Листинг программы:
Модуль Player:
unit Player;
interface
uses OnTable;
type
TPlayer = class
private
public
CountD: shortint; { сколько доминошек на руках }
Hand: TArrDInHand; { доминошки на руках у игрока }
Function GetVar( k : byte) : byte;
procedure Init(var Bazar: TBazar);
Procedure MoveArr(help: byte); {help - какую удалять}
Procedure TakeFromHeap(var Bazar: TBazar);
end;
implementation
Procedure TPlayer.Init(var Bazar: TBazar);
var
i: byte;
begin
Randomize;
CountD:=0;
for i:=1 to 7 do TakeFromHeap(Bazar);
end;
{ Функция возвращает случайное число от 1 до K }
Function TPlayer.GetVar(k : byte) : byte;
begin
Result := round(random*(k-1))+1
end;
Procedure TPlayer.TakeFromHeap;
var
HelpVar: byte;
i,j: byte;
begin
if bazar.CountDInHeap = 0 then exit;
HelpVar := GetVar(Bazar.CountDInHeap);//случайное число от 1 до кол-ва домино в базаре
i:=0;
j:=0;
repeat
inc(i);
if not Bazar.VarD[i].InHand then inc(j)
until j = HelpVar;
inc(CountD);
with Hand[CountD] do
begin
A:=Bazar.VarD[i].A;
B:=Bazar.VarD[i].B;
end;
bazar.VarD[i].InHand := TRUE;
dec(Bazar.CountDInHeap)
end;
{ Уменьшаем количество доминошек на руках игрока на одну }
Procedure TPlayer.MoveArr(help: byte); {help - какую удалять}
Var
i : byte;
Begin
for i := help to CountD do
hand[i] := Hand[i+1];
dec(CountD);
End;
end.
Модуль Computer:
unit Computer;
interface
uses Player, OnTable;
type
TComputer = class(TPlayer)
private
public
procedure Select(var D: byte; A, B: byte; var Basar: TBazar; var Netu: boolean);
end;
implementation
{------------------------------------------------------------
Компьютер выбирает домино
-------------------------------------------------------------}
Procedure TComputer.Select(var D: byte; A, B: byte; var Basar: TBazar; var Netu: boolean);
var
i: Shortint;
flag: boolean;
Found: boolean;
Begin
flag := false;
repeat
Found := False;
i := 1;
repeat
if not ((hand[i].A in [A,B])or
(hand[i].B in [A,B])) then
inc(i)
else
Found := True;
until (i = CountD) or Found;
If Not Found then
begin
if Basar.CountDInHeap <> 0 then
TakeFromHeap(Basar)
else
begin
flag := true;
Netu := true;
end;
end
else
begin
D := i;
Netu := false;
flag := true;
end;
until flag = TRUE;
End;
end.
Модуль OnTable:
unit OnTable;
interface
type
RecordD = record { Для базара }
A, B: 0..6;
InHand: boolean;
end;
ArrD = array [1..28] of RecordD; { Для базара }
TDominoInHand = record { Для игроков }
A, B: byte;
end;
TArrDInHand = array [1..21] of TDominoInHand; { Для игрока }
TOnTable = record { Игровой стол }
X1,Y1 : integer; { Левый угол }
X2,Y2 : integer; { Правый угол }
A : 0..6; { Домино слева }
B : 0..6; { Домино справа }
horiz_1, horiz_2: boolean; {показывает, как рисовать
слева и справа}
end;
TBazar = record
VarD: ArrD; {Базар}
CountDInHeap: Shortint; { количество домино в куче (на базаре)}
end;
procedure Basar_init(var Bazar: TBazar);
procedure ontable_init(var OnTable: TOnTable);
implementation
procedure Basar_init; { инициализация базара... }
var
kk, i, j: byte;
begin
kk:=0;
for i:=0 to 6 do
for j:=i to 6 do
begin
inc(kk);
with bazar.VarD[kk] do
begin
A:=i;
B:=j;
InHand:=FALSE
end
end;
bazar.CountDInHeap:=28;
end;
procedure ontable_init;
begin
OnTable.X1 := 300;
OnTable.y1 := 100;
OnTable.X2 := 300;
OnTable.Y2 := 100;
OnTable.A := 0;
OnTable.B := 0;
OnTable.horiz_1 := true;
OnTable.horiz_2 := true;
end;
end.
Основной модуль компоненты:
unit Domino;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, OnTable, Player, Computer;
type
TDomino = class(TImage)
private
{ Private declarations }
Go_game: boolean;{идет ли игра?}
Schet: TDominoInHand;
OnTable: TOnTable;
Tekuschaya: Shortint; {номер доминошки на которую указывает стрелка}
Bazar: TBazar;
Player: TPlayer;
Computer: TComputer;
procedure Draw_on_table(D: TDominoInHand);
procedure Draw_schet;
procedure Draw_count_comp;
procedure Strelka(i: byte; steret: boolean);{рисует - стирает стрелку над i-ой доминошкой}
procedure Draw_igrok;
procedure Draw_count_basar;
procedure Draw_nachalo;
procedure Draw_Domino(XX, YY, tolshina, A, B: integer; horiz: Boolean);
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Begin_game;
Procedure End_game;
procedure Move_strelka_l;
procedure Move_strelka_r;
published
{ Published declarations }
end;
procedure Register;
implementation
const
x = 5;{начало рисования доминошек игрока}
y = 350;{начало рисования доминошек игрока}
dx = 5; {расстояние между доминошками}
tolsh = 24;{толщина доминошки}
procedure Register;
begin
RegisterComponents('Samples', [TDomino]);
end;
function proverka(D: byte; Hend: TArrDInHand; A, B, X1, X2: byte): boolean;
begin
if (Hend[D].A in [A, B])or
(Hend[D].B in [A, B])or(X1 = X2)
then
Result := true
else
Result := false;
end;
procedure TDomino.Draw_on_table(D: TDominoInHand);
const tolsh1 = 16;
begin
if (OnTable.X1 = OnTable.X2)and(OnTable.Y1 = OnTable.Y2)then {стол пуст?}
begin
OnTable.A := d.A;
OnTable.b := d.b;
if d.a <> d.b then
begin
Draw_Domino(OnTable.X1,OnTable.Y1,tolsh1,D.A,D.B,true);
OnTable.X2 := OnTable.X2 + tolsh1 * 2;
end
else
begin
Draw_Domino(OnTable.X1, OnTable.Y1 - tolsh1 div 2, tolsh1, D.A, D.B, False);
OnTable.X2 := OnTable.X2 + tolsh1;
end;
end
else
begin
if d.A = d.B then {Дубль}
if D.A = OnTable.A then
begin
OnTable.A := D.B;
if OnTable.y1 <> 100 then
if OnTable.horiz_1 then
begin
Draw_Domino(OnTable.X1, OnTable.Y1-tolsh1 div 2, tolsh1, D.a, D.b, false);
OnTable.X1 := OnTable.X1 + tolsh1;
end
else
begin
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.a, D.b, false);
if OnTable.Y1 >= 100 + 2 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 + tolsh1;
OnTable.x1 := OnTable.X1 + tolsh1;
OnTable.horiz_1 := true;
end
else
OnTable.y1 := OnTable.Y1 + 2 * tolsh1;
end
else
begin
OnTable.X1 := OnTable.X1 - tolsh1;
Draw_Domino(OnTable.X1, OnTable.Y1 - tolsh1 div 2, tolsh1, D.B, D.A, false);
if OnTable.X1 <= 3 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 - tolsh1 div 2 + tolsh1 * 2;
OnTable.horiz_1 := false;
end;
end;
end
else
begin
OnTable.B := D.B;
if OnTable.y2 <> 100 then
if OnTable.horiz_2 then
begin
OnTable.X2 := OnTable.X2 - tolsh1;
Draw_Domino(OnTable.X2, OnTable.Y2 - tolsh1 div 2, tolsh1, D.B, D.A, false);
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.a, D.b, false);
if OnTable.Y2 >= 100 + 2 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 + tolsh1;
OnTable.horiz_2 := true;
end
else
OnTable.Y2 := OnTable.Y2 + 2 * tolsh1;
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2 - tolsh1 div 2, tolsh1, D.B, D.A, false);
if OnTable.X2 >= Width - 4 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 - tolsh1 div 2 + tolsh1 * 2;
OnTable.X2 := OnTable.X2 - tolsh1;
OnTable.horiz_2 := false;
end
else
OnTable.X2 := OnTable.X2 + tolsh1;
end;
end
else { не дубль}
begin
if D.A = OnTable.A then
begin
OnTable.A := D.B;
if OnTable.y1 <> 100 then
if OnTable.horiz_1 then
begin
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.a, D.b, true);
OnTable.X1 := OnTable.X1 + 2 * tolsh1;
end
else
begin
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.a, D.b, false);
if OnTable.Y1 >= 100 + 2 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 + tolsh1;
OnTable.x1 := OnTable.X1 + tolsh1;
OnTable.horiz_1 := true;
end
else
OnTable.Y1 := OnTable.Y1 + 2 * tolsh1;
end
else
begin
OnTable.X1 := OnTable.X1 - 2*tolsh1;
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.B, D.A, true);
if OnTable.X1 <= 3 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 + tolsh1;
OnTable.horiz_1 := false;
end;
end;
exit;
end;
if D.A = OnTable.B then
begin
OnTable.B := D.B;
if OnTable.Y2 <> 100 then
if OnTable.horiz_2 then
begin
OnTable.X2 := OnTable.X2 - tolsh1*2;
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.B, D.A, true);
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.a, D.b, false);
if OnTable.Y2 >= 100 + 2 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 + tolsh1;
OnTable.horiz_2 := true;
end
else
OnTable.Y2 := OnTable.Y2 + 2 * tolsh1;
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.A, D.B, true);
if OnTable.X2 >= Width - 4 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 + tolsh1;
OnTable.X2 := OnTable.X2 + tolsh1;
OnTable.horiz_2 := false;
end
else
OnTable.X2 := OnTable.X2 + 2 * tolsh1;
end;
exit;
end;
if D.B = OnTable.A then
begin
OnTable.A := D.A;
if OnTable.y1 <> 100 then
if OnTable.horiz_1 then
begin
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.B, D.A, true);
OnTable.X1 := OnTable.X1 + 2 * tolsh1;
end
else
begin
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.B, D.A, false);
if OnTable.Y1 >= 100 + 2 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 + tolsh1;
OnTable.x1 := OnTable.X1 + tolsh1;
OnTable.horiz_1 := true;
end
else
OnTable.Y1 := OnTable.Y1 + 2 * tolsh1;
end
else
begin
OnTable.X1 := OnTable.X1 - 2*tolsh1;
Draw_Domino(OnTable.X1, OnTable.Y1, tolsh1, D.A, D.B, true);
if OnTable.X1 <= 3 * tolsh1 then
begin
OnTable.Y1 := OnTable.Y1 + tolsh1;
OnTable.horiz_1 := false;
end;
end;
exit;
end;
if D.B = OnTable.B then
begin
OnTable.B := D.A;
if OnTable.Y2 <> 100 then
if OnTable.horiz_2 then
begin
OnTable.X2 := OnTable.X2 - tolsh1*2;
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.A, D.B, true);
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.B, D.A, false);
if OnTable.Y2 >= 100 + 2 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 + tolsh1;
OnTable.horiz_2 := true;
end
else
OnTable.Y2 := OnTable.Y2 + 2 * tolsh1;
end
else
begin
Draw_Domino(OnTable.X2, OnTable.Y2, tolsh1, D.B, D.A, true);
if OnTable.X2 >= Width - 4 * tolsh1 then
begin
OnTable.Y2 := OnTable.Y2 + tolsh1;
OnTable.X2 := OnTable.X2 + tolsh1;
OnTable.horiz_2 := false;
end
else
OnTable.X2 := OnTable.X2 + 2 * tolsh1;
end;
exit;
end;
end;
end;
end;
procedure TDomino.MouseDown;
var D: byte; Netu: boolean;
begin
if not Go_game then exit;
if Button = mbleft then Move_strelka_l
else
if tekuschaya <> 0 then
begin
{проверяем правильность выбора}
if proverka(tekuschaya, Player.Hand, OnTable.A, OnTable.B, OnTable.X1, OnTable.X2) then
begin
draw_on_table(player.hand[Tekuschaya]);
Player.MoveArr(tekuschaya);
if tekuschaya > Player.CountD then
begin
strelka(tekuschaya,true);
tekuschaya := Player.CountD;
strelka(tekuschaya, false);
end;
draw_igrok;
if Player.CountD = 0 then
if MessageDlg('Вы выиграли. Хотите продолжить игру?',mtConfirmation,[mbYes, mbNo], 0) = mrYes then
begin
Inc(Schet.A);
tekuschaya := 1;
ontable_init(OnTable);
Basar_init(Bazar);
Player.Init(Bazar);
Computer.init(Bazar);
draw_nachalo;
exit;
end
else
begin
End_game;
exit;
end;
Computer.Select(D,OnTable.A,OnTable.B, Bazar, Netu);