1
0

Добавил сапера из седьмой главы

This commit is contained in:
2026-03-11 14:44:08 +01:00
parent 1c52c7d560
commit e87eaf26d5
8 changed files with 633 additions and 0 deletions

View File

@@ -0,0 +1,248 @@
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.