Напишите код на Delphi 7 для игры «Уголки» и расскажите, что делать.

Ниже пример простой игры «Уголки» для Delphi 7. Это вариант на форме: поле 8 на 8, два игрока ходят по очереди, шашки двигаются на соседнюю свободную клетку или прыгают через одну шашку.

Что сделать:

• Создайте в Delphi 7 новый проект: File → New → Application.
• Откройте файл Unit1.pas.
• Замените его код на этот.
• Запустите проект кнопкой Run.

Код Unit1.pas:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
Board: array[0..7, 0..7] of Integer;
Cell: Integer;
SelectedX, SelectedY: Integer;
Player: Integer;
procedure DrawBoard;
procedure NewGame;
function CanMove(x1, y1, x2, y2: Integer): Boolean;
function InBoard(x, y: Integer): Boolean;
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Width := 520;
Height := 560;
Cell := 60;
SelectedX := -1;
SelectedY := -1;
NewGame;
end;

procedure TForm1.NewGame;
var
x, y: Integer;
begin
for y := 0 to 7 do
for x := 0 to 7 do
Board[x, y] := 0;

for y := 0 to 2 do
for x := 0 to 2 do
Board[x, y] := 1;

for y := 5 to 7 do
for x := 5 to 7 do
Board[x, y] := 2;

Player := 1;
Caption := 'Уголки. Ход игрока 1';
end;

function TForm1.InBoard(x, y: Integer): Boolean;
begin
Result := (x >= 0) and (x < 8) and (y >= 0) and (y < 8);
end;

function TForm1.CanMove(x1, y1, x2, y2: Integer): Boolean;
var
dx, dy, mx, my: Integer;
begin
Result := False;
if not InBoard(x2, y2) then Exit;
if Board[x2, y2] <> 0 then Exit;

dx := Abs(x2 - x1);
dy := Abs(y2 - y1);

if ((dx = 1) and (dy = 0)) or ((dx = 0) and (dy = 1)) then
Result := True;

if ((dx = 2) and (dy = 0)) or ((dx = 0) and (dy = 2)) then
begin
mx := (x1 + x2) div 2;
my := (y1 + y2) div 2;
if Board[mx, my] <> 0 then Result := True;
end;
end;

procedure TForm1.DrawBoard;
var
x, y: Integer;
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(ClientRect);

for y := 0 to 7 do
for x := 0 to 7 do
begin
Canvas.Brush.Color := clMoneyGreen;
Canvas.Rectangle(20 + x * Cell, 20 + y * Cell,
20 + (x + 1) * Cell, 20 + (y + 1) * Cell);

if Board[x, y] = 1 then Canvas.Brush.Color := clRed;
if Board[x, y] = 2 then Canvas.Brush.Color := clBlue;

if Board[x, y] <> 0 then
Canvas.Ellipse(25 + x * Cell, 25 + y * Cell,
15 + (x + 1) * Cell, 15 + (y + 1) * Cell);
end;

if SelectedX <> -1 then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clYellow;
Canvas.Rectangle(20 + SelectedX * Cell, 20 + SelectedY * Cell,
20 + (SelectedX + 1) * Cell, 20 + (SelectedY + 1) * Cell);
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Width := 1;
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
DrawBoard;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bx, by: Integer;
begin
bx := (X - 20) div Cell;
by := (Y - 20) div Cell;
if not InBoard(bx, by) then Exit;

if Board[bx, by] = Player then
begin
SelectedX := bx;
SelectedY := by;
Repaint;
Exit;
end;

if SelectedX <> -1 then
if CanMove(SelectedX, SelectedY, bx, by) then
begin
Board[bx, by] := Board[SelectedX, SelectedY];
Board[SelectedX, SelectedY] := 0;
SelectedX := -1;
SelectedY := -1;

if Player = 1 then Player := 2 else Player := 1;
Caption := 'Уголки. Ход игрока ' + IntToStr(Player);
Repaint;
end;
end;

end.

Правила в этой версии простые: красные и синие шашки должны перейти в противоположный угол. Игрок выбирает свою шашку мышью, потом щёлкает по клетке, куда хочет пойти.

0 0 Пожаловаться