Untitled

altervisi0n

Jun 30th, 2023

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

Delphi 17.33 KB | None | 0 0

raw download clone embed print report

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.

Add Comment

Please, Sign In to add comment