Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit MainUnit;
- 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.ExtCtrls,
- Vcl.Menus;
- type
- TForm1 = class(TForm)
- Description1: TLabel;
- InputM: TEdit;
- InputN: TEdit;
- Create: TButton;
- InfoM: TLabel;
- InfoN: TLabel;
- Matrix: TStringGrid;
- Description2: TLabel;
- Help: TLabel;
- ElementA: TButton;
- ElementB: TButton;
- MaxPath: TButton;
- PathLabel: TLabel;
- Timer1: TTimer;
- MainMenu1: TMainMenu;
- PopupMenu1: TPopupMenu;
- N1: TMenuItem;
- N2: TMenuItem;
- N3: TMenuItem;
- N4: TMenuItem;
- N5: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- procedure InputMKeyPress(Sender: TObject; var Key: Char);
- procedure InputNKeyPress(Sender: TObject; var Key: Char);
- procedure InputMChange(Sender: TObject);
- procedure InputNChange(Sender: TObject);
- procedure CreateClick(Sender: TObject);
- procedure MatrixKeyPress(Sender: TObject; var Key: Char);
- procedure MatrixSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- procedure ElementAClick(Sender: TObject);
- procedure MatrixSelectCell(Sender: TObject; ACol, ARow: Integer;
- var CanSelect: Boolean);
- procedure ElementBClick(Sender: TObject);
- procedure MaxPathClick(Sender: TObject);
- procedure Timer1Timer(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure N5Click(Sender: TObject);
- procedure N4Click(Sender: TObject);
- procedure N2Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- type
- Elements = record
- Elem: Integer;
- I: Byte;
- end;
- TMatrix = array of array of Elements;
- TBoolMatrix = Array of Array of Boolean;
- TPoint = Record
- X, Y: Integer;
- Color: TColor;
- End;
- TPath = Array of TPoint;
- TArray = Array Of Integer;
- TStr = Array of String[5];
- var
- Form1: TForm1;
- Arr: TMatrix;
- IsFileOpen, SelectA, SelectB: Boolean;
- I1, J1, I2, J2, FinishRowPoint, FinishColPoint, StartRowPoint,
- StartColPoint: Integer;
- FilePath: String;
- Path: TPath;
- M, N, I: Integer;
- CellColor: TColor;
- implementation
- {$R *.dfm}
- procedure TForm1.CreateClick(Sender: TObject);
- var
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- try
- M := StrToInt(InputM.Text);
- except
- IsCorrect := False;
- MessageBox(Form1.Handle,
- Pchar('Проверьте поле для ввода кол-ва строк матрицы.'), 'Ошибка',
- MB_ICONSTOP);
- end;
- If IsCorrect then
- begin
- try
- N := StrToInt(InputN.Text);
- except
- IsCorrect := False;
- MessageBox(Form1.Handle,
- Pchar('Проверьте поле для ввода кол-ва столбцов матрицы.'), 'Ошибка',
- MB_ICONSTOP);
- end;
- end;
- If IsCorrect then
- begin
- SetLength(Arr, M, N);
- Matrix.ColCount := N;
- Matrix.RowCount := M;
- Matrix.Visible := True;
- end;
- end;
- procedure TForm1.ElementAClick(Sender: TObject);
- Var
- Str: String;
- begin
- Help.Visible := True;
- SelectA := True;
- Str := Help.Caption;
- end;
- procedure TForm1.ElementBClick(Sender: TObject);
- begin
- Help.Visible := True;
- SelectB := True;
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := Application.MessageBox('Вы действительно хотите выйти?', 'Выход',
- MB_YESNO + MB_ICONQUESTION) = ID_YES;
- end;
- procedure TForm1.InputMChange(Sender: TObject);
- Const
- STR1 = 'Элемент A';
- STR2 = 'Элемент B';
- Var
- I, J: Integer;
- begin
- If (Length(InputM.Text) = 0) or (Length(InputN.Text) = 0) then
- Create.Enabled := False
- else
- Create.Enabled := True;
- For I := 0 to Matrix.ColCount - 1 do
- For J := 0 to Matrix.RowCount - 1 do
- Matrix.Cells[I, J] := '';
- ElementA.Visible := False;
- ElementB.Visible := False;
- ElementA.Caption := STR1;
- ElementB.Caption := STR2;
- Help.Visible := False;
- MaxPath.Visible := False;
- Matrix.Options := Matrix.Options + [GoEditing];
- end;
- procedure TForm1.InputMKeyPress(Sender: TObject; var Key: Char);
- begin
- If (Key = #13) and (Create.Enabled) then
- Create.Click;
- If (Not(Key In ['1' .. '5', #08, #46])) Then
- Key := #0;
- If Key = '.' then
- Key := Char(0);
- end;
- procedure TForm1.InputNChange(Sender: TObject);
- Const
- STR1 = 'Элемент A';
- STR2 = 'Элемент B';
- Var
- I, J: Integer;
- begin
- If (Length(InputM.Text) = 0) or (Length(InputN.Text) = 0) then
- Create.Enabled := False
- else
- Create.Enabled := True;
- For I := 0 to Matrix.ColCount - 1 do
- For J := 0 to Matrix.RowCount - 1 do
- Matrix.Cells[I, J] := '';
- ElementA.Visible := False;
- ElementB.Visible := False;
- ElementA.Caption := STR1;
- ElementB.Caption := STR2;
- Help.Visible := False;
- MaxPath.Visible := False;
- Matrix.Options := Matrix.Options + [GoEditing];
- end;
- procedure TForm1.InputNKeyPress(Sender: TObject; var Key: Char);
- begin
- If (Key = #13) and (Create.Enabled) then
- Create.Click;
- If (Not(Key In ['1' .. '5', #08, #46])) Then
- Key := #0;
- If Key = '.' then
- Key := Char(0);
- end;
- procedure TForm1.MatrixKeyPress(Sender: TObject; var Key: Char);
- Var
- I, J: Integer;
- IsCorrect: Boolean;
- begin
- If (Not(Key In ['0' .. '9', #08, #46, '-'])) Then
- Key := #0;
- If Key = '.' then
- Key := Char(0);
- With Sender As TStringGrid Do
- Begin
- If (Length(Matrix.Cells[Col, Row]) > 2) then
- If (Not(Key In [#08, #46])) Then
- Key := #0;
- If (Length(Matrix.Cells[Col, Row]) > 0) and (Key = '-') then
- Key := #0;
- End;
- end;
- procedure TForm1.MatrixSelectCell(Sender: TObject; ACol, ARow: Integer;
- var CanSelect: Boolean);
- Const
- STR1 = 'Элемент A';
- STR2 = 'Элемент B';
- begin
- If SelectA then
- begin
- I1 := ACol;
- J1 := ARow;
- ElementA.Caption := STR1 + ' [' + IntToStr(I1 + 1) + ', ' +
- IntToStr(J1 + 1) + ']';
- SelectA := False;
- Matrix.Options := Matrix.Options - [GoEditing];
- end;
- If SelectB then
- begin
- I2 := ACol;
- J2 := ARow;
- ElementB.Caption := STR2 + ' [' + IntToStr(I2 + 1) + ', ' +
- IntToStr(J2 + 1) + ']';
- SelectB := False;
- Matrix.Options := Matrix.Options - [GoEditing];
- end;
- If (ElementA.Caption <> STR1) and (ElementB.Caption <> STR2) then
- MaxPath.Visible := True;
- end;
- procedure TForm1.MatrixSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- Var
- I, J: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- For I := 0 to Matrix.ColCount - 1 do
- For J := 0 to Matrix.RowCount - 1 do
- If (Length(Matrix.Cells[I, J]) = 0) Then
- begin
- ElementA.Visible := False;
- ElementB.Visible := False;
- IsCorrect := False;
- Break;
- end;
- If IsCorrect then
- begin
- ElementA.Visible := True;
- ElementB.Visible := True;
- end;
- end;
- Function IsValid(I, J, N, M: Integer; const BoolMatrix: TBoolMatrix): Boolean;
- Begin
- Result := (I >= 0) and (I < N) and (J >= 0) and (J < M) and
- (Not BoolMatrix[I, J]);
- End;
- Function TrueCopy(BoolMatrix: TBoolMatrix): TBoolMatrix;
- Var
- I, J: Integer;
- Begin
- SetLength(Result, Length(BoolMatrix), Length(BoolMatrix[0]));
- For I := Low(BoolMatrix) to High(BoolMatrix) do
- For J := Low(BoolMatrix[I]) to High(BoolMatrix[I]) do
- Begin
- Result[I][J] := BoolMatrix[I][J];
- End;
- End;
- Function FindPaths2(Const Matrix: TMatrix; BoolMatrix: TBoolMatrix;
- Var Path: TPath; X, Y: Integer): Integer;
- Var
- Sum: Integer;
- Max1, Max2, Max3, Max4: Integer;
- Path1, Path2, Path3, Path4: TPath;
- I, J: Integer;
- Begin
- BoolMatrix[X, Y] := True;
- SetLength(Path, Length(Path) + 1);
- Path[High(Path)].X := X;
- Path[High(Path)].Y := Y;
- If (X = FinishRowPoint) and (Y = FinishColPoint) then
- begin
- Result := Matrix[X, Y].Elem;
- end
- else
- Begin
- Path1 := Copy(Path);
- Path2 := Copy(Path);
- Path3 := Copy(Path);
- Path4 := Copy(Path);
- Max1 := Integer.MinValue;
- Max2 := Integer.MinValue;
- Max3 := Integer.MinValue;
- Max4 := Integer.MinValue;
- // move up
- If (IsValid(X - 1, Y, N, M, BoolMatrix)) then
- Begin
- Max1 := FindPaths2(Matrix, TrueCopy(BoolMatrix), Path1, X - 1, Y);
- End;
- // move down
- If (IsValid(X + 1, Y, N, M, BoolMatrix)) then
- Begin
- Max2 := FindPaths2(Matrix, TrueCopy(BoolMatrix), Path2, X + 1, Y);
- End;
- // move left
- If (IsValid(X, Y - 1, N, M, BoolMatrix)) then
- Begin
- Max3 := FindPaths2(Matrix, TrueCopy(BoolMatrix), Path3, X, Y - 1);
- End;
- // move right
- If (IsValid(X, Y + 1, N, M, BoolMatrix)) then
- Begin
- Max4 := FindPaths2(Matrix, TrueCopy(BoolMatrix), Path4, X, Y + 1);
- End;
- Path := Path1;
- If (Max2 > Max1) then
- Begin
- Path := Path2;
- Max1 := Max2;
- end;
- If (Max3 > Max1) then
- Begin
- Path := Path3;
- Max1 := Max3;
- End;
- If (Max4 > Max1) then
- Begin
- Path := Path4;
- Max1 := Max4;
- End;
- If (Max1 = Integer.MinValue) then
- Result := Max1
- Else
- Result := Max1 + Matrix[X, Y].Elem;
- End;
- End;
- procedure TForm1.MaxPathClick(Sender: TObject);
- Var
- I, J, Max: Integer;
- IsCorrect: Boolean;
- Vertex: Char;
- Index: Byte;
- BoolMatrix: TBoolMatrix;
- Const
- STR1 = 'Элемент A';
- STR2 = 'Элемент B';
- begin
- IsCorrect := True;
- Index := 1;
- If IsCorrect then
- begin
- try
- For I := 0 to Matrix.ColCount - 1 do
- For J := 0 to Matrix.RowCount - 1 do
- Begin
- Arr[J, I].Elem := StrToInt(Matrix.Cells[I, J]);
- Arr[J, I].I := Index;
- Inc(Index);
- End;
- except
- IsCorrect := False;
- MessageBox(Form1.Handle,
- Pchar('Проверьте содержимое матрицы. В клеточках должны быть только целочисленные значения.'),
- 'Ошибка', MB_ICONSTOP);
- ElementA.Visible := False;
- ElementB.Visible := False;
- ElementA.Caption := STR1;
- ElementB.Caption := STR2;
- Help.Visible := False;
- MaxPath.Visible := False;
- Matrix.Options := Matrix.Options + [GoEditing];
- end;
- end;
- If IsCorrect then
- begin
- SetLength(BoolMatrix, M, N);
- For I := 0 to M - 1 do
- Begin
- For J := 0 to N - 1 do
- Begin
- BoolMatrix[I, J] := False;
- End;
- End;
- SetLength(Path, 0);
- FinishRowPoint := I2;
- FinishColPoint := J2;
- StartRowPoint := I1;
- StartColPoint := J1;
- Max := FindPaths2(Arr, BoolMatrix, Path, StartRowPoint, StartColPoint);
- For I := 0 to Matrix.ColCount - 1 do
- For J := 0 to Matrix.RowCount - 1 do
- Begin
- Matrix.Cells[I, J] := '';
- End;
- PathLabel.Caption := PathLabel.Caption + IntToStr(Max);
- PathLabel.Visible := True;
- I := 0;
- Timer1.Enabled := True;
- end;
- end;
- Function Open(): String;
- Begin
- With Form1 Do
- Begin
- If OpenDialog1.Execute Then
- Begin
- FilePath := OpenDialog1.FileName;
- IsFileOpen := True;
- End
- Else
- IsFileOpen := False;
- End;
- Open := FilePath;
- 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 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 = -99;
- Max = 999;
- BAD = 1000;
- 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, J: Integer;
- STR1, STR2: String;
- Arr: TArray;
- IsCorrect: Boolean;
- Const
- MAX_ARR = 5;
- MIN_ARR = 1;
- Max = 999;
- MIN = -99;
- BAD = 1000;
- begin
- Num := 0;
- FilePath := Open();
- AssignFile(FileInput, FilePath);
- Reset(FileInput);
- If (IsFileOpen) Then
- Begin
- STR1 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX_ARR, MIN_ARR);
- End;
- if Not(STR1 = '') then
- Begin
- STR2 := TakeDataFromFile2(IntToStr(Num), FileInput, MAX_ARR, MIN_ARR)
- End;
- if ((STR1 <> '') and (STR2 <> '')) then
- begin
- InputM.Text := STR1;
- InputN.Text := STR2;
- M := StrToInt(STR1);
- N := StrToInt(STR2);
- Create.Click;
- IsCorrect := True;
- For J := 0 To M - 1 Do
- Begin
- Arr := ConvertStringToArray(StrToInt(STR2), FileInput);
- if (Arr[0] <> BAD) then
- Begin
- for I := Low(Arr) to High(Arr) do
- Begin
- Matrix.Cells[I, J] := IntToStr(Arr[I]);
- End;
- End
- else
- Begin
- for I := Low(Arr) to StrToInt(STR1) - 1 do
- Begin
- Matrix.Cells[I, J] := '';
- IsCorrect := False;
- End;
- End;
- End;
- If IsCorrect then
- begin
- ElementA.Visible := True;
- ElementB.Visible := True;
- end;
- end;
- end;
- procedure TForm1.N4Click(Sender: TObject);
- begin
- Application.MessageBox
- ('Дана матрица a(m,n). Найти в ней путь от элемента a[i1,j1] до элемента a[i2,j2] с максимальной суммой. Ходить можно по горизонталям и вертикалям. Каждый элемент матрицы может входить в путь не более одного раза. Выделить этот путь в матрице!',
- 'Задание', MB_ICONINFORMATION);
- end;
- procedure TForm1.N5Click(Sender: TObject);
- begin
- Application.MessageBox('Студент группы 251004 Асепков Данила', 'О разрабочике', MB_ICONINFORMATION);
- end;
- procedure TForm1.Timer1Timer(Sender: TObject);
- begin
- If I <= High(Path) then
- begin
- Matrix.Cells[Path[I].X, Path[I].Y] :=
- IntToStr(Arr[Path[I].X, Path[I].Y].Elem);
- Inc(I);
- end
- else
- Timer1.Enabled := False;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement