Lab.5.1.Full(Delphi)

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.Menus,
  Vcl.ComCtrls,
  Vcl.Buttons,
  System.ImageList,
  Vcl.ImgList,
  Vcl.VirtualImageList,
  Vcl.AppEvnts,
  ClipBrd;

Type
  TLabeledEdit = Class(Vcl.ExtCtrls.TLabeledEdit)
  Protected
    Procedure WMPaste(Var Msg:TMessage); Message WM_PASTE;
  End;
  TfrmMain = Class(TForm)
    pButtons: TPanel;
    svdSaveToFileDialog: TSaveDialog;
    mmMainMenu: TMainMenu;
    miFileMenu: TMenuItem;
    miOpenFromFile: TMenuItem;
    miSaveToFile: TMenuItem;
    miHelp: TMenuItem;
    miInfoAboutDeveloper: TMenuItem;
    opdOpenFromFileDialog: TOpenDialog;
    vilImages_48: TVirtualImageList;
    sdbtOpenFromFile: TSpeedButton;
    sdbtStart: TSpeedButton;
    sdbtSaveToFile: TSpeedButton;
    pBack: TPanel;
    BalloonHint: TBalloonHint;
    lbWelcome: TLabel;
    lbTaskInfo: TLabel;
    sdbtHelp: TSpeedButton;
    lbePatrisipants: TLabeledEdit;
    lbeOut: TLabeledEdit;
    btStart: TButton;
    lbOutParticipants: TLabel;
    lbLastParticipant: TLabel;
    lbOut: TLabel;
    lbLast: TLabel;
    lbIncorrectPatricipants: TLabel;
    lbIncorrectOut: TLabel;
    appeEvents: TApplicationEvents;
    Procedure miHelpClick(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Procedure miInfoAboutDeveloperClick(Sender: TObject);
    Procedure miOpenFromFileClick(Sender: TObject);
    Procedure btStartClick(Sender: TObject);
    Procedure sdbtSaveToFileClick(Sender: TObject);
    Procedure sdbtHelpClick(Sender: TObject);
    Procedure sdbtOpenFromFileClick(Sender: TObject);
    Procedure miSaveToFileClick(Sender: TObject);
    Procedure sdbtStartClick(Sender: TObject);
    Procedure lbePatrisipantsChange(Sender: TObject);
    Procedure lbeOutChange(Sender: TObject);
  End;

Var
  frmMain: TfrmMain;
  NextInChain: THandle;

Implementation

{$R *.dfm}

Uses UnitData;

Type
    TArr = Array Of Integer;
    TPElement = ^TElement;
    TElement = Record
        Number: Integer;
        Next: TPElement;
    End;
    TMyFuncType = Function(Msg: PChar): Boolean; stdcall;
    TMyProcType = Procedure(Flag: Boolean); stdcall;

Function IsFileOfNumbersCorrect(Path: String): Boolean; stdcall; External 'anticlown.dll';

Procedure GetNumbersFromFile(Path: String; Var Participants, NumberOut: Integer; Var IsCorrect: Boolean); stdcall;  External 'anticlown.dll';

Function InputList(NumberOfParticipants: Integer): TPElement;
Var
    Head, CurrElem: TPElement;
    I: Integer;
Begin
    New(CurrElem);
    Head := CurrElem;
    I := 0;

    While I < NumberOfParticipants - 1 Do
    Begin
        CurrElem^.Number := I + 1;

        New(CurrElem^.Next);
        CurrElem := CurrElem^.Next;
        Inc(I);
    End;

    CurrElem^.Next := Head;
    CurrElem^.Number := I + 1;
    InputList := Head;
End;

Function OutList(NumberOfParticipants, NumberOut: Integer; Head: TPElement): TArr;
Var
    AnsArr: TArr;
    CurrElem, Temp: TPElement;
    I, Counter: Integer;
Begin
    SetLength(AnsArr, NumberOfParticipants);
    Counter := 0;
    CurrElem := Head;

    If NumberOut = 1 Then
    Begin
        I := 1;

        While I < NumberOfParticipants Do
        Begin
            CurrElem := CurrElem^.Next;
            Inc(I);
        End;

        While Counter <> NumberOfParticipants Do
        Begin
            AnsArr[Counter] := CurrElem^.Next.Number;
            Temp := CurrElem^.Next;
            CurrElem^.Next:= Temp^.Next;
            Dispose(Temp);
            Inc(Counter);
        End;
    End
    Else
    Begin
        While Counter <> NumberOfParticipants Do
        Begin
            I := 1;

            While I < NumberOut - 1 Do
            Begin
                CurrElem := CurrElem^.Next;
                Inc(I);
            End;

            AnsArr[Counter] := CurrElem^.Next.Number;
            Temp := CurrElem^.Next;
            CurrElem^.Next:= Temp^.Next;
            Dispose(Temp);
            CurrElem := CurrElem^.Next;
            Inc(Counter);
        End;
    End;

    OutList := AnsArr;
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 TfrmMain.miHelpClick(Sender: TObject);
Const
    FIRST_MESSAGE = '- Вводимыми значениями могут являться только целые числа!' + #13#10;
    SECOND_MESSAGE = '- Диапазон ввода количества участников: 3...10' + #13#10;
    THIRD_MESSAGE = '- Для удобного использования программы представлена панель кнопок на левой панели.';
    FOURTH_MESSAGE = '- Для ввода из файла используйте вкладку ''Файл'' - ''Открыть''.' + #13#10;
    FIFTH_MESSAGE = '- Для сохранения в файл используйте вкладку ''Файл'' - ''Сохранить''.' + #13#10;
    SIXTH_MESSAGE = '- Учтите: Каждое из значений в файле должно начинаться с новой строки!';
Begin
    Application.MessageBox(FIRST_MESSAGE + SECOND_MESSAGE + FOURTH_MESSAGE + SIXTH_MESSAGE + FIFTH_MESSAGE, 'Справка');
End;

Procedure TfrmMain.sdbtHelpClick(Sender: TObject);
Begin
    miHelpClick(Sender);
End;

Procedure TfrmMain.miInfoAboutDeveloperClick(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.miOpenFromFileClick(Sender: TObject);
Var
    Participants, NumberOut: Integer;
    IsCorrect: Boolean;
Begin
    If opdOpenFromFileDialog.Execute() Then
        If IsFileOfNumbersCorrect(opdOpenFromFileDialog.FileName) Then
        Begin
            GetNumbersFromFile(opdOpenFromFileDialog.FileName, Participants, NumberOut, IsCorrect);
            If (IsCorrect) Then
            Begin
                lbePatrisipants.Text := IntToStr(Participants);
                lbeOut.Text := IntToStr(NumberOut);
                btStartClick(Sender);
            End;
        End
        Else
            Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
End;

Procedure TfrmMain.sdbtOpenFromFileClick(Sender: TObject);
Begin
    miOpenFromFileClick(Sender);
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;

Procedure TfrmMain.lbePatrisipantsChange(Sender: TObject);
Const
    MIN_VALUE = 3;
    MAX_VALUE = 10;
Begin
    If (lbePatrisipants.Text <> '') Then
    Begin
        If (StrToInt(lbePatrisipants.Text) < MIN_VALUE) Or (StrToInt(lbePatrisipants.Text) > MAX_VALUE) Or (lbePatrisipants.Text[1] = '0') Then
        Begin
            lbIncorrectPatricipants.Visible := True;
            btStart.Enabled := False;
            sdbtStart.Enabled := False;
        End
        Else
        Begin
            lbIncorrectPatricipants.Visible := False;
            If lbIncorrectOut.Visible Then
            Begin
                btStart.Enabled := False;
                sdbtStart.Enabled := False;
            End
            Else
            Begin
                btStart.Enabled := True;
                sdbtStart.Enabled := True;
            End;
        End;
    End
    Else
    Begin
        btStart.Enabled := False;
        sdbtStart.Enabled := False;
    End;
End;

Procedure TfrmMain.lbeOutChange(Sender: TObject);
Const
    MIN_VALUE = 1;
    MAX_VALUE = 10;
Begin
    If (lbeOut.Text <> '') Then
    Begin
        If (StrToInt(lbeOut.Text) < MIN_VALUE) Or (StrToInt(lbeOut.Text) > MAX_VALUE) Or (lbeOut.Text[1] = '0') Then
        Begin
            lbIncorrectOut.Visible := True;
            btStart.Enabled := False;
            sdbtStart.Enabled := False;
        End
        Else
        Begin
            lbIncorrectOut.Visible := False;
            If lbIncorrectPatricipants.Visible Then
            Begin
                btStart.Enabled := False;
                sdbtStart.Enabled := False;
            End
            Else
            Begin
                btStart.Enabled := True;
                sdbtStart.Enabled := True;
            End;
        End;
    End
    Else
    Begin
        btStart.Enabled := False;
        sdbtStart.Enabled := False;
    End;
End;

Procedure TfrmMain.btStartClick(Sender: TObject);
Const
    ERROR_MESSAGE = 'Номер выбывающего не может быть больше количества играющих! Измените номер выбывающего!';
Var
    Head: TPElement;
    NumberOfParticipants, NumberOut, I: Integer;
    AnsArr: TArr;
Begin
    If (StrToInt(lbeOut.Text) > StrToInt(lbePatrisipants.Text)) Then
        Application.MessageBox(ERROR_MESSAGE, Pchar('Ошибка'), MB_ICONERROR)
    Else
    Begin
        lbOutParticipants.Visible := True;
        lbLastParticipant.Visible := True;
        lbOut.Caption := '';
        lbLast.Caption := '';

        NumberOfParticipants := StrToInt(lbePatrisipants.Text);
        NumberOut := StrToInt(lbeOut.Text);
        SetLength(AnsArr, NumberOfParticipants);

        Head := InputList(NumberOfParticipants);
        AnsArr := OutList(NumberOfParticipants, NumberOut, Head);

        For I := Low(AnsArr) To High(AnsArr) - 1 Do
            lbOut.Caption := lbOut.Caption + IntToStr(AnsArr[I]) + ' ';
        lbLast.Caption := IntToStr(AnsArr[High(AnsArr)]);

        lbOut.Visible := True;
        lbLast.Visible := True;
        miSaveToFile.Enabled := True;
        sdbtSaveToFile.Enabled := True;
    End;
End;

Procedure TfrmMain.sdbtStartClick(Sender: TObject);
Begin
    btStartClick(Sender);
End;

Procedure TfrmMain.miSaveToFileClick(Sender: TObject);
Var
  OutputFile: TextFile;
Begin
    If svdSaveToFileDialog.Execute() And FileExists(svdSaveToFileDialog.FileName) Then
    Begin
        AssignFile(OutputFile, svdSaveToFileDialog.FileName);

        Try
            Try
                Rewrite(OutputFile);

                Writeln(OutputFile, 'Входные данные: ');
                Writeln(OutputFile, lbePatrisipants.Text + #13#10 + lbeOut.Text);
                Writeln(OutputFile, 'Ответ: ');
                Writeln(OutputFile, 'Выбывшие: ' + lbOut.Caption + #13#10 + 'Последний: ' + lbLast.Caption);

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

Procedure TfrmMain.sdbtSaveToFileClick(Sender: TObject);
begin
    miSaveToFileClick(Sender);
end;

End.

Unit UnitData;

Interface

Uses
  System.SysUtils, System.Classes, Vcl.BaseImageCollection, Vcl.ImageCollection,
  System.ImageList, Vcl.ImgList, Vcl.Controls;

Type
  TdtmdForImages = Class(TDataModule)
    imcImages: TImageCollection;
    imlIcons: TImageList;
  End;

Var
  dtmdForImages: TdtmdForImages;

Implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

End.