Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Main;
- 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.Grids,
- Vcl.ExtCtrls;
- type
- TForm1 = class(TForm)
- MainMenu1: TMainMenu;
- FileButton: TMenuItem;
- AboutButton: TMenuItem;
- ReadButton: TMenuItem;
- SaveButton: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- Start: TButton;
- SizeEdit: TEdit;
- SizeLabel: TLabel;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- Label5: TLabel;
- Label6: TLabel;
- Label7: TLabel;
- Label8: TLabel;
- Label9: TLabel;
- Label10: TLabel;
- Matrix1: TStringGrid;
- Matrix2: TStringGrid;
- Label11: TLabel;
- Label12: TLabel;
- Label13: TLabel;
- Label14: TLabel;
- Label15: TLabel;
- Label16: TLabel;
- Label17: TLabel;
- Label18: TLabel;
- Label19: TLabel;
- Label20: TLabel;
- Label21: TLabel;
- Label22: TLabel;
- Label23: TLabel;
- Label24: TLabel;
- Label25: TLabel;
- Label26: TLabel;
- Label27: TLabel;
- Label28: TLabel;
- Label29: TLabel;
- Label30: TLabel;
- Matrix1Label: TLabel;
- Matrix2Label: TLabel;
- Check: TButton;
- Label31: TLabel;
- Label32: TLabel;
- Label33: TLabel;
- Label34: TLabel;
- Label35: TLabel;
- Label36: TLabel;
- Label37: TLabel;
- Label38: TLabel;
- Label39: TLabel;
- Label40: TLabel;
- Label41: TLabel;
- Label42: TLabel;
- Label43: TLabel;
- Label44: TLabel;
- Label45: TLabel;
- Label46: TLabel;
- Label47: TLabel;
- Label48: TLabel;
- Label49: TLabel;
- Label50: TLabel;
- Label51: TLabel;
- Label52: TLabel;
- Label53: TLabel;
- Label54: TLabel;
- Label55: TLabel;
- Label56: TLabel;
- Label57: TLabel;
- Label58: TLabel;
- Label59: TLabel;
- Label60: TLabel;
- procedure AboutButtonClick(Sender: TObject);
- procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- procedure EditChange(Sender: TObject);
- procedure ReadButtonClick(Sender: TObject);
- procedure SaveButtonClick(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure EditKeyPress(Sender: TObject; var Key: Char);
- procedure StartClick(Sender: TObject);
- procedure CheckClick(Sender: TObject);
- procedure Matrix1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure Matrix2MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure FillMatrixs();
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- {$R *.dfm}
- Type
- TMatrix = array[0..9, 0..9] of Byte;
- var
- Form1: TForm1;
- N, Size: Integer;
- Matrix11, Matrix22: TMatrix;
- P: array[0..9] of Byte;
- GlobalFlag: Boolean;
- Ans: String;
- const
- MIN_SIZE = 2;
- MAX_SIZE = 10;
- implementation
- procedure ShowAns(Ans: String); stdcall; external 'MyDll.dll';
- procedure TForm1.EditChange(Sender: TObject);
- var
- IsValid1: Boolean;
- i: Integer;
- begin
- IsValid1 := False;
- GlobalFlag := False;
- SaveButton.Enabled := False;
- Matrix1.Visible := False;
- Matrix2.Visible := False;
- Matrix1Label.Visible := False;
- Matrix2Label.Visible := False;
- Check.Visible := False;
- for i := 1 to 10 do
- begin
- TLabel(FindComponent('Label' + IntToStr(i))).Visible := False;
- TLabel(FindComponent('Label' + IntToStr(10 + i))).Visible := False;
- TLabel(FindComponent('Label' + IntToStr(20 + i))).Visible := False;
- TLabel(FindComponent('Label' + IntToStr(30 + i))).Visible := False;
- end;
- PatBlt(Form1.Canvas.Handle, 0, 470, Form1.ClientWidth, Form1.ClientHeight, PATCOPY);
- if SizeEdit.Text <> '' then
- IsValid1 := True;
- if IsValid1 then
- Start.Enabled := True
- else
- Start.Enabled := False;
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := MessageDlg('Вы уверены, что хотите выйти из программы?' +
- #10#13 + 'Все несохраненные данные будут утеряны.',
- mtConfirmation, [mbYes, mbNo], 0) = mrYes;
- end;
- procedure TForm1.Matrix1MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- ACol, ARow: Integer;
- begin
- Matrix1.MouseToCell(X, Y, ACol, ARow);
- if Matrix1.Cells[ACol, ARow] = '0' then
- begin
- Matrix1.Cells[ACol, ARow] := '1';
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Top);
- end
- else
- begin
- Matrix1.Cells[ACol, ARow] := '0';
- Canvas.Pen.Color := Form1.Color;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(ACol + 41))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(ARow + 41))).Top);
- end;
- end;
- procedure TForm1.Matrix2MouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- ACol, ARow: Integer;
- begin
- Matrix2.MouseToCell(X, Y, ACol, ARow);
- if Matrix2.Cells[ACol, ARow] = '0' then
- begin
- GlobalFlag := False;
- Matrix2.Cells[ACol, ARow] := '1';
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Top);
- end
- else
- begin
- GlobalFlag := False;
- Matrix2.Cells[ACol, ARow] := '0';
- Canvas.Pen.Color := Form1.Color;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(ACol + 51))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(ARow + 51))).Top);
- end;
- end;
- procedure TForm1.FillMatrixs();
- var
- i, j: Integer;
- begin
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- begin
- Matrix11[i, j] := StrToInt(Matrix1.Cells[j, i]);
- Matrix22[i, j] := StrToInt(Matrix2.Cells[j, i]);
- end;
- end;
- procedure CheckForIzomorph();
- var
- i, j: Integer;
- Flag: Boolean;
- begin
- Flag := True;
- for i := 0 to n - 1 do
- if Flag then
- for j := 0 to n - 1 do
- if Matrix11[i, j] <> Matrix22[p[i], p[j]] then
- Flag := False;
- GlobalFlag := Flag;
- end;
- procedure swap(x, y: longint);
- var c: Integer;
- begin
- c := p[x];
- p[x] := p[y];
- p[y] := c;
- end;
- procedure next_perm(k, n: longint);
- var i: longint;
- begin
- if GlobalFlag then
- exit;
- if k = n then
- begin
- CheckForIzomorph;
- exit;
- end;
- for i := k to n do
- begin
- swap(k, i);
- next_perm(k + 1, n);
- swap(k, i);
- end;
- end;
- procedure TForm1.CheckClick(Sender: TObject);
- var
- i, j: Integer;
- s: string;
- begin
- FillMatrixs;
- for i := 0 to n - 1 do
- P[i] := i;
- next_perm(0, n - 1);
- if GlobalFlag then
- Ans := 'Графы изоморфны'
- else
- Ans := 'Графы не изоморфны';
- ShowAns(Ans);
- SaveButton.Enabled := True;
- end;
- procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
- const
- Digit: set of Char = ['0'..'9', #8];
- begin
- with (Sender as TEdit) do
- begin
- if not(Key in Digit) then
- Key := #0;
- end;
- SaveButton.Enabled := False;
- end;
- procedure TForm1.AboutButtonClick(Sender: TObject);
- var
- Task: String;
- begin
- Task := 'Данная программа проверяет два графа на изоморфность. Графы заданы матрицами смежности' + #10#13;
- Task := Task + 'Автор - Пестунов Илья, гр. 051007';
- MessageDlg(Task, mtInformation, [mbOK], 0);
- end;
- procedure TForm1.ReadButtonClick(Sender: TObject);
- var
- MyFile: TextFile;
- i, j, m: Integer;
- begin
- SizeEdit.Text := '';
- Check.Visible := False;
- Matrix1.Visible := False;
- if OpenDialog1.Execute then
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- Read(MyFile, N);
- SizeEdit.Text := IntToStr(N);
- Form1.Start.Click;
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- begin
- Read(MyFile, m);
- Matrix1.Cells[j, i] := IntToStr(m);
- if m = 1 then
- begin
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(i + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(i + 41))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(j + 41))).Left,
- TLabel(FindComponent('Label' + IntToStr(j + 41))).Top);
- end;
- end;
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- begin
- Read(MyFile, m);
- Matrix2.Cells[j, i] := IntToStr(m);
- if m = 1 then
- begin
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 2;
- Canvas.MoveTo(TLabel(FindComponent('Label' + IntToStr(i + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(i + 51))).Top);
- Canvas.LineTo(TLabel(FindComponent('Label' + IntToStr(j + 51))).Left,
- TLabel(FindComponent('Label' + IntToStr(j + 51))).Top);
- end;
- end;
- CloseFile(MyFile);
- end;
- end;
- procedure TForm1.SaveButtonClick(Sender: TObject);
- var
- MyFile: TextFile;
- i, j: Integer;
- begin
- if SaveDialog1.Execute then
- begin
- AssignFile(MyFile, SaveDialog1.FileName);
- Rewrite(MyFile);
- Writeln(MyFile, Ans);
- CloseFile(MyFile);
- MessageDlg('Результат успешно сохранён', mtCustom, [mbOK], 0);
- end;
- end;
- procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- var
- IsValid: Boolean;
- N, i, Err, j, m: Integer;
- MyFile: TextFile;
- Check: String;
- const
- Digit: set of Char = ['1'..'9', '0', ' ', '-'];
- begin
- IsValid := True;
- N := Length(OpenDialog1.FileName);
- if (OpenDialog1.FileName[N] = 't') and (OpenDialog1.FileName[N - 1] = 'x')
- and (OpenDialog1.FileName[N - 2] = 't') then
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- Read(MyFile, Check);
- CloseFile(MyFile);
- if Length(Check) = 0 then
- begin
- MessageDlg('Файл пуст', mtWarning, [mbOK], 0);
- IsValid := False;
- end
- else
- begin
- AssignFile(MyFile, OpenDialog1.FileName);
- Reset(MyFile);
- try
- Readln(MyFile, N);
- except
- IsValid := False;
- MessageDlg('Кол-во вершин должно быть натуральным от 2 до 10', mtWarning, [mbOK], 0);
- end;
- if (IsValid) and ((N < MIN_SIZE) or (N > MAX_SIZE)) then
- begin
- IsValid := False;
- MessageDlg('Кол-во вершин должно быть натуральным от 2 до 10', mtError, [mbOK], 0);
- end;
- if IsValid then
- for i := 0 to n - 1 do
- if IsValid then
- for j := 0 to n - 1 do
- begin
- try
- Read(MyFile, m);
- if (m <> 0) and (m <> 1) then
- begin
- IsValid := False;
- MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
- break
- end;
- except
- IsValid := False;
- MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
- end;
- end;
- if IsValid then
- for i := 0 to n - 1 do
- if IsValid then
- for j := 0 to n - 1 do
- begin
- try
- Read(MyFile, m);
- if (m <> 0) and (m <> 1) then
- begin
- IsValid := False;
- MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
- break;
- end;
- except
- IsValid := False;
- MessageDlg('Матрица должна содержать 0 и 1', mtWarning, [mbOK], 0);
- end;
- end;
- CloseFile(MyFile);
- end;
- end
- else
- begin
- MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
- IsValid := False;
- end;
- if not(IsValid) then
- CanClose := False;
- end;
- procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
- var
- N: Integer;
- begin
- N := Length(SaveDialog1.FileName);
- if (SaveDialog1.FileName[N] = 't') and (SaveDialog1.FileName[N - 1] = 'x')
- and (SaveDialog1.FileName[N - 2] = 't') then
- CanClose := True
- else
- begin
- CanClose := False;
- MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
- end;
- end;
- procedure TForm1.StartClick(Sender: TObject);
- var
- Err, i, j, Radius: Integer;
- begin
- Val(SizeEdit.Text, n, Err);
- if (N < MIN_SIZE) or (N > MAX_SIZE) then
- MessageDlg('Введите кол-во вершин в указанном диапазоне', mtError, [mbOK], 0)
- else
- begin
- SaveButton.Enabled := False;
- Matrix1.RowCount := n;
- Matrix1.ColCount := n;
- Matrix1.Width := Matrix1.DefaultColWidth * n + (n * 3);
- Matrix1.Height := Matrix1.DefaultRowHeight * n + (n * 3);
- Matrix2.RowCount := n;
- Matrix2.ColCount := n;
- Matrix2.Width := Matrix2.DefaultColWidth * n + (n * 3);
- Matrix2.Height := Matrix2.DefaultRowHeight * n + (n * 3);
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- Matrix1.Cells[i, j] := '0';
- for i := 0 to n - 1 do
- for j := 0 to n - 1 do
- Matrix2.Cells[i, j] := '0';
- Matrix1.Visible := True;
- Matrix1Label.Visible := True;
- Matrix2.Visible := True;
- Matrix2Label.Visible := True;
- PatBlt(Form1.Canvas.Handle, 0, 470, Form1.ClientWidth, Form1.ClientHeight, PATCOPY);
- for i := 1 to n do
- begin
- TLabel(FindComponent('Label' + IntToStr(i))).Visible := True;
- TLabel(FindComponent('Label' + IntToStr(i + 10))).Visible := True;
- TLabel(FindComponent('Label' + IntToStr(i + 20))).Visible := True;
- TLabel(FindComponent('Label' + IntToStr(i + 30))).Visible := True;
- Radius := 5;
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 2;
- Canvas.Ellipse(TLabel(FindComponent('Label' + IntToStr(i + 40))).Left - TLabel(FindComponent('Label' + IntToStr(i + 40))).Width,
- TLabel(FindComponent('Label' + IntToStr(i + 40))).Top - TLabel(FindComponent('Label' + IntToStr(i + 40))).Height + Radius,
- TLabel(FindComponent('Label' + IntToStr(i + 40))).Left + TLabel(FindComponent('Label' + IntToStr(i + 40))).Width + Radius,
- TLabel(FindComponent('Label' + IntToStr(i + 40))).Top + TLabel(FindComponent('Label' + IntToStr(i + 40))).Height+ Radius);
- Canvas.TextOut(TLabel(FindComponent('Label' + IntToStr(i + 40))).Left,
- TLabel(FindComponent('Label' + IntToStr(i + 40))).Top,
- IntToStr(i));
- Canvas.Ellipse(TLabel(FindComponent('Label' + IntToStr(i + 50))).Left - TLabel(FindComponent('Label' + IntToStr(i + 50))).Width,
- TLabel(FindComponent('Label' + IntToStr(i + 50))).Top - TLabel(FindComponent('Label' + IntToStr(i + 50))).Height + Radius,
- TLabel(FindComponent('Label' + IntToStr(i + 50))).Left + TLabel(FindComponent('Label' + IntToStr(i + 50))).Width + Radius,
- TLabel(FindComponent('Label' + IntToStr(i + 50))).Top + TLabel(FindComponent('Label' + IntToStr(i + 50))).Height+ Radius);
- Canvas.TextOut(TLabel(FindComponent('Label' + IntToStr(i + 50))).Left,
- TLabel(FindComponent('Label' + IntToStr(i + 50))).Top,
- IntToStr(i));
- end;
- Check.Visible := True;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement