Advertisement
Vladislav8653

4.2 Delphi

Mar 13th, 2023 (edited)
162
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 17.29 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.     StringHeader: TLabel;
  12.     ArraySize: TEdit;
  13.     InputArray: TButton;
  14.     StringArray: TLabel;
  15.     StringGrid1: TStringGrid;
  16.     StringNumber: TLabel;
  17.     Number: TEdit;
  18.     Find: TButton;
  19.     Answer: TLabel;
  20.     OpenDialog1: TOpenDialog;
  21.     SaveDialog1: TSaveDialog;
  22.     MainMenu1: TMainMenu;
  23.     PopupMenu1: TPopupMenu;
  24.     N1: TMenuItem;
  25.     N2: TMenuItem;
  26.     N3: TMenuItem;
  27.     N4: TMenuItem;
  28.     N5: TMenuItem;
  29.     procedure InputArrayClick(Sender: TObject);
  30.     procedure ArraySizeChange(Sender: TObject);
  31.     procedure ArraySizeKeyPress(Sender: TObject; var Key: Char);
  32.     procedure NumberChange(Sender: TObject);
  33.     procedure NumberKeyPress(Sender: TObject; var Key: Char);
  34.     procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  35.       const Value: string);
  36.     procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  37.     procedure FindClick(Sender: TObject);
  38.     procedure N4Click(Sender: TObject);
  39.     procedure N5Click(Sender: TObject);
  40.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  41.     procedure N2Click(Sender: TObject);
  42.     procedure N3Click(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.   public
  46.     { Public declarations }
  47.   end;
  48.  
  49.  
  50. type
  51.     TArray = Array Of Integer;
  52.     TStr = Array of String[5];
  53.  
  54. var
  55.   Form1: TForm1;
  56.   TempArr : TArray;
  57.   Path, Save : String;
  58.   IsFileOpen : Boolean;
  59. Const
  60.     BAD = 100000;
  61.  
  62. implementation
  63.  
  64. {$R *.dfm}
  65.  
  66. procedure TForm1.ArraySizeChange(Sender: TObject);
  67. begin
  68.     StringGrid1.Visible := False;
  69.     Find.Visible := False;
  70.     Number.Visible := False;
  71.     StringNumber.Visible := False;
  72.     Number.Text := '';
  73.     Answer.Visible := False;
  74.  
  75.     If Length(ArraySize.Text) = 0 then
  76.     Begin
  77.         InputArray.Enabled := False;
  78.     End
  79.     else
  80.     Begin
  81.         InputArray.Enabled := True;
  82.     End;
  83.     N3.Enabled := False;
  84. end;
  85.  
  86. procedure TForm1.ArraySizeKeyPress(Sender: TObject; var Key: Char);
  87. begin
  88.     if (Key = #13) and (InputArray.Enabled) then
  89.         InputArray.Click;
  90.     If (Not(Key In ['1'..'9', #08, #46])) Then
  91.         Key := #0;
  92.     If Key = '.' then
  93.         Key := Char(0);
  94.  
  95. end;
  96.  
  97. procedure BinarySearch (Arr : Array Of Integer; Var Result, Key, Left, Right : Integer);
  98. Var
  99.     Mid : Integer;
  100. Begin
  101.     If Left <= Right then
  102.     begin
  103.         Mid := Left + (Right - Left) div 2;
  104.         If Arr[Mid] = Key then
  105.             Result := Mid
  106.         else if Arr[Mid] < Key then
  107.         begin
  108.             Left := Mid + 1;
  109.             BinarySearch(Arr, Result, Key, Left, Right);
  110.         end
  111.         else
  112.         begin
  113.             Right := Mid - 1;
  114.             BinarySearch(Arr, Result, Key, Left, Right);
  115.         end;
  116.     end;
  117. End;
  118.  
  119. function CheckArray (Arr : Array of Integer) : Boolean;
  120. Var
  121.     I, N : Integer;
  122.     Ascending, Descending, IsCorrect : Boolean;
  123. Begin
  124.     Ascending := True;
  125.     Descending := True;
  126.     IsCorrect := True;
  127.     I := 0;
  128.     N := High(Arr);
  129.     While ((I < N) and (Descending)) do
  130.     begin
  131.         If Arr[I] <= Arr[I + 1] then
  132.             Descending := False;
  133.         Inc(I);
  134.     end;
  135.  
  136.     I := 0;
  137.     While ((I < N) and (Ascending)) do
  138.     begin
  139.         If Arr[I] >= Arr[I + 1] then
  140.             Ascending := False;
  141.         Inc(I);
  142.     end;
  143.     If ((Not(Descending)) and (Not(Ascending))) then
  144.     begin
  145.         IsCorrect := False;
  146.         MessageBox(Form1.Handle, Pchar('Введите отсортированный массив, так как бинарный поиск возможен только в таком.'), 'Ошибка', MB_ICONSTOP);
  147.     end;
  148.     CheckArray := IsCorrect;
  149. End;
  150.  
  151.  
  152. procedure TForm1.FindClick(Sender: TObject);
  153. Var
  154.     Left, Right, Mid, Result, Key, MidVal, N, I, TempValForCheck: Integer;
  155.     IsCorrect : Boolean;
  156.     Arr : Array of Integer;
  157. Const
  158.     MAX = 99999;
  159.     MIN = -9999;
  160.     No = 100000;
  161. begin
  162.     IsCorrect := True;
  163.     try
  164.         For I := 0 To StringGrid1.ColCount - 1 Do
  165.             TempValForCheck := StrToInt(StringGrid1.Cells[I, 0]);
  166.     except
  167.         IsCorrect := False;
  168.         StringGrid1.Cells[I, 0] := '';
  169.         Find.Visible := False;
  170.         Number.Visible := False;
  171.         StringNumber.Visible := False;
  172.         Number.Text := '';
  173.         MessageBox(Form1.Handle, Pchar('Проверьте, чтобы элементы массива были целыми числами.'), 'Ошибка', MB_ICONSTOP);
  174.     end;
  175.  
  176.     If IsCorrect then
  177.     begin
  178.         For I := 0 To StringGrid1.ColCount - 1 Do
  179.             If (StrToInt(StringGrid1.Cells[I, 0]) > MAX) or (StrToInt(StringGrid1.Cells[I, 0]) < MIN) then
  180.             Begin
  181.                 IsCorrect := False;
  182.                 Break;
  183.             End;
  184.     end;
  185.  
  186.     If IsCorrect then
  187.     Begin
  188.         N := StringGrid1.ColCount;
  189.         SetLength(Arr, N);
  190.         For I := 0 To N - 1 Do
  191.         Begin
  192.             Arr[I] := StrToInt(StringGrid1.Cells[I, 0]);
  193.         End;
  194.         IsCorrect := CheckArray(Arr);
  195.         If Not(IsCorrect) then
  196.         begin
  197.             For I := 0 To N - 1 Do
  198.             Begin
  199.                 StringGrid1.Cells[I, 0] := '';
  200.             End;
  201.         end;
  202.     End;
  203.  
  204.     If IsCorrect then
  205.         try
  206.             Key := StrToInt (Number.Text);
  207.         except
  208.             IsCorrect := False;
  209.             Number.Text := '';
  210.             Answer.Caption := '';
  211.             MessageBox(Form1.Handle, Pchar('Не удалось считать число для поиска. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  212.         end;
  213.  
  214.     If IsCorrect then
  215.     begin
  216.  
  217.         Save := Save + 'Искомое число: ' + Number.Text + #13#10;
  218.         Save := Save + 'Элементы массива: ';
  219.         For I := 0 To N - 1 Do
  220.         Begin
  221.             Save :=  Save + StringGrid1.Cells[I, 0] + ' ';
  222.         End;
  223.         Save := Save + #13#10;
  224.         Result := NO;
  225.         Left := 0;
  226.         Right := StringGrid1.ColCount - 1;
  227.         BinarySearch(Arr, Result, Key, Left, Right);
  228.         Answer.Visible := True;
  229.         If Result = NO then
  230.             Answer.Caption := 'Искомого элемента в массива нет.'
  231.         else
  232.             Answer.Caption := 'Ответ: ' + IntToStr(Result + 1) + ' - ый элемент массива';
  233.         N3.Enabled := True;
  234.         Save := Save + Answer.Caption;
  235.     end;
  236. end;
  237.  
  238.  
  239. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  240. begin
  241.     CanClose := MessageBox(Form1.Handle, 'Вы уверены, что хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION)=ID_YES;
  242. end;
  243.  
  244. procedure TForm1.InputArrayClick(Sender: TObject);
  245. var
  246.     N, I, J : Integer;
  247.     IsCorrect : Boolean;
  248. Const
  249.     WIDE = 82;
  250.     HEIGHT = 35;
  251. begin
  252.     IsCorrect := True;
  253.     Try
  254.         N := StrToInt(ArraySize.Text);
  255.     Except
  256.         MessageBox(Form1.Handle, Pchar('Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
  257.         IsCorrect := False;
  258.         StringGrid1.Visible := False;
  259.         ArraySize.Text := '';
  260.     End;
  261.     if IsCorrect then
  262.     Begin
  263.         Save := Save + 'Размер массива: ' + IntToStr(N) + #13#10;
  264.         StringGrid1.ColCount := N;
  265.  
  266.         //стоковые значения
  267.         StringGrid1.ScrollBars := ssHorizontal;
  268.         StringGrid1.Height := 55;
  269.         StringGrid1.Width := WIDE * 6;
  270.  
  271.         If N < 7 then
  272.         Begin
  273.             StringGrid1.Height := HEIGHT;
  274.             StringGrid1.ScrollBars := ssNone;
  275.             case N of
  276.                 1: StringGrid1.Width := WIDE;
  277.                 2: StringGrid1.Width := WIDE * 2 + 1;
  278.                 3: StringGrid1.Width := WIDE * 3;
  279.                 4: StringGrid1.Width := WIDE * 4;
  280.                 5: StringGrid1.Width := WIDE * 5;
  281.             end;
  282.         End;
  283.         for I := 0 to StringGrid1.RowCount - 1 do
  284.             for J := 0 to StringGrid1.ColCount - 1 do
  285.                 StringGrid1.Cells[J, I] := '';
  286.         StringGrid1.Visible := True;
  287.     End;
  288.  
  289. end;
  290.  
  291. procedure TForm1.N4Click(Sender: TObject);
  292. begin
  293.     Application.MessageBox('Программа рекурсивно осуществляет двоичный поиск элемента в массиве.'#13#10'Размер массива: 1..9'#13#10'Размер элементов массива и числа: -9999..99999'#13#10'P.S. Если в массиве несколько искомых элементов, программа выдаст как ответ тот, что "ближе к середине"', 'Инструкция', 0);
  294. end;
  295.  
  296. procedure TForm1.N5Click(Sender: TObject);
  297. begin
  298.     Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
  299. end;
  300.  
  301. procedure TForm1.NumberChange(Sender: TObject);
  302. begin
  303.     If Length(Number.Text) = 0 then
  304.         Find.Enabled := False
  305.     else
  306.         Find.Enabled := True;
  307.     Answer.Visible := False;
  308.     N3.Enabled := False;
  309. end;
  310.  
  311. procedure TForm1.NumberKeyPress(Sender: TObject; var Key: Char);
  312. begin
  313.     If (Key = #13) and (Find.Enabled) then
  314.         Find.Click;
  315.     If (Not(Key In ['0'..'9', #08, #46, '-'])) Then
  316.         Key := #0;
  317.     If Key = '.' then
  318.         Key := Char(0);
  319.      If (Length(Number.Text) > 0) and (Key = '-')  then
  320.             Key := #0;
  321. end;
  322.  
  323.  
  324.  
  325. procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
  326. Const
  327.     LIM = 4; // значит 5 - реальный лимит символов
  328. begin
  329.     If (Not(Key In ['0'..'9', #08, #46, '-'])) Then
  330.         Key := #0;
  331.     With Sender As TStringGrid Do
  332.     Begin
  333.         If (Length(StringGrid1.Cells[Col, Row]) > LIM) then
  334.             If (Not(Key In [#08, #46])) Then
  335.                 Key := #0;
  336.         If (Length(StringGrid1.Cells[Col, Row]) > 0) and (Key = '-')  then
  337.             Key := #0;
  338.     End;
  339. end;
  340.  
  341. procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  342.   const Value: string);
  343. var
  344.     I : Integer;
  345.     IsCorrect : Boolean;
  346.     Temp : String;
  347. begin
  348.     IsCorrect := True;
  349.     For I := 0 to StringGrid1.ColCount - 1 do
  350.         If (Length(StringGrid1.Cells[I, 0]) = 0) Then
  351.         begin
  352.             Find.Visible := False;
  353.             Number.Visible := False;
  354.             StringNumber.Visible := False;
  355.             IsCorrect := False;
  356.             Number.Text := '';
  357.             Answer.Visible := False;
  358.         end;
  359.     If IsCorrect then
  360.     begin
  361.          Find.Visible := True;
  362.          Number.Visible := True;
  363.          StringNumber.Visible := True;
  364.     end;
  365.     N3.Enabled := False;
  366. end;
  367.  
  368.  
  369. Function CheckFileDataForN(Num: String; MAX, MIN : Integer): Boolean;
  370. Var
  371.     NewNum: Integer;
  372.     IsCorrect: Boolean;
  373. Begin
  374.     NewNum := 0;
  375.     IsCorrect := True;
  376.     Num := Trim (Num);
  377.     Try
  378.         NewNum := StrToInt(Num);
  379.     Except
  380.         MessageBox(Form1.Handle, Pchar('Не получилось преобразовать N к целочисленному типу данных. Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
  381.         IsCorrect := False;
  382.     End;
  383.     If(IsCorrect And ((NewNum > MAX) Or (NewNum < MIN))) Then
  384.     Begin
  385.         Num := IntToStr(NewNum);
  386.         MessageBox(Form1.Handle, Pchar('N вне разрешенного диапазона! Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  387.         IsCorrect := False;
  388.     End;
  389.     CheckFileDataForN := IsCorrect;
  390. End;
  391.  
  392.  
  393. Function Open (): String;
  394. Begin
  395.     With Form1 Do
  396.     Begin
  397.         If OpenDialog1.Execute Then
  398.         Begin
  399.             Path := OpenDialog1.FileName;
  400.             IsFileOpen := True;
  401.         End
  402.         Else
  403.             IsFileOpen := False;
  404.     End;
  405.     Open := Path;
  406. End;
  407.  
  408. Function TakeDataFromFile2(Number2: String; Var FileOutput: TextFile; MAX, MIN : Integer): String;
  409. Var
  410.     IsRight : Boolean;
  411. Begin
  412.     IsRight := True;
  413.     Try
  414.         Readln(FileOutput, Number2);
  415.         Number2 := Trim (Number2);
  416.         IsRight := CheckFileDataForN(Number2, MAX, MIN);
  417.     Except
  418.     End;
  419.     If(Not(IsRight)) Then
  420.         TakeDataFromFile2 := ''
  421.     Else
  422.         TakeDataFromFile2 := Number2;
  423. End;
  424.  
  425.  
  426. function SeparateString (Str : String) : TStr;
  427. Var
  428.     StrArr : TStr;
  429.     I, K : Integer;
  430.     Flag : Boolean;
  431. Begin
  432.     K := 0;
  433.     SetLength(StrArr, (Str.Length div 2) + 1);
  434.     For I := 0 To Str.Length div 2 do
  435.         StrArr[i] := '';
  436.     I := 1;
  437.     While I <= Str.Length Do
  438.     begin
  439.         Flag := true;
  440.         While (Str[I] <> ' ') and (I <= Str.Length) Do
  441.         Begin
  442.             StrArr[K] := StrArr[K] + Str[I];
  443.             Inc(I);
  444.             Flag := False;
  445.         End;
  446.         If Not(Flag) then
  447.             Inc(K);
  448.         If Flag then
  449.             Inc(I);
  450.     end;
  451.     I := 1;
  452.     K := 0;
  453.     While Str[I] <> '' Do
  454.     Begin
  455.         If Str[I] = ' ' then
  456.             Inc(K);
  457.         Inc(I);
  458.     End;
  459.     SetLength(StrArr, K + 1);
  460.     Result := StrArr;
  461. End;
  462.  
  463. function ConvertStringToArray (StringGridColCount : Integer; Var FileOutput: TextFile) : TArray;
  464. Var
  465.     I: Integer;
  466.     Arr : TArray;
  467.     Str : String;
  468.     StrArr : TStr;
  469. Const
  470.     MIN = -9999;
  471.     MAX = 99999;
  472. Begin
  473.     Readln(FileOutput, Str);
  474.     SetLength(Arr, StringGridColCount);
  475.     for I := Low(Arr) to High(Arr) do
  476.         Arr[I] := 0;
  477.     Str := Trim(Str);
  478.     StrArr := SeparateString (Str);
  479.     If (High(StrArr) + 1 <> StringGridColCount) then
  480.     begin
  481.         SetLength (Arr, 1);
  482.         Arr[0] := BAD;
  483.         MessageBox(Form1.Handle, Pchar('Количество элементов массива не совпадает с заявленным. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  484.         ConvertStringToArray := Arr;
  485.         Exit
  486.     end;
  487.     try
  488.         For I := Low(Arr) to High(Arr) do
  489.             Arr[I] := StrToInt (StrArr[I]);
  490.     except
  491.         SetLength (Arr, 1);
  492.         Arr[0] := BAD;
  493.         MessageBox(Form1.Handle, Pchar('Не удалось преобразовать исходные данные в целочисленный тип. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  494.         ConvertStringToArray := Arr;
  495.         Exit
  496.     end;
  497.     For I := Low(Arr) to High(Arr) do
  498.         If (Arr[I] > MAX) or (Arr[I] < MIN) then
  499.         begin
  500.             SetLength (Arr, 1);
  501.             Arr[0] := BAD;
  502.             MessageBox(Form1.Handle, Pchar('Исходные данные выходят за границы допустимых. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
  503.             ConvertStringToArray := Arr;
  504.         end;
  505.     ConvertStringToArray := Arr;
  506. End;
  507.  
  508.  
  509. procedure TForm1.N2Click(Sender: TObject);
  510. Var
  511.     FileInput: TextFile;
  512.     Num, I: Integer;
  513.     Str1, Str2 : String;
  514.     Arr : TArray;
  515. Const
  516.     MAX_ARR= 9;
  517.     MIN_ARR = 1;
  518.     MAX = 99999;
  519.     MIN = -9999;
  520. begin
  521.     Num := 0;
  522.     Path := Open;
  523.     AssignFile(FileInput, Path);
  524.     Reset(FileInput);
  525.     If(IsFileOpen) Then
  526.     Begin
  527.         Str1 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX_ARR, MIN_ARR);
  528.     End;
  529.     if Not(Str1 = '') then
  530.     Begin
  531.         ArraySize.Text := Str1;
  532.     End
  533.     Else
  534.     Begin
  535.         ArraySize.Text := #0;
  536.     End;
  537.     if (Str1 <> '') then
  538.         Begin
  539.             InputArray.Click;
  540.             Arr := ConvertStringToArray(StrToInt(Str1), FileInput);
  541.             if (Arr[0] <> BAD) then
  542.             Begin
  543.                 for I := Low(Arr) to High(Arr) do
  544.                 Begin
  545.                     StringGrid1.Cells[I, 0] := IntToStr(Arr[I]);
  546.                 End;
  547.                 StringNumber.Visible := True;
  548.                 Number.Visible := True;
  549.                 Find.Visible := True;
  550.                 Str2 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX, MIN);
  551.                 If Not(Str2 = '') then
  552.                 Begin
  553.                     Number.Text := Str2;
  554.                 End
  555.                 Else
  556.                 Begin
  557.                     Number.Text := #0;
  558.                 End;
  559.             End
  560.             else
  561.             Begin
  562.                 for I := Low(Arr) to StrToInt(Str1) - 1 do
  563.                 Begin
  564.                     StringGrid1.Cells[I, 0] := '';
  565.                 End;
  566.                  ArraySize.Text := '';
  567.             End;
  568.  
  569.         End;
  570.     CloseFile(FileInput);
  571. end;
  572.  
  573. procedure TForm1.N3Click(Sender: TObject);
  574. Var
  575.     FileOutput: TextFile;
  576.     IsCorrect : Boolean;
  577. begin
  578.     IsCorrect := True;
  579.     Path := Open;
  580.     If (IsFileOpen) Then
  581.     Begin
  582.         try
  583.             AssignFile(FileOutput, Path);
  584.             Rewrite(FileOutput);
  585.             Write(FileOutput, Save);
  586.         except
  587.             IsCorrect := False;
  588.             Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP);
  589.         end;
  590.         if IsCorrect then
  591.         Begin
  592.             Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
  593.             CloseFile(FileOutput);
  594.             ArraySize.Text := '';
  595.         End;
  596.     End;
  597. end;
  598.  
  599.  
  600.  
  601.  
  602. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement