Unit UnitVCLMain;

Interface

Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.StdCtrls,
    Vcl.Buttons,
    Vcl.ExtCtrls,
    Vcl.Grids,
    Vcl.WinXCtrls,
    System.Actions,
    Vcl.ActnList,
    System.ImageList,
    Vcl.ImgList,
    Vcl.VirtualImageList,
    ClipBrd;

Type
    TMatrix = Array Of Array Of Integer;

    TLabeledEdit = Class(Vcl.ExtCtrls.TLabeledEdit)
    Protected
        Procedure WMPaste(Var Msg: TMessage); Message WM_PASTE;
    End;

    TfrmMain = Class(TForm)
        PTop: TPanel;
        SdbtMenu: TSpeedButton;
        LbWelcome: TLabel;
        PClient: TPanel;
        LbTaskInfo: TLabel;
        LbMatrixRequirement: TLabel;
        SplvMenu: TSplitView;
        SdbtExit: TSpeedButton;
        SdbtSaveToFile: TSpeedButton;
        SdbtOpenFromFile: TSpeedButton;
        SdbtStart: TSpeedButton;
        SdbtHelp: TSpeedButton;
        SdbtAboutDeveloper: TSpeedButton;
        StrgrMatrix: TStringGrid;
        BalloonHint: TBalloonHint;
        OpdOpenFromFileDialog: TOpenDialog;
        SvdSaveToFileDialog: TSaveDialog;
        VilImages_48: TVirtualImageList;
        LbeNodesRequirement: TLabeledEdit;
        LbGraph: TLabel;
        BtContinue: TButton;
        BtFind: TButton;
        LbIncorrectInput: TLabel;
        BtBack: TButton;
        Procedure SdbtMenuClick(Sender: TObject);
        Procedure SdbtExitClick(Sender: TObject);
        Procedure SdbtHelpClick(Sender: TObject);
        Procedure SdbtAboutDeveloperClick(Sender: TObject);
        Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
        Procedure SdbtOpenFromFileClick(Sender: TObject);
        Procedure SdbtSaveToFileClick(Sender: TObject);
        Procedure LbeNodesRequirementChange(Sender: TObject);
        Procedure BtContinueClick(Sender: TObject);
        Procedure FormCreate(Sender: TObject);
        Procedure BtBackClick(Sender: TObject);
        Procedure BtFindClick(Sender: TObject);
    Private
        IsFirstMatrixCorrect: Boolean;
        Function CheckInput(): Boolean;
    Public
        FirstAdjacencyMatrix: TMatrix;
        SecondAdjacencyMatrix: TMatrix;
    End;

Var
    FrmMain: TfrmMain;

Implementation

{$R *.dfm}

Uses UnitData,
    UnitVCLVisualization;

{ бэк }

Function TfrmMain.CheckInput: Boolean;
Const
    MIN_VALUE = 0;
    MAX_VALUE = 1;
Var
    I, J: Integer;
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    For I := 1 To StrgrMatrix.ColCount - 1 Do
        For J := 1 To StrgrMatrix.RowCount - 1 Do
            Try
                If (StrToInt(StrgrMatrix.Cells[I, J]) < MIN_VALUE) Or (StrToInt(StrgrMatrix.Cells[I, J]) > MAX_VALUE) Or
                    (Length(StrgrMatrix.Cells[I, J]) > 1) Then
                    IsCorrect := False;
            Except
                Application.MessageBox('Матрица задана некорректно!', 'Ошибка', MB_ICONERROR);
                IsCorrect := False;
                Exit;
            End;
    CheckInput := IsCorrect;
End;

Function IsFileCorrect(Path: String): Boolean;
Const
    MIN_SIZE = 2;
    MAX_SIZE = 10;
Var
    InputFile: TextFile;
    IsCorrect: Boolean;
    Size, I, J: Integer;
    Matrix: TMatrix;
