54. Всем известна игра "15". Вот ее правила. В прямоугольной коробочке находятся 15 фишек, на которых написаны числа от 1 до 15. Размер коробочки — 4x4, таким образом в коробочке есть одна пустая ячейка. В начале игры фишки перемешаны (рис. 1.56). Задача игрока состоит в том, чтобы, не вынимая фишки из коробочки, выстроить фишки в правильном порядке (рис. 1.57).

Рис. 1.56. В начале игры фишки перемешаны

Рис. 1.57. Правильный порядок фишек

Напишите программу "Игра "15"". На рис. 1.58 приведена форма и окна программы.

Рис. 1.58. Форма и окна программы Игра 15

Игра "15"}
unit gamel5_;
interface
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs;
type
TForml = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDovm (Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
// эти объявления вставлены сюда вручную
procedure ShowPole;
procedure Mixer;
private
I Private declarations }
public
f Public declarations }
end;
var
Forml: TForml;
implementation
{$R *.dfm}
const
H = 4; W = 4; // размер поля — 4x4
CH = 64; CW = 64; // размер клеток - 16x16
var
// правильное расположение фишек
stp : array[1..H, 1..W] of byte =
[( 1, 2, 3, 4),
( 5, 6, 7, 8),
( 9,10,11,12),
(13,14,15, 0));
// игровое поле
pole: array[l..H, 1..W] of byte;
ex,ey: integer; // координаты пустой клетки
// новая игра
procedure NewGame;
var
i,j: integer;
begin
// исходное (правильное) положение
for i:=0 to H+l do
for j:=0 to W+l do
pole[i,j] := stp[i,j];
Forml.Mixer; // перемешать фишки
Formi.ShowPole; // отобразить поле
end;
// проверяет, расположены ли
// фишки в нужном порядке
function Finish: boolean;
var
row,col: integer;
i: integer;
begin
row :=1; col :=1;
Finish := True; // пусть фишки в нужном порядке
for i:=l to 15 do
begin
if pole[row,col] <> i then
begin
Finish:= False;
break;
end;
// к следующей клетке
if col < 4
then inc(col)
else begin
col :=1;
inc(row);
end;
end;
end;
// "перемещает" фишку в соседнюю пустую клетку,
// если она есть, конечно
procedure Move(ex,су: integer);
// сх,су — клетка, в которой игрок сделал щелчок
var
г: integer; // выбор игрока
begin
// проверим, возможен ли обмен
if not (( abs(cx-ex) = 1) and (cy-ey = 0) or
( abs(cy-ey) = 1) and (cx-ex = 0))
then exit;
// Обмен. Переместим фишку из х,у в ех,еу
Ро1е[еу,ех] := Pole[су,сх];
Pole[су,сх] := 0;
ех:=сх;
еу:=су;
// отрисовать поле
Forml. ShowPole ;
if Finish then
begin
r := MessageDlg('Цель достигнута!'+ #13+
'Еше раз?1,mtInformation,[mbYes,mbNo],0);
if r = mrNo then Forml.Close; // завершить работу программы
end;
end;
// щелчок в клетке
procedure TForml.FormMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
cx,cy: integer; // координаты клетки
begin
// преобразуем координаты мыши в координаты клетки
CSS := Trunc(X / CW) + 1;
су := Trunc(l' / СН) + 1;
Move(ex,су);
end;
// выводит игровое поле
procedure TForml.ShowPole;
var
i,j: integer;
x,y: integer; // к,у — координаты вывода
// текста в клетке
begin
m
// сетка: вертикальные линии
for i:= I to И- 1 do
begin
Canvas.MoveTo(i*CW,0);
Canvas.LineTo(i*CW,ClientHeight) ;
end;
// сетка: горизонтальные линии
for i:= 1 to H- Ido
begin
Canvas.MoveTo(0,i*CH);
Canvas.LineTo(ClientWidth, i*CH) ;
end;
// содержимое клеток
// x,y — координаты вывода текста
for i:= 1 to H do
begin
y:=(i-l)*CH + 15;
for j:=1 to W do
begin
x:= (j-l)*CK + 15;
case Pole[i,j] of
0: Canvas.TextOut(x,y,' ');
1..9: Canvas.TextOut(x,y,' '+
IntToStr(Pole[i,j])+' ');
10..15: Canvas.TextOut(x,y,IntToStr(Pole[i,j])
end;
end;
end;
end;
// "перемешивает" фишки
procedure TForml.Mixer;
var
xl,yl: integer; // пустая клетка
x2,y2: integer; // эту переместить в пустую
d: integer; // направление, относительно пустой
i: integer;
begin
xl:=4;
yl: =4 ;
randomize;
for i:= 1 to 150 do
begin
repeat
x2:=xl;
y2:=yl;
d:=random(4)+ 1;
case d of
1: ~dec(x2);
2: inc(x2);
3: dec(y2);
4: inc(y2);
end;
until (x2>=l) and (x2<=4) and (y2>=l) and (y2<=4);
// здесь определили фишку, которую
// надо переместить в пустую клетку
Pole[yl,xl] := Ро1е[у2,х2];
Ро1е[у2,х2] := 0;
xl:=x2;
У1:=у2;
end;
// запомним координаты пустой клетки
ех:= xl;
еу:= yl;
end;
// обработка события OnCreate
procedure TForml.FormCreate(Sender: TObject);
begin
ClientWidth := CW * W;
ClientHeight := CH * H;
Canvas.Font.Name := 'Times New Roman';
Canvas.Font.Size := 22;
NewGame;
end;
// обработка события OnPaint
procedure TForml.FormPaint(Sender: TObject);
begin
Forml.ShowPole;
end;
end. ,