Листинги. Учебник Delphi для начинающих

Полный текст программы Сапер 2002 представлен ниже. В листинге 15.9 приведен модуль, соответствующий главной форме, В листинге 15.10 -форме О программе.

Листинг 15.9. Модуль главного окна программы Сапер 2002

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Hhopen1: THhopen;

procedure Form1Create(Sender: TObject);
procedure Form1Paint(Sender: TObject);
procedure Form1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N1Click(Sender: TObject);

procedure N4Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
MR = 10; // кол-во клеток по вертикали
MC = 10; // кол-во клеток по горизонтали
NM = 10; // кол-во мин

W = 40; // ширина клетки поля
H = 40; // высота клетки поля

var
Pole: array[0..MR+1, 0.. MC+1] of integer; // минное поле
// значение элемента массива:
// 0..8 - количество мин в соседних клетках
// 9 - в клетке мина
// 100..109 - клетка открыта
// 200..209 - в клетку поставлен флаг

nMin : integer; // кол-во найденных мин
nFlag : integer; // кол-во поставленных флагов

status : integer; // 0 - начало игры; 1- игра; 2 -результат

// генерирует новое поле
Procedure ShowPole(Canvas : TCanvas; status : integer); forward;// Показывает поле
Procedure Kletka(Canvas : TCanvas; row, col, status : integer); forward; // выводит содержимое клетки
Procedure Open( row, col : integer); forward;// открывает текущую и все соседние клетки, в которых нет мин
Procedure Mina(Canvas : TCanvas; x, y : integer); forward; // Рисует мину
Procedure Flag( Canvas : TCanvas; x, y : integer); forward;// Рисует флаг

// выводит на экран содержимое клетки
Procedure Kletka(Canvas : TCanvas; row, col, status : integer);
var
x,y : integer; // координаты области вывода
begin
x := (col-1)* W + 1;
y := (row-1)* H + 1;

if status = 0 then
begin
Canvas.Brush.Color := clLtGray;
Canvas.Rectangle(x-1,y-1,x+W,y+H);
exit;
end;

if Pole[row,col] < 100 then
begin
Canvas.Brush.Color := clLtGray; // не открытые - серые
Canvas.Rectangle(x-1,y-1,x+W,y+H);
// если игра завершена (status = 2), то показать мины
if (status = 2) and (Pole[row,col] = 9)
then Mina(Canvas, x, y);
exit;
end;

// открываем клетку
Canvas.Brush.Color := clWhite; // открытые белые
Canvas.Rectangle(x-1,y-1,x+W,y+H);
if ( Pole[row,col] = 100 )
then exit; // клетка открыта, но она пустая

if ( Pole[row,col] >= 101) and (Pole[row,col] <= 108 ) then
begin
Canvas.Font.Size := 14;
Canvas.Font.Color := clBlue;
Canvas.TextOut(x+3,y+2,IntToStr(Pole[row,col] -100 ));
exit;
end;

if (Pole[row,col] = 109 ) then // на этой мине подорвались!
begin
Canvas.Brush.Color := clRed;
Canvas.Rectangle(x-1,y-1,x+W,y+H);
end;

if ( (Pole[row,col] mod 10) = 9) and (status = 2) then
Mina(Canvas, x, y);
end;

// Показывает поле
Procedure ShowPole(Canvas : TCanvas; status : integer);
var
row,col : integer;
begin
for row := 1 to MR do
for col := 1 to MC do
Kletka(Canvas, row, col, status);
end;

// рекурсивная функция открывает текущую и все соседние
// клетки, в которых нет мин
Procedure Open( row, col : integer);
begin
if Pole[row,col] = 0 then
begin
Pole[row,col] := 100;
Kletka(Form1.Canvas, row,col, 1);
Open(row,col-1);
Open(row-1,col);
Open(row,col+1);
Open(row+1,col);
//примыкающие диагонально
Open(row-1,col-1);
Open(row-1,col+1);
Open(row+1,col-1);
Open(row+1,col+1);
end
else
if (Pole[row,col] < 100) and ( Pole[row,col] <> -3 ) then
begin
Pole[row,col] := Pole[row,col] + 100;
Kletka(Form1.Canvas, row, col, 1);
end;
end;

// новая игра - генерирует новое поле
procedure NewGame();

var
row,col : integer; // координаты клетки
n : integer; // количество поставленных мин
k : integer; // кол-во мин в соседних клетках
begin
// Очистим эл-ты массива, соответствующие клеткам
// игрового поля.
for row :=1 to MR do
for col :=1 to MC do
Pole[row,col] := 0;

