7.1

Unit UnitMain;

Interface

Uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus,
    Vcl.Samples.Spin, Vcl.Grids, Vcl.ExtCtrls;

Type
    TPoint = Record
        CenterX, CenterY: Integer;
        Color: TColor;
    End;

    PQueue = ^TQueue;
    TQueue = Record
        Data: Integer;
        Next: PQueue;
    End;

    TBoolArr = Array of Boolean;
    TMatrix = Array of Array of Integer;
    TPointsArr = Array of TPoint;

    TFormMain = class(TForm)
        HeaderLabel: TLabel;
        MainMenu: TMainMenu;
        FileMenu: TMenuItem;
        OpenFileMenu: TMenuItem;
        SaveToFileBFSMenu: TMenuItem;
        InfoAboutDeveloper: TMenuItem;
        TaskInfo: TMenuItem;
        SaveToFile: TSaveDialog;
        OpenFromFile: TOpenDialog;
        AskLabel: TLabel;
        VerticeEdit: TSpinEdit;
        MatrixLabel: TLabel;
        sgMatrix: TStringGrid;
        StartPointEdit: TSpinEdit;
        StartButton: TButton;
        VisualButton: TButton;
        BFSLabel: TLabel;
        FromLabel: TLabel;
    OrderLabel: TLabel;
        Procedure FormCreate(Sender: TObject);
        Procedure VerticeEditChange(Sender: TObject);
        Procedure sgMatrixKeyPress(Sender: TObject; Var Key: Char);
        Procedure sgMatrixSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
        Procedure StartButtonClick(Sender: TObject);
        Procedure StartPointEditChange(Sender: TObject);
        Procedure VisualButtonClick(Sender: TObject);
        Procedure OpenFileMenuClick(Sender: TObject);
        Procedure SaveToFileBFSMenuClick(Sender: TObject);
        Procedure InfoAboutDeveloperClick(Sender: TObject);
        Procedure TaskInfoClick(Sender: TObject);
        Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Private
        { Private declarations }
        Function CreateMatrix(): TMatrix;
        Function CheckFull(): Boolean;
    Public
        { Public declarations }
    End;

Var
    FormMain: TFormMain;
    Head, Tail: PQueue;

Implementation

{$R *.dfm}

Uses
    UnitVisualisation, UnitAbout, UnitExit, UnitInstruction_7_1, UnitError;

Const
    StartX = 300;
    StartY = 300;
    AreaRadius = 200;
    NodeRadius = 40;

Procedure AddToQueue(Value: Integer);
Var
    PElem, Last: PQueue;
Begin
    New(PElem);
    PElem^.Data := Value;
    PElem^.Next := Nil;
    If (Head = Nil) then
    Begin
        Head := PElem;
    End;
    If (Tail <> Nil) then
    Begin
        Last := Tail;
        Tail := PElem;
        Last^.Next := PElem;
    End;
    Tail := PElem;
End;

Procedure RemoveFromQueue();
Var
    PElem: PQueue;
Begin
    PElem := Head;
    If (PElem^.Next = Nil) then
    Begin
        Tail := Nil;
        Head := Nil;
    End
    Else
        Head :=  PElem^.Next;
    Dispose(PElem);
End;

Function BFSGraph(Matrix: TMatrix; N: Integer; StartPoint: Integer; Var Output: String): TPointsArr;
Var
    BoolArr: TBoolArr;
    ResultArr: TPointsArr;
    Color: TColor;
    I: Integer;
Begin
    Color := RGB(0,255,255);
    SetLength(BoolArr, N);
    SetLength(ResultArr, N);
    For I := 0 to High(BoolArr) do
        BoolArr[I] := False;
    AddToQueue(StartPoint - 1);
    BoolArr[StartPoint - 1] := True;
    While (Head <> Nil) do
    Begin
        Output := Output + IntToStr(Head^.Data + 1) + ' ';
        ResultArr[Head^.Data].Color := Color;
        Color := Color - RGB(0,17,17);
        For I := 0 to (N - 1) do
        Begin
            If (Not BoolArr[I]) and (Matrix[Head^.Data, I] = 1) then
            Begin
                AddToQueue(I);
                BoolArr[I] := True;
            End;
        End;
        RemoveFromQueue();
    End;
    Result := ResultArr;
End;