Begin
    AssignFile(InputFile, Path);
    IsCorrect := True;

    Try
        Try
            Reset(InputFile);
            Readln(InputFile, Size);

            If (Size < MIN_SIZE) Or (Size > MAX_SIZE) Then
                IsCorrect := False
            Else
            Begin
                SetLength(Matrix, Size, Size);
                I := 0;

                While (IsCorrect) And (I < Size) Do
                Begin
                    J := 0;

                    While (IsCorrect) And (J < Size) Do
                    Begin
                        Read(InputFile, Matrix[I, J]);
                        If (Matrix[I, J] < 0) Or (Matrix[I, J] > Size) Then
                            IsCorrect := False;
                        Inc(J);
                    End;

                    Inc(I);
                End;
            End;
        Finally
            CloseFile(InputFile);
        End;
    Except
        IsCorrect := False;
    End;

    IsFileCorrect := IsCorrect;
End;

Procedure GetSizeFromFile(Const Path: String; Var Size: Single; Var IsCorrect: Boolean);
Var
    InputFile: TextFile;
    Null: String;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Try
            Reset(InputFile);
            Readln(InputFile, Null);

            If (Null <> '') Then
                IsCorrect := True
            Else
            Begin
                IsCorrect := False;
                Application.MessageBox('Файл пуст!', 'Ошибка', MB_ICONERROR);
            End;
        Finally
            Close(InputFile);
        End;
    Except
        Application.MessageBox('Ошибка доступа!', 'Ошибка', MB_ICONERROR);
    End;

    If (IsCorrect) Then
    Begin
        Try
            Try
                Reset(InputFile);
                Readln(InputFile, Size);
            Finally
                Close(InputFile);
            End;
        Except
            IsCorrect := False;
        End;
    End;
End;

Function GetMatrixFromFile(Const Path: String; Const Size: Single; Var Matrix: TMatrix; Var IsCorrect: Boolean): TMatrix;
Var
    InputFile: TextFile;
    I, J: Integer;
    Null: String;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Reset(InputFile);
        Readln(InputFile, Null);
        If (Null <> '') Then
            IsCorrect := True
        Else
        Begin
            IsCorrect := False;
            Application.MessageBox('Данные в файле введены неверно или отсутствуют!', 'Ошибка', MB_ICONERROR);
        End;

    Except
        Application.MessageBox('Ошибка доступа!', 'Ошибка', MB_ICONERROR);
    End;

    If (IsCorrect) Then
    Begin
        Try
            Reset(InputFile);
            Readln(InputFile);
            For I := Low(Matrix) To High(Matrix) Do
                For J := Low(Matrix[0]) To High(Matrix[0]) Do
                    Read(InputFile, Matrix[I, J]);
        Except
            IsCorrect := False;
        End;
        Close(InputFile);
    End;

    GetMatrixFromFile := Matrix;
End;

Function GetSecondMatrixFromFile(Const Path: String; Const Size: Single; Var Matrix: TMatrix; Var IsCorrect: Boolean): TMatrix;
Var
    InputFile: TextFile;
    I, J: Integer;
    Null: String;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Reset(InputFile);
        Readln(InputFile, Null);
        If (Null <> '') Then
            IsCorrect := True
        Else
        Begin
            IsCorrect := False;
            Application.MessageBox('Данные в файле введены неверно или отсутствуют!', 'Ошибка', MB_ICONERROR);
        End;

    Except
        Application.MessageBox('Ошибка доступа!', 'Ошибка', MB_ICONERROR);
    End;

    If (IsCorrect) Then
    Begin
        Try
            Reset(InputFile);
            Readln(InputFile);
            For I := Low(Matrix) To High(Matrix) Do
                Readln(InputFile);
            For I := Low(Matrix) To High(Matrix) Do
                For J := Low(Matrix[0]) To High(Matrix[0]) Do
                    Read(InputFile, Matrix[I, J]);
        Except
            IsCorrect := False;
        End;
        Close(InputFile);
    End;

    GetSecondMatrixFromFile := Matrix;
End;

{ форма }

Procedure TfrmMain.FormCreate(Sender: TObject);
Begin
    IsFirstMatrixCorrect := False;
End;

Procedure TfrmMain.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
    If Application.MessageBox(PChar('Вы уверены, что хотите выйти?'), PChar('Выход'), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1 + MB_TASKMODAL)
        = IDYES Then
        CanClose := True
    Else
        CanClose := False;
End;

Procedure TLabeledEdit.WMPaste(Var Msg: TMessage);
Const
    MIN_VALUE = 2;
    MAX_VALUE = 10;