// расставим мины
Randomize(); // инициализация ГСЧ
n := 0; // кол-во мин
repeat
row := Random(MR) + 1;
col := Random(MC) + 1;
if ( Pole[row,col] <> 9) then
begin
Pole[row,col] := 9;
n := n+1;
end;
until ( n = NM );

// для каждой клетки вычислим
// кол-во мин в соседних клетках
for row := 1 to MR do
for col := 1 to MC do
if ( Pole[row,col] <> 9 ) then
begin
k :=0 ;
if Pole[row-1,col-1] = 9 then k := k + 1;
if Pole[row-1,col] = 9 then k := k + 1;
if Pole[row-1,col+1] = 9 then k := k + 1;
if Pole[row,col-1] = 9 then k := k + 1;
if Pole[row,col+1] = 9 then k := k + 1;
if Pole[row+1,col-1] = 9 then k := k + 1;
if Pole[row+1,col] = 9 then k := k + 1;
if Pole[row+1,col+1] = 9 then k := k + 1;
Pole[row,col] := k;
end;
status := 0; // начало игры
nMin := 0; // нет обнаруженных мин
nFlag := 0; // нет флагов

// Рисует мину
Procedure Mina(Canvas : TCanvas; x, y : integer);
begin
with Canvas do
begin
Brush.Color := clGreen;
Pen.Color := clBlack;
Rectangle(x+16,y+26,x+24,y+30);
Rectangle(x+8,y+30,x+16,y+34);
Rectangle(x+24,y+30,x+32,y+34);
Pie(x+6,y+28,x+34,y+44,x+34,y+36,x+6,y+36);

MoveTo(x+12,y+32); LineTo(x+26,y+32);
MoveTo(x+8,y+36); LineTo(x+32,y+36);
MoveTo(x+20,y+22); LineTo(x+20,y+26);
MoveTo(x+8, y+30); LineTo(x+6,y+28);
MoveTo(x+32,y+30); LineTo(x+34,y+28);
end;
end;

// Рисует флаг
Procedure Flag( Canvas : TCanvas; x, y : integer);
var
p : array [0..3] of TPoint; // координаты флажка и нижней точки древка
m : array [0..4] of TPoint; // буква М
begin
// зададим координаты точек флажка
p[0].x:=x+4; p[0].y:=y+4;
p[1].x:=x+30; p[1].y:=y+12;
p[2].x:=x+4; p[2].y:=y+20;
p[3].x:=x+4; p[3].y:=y+36; // нижняя точка древка

m[0].x:=x+8; m[0].y:=y+14;
m[1].x:=x+8; m[1].y:=y+8;
m[2].x:=x+10; m[2].y:=y+10;
m[3].x:=x+12; m[3].y:=y+8;
m[4].x:=x+12; m[4].y:=y+14;

with Canvas do
begin
// установим цвет кисти и карандаша
Brush.Color := clRed;
Pen.Color := clRed;

// древко
Pen.Color := clBlack;
MoveTo(p[0].x, p[0].y);
LineTo(p[3].x, p[3].y);

// выбор из меню ? команды О программе
procedure TForm1.N4Click(Sender: TObject);
begin
AboutForm.Top := Trunc(Form1.Top + Form1.Height/2 - AboutForm.Height/2);
AboutForm.Left := Trunc(Form1.Left +Form1.Width/2 - AboutForm.Width/2);
AboutForm.ShowModal;
end;

procedure TForm1.Form1Create(Sender: TObject);
var
row,col : integer;
begin
// В неотображаемые эл-ты массива, которые соответствуют
// клеткам по границе игрового поля запишем число -3.
// Это значение используется функцией Open для завершения
// рекурсивного процесса открытия соседних пустых клеток.
for row :=0 to MR+1 do
for col :=0 to MC+1 do
Pole[row,col] := -3;

NewGame(); // "разбросать" мины
Form1.ClientHeight := H*MR + 1;
Form1.ClientWidth := W*MC + 1;
end;

// нажатие кнопки мыши на игровом поле
procedure TForm1.Form1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
row, col : integer;
begin
if status = 2 // игра завершена
then exit;

// преобразуем координаты мыши в индексы
// клетки поля
row := Trunc(y/H) + 1;
col := Trunc(x/W) + 1;

