7.2

unit UnitMain;

interface

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

type
  TFormMain = class(TForm)
    StringGrid: TStringGrid;
    Edit: TEdit;
    Label1: TLabel;
    ButtonCreate: TButton;
    ButtonFind: TButton;
    MatrixGrid: TStringGrid;
    MainMenu: TMainMenu;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    NFile: TMenuItem;
    NInstruction: TMenuItem;
    NAbout: TMenuItem;
    NOpenFile: TMenuItem;
    NSaveFile: TMenuItem;
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure EditChange(Sender: TObject);
    procedure ButtonCreateClick(Sender: TObject);
    procedure StringGridKeyPress(Sender: TObject; var Key: Char);
    procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure ButtonFindClick(Sender: TObject);
    procedure NInstructionClick(Sender: TObject);
    procedure NAboutClick(Sender: TObject);
    procedure NOpenFileClick(Sender: TObject);
    procedure NSaveFileClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses UnitAbout, UnitError, UnitExit, UnitInstruction_7_2;

type
    TArr = Array of Integer;
    TMatrix = Array of TArr;

var
    Count: Integer;

function CheckRow(Str: TStringGrid; ARow, VerCount: Integer): Boolean;
var
    I: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := true;
    I := 1;
    if (Str.Cells[I, Arow].IsEmpty) then
    begin
        IsCorrect := false;
    end
    else
    begin
        I := 2;
        while (I < VerCount) and (IsCorrect) do
        begin
            if not(Str.Cells[I, ARow].IsEmpty) and
            ((StrToInt(Str.Cells[I, Arow]) < StrToInt(Str.Cells[I - 1, ARow]))
            or (StrToInt(Str.Cells[I, Arow]) > VerCount)) then
            begin
                IsCorrect := false;
            end;
            Inc(I);
        end;
    end;
    CheckRow := IsCorrect;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
    ButtonFind.Enabled := true;
end;

procedure TFormMain.ButtonCreateClick(Sender: TObject);
var
    I: Integer;
begin
    Count := StrToInt(Edit.Text);
    StringGrid.RowCount := Count;
    StringGrid.ColCount := Count + 1;
    ButtonCreate.Enabled := false;
    for I := 1 to Count do
    begin
        StringGrid.Cells[0, I - 1] := '№' + IntToStr(I);
    end;
    StringGrid.Enabled := true;
    ButtonFind.Enabled := true;
end;

function GetArrFromRow(Str: TStringGrid; ARow: Integer): TArr;
var
    I, Count: Integer;
    A: TArr;
begin
    I := 1;
    Count := 0;
    while (I < Str.ColCount) and not(Str.Cells[I, ARow].IsEmpty)do
    begin
        Inc(Count);
        Inc(I);
    end;
    SetLength(A, Count);
    I := 1;
    while (I < Str.ColCount) and not(Str.Cells[I, ARow].IsEmpty)do
    begin
        A[I - 1] := StrToInt(Str.Cells[I, ARow]);
        Inc(I);
    end;
    GetArrFromRow := A;
end;

function GetListFromStringGrid(Str: TStringGrid): TMatrix;
var
    M: TMatrix;
    A: TArr;
    I: Integer;
begin
    SetLength(M, Str.RowCount);
    for I := 0 to High(M) do
    begin
        A := GetArrFromRow(Str, I);
        SetLength(M[I], Length(A));
        M[I] := A;
    end;
    GetListFromStringGrid := M;
end;

procedure MakeZeroMatrix(var M: TMatrix);
var
    I, J: Integer;
begin
    for I := 0 to High(M) do
    begin
        for J := 0 to High(M) do
        begin
            M[I][J] := 0;
        end;
    end;
end;

function GetMatrixFromList(List: TMatrix; Count: Integer): TMatrix;
var
    I, J: Integer;
    Matrix: TMatrix;
begin
    SetLength(Matrix, Count, Count);
    MakeZeroMatrix(Matrix);
    for I := 0 to High(List) do
    begin
        for J := 0 to High(List[I]) do
        begin
            Matrix[I][List[I][J] - 1] := 1;
        end;
    end;
    GetMatrixFromList := Matrix;
end;

procedure FillMatrix(var Str: TStringGrid; Matrix: TMatrix);
var
    I, J: Integer;
begin
    Str.ColCount := Length(Matrix);
    Str.RowCount := Length(Matrix);
    for I := 0 to High(Matrix) do
    begin
        for J := 0 to High(Matrix) do
        begin
            Str.Cells[I, J] := IntToStr(Matrix[I][J]);
        end;
    end;
end;

procedure TFormMain.ButtonFindClick(Sender: TObject);
var
    I: Integer;
    IsCorrect: Boolean;
    Matrix, List: TMatrix;
