Lab.7.1.Full(Delphi)

Unit UnitVCLMain;

Interface

Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    System.ImageList,
    Vcl.ImgList,
    Vcl.VirtualImageList,
    Vcl.Menus,
    Vcl.StdCtrls,
    Vcl.Buttons,
    Vcl.WinXCtrls,
    Vcl.ExtCtrls,
    Vcl.Grids,
    ClipBrd,
    System.Actions,
    Vcl.ActnList;

Type

    TMatrix = Array Of Array Of Integer;

    TLabeledEdit = Class(Vcl.ExtCtrls.TLabeledEdit)
    Protected
        Procedure WMPaste(Var Msg: TMessage); Message WM_PASTE;
    End;

    TfrmMain = Class(TForm)
        VilButtons: TVirtualImageList;
        SvdSaveToFileDialog: TSaveDialog;
        BalloonHint: TBalloonHint;
        OpdOpenFromFileDialog: TOpenDialog;
        PTop: TPanel;
        PClient: TPanel;
        SplvMenu: TSplitView;
        SdbtExit: TSpeedButton;
        SdbtSaveToFile: TSpeedButton;
        SdbtOpenFromFile: TSpeedButton;
        SdbtStart: TSpeedButton;
        SdbtMenu: TSpeedButton;
        SdbtHelp: TSpeedButton;
        LbWelcome: TLabel;
        LbTaskInfo: TLabel;
        LbeNodesRequirement: TLabeledEdit;
        StrgrMatrix: TStringGrid;
        LbMatrixRequirement: TLabel;
        BtGetMatrix: TButton;
        SdbtAboutDeveloper: TSpeedButton;
        Procedure SdbtMenuClick(Sender: TObject);
        Procedure SdbtAboutDeveloperClick(Sender: TObject);
        Procedure SdbtHelpClick(Sender: TObject);
        Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
        Procedure SdbtExitClick(Sender: TObject);
        Procedure BtGetMatrixClick(Sender: TObject);
        Procedure SdbtStartClick(Sender: TObject);
        Procedure LbeNodesRequirementChange(Sender: TObject);
        Procedure SdbtOpenFromFileClick(Sender: TObject);
        Procedure SdbtSaveToFileClick(Sender: TObject);
    Private
        IntendencyMatrix: TMatrix;
        Function CheckInput(): Boolean;
        Function GetMatrix(): Boolean;
        Procedure ConvertMatrix();
    Public
        AdjacencyMatrix: TMatrix;
    End;

Var
    FrmMain: TfrmMain;

Implementation

{$R *.dfm}

Uses UnitData,
    UnitMain,
    UnitVCLMatrix;

{ бэк }

Function IsFileCorrect(Path: String): Boolean;
Const
    MIN_SIZE = 2;
    MAX_SIZE = 10;
Var
    InputFile: TextFile;
    IsCorrect: Boolean;
    Size, I, J: Integer;
    Matrix: TMatrix;
Begin
    AssignFile(InputFile, Path);
    IsCorrect := True;

    Try
        Try
            Reset(InputFile);
            Readln(InputFile, Size);

            If (Size < MIN_SIZE) Or (Size > MAX_SIZE) Then
                IsCorrect := False
            Else
            Begin
                SetLength(Matrix, Size, Size);
                I := 0;

                While (IsCorrect) And (I < Size) Do
                Begin
                    J := 0;

                    While (IsCorrect) And (J < Size) Do
                    Begin
                        Read(InputFile, Matrix[I, J]);
                        If (Matrix[I, J] < 0) Or (Matrix[I, J] > Size) Then
                            IsCorrect := False;
                        Inc(J);
                    End;

                    Inc(I);
                End;
            End;
        Finally
            CloseFile(InputFile);
        End;
    Except
        IsCorrect := False;
    End;

    IsFileCorrect := IsCorrect;
End;

