Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit lab6_2;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls,
- Vcl.Samples.Spin, Vcl.Grids;
- type
- TCoordinate = Array[0..1] of Integer;
- TMatrix = Array of Array of Integer;
- TMainForm = class(TForm)
- FieldSTRG: TStringGrid;
- Calculate: TButton;
- SizeSpinEdit: TSpinEdit;
- Label2: TLabel;
- MainMenu1: TMainMenu;
- N1: TMenuItem;
- OpenFileButton: TMenuItem;
- SaveFileButton: TMenuItem;
- SaveFileDialog: TSaveDialog;
- OpenFileDialog: TOpenDialog;
- Label1: TLabel;
- N2: TMenuItem;
- FirstXEdit: TEdit;
- FirstYEdit: TEdit;
- StartLabel: TLabel;
- FinishLabel: TLabel;
- SecXEdit: TEdit;
- SecYEdit: TEdit;
- FinalLabel: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure FieldSTRGSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- procedure SizeSpinEditChange(Sender: TObject);
- procedure N2Click(Sender: TObject);
- Procedure CoordinatesEditChange(Sender: TObject);
- procedure OpenFileButtonClick(Sender: TObject);
- procedure N1Click(Sender: TObject);
- procedure CalculateClick(Sender: TObject);
- procedure SaveFileButtonClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- MainForm: TMainForm;
- Checked: Array of array of boolean;
- Matrix: TMatrix;
- WayStr: string;
- FX, FY: Integer;
- WasFound: Boolean;
- implementation
- {$R *.dfm}
- procedure FillMatrix();
- Var
- I, J, N: Integer;
- Begin
- N := MainForm.SizeSpinEdit.Value;
- for I := 1 to N do
- MainForm.FieldSTRG.Cells[0, I] := IntToStr(I);
- for I := 1 to N do
- MainForm.FieldSTRG.Cells[I, 0] := IntToStr(I);
- for I := 1 to N do
- for J := 1 to N do
- MainForm.FieldSTRG.Cells[J, I] := '0';
- End;
- procedure FillChecked();
- var
- I, J, Size: Integer;
- Begin
- Size := MainForm.FieldSTRG.ColCount - 1;
- SetLength(Checked, Size, Size);
- for I := 0 to Size - 1 do
- for J := 0 to Size - 1 do
- Checked[I, J] := False;
- End;
- procedure TMainForm.FormCreate(Sender: TObject);
- var
- I, J: Integer;
- begin
- MainForm.Height := 500;
- FieldSTRG.Height := 280;
- FieldSTRG.Width := 280;
- FillMatrix();
- FillChecked();
- end;
- procedure TMainForm.N1Click(Sender: TObject);
- begin
- SaveFileButton.Enabled := Not (FinalLabel.Caption = '');
- end;
- procedure TMainForm.N2Click(Sender: TObject);
- begin
- ShowMessage('Программа позволяет проложить путь каравана из точки'+
- '(X1, Y1) в точку (X2, Y2), Караван может двигаться только по местности'+
- ' параллельно осям Ох и Оу между центрами квадратов и только '+
- 'в соседний квадрат с меньшей высотой. '+ #10 +
- 'Вводить высоту в диапозоне от -999 до 999');
- end;
- function CheckFile(Path: String): Boolean;
- var
- FileToCheck: TextFile;
- N, I, J, Num: Integer;
- begin
- AssignFile(FileToCheck, Path);
- Reset(FileToCheck);
- CheckFile := true;
- try
- Readln(FileToCheck, N);
- except
- CheckFile := false;
- end;
- if ((N < 2) or (N > 7)) then
- CheckFile := False;
- for J := 0 to N - 1 do
- Begin
- for I := 0 to N - 1 do
- Begin
- try
- Read(FileToCheck, Num);
- except
- CheckFile := false;
- end;
- if ((Num < -999) or (Num > 999)) then
- CheckFile := False;
- Read(FileToCheck);
- End;
- Readln(FileToCheck);
- End;
- CloseFile(FileToCheck);
- end;
- procedure TMainForm.OpenFileButtonClick(Sender: TObject);
- var
- InputFile: TextFile;
- Num, N, I, J: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- if OpenFileDialog.Execute then
- begin
- if CheckFile(OpenFileDialog.FileName) then
- begin
- AssignFile(InputFile, OpenFileDialog.FileName);
- Reset(InputFile);
- Readln(InputFile, N);
- SizeSpinEdit.Value := N;
- SetLength(Matrix, N, N);
- for J := 0 to N - 1 do
- Begin
- for I := 0 to N - 1 do
- Begin
- Read(InputFile, Matrix[J, I]);
- Read(InputFile);
- End;
- Readln(InputFile);
- End;
- CloseFile(InputFile);
- for J := 1 to N do
- for I := 1 to N do
- FieldSTRG.Cells[I, J] := IntToStr(Matrix[J - 1, I - 1]);
- ShowMessage('Данные из файла успешно загружены');
- end
- else
- Begin
- ShowMessage('Данные в файле некорректны. Введите числа.');
- IsCorrect := False
- End;
- if IsCorrect = True then
- Begin
- Calculate.Click;
- End;
- end;
- end;
- procedure CheckData();
- Var
- I, J, Num: Integer;
- Begin
- for I := 1 to MainForm.SizeSpinEdit.Value do
- for J := 1 to MainForm.SizeSpinEdit.Value do
- Begin
- try
- Num := StrToInt(MainForm.FieldSTRG.Cells[I, J]);
- except
- MainForm.Calculate.Enabled := false;
- end;
- if (Num > 999) Or (Num < -999) then
- MainForm.Calculate.Enabled := false;
- End;
- End;
- procedure GetCoordinates(X1, Y1: Integer);
- Begin
- X1 := StrToInt(MainForm.FirstXEdit.Text);
- Y1 := StrToInt(MainForm.FirstYEdit.Text);
- FX := StrToInt(MainForm.SecXEdit.Text);
- FY := StrToInt(MainForm.SecYEdit.Text);
- End;
- Function FindIfExists(X, Y: Integer): Boolean;
- Begin
- if (X > MainForm.SizeSpinEdit.Value) or (Y > MainForm.SizeSpinEdit.Value) then
- FindIfExists := False;
- if (X or Y) < 1 then
- FindIfExists := False;
- FindIfExists := True;
- End;
- Function WasChecked(X, Y: Integer): Boolean;
- Begin
- WasChecked := Checked[X - 1,Y - 1];
- End;
- Function FindIfPossible(X1, Y1, X2, Y2: Integer): Boolean;
- Var
- FHigh, SHeigh: Integer;
- Begin
- FHigh := StrToInt(MainForm.FieldSTRG.Cells[X1, Y1]);
- SHeigh := StrToInt(MainForm.FieldSTRG.Cells[X2, Y2]);
- if FHigh > Sheigh then
- FindIfPossible := True
- Else
- FindIfPossible := False;
- End;
- procedure FindWay(X, Y: Integer);
- Begin
- Checked[X - 1, Y - 1] := True;
- if ((X = FX) and (Y = FY)) then
- Begin
- WasFound := True;
- WayStr := WayStr + '[' + IntToStr(X) + '|' + IntToStr(Y) + ']';
- End;
- if Not(WasFound) then
- Begin
- if (((not(WasChecked(X - 1, Y)) and FindIfPossible(X, Y, X - 1, Y)) or ((WasChecked(X - 1, Y)) and (not FindIfPossible(X, Y, X - 1, Y)))) and FindIfExists(X - 1, Y) ) then
- Begin
- FindWay(X - 1, Y);
- End;
- if ((not(WasChecked(X + 1, Y)) and FindIfPossible(X, Y, X + 1, Y)) or ((WasChecked(X + 1, Y)) and (not FindIfPossible(X, Y, X + 1, Y))) and FindIfExists(X + 1, Y)) then
- Begin
- FindWay(X + 1, Y);
- End;
- if ((((not(WasChecked(X, Y + 1)) and FindIfPossible(X, Y, X, Y + 1)) or ((WasChecked(X,Y + 1) and (not FindIfPossible(X, Y, X, Y + 1))))) and FindIfExists(X, Y+1))) then
- Begin
- FindWay(X, Y + 1);
- End;
- if (((not(WasChecked(X, Y - 1)) and FindIfPossible(X, Y, X, Y - 1)) or ((WasChecked(X,Y - 1)) and (not FindIfPossible(X, Y, X, Y - 1)))) and FindIfExists(X, Y - 1) ) then
- Begin
- FindWay(X, Y - 1);
- End;
- End;
- if Not WasFound then
- WayStr := WayStr + '[' + IntToStr(X) + '|' + IntToStr(Y - 1) + ']';
- End;
- procedure TMainForm.CalculateClick(Sender: TObject);
- var
- X1, Y1, X2, Y2: Integer;
- begin
- WasFound := False;
- FinalLabel.Caption := '';
- X1 := StrToInt(MainForm.FirstXEdit.Text);
- Y1 := StrToInt(MainForm.FirstYEdit.Text);
- FX := StrToInt(MainForm.SecXEdit.Text);
- FY := StrToInt(MainForm.SecYEdit.Text);
- WayStr := '[' + IntToStr(X1) + '|' + IntToStr(Y1) + ']';
- FillChecked();
- FindWay(X1, Y1);
- if Not(WasFound) then
- WayStr := 'Путь не найден';
- FinalLabel.Caption := WayStr;
- end;
- Procedure TMainForm.CoordinatesEditChange(Sender: TObject);
- Var
- Num, Finish: Integer;
- Begin
- Finish := MainForm.SizeSpinEdit.Value;
- Calculate.Enabled := True;
- try
- Num := StrToInt(FirstXEdit.Text);
- except
- Calculate.Enabled := false;
- end;
- if (Num > Finish) Or (Num < 1) then
- Calculate.Enabled := false;
- try
- Num := StrToInt(FirstYEdit.Text);
- except
- Calculate.Enabled := false;
- end;
- if (Num > Finish) Or (Num < 1) then
- Calculate.Enabled := false;
- try
- Num := StrToInt(SecXEdit.Text);
- except
- Calculate.Enabled := false;
- end;
- if (Num > Finish) Or (Num < 1) then
- Calculate.Enabled := false;
- try
- Num := StrToInt(SecYEdit.Text);
- except
- Calculate.Enabled := false;
- end;
- if (Num > Finish) Or (Num < 1) then
- Calculate.Enabled := false;
- CheckData();
- End;
- Function IsFileExist(Address: String): Boolean; export;
- Var
- IsCorrect: Boolean;
- Begin
- If FileExists(Address) Then
- IsCorrect := True
- Else
- IsCorrect := False;
- IsFileExist := IsCorrect;
- End;
- procedure TMainForm.SaveFileButtonClick(Sender: TObject);
- var
- OutputFile: TextFile;
- begin
- if SaveFileDialog.Execute() then
- Begin
- if IsFileExist(SaveFileDialog.FileName) then
- Begin
- AssignFile(OutputFile, SaveFileDialog.FileName);
- Rewrite(OutputFile);
- Writeln(OutputFile, FinalLabel.Caption);
- CloseFile(OutputFile);
- ShowMessage('Успешно сохранено');
- End
- else
- ShowMessage('Файл не существует.')
- End;
- end;
- procedure TMainForm.SizeSpinEditChange(Sender: TObject);
- begin
- FillMatrix();
- FieldSTRG.Height := (SizeSpinEdit.Value + 1) * 40;
- FieldSTRG.Width := (SizeSpinEdit.Value + 1) * 40;
- FieldSTRG.ColCount := SizeSpinEdit.Value + 1;
- FieldSTRG.RowCount := SizeSpinEdit.Value + 1;
- MainForm.CoordinatesEditChange(Sender);
- end;
- procedure TMainForm.FieldSTRGSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- begin
- MainForm.Calculate.Enabled := True;
- CheckData();
- CoordinatesEditChange(Sender);
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement