332 lines
8.8 KiB
ObjectPascal
332 lines
8.8 KiB
ObjectPascal
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.
|
||
|