Begin
    If Clipboard.HasFormat(CF_TEXT) Then
    Begin
        Try
            If (StrToInt(Clipboard.AsText) < MIN_VALUE) Or (StrToInt(Clipboard.AsText) > MAX_VALUE) Then
            Begin
                Application.MessageBox(Pchar('В буфере обмена содержится неподходящее значение!'), 'Ошибка', MB_ICONWARNING);
                Exit;
            End;
        Except
            Application.MessageBox(Pchar('При чтении из буфера произошла ошибка!'), 'Ошибка', MB_ICONWARNING);
            Exit;
        End;
    End
    Else
    Begin
        Application.MessageBox(Pchar('В буфере обмена содержатся некорректные данные!'), 'Ошибка', MB_ICONWARNING);
        Exit;
    End;
    Inherited;
End;

Function NewEditProc(Window: HWND; UMsg: UINT; WindowParametr: WPARAM; LParam: LPARAM): Integer; Stdcall;
Const
    MIN_VALUE = 0;
    MAX_VALUE = 1;
Var
    Col, Row: Integer;
Begin
    Col := FrmMain.StrgrMatrix.Col;
    Row := FrmMain.StrgrMatrix.Row;

    If UMsg = WM_PASTE Then
    Begin
        Try
            If (StrToInt(Clipboard.AsText) < MIN_VALUE) Or (StrToInt(Clipboard.AsText) > MAX_VALUE) Then
            Begin
                Application.MessageBox(Pchar('В буфере обмена содержится неподходящее значение!'), 'Ошибка', MB_ICONWARNING);
                Exit;
            End
            Else
            Begin
                FrmMain.StrgrMatrix.Cells[Col, Row] := Clipboard.AsText;
                Exit;
            End;
        Except
            Application.MessageBox(Pchar('В буфере обмена находятся неподходящие данные!'), 'Ошибка', MB_ICONWARNING);
            Exit;
        End;
    End
    Else
        Result := CallWindowProc(Pointer(GetWindowLong(Window, GWL_USERDATA)), Window, UMsg, WindowParametr, LParam);
End;

{ кнопки на боковой панели }

Procedure TfrmMain.SdbtAboutDeveloperClick(Sender: TObject);
Const
    FIRST_MESSAGE = 'Ф.И.О.: Карась А.С. a.k.a Clownfish' + #13#10;
    SECOND_MESSAGE = 'Группа: 251004' + #13#10;
    THIRD_MESSAGE = 'Контакты: предварительная запись вживую по адресу' + #13#10;
    FOURTH_MESSAGE = 'г.Гродно, ул.Мостовая, д.31';
Begin
    Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE + FOURTH_MESSAGE, 'О разработчике');
End;

Procedure TfrmMain.SdbtExitClick(Sender: TObject);
Begin
    Close;
End;

Procedure TfrmMain.SdbtHelpClick(Sender: TObject);
Const
    FIRST_MESSAGE = '- Вводимыми значениями могут являться только целые числа!' + #13#10;
    SECOND_MESSAGE = '- Диапазон ввода количества вершин: 2...10' + #13#10;
    THIRD_MESSAGE = '- Для ввода из файла используйте вкладку ''Файл'' - ''Открыть''.' + #13#10;
    FOURTH_MESSAGE = '- Для сохранения в файл используйте вкладку ''Файл'' - ''Сохранить''.' + #13#10;
    FIFTH_MESSAGE = '- Для удобного использования программы представлен набор кнопок на левой панели.';
Begin
    Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE + FOURTH_MESSAGE + FIFTH_MESSAGE, 'Справка');
End;

Procedure TfrmMain.SdbtMenuClick(Sender: TObject);
Begin
    SplvMenu.Opened := Not SplvMenu.Opened;
End;

Procedure TfrmMain.SdbtOpenFromFileClick(Sender: TObject);
Var
    SizeFromFile: Single;
    IsCorrect: Boolean;
    Size, I, J: Integer;