if Button = mbLeft then
begin
if Pole[row,col] = 9 then
begin // открыта клетка, в которой есть мина
Pole[row,col] := Pole[row,col] + 100;
status := 2; // игра закончена
ShowPole(Form1.Canvas, status);
end
else if Pole[row,col] < 9 then
Open(row,col);
end
else
if Button = mbRight then
if Pole[row,col] > 200 then
begin
// уберем флаг и закроем клетку
nFlag := nFlag - 1;
Pole[row,col] := Pole[row,col] - 200; // уберем флаг
x := (col-1)* W + 1;
y := (row-1)* H + 1;
Canvas.Brush.Color := clLtGray;
Canvas.Rectangle(x-1,y-1,x+W,y+H);
end
else
begin // поставить в клетку флаг
nFlag := nFlag + 1;
if Pole[row,col] = 9
then nMin := nMin + 1;
Pole[row,col] := Pole[row,col]+ 200; // поставили флаг
if (nMin = NM) and (nFlag = NM) then
begin
status := 2; // игра закончена
ShowPole(Form1.Canvas, status);
end
else Kletka(Form1.Canvas, row, col, status);
end;
end;

// Выбор меню Новая игра
procedure TForm1.N1Click(Sender: TObject);
begin
NewGame();
ShowPole(Form1.Canvas,status);
end;

// выбор из меню ? команды Справка
procedure TForm1.N3Click(Sender: TObject);

var
HelpFile : string; // файл справки
HelpTopic : string; // раздел справки
pwHelpFile : PWideChar; // файл справки (указатель на WideChar строку)
pwHelpTopic : PWideChar; // раздел (указатель на WideChar строку)
begin
HelpFile := 'saper.chm';
HelpTopic := 'saper_02.htm';

// выделить память для WideChar строк
GetMem(pwHelpFile, Length(HelpFile) * 2);
GetMem(pwHelpTopic, Length(HelpTopic)*2);

// преобразовать Ansi строку в WideString строку
pwHelpFile := StringToWideChar(HelpFile,pwHelpFile,MAX_PATH*2);
pwHelpTopic := StringToWideChar(HelpTopic,pwHelpTopic,32);

// вывести справочную информацию
Form1.Hhopen1.OpenHelp(pwHelpFile,pwHelpTopic);

procedure TForm1.Form1Paint(Sender: TObject);
begin
ShowPole(Form1.Canvas, status);
end;
end.

Знаете ли Вы, в чем ложность понятия "физический вакуум"?

Физический вакуум - понятие релятивистской квантовой физики, под ним там понимают низшее (основное) энергетическое состояние квантованного поля, обладающее нулевыми импульсом, моментом импульса и другими квантовыми числами. Физическим вакуумом релятивистские теоретики называют полностью лишённое вещества пространство, заполненное неизмеряемым, а значит, лишь воображаемым полем. Такое состояние по мнению релятивистов не является абсолютной пустотой, но пространством, заполненным некими фантомными (виртуальными) частицами. Релятивистская квантовая теория поля утверждает, что, в согласии с принципом неопределённости Гейзенберга, в физическом вакууме постоянно рождаются и исчезают виртуальные, то есть кажущиеся (кому кажущиеся?), частицы: происходят так называемые нулевые колебания полей. Виртуальные частицы физического вакуума, а следовательно, он сам, по определению не имеют системы отсчета, так как в противном случае нарушался бы принцип относительности Эйнштейна, на котором основывается теория относительности (то есть стала бы возможной абсолютная система измерения с отсчетом от частиц физического вакуума, что в свою очередь однозначно опровергло бы принцип относительности, на котором постороена СТО). Таким образом, физический вакуум и его частицы не есть элементы физического мира, но лишь элементы теории относительности, которые существуют не в реальном мире, но лишь в релятивистских формулах, нарушая при этом принцип причинности (возникают и исчезают беспричинно), принцип объективности (виртуальные частицы можно считать в зависимсоти от желания теоретика либо существующими, либо не существующими), принцип фактической измеримости (не наблюдаемы, не имеют своей ИСО).

Когда тот или иной физик использует понятие "физический вакуум", он либо не понимает абсурдности этого термина, либо лукавит, являясь скрытым или явным приверженцем релятивистской идеологии.

Понять абсурдность этого понятия легче всего обратившись к истокам его возникновения. Рождено оно было Полем Дираком в 1930-х, когда стало ясно, что отрицание эфира в чистом виде, как это делал великий математик, но посредственный физик Анри Пуанкаре, уже нельзя. Слишком много фактов противоречит этому.

Для защиты релятивизма Поль Дирак ввел афизическое и алогичное понятие отрицательной энергии, а затем и существование "моря" двух компенсирующих друг друга энергий в вакууме - положительной и отрицательной, а также "моря" компенсирующих друг друга частиц - виртуальных (то есть кажущихся) электронов и позитронов в вакууме.

Однако такая постановка является внутренне противоречивой (виртуальные частицы ненаблюдаемы и их по произволу можно считать в одном случае отсутствующими, а в другом - присутствующими) и противоречащей релятивизму (то есть отрицанию эфира, так как при наличии таких частиц в вакууме релятивизм уже просто невозможен). Подробнее читайте в FAQ по эфирной физике.