book-exercises/Занимательное программирование/7/1_minesweeper/unit1.pas

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.