Procedure DrawGraph(Canvas: TCanvas; N: Integer; Matrix: TMatrix; Var PointsArr: TPointsArr);
Var
    Alfa: Real;
    I, J: Integer;
    CenterX, CenterY: Integer;
    Str: String;
Begin
    Alfa := 2*Pi/N;
    With Canvas do
    Begin
        Font.Color := clWhite;
        Font.Size := 12;
        Font.Style := [fsBold];

        For I := 0 to (N - 1) do
        Begin
            CenterX := Round(AreaRadius * Sin(Alfa * I)) + StartX;
            CenterY := Round(AreaRadius * Cos(Alfa * I)) + StartY;
            PointsArr[I].CenterX := CenterX;
            PointsArr[I].CenterY := CenterY;
        End;

        Pen.Color := clBlack;
        Pen.Width := 3;
        For I := 0 to (N - 2) do
        Begin
            For J := I to (N - 1) do
            Begin
                If (Matrix[I, J] = 1) then
                Begin
                    MoveTo(PointsArr[I].CenterX, PointsArr[I].CenterY);
                    LineTo(PointsArr[J].CenterX, PointsArr[J].CenterY);
                End;
            End;
        End;
        For I := 0 to (N - 1) do
        Begin
            Brush.Color := PointsArr[I].Color;
            Ellipse(PointsArr[I].CenterX - NodeRadius div 2,
                        PointsArr[I].CenterY - NodeRadius div 2, PointsArr[I].CenterX + NodeRadius div 2,
                        PointsArr[I].CenterY + NodeRadius div 2);
            Str := IntToStr(I + 1);
            TextOut(PointsArr[I].CenterX - (TextWidth(Str) div 2), PointsArr[I].CenterY - (TextHeight(Str) div 2), Str);
        End;
    End;

End;

Procedure TFormMain.StartButtonClick(Sender: TObject);
Var
    Output: String;
    Matrix: TMatrix;
    ResultArr: TPointsArr;
    N: Integer;
Begin
    Matrix := CreateMatrix();
    N := VerticeEdit.Value;
    ResultArr := BFSGraph(Matrix, N, StartPointEdit.Value, Output);
    BFSLabel.Caption := Output;
    VisualButton.Enabled := True;
    SaveToFileBFSMenu.Enabled := True;
End;

Procedure TFormMain.VisualButtonClick(Sender: TObject);
Var
    ResultArr: TPointsArr;
    Matrix: TMatrix;
    N: Integer;
    Output: String;
    Visual: TFormVisualisation;
Begin
    Matrix := CreateMatrix();
    N := VerticeEdit.Value;
    ResultArr := BFSGraph(Matrix, N, StartPointEdit.Value, Output);
    Try
        Visual := TFormVisualisation.Create(Self);
        DrawGraph(Visual.PaintArea.Canvas, VerticeEdit.Value, Matrix, ResultArr);
        Visual.ShowModal();
    Finally
        Visual.Free();
    End;
End;

Function IsFileCorrect(Path: String): Boolean;
Var
    FileToCheck: TextFile;
    N: Integer;
    IsCorrect: Boolean;
    Null: String;
Begin
    AssignFile(FileToCheck, Path);
    Reset(FileToCheck);
    IsCorrect := True;
    Try
        Readln(FileToCheck, N);
        Readln(FileToCheck, Null);
    Except
        IsCorrect := False;
    End;
    If (N < 1) or (N > 15) then
    Begin
        IsCorrect := False;
    End;
    If (Null = '') then
        IsCorrect := False;
    CloseFile(FileToCheck);
    IsFileCorrect := IsCorrect;
End;

Function CheckFileMatrix(Matrix: TMatrix; N: Integer): Boolean;
Var
    I, J: Integer;
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    I := 0;
    While ((IsCorrect) and (I < N)) do
    Begin
        J := 0;
        While ((IsCorrect) and (J < N)) do
        Begin
            If (I = J) and (Matrix[I][J] = 1) then
                IsCorrect := False
            Else If (I <> J) and (Matrix[I][J] <> 0) and (Matrix[I][J] <> 1) then
                IsCorrect := False;
            Inc(J);
        End;
        Inc(I);
    End;
    Result := IsCorrect;
End;

Function GetMatrixFromFile(Path: String; N: Integer; Var IsCorrect: Boolean): TMatrix;
Var
    I, J: Integer;
    InputFile: TextFile;
    Matrix: TMatrix;