Begin
    If OpdOpenFromFileDialog.Execute() Then
        If IsFileCorrect(OpdOpenFromFileDialog.FileName) Then
        Begin
            GetSizeFromFile(OpdOpenFromFileDialog.FileName, SizeFromFile, IsCorrect);
            Size := Round(SizeFromFile);

            SetLength(FirstAdjacencyMatrix, Size, Size);
            SetLength(SecondAdjacencyMatrix, Size, Size);
            FirstAdjacencyMatrix := GetMatrixFromFile(OpdOpenFromFileDialog.FileName, Size, FirstAdjacencyMatrix, IsCorrect);
            SecondAdjacencyMatrix := GetSecondMatrixFromFile(OpdOpenFromFileDialog.FileName, Size, SecondAdjacencyMatrix, IsCorrect);

            If (IsCorrect) Then
            Begin
                LbeNodesRequirement.Text := IntToStr(Size);
                For I := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
                    For J := Low(FirstAdjacencyMatrix[0]) To High(FirstAdjacencyMatrix[0]) Do
                        StrgrMatrix.Cells[J + 1, I + 1] := IntToStr(FirstAdjacencyMatrix[I, J]);
                BtContinueClick(Sender);
                For I := Low(SecondAdjacencyMatrix) To High(SecondAdjacencyMatrix) Do
                    For J := Low(SecondAdjacencyMatrix[0]) To High(SecondAdjacencyMatrix[0]) Do
                        StrgrMatrix.Cells[J + 1, I + 1] := IntToStr(SecondAdjacencyMatrix[I, J]);
                BtFindClick(Sender);
            End
            Else
                Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
        End
        Else
            Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
End;

Procedure TfrmMain.SdbtSaveToFileClick(Sender: TObject);
Var
    OutputFile: TextFile;
    I, J: Integer;