Procedure GetSizeFromFile(Const Path: String; Var Size: Single; Var IsCorrect: Boolean);
Var
    InputFile: TextFile;
    Null: String;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Try
            Reset(InputFile);
            Readln(InputFile, Null);

            If (Null <> '') Then
                IsCorrect := True
            Else
            Begin
                IsCorrect := False;
                Application.MessageBox('Файл пуст!', 'Ошибка', MB_ICONERROR);
            End;
        Finally
            Close(InputFile);
        End;
    Except
        Application.MessageBox('Ошибка доступа!', 'Ошибка', MB_ICONERROR);
    End;

    If (IsCorrect) Then
    Begin
        Try
            Try
                Reset(InputFile);
                Readln(InputFile, Size);
            Finally
                Close(InputFile);
            End;
        Except
            IsCorrect := False;
        End;
    End;
End;

Function GetMatrixFromFile(Const Path: String; Const Size: Single; Var Matrix: TMatrix; Var IsCorrect: Boolean): TMatrix;
Var
    InputFile: TextFile;
    I, J: Integer;
    Null: String;
Begin
    IsCorrect := True;
    Try
        AssignFile(InputFile, Path);
        Reset(InputFile);
        Readln(InputFile, Null);
        If (Null <> '') Then
            IsCorrect := True
        Else
        Begin
            IsCorrect := False;
            Application.MessageBox('Данные в файле введены неверно или отсутствуют!', 'Ошибка', MB_ICONERROR);
        End;

    Except
        Application.MessageBox('Ошибка доступа!', 'Ошибка', MB_ICONERROR);
    End;

    If (IsCorrect) Then
    Begin
        Try
            Reset(InputFile);
            Readln(InputFile);
            For I := Low(Matrix) To High(Matrix) Do
                For J := Low(Matrix[0]) To High(Matrix[0]) Do
                    Read(InputFile, Matrix[I, J]);
        Except
            IsCorrect := False;
        End;
        Close(InputFile);
    End;

    GetMatrixFromFile := Matrix;
End;

Function TfrmMain.CheckInput: Boolean;
Var
    I, J: Integer;
Begin
    For J := 0 To StrgrMatrix.RowCount - 1 Do
    Begin
        I := 1;
        While (I < StrgrMatrix.RowCount) And (StrgrMatrix.Cells[I, J] <> '0') Do
        Begin
            If (StrgrMatrix.Cells[I, J] = '') Or (StrToInt(StrgrMatrix.Cells[I, J]) < 0) Or (StrToInt(StrgrMatrix.Cells[I, J]) > StrgrMatrix.RowCount)
                Or (StrToInt(StrgrMatrix.Cells[I, J]) = J + 1) Then
            Begin
                CheckInput := False;
                Break;
            End
            Else
                CheckInput := True;
            Inc(I);
        End;
    End;
End;

Function TfrmMain.GetMatrix(): Boolean;
Var
    I, J: Integer;
Begin
    SetLength(IntendencyMatrix, StrgrMatrix.RowCount, StrgrMatrix.RowCount);
    GetMatrix := True;
    If CheckInput() Then
        For I := 1 To StrgrMatrix.ColCount - 1 Do
            For J := 0 To StrgrMatrix.RowCount - 1 Do
                IntendencyMatrix[J, I - 1] := StrToInt(StrgrMatrix.Cells[I, J])
    Else
    Begin
        Application.MessageBox('Списки заданы неверно! Проверьте ввод!', 'Ошибка', MB_ICONERROR);
        GetMatrix := False;
    End;
End;

Procedure TfrmMain.ConvertMatrix();
Var
    I, J: Integer;
Begin
    SetLength(AdjacencyMatrix, Length(IntendencyMatrix), Length(IntendencyMatrix[0]));
    For I := Low(IntendencyMatrix) To High(IntendencyMatrix) Do
    Begin
        J := 0;
        While (J < High(IntendencyMatrix)) Do
        Begin
            AdjacencyMatrix[I, J] := 0;
            Inc(J);
        End;
        J := 0;
        While (J < High(IntendencyMatrix)) And (IntendencyMatrix[I, J] <> 0) Do
        Begin
            AdjacencyMatrix[I, IntendencyMatrix[I, J] - 1] := 1;
            Inc(J);
        End;
    End;
