Lab.6.1.Full(Delphi)

Unit RacingMain;

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,
    System.ImageList,
    Vcl.ImgList,
    Vcl.VirtualImageList,
    Vcl.VirtualImage;

Type
    TfrmMain = Class(TForm)
        GrpBack: TGridPanel;
        PButtons: TPanel;
        SdbtHelp: TSpeedButton;
        SdbtStart: TSpeedButton;
        LbTaskInfo: TLabel;
        VilImages_42: TVirtualImageList;
        VilPictures: TVirtualImageList;
        PRace: TPanel;
        ShpSecondRunner: TShape;
        ShpThirdRunner: TShape;
        SdbtInfoAboutDeveloper: TSpeedButton;
        SdbtExit: TSpeedButton;
        ShpTrack: TShape;
        ShpFirstSeparator: TShape;
        ShpSecondSeparator: TShape;
        ShpFirstRunner: TShape;
        ShpStartLine: TShape;
        ShpFinishLine: TShape;
        PResult: TPanel;
        LbAnswer: TLabel;
        BllnhHint: TBalloonHint;
        Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
        Procedure SdbtHelpClick(Sender: TObject);
        Procedure SdbtExitClick(Sender: TObject);
        Procedure SdbtInfoAboutDeveloperClick(Sender: TObject);
        Procedure SdbtStartClick(Sender: TObject);
        Procedure FormKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
    End;

Var
    FrmMain: TfrmMain;

Implementation

{$R *.dfm}

Uses RacingDataPictures;

Procedure Delay(Value: Cardinal);
Var
    F, N: Cardinal;
Begin
    N := 0;
    While N <= (Value Div 10) Do
    Begin
        SleepEx(1, True);
        Application.ProcessMessages;
        Inc(N);
    End;

    F := GetTickCount;

    Repeat
        Application.ProcessMessages;
        N := GetTickCount;
    Until (N - F >= (Value Mod 10)) Or (N < F);
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.FormKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Begin
    If (Key = VK_RETURN) And (SdbtStart.Enabled = True) Then
        SdbtStartClick(Sender);
End;

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

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

Procedure TfrmMain.SdbtInfoAboutDeveloperClick(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.SdbtStartClick(Sender: TObject);
Const
    START_SPEED = 5;
    MAX_SPEED = 15;
Var
    FirstRunnerSpeed, SecondRunnerSpeed, ThirdRunnerSpeed, FirstRunnerPlace, SecondRunnerPlace,
        ThirdRunnerPlace: Integer;
Begin
    SdbtStart.Enabled := False;
    Randomize;
    FirstRunnerSpeed := START_SPEED;
    SecondRunnerSpeed := START_SPEED;
    ThirdRunnerSpeed := START_SPEED;

    While Not((ShpFinishLine.Left - ShpFirstRunner.Left < 1) And
        (ShpFinishLine.Left - ShpSecondRunner.Left < 1) And
        (ShpFinishLine.Left - ShpFirstRunner.Left < 1)) Do
    Begin
        Delay(15);
        If ShpFirstRunner.Left > ShpFinishLine.Left Then
            FirstRunnerSpeed := 0
        Else
        Begin
            FirstRunnerSpeed := FirstRunnerSpeed + Random(21) - 10;
            If FirstRunnerSpeed < 0 Then
                FirstRunnerSpeed := 1;
            If FirstRunnerSpeed > MAX_SPEED Then
                FirstRunnerSpeed := MAX_SPEED;
            ShpFirstRunner.Left := ShpFirstRunner.Left + FirstRunnerSpeed;
        End;
        If ShpSecondRunner.Left > ShpFinishLine.Left Then
            SecondRunnerSpeed := 0
        Else
        Begin
            SecondRunnerSpeed := SecondRunnerSpeed + Random(21) - 10;
            If SecondRunnerSpeed < 0 Then
                SecondRunnerSpeed := 1;
            If SecondRunnerSpeed > MAX_SPEED Then
                SecondRunnerSpeed := MAX_SPEED;
            ShpSecondRunner.Left := ShpSecondRunner.Left + SecondRunnerSpeed;
        End;
        If ShpThirdRunner.Left > ShpFinishLine.Left Then
            ThirdRunnerSpeed := 0
        Else
        Begin
            ThirdRunnerSpeed := SecondRunnerSpeed + Random(20) - 10;
            If ThirdRunnerSpeed < 0 Then
                ThirdRunnerSpeed := 1;
            If ThirdRunnerSpeed > MAX_SPEED Then
                ThirdRunnerSpeed := MAX_SPEED;
            ShpThirdRunner.Left := ShpThirdRunner.Left + ThirdRunnerSpeed;
        End;
    End;

    If (ShpFirstRunner.Left > ShpSecondRunner.Left) And
        (ShpFirstRunner.Left > ShpThirdRunner.Left) Then
    Begin
        FirstRunnerPlace := 1;
        If (ShpSecondRunner.Left > ShpThirdRunner.Left) Then
        Begin
            SecondRunnerPlace := 2;
            ThirdRunnerPlace := 3;
        End
        Else
        Begin
            SecondRunnerPlace := 3;
            ThirdRunnerPlace := 2;
        End;
    End
    Else
    Begin
        If (ShpSecondRunner.Left > ShpThirdRunner.Left) Then
        Begin
            SecondRunnerPlace := 1;
            If (ShpThirdRunner.Left > ShpFirstRunner.Left) Then
            Begin
                ThirdRunnerPlace := 2;
                FirstRunnerPlace := 3;
            End
            Else
            Begin
                ThirdRunnerPlace := 3;
                FirstRunnerPlace := 2;
            End;
        End
        Else
        Begin
            ThirdRunnerPlace := 1;
            If (ShpSecondRunner.Left > ShpFirstRunner.Left) Then
            Begin
                SecondRunnerPlace := 2;
                FirstRunnerPlace := 3;
            End
            Else
            Begin
                SecondRunnerPlace := 3;
                FirstRunnerPlace := 2;
            End;
        End;
    End;

    LbAnswer.Visible := True;
    LbAnswer.Caption := LbAnswer.Caption + ' красный - ' + IntToStr(FirstRunnerPlace) +
        ' место, зеленый  - ' + IntToStr(SecondRunnerPlace) + ' место, синий  - ' +
        IntToStr(ThirdRunnerPlace) + ' место! Поздравляем участников!!!';
End;

End.

Unit RacingDataPictures;

Interface

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

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

Var
    DtmdPictures: TdtmdPictures;

Implementation

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

End.