unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls; const FieldWidth = 20; { Ширина поля } FieldHeight = 25; { Высота поля } CellsPerMine = 6; { Среднее значение количества клеток на одну мину } type { "Доработанная" кнопка } MySpeedButton = class(TSpeedButton) public x, y: Integer; { Её положение на игровом поле } Uncovered: Boolean; { Нажата или нет } IsMine: Boolean; { Находится ли в ней мина } Flagged: Boolean; { Помечена флажком } Clicked: Boolean; procedure Uncover; procedure Flag; { Обработчик события Click } procedure MouseLeave; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); override; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; ImageList: TImageList; Status: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private public end; var { Игровое поле (двумерный массив кнопок) } Field: array[0..FieldWidth - 1, 0..FieldHeight - 1] of MySpeedButton; GameOver: Boolean = false; { Индикатор конца игры } Mines: Integer; { Количество мин } Opened: Integer; { Количество открытых клеток } Form1: TForm1; { Создание игрового поля } procedure MakeButtons; procedure StartGame; implementation {$R *.lfm} { MySpeedButton } { Обработка щелчка на кнопке } procedure MySpeedButton.Uncover; var c: Integer; i, j: Integer; dx, dy: Integer; begin { Теперь кнопка точно нажата } Uncovered := true; { Если в ней оказалась мина } if IsMine then begin GameOver := true; Form1.Status.Caption := 'Поражения!'; { Выводим изображение мины (9) } Form1.ImageList.GetBitmap(9, Glyph) end else begin c := 0; for dx := -1 to 1 do for dy := -1 to 1 do { Клетка сама себе не сосед } if not ((dx = 0) and (dy = 0)) then begin { Координаты текущего соседа } i := x + dx; j := y + dy; { Если сосед не за пределами поля, учитываем его } { Integer(Field[i, j].IsMine) = 1, если есть мина. } { Integer(Field[i, j].IsMine) = 0 в противном случае } if (i >= 0) and (j >= 0) and (i < FieldWidth) and (j < FieldHeight) then c := c + Integer(Field[i, j].IsMine); end; Form1.ImageList.GetBitmap(c, Glyph); { Рисуем требуемую картинку } { Мы открыли еще одну клетку } Opened := Opened + 1; { Открыты все безопасные клетки } if Opened + Mines = FieldWidth * FieldHeight then begin { Конец игры } GameOver := true; Form1.Status.Caption := 'Победа!' end; if c = 0 then for dx := -1 to 1 do for dy := -1 to 1 do { Клетка сама себе не сосед } if not ((dx = 0) and (dy = 0)) then begin { Координаты текущего соседа } i := x + dx; j := y + dy; if (i >= 0) and (j >= 0) and (i < FieldWidth) and (j < FieldHeight) and not Field[i, j].Uncovered then Field[i, j].Uncover end end; end; procedure MySpeedButton.Flag; begin if Flagged then begin Flagged := false; Glyph := nil end else begin Flagged := true; Form1.ImageList.GetBitmap(10, Glyph) end end; procedure MySpeedButton.MouseLeave; begin Clicked := false end; procedure MySpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); begin if (Button = mbLeft) or (Button = mbRight) then Clicked := true end; procedure MySpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; ax, ay: Integer); begin { Если кнопка уже нажата или игра закончена, не обрабатываем } if GameOver or Uncovered or not Clicked then Exit; if (Button = mbLeft) and not Flagged then Uncover else if Button = mbRight then Flag end; procedure StartGame; var i, j: Integer; begin { Строка статуса изначально пуста } Form1.Status.Caption := ''; { Счетчик мин } Mines := 0; { Счетчик открытых клеток } Opened := 0; { Еще не конец игры } GameOver := false; for i := 0 to FieldWidth - 1 do for j := 0 to FieldHeight - 1 do begin { Пока на кнопках нет картинок } Field[i, j].Glyph := nil; { и ни одна из них не нажата } Field[i, j].Uncovered := false; { и не помечена } Field[i, j].Flagged := false; Field[i, j].Clicked := false; { С вероятностью 1/CellsPerMine } if Random(CellsPerMine) = 0 then begin { Размещаем мину } Field[i, j].IsMine := true; Mines := Mines + 1 end else begin { иначе клетка безопасна } Field[i, j].IsMine := false end end end; { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin Randomize; { При запуске программы создаем кнопки } MakeButtons; StartGame; end; procedure TForm1.Button1Click(Sender: TObject); begin StartGame; end; procedure TForm1.FormDestroy(Sender: TObject); var i, j: Integer; begin for i := 0 to FieldWidth - 1 do for j := 0 to FieldHeight - 1 do Field[i, j].Free; end; procedure MakeButtons; var i, j: Integer; begin for i := 0 to FieldWidth - 1 do for j := 0 to FieldHeight - 1 do begin Field[i, j] := MySpeedButton.Create(nil); { Создать кнопку } with Field[i, j] do begin { Указываем координаты кнопки } Left := i * 24; Top := j * 24; { Указываем размеры кнопки } Width := 24; Height := 24; Parent := Form1; { а также родительскую форму } { x, y - Позиция кнопки на игровом поле } x := i; y := j end end; end; end.