End;

{ форма }

Procedure TfrmMain.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
    If Application.MessageBox(PChar('Вы уверены, что хотите выйти?'), PChar('Выход'), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1 + MB_TASKMODAL)
        = IDYES Then
        CanClose := True
    Else
        CanClose := False;
End;

Procedure TLabeledEdit.WMPaste(Var Msg: TMessage);
Const
    MIN_VALUE = 2;
    MAX_VALUE = 10;
Begin
    If Clipboard.HasFormat(CF_TEXT) Then
    Begin
        Try
            If (StrToInt(Clipboard.AsText) < MIN_VALUE) Or (StrToInt(Clipboard.AsText) > MAX_VALUE) Then
            Begin
                Application.MessageBox(Pchar('В буфере обмена содержится неподходящее значение!'), 'Ошибка', MB_ICONWARNING);
                Exit;
            End;
        Except
            Application.MessageBox(Pchar('При чтении из буфера произошла ошибка!'), 'Ошибка', MB_ICONWARNING);
            Exit;
        End;
    End
    Else
    Begin
        Application.MessageBox(Pchar('В буфере обмена содержатся некорректные данные!'), 'Ошибка', MB_ICONWARNING);
        Exit;
    End;
    Inherited;
End;

Function NewEditProc(Window: HWND; UMsg: UINT; WindowParametr: WPARAM; LParam: LPARAM): Integer; Stdcall;
Const
    MIN_VALUE = 0;
Var
    Col, Row: Integer;
Begin
    Col := FrmMain.StrgrMatrix.Col;
    Row := FrmMain.StrgrMatrix.Row;

    If UMsg = WM_PASTE Then
    Begin
        Try
            If (StrToInt(Clipboard.AsText) < MIN_VALUE) Then
            Begin
                Application.MessageBox(Pchar('В буфере обмена содержится неподходящее значение!'), 'Ошибка', MB_ICONWARNING);
                Exit;
            End
            Else
            Begin
                FrmMain.StrgrMatrix.Cells[Col, Row] := Clipboard.AsText;
                Exit;
            End;
        Except
            Application.MessageBox(Pchar('В буфере обмена находятся неподходящие данные!'), 'Ошибка', MB_ICONWARNING);
            Exit;
        End;
    End
    Else
        Result := CallWindowProc(Pointer(GetWindowLong(Window, GWL_USERDATA)), Window, UMsg, WindowParametr, LParam);
End;

{ обработка нажатий на splitview }

Procedure TfrmMain.SdbtMenuClick(Sender: TObject);
Begin
    SplvMenu.Opened := Not SplvMenu.Opened;
End;

Procedure TfrmMain.SdbtOpenFromFileClick(Sender: TObject);
Var
    SizeFromFile: Single;
    IsCorrect: Boolean;
    Size, I, J: Integer;
Begin
    If OpdOpenFromFileDialog.Execute() Then
        If IsFileCorrect(OpdOpenFromFileDialog.FileName) Then
        Begin
            GetSizeFromFile(OpdOpenFromFileDialog.FileName, SizeFromFile, IsCorrect);
            Size := Round(SizeFromFile);

            SetLength(IntendencyMatrix, Size, Size);
            SetLength(AdjacencyMatrix, Size, Size);
            IntendencyMatrix := GetMatrixFromFile(OpdOpenFromFileDialog.FileName, Size, IntendencyMatrix, IsCorrect);

            If (IsCorrect) Then
            Begin
                LbeNodesRequirement.Text := IntToStr(Size);
                For I := Low(IntendencyMatrix) To High(IntendencyMatrix) Do
                    For J := Low(IntendencyMatrix[0]) To High(IntendencyMatrix[0]) Do
                        StrgrMatrix.Cells[J + 1, I] := IntToStr(FrmMain.IntendencyMatrix[I, J]);
            End
            Else
                Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
        End
        Else
            Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
End;

