(Delphi) lab7.2

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
    TMatrix = Array of Array of Integer;

  TFormMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    InfoLabel: TLabel;
    InfoLabel1: TLabel;
    SpinEdit: TSpinEdit;
    StringGrid: TStringGrid;
    StringGrid1: TStringGrid;
    Button1: TButton;
    A1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    OpenFromFile: TOpenDialog;
    SaveDialog: TSaveDialog;
    procedure AboutClick(Sender: TObject);
    procedure DeveloperInfoClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure SpinEditChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGridKeyPress(Sender: TObject; var Key: Char);
    procedure ClearStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure FindList;
    procedure FillStringGrid;
    procedure ClearGrid;
    procedure ClearList;
    procedure OpenFromFileMenuClick(Sender: TObject);
    procedure SaveToFileMenuClick(Sender: TObject);
    function IsInFileCorrect(const Path: String): Boolean;
    function IsMatrixCorrect(Matrix: TMatrix): Boolean;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

type
    TNode =^ Node;
    Node = Record
      pNumber: Integer;
      pNext: TNode;
end;

var
    Arr: Array of TNode;

procedure TFormMain.AboutClick(Sender: TObject);
begin
    application.MessageBox('Данная программа преобразовывает матрицу смежности в списки инцидентности', 'О программе');
end;

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

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
    WND: HWND;
    lpCaption, lpText: PChar;
    Tip: Integer;
begin
    WND := FormMain.Handle;
    lpCaption := 'Выход';
    lpText := 'Вы уверены, что хотите выйти?';
    Tip := MB_YESNO + MB_ICONINFORMATION + MB_DEFBUTTON2;
    case MessageBox(WND, lpText, lpCaption, Tip) Of
        IDYES : CanClose := True;
        IDNO : CanClose := False;
    end
end;

procedure TFormMain.ClearGrid;
var
    i,j: Integer;
begin
    for i := 1 to StringGrid1.ColCount do
        for j := 1 to StringGrid1.RowCount do
            StringGrid1.Cells[i, j] := '';
end;

procedure TFormMain.FormCreate(Sender: TObject);
var
    i: Integer;
begin
    for i := 1 to 2 do
    begin
        StringGrid1.Cells[0, i] := IntToStr(i);
        StringGrid.Cells[i, 0] := IntToStr(i);
        StringGrid.Cells[0, i] := IntToStr(i);
    end;
    ClearStringGrid;
end;

function TFormMain.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 TFormMain.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 ((Matrix[i,j] = 1) and (Matrix[j,i] <> 1)) then
                Answer := False;
            Inc(j);
        end;
        Inc(i);
    end;
    Result := Answer;
end;

procedure TFormMain.OpenFromFileMenuClick(Sender: TObject);
var
    i,j, Size: Integer;
    inFile: TextFile;
    Matrix: TMatrix;
    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
                N4.Enabled := True;
                Button1.Click;
            end
            else
            begin
                FormCreate(FormMain);
                SpinEdit.Value := 2;
            end;
        end
        else
            IsCorrect := False;
    end
    else
        IsCorrect := False;
    if not IsCorrect then
        Application.MessageBox('Работа с файлом некорректна', 'Ошибка', MB_ICONERROR);
end;

procedure TFormMain.FindList;
var
    i,j: Integer;
    Current, Temp: TNode;
begin
    SetLength(Arr,SpinEdit.Value);
    for i := 0 to Length(Arr) - 1 do
    begin
        for j := 1 to Length(Arr) do
            if StringGrid.Cells[j, i + 1] = '1' then
            begin
                New(Temp);
                Temp.pNumber := j;
                Temp.pNext := nil;
                if Arr[i] = nil then
                    Arr[i] := Temp
                else
                begin
                    Current := Arr[i];
                    while Current.pNext <> nil do
                        Current := Current.pNext;
                    Current.pNext := Temp
                end;
            end;
    end;
end;

procedure TFormMain.FillStringGrid;
var
    Current: TNode;
    i, Counter: Integer;
begin
    StringGrid1.Enabled := True;
    for i := 0 to Length(Arr)  - 1 do
    begin
        Counter := 1;
        Current := Arr[i];
        while Current <> nil do
        begin
            StringGrid1.Cells[Counter, i + 1] := IntToStr(Current.pNumber);
            Inc(Counter);
            Current := Current.pNext;
        end;
    end;
    StringGrid1.Enabled := False;
end;

procedure TFormMain.ClearList;
var
    Current, Prev: TNode;
    i: Integer;
begin
    for i := 0 to Length(Arr) - 1 do
    begin
        while Arr[i] <> nil do
        begin
            Current := Arr[i];
            while Current.pNext <> nil do
            begin
                Prev := Current;
                Current := Current.pNext;
            end;
            if Current <> Arr[i] then
            begin
                Prev.pNext := nil;
            end
            else
                Arr[i] := nil;
            Dispose(Current);
        end;
    end;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
    ClearGrid;
    ClearList;
    FindList;
    FillStringGrid;
    N4.Enabled := True;
end;

procedure TFormMain.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 TFormMain.SaveToFileMenuClick(Sender: TObject);
var
    OutputFile: TextFile;
    i,j: Integer;
begin
    if SaveDialog.Execute() and FileExists(SaveDialog.FileName) then
    begin
        AssignFile(OutputFile, SaveDialog.FileName);
        try
            Rewrite(OutputFile);
            Writeln(OutputFile,'Списки инцинденций:');
            for i := 1 to SpinEdit.Value do
            begin
                j := 1;
                Write(OutputFile,IntToStr(i) + ': ');
                while (StringGrid1.Cells[j +1 ,i] <> '') do
                begin
                    Write(OutputFile,StringGrid1.Cells[j,i] + ' --> ');
                    Inc(j);
                end;
                Writeln(OutputFile,StringGrid1.Cells[j,i]);
            end;
            CloseFile(OutputFile);
            Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение', MB_ICONINFORMATION);
        except
            Application.MessageBox('Отказано в доступе! Измените параметры файла! ', 'Ошибка!', MB_ICONERROR);
        end;
    end
    else
        Application.MessageBox('Введено некорректное имя файла', 'Ошибка!', MB_ICONERROR);
end;

procedure TFormMain.SpinEditChange(Sender: TObject);
begin
    if (SpinEdit.Value >= StringGrid.ColCount) then
    begin

        repeat
            ClearStringGrid;
            ClearGrid;
            StringGrid.ColCount := StringGrid.ColCount + 1;
            StringGrid.RowCount := StringGrid.RowCount + 1;
            StringGrid1.RowCount := StringGrid1.RowCount + 1;
            StringGrid1.ColCount := StringGrid1.ColCount + 1;
            StringGrid1.Cells[0, StringGrid1.RowCount - 1] := IntToStr(StringGrid1.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;
            ClearGrid;
            StringGrid.Cells[StringGrid.RowCount, 0] := '';
            StringGrid.Cells[0, StringGrid.RowCount] := '';
            StringGrid1.Cells[0, StringGrid1.RowCount] := '';
            StringGrid1.ColCount := StringGrid1.ColCount - 1;
            StringGrid1.RowCount := StringGrid1.RowCount - 1;
            StringGrid.ColCount := StringGrid.ColCount - 1;
            StringGrid.RowCount := StringGrid.RowCount - 1;
        until(SpinEdit.Value = StringGrid.ColCount - 1);
    end;
end;



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

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

end.