begin
    IsCorrect := true;
    I := 0;
    while (I < StringGrid.RowCount) and (IsCorrect) do
    begin
        if not(CheckRow(StringGrid, I, StringGrid.RowCount)) then
        begin
            IsCorrect := false;
        end;
        Inc(I);
    end;
    if (IsCorrect) then
    begin
        List := GetListFromStringGrid(StringGrid);
        Matrix := GetMatrixFromList(List, StringGrid.RowCount);
        FillMatrix(MatrixGrid, Matrix);
        NSaveFile.Enabled := true;
    end
    else
    begin
        UnitError.FormError.LabelError.Caption := 'Проверьте корректность ввода списков!';
        UnitError.FormError.ShowModal;
        UnitError.FormError.LabelError.Caption := '';
        NSaveFile.Enabled := false;
    end;
end;

procedure TFormMain.EditChange(Sender: TObject);
begin
    if Edit.Text <> '' then
        ButtonCreate.Enabled := true
    else
        ButtonCreate.Enabled := false;
    StringGrid.Enabled := false;
    ButtonFind.Enabled := false;
end;

procedure TFormMain.EditKeyPress(Sender: TObject; var Key: Char);
begin
    if not(Key in ['2'..'9', #8]) then
        Key := #0;
end;

procedure TFormMain.NAboutClick(Sender: TObject);
begin
    UnitAbout.FormAbout.ShowModal;
end;

procedure TFormMain.NInstructionClick(Sender: TObject);
begin
    UnitInstruction_7_2.FormInstruction.ShowModal;
end;

procedure TFormMain.NOpenFileClick(Sender: TObject);
var
    F: TextFile;
    Path: String;
    IsCorrect: Boolean;
    Number, I, J, Vertex: Integer;
begin
    IsCorrect := true;
    if OpenDialog.Execute then
    begin
        Path := OpenDialog.FileName;
        try
            AssignFile(F, Path);
            Reset(F);
            try
                Readln(F, Number);
                Edit.Text := IntToStr(Number);
                ButtonCreateClick(Sender);
                I := 0;
                while (I < Number) do
                begin
                    J := 0;
                    while (J < Number + 1) do
                    begin
                        Read(F, Vertex);
                        if Vertex > 0 then
                        begin
                            StringGrid.Cells[J + 1, I] := IntToStr(Vertex);
                        end
                        else
                        begin
                            J := Number;
                        end;
                        Inc(J);
                    end;
                    Inc(I);
                end;
                if not(EoF(F)) then
                begin
                    IsCorrect := false;
                end;
            finally
                CloseFile(F);
            end;
        except
            UnitError.FormError.LabelError.Caption := 'Возникла ошибка при считывании списка из файла!';
            UnitError.FormError.ShowModal;
            UnitError.FormError.LabelError.Caption := '';
        end;
    end;
    if not(IsCorrect) then
    begin
        UnitError.FormError.LabelError.Caption := 'В файле найдены лишние элементы!';
        UnitError.FormError.ShowModal;
        UnitError.FormError.LabelError.Caption := '';
    end;
end;

procedure TFormMain.NSaveFileClick(Sender: TObject);
var
    F: TextFile;
    Path: String;
    I, J: Integer;
begin
    if SaveDialog.Execute then
    begin
        Path := SaveDialog.FileName;
        try
            AssignFile(F, Path);
            Rewrite(F);
            try
                Writeln(F, 'Матрица смежности:');
                I := 0;
                while (I < MatrixGrid.ColCount) do
                begin
                    J := 0;
                    while (J < MatrixGrid.RowCount) do
                    begin
                        Write(F, MatrixGrid.Cells[I, J], ' ');
                        Inc(J);
                    end;
                    Writeln(F, '');
                    Inc(I);
                end;
            finally
                CloseFile(F);
            end;
        except
            UnitError.FormError.LabelError.Caption := 'Возникла ошибка при считывании списка из файла!';
            UnitError.FormError.ShowModal;
            UnitError.FormError.LabelError.Caption := '';
        end;
    end;
end;

procedure TFormMain.StringGridKeyPress(Sender: TObject; var Key: Char);
var
    Row, Col: Integer;
begin
    Row := StringGrid.Row;
    Col := StringGrid.Col;
    if not(Key in ['1'..'9', #8]) then
        Key := #0;
    if (length(StringGrid.Cells[Col, Row]) = 1) and not(Key in [#8])then
        Key := #0;
    try
        if (Col > 1) and (Ord(Key) <= Ord(StringGrid.Cells[Col - 1, Row][1])) and not(Key = #8) then
            Key := #0;
    except
        UnitError.FormError.LabelError.Caption := 'Ввод значения не возможен, т.к. предыдущая ячейка не заполнена!';
        UnitError.FormError.ShowModal;
        UnitError.FormError.LabelError.Caption := '';
    end;
    if (Col > 0) and (Ord(Key) > Ord(Edit.Text[1])) and not(Key = #8) then
        Key := #0;
    if (StringGrid.Cells[Col - 1, Row].IsEmpty) then
        Key := #0;
end;

procedure TFormMain.StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
    if (ACol <> (Count - 1)) and not(StringGrid.Cells[ACol + 1, ARow].IsEmpty)
    and not(StringGrid.Cells[ACol - 1, ARow].IsEmpty) then
        CanSelect := false;
end;

end.