Лістинги

Повний текст програми Сапер 2002 представлений нижче. У лістингу 15.9 наведено модуль, відповідний головною формою, В лістингу 15.10 -форме Про.

Лістинг 15.9. Модуль головного вікна програми Сапер 2002

unit saper_1;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, OleCtrls, HHOPENLib_TLB;
type
TForm1 = class (TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Hhopen1: THhopen;
procedure Form1Create (Sender: TObject);
procedure Form1Paint (Sender: TObject);
procedure Form1MouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N1Click (Sender: TObject);
procedure N4Click (Sender: TObject);
procedure N3Click (Sender: TObject);
private
{Private declarations}
public
{Public declarations}
end;
var
Form1: TForm1;

implementation
uses saper_2;
{$ R * .DFM}
const
MR = 10; // кількість клітин по вертикалі
MC = 10; // кількість клітин по горизонталі
NM = 10; // кількість хв
W = 40; // ширина клітини поля
H = 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 - початок гри; 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, y: integer); forward; // Малює міну
Procedure Flag (Canvas: TCanvas; x, y: integer); forward; // Малює прапор
// виводить на екран вміст клітини
Procedure Kletka (Canvas: TCanvas; row, col, status: integer);
var
x, y: integer; // координати області виведення
begin
x: = (col-1) * W + 1;
y: = (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, 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-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;
Kletka (Form1.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 (Form1.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 [row, col]: = 0;
// розставимо міни
Randomize (); // ініціалізація ГСЧ
n: = 0; // кількість хв
repeat
row: = Random (MR) + 1;
col: = Random (MC) + 1;
if (Pole [row, col] & lt; & gt; 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] "lt" > 9) then
begin
k: = 0;
if Pole [row-1, col-1] = 9 then k: = k + 1;
if Pole [row-1, col] = 9 then k: = k + 1;
if Pole [row-1, col + 1] = 9 then k: = k + 1;
if Pole [row, col-1] = 9 then k: = k + 1;
if Pole [row, col + 1] = 9 then k: = k + 1;
if Pole [row + 1, col-1] = 9 then k: = k + 1;
if Pole [row + 1, col] = 9 then k: = k + 1;
if Pole [row + 1, col + 1] = 9 then k: = k + 1;
Pole [row, col]: = k;
end;
status: = 0; // початок гри
nMin: = 0; // нет виявлених хв
nFlag: = 0; // нет прапорів
end;
// Малює міну
Procedure Mina (Canvas: TCanvas; x, y: 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, y + 28);
end;
end;
// Малює прапор
Procedure Flag (Canvas: TCanvas; x, y: integer);
var
p: array [0..3] of TPoint; // координати прапорця і нижньої точки древка
m: array [0..4] of TPoint; // буква М
begin
// задамо координати точок прапорця
p [0] .x: = x + 4; p [0] .y: = y + 4;
p [1] .x: = x + 30; p [1] .y: = y + 12;
p [2] .x: = x + 4; p [2] .y: = y + 20;
p [3] .x: = x + 4; p [3] .y: = y + 36; // нижня точка древка
m [0] .x: = x + 8; m [0] .y: = y + 14;
m [1] .x: = x + 8; m [1] .y: = y + 8;
m [2] .x: = x + 10; m [2] .y: = y + 10;
m [3] .x: = x + 12; m [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 TForm1.N4Click (Sender: TObject);
begin
AboutForm.Top: = Trunc (Form1.Top + Form1.Height / 2 - AboutForm.Height / 2);
AboutForm.Left: = Trunc (Form1.Left + Form1.Width / 2 - AboutForm.Width / 2);
AboutForm.ShowModal;
end;
procedure TForm1.Form1Create (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;
NewGame (); // "розкидати" міни
Form1.ClientHeight: = H * MR + 1;
Form1.ClientWidth: = W * MC + 1;
end;

// натискання кнопки миші на ігровому полі
procedure TForm1.Form1MouseDown (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 = mbLeft then
begin
if Pole [row, col] = 9 then
begin // відкрита клітина, в якій є міна
Pole [row, col]: = Pole [row, col] + 100;
status: = 2; // гра закінчена
ShowPole (Form1.Canvas, status);
end
else if Pole [row, col] & lt; 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;
y: = (row-1) * H + 1;
Canvas.Brush.Color: = clLtGray;
Canvas.Rectangle (x-1, y-1, 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 = NM) and (nFlag = NM) then
begin
status: = 2; // гра закінчена
ShowPole (Form1.Canvas, status);
end
else Kletka (Form1.Canvas, row, col, status);
end;
end;
// Вибір меню Нова гра
procedure TForm1.N1Click (Sender: TObject);
begin
NewGame ();
ShowPole (Form1.Canvas, status);
end;
// вибір з меню? команди Довідка
procedure TForm1.N3Click (Sender: TObject);
var
HelpFile: string; // файл довідки
HelpTopic: string; // розділ довідки
pwHelpFile: PWideChar; // файл довідки (покажчик на WideChar рядок)
pwHelpTopic: PWideChar; // розділ (покажчик на WideChar рядок)
begin
HelpFile: = 'saper.chm';
HelpTopic: = 'saper_02.htm';
// виділити пам'ять для WideChar рядків
GetMem (pwHelpFile, Length (HelpFile) * 2);
GetMem (pwHelpTopic, Length (HelpTopic) * 2);
// перетворити Ansi рядок в WideString рядок
pwHelpFile: = StringToWideChar (HelpFile, pwHelpFile, MAX_PATH * 2);
pwHelpTopic: = StringToWideChar (HelpTopic, pwHelpTopic, 32);
// вивести довідкову інформацію
Form1.Hhopen1.OpenHelp (pwHelpFile, pwHelpTopic);
end;
procedure TForm1.Form1Paint (Sender: TObject);
begin
ShowPole (Form1.Canvas, status);
end;
end .