Begin
    SetLength(Matrix, N, N);
    I := 0;
    AssignFile(InputFile, Path);
    Reset(InputFile);
    Readln(InputFile);
    While ((IsCorrect) and (I < N)) do
    Begin
        J := 0;
        While ((IsCorrect) and (J < N)) do
        Begin
            Try
                Read(InputFile, Matrix[I, J]);
            Except
                IsCorrect := False;
            End;
            Inc(J);
        End;
        Inc(I);
    End;
    If (IsCorrect) then
        IsCorrect := CheckFileMatrix(Matrix, N);
    CloseFile(InputFile);
    GetMatrixFromFile := Matrix;
End;

Procedure GetDataFromFile(Path: String; Var N: Integer; Var Matrix: TMatrix;
  Var IsCorrect: Boolean);
Var
    InputFile: TextFile;
    Null: String;
    I: Integer;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Reset(InputFile);
    Except
        UnitError.FormError.LabelError.Caption := 'Ошибка получения данных из файла!';
        UnitError.FormError.ShowModal;
        UnitError.FormError.LabelError.Caption := '';
    End;
    If (IsCorrect) then
    Begin
        Try
            Reset(InputFile);
            Readln(InputFile, N);
        Except
            IsCorrect := False;
        End;
    End;
    If (IsCorrect) then
        Matrix := GetMatrixFromFile(Path, N, IsCorrect);
End;

Procedure TFormMain.OpenFileMenuClick(Sender: TObject);
Var
    N: Integer;
    I, J: Integer;
    IsCorrect: Boolean;
    Matrix: TMatrix;
Begin
    If OpenFromFile.Execute() Then
        If IsFileCorrect(OpenFromFile.FileName) Then
        Begin
            GetDataFromFile(OpenFromFile.FileName, N, Matrix, IsCorrect);
            If (IsCorrect) Then
            Begin
                BFSLabel.Caption := '';
                StartButton.Enabled := True;
                VerticeEdit.Value := N;
                sgMatrix.ColCount := VerticeEdit.Value + 1;
                sgMatrix.RowCount := VerticeEdit.Value + 1;
                For I := 2 to N do
                    sgMatrix.Cells[0, I] := '  ' + IntToStr(I);
                For J := 2 to N do
                    sgMatrix.Cells[J, 0] := '  ' + IntToStr(J);
                For I := 1 to N do
                Begin
                    For J := 1 to N do
                    Begin
                        sgMatrix.Cells[J, I] := IntToStr(Matrix[J - 1, I - 1]);
                    End;
                End;
                If (CheckFull()) then
                Begin
                    StartButton.Enabled := True;
                End
                Else
                Begin
                    StartButton.Enabled := False;
                End;
                SaveToFileBFSMenu.Enabled := False;
            End
            Else
            Begin
                UnitError.FormError.LabelError.Caption := 'Ошибка получения данных из файла!';
                UnitError.FormError.ShowModal;
                UnitError.FormError.LabelError.Caption := '';
            End;
        End
        Else
        Begin
            UnitError.FormError.LabelError.Caption := 'Ошибка получения данных из файла!';
            UnitError.FormError.ShowModal;
            UnitError.FormError.LabelError.Caption := '';
        End;
End;

Procedure TFormMain.SaveToFileBFSMenuClick(Sender: TObject);
Var
    OutputFile: TextFile;
    I, J, N: Integer;
    S: String;
Begin
    If ((SaveToFile.Execute()) and FileExists(SaveToFile.FileName)) then
    Begin
        AssignFile(OutputFile, SaveToFile.FileName);
        Try
            Rewrite(OutputFile);
        Except
            UnitError.FormError.LabelError.Caption := 'Ошибка доступа к файлу!';
            UnitError.FormError.ShowModal;
            UnitError.FormError.LabelError.Caption := '';
        End;
        N := VerticeEdit.Value;
        Writeln(OutputFile,'Количество вершин в графе:  ', N);
        Writeln(OutputFile,'Матрица смежности: ');
        For I := 1 to N do
        Begin
            For J := 1 to N do
            Begin
                Write(OutputFile, sgMatrix.Cells[J, I],' ');
            End;
            Writeln(OutputFile);
        End;
        S := 'Обход графа в ширину: ' + BFSLabel.Caption;
        Writeln(OutputFile, S);
        CloseFile(OutputFile);
    End
End;

