unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, Menus, ExtCtrls; const DefaultFieldWidth = 16; { Ширина поля } DefaultFieldHeight = 16; { Высота поля } CellSize = 24; 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; BestTimes: TMenuItem; TimerLabel: TLabel; MainMenu1: TMainMenu; Game: TMenuItem; Beginner: TMenuItem; Intermediate: TMenuItem; Expert: TMenuItem; Status: TLabel; Timer1: TTimer; procedure BeginnerClick(Sender: TObject); procedure BestTimesClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ExpertClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure IntermediateClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); private public end; var { Игровое поле (двумерный массив кнопок) } Field: array of array of MySpeedButton; GameOver: Boolean = false; { Индикатор конца игры } Mines: Integer; { Количество мин } Opened: Integer; { Количество открытых клеток } Form1: TForm1; Results: array[1..3] of Integer; { Создание игрового поля } procedure MakeButtons(AFieldWidth, AFieldHeight: Integer); procedure StartGame; { Конец игры } procedure EndGame; procedure FreeField; 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 < Length(Field)) and (j < Length(Field[0])) then c := c + Integer(Field[i, j].IsMine); end; Form1.ImageList.GetBitmap(c, Glyph); { Рисуем требуемую картинку } { Мы открыли еще одну клетку } Opened := Opened + 1; { Открыты все безопасные клетки } if Opened + Mines = Length(Field) * Length(Field[0]) then EndGame; 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 < Length(Field)) and (j < Length(Field[0])) 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 Inherited; 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 High(Field) do for j := 0 to High(Field[i]) 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; procedure EndGame; begin GameOver := true; Form1.Status.Caption := 'Победа!'; if Length(Field) = 9 then if Form1.Timer1.Tag < Results[1] then Results[1] := Form1.Timer1.Tag else if Length(Field) = 16 then if Form1.Timer1.Tag < Results[2] then Results[2] := Form1.Timer1.Tag else if Length(Field) = 20 then if Form1.Timer1.Tag < Results[3] then Results[3] := Form1.Timer1.Tag end; { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin Randomize; Results[1] := 999999; Results[2] := 999999; Results[3] := 999999; { При запуске программы создаем кнопки } MakeButtons(DefaultFieldWidth, DefaultFieldHeight); StartGame end; procedure TForm1.Button1Click(Sender: TObject); begin StartGame; end; procedure TForm1.ExpertClick(Sender: TObject); begin MakeButtons(20, 25); StartGame end; procedure TForm1.BeginnerClick(Sender: TObject); begin MakeButtons(9, 9); StartGame end; procedure TForm1.BestTimesClick(Sender: TObject); begin ShowMessage('Новичок: ' + Results[1].ToString + sLineBreak + 'Нормальный: ' + Results[2].ToString + sLineBreak + 'Эксперт: ' + Results[3].ToString) end; procedure TForm1.FormDestroy(Sender: TObject); begin FreeField; Inherited end; procedure TForm1.IntermediateClick(Sender: TObject); begin MakeButtons(DefaultFieldWidth, DefaultFieldHeight); StartGame end; procedure TForm1.Timer1Timer(Sender: TObject); var Minutes, Seconds: Integer; begin Minutes := Timer1.Tag div 60; Seconds := Timer1.Tag mod 60; if Seconds > 9 then TimerLabel.Caption := Minutes.ToString + ':' + Seconds.ToString else TimerLabel.Caption := Minutes.ToString + ':0' + Seconds.ToString; Timer1.Tag := Timer1.Tag + 1 end; procedure FreeField; var i, j: Integer; begin for i := 0 to High(Field) do for j := 0 to High(Field[i]) do Field[i, j].Free end; procedure MakeButtons(AFieldWidth, AFieldHeight: Integer); var i, j: Integer; begin FreeField; SetLength(Field, AFieldWidth, AFieldHeight); for i := 0 to AFieldWidth - 1 do for j := 0 to AFieldHeight - 1 do begin Field[i, j] := MySpeedButton.Create(nil); { Создать кнопку } with Field[i, j] do begin { Указываем координаты кнопки } Left := i * CellSize; Top := j * CellSize; { Указываем размеры кнопки } Width := CellSize; Height := CellSize; Parent := Form1; { а также родительскую форму } { x, y - Позиция кнопки на игровом поле } x := i; y := j end end; end; end.