Advertisement
Vladislav8653

selection sort

Mar 5th, 2023
148
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 13.74 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Label1: TLabel;
  12.     StringGrid1: TStringGrid;
  13.     StringGrid2: TStringGrid;
  14.     Button1: TButton;
  15.     StringGrid3: TStringGrid;
  16.     Label2: TLabel;
  17.     Edit1: TEdit;
  18.     Label3: TLabel;
  19.     MainMenu1: TMainMenu;
  20.     PopupMenu1: TPopupMenu;
  21.     SaveDialog1: TSaveDialog;
  22.     OpenDialog1: TOpenDialog;
  23.     N1: TMenuItem;
  24.     N2: TMenuItem;
  25.     N3: TMenuItem;
  26.     N4: TMenuItem;
  27.     N5: TMenuItem;
  28.     procedure Edit1Change(Sender: TObject);
  29.     procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  30.       const Value: string);
  31.     procedure Button1Click(Sender: TObject);
  32.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  33.     procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  34.     procedure N4Click(Sender: TObject);
  35.     procedure N5Click(Sender: TObject);
  36.     procedure N2Click(Sender: TObject);
  37.     procedure N3Click(Sender: TObject);
  38.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  39.   private
  40.     { Private declarations }
  41.   public
  42.     { Public declarations }
  43.   end;
  44.  
  45. type
  46.     TArray = Array Of Integer;
  47.     TStr = Array of String[5];
  48. var
  49.   Form1: TForm1;
  50.   TempArr : TArray;
  51.   Path, Result : String;
  52.   IsFileOpen : Boolean;
  53. Const
  54.     BAD = 100000;
  55.  
  56. implementation
  57.  
  58. {$R *.dfm}
  59.  
  60. procedure TForm1.Button1Click(Sender: TObject);
  61. Var
  62.     Arr : TArray;
  63.     I, J, K, N, Temp, Min : Integer;
  64.     IsCorrect : Boolean;
  65. begin
  66.     N := StringGrid1.ColCount;
  67.     SetLength (Arr, N);
  68.     IsCorrect := True;
  69.     Result := 'Исходный массив: ';
  70.     For I := 0 To N - 1 Do
  71.     Begin
  72.         Try
  73.             Arr[I] := StrToInt(StringGrid1.Cells[I, 0]);
  74.             Result := Result + (StringGrid1.Cells[I, 0]) + ' ';
  75.         Except
  76.             IsCorrect := False;
  77.         End;
  78.     End;
  79.     If IsCorrect then
  80.     Begin
  81.         K := 0;
  82.         For I := 0 To High(Arr) - 1 do
  83.         Begin
  84.             For J :=  I + 1 To High(Arr)  do
  85.                 If (Arr[J] < Arr[I]) then
  86.                 Begin
  87.                     Min := Arr[J];
  88.                     Arr[J] := Arr[I];
  89.                     Arr[I] := Min;
  90.                 End;
  91.             For Temp := 0 To High(Arr) Do
  92.             Begin
  93.                 StringGrid2.Cells[Temp + 1, K] := IntToStr(Arr[Temp]);
  94.                 StringGrid2.Cells[0, K] := 'Этап ' + IntToStr(K + 1);
  95.             End;
  96.             Inc(K);
  97.         End;
  98.         Result := Result + ' Отсортированный массив: ';
  99.         For I := 0 To High(Arr) Do
  100.         begin
  101.             StringGrid3.Cells[I, 0] := IntToStr(Arr[I]);
  102.             Result := Result + IntToStr(Arr[I]) + ' ';
  103.         end;
  104.  
  105.         StringGrid2.Visible := True;
  106.         StringGrid3.Visible := True;
  107.         Label2.Visible := True;
  108.         N3.Enabled := True;
  109.  
  110.     End;
  111. end;
  112.  
  113. procedure TForm1.Edit1Change(Sender: TObject);
  114. Var
  115.     N, J, I: Integer;
  116.     IsCorrect : Boolean;
  117. Const
  118.     WIDE = 82;
  119.     HEIGHT = 35;
  120. begin
  121.     IsCorrect := True;
  122.     try
  123.         N := StrToInt(Edit1.Text);
  124.     except
  125.         IsCorrect := False;
  126.     end;
  127.     If Iscorrect then
  128.     begin
  129.         StringGrid1.ColCount := N;
  130.  
  131.         StringGrid1.ScrollBars := ssHorizontal;
  132.         StringGrid1.Height := 55;
  133.         StringGrid1.Width := WIDE * 7;
  134.  
  135.         If N < 8 then
  136.         Begin
  137.             StringGrid1.Height := HEIGHT;
  138.             StringGrid1.ScrollBars := ssNone;
  139.             case N of
  140.                 1: StringGrid1.Width := WIDE;
  141.                 2: StringGrid1.Width := WIDE * 2 + 1;
  142.                 3: StringGrid1.Width := WIDE * 3;
  143.                 4: StringGrid1.Width := WIDE * 4;
  144.                 5: StringGrid1.Width := WIDE * 5;
  145.                 6: StringGrid1.Width := WIDE * 6 - 2;
  146.             end;
  147.         End;
  148.         for I := 0 to StringGrid1.RowCount - 1 do
  149.             for J := 0 to StringGrid1.ColCount - 1 do
  150.                 StringGrid1.Cells[J, I] := '';
  151.         for I := 0 to StringGrid2.RowCount - 1 do
  152.             for J := 0 to StringGrid2.ColCount - 1 do
  153.                 StringGrid2.Cells[J, I] := '';
  154.         StringGrid2.Visible := False;
  155.         StringGrid3.Visible := False;
  156.         StringGrid1.Visible := True;
  157.         StringGrid2.ColCount := N + 1;
  158.         Label2.Visible := False;
  159.         N3.Enabled := False;
  160.         StringGrid2.ScrollBars := ssHorizontal;
  161.         StringGrid2.Width := WIDE * 7;
  162.  
  163.         If N < 7 then
  164.         Begin
  165.             StringGrid2.ScrollBars := ssNone;
  166.             case N of
  167.                 1: StringGrid2.Width := WIDE * 2;
  168.                 2: StringGrid2.Width := WIDE * 3 + 1;
  169.                 3: StringGrid2.Width := WIDE * 4;
  170.                 4: StringGrid2.Width := WIDE * 5;
  171.                 5: StringGrid2.Width := WIDE * 6;
  172.                 6: StringGrid2.Width := WIDE * 7 - 2;
  173.             end;
  174.         End;
  175.         StringGrid3.ColCount := N;
  176.  
  177.         StringGrid3.ScrollBars := ssHorizontal;
  178.         StringGrid3.Height := 55;
  179.         StringGrid3.Width := WIDE * 7;
  180.  
  181.         If N < 8 then
  182.         Begin
  183.             StringGrid3.Height := HEIGHT;
  184.             StringGrid3.ScrollBars := ssNone;
  185.             case N of
  186.                 1: StringGrid3.Width := WIDE;
  187.                 2: StringGrid3.Width := WIDE * 2 + 1;
  188.                 3: StringGrid3.Width := WIDE * 3;
  189.                 4: StringGrid3.Width := WIDE * 4;
  190.                 5: StringGrid3.Width := WIDE * 5;
  191.                 6: StringGrid3.Width := WIDE * 6 - 2;
  192.             end;
  193.         End;
  194.  
  195.         Button1.Visible := False;
  196.     end;
  197. end;
  198.  
  199. procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  200. begin
  201.     if (Key = #13) and (Button1.Enabled) then
  202.         Button1.Click;
  203.     If (Not(Key In ['2'..'9', #08, #46])) Then
  204.         Key := #0;
  205. end;
  206.  
  207.  
  208. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  209. begin
  210.     CanClose := MessageBox(Form1.Handle, 'Вы уверены, что хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION)=ID_YES;
  211. end;
  212.  
  213. procedure TForm1.N4Click(Sender: TObject);
  214. begin
  215.     Application.MessageBox('Программа сортирует массив методом простого выбора с пошаговой детализацией.'#13#10'Размер массива: 2..9.'#13#10'Диапазон элементов массива: -9999..99999', 'Инструкция', 0);
  216. end;
  217.  
  218. procedure TForm1.N5Click(Sender: TObject);
  219. begin
  220.     Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
  221. end;
  222.  
  223. procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
  224. Const
  225.     LIM = 4; // значит 5 - реальный лимит символов
  226. begin
  227.     If (Not(Key In ['0'..'9', #08, #46, '-'])) Then
  228.         Key := #0;
  229.     With Sender As TStringGrid Do
  230.     Begin
  231.         If (Length(StringGrid1.Cells[Col, Row]) > LIM) then
  232.             If (Not(Key In [#08, #46])) Then
  233.                 Key := #0;
  234.         If (Length(StringGrid1.Cells[Col, Row]) = 1) and (Key = '-')  then
  235.             Key := #0;
  236.     End;
  237. end;
  238.  
  239. procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  240.   const Value: string);
  241. var
  242.     I : Integer;
  243.     IsCorrect : Boolean;
  244.     Temp : String;
  245. begin
  246.     IsCorrect := True;
  247.     for I := 0 to StringGrid1.ColCount - 1 do
  248.         If (Length(StringGrid1.Cells[I, 0]) = 0) Then
  249.         begin
  250.             Button1.Visible := False;
  251.             IsCorrect := False;
  252.         end;
  253.     If IsCorrect then
  254.     begin
  255.          Button1.Visible := True;
  256.     end;
  257.     N3.Enabled := False;
  258. end;
  259.  
  260.  
  261. Function CheckFileDataForN(Num: String): Boolean;
  262. Const
  263.     MAX_LIM = 99999;
  264.     MIN_LIM = 2;
  265. Var
  266.     NewNum: Integer;
  267.     IsCorrect: Boolean;
  268. Begin
  269.     NewNum := 0;
  270.     IsCorrect := True;
  271.     Num := Trim (Num);
  272.     Try
  273.         NewNum := StrToInt(Num);
  274.     Except
  275.         MessageBox(Form1.Handle, Pchar('Не получилось преобразовать N к целочисленному типу данных. Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
  276.         IsCorrect := False;
  277.     End;
  278.     If(IsCorrect And ((NewNum > MAX_LIM) Or (NewNum < MIN_LIM))) Then
  279.     Begin
  280.         Num := IntToStr(NewNum);
  281.         MessageBox(Form1.Handle, Pchar('N вне разрешенного диапазона! Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  282.         IsCorrect := False;
  283.     End;
  284.     CheckFileDataForN := IsCorrect;
  285. End;
  286.  
  287.  
  288. Function Open (): String;
  289. Begin
  290.     With Form1 Do
  291.     Begin
  292.         If OpenDialog1.Execute Then
  293.         Begin
  294.             Path := OpenDialog1.FileName;
  295.             IsFileOpen := True;
  296.         End
  297.         Else
  298.             IsFileOpen := False;
  299.     End;
  300.     Open := Path;
  301. End;
  302.  
  303. Function TakeDataFromFile2(Number2: String; Var FileOutput: TextFile): String;
  304. Var               //N
  305.     IsRight : Boolean;
  306. Begin
  307.     IsRight := True;
  308.     Try
  309.         Readln(FileOutput, Number2);
  310.         Number2 := Trim (Number2);
  311.         IsRight := CheckFileDataForN(Number2);
  312.     Except
  313.     End;
  314.     If(Not(IsRight)) Then
  315.         TakeDataFromFile2 := ''
  316.     Else
  317.         TakeDataFromFile2 := Number2;
  318. End;
  319.  
  320.  
  321. function SeparateString (Str : String) : TStr;
  322. Var
  323.     StrArr : TStr;
  324.     I, K : Integer;
  325.     Flag : Boolean;
  326. Begin
  327.     K := 0;
  328.     SetLength(StrArr, (Str.Length div 2) + 1);
  329.     For I := 0 To Str.Length div 2 do
  330.         StrArr[i] := '';
  331.     I := 1;
  332.     While I <= Str.Length Do
  333.     begin
  334.         Flag := true;
  335.         While (Str[I] <> ' ') and (I <= Str.Length) Do
  336.         Begin
  337.             StrArr[K] := StrArr[K] + Str[I];
  338.             Inc(I);
  339.             Flag := False;
  340.         End;
  341.         If Not(Flag) then
  342.             Inc(K);
  343.         If Flag then
  344.             Inc(I);
  345.     end;
  346.     I := 1;
  347.     K := 0;
  348.     While Str[I] <> '' Do
  349.     Begin
  350.         If Str[I] = ' ' then
  351.             Inc(K);
  352.         Inc(I);
  353.     End;
  354.     SetLength(StrArr, K + 1);
  355.     Result := StrArr;
  356. End;
  357.  
  358. function ConvertStringToArray (StringGridColCount : Integer; Var FileOutput: TextFile) : TArray;
  359. Var
  360.     I: Integer;
  361.     Arr : TArray;
  362.     Str : String;
  363.     StrArr : TStr;
  364. Const
  365.     MIN = -9999;
  366.     MAX = 99999;
  367. Begin
  368.     Readln(FileOutput, Str);
  369.     SetLength(Arr, StringGridColCount);
  370.     for I := Low(Arr) to High(Arr) do
  371.         Arr[I] := 0;
  372.     Str := Trim(Str);
  373.     StrArr := SeparateString (Str);
  374.     If (High(StrArr) + 1 <> StringGridColCount) then
  375.     begin
  376.         SetLength (Arr, 1);
  377.         Arr[0] := BAD;
  378.         MessageBox(Form1.Handle, Pchar('Количество элементов массива не совпадает с заявленным. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  379.         ConvertStringToArray := Arr;
  380.         Exit
  381.     end;
  382.     try
  383.         For I := Low(Arr) to High(Arr) do
  384.             Arr[I] := StrToInt (StrArr[I]);
  385.     except
  386.         SetLength (Arr, 1);
  387.         Arr[0] := BAD;
  388.         MessageBox(Form1.Handle, Pchar('Не удалось преобразовать исходные данные в целочисленный тип. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  389.         ConvertStringToArray := Arr;
  390.         Exit
  391.     end;
  392.     For I := Low(Arr) to High(Arr) do
  393.         If (Arr[I] > MAX) or (Arr[I] < MIN) then
  394.         begin
  395.             SetLength (Arr, 1);
  396.             Arr[0] := BAD;
  397.             MessageBox(Form1.Handle, Pchar('Исходные данные выходят за границы допустимых. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  398.             ConvertStringToArray := Arr;
  399.         end;
  400.     ConvertStringToArray := Arr;
  401. End;
  402.  
  403.  
  404. procedure TForm1.N2Click(Sender: TObject);
  405. Var
  406.     FileInput: TextFile;
  407.     Num, I: Integer;
  408.     Str1, Str2 : String;
  409.     Arr : TArray;
  410. begin
  411.     Num := 0;
  412.     Path := Open;
  413.     AssignFile(FileInput, Path);
  414.     Reset(FileInput);
  415.     If(IsFileOpen) Then
  416.     Begin
  417.         Str1 := TakeDataFromFile2(IntToStr(Num), FileInput);
  418.     End;
  419.     if Not(Str1 = '') then
  420.     Begin
  421.         Edit1.Text := Str1;
  422.     End
  423.     Else
  424.     Begin
  425.         Edit1.Text := #0;
  426.     End;
  427.     if (Str1 <> '') then
  428.         Begin
  429.             Arr := ConvertStringToArray(StrToInt(Str1), FileInput);
  430.             if (Arr[0] <> BAD) then
  431.             Begin
  432.                 for I := Low(Arr) to High(Arr) do
  433.                 Begin
  434.                     StringGrid1.Cells[I, 0] := IntToStr(Arr[I]);
  435.                     Button1.Visible := True;
  436.                 End;
  437.             End
  438.             else
  439.             Begin
  440.                 for I := Low(Arr) to StrToInt(Str1) - 1 do
  441.                 Begin
  442.                     StringGrid1.Cells[I, 0] := '';
  443.                 End;
  444.                  Edit1.Text := '';
  445.             End;
  446.  
  447.         End;
  448.     CloseFile(FileInput);
  449. end;
  450.  
  451.  
  452. procedure TForm1.N3Click(Sender: TObject);
  453. Var
  454.     FileOutput: TextFile;
  455.     IsCorrect : Boolean;
  456. begin
  457.     IsCorrect := True;
  458.     Path := Open;
  459.     If (IsFileOpen) Then
  460.     Begin
  461.         try
  462.             AssignFile(FileOutput, Path);
  463.             Rewrite(FileOutput);
  464.             Write(FileOutput, Result);
  465.         except
  466.             IsCorrect := False;
  467.             Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP);
  468.         end;
  469.         if IsCorrect then
  470.         Begin
  471.             Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
  472.             CloseFile(FileOutput);
  473.             Edit1.Text := '2';
  474.         End;
  475.     End;
  476. end;
  477.  
  478. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement