Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement