Листинг 15.9. Модуль главного окна программы Сапер 2002
unit saper_l;interfaceWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs, Menus, StdCtrls, OleCtrls, HHOPENLib_TLB;typeTForm1 = 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;varForm1: TForml;implementationuses saper_2;{$R*.DFM}constMR = 10; // кол-во клеток по вертикалиМС = 10; // кол-во клеток по горизонталиNМ = 10; // кол-во минW = 40; // ширина клетки поляН = 40; // аысога клетки поляvarpole: 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 thenbeginCanvas.Brush.Color := clLtGray;Canvas,Rectangle(x-1,y-1,x+W,y+H);exit;end;if Pole[row,col] < 100 thenbeginCanvas.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) thenbeginCanvas.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) thenFlag(Canvas, x, y);if (Pole[row,col] = 109) then // на этой мине подорвались!beginCanvas.Brush.Color := clRed;Canvas.Rectangle(x-1,y-1,x+W,y+H);end;if ((Pole[row,col] mod 10) = 9) and (status = 2) thenMina(Canvas, x, y);end;// показывает полеProcedure ShowPole(Canvas ; TCanvas; status : integer);varrow,col : integer;beginfor row := 1 to MR dofor col := 1 to MC doKletka(Canvas, row, col, status);end;// рекурсивная функция открывает текущую и все соседние// клетки, в которых нет минProcedure Open(row, col : integer);beginif Pole[row,col] = 0 thenbeginPole[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);endelseif (Pole[row,col] < 100] and (Pole[row,col] <> -3) thenbeginPole[row,col] := Pole[row,col] + 100;Kletka(Forml.Canvas, row, col, 1);end;end;// новая игра — генерирует новое полеprocedure NewGame();varrow,col : integer; // координаты клеткиn : integer; // количество поставленных минk : integer; // кол-во мин в соседних клеткахbegin// очистим эл-ты массива, соответствующее клеткам// игрового поляfor row :=1 to MR dofor col :=1 to MC doPole trow,col] := 0;// расставим миныRandomized; // инициализация ГСЧn :=0; // кол-во минrepeatrow := Random(MR) + 1;col := Random(MC) + 1;it (Pole[row,col] о Э) thenbeginPole[row,col] := 9;n := n+1;end;until (n = NM);// для каждой клетки вычислим// кол-во мин в соседних клеткахfor row := 1 to MR dofor col := 1 to MC doif (Pole£row,col] <> 9) thenbegink :=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);beginwith Canvas dobeginBrush.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);varp : 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 dobegin// установим цвет кисти и карандаша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);beginAboutForm.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);varrow,col : integer;begin// в неотображаемые эл-гы массива, которые соответствуют// клеткам по границе игрового поля, запишем число -3.// это значение используется функцией Open для завершения// рекурсивного процесса открытия соседних пустых клетокfor row :=0 to MR+1 dofor col :=0 to MC+1 doPole[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);varrow, col : integer;beginif status = 2 // игра завершенаthen exit;if status = 0 then // первый щелчокstatus := 1;// преобразуем координаты мыши в индексыrow := Trunc(y/H) + 1;col := Trunc(x/H) + 1;if Button = rnbLeft thenbeginif Pole[row,col] = 9 thenbegin // открыта клетка, в которой есть минаPole[row,col] := Pole[row,col] + 100;status := 2; // игра законченаShowPole(Forml.Canvas, status);endelse if Pole[row,col] < 9 thenOpen(row,col);endelseif Button = mbRight thenif Pole[row,col] > 200 thenbegin// уберем флаг и закроем клетку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];endelsebegin // поставить в клетку флагnFlag := nFlag + 1;if Pole[row,col] = 9then nMin := nMin + 1;Pole[row,col]:=Pole[row,col]+200;// поставили флагif (nMin - MM) and (nFlag = NM) thenbeginstatus := 2; // игра законченаShowPole(Forml.Canvas, status);endelse KletkafForml.Canvas, row, col, status);end;end;// выбор меню Новая играprocedure TForml.NlClick(Sender: TObject);beginNewGame();ShowPole(Forml.Canvas,status);end;//выбор из меню ? команды Справкаprocedure TForml.N3Click(Sender: TObject);varHelpFile : string; // файл справкиHelpTopic : string; // раздел справкиpwHelpFile : PWideChar; // файл справки (указатель на WideChar-строку)pwHelpTopic : PWideChar; // раздел (указатель на HideChar-строку)beginHelpFile := '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);beginShowPole(Forml.Canvas, status);end;end.