The module main window Minesweeper 2002
unit saper_l;
interface
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, OleCtrls, HHOPENLib_TLB;
type
TForm1 = class(TForm)
MainMenul: TMainMemi;
N1: TMemiltem;
N2: TMemiltem;
N3: TMenuItem;
N4: TMenuItem;
Hhopen1: THhopen;
procedure FormlCreate(Sender: TObject);
procedure FormlPaint(3ender; TObject);
procedure FomlMouseDovmf Sender: TObject; Button: TMouseButton,-
Shift: TShiftState( X, Y: Integer);
procedure NIClick(Sender: TObject);
procedure K4Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForml;
implementation
uses saper_2;
{$R*.DFM}
const
MR = 10; // кол-во клеток по вертикали
МС = 10; // кол-во клеток по горизонтали
NМ = 10; // кол-во мин
W = 40; // ширина клетки поля
Н = 40; // аысога клетки поля
var
pole: array(0..MR+1, 0.. MC+1] of integer; // минное попе
// значение элемента массива:
// 0..8 — количество мин в соседний клетках
// 9 — в клетке мина
// 100,.109 — клетка открыта
// 200..209 — в клетку поставлен флаг
nMin : integer; // кол-во найденных мин
nFlag : integer; // кол-во поставленных флагов
status : integer; //0 — начало игры; I - игра; 2 - результат
Procedure NewGameO; forward; // генерирует новое поле
Procedure ShowPole(Canvas : TCanvas; status : integer); forward;
//Показывает поле
Procedure Kletka(Canvas : TCanvas; row, col, status ; integer); forward;
// выводит содержимое клетки
Procedure Open(row, col : integer); forward;// открывает текущую и все соседние клетки, в которых нет мин
Procedure MinafCanvas : TCanvas; х, у : integer); forward; // рисует мину
Procedure Flag(Canvas : TCanvas; x, у : integer); forward;// рисует флаг
// выводит на экран содержимое клетки
Procedure Kletka(Canvas : TCanvas; row, col, status : integer);
var
х,у : integer; // коорлинаты области вывода
begin
х := (col-1)* W + 1;
у := (row-1)* H + 1;
if status = 0 then
begin
Canvas.Brush.Color := clLtGray;
Canvas,Rectangle(x-1,y-1,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,у+Н);
// есл Hipa завершена (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 trow,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] -1001);
exit;
end;
if (Pole[row,colj >= 200) then
Flag(Canvas, x, y);
if (Pole[row,col] = 109) then // на этой мине подорвались!
begin
Canvas.Brush.Color := clRed;
Canvas.Rectangle(x-1,y-1,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;
// рекурсивная функция открывает текущую и все соседние
// клетки, в которых нет мин
Procedure Open(row, col : integer);
begin
if Pole[row,col] = 0 then
begin
Pole[row,col] ;= 100;
KletkafForml.Canvas, row,col, 1);
Open(row,col-lJ;
Open(row-l,col];
Open(row,col+1];
Open(row+l,col];
// примыкающие диагонально
Open(row-1,col-l|;
Open(row-1,col+1) ;
Open(row+1,col-l);
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; // количество поставленных мин
k : integer; // кол-во мин в соседних клетках
begin
// очистим эл-ты массива, соответствующее клеткам
// игрового поля
for row :=1 to MR do
for col :=1 to MC do
Pole trow,col] := 0;
// расставим мины
Randomized; // инициализация ГСЧ
n :=0; // кол-во мин
repeat
row := Random(MR) + 1;
col := Random(MC) + 1;
it (Pole[row,col] о Э) 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
k :=0 ;
if Pole[row-l,col-l] = 9 then inc(k);
if Pole[row-l,col] = 9 then inc(k);
if Pole[row-l,col+l] = 9 then inc(k);
if Pole[row,col-l] = 9 then inc(k);
if Pole[row,col+l] - 9 then inc(k);
if Pole[row-t-l,col-1! = 9 then inc(k);
if Pole[row+l,col] = 9 then inc(k);
if Pole[row+l,col+l] = 9 then inc(k);
Pole[tow,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+16,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+26,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,yi-28);
end;
end;
// рисуем флаг
Procedure Flag(Canvas : TCanvas; x, у ; integer);
var
p : array 10..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].х =х+4; m[0].у:=у+14;
m[1].х =х+8; m[1].у:=у+8;
m[2].х =х+10; m[2].у:=у+10;
m[3].х =х+12; m[3].у:=у+8;
m[4],x:=x+12; m[4].у:=у+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.mClick(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);
AboutForm.ShowModal;
end;
procedure TForml.FormlCreatefSender: 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;
NewGame(); // "разбросать" мины
Forml.ClientHeight := H*MR + 1;
Forml.ClientWidth := W'MC + 1;
end;
// нажатие кнопки мыши на игровом поле
procedure TForml.FormlMouseDownlSender: 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/H) + 1;
if Button = rnbLeft 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;// уберем флаг
x : = (col-1)- W + 1;
у := (row-1)* H + 1;
Canvas.Brush.Color := clLtGray;
Canvas.Rectangle(x-l,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 = NM) then
begin
status := 2; // игра закончена
ShowPole(Forml.Canvas, status);
end
else KletkafForml.Canvas, row, col, status);
end;
end;
// выбор меню Новая игра
procedure TForml.NlClick(Sender: TObject);
begin
NewGame();
ShowPole(Forml.Canvas,status);
end;
//выбор из меню ? команды Справка
procedure TForml.N3Click(Sender: TObject);
var
HelpFile : string; // файл справки
HelpTopic : string; // раздел справки
pwHelpFile : PWideChar; // файл справки (указатель на WideChar-строку)
pwHelpTopic : PWideChar; // раздел (указатель на HideChar-строку)
begin
HelpFile := 'saper.chm';
HelpTopic := 'saper_02.htm';
// выделить память для tiideChar строк
GetMemfpwHelpFile, Length(HelpFile) * 2);
GetMem(pwHelpTopic, Length(HelpTopic]*2);
// преобразовать ANSI-строку в WideString-строку
pwHelpFile := StringToWideChar(HelpFile,pwHelpFile,MAX_PATH*2);
pwHelpTopic := StringToWideChar(HelpTopic,pwHelpTopic,32);
// вывести справочную информацию
Forml.Hhopenl.OpenHelplpwHelpFile,pwHelpTopic);
end;
procedure TForml.FormlPaint(Sender: TObject);
begin
ShowPole(Forml.Canvas, status);
end;
end.