path: root/Занимательное программирование/7/2_minesweeper/unit1.pas

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.