laba_6_2_del_v2

unit laba_6_2_f1;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
        System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
        laba_6_2_UnitTypes, Vcl.ExtCtrls, Vcl.Imaging.pngimage, laba_6_2_UnitBoard,
  Vcl.StdCtrls, laba_6_2_UnitKnight, laba_6_2_UnitDoKnightMoves, Vcl.ComCtrls, Math,
  Vcl.Menus;

type
  TForm_6_2 = class(TForm)
    ImageDark2: TImage;
    ImageLight2: TImage;
    LabelToMeasureScreenOfUser: TLabel;
    ImageKnight: TImage;
    TimerForKnightMoves: TTimer;
    ImageLight1: TImage;
    ImageDark1: TImage;
    ButtonStart: TButton;
    LabelHelp: TLabel;
    TrackBar1: TTrackBar;
    LabelSpeedOfKnight: TLabel;
    MainMenu1: TMainMenu;
    NHelp: TMenuItem;
    NTask: TMenuItem;
    NAuthor: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure TimerForKnightMovesTimer(Sender: TObject);
    procedure ButtonStartClick(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure NTaskClick(Sender: TObject);
    procedure NAuthorClick(Sender: TObject);
  private
    MultPix: Single;
  public
    function MultPixels(PixQuant: Integer): Integer;

    procedure CellOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

procedure MyMessageBoxInfo(Form: TForm; CaptionWindow, TextMessage: String; IsWarning: Boolean = False); external 'Dll_MyMessageBox.dll';
function MyMessageBoxYesNo(Form: TForm; CaptionWindow, TextMessage: String; IsWarning: Boolean = False) : Boolean; external 'Dll_MyMessageBox.dll';

var
    Form_6_2: TForm_6_2;
    Board: TBoard;
    Knight: TKnight;
    KnightIsMoving: Boolean;

implementation

{$R *.dfm}

procedure TForm_6_2.FormCreate(Sender: TObject);
begin
    MultPix := LabelToMeasureScreenOfUser.Width / 100;
    KnightIsMoving := False;

    CreateBoard();
    SetKnight();
end;

function TForm_6_2.MultPixels(PixQuant: Integer): Integer;
begin
    Result := Round(PixQuant * MultPix);
end;

procedure TForm_6_2.NAuthorClick(Sender: TObject);
begin
    MyMessageBoxInfo(Form_6_2, 'Автор', 'Панев Александр, гр. 051007' + #10#13 + 'Минск, 2021');
end;

procedure TForm_6_2.NTaskClick(Sender: TObject);
begin
    MyMessageBoxInfo(Form_6_2, 'Задание', 'Обойти шахматную доску ходом коня так, чтобы все клетки были пройдены по одному разу.');
end;

procedure TForm_6_2.TimerForKnightMovesTimer(Sender: TObject);
begin
    DoOneMove();
end;

procedure TForm_6_2.TrackBar1Change(Sender: TObject);
begin
    TimerForKnightMoves.Interval := 20 * (6 - TrackBar1.Position) * (6 - TrackBar1.Position) * (5 - TrackBar1.Position);
    TimerForKnightMoves.Interval := Min(TimerForKnightMoves.Interval, 1500);
    TimerForKnightMoves.Interval := Max(TimerForKnightMoves.Interval, 20);
end;

procedure TForm_6_2.ButtonStartClick(Sender: TObject);
begin
    if KnightIsMoving then
        if ButtonStart.Caption = 'Продолжить' then
        begin
            TimerForKnightMoves.Enabled := True;
            ButtonStart.Caption := 'Остановить'
        end
        else
        begin
            TimerForKnightMoves.Enabled := False;
            ButtonStart.Caption := 'Продолжить'
        end
    else
        StartKnightMoves();
end;

procedure TForm_6_2.CellOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if not KnightIsMoving then
        with Sender as TCell do
            MoveKnightToCell(PosX, PosY);
end;

end.








unit laba_6_2_UnitBoard;

interface

uses laba_6_2_UnitTypes;

const
    SizeOfCell = 60;

procedure CreateBoard();
procedure ResetBoardAndKnight();

implementation

uses laba_6_2_f1;

procedure CreateBoard();
var
    i, j: Integer;

begin
    with Form_6_2 do
    for i := 1 to 8 do
        for j := 1 to 8 do
        begin
            Board[i][j] := TCell.Create(Form_6_2);
            with Board[i][j] do
            begin
                Parent := Form_6_2;
                Width := MultPixels(SizeOfCell);
                Height := Width;
                Stretch := True;
                Proportional := True;
                Top := MultPixels(SizeOfCell) * j;
                Left := MultPixels(SizeOfCell) * i;
                PosX := i;
                PosY := j;

                OnMouseDown := CellOnMouseDown;
            end;
        end;

    ResetBoardAndKnight();
end;

procedure ResetBoardAndKnight();
var
    i, j: Integer;

begin
    for i := 1 to 8 do
        for j := 1 to 8 do
            with Board[i][j] do
            begin
                SetColor(False);
                ColorOfNode := 0;
            end;

    if Knight <> nil then
        Knight.QuantWalkedCells := 0;
end;

end.









unit laba_6_2_UnitDoKnightMoves;

interface

procedure StartKnightMoves();
procedure DoOneMove();

implementation

uses laba_6_2_f1, laba_6_2_UnitTypes, laba_6_2_UnitKnight, System.SysUtils, laba_6_2_UnitBoard;

function GetMovesFromCell(FromX, FromY: ShortInt) : TArrMoves; forward;
procedure EndKnightMoves(); forward;

procedure StartKnightMoves();
begin
    ResetBoardAndKnight();
    KnightIsMoving := True;

    with Form_6_2 do
    begin
        ButtonStart.Caption := 'Остановить';
        TimerForKnightMoves.Enabled := True;
        LabelHelp.Visible := False;
    end;
end;

procedure EndKnightMoves();
begin
    MyMessageBoxInfo(Form_6_2, 'Готово', 'Путь завершён. Конь посетил ' + IntToStr(Knight.QuantWalkedCells) + ' клетки.');
    KnightIsMoving := False;
    with Form_6_2 do
    begin
        LabelHelp.Visible := True;
        ButtonStart.Caption := 'Начать';
    end;
end;

procedure DoOneMove();
var
    ArrMoves: TArrMoves;
    i, QuantOfAvailMoves, MinAvailMoves, IndexOfMin: Byte;

begin
    Form_6_2.TimerForKnightMoves.Enabled := False;

    with Knight do
        ArrMoves := GetMovesFromCell(PosX, PosY);

    if Length(ArrMoves) > 0 then
    begin
        for i := 0 to High(ArrMoves) do
        begin
            with Knight do
                QuantOfAvailMoves := Length(GetMovesFromCell(PosX + ArrMoves[i][1], PosY + ArrMoves[i][2]));
            if i = 0 then
            begin
                MinAvailMoves := QuantOfAvailMoves;
                IndexOfMin := 0;
            end
            else
                if QuantOfAvailMoves < MinAvailMoves then
                begin
                    MinAvailMoves := QuantOfAvailMoves;
                    IndexOfMin := i;
                end;
        end;

        with Knight do
            MoveKnightToCell(PosX + ArrMoves[IndexOfMin][1], PosY + ArrMoves[IndexOfMin][2]);
        if Knight.QuantWalkedCells = 64 then
            EndKnightMoves()
        else
            Form_6_2.TimerForKnightMoves.Enabled := True;
    end
    else
    begin
        MyMessageBoxInfo(Form_6_2, 'Ошибка', 'Путь не найден', True);
        EndKnightMoves();
    end;
end;

function GetMovesFromCell(FromX, FromY: ShortInt) : TArrMoves;
const
    AllowedMoves: Array [1..8] of TVector = ((-2, 1), (2, -1), (-2, -1), (-1, -2), (2, 1),
      (1, 2), (-1, 2), (1, -2));

var
    i, QuantOfMoves: Byte;
    ArrMoves: TArrMoves;

begin
    QuantOfMoves := 0;
    SetLength(ArrMoves, 8);
    for i := 1 to 8 do
        if (FromX + AllowedMoves[i][1] < 9) and (FromX + AllowedMoves[i][1] > 0) and
        (FromY + AllowedMoves[i][2] < 9) and
        (FromY + AllowedMoves[i][2] > 0) and
        (Board[FromX + AllowedMoves[i][1]][FromY + AllowedMoves[i][2]].ColorOfNode = 0) then
        begin
            ArrMoves[QuantOfMoves] := AllowedMoves[i];
            Inc(QuantOfMoves);
        end;

    SetLength(ArrMoves, QuantOfMoves);

    Result := ArrMoves;
end;

end.













unit laba_6_2_UnitKnight;

interface

uses
    laba_6_2_UnitTypes;

procedure SetKnight();
procedure MoveKnightToCell(ToX, ToY: Byte);

implementation
uses laba_6_2_f1, laba_6_2_UnitBoard;

procedure SetKnight();
begin
    with Form_6_2 do
        with Knight do
        begin
            Knight := TKnight.Create(Form_6_2);
            Parent := Form_6_2;

            QuantWalkedCells := 0;

            Width := Board[1][1].Width;
            Height := Width;
            Picture := ImageKnight.Picture;
            Proportional := True;
            Stretch := True;

            MoveKnightToCell(1, 1);

            BringToFront();
        end;
end;

procedure MoveKnightToCell(ToX, ToY: Byte);
begin
    with Knight do
        begin
            if KnightIsMoving and (QuantWalkedCells = 0) then
            begin
                Board[PosX][PosY].ColorOfNode := 2;
                Board[PosX][PosY].SetColor(True);
                Inc(QuantWalkedCells);
            end;

            PosX := ToX;
            PosY := ToY;
            Top := Board[PosX][PosY].Top;
            Left := Board[PosX][PosY].Left;

            BringToFront();

            if KnightIsMoving then
            begin
                Board[PosX][PosY].ColorOfNode := 2;
                Board[PosX][PosY].SetColor(True);
                Inc(QuantWalkedCells);
            end;
        end;
end;

end.













unit laba_6_2_UnitTypes;

interface

uses Vcl.ExtCtrls, System.Classes, Vcl.Controls;

type
    TVector = Array [1..2] of ShortInt;
    TArrMoves = Array of TVector;

    TCell = Class(TImage)
    public
        ColorOfNode: Byte;  // 0 - was not ; 1 - temp was; 2 - was
        PosX, PosY: Byte;
    published
        procedure SetColor(IsWalked: Boolean);
    End;

    TBoard = Array [1 .. 8, 1 .. 8] of TCell;

    TKnight = Class (TImage)
    public
        PosX, PosY, QuantWalkedCells: Byte;
    End;

implementation

uses laba_6_2_f1, laba_6_2_UnitKnight;

procedure TCell.SetColor(IsWalked: Boolean);
begin
    with Form_6_2 do
        if (PosX + PosY) mod 2 = 1 then
            if IsWalked then
                Picture := ImageDark2.Picture
            else
                Picture := ImageDark1.Picture
        else
            if IsWalked then
                Picture := ImageLight2.Picture
            else
                Picture := ImageLight1.Picture
end;

end.