Begin

    If SvdSaveToFileDialog.Execute() And FileExists(SvdSaveToFileDialog.FileName) Then
    Begin
        AssignFile(OutputFile, SvdSaveToFileDialog.FileName);

        Try
            Try
                Rewrite(OutputFile);

                Writeln(OutputFile, 'Входные данные ');
                Writeln(OutputFile, 'Кол-во вершин: ', Length(FirstAdjacencyMatrix));

                Write(OutputFile, 'Первая матрица смежности: ' + #13#10);
                Write(OutputFile, '    ');
                For I := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
                    Write(OutputFile, I + 1, '    ');
                Write(OutputFile, #13#10);
                For I := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
                Begin
                    Write(OutputFile, I + 1, '   ');
                    For J := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
                        Write(OutputFile, FirstAdjacencyMatrix[I, J], '    ');
                    Write(OutputFile, #13#10);
                End;

                Write(OutputFile, 'Вторая матрица смежности: ' + #13#10);
                Write(OutputFile, '    ');
                For I := Low(SecondAdjacencyMatrix) To High(SecondAdjacencyMatrix) Do
                    Write(OutputFile, I + 1, '    ');
                Write(OutputFile, #13#10);
                For I := Low(SecondAdjacencyMatrix) To High(SecondAdjacencyMatrix) Do
                Begin
                    Write(OutputFile, I + 1, '   ');
                    For J := Low(SecondAdjacencyMatrix) To High(SecondAdjacencyMatrix) Do
                        Write(OutputFile, SecondAdjacencyMatrix[I, J], '    ');
                    Write(OutputFile, #13#10);
                End;
                Writeln(OutputFile, 'Ответ: ', FrmVisualization.PBottom.Caption);

                Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение', MB_ICONINFORMATION);
            Finally
                CloseFile(OutputFile);
            End;
        Except
            Application.MessageBox('Отказано в доступе! Измените параметры файла! ', 'Ошибка!', MB_ICONERROR);
        End;
    End
    Else
        Application.MessageBox('Введено некорректное имя файла или закрыто окно сохранения!', 'Ошибка!', MB_ICONERROR);

End;

{ компоненты формы }

Procedure TfrmMain.LbeNodesRequirementChange(Sender: TObject);
Const
    MIN_VALUE = 2;
    MAX_VALUE = 10;
Var
    I: Integer;
Begin
    IsFirstMatrixCorrect := False;
    For I := 0 To StrgrMatrix.RowCount Do
        StrgrMatrix.Rows[I].Clear;
    If (LbeNodesRequirement.Text <> '') And Not((StrToInt(LbeNodesRequirement.Text) < MIN_VALUE) Or
        (StrToInt(LbeNodesRequirement.Text) > MAX_VALUE)) Then
    Begin
        StrgrMatrix.ColCount := StrToInt(LbeNodesRequirement.Text) + 1;
        StrgrMatrix.RowCount := StrgrMatrix.ColCount;
        StrgrMatrix.Width := (StrgrMatrix.DefaultColWidth + 3) * StrgrMatrix.ColCount;
        If StrgrMatrix.Width > StrgrMatrix.Constraints.MaxWidth Then
            StrgrMatrix.Width := StrgrMatrix.Constraints.MaxWidth;
        StrgrMatrix.Height := (StrgrMatrix.DefaultRowHeight + 3) * StrgrMatrix.RowCount;
        If StrgrMatrix.Height > StrgrMatrix.Constraints.MaxHeight Then
            StrgrMatrix.Height := StrgrMatrix.Constraints.MaxHeight;
        For I := 1 To StrgrMatrix.RowCount Do
        Begin
            StrgrMatrix.Cells[I, 0] := IntToStr(I);
            StrgrMatrix.Cells[0, I] := IntToStr(I);
        End;

        StrgrMatrix.Left := (FrmMain.Width - StrgrMatrix.Width) Div 2 + 10;
        LbMatrixRequirement.Visible := True;
        StrgrMatrix.Visible := True;
        LbIncorrectInput.Visible := False;
    End
    Else
    Begin
        LbMatrixRequirement.Visible := False;
        StrgrMatrix.Visible := False;
        SdbtStart.Enabled := False;
        LbIncorrectInput.Visible := True;
    End;
End;

Procedure TfrmMain.BtBackClick(Sender: TObject);
Var
    I, J: Integer;
Begin
    BtContinue.Enabled := True;
    BtBack.Enabled := False;
    BtBack.Visible := False;
    BtFind.Enabled := False;
    BtFind.Visible := False;
    SdbtStart.Enabled := False;
    LbGraph.Caption := 'Первый граф';
    LbeNodesRequirement.Enabled := True;

    For I := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
        For J := Low(FirstAdjacencyMatrix[0]) To High(FirstAdjacencyMatrix[0]) Do
            StrgrMatrix.Cells[J + 1, I + 1] := IntToStr(FirstAdjacencyMatrix[I, J]);
End;

Procedure TfrmMain.BtContinueClick(Sender: TObject);
Var
    I, J: Integer;
Begin
    If CheckInput Then
    Begin
        SetLength(FirstAdjacencyMatrix, StrToInt(LbeNodesRequirement.Text), StrToInt(LbeNodesRequirement.Text));
        For I := Low(FirstAdjacencyMatrix) To High(FirstAdjacencyMatrix) Do
            For J := Low(FirstAdjacencyMatrix[0]) To High(FirstAdjacencyMatrix[0]) Do
                FirstAdjacencyMatrix[I, J] := StrToInt(StrgrMatrix.Cells[J + 1, I + 1]);
        IsFirstMatrixCorrect := True;

        BtContinue.Enabled := False;
        BtBack.Enabled := True;
        BtBack.Visible := True;
        BtFind.Enabled := True;
        BtFind.Visible := True;
        SdbtStart.Enabled := True;
        LbeNodesRequirement.Enabled := False;
        LbGraph.Caption := 'Второй граф';

        For I := 1 To StrgrMatrix.ColCount - 1 Do
            For J := 1 To StrgrMatrix.RowCount - 1 Do
                StrgrMatrix.Cells[I, J] := IntToStr(SecondAdjacencyMatrix[J - 1, I - 1]);
    End;
End;

Procedure TfrmMain.BtFindClick(Sender: TObject);
Var
    I, J: Integer;
Begin
    If CheckInput Then
    Begin
        SetLength(SecondAdjacencyMatrix, StrToInt(LbeNodesRequirement.Text), StrToInt(LbeNodesRequirement.Text));
        For I := Low(SecondAdjacencyMatrix) To High(SecondAdjacencyMatrix) Do
            For J := Low(SecondAdjacencyMatrix[0]) To High(SecondAdjacencyMatrix[0]) Do
                SecondAdjacencyMatrix[I, J] := StrToInt(StrgrMatrix.Cells[J + 1, I + 1]);

        SdbtSaveToFile.Enabled := True;
        FrmVisualization.Show;
        FrmMain.Hide;
    End;
End;

End.

Unit UnitVCLLoadingScreen;

Interface

Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.ExtCtrls,
    Vcl.Imaging.Pngimage, Vcl.Imaging.jpeg;

Type
    TfrmLoadingScreen = Class(TForm)
        TmrEndLoadingScreen: TTimer;
        TmrAlphaBlendChanging: TTimer;
    imLogo: TImage;
    pBack: TPanel;
        Procedure FormCreate(Sender: TObject);
        Procedure TmrEndLoadingScreenTimer(Sender: TObject);
        Procedure TmrAlphaBlendChangingTimer(Sender: TObject);
    End;

Var
    FrmLoadingScreen: TfrmLoadingScreen;

Implementation

{$R *.dfm}

Procedure TfrmLoadingScreen.FormCreate(Sender: TObject);
Var
    HRgn: Cardinal;
Begin
    HRgn := CreateEllipticRgn(0, 0, 400, 400);
    SetWindowRgn(Handle, HRgn, False);

    TmrEndLoadingScreen.Enabled := True;
    TmrAlphaBlendChanging.Enabled := True;
End;

Procedure TfrmLoadingScreen.TmrAlphaBlendChangingTimer(Sender: TObject);
Begin
    If FrmLoadingScreen.AlphaBlendValue > 253 Then
        TmrAlphaBlendChanging.Enabled := False
    Else
        FrmLoadingScreen.AlphaBlendValue := FrmLoadingScreen.AlphaBlendValue + 2;
End;

Procedure TfrmLoadingScreen.TmrEndLoadingScreenTimer(Sender: TObject);
Begin
    TmrEndLoadingScreen.Enabled := False;
End;

End.

Unit UnitData;

Interface

Uses
    System.SysUtils,
    System.Classes, Vcl.BaseImageCollection, Vcl.ImageCollection;

Type
    TdtmdImages = Class(TDataModule)
    imcImages: TImageCollection;
    End;

Var
    dtmdImages: TdtmdImages;

Implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}

End.

Unit UnitVCLVisualization;

Interface

Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.StdCtrls,
    Vcl.ExtCtrls,
    UnitVCLMain;

Type
    TCoords = Record
        X: Integer;
        Y: Integer;
    End;

    TArr = Array Of Integer;

    TfrmVisualization = Class(TForm)
        PBottom: TPanel;
        BtClose: TButton;
        BtSaveToFile: TButton;
        PbFirst: TPaintBox;
        PbSecond: TPaintBox;
        Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
        Procedure BtCloseClick(Sender: TObject);
        Procedure BtSaveToFileClick(Sender: TObject);
        Procedure FormShow(Sender: TObject);
        Procedure PbFirstPaint(Sender: TObject);
        Procedure PbSecondPaint(Sender: TObject);
    Private
        Function GetPowers(Matrix: TMatrix): TArr;
        Function FindIsIsomorphic(Const FirstMatrix, SecondMatrix: TMatrix): Boolean;
        Procedure VizualizeGraph(Canvas: TCanvas; Const Matrix: TMatrix);
    End;

Var
    FrmVisualization: TfrmVisualization;

Implementation

{$R *.dfm}
{ бэк }

Function TfrmVisualization.GetPowers(Matrix: TMatrix): TArr;
Var
    I, J, SumOfConnections, Temp: Integer;
    Vector: TArr;
Begin
    SetLength(Vector, Length(Matrix));
    For I := Low(Matrix) To High(Matrix) Do
    Begin
        SumOfConnections := 0;
        For J := Low(Matrix[0]) To High(Matrix[0]) Do
            If Matrix[I, J] = 0 Then
                Inc(SumOfConnections);
        Vector[I] := SumOfConnections;
    End;

    For I := Low(Vector) To High(Vector) Do
        For J := Low(Vector) To High(Vector) - 1 Do
            If Vector[J] > Vector[J + 1] Then
            Begin
                Temp := Vector[J];
                Vector[J] := Vector[J + 1];
                Vector[J + 1] := Temp;
            End;

    GetPowers := Vector;
End;

Procedure TfrmVisualization.PbFirstPaint(Sender: TObject);
Begin
    VizualizeGraph(PbFirst.Canvas, FrmMain.FirstAdjacencyMatrix);
End;

Procedure TfrmVisualization.PbSecondPaint(Sender: TObject);
Begin
    VizualizeGraph(PbSecond.Canvas, FrmMain.SecondAdjacencyMatrix);
End;

Function TfrmVisualization.FindIsIsomorphic(Const FirstMatrix, SecondMatrix: TMatrix): Boolean;
Var
    I, J: Integer;
    IsIsomorphic: Boolean;
    FirstVector, SecondVector: TArr;
Begin
    IsIsomorphic := True;
    SetLength(FirstVector, Length(FirstMatrix));
    SetLength(SecondVector, Length(SecondMatrix));

    If Length(FirstMatrix) <> Length(SecondMatrix) Then
        IsIsomorphic := False
    Else
    Begin
        FirstVector := GetPowers(FirstMatrix);
        SecondVector := GetPowers(SecondMatrix);

        For I := Low(FirstVector) To High(FirstVector) Do
            If FirstVector[I] <> SecondVector[I] Then
                IsIsomorphic := False;
    End;

    FindIsIsomorphic := IsIsomorphic;
End;

{ компоненты }

Procedure TfrmVisualization.VizualizeGraph(Canvas: TCanvas; Const Matrix: TMatrix);
Const
    X0 = 200;
    Y0 = 200;
    Radius = 150;
    Pi = 3;
Var
    X, Y, A, I, J, NodeRadius: Integer;
    VectorOfCoords: Array Of TCoords;
Begin
    Randomize;
    SetLength(VectorOfCoords, Length(Matrix));
    NodeRadius := Radius Div 8;
    With Canvas Do
    Begin
        For I := Low(Matrix) To High(Matrix) Do
        Begin
            A := 2 * Pi * ((I + 1) * 360 Div Length(Matrix));
            //A := 2 * Pi * Random(Radius);
            X := X0 + Round(Radius * Cos(A));
            Y := Y0 + Round(Radius * Sin(A));
            VectorOfCoords[I].X := X;
            VectorOfCoords[I].Y := Y;
        End;
    End;

    Canvas.Font.Size := 12;
    Canvas.Pen.Width := 3;
    For I := Low(Matrix) To High(Matrix) Do
        For J := Low(Matrix) To High(Matrix) Do
            If (Matrix[I, J] = 1) And (I <> J) Then
                With Canvas Do
                Begin
                    Pen.Color := ClRed;
                    MoveTo(VectorOfCoords[I].X, VectorOfCoords[I].Y);
                    LineTo(VectorOfCoords[J].X, VectorOfCoords[J].Y);
                    Pen.Color := ClBlack;
                End;

    For I := Low(Matrix) To High(Matrix) Do
    Begin
        Canvas.Ellipse(VectorOfCoords[I].X - NodeRadius, VectorOfCoords[I].Y - NodeRadius, VectorOfCoords[I].X + NodeRadius,
            VectorOfCoords[I].Y + NodeRadius);
        Canvas.TextOut(VectorOfCoords[I].X - 7, VectorOfCoords[I].Y - 10, IntToStr(I + 1));
    End;
End;

Procedure TfrmVisualization.BtCloseClick(Sender: TObject);
Begin
    Close;
End;

Procedure TfrmVisualization.BtSaveToFileClick(Sender: TObject);
Begin
    FrmMain.SdbtSaveToFileClick(Sender);
End;

Procedure TfrmVisualization.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
    FrmMain.Show;
End;

Procedure TfrmVisualization.FormShow(Sender: TObject);
Var
    IsIsomorphic: Boolean;
Begin
    PbFirst.Repaint;
    PbSecond.Repaint;
    IsIsomorphic := FindIsIsomorphic(FrmMain.FirstAdjacencyMatrix, FrmMain.SecondAdjacencyMatrix);
    If IsIsomorphic Then
        PBottom.Caption := 'Графы изоморфны'
    Else
        PBottom.Caption := 'Графы не изоморфны';
End;

End.