Function TFormMain.CreateMatrix(): TMatrix;
Var
    Matrix: TMatrix;
    N, I, J: Integer;
Begin
    N := VerticeEdit.Value;
    SetLength(Matrix, N, N);
    For I := 0 to (N - 1) do
        For J := 0 to (N - 1) do
        Begin
            Matrix[I, J] := StrToInt(sgMatrix.Cells[J + 1, I + 1]);
        End;
    Result := Matrix;
End;

Function TFormMain.CheckFull: Boolean;
Var
    I, J: Integer;
    IsFull: Boolean;
Begin
    IsFull := True;
    For I := 1 to VerticeEdit.Value do
    Begin
        For J := 1 to VerticeEdit.Value do
        Begin
            If (sgMatrix.Cells[J,I] = '') then
                IsFull := False;
        End;
    End;
    Result := IsFull;
End;

Procedure TFormMain.VerticeEditChange(Sender: TObject);
Var
    I, J: Integer;
Begin
    sgMatrix.ColCount := VerticeEdit.Value + 1;
    sgMatrix.RowCount := VerticeEdit.Value + 1;
    sgMatrix.Cells[VerticeEdit.Value,0] := '  ' + IntToStr(VerticeEdit.Value);
    sgMatrix.Cells[0,VerticeEdit.Value] := '  ' + IntToStr(VerticeEdit.Value);
    sgMatrix.Cells[VerticeEdit.Value, VerticeEdit.Value] := '0';
    For I := 1 to VerticeEdit.Value do
    Begin
        sgMatrix.Cells[VerticeEdit.Value + 1, I] := '';
    End;
    For J := 1 to VerticeEdit.Value do
    Begin
        sgMatrix.Cells[J, VerticeEdit.Value + 1] := '';
    End;
    sgMatrix.Cells[VerticeEdit.Value + 1, VerticeEdit.Value + 1] := '';
    SaveToFileBFSMenu.Enabled := False;
    StartPointEdit.MaxValue := VerticeEdit.Value;
    If (StartPointEdit.Value > VerticeEdit.Value) then
        StartPointEdit.Value := VerticeEdit.Value;
    If CheckFull then
    Begin
        StartButton.Enabled := True;
    End
    Else
    Begin
        StartButton.Enabled := False;
    End;
    VisualButton.Enabled := False;

    BFSLabel.Caption := '';
End;

Procedure TFormMain.StartPointEditChange(Sender: TObject);
Begin
    If (StartPointEdit.Value > VerticeEdit.Value) then
        StartPointEdit.Value := VerticeEdit.Value;
    BFSLabel.Caption := '';
    VisualButton.Enabled := False;
    SaveToFileBFSMenu.Enabled := False;
End;

Procedure TFormMain.FormCreate(Sender: TObject);
Begin
    sgMatrix.Cells[1,0] := '  1';
    sgMatrix.Cells[0,1] := '  1';
    sgMatrix.Cells[1,1] := '0';
    Head := Nil;
    Tail := Nil;
End;

Procedure TFormMain.sgMatrixKeyPress(Sender: TObject; var Key: Char);
Var
    C, R: Byte;
Begin
    C := sgMatrix.Col;
    R := sgMatrix.Row;
    If Not (Key in ['0','1', #08]) then
        Key := #0;
    If (Length(sgMatrix.Cells[C, R]) = 1) and (Key <> #08) then
        Key := #0;
    If (C = R) then
        Key := #0;
End;

Procedure TFormMain.sgMatrixSetEditText(Sender: TObject; ACol, ARow: Integer; Const Value: String);
Begin
    If (ACol <> ARow) then
        sgMatrix.Cells[ARow, ACol] := Value;
    If CheckFull then
    Begin
        StartButton.Enabled := True;
    End
    Else
    Begin
        StartButton.Enabled := False;
    End;
    BFSLabel.Caption := '';
    VisualButton.Enabled := False;
    SaveToFileBFSMenu.Enabled := False;
End;

Procedure TFormMain.InfoAboutDeveloperClick(Sender: TObject);
Begin
    UnitAbout.FormAbout.ShowModal;
End;

Procedure TFormMain.TaskInfoClick(Sender: TObject);
Begin
    UnitInstruction_7_1.FormInstruction.ShowModal;
End;

Procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Begin
    CanClose := UnitExit.FormExit.ShowModal = mrOk;
End;

End.