unit Unit2;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin,
    Vcl.Menus, Graph, LinkList, MatrixInt, Node, Vcl.ExtCtrls, Vcl.Grids;

type
    // TIntMatrix = Array of Array of Integer;
    TIntMatrix = TMatrixInt;
    TIntArr = TArrInt;
    TLabelMatrix = Array of Array of TLabel;

    TMainForm = class(TForm)
        Label1: TLabel;
        MainMenu1: TMainMenu;
        NInputClick: TMenuItem;
        SaveDialog1: TSaveDialog;
        OpenDialog1: TOpenDialog;
        SpinEditLine: TSpinEdit;
        SpinEditColumn: TSpinEdit;
        Label3: TLabel;
        Label4: TLabel;
        ButtonCreate: TButton;
        Label5: TLabel;
        ButtonResult: TButton;
        Label6: TLabel;
        Label7: TLabel;
        ButtonDelete: TButton;
        EditTest: TEdit;
        N1: TMenuItem;
        N2: TMenuItem;
        PopupMenu1: TPopupMenu;
        N3: TMenuItem;
        N4: TMenuItem;
        MatrixGrid: TStringGrid;
        procedure SpinEditLineKeyPress(Sender: TObject; var Key: Char);
        procedure ButtonCreateClick(Sender: TObject);
        procedure ButtonDeleteClick(Sender: TObject);
        procedure EditTestKeyPress(Sender: TObject; var Key: Char);
        procedure ButtonResultClick(Sender: TObject);
        procedure NInputClickClick(Sender: TObject);
        procedure N2Click(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
        procedure NOutputClickClick(Sender: TObject);
        procedure SpinEditLineKeyDown(Sender: TObject; var Key: Word;
          Shift: TShiftState);
        procedure EditTestKeyDown(Sender: TObject; var Key: Word;
          Shift: TShiftState);
        Function CheckFileExtension(Address: String): Boolean;
        Procedure OutputFile(Address: String);
        procedure N3Click(Sender: TObject);
        procedure N4Click(Sender: TObject);
        function CheckMatrix(): Boolean;
        procedure FormCreate(Sender: TObject);
        procedure MatrixGridClick(Sender: TObject);
        procedure ClearMatrix();

    private
        { Private declarations }
    public
        { Public declarations }
    end;

const
    MAX_LINE_MATRIX = 7;
    MAX_COLUMN_MATRIX = 15;
    MIN_SIZE_MATRIX = 2;

var
    MainForm: TMainForm;
    MatrixInt: TIntMatrix;
    MatrixResult: TLabelMatrix;
    ListCycle: TLinkList<String>;

implementation

{$R *.dfm}

uses OutputGraph;

function TMainForm.CheckMatrix(): Boolean;
var
    I, J: Integer;
begin
    ButtonResult.Enabled := true;
    try
        for I := 1 to MatrixGrid.RowCount-1 do
            for J := 1 to MatrixGrid.ColCount-1 do
                if not ((StrToInt(MatrixGrid.Cells[J, I]) = 0) or
                  (StrToInt(MatrixGrid.Cells[J, I]) = 1)) then
                    ButtonResult.Enabled := false;
    except
        ButtonResult.Enabled := false;
    end;
    if not ButtonResult.Enabled then
        MessageDlg('Матрица задана некорректно', mtError, [mbOK], 0);
    CheckMatrix := ButtonResult.Enabled;
end;

procedure TMainForm.EditTestKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    TEdit(Sender).ReadOnly := (Shift = [ssShift]) or (Shift = [ssCtrl]);
end;

procedure TMainForm.EditTestKeyPress(Sender: TObject; var Key: Char);
begin
    With (Sender as TEdit) do
    begin
        if not(Key in ['0' .. '1', #8]) then
            Key := #0;
        if (Length(Text) > 0) and not(Key = #8) then
            Key := #0;
    end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    if MessageDlg('Вы действительно хотите выйти?', mtWarning, [mbYes, mbNo], 0)
      = mrNo then
        CanClose := false;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    MatrixGrid.Cells[0, 1] := '1';
    MatrixGrid.Cells[0, 2] := '2';
    MatrixGrid.Cells[1, 0] := 'A';
    MatrixGrid.Cells[2, 0] := 'B';
end;

procedure TMainForm.MatrixGridClick(Sender: TObject);
begin
    ButtonResult.Enabled := true;
end;

Procedure CreateMatrix(Line, Column: Integer);
begin
    MainForm.MatrixGrid.RowCount := Line+1;
    MainForm.MatrixGrid.ColCount := Column+1;
    MainForm.MatrixGrid.Height := MainForm.MatrixGrid.RowCount * 22;
    MainForm.MatrixGrid.Width := MainForm.MatrixGrid.ColCount * 22;
end;

procedure TMainForm.ButtonCreateClick(Sender: TObject);
var
    Line, Column, I, J: Integer;
    IsCorrect: Boolean;
begin

    IsCorrect := true;
    Line := SpinEditLine.Value;
    Column := SpinEditColumn.Value;
    for I := 1 to Line do
        MatrixGrid.Cells[0, I] := IntToStr(I);
    for I := 1 to Column do
        MatrixGrid.Cells[I, 0] := Chr(Ord('A') + I - 1);
    if ((Line > MAX_LINE_MATRIX) or (Column > MAX_COLUMN_MATRIX)) and IsCorrect
    then
    begin
        MessageDlg('Размеры матрицы не должны превышать 7', mtError, [mbOK], 0);
        IsCorrect := false;
    end;
    if IsCorrect then
    begin
        CreateMatrix(Line, Column);
        ButtonDelete.Enabled := true;
        ButtonCreate.Enabled := false;
        SpinEditLine.Enabled := false;
        SpinEditColumn.Enabled := false;
        NInputClick.Enabled := false;
    end;
end;

procedure TMainForm.ClearMatrix();
var
    I, J: Integer;
begin
    for I := 1 to MatrixGrid.RowCount do
        for J := 1 to MatrixGrid.ColCount do
            MatrixGrid.Cells[J, I] := '';
end;

procedure TMainForm.ButtonDeleteClick(Sender: TObject);
var
    I, J, Num: Integer;
begin
    ButtonDelete.Enabled := false;
    ButtonCreate.Enabled := true;
    SpinEditLine.Enabled := true;
    SpinEditColumn.Enabled := true;
    NInputClick.Enabled := true;
    ClearMatrix();
end;

Procedure FillMatrix(Var MatrixInt: TIntMatrix);
var
    I, J: Integer;
begin
    SetLength(MatrixInt, MainForm.MatrixGrid.RowCount - 1,
      MainForm.MatrixGrid.ColCount - 1);
    for I := 0 to High(MatrixInt) do
        for J := 0 to High(MatrixInt[I]) do
            MatrixInt[I][J] :=
              StrToInt(MainForm.MatrixGrid.Cells[J + 1, I + 1]);
end;

function IsGraphExist(Matrix: TIntMatrix): Boolean;
var
    Temp, I, J: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := true;
    for J := 0 to High(Matrix[0]) do
    begin
        Temp := 0;
        for I := 0 to High(Matrix) do
            if Matrix[I][J] = 1 then
                Inc(Temp);
        if (Temp <> 2) and (Temp <> 0) then
        begin
            MessageDlg('По данной матрице невозможно построить граф', mtError,
              [mbOK], 0);
            IsCorrect := false;
        end;
    end;
    IsGraphExist := IsCorrect;
end;

function FillArrCycle(Line: String): TIntArr;
var
    I, J: Integer;
    Arr: TIntArr;
begin
    SetLength(Arr, (Length(Line) - 6) div 2);
    J := 0;
    I := 7;
    while (I < Length(Line)) do
    begin
        Arr[J] := StrToInt(Line[I]);
        Inc(J);
        I := I + 2;
    end;
    FillArrCycle := Arr;
end;

procedure OutputGrpah(Graph: TGraph);
var
    Arr: TIntArr;
begin
    Arr := FillArrCycle(Graph.HamiltonianCycle.GetLinkByIndex(1).GetData);
    FormOutputGraph.FillLabelCyrcle(Graph.HamiltonianCycle);
    FormOutputGraph.PrintGraph(Graph.GetAdjMat, Arr);
    FormOutputGraph.ShowModal;
end;

procedure CreateGraph(MatrixInt: TIntMatrix);
var
    Graph: TGraph;
begin
    Graph := TGraph.Create(Length(MatrixInt));
    Graph.FillAdjMat(MatrixInt);
    ListCycle := Graph.HamiltonianCycle;
    if ListCycle.GetSize = 0 then
        MessageDlg('В данном графе отсутсвуют гамильтоновы циклы', mtError,
          [mbOK], 0)
    else
        OutputGrpah(Graph);
end;

procedure TMainForm.ButtonResultClick(Sender: TObject);
var
    MatrixInt: TIntMatrix;
    Arr: TIntArr;
begin
    if CheckMatrix then
    begin
        FillMatrix(MatrixInt);
        if IsGraphExist(MatrixInt) then
            CreateGraph(MatrixInt);
    end;
end;

procedure TMainForm.SpinEditLineKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    TEdit(Sender).ReadOnly := (Shift = [ssShift]) or (Shift = [ssCtrl]);
end;

procedure TMainForm.SpinEditLineKeyPress(Sender: TObject; var Key: Char);
begin
    Key := #0;
end;

Function CheckNumberOfLines(Address: String): Integer;
Var
    Line, Num: Integer;
    InputFile: TextFile;
Begin
    AssignFile(InputFile, Address);
    Reset(InputFile);
    Line := 0;
    While (Not SeekEof(InputFile)) Do
    Begin
        Read(InputFile, Num);
        If (SeekEoln(InputFile)) Then
            Inc(Line);
    End;
    Close(InputFile);
    CheckNumberOfLines := Line;
End;

Function CheckNumberOfColumns(Address: String): Integer;
Var
    Columns, Num: Integer;
    InputFile: TextFile;
Begin
    AssignFile(InputFile, Address);
    Reset(InputFile);
    Columns := 0;
    While (Not SeekEoln(InputFile)) Do
    Begin
        Read(InputFile, Num);
        Inc(Columns);
    End;
    Close(InputFile);
    CheckNumberOfColumns := Columns;
End;

Procedure ReadFile(Address: String);
Var
    InputFile: TextFile;
    Lines, Columns, I, J, Temp: Integer;
Begin
    Lines := CheckNumberOfLines(Address);
    Columns := CheckNumberOfColumns(Address);
    CreateMatrix(Lines, Columns);
    AssignFile(InputFile, Address);
    Reset(InputFile);
    Dec(Lines);
    Dec(Columns);
    For I := 0 To Lines Do
        For J := 0 To Columns Do
        begin
            Read(InputFile, Temp);
            MainForm.MatrixGrid.Cells[J + 1, I + 1] := IntToStr(Temp);
        end;
    Close(InputFile);
End;

Function IsCorrectSizeFile(Address: String): Boolean;
Var
    IsCorrect: Boolean;
    InputFile: TextFile;
Begin
    AssignFile(InputFile, Address);
    Reset(InputFile);
    If (EoF(InputFile)) Then
    Begin
        MessageDlg('Файл пустой', mtError, [mbOK], 0);
        IsCorrect := false;
    End
    Else
        IsCorrect := true;
    Close(InputFile);
    IsCorrectSizeFile := IsCorrect;
End;

Procedure PrintErrorFile(IsCorrect: Boolean);
Begin
    If (Not IsCorrect) Then
        MessageDlg('Данные в указанном файле не соответствуют условию', mtError,
          [mbOK], 0);
End;

Function TMainForm.CheckFileExtension(Address: String): Boolean;
Var
    N: Integer;
    IsCorrect: Boolean;
Begin
    N := Length(Address);
    IsCorrect := false;
    if (Address[N] = 't') and (Address[N - 1] = 'x') and (Address[N - 2] = 't')
    then
        IsCorrect := true
    else
        MessageDlg('Файл должен иметь расширение .txt', mtError, [mbOK], 0);
    CheckFileExtension := IsCorrect;
End;

Function IsCorrectFile(Address: String): Boolean;
Var
    IsCorrect: Boolean;
    InputFile: TextFile;
    Num: Integer;
Begin
    AssignFile(InputFile, Address);
    Reset(InputFile);
    IsCorrect := true;
    While ((Not EoF(InputFile)) And IsCorrect) Do
    Begin
        Try
            Read(InputFile, Num);
            if (Num <> 0) and (Num <> 1) then
                IsCorrect := false;
        Except
            IsCorrect := false;
        End;
    End;
    Close(InputFile);
    if IsCorrect then
    begin
        if (CheckNumberOfLines(Address) < MIN_SIZE_MATRIX) or
          ((CheckNumberOfColumns(Address) < MIN_SIZE_MATRIX)) then
            IsCorrect := false;
        if (CheckNumberOfLines(Address) > MAX_LINE_MATRIX) or
          ((CheckNumberOfColumns(Address) > MAX_COLUMN_MATRIX)) then
            IsCorrect := false;
    end;
    PrintErrorFile(IsCorrect);
    IsCorrectFile := IsCorrect;
End;

Function IsFileExist(Address: String): Boolean;
Var
    IsCorrect: Boolean;
Begin
    If FileExists(Address) Then
        IsCorrect := true
    Else
    Begin
        IsCorrect := false;
        MessageDlg('Указанного файла не существует', mtError, [mbOK], 0);
    End;
    IsFileExist := IsCorrect;
End;

procedure TMainForm.N2Click(Sender: TObject);
begin
    MainForm.Close;
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
    MessageBox(Application.Handle,
      'Выполнила студентка группы 051007, Герасимович Дарья',
      'Об авторе', mb_ok);
end;

procedure TMainForm.N4Click(Sender: TObject);
begin
    MessageBox(Application.Handle,
      'Граф задан матрицей инциденций. Разработать программу нахождения ' +
      #10#13 + 'всех гамильтоновых циклов в графе. Граф визуализировать. Найденный цикл выделить цветом.',
      'О программе', mb_ok);
end;

procedure TMainForm.NInputClickClick(Sender: TObject);
var
    InputFile: TextFile;
    IsCorrect: Boolean;
begin
    repeat
        IsCorrect := true;
        if OpenDialog1.Execute then
        begin
            IsCorrect := IsFileExist(OpenDialog1.FileName) and
              CheckFileExtension(OpenDialog1.FileName) and
              IsCorrectSizeFile(OpenDialog1.FileName) and
              IsCorrectFile(OpenDialog1.FileName);
            if IsCorrect then
            begin
                ReadFile(OpenDialog1.FileName);
                SpinEditLine.Value := CheckNumberOfLines(OpenDialog1.FileName);
                SpinEditColumn.Value :=
                  CheckNumberOfColumns(OpenDialog1.FileName);
                ButtonDelete.Enabled := true;
                ButtonCreate.Enabled := false;
                SpinEditLine.Enabled := false;
                SpinEditColumn.Enabled := false;
                NInputClick.Enabled := false;
            end;
        end;
    until IsCorrect;
end;

Procedure TMainForm.OutputFile(Address: String);
Var
    OutputFile: TextFile;
    IsCorrect: Boolean;
    I, J: Integer;
Begin
    AssignFile(OutputFile, Address);
    Rewrite(OutputFile);
    Writeln(OutputFile, 'Матрица: ');
    for I := 0 to MatrixGrid.RowCount - 1 do
    begin
        for J := 0 to MatrixGrid.ColCount - 1 do
            Write(OutputFile, MatrixGrid.Cells[J + 1, I + 1] + ' ');
        Writeln(OutputFile);
    end;
    Writeln(OutputFile, 'Гамильтоновы циклы: ');
    for I := 1 to ListCycle.GetSize do
    begin
        Writeln(OutputFile, IntToStr(I) + '-ый ' + ListCycle.GetLinkByIndex
          (I).GetData);
    end;
    CloseFile(OutputFile);
End;

procedure TMainForm.NOutputClickClick(Sender: TObject);
var
    IsCorrect: Boolean;
begin
    repeat
        IsCorrect := true;
        if SaveDialog1.Execute then
        begin
            IsCorrect := CheckFileExtension(SaveDialog1.FileName);
            if IsCorrect then
            begin
                OutputFile(SaveDialog1.FileName);
                ShowMessage('Результат успешно сохранён');
            end;
        end;
    until IsCorrect;
end;

end.