Advertisement
stepan12123123123

Untitled

Dec 20th, 2022
509
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 7.59 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes,Variants, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,ShellAPI, Windows, Buttons, ExtCtrls, StdCtrls;
  9.  
  10. type
  11.  
  12.   {LIST}
  13.   {Тип основных данных.}
  14.   {Указатель на элемент списка.}
  15.   TPElem = ^TElem;
  16.   {Элемент списка.}
  17.   TElem = record
  18.     Data : integer; {Основные данные.}
  19.     PointNext : TPElem; {Указатель на следующий элемент.}
  20.   end;
  21.   {Список.}
  22.   TDList = record
  23.   PointBeg, PointEnd : TPElem; {Указатели на первый и на последний элементы списка.}
  24.    end;
  25.    { TForm1 }
  26.   TForm1 = class(TForm)
  27.     Button1: TButton;
  28.     Button2: TButton;
  29.     Button3: TButton;
  30.     Button4: TButton;
  31.     Button5: TButton;
  32.     Button6: TButton;
  33.     Edit1: TEdit;
  34.     ListBox1: TListBox;
  35.     ListBox2: TListBox;
  36.     ListBox3: TListBox;
  37.     Memo1: TMemo;
  38.     OpenDialog1: TOpenDialog;
  39.     SaveDialog1: TSaveDialog;
  40.     procedure Button1Click(Sender: TObject);
  41.     procedure Button2Click(Sender: TObject);
  42.     procedure Button3Click(Sender: TObject);
  43.     procedure Button4Click(Sender: TObject);
  44.     procedure Button5Click(Sender: TObject);
  45.     procedure Button6Click(Sender: TObject);
  46.     procedure Edit1Change(Sender: TObject);
  47.     procedure Memo1Change(Sender: TObject);
  48.   private
  49.  
  50.   public
  51.   end;
  52.  
  53. var
  54.   Form1: TForm1;
  55.  
  56. implementation
  57. var
  58. n : integer;
  59. List1, List2 : TDList;
  60. ListForm : TForm1;
  61. {$R *.lfm}
  62.  
  63. { TForm1 }
  64. {Create list}
  65.  
  66. procedure Create_Zero_List(var a: TDList; n : integer);
  67. var
  68. i : integer;
  69. Elem : TPElem;
  70. begin
  71.   a.PointEnd := nil;
  72.   a.PointBeg := nil;
  73.   for i := 0 to n-1 do begin
  74.     New(Elem);
  75.     Elem^.Data := 0;
  76.     Elem^.PointNext := nil;
  77.     if a.PointBeg = nil then begin
  78.        a.PointBeg := Elem;
  79.     end
  80.     else begin
  81.        a.PointEnd^.PointNext := Elem;
  82.     end;
  83.     a.PointEnd := Elem;
  84.   end;
  85. end;
  86. function Slianie(var list1, list2, a: TPElem; n1, n2: integer): TPElem;
  87. var s1 : TDList;
  88. s : TPElem;
  89. n3: integer;
  90. begin
  91.   n3 := n1 + n2;
  92.   Create_Zero_List(s1,n3);
  93.   s := s1.PointBeg;
  94.   while (list1 <> nil) and (list2 <> nil) do begin
  95.     if list1^.Data <= list2^.Data then begin
  96.        s^.Data := list1^.Data;
  97.        s := s^.PointNext;
  98.        list1 := list1^.PointNext;
  99.     end
  100.     else begin
  101.        s^.Data := list2^.Data;
  102.        s := s^.PointNext;
  103.        list2 := list2^.PointNext;
  104.       end;
  105.   end;
  106.   if list1 = nil then begin
  107.       while list2 <> nil do begin
  108.         s^.Data := list2^.Data;
  109.         s := s^.PointNext;
  110.         list2 := list2^.PointNext;
  111.       end;
  112.   end
  113.   else begin
  114.      while list1 <> nil do begin
  115.        s^.Data := list1^.Data;
  116.        s := s^.PointNext;
  117.        list1 := list1^.PointNext;
  118.      end;
  119.   end;
  120.   Slianie := s1.PointBeg;
  121. end;
  122. procedure MergeSort(var a: TPElem; n : integer);
  123. var p1, p2: TPElem;
  124. k, i : integer;
  125. begin
  126.   if n > 1 then begin
  127.      k := n div 2;
  128.      p1 := a;
  129.      for i := 1 to k-1 do begin
  130.        p1 := p1^.PointNext;
  131.      end;
  132.      p2 := p1^.PointNext;
  133.      p1^.PointNext := nil;
  134.      p1 := a;
  135.      MergeSort(p1, k);
  136.      MergeSort(p2, n-k);
  137.      a := Slianie(p1, p2, a, k, n-k);
  138.   end;
  139. end;
  140.  
  141.  
  142. procedure Create_List(var a: TDList; n : integer);
  143. var
  144. i : integer;
  145. Elem : TPElem;
  146. begin
  147.   randomize;                          
  148.   a.PointEnd := nil;
  149.   a.PointBeg := nil;
  150.   for i := 0 to n-1 do begin
  151.     New(Elem);
  152.     Elem^.Data := random(1999)-999;
  153.     Elem^.PointNext := nil;
  154.     if a.PointBeg = nil then begin
  155.        a.PointBeg := Elem;
  156.     end
  157.     else begin
  158.        a.PointEnd^.PointNext := Elem;
  159.     end;
  160.     a.PointEnd := Elem;
  161.   end;
  162. end;
  163. procedure Create_List_Order(var a: TDList; n : integer);
  164. var
  165. i,k : integer;
  166. Elem : TPElem;
  167. begin
  168.   randomize;
  169.   k := -1000;
  170.   a.PointEnd := nil;
  171.   a.PointBeg := nil;
  172.   for i := 0 to n-1 do begin
  173.     New(Elem);
  174.     Elem^.Data := random(1999)-999;
  175.     while Elem^.Data < k do begin
  176.         Elem^.Data := random(1999)-999;
  177.     end;
  178.     k := Elem^.Data;
  179.     Elem^.PointNext := nil;
  180.     if a.PointBeg = nil then begin
  181.        a.PointBeg := Elem;
  182.     end
  183.     else begin
  184.        a.PointEnd^.PointNext := Elem;
  185.     end;
  186.     a.PointEnd := Elem;
  187.   end;
  188. end;
  189.  
  190. procedure Writer1(var a : TDList; n : integer);
  191. var Elem : TPElem;
  192. begin
  193.   Form1.ListBox1.Clear;
  194.   if n <= 40 then begin
  195.   Elem := a.PointBeg;
  196.   if Elem = nil then begin
  197.      Form1.ListBox1.Items.Add('--');
  198.      end
  199.   else begin
  200.     While Elem <> nil do begin
  201.       if Elem <> a.PointEnd then begin
  202.          Form1.ListBox1.Items.Add(IntToStr(Elem^.Data));
  203.          Elem := Elem^.PointNext;
  204.       end
  205.       else begin
  206.         Form1.ListBox1.Items.Add(IntToStr(Elem^.Data));
  207.         break;
  208.       end;
  209.     end;
  210.   end;
  211.   end
  212.   else
  213.      Form1.ListBox1.Items.Add('SOCHI KLASS!!!');
  214. end;
  215. procedure Writer2(var a : TDList; n : integer);
  216. var Elem : TPElem;
  217. begin
  218.   Form1.ListBox2.Clear;
  219.   if n <= 40 then begin
  220.   Elem := a.PointBeg;
  221.   if Elem = nil then begin
  222.      Form1.ListBox2.Items.Add('--');
  223.      end
  224.   else begin
  225.     While Elem <> nil do begin
  226.       if Elem <> a.PointEnd then begin
  227.          Form1.ListBox2.Items.Add(IntToStr(Elem^.Data));
  228.          Elem := Elem^.PointNext;
  229.       end
  230.       else begin
  231.         Form1.ListBox2.Items.Add(IntToStr(Elem^.Data));
  232.         break;
  233.       end;
  234.     end;
  235.   end;
  236.   end
  237.   else
  238.      Form1.ListBox2.Items.Add('SOCHI KLASS!!!');
  239. end;
  240. procedure Writer3(var a : TDList; n : integer);
  241. var Elem : TPElem;
  242. begin
  243.   Form1.ListBox3.Clear;
  244.   Elem := a.PointBeg;
  245.   if Elem = nil then begin
  246.      Form1.ListBox3.Items.Add('--');
  247.      end
  248.   else begin
  249.     While Elem <> nil do begin
  250.       if Elem <> a.PointEnd then begin
  251.          Form1.ListBox3.Items.Add(IntToStr(Elem^.Data));
  252.          Elem := Elem^.PointNext;
  253.       end
  254.       else begin
  255.         Form1.ListBox3.Items.Add(IntToStr(Elem^.Data));
  256.         break;
  257.       end;
  258.     end;
  259.   end;
  260. end;
  261. procedure TForm1.Button1Click(Sender: TObject);
  262. begin
  263.    n := StrToInt(Edit1.Text);
  264.    Create_List(List1, n);
  265.    if n <= 40 then begin
  266.    Writer1(List1, n)
  267.    end;
  268. end;
  269.  
  270. procedure TForm1.Button2Click(Sender: TObject);
  271. begin
  272.     n := StrToInt(Edit1.Text);
  273.    Create_List_Order(List2, n);
  274.    if n <= 40 then begin
  275.    Writer2(List2, n)
  276.    end;
  277. end;
  278.  
  279. procedure TForm1.Button3Click(Sender: TObject);
  280. begin
  281.   n := StrToInt(Edit1.Text);
  282.   MergeSort(List1.PointBeg, n);
  283.   if n <= 40 then begin
  284.   Writer3(List1, n);
  285.   end;
  286. end;
  287.  
  288. procedure TForm1.Button4Click(Sender: TObject);
  289. begin
  290.   Close;
  291. end;
  292. procedure TForm1.Button6Click(Sender: TObject);
  293. begin
  294.  
  295. end;
  296. procedure TForm1.Button5Click(Sender : TObject);
  297. var
  298. outf : textfile;
  299. Elem : TPElem;
  300. begin
  301.    Memo1.Lines.Clear;
  302.    ListForm.Memo1.Lines.Add('Укажите файл для сохранения');
  303.    if ListForm.OpenDialog1.Execute then begin
  304.    assignfile(outf,ListForm.OpenDialog1.FileName);
  305.    rewrite(outf);
  306.    Elem := List1.PointBeg;
  307.    if Elem = nil then begin
  308.      write(outf, '--');
  309.      end
  310.   else begin
  311.     While Elem <> nil do begin
  312.       if Elem <> List1.PointEnd then begin
  313.          write(Elem^.Data, ' ');
  314.          Elem := Elem^.PointNext;
  315.       end
  316.       else begin
  317.         write(Elem^.Data, ' ');
  318.         break;
  319.       end;
  320.     end;
  321.   end;
  322.   closefile(outf);
  323.   ListForm.Memo1.Lines.Clear;
  324.   ListForm.Memo1.Lines.Add('Список записан в файл' + ListForm.OpenDialog1.FileName);
  325.    end;
  326. end;
  327. procedure TForm1.Edit1Change(Sender: TObject);
  328. begin
  329.  
  330. end;
  331.  
  332. procedure TForm1.Memo1Change(Sender: TObject);
  333. begin
  334.  
  335. end;
  336.  
  337. end.
  338.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement