Рис. 1.59. Окно программы Собери картинку

Игра "Собери картинку" — игра "15" с графическим интерфейсом (вместо цифр — фрагменты картинки) . Картинка загружается из файла pic_l.bmp, который находится в том же каталоге что и выполняемый файл программы.

(с) Культин Н.Б., 2003.
}
unit soberi_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs;
type
TForml = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
// эти объявления вставлены сюда вручную
procedure ShowPole;
procedure Mixer;
procedure NewGame;
private
I Private declarations I
public
{ Public declarations )
end;
var
Forml: TForml;
implementation
{$R +.dfm}
const
H = 4; W = 4; // размер поля - 4x4
we,he: integer; // ширина и высота клетки
// игровое поле
pole: array[1..H, 1..W] of byte;
ex,ey: integer; // координаты пустой клетки
// правильное расположение клеток
stp : array[1..H, 1..W] of byte =
(( 1, 2, 3, 4),
( 5, 6, 7, 8),
( 9,10,11,12) ,
(13,14,15, 0));
pic: TBitmap; // картинка
// новая игра
procedure TE'orml .NewGame;
var
fname: string[20]; // файл картинки
i,j: integer; •
begin
l сюда можно вставить инструкции,
обеспечивающие, например, случайный
выбор загружаемой картинки }
fname := 'pic_l.bmp1;
try
pic.LoadFromFile(fname);
except
on EFopenError do
begin
ShowMessage('Ошибка обращения к файлу ' + fname)
Forml.Close;
end;
end;
// установить размер формы,
// равный размеру картинки
// размер клетки
he := Pic.Height div H;
we := Pic.Width div W;
// размер формы
ClientWidth := we * W;
ClientHeight := he * H;
// исходное (правильное) положение
for i:=1 to H do
for j:=1 to W do
pole[i,j] := stp[i,j];
Forml.Mixer; // перемешать фишки
Forral.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;
// Обмен. Переместим фишку из х,у в ех,еу
Pole[ey,ex] := Pole[су,сх];
Pole[су,сх] := 0;
ех:=сх;
еу:=су;
// отрисовать поле
Forml.ShowPole;
if Finish then
begin
pole[4,4] := 16;
Forml.ShowPole;
r : = MessageDlg('Цель достигнута!'+ #13+
'Еше раз? ',mtlnformation,' [mbYes,mbNo], 0) ;
if г = mrNo then Forml.Close; // завершить работу
// программы
Forml.NewGame;
end;
end;
// щелчок в клетке
procedure TForml.FormMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
cx,cy: integer; // координаты клетки
begin
// преобразуем координаты мыши в координаты клетки
сх := Trunc(X / we) + 1;
су := Trunc(Y / he) + 1;
Move(ex,су);
end;
// выводит игровое поле
procedure TForml.ShowPole;
var
Source, Dest: TRect; // области: источник и приемник
sx,sy: integer; // левый верхний угол области-источника
х,j: integer;
begin
// содержимое клеток
for i := 1 to W do
for j := 1 to H do
begin
// преобразуем номер картинки
// в координаты левого верхнего
// угла области-источника
sy := ((pole[i,j] -1) div W) * he;
sx := ((pole[i,j] -1) mod W) * we;
Source := Bounds(sx,sy,we,he);
Dest := Bounds ( (j-1) *wc, (i-1) *hc,wc,hc) ;
if polefi,j] <> 0
then Canvas.CopyRect(Dest,pic.Canvas,Source)
else Canvas.Rectangle)(j-1)*wc, (i-l)*hc,
j*wc, i*hc);
end;
end;
// "перемешивает" фишки
procedure TForml.Mixer;
var
xl,yl: integer; // пустая клетка
x2,y2: integer; // эту переместить в пустую
d: integer; . // направление, относительно пустой
1; integer;
begin
xl:=4; yl:=4; // см. описание массива stp
randomize;
for i:= 1 to 150 do // кол-во перестановок
begin
repeat
x2:=xi;
y2:=yl;
d:=random(4)+1;
бЗак. 939
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
pic := TBitMap.Create;
NewGame;
end;
// обработка события OnPaint
procedure TForml.FormPaint(Sender: TObject);
begin
Forml.ShowPole;
end;
end.