Хорошо знакомая всем пользователям Windows игра "Сапер" развивает логическое мышление. Вот правила игры. Игровое поле состоит из клеток, в каждой из которых может быть мина. Задача игрока — найти все мины и пометить их флажками. Используя кнопки мыши, игрок может открыть клетку или поста вить в нее флажок, указав тем самым, что в клетке находится мина. Клетка открывается щелчком левой кнопки мыши, фла жок ставится щелчком правой. Если в клетке, которую открыл игрок, есть мина, то происходит взрыв (сапер ошибся, а он, как известно, ошибается только один раз) и игра заканчивается (рис' 1.64). Если в клетке мины нет, то в этой клетке появляется число, соответствующее количеству мин, находящихся в сосед них клетках. Анализируя информацию о количестве мин в клетках, соседних с уже открытыми, игрок может обнаружить и по метить флажками все мины. Ограничений на количество клеток, помеченных флажками, нет. Однако для завершения игры (вы игрыша) флажки должны быть установлены только в тех клетках, в которых есть мины. Ошибочно установленный флажок можно убрать, щелкнув правой кнопкой мыши в клетке, в которой он находится.

Рис. 1.64. Вид окна во время (в конце) игры

Разработайте программу, реализующую игру "Сапер". Вид глав ной формы приведен на рис. 1.65.

Рис. 1.65. Главная форма программы Сапер

// модуль главной формы
unit saper_l;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, Menus, StdCtrls, OleCtrls;
type
TForml = class(TForm)
MainMenul: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
procedure FormlCreate(Sender: TObject);
procedure FormlPaint(Sender: TObject);
procedure FormlMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NIClick(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
( Private declarations }
public
[ Public declarations )
end;
var
Forml: TForml;
implementation
uses saper_2;
{$R *.DFM}
const
MR = 10; // кол-во клеток по вертикали
МС = 10; // кол-во клеток по горизонтали
NM = 10; // кол-во мин
W =40; // ширина клетки поля
Н =40; // высота клетки поля
var
Pole: array[0..MR+l, 0.. MC+l] of integer; //минное поле
// значение элемента массива:
// 0,.8 — количество мин в соседних клетках
// 9 — в клетке мина
// 100..109 — клетка открыта
// 200..209 — в клетку поставлен флаг
nMin : integer; // кол-во найденных мин
nFlag : integer; // кол-во поставленных флагов
status : integer; // 0 — начало игры; 1 — игра; 2 — результат
// генерирует новое поле
Procedure NewGame(); forward;
// показывает поле
Procedure ShowPole(Canvas : TCanvas; status:integer); forward;
// выводит содержимое клетки
Procedure Kletka(Canvas: TCanvas; row,col,status :integer);
forward;
// открывает текущую и все соседние клетки, в которых нет мин
Procedure Open( row, col : integer); forward;
// рисует мину
Procedure Mina(Canvas : TCanvas; x, у : integer); forward;
// рисует флаг
Procedure Flag( Canvas : TCanvas; x, у : integer); forward;
// выводит на экран содержимое клетки
Procedure Kletka(Canvas : TCanvas; row,col,status : integer);
var
x,y : integer; // координаты области вывода
begin
x := (col-1)* W + 1;
у := (row-1)* H + 1;
if status = 0 then
begin
Canvas.Brush.Color := clLtGray;
Canvas.Rectangle(x-1,y-l,x+W,y+H);
exit;
end;
if Pole[row,col] < 100 then
begin
// не открытые клетки — серые
Canvas.Brush.Color : = clLtGray;
Canvas.Rectangle(x-1,y-1,x+W,y+H);
// если игра завершена (status = 2),
// то показать мины
if (status = 2) and (Pole[row,col] = 9)
then Mina(Canvas, x, y);
exit;
end;
// открываем клетку
Canvas.Brush.Color := clWhite; // открытые белые
Canvas.Rectangle(x-1,y-1,x+W,y+H);
if ( Pole[row,col] = 100)
then exit; // клетка открыта, но она пустая
if (Pole[row,col] >= 101) and (Pole[row,col] <= 108) then
begin
Canvas.Font.Size := 14;
Canvas.Font.Color := clBlue;
Canvas .TextOut (x+3, y+2,.
IntToStr(Pole[row,col] - 100));
exit;
end;
if ( Pole[row,col] >= 200) then
Flag(Canvas, x, y);
if (Pole[row,col] = 109) then
// на этой мине подорвались!
begin
Canvas.Brush.Color := clRed;
Canvas.Rectangle(x-1,y-l,x+W,y+H) ;
end;
if ( (Pole[row,col] mod 10) = 9) and (status = 2) then
Mina(Canvas, x, y);
end;
// показывает поле
Procedure ShowPole(Canvas : TCanvas; status : integer);
var
row,col : integer;
begin
for row := 1 to MR do
for col := 1 to MC do
Kletka(Canvas, row, col, status);
end;
m
// рекурсивная функция открывает текущую и все соседние
// клетки, в которых нет мин
Procedure Open( row, col : integer);
begin
if Pole[row,col] = 0 then
begin
Pole[row,col] := 100;
Kletka(Forml.Canvas, row,col, 1);
Open(row,col-1);
Open(row-1,col);
Open(row,col+1);
Open(row+1,col);
//примыкающие диагонально
Open(row-1,col-1);
Open(row-1,col+1) ;
Open(row+1,col-1);
Open(row+1,col+1) ;
end
else
if (Pole[row,col]<100)and(Pole[row,col]<>-3) then
begin
Pole[row,col] := Pole[row,col] + 100;
Kletka(Forml.Canvas, row, col, 1) ;
end;
end;
// новая игра — генерирует новое поле
procedure NewGame();
var
row,col : integer; // координаты клетки
n : integer; // кол-во поставленных мин
к : integer; // кол-во мин в соседних клетках
begin
// Очистим эл-ты массива, соответствующие клеткам
// игрового поля.
for row :=1 to MR do
for col :=1 to MC do
Pole[row,col] := 0;
// расставим мины
Randomized; // инициализация ГСЧ
n := 0; // кол-во мин
repeat
row := Random(MR) + 1;
col := Random(MC) + 1;
if ( Pole[row,col] <> 9) then
begin
Pole[row,col] := 9;
n := n+1;
end;
until ( n = NM);
// для каждой клетки вычислим
// кол-во мин в соседних клетках
for row := 1 to MR do
for col := 1 to MC do
if ( Pole[row,col] <> 9) then
begin
к :=0;
if Pole[row-l,col-l] = 9 then к := к + 1;
if Pole[row-1,col] = 9 then к := к + 1;
if Pole[row-l,col+l] = 9 then к := к + 1;
if Pole[row,col-1] = 9 then к := к + 1;
if Pole[row,col+1] = 9 then к := к + 1;

if Pole[row+l,col-l] = 9 then к := к + 1;
if Pole[row+1,col] = 9 then к := к + 1;
if Pole[row+1,col+1] - 9 then к := к + 1;
Pole[row,col] := k;
end;
status := 0; // начало игры
nMin := 0; // нет обнаруженных мин
nFlag := 0; // нет флагов
end;
// рисует мину
Procedure Mina(Canvas : TCanvas; x, у : integer);
begin
with Canvas do
begin
Brush.Color := clGreen;
Pen.Color := clBlack;
Rectangle(x+16,y+26,x+24,y+30);
Rectangle(x+8,y+30,x+l6,y+34);
Rectangle (x+24, y+30, x+*32, y+34 ) ;
Pie(x+6,y+28,x+34,y+44,x+34,y+36,x+6,y+36) ;
MoveTo(x+12,y+32); LineTo(x+2 6,y+32);
MoveTo(x+8,y+36); LineTo(x+32,y+36);
MoveTo(x+20,y+22); LineTo(x+20,y+26);
MoveTo(x+8, y+30); LineTo(x+6,y+28);
MoveTo(x+32,y+30); LineTo(x+34,y+28);
end;
end;
// рисует флаг
Procedure Flag( Canvas : TCanvas; x, у : integer);
var
p : array [0..3] of TPoint; // координаты флажка и
// нижней точки древка
m : array [0..4] of TPoint; // буква М
begin
// зададим координаты точек флажка
р[0].х:=х+4; р[0].у:=у+4;
р[1].х:=х+30; р[1].у:=у+12;
р[2].х:=х+4; р[2].у:=у+20;
р[3].х:=х+4; р[3].у:=у+36; // нижняя точка древка
m[0].x:=x+8; m[0].у:=y+14;
m[1].x:=x+8; m[1].у:=y+8;
m[2].x:=x+10; m[2].y:=y+10;
m[3].x:=x+12; ra[3].y:=y+8;
m[4].x:=x+12; m[4].y:=y+14;
with Canvas do
begin
// установим цвет кисти и карандаша
Brush.Color := clRed;
Pen.Color := clRed;
Polygon(p); // флажок
// древко
Pen.Color := clBlack;
MoveTo(p[0] .x, p[0] .y) ;
LineTo(p[3] .x, p[3] .y) ;
// буква М
Pen.Color := clWhite;
Polyline(m);
Pen.Color := clBlack;
end;
end;
// выбор из меню ? команды О программе
procedure TForml.N4Click(Sender: TObject);
begin
AboutForm.Top := Trunc(Forml.Top + Forml.Height/2 -
AboutForm.Height/2);
AboutForm.Left := Trunc(Forml.Left +Forml.Width/2 -
AboutForm.Width/2);
About Form.ShowModal;
end;
procedure TForml.FormlCreate(Sender: TObject);
var
row,col : integer;
begin
// В неотображаемые ал-ты массива, которые соответствуют
// клеткам по границе игрового поля, запишем число -3.
// Это значение используется функцией Open для завершения
// рекурсивного процесса открытия соседних пустых клеток.
for row :=0 to MR+1 do
for col :=0 to MC+1 do
Pole[row,col] := -3;
NewGaineO; /'/' "разбросать" мины
Forml.ClientHeight := H*MR + 1;
Forml.ClientWidth := W*MC + 1;
end;
// нажатие кнопки мыши на игровом поле
procedure TForml.FormlMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
row, col : integer;
begin
if status = 2 // игра завершена
then exit;
if status ¦ 0 then // первый щелчок
status := 1;
// преобразуем координаты мыши в индексы
// клетки поля
row := Trunc(y/H) + 1;
col := Trunc(x/W) + 1; .
if Button = rabLeft then
begin
if Pole[row,col] = 9 then
begin // открыта клетка, в которой есть мина
Pole[row,col] := Pole[row,col] + 100;
status := 2; // игра закончена
ShowPole(Forml.Canvas, status);
end
else if Pole[row,col] < 9 then
Open(row,col);
end
else
if Button = mbRight then
if Pole[row,col] > 200 then
begin
// уберем флаг и закроем клетку
nFlag := nFlag — 1;
Pole[row,col] := Pole[row,col] — 200;
к := (col-1)* W + 1;
у := (row-1)* H + 1;
Canvas.Brush.Color := clLtGray;
Canvas.Rectangle(x-1,y-l,x+W,y+H);
end
else
begin // поставить в клетку флаг
nFlag := nFlag + 1;
if Pole[row,col] = 9
then nMin := nMin + 1;
Pole[row,col] : = Pole[row,col]+ 200;
if (nMin = MM) and (nFlag = bJM) then
begin
status := 2; // игра закончена
ShowPole(Forml.Canvas, status);
end
else Kletka(Forml.Canvas, row, col,
status);
end;
end;
// выбор меню Новая игра
procedure TForml.NIClick(Sender: TObject);
begin
NewGame();
ShowPole(Forml.Canvas,status) ;
end;
/ выбор из меню ? команды Справка
procedure TForml.N3Click(Sender: TObject);
begin
/'/ вывести справочную информацию
Winhelp(Forml.Handle,'saper.hlp',HELP_CONTEXT,1);
end;
//' обработка события OnPaint
procedure TForml.FormlPaint(Sender: TObject);
begin
// отобразить игровое поле
ShowPole(Forml.Canvas, status);
end;
end.
// модуль формы О программе
unit saper 2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, saper_l;
type
TAboutForm = class(TForm)
Buttonl: TButton;
Label1: TLabel;
Label2: TLabel;
procedure ButtonlClick(Sender: TObject);
private
{ Private declarations }
public
I Public declarations }
end;
var
AboutForm: TAboutForm;
implementation
{$R *.DFM}
procedure TAboutForm.ButtonlClick(Sender: TObject);
begin
ModalResult := mrOk;
end;
end.