unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.Menus; type TForm1 = class(TForm) StringHeader: TLabel; ArraySize: TEdit; InputArray: TButton; StringArray: TLabel; StringGrid1: TStringGrid; StringNumber: TLabel; Number: TEdit; Find: TButton; Answer: TLabel; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; MainMenu1: TMainMenu; PopupMenu1: TPopupMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; procedure InputArrayClick(Sender: TObject); procedure ArraySizeChange(Sender: TObject); procedure ArraySizeKeyPress(Sender: TObject; var Key: Char); procedure NumberChange(Sender: TObject); procedure NumberKeyPress(Sender: TObject; var Key: Char); procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); procedure StringGrid1KeyPress(Sender: TObject; var Key: Char); procedure FindClick(Sender: TObject); procedure N4Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; type TArray = Array Of Integer; TStr = Array of String[5]; var Form1: TForm1; TempArr : TArray; Path, Save : String; IsFileOpen : Boolean; Const BAD = 100000; implementation {$R *.dfm} procedure TForm1.ArraySizeChange(Sender: TObject); begin StringGrid1.Visible := False; Find.Visible := False; Number.Visible := False; StringNumber.Visible := False; Number.Text := ''; Answer.Visible := False; If Length(ArraySize.Text) = 0 then Begin InputArray.Enabled := False; End else Begin InputArray.Enabled := True; End; N3.Enabled := False; end; procedure TForm1.ArraySizeKeyPress(Sender: TObject; var Key: Char); begin if (Key = #13) and (InputArray.Enabled) then InputArray.Click; If (Not(Key In ['1'..'9', #08, #46])) Then Key := #0; If Key = '.' then Key := Char(0); end; procedure BinarySearch (Arr : Array Of Integer; Var Result, Key, Left, Right : Integer); Var Mid : Integer; Begin If Left <= Right then begin Mid := Left + (Right - Left) div 2; If Arr[Mid] = Key then Result := Mid else if Arr[Mid] < Key then begin Left := Mid + 1; BinarySearch(Arr, Result, Key, Left, Right); end else begin Right := Mid - 1; BinarySearch(Arr, Result, Key, Left, Right); end; end; End; function CheckArray (Arr : Array of Integer) : Boolean; Var I, N : Integer; Ascending, Descending, IsCorrect : Boolean; Begin Ascending := True; Descending := True; IsCorrect := True; I := 0; N := High(Arr); While ((I < N) and (Descending)) do begin If Arr[I] <= Arr[I + 1] then Descending := False; Inc(I); end; I := 0; While ((I < N) and (Ascending)) do begin If Arr[I] >= Arr[I + 1] then Ascending := False; Inc(I); end; If ((Not(Descending)) and (Not(Ascending))) then begin IsCorrect := False; MessageBox(Form1.Handle, Pchar('Введите отсортированный массив, так как бинарный поиск возможен только в таком.'), 'Ошибка', MB_ICONSTOP); end; CheckArray := IsCorrect; End; procedure TForm1.FindClick(Sender: TObject); Var Left, Right, Mid, Result, Key, MidVal, N, I, TempValForCheck: Integer; IsCorrect : Boolean; Arr : Array of Integer; Const MAX = 99999; MIN = -9999; No = 100000; begin IsCorrect := True; try For I := 0 To StringGrid1.ColCount - 1 Do TempValForCheck := StrToInt(StringGrid1.Cells[I, 0]); except IsCorrect := False; StringGrid1.Cells[I, 0] := ''; Find.Visible := False; Number.Visible := False; StringNumber.Visible := False; Number.Text := ''; MessageBox(Form1.Handle, Pchar('Проверьте, чтобы элементы массива были целыми числами.'), 'Ошибка', MB_ICONSTOP); end; If IsCorrect then begin For I := 0 To StringGrid1.ColCount - 1 Do If (StrToInt(StringGrid1.Cells[I, 0]) > MAX) or (StrToInt(StringGrid1.Cells[I, 0]) < MIN) then Begin IsCorrect := False; Break; End; end; If IsCorrect then Begin N := StringGrid1.ColCount; SetLength(Arr, N); For I := 0 To N - 1 Do Begin Arr[I] := StrToInt(StringGrid1.Cells[I, 0]); End; IsCorrect := CheckArray(Arr); If Not(IsCorrect) then begin For I := 0 To N - 1 Do Begin StringGrid1.Cells[I, 0] := ''; End; end; End; If IsCorrect then try Key := StrToInt (Number.Text); except IsCorrect := False; Number.Text := ''; Answer.Caption := ''; MessageBox(Form1.Handle, Pchar('Не удалось считать число для поиска. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP); end; If IsCorrect then begin Save := Save + 'Искомое число: ' + Number.Text + #13#10; Save := Save + 'Элементы массива: '; For I := 0 To N - 1 Do Begin Save := Save + StringGrid1.Cells[I, 0] + ' '; End; Save := Save + #13#10; Result := NO; Left := 0; Right := StringGrid1.ColCount - 1; BinarySearch(Arr, Result, Key, Left, Right); Answer.Visible := True; If Result = NO then Answer.Caption := 'Искомого элемента в массива нет.' else Answer.Caption := 'Ответ: ' + IntToStr(Result + 1) + ' - ый элемент массива'; N3.Enabled := True; Save := Save + Answer.Caption; end; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := MessageBox(Form1.Handle, 'Вы уверены, что хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION)=ID_YES; end; procedure TForm1.InputArrayClick(Sender: TObject); var N, I, J : Integer; IsCorrect : Boolean; Const WIDE = 82; HEIGHT = 35; begin IsCorrect := True; Try N := StrToInt(ArraySize.Text); Except MessageBox(Form1.Handle, Pchar('Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP); IsCorrect := False; StringGrid1.Visible := False; ArraySize.Text := ''; End; if IsCorrect then Begin Save := Save + 'Размер массива: ' + IntToStr(N) + #13#10; StringGrid1.ColCount := N; //стоковые значения StringGrid1.ScrollBars := ssHorizontal; StringGrid1.Height := 55; StringGrid1.Width := WIDE * 6; If N < 7 then Begin StringGrid1.Height := HEIGHT; StringGrid1.ScrollBars := ssNone; case N of 1: StringGrid1.Width := WIDE; 2: StringGrid1.Width := WIDE * 2 + 1; 3: StringGrid1.Width := WIDE * 3; 4: StringGrid1.Width := WIDE * 4; 5: StringGrid1.Width := WIDE * 5; end; End; for I := 0 to StringGrid1.RowCount - 1 do for J := 0 to StringGrid1.ColCount - 1 do StringGrid1.Cells[J, I] := ''; StringGrid1.Visible := True; End; end; procedure TForm1.N4Click(Sender: TObject); begin Application.MessageBox('Программа рекурсивно осуществляет двоичный поиск элемента в массиве.'#13#10'Размер массива: 1..9'#13#10'Размер элементов массива и числа: -9999..99999'#13#10'P.S. Если в массиве несколько искомых элементов, программа выдаст как ответ тот, что "ближе к середине"', 'Инструкция', 0); end; procedure TForm1.N5Click(Sender: TObject); begin Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0); end; procedure TForm1.NumberChange(Sender: TObject); begin If Length(Number.Text) = 0 then Find.Enabled := False else Find.Enabled := True; Answer.Visible := False; N3.Enabled := False; end; procedure TForm1.NumberKeyPress(Sender: TObject; var Key: Char); begin If (Key = #13) and (Find.Enabled) then Find.Click; If (Not(Key In ['0'..'9', #08, #46, '-'])) Then Key := #0; If Key = '.' then Key := Char(0); If (Length(Number.Text) > 0) and (Key = '-') then Key := #0; end; procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char); Const LIM = 4; // значит 5 - реальный лимит символов begin If (Not(Key In ['0'..'9', #08, #46, '-'])) Then Key := #0; With Sender As TStringGrid Do Begin If (Length(StringGrid1.Cells[Col, Row]) > LIM) then If (Not(Key In [#08, #46])) Then Key := #0; If (Length(StringGrid1.Cells[Col, Row]) > 0) and (Key = '-') then Key := #0; End; end; procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); var I : Integer; IsCorrect : Boolean; Temp : String; begin IsCorrect := True; For I := 0 to StringGrid1.ColCount - 1 do If (Length(StringGrid1.Cells[I, 0]) = 0) Then begin Find.Visible := False; Number.Visible := False; StringNumber.Visible := False; IsCorrect := False; Number.Text := ''; Answer.Visible := False; end; If IsCorrect then begin Find.Visible := True; Number.Visible := True; StringNumber.Visible := True; end; N3.Enabled := False; end; Function CheckFileDataForN(Num: String; MAX, MIN : Integer): Boolean; Var NewNum: Integer; IsCorrect: Boolean; Begin NewNum := 0; IsCorrect := True; Num := Trim (Num); Try NewNum := StrToInt(Num); Except MessageBox(Form1.Handle, Pchar('Не получилось преобразовать N к целочисленному типу данных. Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP); IsCorrect := False; End; If(IsCorrect And ((NewNum > MAX) Or (NewNum < MIN))) Then Begin Num := IntToStr(NewNum); MessageBox(Form1.Handle, Pchar('N вне разрешенного диапазона! Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP); IsCorrect := False; End; CheckFileDataForN := IsCorrect; End; Function Open (): String; Begin With Form1 Do Begin If OpenDialog1.Execute Then Begin Path := OpenDialog1.FileName; IsFileOpen := True; End Else IsFileOpen := False; End; Open := Path; End; Function TakeDataFromFile2(Number2: String; Var FileOutput: TextFile; MAX, MIN : Integer): String; Var IsRight : Boolean; Begin IsRight := True; Try Readln(FileOutput, Number2); Number2 := Trim (Number2); IsRight := CheckFileDataForN(Number2, MAX, MIN); Except End; If(Not(IsRight)) Then TakeDataFromFile2 := '' Else TakeDataFromFile2 := Number2; End; function SeparateString (Str : String) : TStr; Var StrArr : TStr; I, K : Integer; Flag : Boolean; Begin K := 0; SetLength(StrArr, (Str.Length div 2) + 1); For I := 0 To Str.Length div 2 do StrArr[i] := ''; I := 1; While I <= Str.Length Do begin Flag := true; While (Str[I] <> ' ') and (I <= Str.Length) Do Begin StrArr[K] := StrArr[K] + Str[I]; Inc(I); Flag := False; End; If Not(Flag) then Inc(K); If Flag then Inc(I); end; I := 1; K := 0; While Str[I] <> '' Do Begin If Str[I] = ' ' then Inc(K); Inc(I); End; SetLength(StrArr, K + 1); Result := StrArr; End; function ConvertStringToArray (StringGridColCount : Integer; Var FileOutput: TextFile) : TArray; Var I: Integer; Arr : TArray; Str : String; StrArr : TStr; Const MIN = -9999; MAX = 99999; Begin Readln(FileOutput, Str); SetLength(Arr, StringGridColCount); for I := Low(Arr) to High(Arr) do Arr[I] := 0; Str := Trim(Str); StrArr := SeparateString (Str); If (High(StrArr) + 1 <> StringGridColCount) then begin SetLength (Arr, 1); Arr[0] := BAD; MessageBox(Form1.Handle, Pchar('Количество элементов массива не совпадает с заявленным. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP); ConvertStringToArray := Arr; Exit end; try For I := Low(Arr) to High(Arr) do Arr[I] := StrToInt (StrArr[I]); except SetLength (Arr, 1); Arr[0] := BAD; MessageBox(Form1.Handle, Pchar('Не удалось преобразовать исходные данные в целочисленный тип. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP); ConvertStringToArray := Arr; Exit end; For I := Low(Arr) to High(Arr) do If (Arr[I] > MAX) or (Arr[I] < MIN) then begin SetLength (Arr, 1); Arr[0] := BAD; MessageBox(Form1.Handle, Pchar('Исходные данные выходят за границы допустимых. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP); ConvertStringToArray := Arr; end; ConvertStringToArray := Arr; End; procedure TForm1.N2Click(Sender: TObject); Var FileInput: TextFile; Num, I: Integer; Str1, Str2 : String; Arr : TArray; Const MAX_ARR= 9; MIN_ARR = 1; MAX = 99999; MIN = -9999; begin Num := 0; Path := Open; AssignFile(FileInput, Path); Reset(FileInput); If(IsFileOpen) Then Begin Str1 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX_ARR, MIN_ARR); End; if Not(Str1 = '') then Begin ArraySize.Text := Str1; End Else Begin ArraySize.Text := #0; End; if (Str1 <> '') then Begin InputArray.Click; Arr := ConvertStringToArray(StrToInt(Str1), FileInput); if (Arr[0] <> BAD) then Begin for I := Low(Arr) to High(Arr) do Begin StringGrid1.Cells[I, 0] := IntToStr(Arr[I]); End; StringNumber.Visible := True; Number.Visible := True; Find.Visible := True; Str2 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX, MIN); If Not(Str2 = '') then Begin Number.Text := Str2; End Else Begin Number.Text := #0; End; End else Begin for I := Low(Arr) to StrToInt(Str1) - 1 do Begin StringGrid1.Cells[I, 0] := ''; End; ArraySize.Text := ''; End; End; CloseFile(FileInput); end; procedure TForm1.N3Click(Sender: TObject); Var FileOutput: TextFile; IsCorrect : Boolean; begin IsCorrect := True; Path := Open; If (IsFileOpen) Then Begin try AssignFile(FileOutput, Path); Rewrite(FileOutput); Write(FileOutput, Save); except IsCorrect := False; Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP); end; if IsCorrect then Begin Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0); CloseFile(FileOutput); ArraySize.Text := ''; End; End; end; end.