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.
پاسخ با نقل قول
با همون موضوع (بدست آودن Traffic مصرفی در شبکه) ایجاد کردن ، احتمالاً به نتیجه هم رسیدن ولی روشهایی که ارائه شده کمی برای تازه کارها مشکل سازه به همین خاطر تصمیم گرفتم برنامه ای رو در زمینه برای شما قرار بدم تا حالشو ببرید.
نوشته شده توسط SayeyeZohor