Procedure TfrmMain.SdbtSaveToFileClick(Sender: TObject);
Var
    OutputFile: TextFile;
    I, J: Integer;
Begin
    If SvdSaveToFileDialog.Execute() And FileExists(SvdSaveToFileDialog.FileName) Then
    Begin
        AssignFile(OutputFile, SvdSaveToFileDialog.FileName);

        Try
            Try
                Rewrite(OutputFile);

                Writeln(OutputFile, 'Входные данные ');
                Writeln(OutputFile, 'Кол-во вершин: ', Length(AdjacencyMatrix));
                Writeln(OutputFile, 'Списки: ');
                For I := Low(IntendencyMatrix) To High(IntendencyMatrix) Do
                Begin
                    Write(OutputFile, I + 1, ': ');
                    For J := Low(IntendencyMatrix[0]) To High(IntendencyMatrix[0]) Do
                        Write(OutputFile, IntendencyMatrix[I, J], '    ');
                    Write(OutputFile, #13#10);
                End;

                Write(OutputFile, 'Матрица смежности: ' + #13#10);
                Write(OutputFile, '    ');
                For I := Low(AdjacencyMatrix) To High(AdjacencyMatrix) Do
                    Write(OutputFile, I + 1, '    ');
                Write(OutputFile, #13#10);
                For I := Low(AdjacencyMatrix) To High(AdjacencyMatrix) Do
                Begin
                    Write(OutputFile, I + 1, '    ');
                    For J := Low(AdjacencyMatrix) To High(AdjacencyMatrix) Do
                        Write(OutputFile, AdjacencyMatrix[I, J], '    ');
                    Write(OutputFile, #13#10);
                End;

                Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение', MB_ICONINFORMATION);
            Finally
                CloseFile(OutputFile);
            End;
        Except
            Application.MessageBox('Отказано в доступе! Измените параметры файла! ', 'Ошибка!', MB_ICONERROR);
        End;
    End
    Else
        Application.MessageBox('Введено некорректное имя файла или закрыто окно сохранения!', 'Ошибка!', MB_ICONERROR);
End;

Procedure TfrmMain.SdbtStartClick(Sender: TObject);
Begin
    BtGetMatrixClick(Sender);
End;

Procedure TfrmMain.SdbtAboutDeveloperClick(Sender: TObject);
Const
    FIRST_MESSAGE = 'Ф.И.О.: Карась А.С. a.k.a Clownfish' + #13#10;
    SECOND_MESSAGE = 'Группа: 251004' + #13#10;
    THIRD_MESSAGE = 'Контакты: предварительная запись вживую по адресу' + #13#10;
    FOURTH_MESSAGE = 'г.Гродно, ул.Мостовая, д.31';
Begin
    Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE + FOURTH_MESSAGE, 'О разработчике');
End;

Procedure TfrmMain.SdbtHelpClick(Sender: TObject);
Const
    FIRST_MESSAGE = '- Вводимыми значениями могут являться только целые числа!' + #13#10;
    SECOND_MESSAGE = '- Диапазон ввода количества вершин: 2...10' + #13#10;
    THIRD_MESSAGE = '- Для ввода из файла используйте вкладку ''Файл'' - ''Открыть''.' + #13#10;
    FOURTH_MESSAGE = '- Для сохранения в файл используйте вкладку ''Файл'' - ''Сохранить''.' + #13#10;
    FIFTH_MESSAGE = '- Для удобного использования программы представлен набор кнопок на левой панели.';
Begin
    Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + THIRD_MESSAGE + FOURTH_MESSAGE + FIFTH_MESSAGE, 'Справка');
End;

Procedure TfrmMain.SdbtExitClick(Sender: TObject);
Begin
    Close;
End;

{ компоненты формы }

Procedure TfrmMain.LbeNodesRequirementChange(Sender: TObject);
Const
    MIN_VALUE = 2;
    MAX_VALUE = 10;
Var
    I: Integer;
Begin
    If (LbeNodesRequirement.Text <> '') And Not((StrToInt(LbeNodesRequirement.Text) < MIN_VALUE) Or
        (StrToInt(LbeNodesRequirement.Text) > MAX_VALUE)) Then
    Begin
        StrgrMatrix.ColCount := StrToInt(LbeNodesRequirement.Text) + 1;
        StrgrMatrix.RowCount := StrToInt(LbeNodesRequirement.Text);
        StrgrMatrix.Width := (StrgrMatrix.DefaultColWidth + 2) * StrgrMatrix.ColCount;
        If StrgrMatrix.Width > StrgrMatrix.Constraints.MaxWidth Then
            StrgrMatrix.Width := StrgrMatrix.Constraints.MaxWidth;
        StrgrMatrix.Height := (StrgrMatrix.DefaultRowHeight + 2) * StrgrMatrix.RowCount;
        If StrgrMatrix.Height > StrgrMatrix.Constraints.MaxHeight Then
            StrgrMatrix.Height := StrgrMatrix.Constraints.MaxHeight;
        For I := 0 To StrgrMatrix.RowCount - 1 Do
            StrgrMatrix.Cells[0, I] := IntToStr(I + 1) + ':';
        LbMatrixRequirement.Visible := True;
        StrgrMatrix.Visible := True;
        BtGetMatrix.Visible := True;
        SdbtStart.Enabled := True;
    End
    Else
    Begin
        LbMatrixRequirement.Visible := False;
        StrgrMatrix.Visible := False;
        BtGetMatrix.Visible := False;
        SdbtStart.Enabled := False;
    End;
End;

Procedure TfrmMain.BtGetMatrixClick(Sender: TObject);
Begin
    If GetMatrix() Then
    Begin
        ConvertMatrix();
        FrmMatrix := TfrmMatrix.Create(Self);
        FrmMatrix.StrgrMatrix.RowCount := StrgrMatrix.RowCount + 1;
        FrmMatrix.StrgrMatrix.ColCount := StrgrMatrix.ColCount;
        SdbtSaveToFile.Enabled := True;
        FrmMatrix.Show;
        FrmMain.Hide;
    End;
End;

End.

Unit UnitData;

Interface

Uses
    System.SysUtils,
    System.Classes,
    Vcl.BaseImageCollection,
    Vcl.ImageCollection;

Type
    TdtmdPictures = Class(TDataModule)
        ImcForButtons: TImageCollection;
    End;

Var
    DtmdPictures: TdtmdPictures;

Implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}

End.

Unit UnitVCLLoadingScreen;

Interface

Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.Imaging.Pngimage,
    Vcl.ExtCtrls;

Type
    TfrmLoadingScreen = Class(TForm)
        PBack: TPanel;
        ImLogo: TImage;
        TmrAlphaBlendChanging: TTimer;
        TmrEndLoadingScreen: TTimer;
        Procedure FormCreate(Sender: TObject);
        Procedure TmrAlphaBlendChangingTimer(Sender: TObject);
        Procedure TmrEndLoadingScreenTimer(Sender: TObject);
    End;

Var
    FrmLoadingScreen: TfrmLoadingScreen;

Implementation

{$R *.dfm}

Procedure TfrmLoadingScreen.FormCreate(Sender: TObject);
Var
    HRgn: Cardinal;
Begin
    HRgn := CreateEllipticRgn(0, 0, 400, 400);
    SetWindowRgn(Handle, HRgn, False);

    TmrEndLoadingScreen.Enabled := True;
    TmrAlphaBlendChanging.Enabled := True;
End;

Procedure TfrmLoadingScreen.TmrAlphaBlendChangingTimer(Sender: TObject);
Begin
    If FrmLoadingScreen.AlphaBlendValue > 253 Then
        TmrAlphaBlendChanging.Enabled := False
    Else
        FrmLoadingScreen.AlphaBlendValue := FrmLoadingScreen.AlphaBlendValue + 2;
End;

Procedure TfrmLoadingScreen.TmrEndLoadingScreenTimer(Sender: TObject);
Begin
    TmrEndLoadingScreen.Enabled := False;
End;

End.