(Delphi) lab 7.1

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.Buttons, Vcl.ExtCtrls,
    Vcl.Samples.Spin, Vcl.Menus, Vcl.Grids, System.Generics.Collections,System.RegularExpressions,
    Vcl.Imaging.jpeg, Vcl.ExtDlgs, Vcl.Imaging.pngimage;

type
    Coords = Record
        X: Integer;
        Y: Integer;
    End;

    TPList = ^TList;
    TList = Record
        Node: Integer;
        Next: TPList;
    End;

    TMatrix = Array Of Array Of Integer;
    VertexList = TList<Coords>;
    TArr = Array of Integer;

  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    OpenFromFileMenu: TMenuItem;
    Instruction: TMenuItem;
    SaveToFileMenu: TMenuItem;
    OpenFromFile: TOpenDialog;
    SaveDialog: TSaveDialog;
    InfoLabel1: TLabel;
    SpinEdit: TSpinEdit;
    StringGrid: TStringGrid;
    InfoLabel: TLabel;
    AboutDeveloperMenu: TMenuItem;
    ShowGraphButton: TButton;
    Visualizer: TImage;
    VertexSpinEdit: TSpinEdit;
    SearchButton: TButton;
    procedure InstructionClick(Sender: TObject);
    procedure AboutDeveloperMenuClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClearStringGrid;
    procedure SpinEditChange(Sender: TObject);
    procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure StringGridKeyPress(Sender: TObject; var Key: Char);
    procedure ShowGraphButtonClick(Sender: TObject);
    procedure ClearScreen;
    procedure ChekGrid(Key: Char);
    function FindMatrix: TMatrix;
    procedure DrawGraph(AdjMatrix: TMatrix);
    procedure DrawVertexes(Amount: Integer; Var VertexCoords: VertexList);
    procedure DrawLines(AdjMatrix: TMatrix; VertexCoords: VertexList);
    procedure DrawArrows(i,j: Integer; VertexCoords: VertexList);
    procedure OpenFromFileMenuClick(Sender: TObject);
    function IsInFileCorrect(const Path: String): Boolean;
    function IsMatrixCorrect(Matrix: TMatrix): Boolean;
    procedure SaveToFileMenuClick(Sender: TObject);
    procedure VertexSpinEditChange(Sender: TObject);
    procedure SearchButtonClick(Sender: TObject);
    procedure CreateList(Matrix: TMatrix);
    procedure AddNode(FromVertex: Integer; ToVertex: Integer);
    function FindArray(Vertex: Integer; Length: Integer): TArr;
    function IsAllFind(NewArr: TArr): Boolean;
    procedure ShowAnswer(AnsArr: TArr; Vertex: Integer);
    procedure ClearList;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

type
    TPNode = ^TNode;
    TNode = Record
        FromVertex: Integer;
        ToVertex: Integer;
        Next: TPNode;
    End;

var
    Head: TPNode;
    Xprev, YPrev: Integer;
    Arr, prevArr: TArr;
    MyVertexCoords: VertexList;
    MyMatrix: TMatrix;

const
    DEFAULT_WIDTH = 490;
    DEFAULT_LEFT = 532;
    EXTENDED_WIDTH = 1200;
    VERTEXES_COLOR = $00B3B300;
    BACKGROUND_COLOR = $001C1A13;
    TREE_COLOR =  $004F009D;
    POINT_RAD = 10;
    LINE_WIDTH = 5;
    GRAPH_RAD = 150;
    VERTEX_RAD = 30;
    FONT_SIZE = 20;

procedure TMainForm.AboutDeveloperMenuClick(Sender: TObject);
begin
    Application.MessageBox('Данная программа написана Вакарём Егором'#13#10'студентом группы 151002.','О разработчике');
end;

procedure TMainForm.ClearStringGrid;
var
    i,j: Integer;
begin
    for i := 1 to StringGrid.ColCount do
        for j := 1 to StringGrid.RowCount do
            StringGrid.Cells[i, j] := '0';
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
    S: TGridRect;
    i: Integer;
begin
    SaveToFileMenu.Enabled := False;
    MainForm.Width := 545;
    MainForm.Height := 491;
    MainForm.Position := poDesktopCenter;
    InfoLabel.Left := 14;
    for i := 1 to 2 do
    begin
        StringGrid.Cells[i, 0] := IntToStr(i);
        StringGrid.Cells[0, i] := IntToStr(i);
    end;
    ClearStringGrid;
    StringGrid.Selection := S;
end;

procedure TMainForm.InstructionClick(Sender: TObject);
begin
    Application.MessageBox('Граф задается матрицей смежности.'#13#10'Принимает ключи ''1'', ''0''.'#13#10'Диапазон значений кол-ва вершин [2; 13].'#13#10'Для начала алгоритма выберите вершину'#13#10'и нажмите кнопку "Начать поиск".', 'Инструкция');
end;

function TMainForm.IsInFileCorrect(const Path: String): Boolean;
const
    MIN_SIZE = 1;
    MAX_SIZE = 13;
var
    InFile: TextFile;
    Size, Temp, i, j: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    Try
        AssignFile(InFile, Path);
        Reset(InFile);
        Size := 0;
        try
            Read(InFile,Size);
        except
            IsCorrect := False;
        end;
    except
        IsCorrect := False;
    End;
    if (IsCorrect) then
    begin
        if (Size < MIN_SIZE) or (Size > MAX_SIZE) then
        begin
            IsCorrect := False;
        end
    end;
    i := 0;
    if IsCorrect then
    begin
        While (IsCorrect and (i < Size) and (not Eof(InFile))) do
        begin
            try
                for j := 0 to Size - 1 do
                    Read(InFile, Temp);
                if not ((Temp = 1) or (Temp = 0))then
                    IsCorrect := False;
            except
                IsCorrect := False;
            end;
            Inc(i);
        end;
    end;
    if (IsCorrect and ((i < Size))) then
    begin
        IsCorrect := False;
    end;
    try
        CloseFile(InFile);
    except
        IsCorrect := False;
    end;
    IsInFileCorrect := IsCorrect;
end;

function TMainForm.IsMatrixCorrect(Matrix: TMatrix): Boolean;
var
    i,j: Integer;
    Answer: Boolean;
begin
    Answer := True;
    i := 0;
    j := 0;
    while (Answer and (i < Length(Matrix)))  do
    begin
        while (Answer and (j < Length(Matrix[0])))do
        begin
            if (((i = j) and (Matrix[i,j] <> 0)) or ((Matrix[i,j] = 1) and (Matrix[j,i] <> 0))) then
                Answer := False;
            Inc(j);
        end;
        Inc(i);
    end;
    Result := Answer;
end;

procedure TMainForm.OpenFromFileMenuClick(Sender: TObject);
var
    i,j, Size: Integer;
    Matrix: TMatrix;
    inFile: TextFile;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    if OpenFromFile.Execute() then
    begin
        if (IsInFileCorrect(OpenFromFile.FileName)) then
        begin
            AssignFile(InFile, OpenFromFile.FileName);
            Reset(InFile);
            Read(InFile, Size);
            SpinEdit.Value := Size;
            SetLength(Matrix, Size, Size);
            for i := 0 to Size - 1 do
            begin
                for j := 0 to Size - 1 do
                begin
                    Read(InFile,Matrix[i,j]);
                    StringGrid.Cells[j + 1,i + 1] := IntToStr(Matrix[i,j]);
                end;

            end;
            CloseFile(InFile);
            if IsMatrixCorrect(Matrix) then
            begin
                SaveToFileMenu.Enabled := True;
                ShowGraphButton.Click;
            end
            else
            begin
                FormCreate(MainForm);
                SpinEdit.Value := 2;
            end;
        end
        else
            IsCorrect := False;
    end
    else
        IsCorrect := False;
    if not IsCorrect then
        Application.MessageBox('Работа с файлом некорректна', 'Ошибка', MB_ICONERROR);
end;

procedure TMainForm.ClearScreen;
Begin
    With Visualizer.Canvas Do
    Begin
        Brush.Color := BACKGROUND_COLOR;
        Pen.Color := BACKGROUND_COLOR;
        Rectangle(0,0,Visualizer.Width,Visualizer.Height);
    End;
End;

function TMainForm.FindMatrix: TMatrix;
var
    N,i,j: Integer;
    Matrix: TMatrix;
begin
    N := SpinEdit.Value;
    SetLength(Matrix, N, N);
    for i := 1 to N do
        for j := 1 to N do
            Matrix[i-1,j-1] := StrToInt(StringGrid.Cells[j,i]);
    Result := Matrix;
end;

Procedure TMainForm.DrawVertexes(Amount: Integer; Var VertexCoords: VertexList);
Var
    I, X, Y: Integer;
    Center: Coords;
    CurrPhi, Phi: Extended;
    CurrCoords: Coords;
Begin
    VertexCoords := TList<Coords>.Create;
    Phi := (2 * Pi) / Amount;
    Center.X := Visualizer.Width Div 2;
    Center.Y := Visualizer.Height Div 2;
    With Visualizer.Canvas Do
    Begin
        Pen.Color := VERTEXES_COLOR;
        Pen.Width := 1;
        X := Center.X;
        Y := Center.Y;
        Font.Name := 'Segoe UI';
        Font.Style := [FsBold];
        Font.Color := VERTEXES_COLOR;
        Font.Height := FONT_SIZE;
        CurrPhi := 0;
        For I := 0 To Amount - 1 Do
        Begin
            Brush.Color := VERTEXES_COLOR;
            CurrPhi := CurrPhi + Phi;
            Y := Round(Center.Y - GRAPH_RAD * Sin(CurrPhi));
            X := Round(Center.X - GRAPH_RAD * Cos(CurrPhi));
            Ellipse(X - VERTEX_RAD, Y - VERTEX_RAD, X + VERTEX_RAD, Y + VERTEX_RAD);
            CurrCoords.X := X;
            CurrCoords.Y := Y;
            VertexCoords.Add(CurrCoords);
            Brush.Color := BACKGROUND_COLOR;
            If CurrPhi < Pi Then
                TextOut(X - 5 , Y - 64, IntToStr(I + 1))
            Else
                TextOut(X - 5, Y + 32, IntToStr(I + 1));
        End;
    End;
    XPrev := VertexCoords.Items[0].X;
    YPrev := VertexCoords.Items[0].Y;
End;

procedure TMainForm.DrawGraph(AdjMatrix: TMatrix);
var
    VertexCoords: VertexList;
begin
    VertexCoords := TList<Coords>.Create;
    DrawVertexes(SpinEdit.Value, VertexCoords);
    DrawLines(AdjMatrix, VertexCoords);
    DrawVertexes(SpinEdit.Value, VertexCoords);
    MyVertexCoords := VertexCoords;
    MyMatrix := AdjMatrix;
end;

procedure TMainForm.DrawArrows(i,j: Integer; VertexCoords: VertexList);
var
    Hypotenuse, Cos, XForArrow, YForArrow: Real;
    MinY,MinX,MaxY,MaxX: Integer;
begin
    with Visualizer.Canvas do
    begin
        Pen.Color := clGreen;
        MoveTo((VertexCoords.Items[I].X + 3* VertexCoords.Items[J].X) div 4,(VertexCoords.Items[I].Y + 3 * VertexCoords.Items[J].Y) div 4);
        LineTo(VertexCoords.Items[J].X, VertexCoords.Items[J].Y);
    end;
end;

procedure TMainForm.DrawLines(AdjMatrix: TMatrix; VertexCoords: VertexList);
var
    I, J: Byte;
    Hypotenuse, Cos, XForArrow, YForArrow: Real;
    InciedenceList: TList;
    Line: String;
begin
    for I := 0 to High(AdjMatrix) do
    begin
        for J := 0 to High(AdjMatrix) do
        begin
            if AdjMatrix[I, J] = 1 then
            begin
                with Visualizer.Canvas do
                begin
                    Pen.Color := VERTEXES_COLOR;
                    Pen.Width := 4;
                    MoveTo(VertexCoords.Items[I].X, VertexCoords.Items[I].Y);
                    LineTo(VertexCoords.Items[J].X, VertexCoords.Items[J].Y);
                    DrawArrows(i,j,VertexCoords);
                end;
            end;
        end;
    end;
end;

procedure TMainForm.SaveToFileMenuClick(Sender: TObject);
var
    OutputFile: TextFile;
    i,j: Integer;
    Ans: PWideChar;
begin
    ClearList;
    CreateList(MyMatrix);
    Arr := nil;
    Arr := FindArray(VertexSpinEdit.Value, SpinEdit.Value);
    Ans := PWideChar('Список расстояний из вершины ' + IntToStr(VertexSpinEdit.Value) + ':'#13#10);
    for i := 0 to Length(Arr) - 1 do
    begin
        if i <> VertexSpinEdit.Value - 1 then
            if Arr[i] = 10000 then
                Ans := PWideChar(Ans + IntToStr(i+1) + ': Невозможно достичь'#13#10)
            else
                Ans := PWideChar(Ans + IntToStr(i+1) + ': ' + IntToStr(Arr[i]) + #13#10);
    end;
    if SaveDialog.Execute() and FileExists(SaveDialog.FileName) then
    begin
        AssignFile(OutputFile, SaveDialog.FileName);
        try
            Rewrite(OutputFile);
            Writeln(OutputFile,Ans);
            CloseFile(OutputFile);
            Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение', MB_ICONINFORMATION);
        except
            Application.MessageBox('Отказано в доступе! Измените параметры файла! ', 'Ошибка!', MB_ICONERROR);
        end;
    end
    else
        Application.MessageBox('Введено некорректное имя файла', 'Ошибка!', MB_ICONERROR);
end;

procedure TMainForm.AddNode(FromVertex: Integer; ToVertex: Integer);
var
    Temp, Current: TPNode;
begin
    New(Temp);
    Temp.FromVertex := FromVertex;
    Temp.ToVertex := ToVertex;
    Temp.Next := nil;
    if Head = nil then
        Head := Temp
    else
    begin
        Current := Head;
        while Current.Next <> nil do
            Current := Current.Next;
        Current.Next := Temp;
    end;
end;

procedure TMainForm.CreateList(Matrix: TMatrix);
var
    i,j: Integer;
begin
    for i := 0 to Length(Matrix) - 1 do
        for j := 0 to Length(Matrix[0]) - 1 do
            if (matrix[i][j] = 1) then
                    AddNode(i+1, j+1);
end;

function TMainForm.IsAllFind(NewArr: TArr): Boolean;
var
    Answer: Boolean;
    i: Integer;
begin
    i := 0;
    Answer := True;
    while (Answer and (i < Length(NewArr))) do
    begin
        if (NewArr[i] = 10000) then
            Answer := false;
        Inc(i);
    end;
    Result := Answer;
end;

function TMainForm.FindArray(Vertex: Integer; Length: Integer): TArr;
var
    NewArr: TArr;
    i: Integer;
    Temp: TPNode;
    AreSame: Boolean;
begin
    SetLength(NewArr, Length);
    for i := 0 to Length - 1 do
        NewArr[i] := 10000;
    NewArr[vertex - 1] := 0;
    repeat
        Temp := Head;
        while (temp <> nil) do
        begin
            if (NewArr[Temp.ToVertex - 1] > NewArr[Temp.FromVertex - 1] + 1) then
                NewArr[Temp.ToVertex - 1] := NewArr[Temp.FromVertex - 1] + 1;
            Temp := Temp.Next;
        end;
        AreSame := (NewArr = PrevArr);
        PrevArr := Arr;
    until (IsAllFind(arr) or areSame);
    Result := NewArr;
end;

procedure TMainForm.ShowAnswer(AnsArr: TArr; Vertex: Integer);
var
    i: Integer;
    Ans: PWideChar;
begin
    Ans := PWideChar('Список расстояний из вершины ' + IntToStr(Vertex) + ':'#13#10);
    for i := 0 to Length(AnsArr) - 1 do
    begin
        if i <> Vertex - 1 then
            if AnsArr[i] = 10000 then
                Ans := PWideChar(Ans + IntToStr(i+1) + ': Невозможно достичь'#13#10)
            else
                Ans := PWideChar(Ans + IntToStr(i+1) + ': ' + IntToStr(AnsArr[i]) + #13#10);
    end;
     Application.MessageBox(Ans, 'Ответ');
end;

procedure TMainForm.ClearList;
var
    Current, Prev: TPNode;
    i: Integer;
begin
    while Head <> nil do
    begin
        Current := Head;
        while Current.Next <> nil do
        begin
            Prev := Current;
            Current := Current.Next;
        end;
        if Current <> Head then
        begin
            Prev.Next := nil;
        end
        else
            Head := nil;
        Dispose(Current);
    end;
end;

procedure TMainForm.SearchButtonClick(Sender: TObject);
begin
    ClearList;
    CreateList(MyMatrix);
    Arr := nil;
    Arr := FindArray(VertexSpinEdit.Value, SpinEdit.Value);
    ShowAnswer(Arr, VertexSpinEdit.Value);
end;

procedure TMainForm.ShowGraphButtonClick(Sender: TObject);
var
    Matrix: TMatrix;
begin
    MainForm.Width := 1100;
    MainForm.Height := 530;
    InfoLabel.Left := 302;
    MainForm.Position := poDesktopCenter;
    ClearScreen;
    Matrix := FindMatrix;
    DrawGraph(Matrix);
    VertexSpinEdit.MaxValue := SpinEdit.Value;
    VertexSpinEdit.Value := 1;
    SaveToFileMenu.Enabled := True;
end;

procedure TMainForm.SpinEditChange(Sender: TObject);
var
    S: TGridRect;
begin
    if MainForm.Width > 545 then
    begin
        FormCreate(MainForm);
    end;
    StringGrid.Selection := S;
    if (SpinEdit.Value >= StringGrid.ColCount) then
    begin
        repeat
            ClearStringGrid;
            StringGrid.ColCount := StringGrid.ColCount + 1;
            StringGrid.RowCount := StringGrid.RowCount + 1;
            StringGrid.Cells[StringGrid.RowCount - 1, 0] := IntToStr(StringGrid.RowCount - 1);
            StringGrid.Cells[0, StringGrid.RowCount - 1] := IntToStr(StringGrid.RowCount - 1);
        until(SpinEdit.Value = StringGrid.ColCount - 1);
    end
    else
    begin
        repeat
            ClearStringGrid;
            StringGrid.Cells[StringGrid.RowCount, 0] := '';
            StringGrid.Cells[0, StringGrid.RowCount] := '';
            StringGrid.ColCount := StringGrid.ColCount - 1;
            StringGrid.RowCount := StringGrid.RowCount - 1;
        until(SpinEdit.Value = StringGrid.ColCount - 1);
    end;
end;

procedure TMainForm.ChekGrid(Key: Char);
var
    isChanged: Boolean;
    Value: String;
begin
    Value := Copy(StringGrid.Cells[StringGrid.Col, StringGrid.Row],1,1);
    if ((Key = '0') or (Key = '1')) and (Key <> Value) and (MainForm.Width > 545) then
    begin
        MainForm.Width := 545;
        MainForm.Height := 491;
        MainForm.Position := poDesktopCenter;
        InfoLabel.Left := 14;
    end;
end;

procedure TMainForm.StringGridKeyPress(Sender: TObject; var Key: Char);
begin
    ChekGrid(Key);
    if Key = '0' then
    begin
        StringGrid.Cells[StringGrid.Col, StringGrid.Row] := '0';
        StringGrid.Cells[StringGrid.Row, StringGrid.Col] := '1';
    end
    else
        if StringGrid.Col <> StringGrid.Row then
            if Key = '1' then
            begin
                StringGrid.Cells[StringGrid.Row, StringGrid.Col] := '0';
                StringGrid.Cells[StringGrid.Col, StringGrid.Row] := '1';
            end;
    Key := #0;
end;

procedure TMainForm.StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
    if (ACol < 1) or (ARow < 1) or (ARow = ACol) then
        CanSelect := False;
end;

procedure TMainForm.VertexSpinEditChange(Sender: TObject);
var
    Vertex: Integer;
    XCoord, YCoord: Integer;
begin
    Vertex := StrToInt(VertexSpinEdit.Text);
    XCoord := MyVertexCoords.Items[Vertex - 1].X;
    YCoord := MyVertexCoords.Items[Vertex - 1].Y;
    with Visualizer.Canvas Do
    begin
        Pen.Color := VERTEXES_COLOR;
        Pen.Width := LINE_WIDTH;
        Brush.Color := VERTEXES_COLOR;
        Ellipse(XPrev - VERTEX_RAD, YPrev - VERTEX_RAD, XPrev + VERTEX_RAD, YPrev + VERTEX_RAD);
        Pen.Color := ClYellow;
        Ellipse(XCoord - VERTEX_RAD, YCoord - VERTEX_RAD, XCoord + VERTEX_RAD, YCoord + VERTEX_RAD);
        Brush.Color := ClYellow;
        Ellipse(XCoord - POINT_RAD, YCoord - POINT_RAD, XCoord + POINT_RAD, YCoord + POINT_RAD);
    end;
    XPrev := MyVertexCoords.Items[Vertex - 1].X;
    YPrev := MyVertexCoords.Items[Vertex - 1].Y;
end;

end.