Быстрая компьютерная графика

1

Бесплатное издание

Все права защищены. Никакая часть этой книги не может
быть воспроизведена в любой форме без письменного разрешения правообладателей.
Автор книги не несёт ответственности за возможный вред
от использования информации, составляющей содержание
книги и приложений.

Copyright 2023 Валерий Рубанцев
Лилия Рубанцева
2

От автора
В книге Компьютерная графика на занимательных примерах вы познакомились
с замечательным модулем GraphWPF, который помогает крутить и вертеть круги,
эллипсы и спирали – всё, что творческой душе угодно.

И даже компьютерные игры с этим модулем можно писать. Но только статические, в которых нет подвижных объектов, потому что из-за них необходимо перерисовывать всю сцену целиком. На не шибко быстрых компьютерах так быстро,
как нужно, не получится.

3

В этой книге вы продолжите знакомство с компьютерной графикой, но уже с модулем WPFObjects. Его вы также получаете бесплатно и сразу с установщиком
среды разработки PascalABC.NET. С ним вы легко и просто сможете создавать любые игровые объекты и перемещать их по окну программы мышкой в любую сторону. Эти объекты сами перерисовываются, поэтому не затирают фон. Понятно,
что скорость работы программ с объектами достаточно высокая, чтобы писать динамические и динамичные игры.
Игровые объекты могут двигаться самостоятельно и даже анимировано. Они
умеют распознавать столкновения с мышкой и другими игровыми объектами, которых может быть до нескольких сотен!
С модулем WPFObjects программирование компьютерных игр становится простым и приятным занятием. В конце книги вы найдёте несколько примеров игровых программ, которые показывают только самые основы программирования
компьютерных игр, но они послужат нам началом к программированию более
сложных и интересных игр.
В подготовке книги принимали участие:
• Искусственный интеллект в виде нейронных сетей, который в меру сил и
возможностей иллюстрировал пустоты в этой книге.
• Натуральный интеллект в виде нейронов автора текста, который в меру сил
и возможностей создавал пустоты для работы искусственного интеллекта.

Валерий Рубанцев

4

Условные обозначения, принятые в книге:
Дополнение

Указание

Замечание

Исходный код:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

Задание для самостоятельного решения
Заголовок проекта:

Диагональный круг WPF
Исходные коды всех проектов находятся в папке _Projects

5

Оглавление
Быстрая компьютерная графика ................................... 1
От автора ............................................................... 3
Оглавление ............................................................. 6
Отрезки прямых ........................................................ 9
Случайные отрезки WPFO ....................................................................................... 9

Прямоугольники и квадраты ........................................ 20
Случайные прямоугольники WPFO.................................................................... 20
Прямоугольные декораторы WPFO ................................................................... 25
Квадратные объекты................................................................................................ 40
Квадратные объекты WPFO .................................................................................. 40
Мигающие квадраты WPFO .................................................................................. 43
Прямоугольники со скруглёнными углами WPFO ....................................... 47
Квадраты со скруглёнными углами WPFO ...................................................... 53
Прозрачные квадроугольники WPFO ................................................................ 56
Стакан WPFO .............................................................................................................. 59

Эллипсы и круги ..................................................... 63
Эллиптические объекты WPFO........................................................................... 64
Круговые объекты WPFO ....................................................................................... 68
Мигающие точки WPFO ......................................................................................... 72
Пульсирующие точки WPFO ................................................................................ 75
Одинокий пульсар WPFO ...................................................................................... 79
Жёлтая подводная лодка WPFO .......................................................................... 82

Правильные многоугольники ........................................ 88
Правильные многоугольники WPFO ................................................................. 89
Правильные многоугольники 2 WPFO ............................................................. 95
Правильные многоугольники 3 WPFO ............................................................. 97
6

Правильные многоугольники 4 WPFO ............................................................. 99

Звёзды ............................................................... 102
Звёзды WPFO........................................................................................................... 103

Произвольные многоугольники ................................... 110
Случайные многоугольники WPFO ................................................................... 111

Картинки ............................................................. 117
Картинки WPFO........................................................................................................118

Текст ................................................................. 124
Текст WPFO .............................................................................................................. 125
Текст 2 WPFO .......................................................................................................... 128

Анимация объектов ................................................. 135
Анимация объектов WPFO .................................................................................. 137
Анимация объектов 2 WPFO ...............................................................................141

Общие свойства и методы объектов .............................. 145
Вверх-вниз WPFO ................................................................................................... 153
События мышки ...................................................................................................... 156
События мышки WPFO ......................................................................................... 156
События клавиатуры ............................................................................................. 158
События клавиатуры WPFO ................................................................................ 159
Другие события ...................................................................................................... 160
Другие события WPFO ......................................................................................... 160
Кто под мышкой WPFO ........................................................................................ 162
Скалирование WPFO ..............................................................................................171
Анимированный Марио WPFO ........................................................................... 176
Пульсирующие точки 2 WPFO .......................................................................... 180

7

Занятные приложения знаний и усилий .......................... 182
Картинный фон WPFO .......................................................................................... 182
Пузыри ...................................................................................................................... 184
Движение объекта к цели WPFO ..................................................................... 205
Все в сборе WPFO ................................................................................................. 209
Все в сборе 2 WPFO ............................................................................................... 213
Свободное падение WPFO ................................................................................... 216
Куда подальше WPFO .......................................................................................... 222
Метание Квадратика WPFO ................................................................................ 226
Тянем-потянем WPFO .......................................................................................... 231
Тянем-потянем 2 WPFO ...................................................................................... 236
Круговые столкновения WPFO ......................................................................... 240
Квадратные столкновения WPFO ..................................................................... 248
Квадратно-круговые столкновения WPFO..................................................... 253
Лабиринт WPFO ..................................................................................................... 255
Лабиринт 2 WPFO ................................................................................................. 272
Стек WPFO ............................................................................................................... 276
Числавряд WPFO ................................................................................................... 289
Попорядку WPFO .................................................................................................. 298
Попамяти WPFO ................................................................................................... 305
Ещёстрашнее WPFO ............................................................................................... 316

Литература .......................................................... 320

8

Отрезки прямых
Все классы, создающие графические объекты, сосредоточены в модуле
WPFObjects, который нужно сразу добавить в начало каждого файла:
uses WPFObjects;

Представлять пиксели объектами плохая затея, поэтому сразу переходим к отрезкам прямых.
Конструкторы класса LineWPF создают отрезки прямых:
constructor(x1, y1, x2, y2: real; с: GColor);

constructor(p1, p2, r: Point; с: GColor);
x1, y1 или р1 – координаты начала отрезка
x2, y2 или р2 – координаты конца отрезка
c – цвет отрезка

Случайные отрезки WPFO
Все отрезки хороши, но по умолчанию они очень тонкие – всего 1 пиксель (Рис.
1):
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

9

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Случайные отрезки WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Create;
begin
loop 20 do begin
// координаты отрезка:
var x1 := Random(20, GW_WIDTH);
var y1 := Random(20, GW_HEIGHT);
var x2 := Random(20, GW_WIDTH);
var y2 := Random(20, GW_HEIGHT);
// случайный цвет:
var clr := RandomColor;
// создаём отрезок:
new LineWPF(x1,y1,x2,y2,clr);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
Create;
Window.Title += m;
end.

Но у объектов класса LineWPF есть несколько полезных свойств.
Свойство Color изменяет или возвращает текущий цвет отрезка:
property Color ↔ GColor;

10

Рис. 1. Худосочные отрезки

А вот и свойство LineWidth, которое изменяет или возвращает текущую толщину
отрезка:
11

property LineWidth ↔ real;
Эти свойства помогут нам написать новую процедуру Create2.
Здесь мы восьмикратно утолщаем все отрезки, а затем в бесконечном цикле while
перекрашиваем все отрезки в случайные цвета (Рис. 2):
procedure Create2;
begin
var listL := new List<LineWPF>();
loop 20 do begin
// координаты отрезка:
var x1 := Random(20, GW_WIDTH);
var y1 := Random(20, GW_HEIGHT);
var x2 := Random(20, GW_WIDTH);
var y2 := Random(20, GW_HEIGHT);
// случайный цвет:
var clr := RandomColor;
// создаём отрезок:
var l := new LineWPF(x1,y1,x2,y2,clr);
//l.LineWidth := 8;
l.SetLineWidth(8);
listL.Add(l);
end;
Sleep(1000);
while true do
foreach var l in listL do begin
l.Color := RandomColor;
Sleep(100);
end;
end;
begin
Prepare;
var m := MillisecondsDelta;
//Create;
Create2;
Window.Title += m;
end.

12

Рис. 2. Утолстились

Вместо свойства LineWidth вы можете использовать функцию SetLineWidth:

13

function SetLineWidth(lw : real): LineWPF;
Свойства Width и Height изменяют и возвращают текущую ширину и высоту отрезка:
property Width ↔ real;
property Height ↔ real;
Под шириной и высотой отрезка понимают размеры прямоугольника, в котором
отрезок служит диагональю.
Но изменить размеры отрезка таким способом не удаётся.
Свойства X1, X2, Y1, Y2, P1, P2 изменяют или возвращают текущие координаты
концов отрезка:
property X1 ↔ real;
property X2 ↔ real;
property Y1 ↔ real;
property Y2 ↔ real;
property P1 ↔ Point;
property P2 ↔ Point;

14

С помощью этих свойств мы можем изменять положение отрезков на экране:
procedure Create3;
begin
var listL := new List<LineWPF>();
loop 20 do begin
// координаты отрезка:
var x1 := Random(20, GW_WIDTH);
var y1 := Random(20, GW_HEIGHT);
var x2 := Random(20, GW_WIDTH);
var y2 := Random(20, GW_HEIGHT);
// случайный цвет:
var clr := RandomColor;
// создаём отрезок:
var l := new LineWPF(x1,y1,x2,y2,clr);
l.LineWidth := 8;
listL.Add(l);
end;
Sleep(1000);
while true do
foreach var l in listL do begin
//
l.Width := Random(8, 20);
//
l.Height := Random(80, 200);
//
Println(l.Width, l.Height);
// координаты отрезка:
var x1 := Random(20, GW_WIDTH);
var y1 := Random(20, GW_HEIGHT);
var x2 := Random(20, GW_WIDTH);
var y2 := Random(20, GW_HEIGHT);
l.X1 := x1;
l.X2 := x2;
l.Y1 := y1;
l.Y2 := y2;
Sleep(200);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
15

//Create2;
Create3;
Window.Title += m;
end.

Метод SetRotate поворачивает отрезок на заданный угол da вокруг его центра:
function SetRotate(da : real): RectangleWPF;
Угол измеряется в градусах. Положительный значения угла поворачивают прямоугольник по часовой стрелке, отрицательные – в противоположном направлении:
procedure Animation;
begin
// создаём отрезок -->
// координаты отрезка:
var x1 := 120;
var y1 := 120;
var x2 := GW_WIDTH - 120;
var y2 := GW_HEIGHT - 120;
// цвет:
var clr := Colors.Red;
// создаём отрезок:
var l := new LineWPF(x1,y1,x2,y2, clr);
// толщина:
l.LineWidth := 25;
// угол поворота:
var da := 0.125;
while true do begin
l.SetRotate(da);
Sleep(5);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
16

//Create2;
//Create3;
//Create4;
Animation;
Window.Title += m;
end.

Методы SetText добавляют к отрезку заданную строку:
function SetText(txt : string; size : real;
fontname: string; с: GColor): LineWPF;

function SetText(txt : string; size : real := 16;
fontname: string := 'Arial'): LineWPF;
txt – заданная строка
size – размер шрифта
fontname – название шрифта
с – цвет шрифта
Второй метод имеет параметры по умолчанию, а текст всегда окрашивается в чёрный цвет.
В процедуре Create4 мы создаём отрезок и добавляем к нему надпись:
procedure Create4;
begin
// создаём отрезок -->
// координаты отрезка:
var x1 := 20;
var y1 := 20;
var x2 := GW_WIDTH - 20;
var y2 := GW_HEIGHT - 20;
// цвет:
var clr := Colors.Red;
// создаём отрезок:
17

var l := new LineWPF(x1,y1,x2,y2, clr);
// толщина:
l.LineWidth := 25;
// текст:
var txt := ' Отрезанный текст!';
l.SetText(txt, 32, 'Arial', Colors.DarkGreen);

Создаём прямоугольник по размерам отрезка:
new RectangleWPF(x1,y1,l.Width, l.Height, Colors.Transparent, 1,
Colors.Orange);
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
//Create2;
//Create3;
Create4;
Window.Title += m;
end.

На Рис. 3 хорошо видно, что текст вписывается в прямоугольник, в котором
диагональю служит заданный отрезок.

18

Рис. 3. Как вписанный

19

Прямоугольники и квадраты
Класс RectangleWPF
прямоугольников.

имеет

несколько

конструкторов

для

создания

Верхний левый угол прямоугольника задаётся координатами x и y, а ширина и
высота определяются параметрами w и h. Также в конструктор нужно передать
цвет заливки прямоугольника c.
Первый конструктор создаёт закрашенный прямоугольник без контура:
constructor(x, y, w, h: real; с: GColor);

Случайные прямоугольники WPFO
Используем первый конструктор, чтобы создать десяток разноцветных прямоугольных объектов (Рис. 1):
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Случайные прямоугольники WPFO ';
Window.Clear(Colors.SeaShell);
end;

20

procedure Create;
begin
loop 10 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет:
var clr := RandomColor;
// создаём прямоугольник:
new RectangleWPF(x,y,w,h,clr);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
Create;
Window.Title += m;
end.

Второй конструктор создаёт закрашенный прямоугольник с контуром (Рис. 2):
constructor(x, y, w, h: real; с: GColor;
borderWidth: real; borderColor: GColor);
borderWidth – толщина/ширина контура
borderColor – цвет контура
procedure Create2;
begin
loop 10 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
21

// размеры:
var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет заливки:
var clr1 := RandomColor;
// случайный цвет контура:
var clr2 := RandomColor;
// случайная толщина контура:
var t := Random(2,7);
// создаём прямоугольник:
new RectangleWPF(x,y,w,h,clr1, t, clr2);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
Create2;
Window.Title += m;
end.

Третий конструктор создаёт закрашенный прямоугольник с чёрным контуром:
constructor(x, y, w, h: real; с: GColor;
borderWidth: real);
Этот конструктор создаёт такой же объект, как предыдущий, но контур всегда чёрного цвета.
Четвёртый конструктор создаёт закрашенный прямоугольник без контура:
constructor(p: Point; w, h: real; с: GColor);
Этот конструктор создаёт такой же объект, как первый конструктор, но координаты верхнего левого угла прямоугольника задаются типом Point.
22

Рис. 1. Цветные прямоугольники
23

Рис. 2. Оконтуренные прямоугольники

24

Пятый конструктор создаёт закрашенный прямоугольник с контуром:
constructor(p: Point; w, h: real; с: GColor;
borderWidth: real; borderColor: GColor);
Этот конструктор создаёт такой же объект, как второй конструктор, но координаты верхнего левого угла прямоугольника задаются типом Point.
Шестой конструктор создаёт закрашенный прямоугольник с чёрным контуром:
constructor(p: Point; w, h: real; с: GColor;
borderWidth: real);
Этот конструктор создаёт такой же объект, как третий конструктор, но координаты
верхнего левого угла прямоугольника задаются типом Point.
Чтобы добавить или изменить контур прямоугольного объекта нужно вызвать его
метод SetBorder:
function SetBorder(w : real := 1;
с: GColor := Colors.Black): RectangleWPF;
По умолчанию толщина контура равна1 пикселю, а цвет – чёрный.

Прямоугольные декораторы WPFO
В процедуре Create создаём 10 прямоугольников без контура. Первая пятёрка
прямоугольников так и остаётся без контура, а вторая получает контур по умолчанию:
uses WPFObjects;
25

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Прямоугольные декораторы WPFO ';
Window.Clear(Colors.SeaShell);
end;
procedure Create;
begin
for var i := 0 to 9 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет:
var clr := RandomColor;
// создаём прямоугольник без контура:
var r := new RectangleWPF(x,y,w,h,clr);
if i > 4 then
r.SetBorder;
end;
end;
begin
Prepare;
var m := MillisecondsDelta;
Create;
Window.Title += m;
end.

На Рис. 1 хорошо видно, что вторая половина прямоугольников оконтурена.
26

Рис. 1. С контуром и без

27

Толщину и цвет контура мы можем задавать самостоятельно (Рис. 2):
procedure Create;
begin
for var i := 0 to 9 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет:
var clr := RandomColor;
// создаём прямоугольник без контура:
var r := new RectangleWPF(x,y,w,h,clr);
// случайная толщина контура:
var t := Random(2,7);
// случайный цвет контура:
clr := RandomColor;
if i > 4 then
r.SetBorder(t, clr);
end;
end;

Метод RemoveBorder удаляет контур:
function RemoveBorder : RectangleWPF;
В процедуре Create2 мы последовательно создаём десяток прямоугольных объектов, добавляем к ним контур (Рис. 3), а через 2 секунды удаляем его (Рис. 4):
procedure Create2;
begin
loop 10 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
28

var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет:
var clr := RandomColor;
// создаём прямоугольник без контура:
var r := new RectangleWPF(x,y,w,h,clr);
// случайная толщина контура:
var t := Random(2,7);
// случайный цвет контура:
clr := RandomColor;
r.SetBorder(t, clr);
Sleep(2000);
r.RemoveBorder;
Sleep(1000);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
Create2;
Window.Title += m;
end.

Итак, мы в любое время можем добавить к прямоугольному объекту контур, а затем удалить его, вновь добавить, и так далее (Рис. 6).
Метод SetRotate поворачивает прямоугольный объект на заданный угол da вокруг
своего центра:
function SetRotate(da : real): RectangleWPF;
Угол измеряется в градусах. Положительный значения угла поворачивают прямоугольник по часовой стрелке, отрицательные – в противоположном направлении
(Рис. 7):

29

procedure Create3;
begin
loop 10 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
var w := Random(GW_WIDTH - x);
var h := Random(GW_HEIGHT - y);
// случайный цвет:
var clr1 := RandomColor;
// случайная толщина контура:
var t := Random(2,7);
// случайный цвет контура:
var clr2 := RandomColor;
// создаём прямоугольник:
var r := new RectangleWPF(x,y,w,h, clr1, t, clr2);
Sleep(500);
// случайный поворот:
var da := Random(-180, 180);
r.SetRotate(da);
Sleep(500);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
//Create;
//Create2;
Create3;
Window.Title += m;
end.

Используя метод SetRotate, мы можем создать простейшую анимацию (Рис. 8):
procedure Animation;
begin
// создаём прямоугольник -->
30

// размеры:
var w := 420;
var h := 360;
// координаты вершины:
var x :=CX - w / 2;
var y := CY - h / 2;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// создаём прямоугольник:
var r := new RectangleWPF(x,y,w,h, clr1, t, clr2);
// угол поворота:
var da := 0.25;
while true do begin
r.SetRotate(da);
Sleep(10);
end;
end;
begin
Prepare;
//Create;
//Create2;
//Create3;
Animation;
end.

Метод SetText добавляет к прямоугольному объекту заданную строку:
function SetText(txt : string; size : real;
fontname: string; с: GColor): RectangleWPF;
txt – заданная строка
size – размер шрифта
fontname – название шрифта
с – цвет шрифта
31

Рис. 2. Всё в наших руках

32

Рис. 3. Добавили контур

33

Рис. 5. Удалили контур

34

Рис. 6. Управляемые контуры

35

Рис. 7. Крутиугольники

36

Рис. 8. Оживлённое вращение

37

Строка располагается по центру прямоугольника (Рис. 9):
procedure Animation2;
begin
// создаём прямоугольник -->
// размеры:
var w := 420;
var h := 360;
// координаты вершины:
var x :=CX - w / 2;
var y := CY - h / 2;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// создаём прямоугольник:
var r := new RectangleWPF(x,y,w,h, clr1, t, clr2);
// угол поворота:
var da := 0.25;
// текст:
var txt := ' И всё-таки он вертится!';
r.SetText(txt, 32, 'Arial', Colors.Red);
while true do begin
r.SetRotate(da);
Sleep(10);
end;
end;

begin
Prepare;
//Create;
//Create2;
//Create3;
//Animation;
Animation2;
end.

38

Рис. 9. В центре внимания

39

Перегрузка метода SetText упрощает добавление надписи:
function SetText(txt : string; size : real := 16;
fontname: string := 'Arial'): RectangleWPF;
Шрифт по умолчанию Arial высотой 16 пунктов. Цвет шрифта всегда чёрный.

Квадратные объекты
Класс SquareWPF имеет такие же конструкторы, как и класс RectangleWPF, но для
создания квадратов. То же самое относится и к методам. Единственное отличие
квадратов от прямоугольников в том, что у них одинаковая ширина и высота,
поэтому в конструкторах и в методах отстутствует параметр h.

Квадратные объекты WPFO
В этом проекте мы заставим вращаться квадрат:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Квадратные объекты WPFO ';
40

Window.Clear(Colors.SeaShell);
end;

В процедуре Animation создаём квадрат. Других изменений по сравнению с
предыдущим проектом нет (Рис. 1):
procedure Animation;
begin
// создаём квадрат -->
// размер:
var w := 420;
// координаты вершины:
var x := CX - w / 2;
var y := x;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// создаём квадрат:
var r := new SquareWPF(x,y,w, clr1, t, clr2);
// угол поворота:
var da := 0.25;
// текст:
var txt := ' Квадратная круговерть!';
r.SetText(txt, 32, 'Arial', Colors.Red);
while true do begin
r.SetRotate(da);
Sleep(10);
end;
end;

begin
Prepare;
Animation;
end.

41

Рис. 1. Крутится-вертится

42

Мигающие квадраты WPFO
В этой программе мы создадим 23 квадрата. Все они имеют контур толщиной 16
пикселей. Цвет контуров чередуется: чёрный – белый – чёрный - …:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Мигающие квадраты WPFO ';
Window.Clear(Colors.SeaShell);
end;

В процедуре Animation помещаем все квадраты в список lstS, назначение которого прояснится позже:
procedure Animation;
begin
var lstS := new List<SquareWPF>();
// толщина контура:
var t := 16;
// размеры:
var w := 2*t;
// цвет заливки:
var clr1 := Colors.Transparent;
// цвет контура:
var clr2 := Colors.Black;
// создаём квадраты -->
43

for var i := 0 to 22 do begin
// координаты вершины:
var x := CX - w / 2;
var y := x;
// цвет контура:
clr2 := i mod 2 = 0 ? Colors.Black : Colors.White;
// создаём квадрат:
var rect := new SquareWPF (x,y,w, clr1, t, clr2);
lstS.Add(rect);
w += t*2;
end;
end;

begin
Prepare;
Animation;
end.

Все квадраты готовы. Запускаем программу и видим на экране квадратную зебру
(Рис. 1).
Добавляем в конец процедуры Animation мигалку для квадратов:
while true do begin
foreach var r in lstS do begin
if r.BorderColor = Colors.Black then
r.BorderColor := Colors.White
else r.BorderColor := Colors.Black;
Sleep(20);
end;
end;
end;

В книгах анимация пока недоступна, но наш код перекрашивает квадраты от центра к границам окна программы.

44

Рис. 1. Квадратная зебра

45

Пускаем волну в обратную сторону. Для этого изменяем порядок квадратов в
списке Reverse на противоположный, перекрашиваем квадраты от границ окна
программы к центру и возвращаем порядок квадратов в исходное положение:
while true do begin
foreach var r in lstS do begin
if r.BorderColor = Colors.Black then
r.BorderColor := Colors.White
else r.BorderColor := Colors.Black;
Sleep(20);
end;
lstS.Reverse;
foreach var r in lstS do begin
if r.BorderColor = Colors.Black then
r.BorderColor := Colors.White
else r.BorderColor := Colors.Black;
Sleep(20);
end;
lstS.Reverse;
end;
end;

Это надо видеть!
Класс RoundRectWPF создаёт прямоугольники со скруглёнными углами, поэтому
в конструкторы добавляется ещё один параметр – радиус скругления r:
constructor(x, y, w, h, r: real; с: GColor);

constructor(x, y, w, h, r: real; с: GColor;
borderWidth: real; borderColor: GColor);

constructor(x, y, w, h, r: real; с: GColor;
borderWidth: real);
46

constructor(p: Point; w, h, r: real; с: GColor);

constructor(p: Point; w, h, r: real; с: GColor;
borderWidth: real; borderColor: GColor);
x, y – координаты левого верхнего угла прямоугольника
w, h – ширина и высота прямоугольника
r – радиус скругления углов
c – цвет заливки прямоугольника
borderWidth – толщина/ширина контура
borderColor – цвет контура
Методы SetBorder, RemoveBorder, SetText и SetRotate действуют так же, как у
обычных прямоугольников. Но прямоугольники со скруглёнными углами имеют
дополнительное свойство RoundRadius, которое устанавливает или возвращает
радиус скругления:
property RoundRadius ↔ real;

Прямоугольники со скруглёнными углами WPFO
В этом проекте мы завращаем скруглённоугольник (Рис. 1):
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
47

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Прямоугольники со скруглёнными углами WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Animation;
begin
// создаём прямоугольник -->
// размеры:
var w := 500;
var h := 360;
// координаты вершины:
var x := CX - w / 2;
var y := CY - h / 2;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// радиус скругления:
var r := 32;
// создаём прямоугольник:
var rect := new RoundRectWPF (x,y,w,h,r, clr1, t, clr2);
// угол поворота:
var da := 0.25;
// текст:
var txt := ' И всё-таки он закруглился! ';
rect.SetText(txt, 32, 'Arial', Colors.Red);
while true do begin
rect.SetRotate(da);
Sleep(10);
end;
end;

48

begin
Prepare;
Animation;
end.

Добавляем в бесконечный цикл увеличение радиуса скругления:
while true do begin
rect.SetRotate(da);
Sleep(10);
rect.RoundRadius += 1;
end;

И прямоугольник превращается в аккуратный эллипс (Рис. 2).
Класс RoundSquareWPF создаёт квадраты со скруглёнными углами, поэтому в конструкторе отсутствует параметр h – высота квадрата:
constructor(x, y, w, r: real; с: GColor);

constructor(x, y, w, r: real; с: GColor;
borderWidth: real; borderColor: GColor);

constructor(x, y, w, r: real; с: GColor;
borderWidth: real);

constructor(p: Point; w, r: real; с: GColor);

constructor(p: Point; w, r: real; с: GColor;
borderWidth: real; borderColor: GColor);

49

x, y – координаты левого верхнего угла квадрата
w – ширина и высота квадрата
r – радиус скругления углов
c – цвет заливки квадрата
borderWidth – толщина/ширина контура
borderColor – цвет контура
Методы SetBorder, RemoveBorder, SetText и SetRotate действуют так же, как у
обычных прямоугольников.

50

Рис. 1. Не остро, но и не тупо

51

Рис. 2. Овальный родственник

52

Квадраты со скруглёнными углами WPFO
Создаём и крутим квадраты со скруглёнными углами (Рис. 1):
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Квадраты со скруглёнными углами WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Animation;
begin
// создаём квадрат -->
// размеры:
var w := 500;
// координаты вершины:
var x := CX - w / 2;
var y := x;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// радиус скругления:
var r := 32;
// создаём квадрат:
53

var rect := new RoundSquareWPF (x,y,w,r, clr1, t, clr2);
// угол поворота:
var da := 0.25;
// текст:
var txt := ' И всё-таки он закруглился! ';
rect.SetText(txt, 32, 'Arial', Colors.Red);
while true do begin
rect.SetRotate(da);
Sleep(10);
end;
end;

begin
Prepare;
Animation;
end.

54

Рис. 1. Круговорот квадрата

55

Прозрачные квадроугольники WPFO
Иногда нужны незакрашенные прямоугольники, квадраты и другие плоские фигуры, которые имеют только контур. Для этого следует задать прозрачный цвет
для заливки – и от прямоугольника останется только контур без нутра:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Прозрачные квадроугольники WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Create;
begin
// прозрачный цвет заливки:
var clr1 := Colors.Transparent;
loop 20 do begin
// координаты вершины:
var x := Random(20, GW_WIDTH/2);
var y := Random(20, GW_HEIGHT/2);
// размеры:
var w := Random(GW_WIDTH/2);
var h := Random(GW_HEIGHT/2);
// случайный цвет контура:
var clr2 := RandomColor;
// случайная толщина контура:
var t := Random(2,10);
// радиус скругления:
var r := Random(20, 40);
56

// создаём прямоугольник:
new RoundSquareWPF (x,y,w,r, clr1, t, clr2);
end;
end;

begin
Prepare;
var m := MillisecondsDelta;
Create;
Window.Title += m;
end.

На Рис. 1 хорошо видно, что
при большом радиусе скругления прямоугольники/квадраты превращаются в окружности.

57

Рис. 1. Кругопревращения квадратов

58

Стакан WPFO
Вот стакан пустой - он предмет простой. Так,
наверно, сказал бы наш любимый Винни об
этой картинке (Рис. 1).
Так как наш стакан – это просто белый прямоугольник, то создать его совсем просто:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 360;
GW_HEIGHT =720;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Стакан WPFO ';
Window.Clear(Colors.DarkBlue);
// создаём стакан:
new RectangleWPF(50, 20, GW_WIDTH - 100, GW_HEIGHT-40, Colors.White);
end;

begin
Prepare;
Draw;
end.

Переменная nap отвечает за наполнение стакана. Сначала она равна нулю, что
соответствует пустому стакану:
// НАПОЛНЯЕМ СТАКАН
procedure Draw;
59

begin
// наполнение:
var nap := 0;
var clr := Colors.DodgerBlue;
// координаты вершины:
var x := 50;
// ширина:
var w := GW_WIDTH - 100;
var rect := new RectangleWPF(x, GW_HEIGHT - 20, w, nap, clr);

В процедуре Draw соответственно наполненности стакана мы рисуем голубой
прямоугольник, призванный символизировать наполнение стакана живительной
влагой:
while true do begin
// прямоугольник:
rect.Top := GW_HEIGHT - 20 - nap;
rect.Height := nap+1;

В каждом цикле мы подливаем в стакан немного воды:
if nap < GW_HEIGHT - 40 then nap += 1

Этот ирригационный процесс продолжается до тех пор, пока стакан не наполнится до края. После этого – вода из стакана исчезнет, и компьютерная анимация
запустится с начала:
else begin
Sleep(1000);
nap := 0;
end;
Sleep(16);
end;
end;

Получилось наглядно и забавно (Рис. 2).
60

Попробуйте зациклить этот процесс, то есть после
наполнения стакана сливайте воду, а затем снова набирайте её. Это будет ещё забавнее!

Рис. 1. Устаканилось
61

Рис. 2. Приливы и отливы в стакане

62

Эллипсы и круги
Класс EllipseWPF имеет несколько конструкторов для создания эллипсов.
Эллипсы принципиально отличаются от прямоугольников только тем, что у них
нет углов, поэтому положение эллипса на канве задаётся координатами центра,
а вместо ширины и высоты размеры эллипса определяются радиусами. Поэтому
конструкторы эллипсов мало чем отличаются от конструкторов прямоугольников.
constructor(x, y, rx, ry: real; с: GColor);

constructor(x, y, rx, ry: real; с: GColor;
borderWidth: real; borderColor: GColor);

constructor(x, y, rx, ry: real; с: GColor;
borderWidth: real);

constructor(p: Point; rx, ry: real; с: GColor);

constructor(p: Point; rx, ry: real; с: GColor;
borderWidth: real; borderColor: GColor);
x, y – координаты центра эллипса
rx, ry – размеры эллипса. Ширина и высота эллипса вдвое больше!
c – цвет заливки эллипса
borderWidth – толщина/ширина контура
borderColor – цвет контура
Методы SetBorder, RemoveBorder, SetText и SetRotate действуют так же, как для
других объектов.
63

Эллиптические объекты WPFO
Переделываем прямоугольный проект в эллиптический:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Эллиптические объекты WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Animation;
begin
// создаём эллипс -->
// размеры:
var rx := 640 / 2;
var ry := 480 / 2;
// координаты центра:
var x := CX;
var y := CY;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// создаём эллипс:
var r := new EllipseWPF(x,y, rx, ry, clr1, t, clr2);
64

// угол поворота:
var da := 0.25;
// текст:
var txt := ' Эллипсная круговерть!';
r.SetText(txt, 32, 'Arial', Colors.Red);
while true do begin
r.SetRotate(da);
Sleep(10);
end;
end;
begin
Prepare;
Animation;
end.

Эллипс красиво вращается вокруг своего центра (Рис. 1).
Эллиптические объекты имеют 2 свойства, которые задают и возвращают радиусы эллипса:
property RadiusX ↔ real;

property RadiusY ↔ real;
Используем эти свойства, чтобы изменять ширину эллипса, а также надпись на
объекте (Рис. 2):
while true do begin
txt := $' RadiusX = {r.RadiusX} RadiusY = {r.RadiusY}';
r.SetText(txt, 32, 'Consolas', Colors.Red);
r.SetRotate(da);
Sleep(10);
r.RadiusX := Round(r.RadiusX, 2) + 0.01;
end;
end;

65

Рис. 1. Эллиптическая орбита

66

Рис. 2. Изменчивый эллипс

67

Попытка изменить значение RadiusY приводит к неожиданным результатам: эллипс резко и значительно опускается.

Круги отличаются от эллипсов тем, что у них оба радиуса одинаковы.
Класс CircleWPF имеет несколько конструкторов для создания кругов, которые
отличаются только числом параметров.
Методы SetBorder, RemoveBorder, SetText и SetRotate действуют так же, как для
других объектов.
Круги имеют 3 свойства.
Свойство Radius задаёт или возвращает радиус круга:
property Radius ↔ real;
Свойства Width и Height задают или возвращают ширину и высоту круга, которые
вдвое больше радиуса круга (то есть это диаметры):
property Width ↔ real;
property Height ↔ real;

Круговые объекты WPFO
В новом проекте мы крутим круги (Рис. 1):
uses WPFObjects;
68

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Круговые объекты WPFO ';
Window.Clear(Colors.SeaShell);
end;

procedure Animation;
begin
// создаём круг -->
// размер:
var r := 480 / 2;
// координаты центра:
var x := CX;
var y := CY;
// цвет заливки:
var clr1 := Colors.Yellow;
// цвет контура:
var clr2 := Colors.Red;
// толщина контура:
var t := 5;
// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
// угол поворота:
var da := 0.25;
// текст:
//
var txt := ' Круговерть!';
//
circle.SetText(txt, 48, 'Arial', Colors.Red);
while true do begin
var txt := $' Width = {circle.Width} Height = {circle.Height}';
circle.SetText(txt, 30, 'Arial', Colors.Red);
69

circle.SetRotate(da);
Sleep(10);
circle.Radius := Round(circle.Radius, 2) + 0.1;
//circle.Width := Round(circle.Width, 2) + 0.1;
end;
end;

begin
Prepare;
Animation;
end.

70

Рис. 1. Настоящая круговерть

71

Мигающие точки WPFO
Вы уже умеете создавать отдельные круги, а в этом проекте мы наделаем много
кругов, которые назовём точками, и аккуратно расставим их на экране стройными
рядами и колоннами. Все точки будут одного размера:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// диаметр точки:
D = 40;

Во вложенных циклах размещаем точки слева направо и сверху вниз:
procedure Animation;
begin
// список для хранения точек:
var lstP := new List<CircleWPF>();
// создаём точки -->
for var row := 0 to GW_HEIGHT div D - 1 do
for var col := 0 to GW_WIDTH div D - 1 do begin
// координаты центра:
var xc := D * col + D div 2;
var yc := D * row + D div 2;

Цвет точки выбираем случайно, а точки отправляем на хранение в список lstP:
// цвет очередной точки:
var clr := RandomColor;
var circle := new CircleWPF(xc,yc, D div 2, clr);
// добавляем точку к списку:
72

lstP.Add(circle);
end;

Теперь мы можем делать с точками всё что угодно, например, изменять их цвет:
while true do begin
foreach var p in lstP do begin
// меняем цвет точки:
var clr := RandomColor;
p.Color := clRandom;
end;
Sleep(10);
end;
end;

В главном блоке программы вызываем процедуры Prepare и Animation:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Мигающие точки WPFO ';
Window.Clear(Colors.Black);
end;
begin
Prepare;
Animation;
end.

На картинке этого не покажешь, но
точки мигают весьма завлекательно (Рис. 1).

73

Рис. 1. Подмигивающие точки

74

Пульсирующие точки WPFO
Давайте усовершенствуем нашу «точечную» программу так, чтобы точки не
только изменяли цвет, но и пульсировали, то есть попеременно расширялись и
сжимались.
Текущий диаметр точки мы сохраним в переменной d, а максимальный – в константе D_MAX. Также нам понадобится переменная dd для хранения величины
изменения диаметра точки. Если она положительная, то точки расширяются, а
если отрицательная – сжимаются:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// макс. диаметр точки:
D_MAX = 60;
var
// диаметр точки:
d := 10;
// в-на изменения диаметра:
dd := 3;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Пульсирующие точки 2 WPFO ';
Window.Clear(Colors.Black);
end;

procedure Create;
begin
75

// создаём точки -->
for var row := 0 to GW_HEIGHT div D_MAX - 1 do
for var col := 0 to GW_WIDTH div D_MAX - 1 do begin
// координаты центра:
var xc := D_MAX * col + D_MAX div 2;
var yc := D_MAX * row + D_MAX div 2;
// цвет очередной точки:
var clr := RandomColor;
var circle : ObjectWPF := new CircleWPF(xc,yc, d div 2,
clr);
end;
end;

procedure Animation;
begin
// меняем размер точки:
d += dd;
if d > D_MAX then dd := -3
else if d < 2 then dd := 3;
for var i := 0 to Objects.Count-1 do begin
var p := CircleWPF(Objects[i]);
p.Radius := d / 2;
end;
end;

begin
Prepare;
Redraw(Create);
//Create;
var k := 1;
while True do
begin
Redraw(Animation);
k += 1;
Window.Title := Format('{0,5:f2}',k/Milliseconds*1000)+
' кадров в секунду';
//Sleep(33);
end;
end.

76

В конце каждого цикла мы изменяем текущий диаметр точек на величину dd:
// меняем размер точки:
d += dd;

И тут же проверяем их размеры. Если текущий диаметр больше максимального,
то точки в следующих циклах сжимаются:
if d > D_MAX then dd := -3

Если же они уже хорошенько сжались, то в следующих циклах расширяются:
else if d < 2 then dd := 3;

Циклы сжатия и расширения точек
продолжаются до тех пор, пока вы не
закроете программу.
На снимке с экрана этот процесс показать невозможно, поэтому посмотрите, как выглядят точки в промежуточном состоянии (Рис. 1).

77

Рис. 1. Пульс нормальный

78

Одинокий пульсар WPFO
Пульсары – это удивительные космические объекты, излучение
которых изменяется со временем, «пульсирует». Наша программа моделирует, скорее, не пульсары, а другие – не менее
замечательные! – космические объекты – переменные звёзды,
которые периодически изменяют свои размеры.
Звезду мы заменим цветным кругом, который то уменьшается, то увеличивается
в размерах. Когда круг уменьшится до размеров точки, он перекрасится в случайный цвет:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// макс. диаметр пульсара:
D_MAX = GW_HEIGHT - 10;
var
// диаметр пульсара:
d := 10;
// в-на изменения диаметра:
dd := 3;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Одинокий пульсар WPFO ';
Window.Clear(Colors.Black);
end;

procedure Animation;
79

begin
// создаём пульсар -->
// координаты центра:
var xc := CX;
var yc := CY;
// цвет:
var clr := RandomColor;
var circle := new CircleWPF(xc,yc, d div 2, clr);
while true do begin
// меняем диаметр пульсара:
d += dd;
if d > D_MAX then dd := -3
else if d < 2 then begin
dd := 3;
clr := RandomColor;
circle.Color := clr;
end;
circle.Radius := d / 2;
Sleep(10);
end;
end;

begin
Prepare;
Animation;
end.

А пульсирующая звезда получилась
нам на славу (Рис. 1)!

80

Рис. 1. Пульс есть

81

Жёлтая подводная лодка WPFO
Самая известная из всех подводных лодок та, про которую спели битлы (Рис. 1).

Рис. 1. Елловая сабмарина

Она была жёлтого цвета, и, как следует из песни, жить в ней было уютно и беззаботно.
Но у битлов подводная лодка появилась сама собой, а у нас всё-таки забота есть:
нам нужно её создать.
Но сначала мы по примеру стаканного проекта наполним наш океан водой. Но не
жёлтой и не оранжевой, а обыкновенной. Когда всё будет готово, в самой пучине
океана появится та самая йеллосабмарин, о которой так здорово поётся в песне.
У нас она будет, правда, не такая красивая, как на картинке, но вполне правдоподобная – эллиптическая.

82

Жить мы будем не внутри лодки, а снаружи и управлять её возвратно-поступательными движениями будем клавишами со стрелками.
Всё это несложно, но мы ходу движения подлодки должны приглядывать за ней,
чтобы она ненароком не покинула вверенную нам акваторию.
Если бы мы научили нашу героиню подводного труда обходить мины и стрелять
торпедами, то получилась бы самая настоящая компьютерная стрелялка. Но эта
задача пока слишком сложна для нас, поэтому будем лелеять мечту, а пока займёмся текущими делами.
Размеры лодки и её начальные координаты незыблемы и непоколебимы, поэтому мы сохраним их в константах:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =640;
// размеры лодки:
P_WIDTH = 80;
P_HEIGHT = 20;
// координаты лодки:
P_X = GW_WIDTH div 2;
P_Y = GW_HEIGHT-150;

Подготовительные и пусконаладочные мероприятия проводим в процедуре
Prepare:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Жёлтая подводная лодка WPFO ';
Window.Clear(Colors.White);

83

OnKeyDown := KeyDown;
end;

В главном блоке программы заполняем наш океан водой, после чего выпускаем
подводную лодку:
begin
Prepare;
CreateOcean;
CreatePodlodka;
end.

Процесс создания океана, несмотря на масштабы и объём работ, даже проще,
чем наполнение стакана:
// СОЗДАЁМ ОКЕАН
procedure CreateOcean;
begin
var clr := Colors.DodgerBlue;
// координаты вершины:
var x := 0;
// ширина:
var w := GW_WIDTH;
var rect := new RectangleWPF(x, 0, w, nap, clr);
while nap < GW_HEIGHT do begin
// прямоугольник:
rect.Top := GW_HEIGHT - nap;
rect.Height := nap+1;
nap += 1;
Sleep(5);
end;
end;

И тут на сцене появляется во всей красе наша жёлтая подводная лодка:
// СОЗДАЁМ ПОДВОДНУЮ ЛОДКУ
procedure CreatePodlodka;
84

begin
var clrF := Colors.Yellow;
var clrB := Colors.Blue;
var bw := 1;
podlodka := new EllipseWPF(P_X, P_Y, P_WIDTH, P_HEIGHT,
clrF, bw, clrB);
end;

Её даже можно увидеть, если поглубже засунуть голову в воду (Рис. 2).
С управлением мы легко управляемся в процедуре KeyDown:
procedure KeyDown(k: Key);
begin
podlodka.Dx := 0;
podlodka.Dy := 0;
if k
else
else
else

= Key.UP then podlodka.Dy := -1
if k = Key.DOWN then podlodka.Dy := 1
if k = Key.LEFT then podlodka.Dx := -1
if k = Key.RIGHT then podlodka.Dx := 1;

// ограничиваем перемещения:
var x := podlodka.Center.X + podlodka.Dx;
var y := podlodka.Center.Y + podlodka.Dy;
if (x < podlodka.Width/2) or
(x > GW_WIDTH - podlodka.Width/2) or
(y < podlodka.Height/2) or
(y > GW_HEIGHT - podlodka.Height/2) then exit
else MovePodlodka;
end;

Крутите штурвал и педали, набирайте балласт, продувайте цистерны. Короче говоря, счастливого плавания (Рис. 3)!

85

Рис. 2. Реально жёлтая!

86

Рис. 3. Всплываем

87

Правильные многоугольники
Очень простой правильный многоугольник мы одолели – это квадрат. Самый простой правильный многоугольник – это треугольник, для которого нет отдельного
класса. Но универсальный класс RegularPolygonWPF может создавать любые правильные многоугольники.
Первый конструктор создаёт правильный закрашенный многоугольник без контура:
constructor(x, y, r: real; n: integer; с: GColor);
Второй конструктор создаёт правильный закрашенный многоугольник с контуром:
constructor(x, y, r: real; с: GColor;
borderWidth: real; borderColor: GColor);
Третий конструктор создаёт правильный закрашенный многоугольник с чёрным
контуром:
constructor(x, y, r: real; с: GColor;
borderWidth: real);
Следующая тройка конструкторов повторяет предыдущую тройку, но центр описанной окружности задаётся типом Point:
constructor(p: Point; r: real; n: integer; с: GColor);
constructor(p: Point; r: real; с: GColor;
borderWidth: real; borderColor: GColor);

88

constructor(p: Point; r: real; с: GColor;
borderWidth: real);
x, y, р – координаты центра многоугольника
r – радиус описанной окружности
n – число вершин
c – цвет заливки
borderWidth – толщина/ширина контура
borderColor – цвет контура
Свойства Width, Height, Radius – как у кругов.
Свойство Count устанавливает или возвращает текущее число вершин правильного многоугольника:
property Count ↔ integer;

Правильные многоугольники WPFO
Чтобы выбирать число углов/сторон многоугольника в запущенной программе,
установим на панели ползунок:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
var
// ползунок:
sl : SliderWPF;
89

// многоугольник:
poly : RegularPolygonWPF;

В процедуре Prepare создаём окно и ползунок:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH + 120, GW_HEIGHT);
Window.Title := ' Правильные многоугольники WPFO ';
Window.Clear(Colors.SeaShell);
LeftPanel(120, Colors.BurlyWood, 5);
sl := Slider('Число вершин:', 3, 20, 1);
// изменяем число вершин:
var p: procedure := () → begin
Create(sl.Value);
end;
sl.ValueChanged := p;
end;

В главном блоке сразу вызываем процедуру Create, которая создаёт правильный
треугольник:
begin
Prepare;
Create(3);
end.

Мы не можем просто стереть предыдущий многоугольник, поскольку это объект
– его следует уничтожить методом Destroy, но сначала мы должны убедиться, что
объект уже создан:
procedure Create(n: integer);
begin
// уничтожаем предыдущий объект:
if poly <> nil then
90

poly.Destroy;
// координаты центра:
var xc := CX;
var yc := CY;
// радиус:
var r := GW_WIDTH / 2 - 10;
// цвет заливки:
var clr := RandomColor;

Для создания многоугольника используем первый конструктор:
// создаём новый объект:
poly := new RegularPolygonWPF(xc, yc, r, n, clr);
end;

Забавно, но если вместо левой панели создать правую, то программа не
работает!
Запускаем программу – и лиловенький
треугольненький объектик предстаёт перед нами в лучшем виде (Рис. 1).
Перемещаем движок – и треугольник
превращается в знакомый нам квадрат,
повёрнутый ромбиком (Рис. 2).
И дальше по списку – пяти-, шести- и прочие многоугольники (Рис. 3).
Как вы видите, многоугольники не имеют
контура.

91

Рис. 1. Треугольные дела
92

Рис. 2. Повёрнутый квадрат
93

Рис. 3. Бесконтурный шестиугольник
94

Правильные многоугольники 2 WPFO
Добавляем в процедуру Create контур для правильного многоугольника:
procedure Create(n: integer);
begin
// уничтожаем предыдущий объект:
if poly <> nil then
poly.Destroy;
// координаты центра:
var xc := CX;
var yc := CY;
// радиус:
var r := GW_WIDTH / 2 - 10;
// цвет заливки:
var clrF := RandomColor;
// толщина контура:
var t := 7;
// цвет контура:
var clrB := RandomColor;
// создаём новый объект:
poly := new RegularPolygonWPF(xc,
yc, r, n, clrF,t, clrB);
end;

Оконтуренные правильные многоугольники
контурентноспособнее (Рис. 1).

95

Рис. 1. Пограничная полоса
96

Правильные многоугольники 3 WPFO
Свойство Count изменяет число вершин правильного многоугольника. Поэтому
мы можем создать единственный правильный многоугольник, а затем просто
изменять число его вершин:
procedure Create(n: integer);
begin
// создаём новый объект:
if poly = nil then begin
// координаты центра:
var xc := CX;
var yc := CY;
// радиус:
var r := GW_WIDTH / 2 - 10;
// цвет заливки:
var clrF := RandomColor;
// толщина контура:
var t := 7;
// цвет контура:
var clrB := RandomColor;
poly := new RegularPolygonWPF(xc, yc, r, n, clrF,t, clrB);
end
else poly.Count := n;
end;

Теперь нам достаточно одного многоугольника с
изменяемым числом вершин (Рис. 1).

97

Рис. 1. Универсальный объект
98

Правильные многоугольники 4 WPFO
Раз уж мы научились легко и просто изменять число вершин правильного
многоугольника, то почему бы нам не анимировать этот занимательный процесс?
Сказано – сделано:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
var
// многоугольник:
poly : RegularPolygonWPF;
var dn := 1;

procedure Create(n: integer);
begin
// координаты центра:
var xc := CX;
var yc := CY;
// радиус:
var r := GW_WIDTH / 2 - 10;
// цвет заливки:
var clrF := Colors.Yellow;
// толщина контура:
var t := 7;
// цвет контура:
var clrB := Colors.Red;
poly := new RegularPolygonWPF(xc, yc, r, n, clrF,t, clrB);
end;

procedure Animation;
begin
while true do begin
99

// меняем число вершин:
var n := poly.Count;
if n > 49 then dn := -1
else if n < 7 then begin
dn := 1;
Sleep(200);
end;
poly.Count += dn;
//Println(poly.Count);
Sleep(60);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Правильные многоугольники 4 WPFO ';
Window.Clear(Colors.SeaShell);
end;

begin
Prepare;
Create(6);
Animation;
end.

Без
ползунков
и
нашего
непосредственного участия программа
сама крутит и вертит очень правильные
многоугольники (Рис. 1).

100

Рис. 1. Многоугольная анимация

101

Звёзды
Звёзды – это почти правильные многоугольники. Для их создания и обслуживания
существует специальный класс StarWPF, который наследует классу правильных
многоугольников RegularPolygonWPF.
Первый конструктор создаёт закрашенную звезду без контура:
constructor(x, y, r, rinternal: real; n: integer; с: GColor);
Второй конструктор создаёт закрашенную звезду с контуром:
constructor(x, y, r, rinternal: real; с: GColor;
borderWidth: real; borderColor: GColor);
Третий конструктор создаёт закрашенную звезду с чёрным контуром:
constructor(x, y, r, rinternal: real; с: GColor;
borderWidth: real);
Следующая тройка конструкторов повторяет предыдущую тройку, но центр описанной окружности задаётся типом Point:
constructor(p: Point; r, rinternal: real; n: integer;
с: GColor);
constructor(p: Point; r, rinternal: real; с: GColor;
borderWidth: real; borderColor: GColor);

constructor(p: Point; r, rinternal: real; с: GColor;
borderWidth: real);
102

x, y, р – координаты центра многоугольника
r – радиус описанной окружности
rinternal – радиус внутренней окружности
n – число вершин
c – цвет заливки
borderWidth – толщина/ширина контура
borderColor – цвет контура
Свойства Width, Height, Radius – как у кругов.
Свойство Count устанавливает или возвращает текущее число вершин звезды:
property Count ↔ integer;
Новое свойство InternalRadius устанавливает или возвращает текущий внутренний радиус звезды:
property InternalRadius ↔ real;

Звёзды WPFO
В этом проекте нам понадобятся 2 ползунка. Ползунком sln мы будем изменять
число вершин звезды, а ползунком slri – её внутренний диаметр:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
var
103

// ползунки:
sln : SliderWPF;
slri : SliderWPF;

Мы создадим единственную звезду, а ползунками будем изменять её свойства:
// звезда:
star : StarWPF;

В главном блоке программы вызываем процедуры Prepare и Create;
begin
Prepare;
Create;
end.

В процедуре Prepare создаём элементы управления:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH + 120, GW_HEIGHT);
Window.Title := ' Звёзды WPFO ';
Window.Clear(Colors.SeaShell);
LeftPanel(120, Colors.BurlyWood, 5);
sln := Slider('Число вершин:', 5, 20, 1);
slri := Slider('Внутренний радиус:', 2, GW_WIDTH div 2, 60, 1);
// изменяем число вершин:
var p: procedure := () → begin
star.Count := sln.Value;
end;
sln.ValueChanged := p;
// изменяем внутренний радиус:
var pri: procedure := () → begin
star.InternalRadius := slri.Value;
104

end;
slri.ValueChanged := pri;
end;

А в процедуре Create – исходную звезду:
procedure Create;
begin
// создаём новый объект:
if star = nil then begin
// координаты центра:
var xc := CX;
var yc := CY;
// радиус описанной окружности:
var r := GW_WIDTH / 2 - 6;
// цвет заливки:
var clrF := RandomColor;
// толщина контура:
var t := 5;
// цвет контура:
var clrB := RandomColor;
star := new StarWPF(xc, yc, r, 60, 5, clrF, t, clrB);
end;
end;

Для пяти вершин подбираем такой радиус, чтобы получилась звезда, как мы её
себе представляем (Рис. 1).
С увеличением числа вершин звезда становится всё зубастее (Рис. 2).
Увеличение внутреннего радиуса звезды превращает её в правильный многоугольник, близкой родственницей которого она и является (Рис. 3).
А с увеличением числа вершин звезда стремится стать кругом, как и подобает
настоящим звёздам (Рис. 4).

105

Рис. 1. Настоящая звезда
106

Рис. 2. Остроконечная звезда
107

Рис. 3. Неожиданное превращение
108

Рис. 4. Звезда пошла кругом
109

Произвольные многоугольники
Самый простой многоугольник – это треугольник с тремя углами. За ним следует
прямоугольник с четырьмя углами. И так далее до самого круга с бесконечным
числом углов. Прямоугольники мы уже освоили. Освоим и многоугольники в целом и вообще. Строительством многоугольников занимается класс PolygonWPF.
Первый конструктор создаёт закрашенный многоугольник без контура:
constructor(pp : array of Point; с: GColor);
Координаты вершин многоугольника задаются массивом pp.
Второй конструктор создаёт закрашенный многоугольник с контуром:
constructor(pp : array of Point; с: GColor;
borderWidth: real; borderColor: GColor);
Третий конструктор создаёт правильный закрашенный многоугольник с чёрным
контуром:
constructor(pp : array of Point; с: GColor;
borderWidth: real);
рp – координаты вершин многоугольника
n – число вершин
borderWidth – толщина/ширина контура
borderColor – цвет контура
Свойство Points устанавливает или возвращает текущий массив координат вершин многоугольника:
property Points ↔ array of Point;
110

Случайные многоугольники WPFO
Многоугольники начинаются с треугольников, поэтому сразу устанавливаем
число вершин в тройку:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =640;
// толщина контура:
BORDER_WIDTH = 6;
var
// ползунок:
sl : SliderWPF;
// многоугольник:
ngon : PolygonWPF;
// число вершин:
nv := 3;

В процедуре Prepare создаём ползунок sl для изменения числа вершин многоугольника:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH + 120, GW_HEIGHT);
Window.Title := ' Случайные многоугольники WPFO ';
Window.Clear(Colors.SeaShell);
LeftPanel(120, Colors.BurlyWood, 5);
sl := Slider('Число вершин:', 3, 20, 1);
// изменяем длину волны ползунком:
var p: procedure := () → begin
nv := sl.Value;
Draw(false);
end;
sl.ValueChanged := p;
111

А также кнопку для обновления многоугольника:
var b := new ButtonWPF('ОБНОВИТЬ', 16);
b.Width := 100;
b.Height := 24;
b.Click := procedure -> Draw(true);
end;

В главном блоке программы вызываем процедуры Prepare и Create:
begin
Prepare;
Create;
end.

В процедуре Create создаём многоугольник с числом вершин nv, со случайными
цветами заливки и контура:
// СОЗДАЁМ МНОГОУГОЛЬНИК
procedure Create;
begin
// толщина контура:
var t := BORDER_WIDTH;
// случайный цвет контура:
var clrB := RandomColor;
// случайный цвет заливки:
var clrF := RandomColor;
// массив точек:
var apts : array of Point := new Point[nv];
// заполняем массив:
for var i := 0 to nv - 1 do begin
// координаты вершины:
var x := Random(t, GW_WIDTH - t);
var y := Random(t, GW_HEIGHT - t);
var pt := new Point(x,y);
apts[i] := pt;
end;
112

// создаём многоугольник:
ngon := new PolygonWPF(apts, clrF, t, clrB);
end;

При изменении числа вершин обновляем координаты вершин многоугольника:
// ИЗМЕНЯЕМ МНОГОУГОЛЬНИК
procedure Draw(repaint: boolean := false);
begin
// толщина контура:
var t := BORDER_WIDTH;;
// массив точек:
var apts : array of Point := new Point[nv];
// заполняем массив:
for var i := 0 to nv-1 do begin
// координаты вершины:
var x := Random(t, GW_WIDTH - t);
var y := Random(t, GW_HEIGHT - t);
var pt := new Point(x,y);
apts[i] := pt;
end;
if repaint then begin
// случайный цвет контура:
var clrB := RandomColor;
ngon.BorderColor := clrB;
// случайный цвет заливки:
var clrF := RandomColor;
ngon.Color := clrF;
end;
// обновляем многоугольник:
ngon.Points := apts;
end;

Если нажата кнопка ОБНОВИТЬ, то мы дополнительно изменяем цвета заливки и
контура.
Треугольники не вызывают вопросов (Рис. 1).

113

Рис. 1. Произвольный треугольник

Четырёхугольники могут превратиться в бантик (Рис. 2).

114

Рис. 2. Завязали бантик

Чем больше вершин у произвольного многоугольника, тем более сложным он становится (Рис. 3).

115

Рис. 3. Многоугольник - это сложная штука

116

Картинки
Самые интересные объекты – это картинки. Картинные объекты создаёт класс
PictureWPF.
Первый конструктор создаёт картинку из файла на диске и помещает её в точку с
координатами (x, y):
constructor(x, y: real; fname: string);
Второй конструктор действует, как первый, но дополнительно можно изменить
ширину и высоту картинки:
constructor(x, y, w, h: real; fname: string);
Третий и четвёртый конструктор повторяют первые два, но координаты верхнего
левого угла картинки задаются структурой/записью Point:
constructor(p: Point; fname: string);

constructor(p: Point; w, h: real; fname: string);
x, y, p – координаты левого верхнего угла объекта
fname – путь к файлу с расширением: .bmp, .gif, ICO, .jpg, .png, .wdp и .tiff.
Статический метод CreateInvisible создаёт картинку из файла на диске:
static function CreateInvisible(x,y : real;
fname: string): PictureWPF;

117

Если картинка не должна сразу после создания появиться на экране, то используйте этот метод. Чтобы показать картинку на экране, присвойте её свойству Visible значение true.

Картинки WPFO
Я скопировал все картинки в папку с исходным кодом программы, поэтому путь к
файлам состоит только из названия файла и расширения:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
var
// названия картинок:
fnames := |'ball0.png',
'ball1.png',
'ball2.png',
'ball3.png',
'ball4.png'|;

В процедуре Load мы бесконечно загружаем случайно выбранные картинки и разбрасываем их по окну программы:
procedure Load;
begin
while true do begin
// номер картинки:
var n := Random(fnames.Length);
var fname := fnames[n];
// случайные координаты картинки:
var x := Random(10, GW_WIDTH - 62);
var y := Random(10, GW_HEIGHT - 62);
new PictureWPF(x,y,fname);
118

Sleep(100);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Картинки WPFO ';
Window.Clear(Colors.SeaShell);
end;

begin
Prepare;
Load;
end.

Мячей набили мы немало (Рис. 1).

119

Рис. 1. Мячепад

Как вы помните подобный случай произошёл в игре между командами Зубило и
Шайба (Рис. 2).

120

Рис. 2. Старик Хоттабыч развлекается

Если во второй конструктор передать ширину/высоту больше оригинальной, то
картинка не изменится. Если меньше, то картинка пропорционально уменьшится
(Рис. 3):
procedure Load2;
begin
while true do begin
121

// номер картинки:
var n := Random(fnames.Length);
var fname := fnames[n];
// случайные координаты картинки:
var x := Random(10, GW_WIDTH - 62);
var y := Random(10, GW_HEIGHT - 62);
// ширина:
var w := 40;
new PictureWPF(x,y, w, 60,fname);
Sleep(100);
end;
end;

begin
Prepare;
//Load;
Load2;
end.

122

Рис. 3. Мелкоскоп

123

Текст
Каждый объект можно дополнить текстом, но можно создать и собственно текстовый объект с помощью класса TextWPF.
В этом классе 3 конструктора.
Первый конструктор создаёт текст txt в точке с координатами (x, y):
constructor(x, y: real; txt: string;
с: GColor:= Colors.Black);
По умолчанию цвет текста чёрный, но вы можете передать в конструктор любой
другой цвет.
Второй конструктор действует, как первый, но дополнительно можно задать размер шрифта:
constructor(x, y, sz: real; txt: string; с: GColor);
Третий конструктор действует, как второй, но цвет шрифта чёрный:
constructor(x, y, sz: real; txt: string;
с: GColor:= Colors.Black);
x, y – координаты левого верхнего угла объекта
txt – строка
с – цвет текста
sz – размер шрифта
Свойство FontSize устанавливает или возвращает размер шрифта:
property FontSize ↔ real;
124

Свойство FontName устанавливает или возвращает имя шрифта:
property FontName ↔ string;
Свойство Color изменяет или возвращает текущий цвет шрифта:
property Color ↔ GColor;
Свойство BackgroundColor изменяет или возвращает текущий цвет фона текста:
property BackgroundColor ↔ GColor;
Свойство Text устанавливает или возвращает текущую надпись:
property Text ↔ string;
Метод SetRotate поворачивает надпись на заданный угол da вокруг своего центра:
function SetRotate(da : real): TextWPF;
При этом создаётся новый объект.

Текст WPFO
Пользуемся вторым конструктором, чтобы создать текстовые объекты случайного
цвета и случайного размера шрифта:
uses WPFObjects;

125

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;

// СОЗДАЁМ ТЕКСТОВЫЕ ОБЪЕКТЫ
procedure CreateText;
begin
while true do begin
// координаты:
var x := 10;
var y := Random(10, GW_HEIGHT - 40);
// размер шрифта:
var sz := Random(6, 28);

Для тестовой строки выбираем панграмму – строку, в которой содержатся все
буквы русского алфавита:
// строка-панграмма:
var txt := 'Эх, чужак! Общий съём цен шляп (юфть) — вдрызг';
// цвет:
var c := RandomColor;
new TextWPF(x, y, sz, txt, c);
Sleep(100);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Текст WPFO ';
Window.Clear(Colors.SeaShell);
end;
begin
Prepare;
CreateText;
end.

126

Запускаем программу. Строки даже с мелким шрифтом читаются отлично (Рис. 1).

Рис. 1. Панграмматично

127

Текст 2 WPFO
С помощью свойств текста FontSize и Color мы можем организовать занятную анимацию текстового сообщения:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =200;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// макс. размер шрифта:
D_SZ = 40;
var
// размер шрифта:
sz := 6;
// в-на изменения размера:
dsz := 1;

// СОЗДАЁМ ТЕКСТОВЫЙ ОБЪЕКТ
procedure CreateText;
begin
// строка-панграмма
var str := 'Эх, чужак! Общий съём цен шляп (юфть) — вдрызг';
var txt : TextWPF;
// координаты:
var x := 10;
var y := CY-20;
// цвет:
var c := RandomColor;
txt := new TextWPF(x, y, sz, str, c);
Sleep(100);
while true do begin
// изменяем размер шрифта:
sz += dsz;
if sz > D_SZ then dsz := -1
else if sz < 6 then begin
128

dsz := 1;
c := RandomColor;
txt.Color := c;
end;
txt.FontSize := sz;
Sleep(20);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Текст 2 WPFO ';
Window.Clear(Colors.SeaShell);
end;

begin
Prepare;
CreateText;
end.

Размер и цвет шрифта постоянно изменяются, привлекая внимание пользователя
(Рис. 1 и 2).

Рис. 1. Строка уменьшается

129

Рис. 2. Строка увеличивается

Дополнительно мы можем оперативно изменять шрифт в работающей программе (Рис. 3):
txtnames := |'Arial',
'Arial Black',
'Consolas',
'Courier New',
'Times New Roman',
'Showcard Gothic'|;
else if sz < 6 then begin
dsz := 1;
c := RandomColor;
txt.Color := c;
var tn := Random(txtnames.Length);
txt.FontName := txtnames[tn];
end;
txt.FontSize := sz;
Sleep(60);
end;
end;

Чтобы увидеть, какие шрифты установлены на компьютере, откройте диалоговое
окно Настройки → Редактор → Шрифт (Рис. 4).

130

Рис. 3. Изменчивый шрифт

Рис. 4. Полный список

Однако «нестандартные» шрифты не содержат русских
букв, то они будут заменены буквами из шрифта по умолчанию.
131

Изменяем в процедуре CreateText цвет фона надписи:
// изменяем цвет фона:
var cb := RandomColor;
txt.BackgroundColor := cb;

Если хорошо подобрать цвета фона и надписи, то получается наглядно и эффектно
(Рис. 5).

Рис. 5. Шрифтовой дизайн

Давайте вместо панграммы напечатаем название текущего шрифта:
else if sz < 6 then begin
dsz := 1;
c := RandomColor;
txt.Color := c;
// изменяем цвет фона:
var cb := RandomColor;
txt.BackgroundColor := cb;
var tn := Random(txtnames.Length);
txt.FontName := txtnames[tn];
txt.Text := txtnames[tn];
end;

Экзотические шрифты вполне работоспособны, но только с латинскими буквами
(Рис. 6).
132

Рис. 6. Экзотика

Как и другие объекты, надписи можно вращать (Рис. 7):
else if sz < 6 then begin
dsz := 1;
c := RandomColor;
txt.Color := c;
// изменяем цвет фона:
var cb := RandomColor;
txt.BackgroundColor := cb;
var tn := Random(txtnames.Length);
txt.FontName := txtnames[tn];
//txt.Text := txtnames[tn];
end;
txt.FontSize := sz;
txt.SetRotate(sz*5);
Sleep(60);
end;

133

Рис. 7. Текст с поворотом

134

Анимация объектов
Процедуры AnimMoveBy и AnimMoveOn анимировано перемещают объект на a и
b пикселей вдоль горизонтальной и вертикальной осей за время sec:
procedure AnimMoveBy(a, b : real; sec : real := 1);

procedure AnimMoveOn(a, b : real; sec : real := 1);
Процедура AnimMoveTo анимировано перемещает объект в точку с координатами (x,y) за время sec:
procedure AnimMoveTo(x, y : real; sec : real := 1);
Процедура AnimMoveForward анимировано перемещает объект на расстояние
dist за 1 секунду по направлению, заданному RotateAngle в градусах:
procedure AnimMoveForward(dist : real);
Странно, но время анимации задать нельзя!
Процедура AnimMoveEnd заканчивает анимацию перемещения объекта:
procedure AnimMoveEnd;
Процедура AnimRotate анимировано поворачивает объект на угол а в градусах за
время sec:
procedure AnimRotate (a : real; sec : real := 1);

135

Процедура AnimScale анимировано изменяет размеры объекта в а раз за время
sec:
procedure AnimScale(a : real; sec : real := 1);
Следующие процедуры находятся в модуле GraphWPF.
Процедура BeginFrameBasedAnimation начинает покадровую анимацию с заданной частотой обновления сцены frate:
procedure BeginFrameBasedAnimation(Draw : procedure;
frate: integer := 61);
Важно: перед обновлением кадра всё окно программы стирается белым цветом!
А затем вызывается указанная процедура Draw.
Вторая процедура BeginFrameBasedAnimation действует, как первая, но процедура Draw получает номер текущего кадра frame:
procedure BeginFrameBasedAnimation(Draw : procedure(frame: integer);
frate: integer := 61);

Третья процедура BeginFrameBasedAnimation действует, как первая, но процедура Draw получает время dt, прошедшее после показа предыдущего кадра:
procedure BeginFrameBasedAnimation(Draw : procedure(dt: real);
frate: integer := 61);

Процедура EndFrameBasedAnimation заканчивает покадровую анимацию:
procedure EndFrameBasedAnimation;

136

Анимация объектов WPFO
Начинаем анимировать объекты:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

В процедуре Create создаём цель – небольшой кружок красного цвета в случайном месте окна программы:
// СОЗДАЁМ ОБЪЕКТЫ
procedure Create(n : integer);
begin
// создаём цель -->
// координаты случайной цели:
var xt := Random(20, GW_WIDTH/2);
var yt := Random(20, GW_HEIGHT/2);
var c := new CircleWPF(xt, yt, 10, Colors.Red);

Затем создаём дюжину разноцветных прямоугольников в случайных местах окна
программы:
loop n do begin
// координаты вершины:
var x := Random(20, GW_WIDTH - 20);
var y := Random(20, GW_HEIGHT - 20);
// размеры:
var w := Random(24, 48);
var h := Random(24, 48);
// случайный цвет:
var clr := RandomColor;
137

// создаём прямоугольник:
var r := new RectangleWPF(x,y,w,h,clr);
r.ToBack;

И устремляем их к цели:
// отправляем прямоугольник к цели:
r.AnimMoveBy(xt-x, yt-y, 10.1);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Анимация объектов WPFO ';
Window.Clear(Colors.SeaShell);
end;
begin
Prepare;
Create(12);
end.

На Рис. 1 видно, что прямоугольники хаотично разбросаны по всему окну программы, поэтому они находятся на разном удалении от цели.
Но в методе AnimMoveBy мы задали для всех прямоугольников одинаковое
время достижения цели, поэтому они двигаются с разной скоростью и одновременно достигают цели. Рис. 2 показывает, что левые верхние углы прямоугольников оказались в центре круга.
Метод AnimMoveTo отправляет объект точно в цель:
// отправляем прямоугольник к цели:
//r.AnimMoveBy(xt-x, yt-y, 10.1);
r.AnimMoveTo(xt, yt, 10.1);

138

Рис. 1. Вразброс

139

Рис. 2. Цель поражена нашими успехами

140

Анимация объектов 2 WPFO
Создаём в процедуре Create 20 вытянутых прямоугольников, чтобы вращение
было более наглядным:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

// СОЗДАЁМ ОБЪЕКТЫ
procedure Create(n : integer);
begin
loop n do begin
// координаты вершины:
var x := Random(20, GW_WIDTH - 60);
var y := Random(20, GW_HEIGHT - 70);
// размеры:
var w := Random(24, 48);
var h := 2 * w;
// случайный цвет:
var clr := RandomColor;
// создаём прямоугольник:
var r := new RectangleWPF(x,y,w,h,clr);

Задаём достаточно большие углы поворота, чтобы оценить работу метода
AnimRotate:
// угол поворота:
var a := Random(-1800, 1800);
r.RotateAngle := a;
r.ToBack;
r.AnimRotate(a, 7)
141

//r.AnimMoveForward(33);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Анимация объектов 2 WPFO ';
Window.Clear(Colors.SeaShell);
end;

begin
Prepare;
Create(20);
end.

Запускаем программу – прямоугольники вращаются дружно, слаженно и плавно
(Рис. 1).
Масштабирование также проходит гладко (Рис. 2):
var a := Random(-5, 5);
r.AnimScale(a, 10);

142

Рис. 1. Дружный хоровод

143

Рис. 2. Масштабная анимация

144

Общие свойства и методы объектов
Свойство Width устанавливает или возвращает текущую ширину объекта:
property Width ↔ real;
Свойство Height устанавливает или возвращает текущую высоту объекта:
property Height ↔ real;
Свойство Size устанавливает или возвращает текущие размеры объекта:
property Size ↔ GSize;
Свойство Bounds возвращает описывающий прямоугольник для объекта:
property Bounds → GRect;
Свойство ScaleFactor устанавливает или возвращает коэффициент масштабирования объекта:
property ScaleFactor ↔ real;
Если это свойство равно 1, то объект имеет оригинальные размеры.
Если это свойство больше 1, то объект имеет увеличенные размеры.
Если это свойство меньше 1, то объект имеет уменьшенные размеры.
Процедура Scale масштабирует объект в sc раз относительно текущего размера:
procedure Scale(sc : real);

145

Свойство ScaledWidth возвращает ширину объекта после масштабирования:
property ScaledWidth → real;
Свойство ScaledHeight возвращает высоту объекта после масштабирования:
property ScaledHeight → real;
Свойство ScaledSize возвращает размеры объекта после масштабирования:
property ScaledSize → GSize;
Процедура AnimScale анимировано масштабирует объект в sc раз относительно
исходного размера за время dt в секундах:
procedure AnimScale(sc : real; dt : real := 1);
По умолчанию время анимации равно 1 секунде.
Свойство Left устанавливает или возвращает расстояние объекта от левой границы окна:
property Left ↔ real;
Свойство Top устанавливает или возвращает расстояние объекта от верхней границы окна:
property Top ↔ real;
Свойство Right устанавливает или возвращает расстояние правого края объекта
от правой границы окна:

146

property Right ↔ real;
Свойство Bottom устанавливает или возвращает расстояние нижнего края объекта от верхней границы окна:
property Bottom ↔ real;
Свойство Center возвращает координаты центра объекта или перемещает его в
заданную точку:
property Center ↔ Point;
Свойство LeftTop возвращает координаты левого верхнего угла объекта:
property LeftTop → Point;
Свойство LeftBottom возвращает координаты левого нижнего угла объекта:
property LeftBottom → Point;
Свойство RightTop возвращает координаты правого верхнего угла объекта:
property RightTop → Point;
Свойство RightBottom возвращает координаты правого нижнего угла объекта:
property RightBottom → Point;
Свойство CenterTop возвращает координаты середины верхней границы объекта:
property CenterTop → Point;
147

Свойство CenterBottom возвращает координаты середины нижней границы объекта:
property CenterBottom → Point;
Свойство Color устанавливает или возвращает текущий цвет объекта:
property Color ↔ GColor;
Свойства Dx и Dy устанавливают или возвращают текущее направление (вектор)
перемещения объекта:
property Dx ↔ real;

property Dy ↔ real;
Свойство Direction устанавливает или возвращает текущее направление перемещения объекта:
property Direction ↔ (real, real);
то же самое, что (Dx, Dy).
Свойство Velocity устанавливает или возвращает текущую скорость перемещения
объекта:
property Velocity ↔ real := 300;
Значение свойства Velocity по умолчанию слишком велико,
поэтому сразу задавайте нужную скорость!

148

Свойства Dx, Dy, Direction и Velocity иcпользуются в методе Move.
Свойство Visible устанавливает или возвращает текущую видимость объекта на
экране:
property Visible ↔ boolean;
По умолчанию объект видимый. Но если установить значение этого свойства в
false, то он исчезнет.
Свойство RotateAngle устанавливает или возвращает текущий угол поворота объекта в градусах по часовой стрелке вокруг его центра:
property RotateAngle ↔ real;
Процедура Move перемещает объект на dx, dy пикселей по горизонтали и вертикали:
procedure Move(dx, dy);
Процедура MoveTime перемещает объект по направлению Direction со скоростью
Velocity за время dt:
procedure MoveTime(dt : real);
На самом деле объект мгновенно перенесётся в заданную
точку! Никакой анимации!

Первая процедура MoveBy перемещает объект на a, b пикселей по горизонтали и
вертикали:

149

procedure MoveBy(a, b : real);
Вторая процедура MoveBy перемещает объект на вектор (a, b):
procedure MoveBy(v : (real,real));
Две процедуры MoveOn действуют так же, как процедуры MoveBy.
Процедура MoveTo перемещает левый верхний угол объекта в точку с координатами (x, y):
procedure MoveTo(x, y : real);
Процедура MoveForward перемещает объект на заданное расстояние в направлении RotateAngle:
procedure MoveForward(dist : real);
Углы отсчитываются от положительного направления
вертикальной оси.

Процедура Rotate поворачивает объект на заданный угол а вокруг его центра:
procedure Rotate(а : real);
Процедура RotateToPoint поворачивает объект в направлении точки с координатами (x, y):
procedure RotateToPoint(x, y : real);

150

Предполагается, что изначально объект смотрит вверх.

Процедура AddChild добавляет объект ch:
procedure AddChild(ch : ObjectWPF; al : Alignment);
Параметр Alignment имеет такие значения:
Alignment = (LeftTop,
CenterTop,
RightTop,
LeftCenter,
Center,
RightCenter,
LeftBottom,
CenterBottom,
RightBottom);
И выравнивает дочерний объект относительно родительского. По умолчанию равен Alignment.LeftTop.
Процедура AddChild удаляет дочерний объект:
procedure DeleteChild(ch : ObjectWPF);

Не работает!

Процедура Destroy уничтожает объект:

151

procedure Destroy;
Уничтожаемый объект должен существовать, иначе возникнет ошибка.

Процедура ToFront переносит объект выше остальных:
procedure ToFront;
Процедура ToBack переносит объект ниже остальных:
procedure ToBack;
Программа рисует объекты в порядке их поступления, поэтому первый созданный
объект окажется ниже других объектов. Следом за первым на экране появится
второй объект, и так далее. Последний объект находится выше всех остальных, то
есть «ближе» к нам. Иногда нужно изменить порядок прорисовки объектов. Тут
нам на помощь приходят процедуры ToFront и ToBack.
Метод Intersects проверяет, пересекается ли данный объект с другим объектом
ob:
function Intersects(ob : ObjectWPF): boolean;
Если объекты пересекаются, то функция возвращает true. В противном случае –
false.
Метод IntersectionList, возвращает список объектов, с которым пересекается заданный объект:
function Intersects(Self : ObjectWPF): List<ObjectWPF>;
152

extensionmethod

Вверх-вниз WPFO
В этой программе мы создаём 5 кругов:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

// СОЗДАЁМ КРУГИ
procedure Create(n : integer);
begin
var x,y,r,t : real;
var clr1, clr2 :Color;
// список кругов:
var lstC := new List<CircleWPF>();
loop n do begin
// размер:
r := Random(100, 200);
// координаты центра:
x := Random(CX-r, CX+r);
y := Random(CY-r, CY+r);
// цвет заливки:
clr1 := RandomColor;
// цвет контура:
clr2 := RandomColor;
// толщина контура:
t := 5;
// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
lstC.Add(circle);
153

end;

А затем выбираем из списка случайный круг и переносим его наверх (или вниз, но
это менее наглядно):
while true do begin
// выбираем случайный круг:
var nc := Random(n);
var c := lstC[nc];
c.ToFront;
//c.ToBack;
Sleep(100);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Вверх-вниз WPFO ';
Window.Clear(Colors.SeaShell);
end;

begin
Prepare;
Create(5);
end.

Запускаем программу и наблюдаем, как попеременно последние круги становятся первыми
(Рис. 1).

154

Рис. 1. Всё может быть

155

События мышки
При перемещении мышки по окну программы и при нажатии кнопок возникают
события, которые мы можем обрабатывать в программе.
Событие OnMouseMove возникает при перемещении мышки:
OnMouseMove: procedure(x, y : real; mousebutton : integer);
Событие OnMouseDown возникает, когда нажимается кнопка мышки:
OnMouseDown: procedure(x, y : real; mousebutton : integer);
Событие OnMouseUp возникает, когда отпускается нажатая кнопка мышки:
OnMouseDown: procedure(x, y : real; mousebutton : integer);
x, y – текущие координаты курсора мышки
mousebutton = 0, если кнопка мышки не нажата
= 1, если нажата (и удерживается) левая кнопка мышки
= 2, если нажата правая кнопка мышки

События мышки WPFO
Чтобы использовать в программе события мышки, нужно назначить процедурыобработчики для этих событий. Удобнее всего это сделать в процедуре Prepare:
uses WPFObjects;
const
// размеры окна:
156

GW_WIDTH = 360;
GW_HEIGHT =360;
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' События мышки WPFO ';
Window.Clear(Colors.SeaShell);
OnMouseMove := MouseMove;
OnMouseDown := MouseDown;
OnMouseUp := MouseUp;
end;

begin
Prepare;
end.

В процедурах-обработчиках мы получаем текущие координаты мышки и номер
нажатой кнопки:
procedure MouseMove(x,y: real; mb: integer);
begin
Println('MouseMove', x,y, mb);
end;

procedure MouseDown(x,y: real; mb: integer);
begin
Println('MouseDown',x,y, mb);
end;

procedure MouseUp(x,y: real; mb: integer);
begin
Println('MouseUp', x,y, mb);
end;

157

События клавиатуры
При нажатии клавиш также возникают события, которые мы можем обрабатывать
в программе.
Событие OnKeyDown возникает при нажатии на клавишу:
OnKeyDown: procedure(k : Key);
Событие OnKeyUp возникает, когда отпускается нажатая клавиша:
OnKeyUp: procedure(k : Key);
Событие OnKeyPress возникает при нажатии на символьную клавишу:
OnKeyPress: procedure(ch : char);
k – код клавиши
ch – печатный символ
Печатный символ вы можете прочитать на клавишах. Если это буква, то это код
ПРОПИСНОЙ БУКВЫ.
Клавиш очень много, поэтому вы можете просто напечатать в консоли код нужных
вам клавиш. Все коды клавиш вы можете найти здесь:
https://learn.microsoft.com/ruru/dotnet/api/system.windows.input.key?view=windowsdesktop-7.0

158

События клавиатуры WPFO
Небольшой проект для изучения событий клавиатуры:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 360;
GW_HEIGHT =360;

procedure KeyDown(k: Key);
begin
Println('k =',k);
end;
procedure KeyUp(k: Key);
begin
Println('k =',k);
end;
procedure KeyPress(ch: char);
begin
Println('ch =',ch);
end;
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' События клавиатуры WPFO ';
Window.Clear(Colors.SeaShell);
OnKeyDown := KeyDown;
OnKeyUp := KeyUp;
OnKeyPress := KeyPress;
end;

begin
159

Prepare;
end.

Другие события
Событие OnResize возникает при изменении размеров окна программы:
OnResize: procedure;
Событие OnClose возникает при закрытии главного окна программы:
OnClose: procedure;
В процедуре-обработчике этого события вы можете попрощаться с пользователем или сохранить данные на диске.
Событие OnDrawFrame возникает при перерисовке сцены:
OnDrawFrame: procedure(dt : real);
dt – время в секундах, которое прошло после предыдущей перерисовки сцены

Другие события WPFO
Это проект поможет вам использовать эти события в своих программах:
uses WPFObjects;
const
// размеры окна:
160

GW_WIDTH = 360;
GW_HEIGHT =360;

procedure Resize;
begin
Window.Title := $'Размеры окна: {Window.Width} x {Window.Height}';
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Другие события WPFO ';
Window.Clear(Colors.SeaShell);
OnResize := procedure → begin
Resize;
end;

OnClose := procedure → begin
Window.Title := ' УШЛА НА БАЗУ! ';
Sleep(2000);
end;

OnDrawFrame := dt -> begin
Window.Title := $'{dt} -> {Round(1 / dt, 2)}';
end;

161

end;

begin
Prepare;
end.

Функция ObjectUnderPoint возвращает первый объект, который находится в точке
с координатами (x, y):
function ObjectUnderPoint(x, y : real): ObjectWPF;
Будьте осторожны: если в заданной точке нет объектов,
то функция вернёт nil!

Функция ObjectsIntersect проверяет, пересекаются ли 2 заданных объекта:
function ObjectsIntersect (ob1, ob2 : ObjectWPF): boolean;
Если объекты пересекаются, то функция возвращает true. В противном случае –
false.

Кто под мышкой WPFO
Создаём 20 красивых кругов разных калибров и колеров:
uses WPFObjects, Controls;
162

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// список кругов:
var lstC := new List<ObjectWPF>();

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Кто под мышкой WPFO ';
Window.Clear(Colors.SeaShell);
OnMouseDown := MouseDown;
end;

begin
Prepare;
Create(20);
end.

// СОЗДАЁМ КРУГИ
procedure Create(n : integer);
begin
var x,y,r,t : real;
var clr1, clr2 :Color;
loop n do begin
// размер:
r := Random(60, 120);
// координаты центра:
x := Random(r, GW_WIDTH-r);
y := Random(r, GW_HEIGHT-r);
// цвет заливки:
clr1 := RandomColor;
163

// цвет контура:
clr2 := RandomColor;
// толщина контура:
t := 5;
// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
lstC.Add(circle);
end;
end;

В процедуре MouseDown находим кликнутый объект:
procedure MouseDown(x,y: real; mb: integer);
begin
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;

И возносим его над всеми остальными круглыми неудачниками:
c.ToFront;
end;

Все круги на своих местах (Рис. 1).
Процедура MouseDown2 более радикальная – она с помощью мышки выгрызает
круги из круга жизни:
procedure MouseDown2(x,y: real; mb: integer);
begin
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;
lstC.Remove(c);
c.destroy;
if lstC.Count = 0 then
164

MessageBox.Show(' IGRA OVER!',' Кругомышка ');
end;
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Кто под мышкой WPFO ';
Window.Clear(Colors.SeaShell);
//OnMouseDown := MouseDown;
OnMouseDown := MouseDown2;
end;

Тут уже попахивает простецкой, но залипательной игрой!
Один щелчок мышки – и аутсайдер вырывается в лидеры (Рис. 2).
Кругом круги (Рис. 3).
Но тут на сцене появляется прожорливая МЫШЬ (Рис. 4)!
Тут были бы уместнее кусочки сыра, но, поговаривают, что
на мышек наговаривают, – сыр они не любят.

Теперь уже не скажешь «сыр!» - игра
сделана (Рис. 5).

165

Рис. 1. Кругостолпотворение

166

Рис. 2. Один щелчок – и какие перемены!

167

Рис. 3. Пока спокойно

168

Рис. 4. Прожорливая мышка

169

Рис. 5. Мышь победила

170

Скалирование WPFO
Для масштабных экспериментов нам нужен настоящий супергерой, который Марио! В нашей программе он будет представлен в лучшем виде, то есть как на картинке. Для изменения размеров Марио в обе стороны мы установим на панели
ползунок:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
TITLE = ' Скалирование WPFO ';
var
// ползунок:
sl : SliderWPF;
// картинка:
mario : PictureWPF;

Процедура Info печатает в заголовке окна (чтобы не плодить без нужды элементы
управления) текущие размеры портрета Марио:
procedure Info;
begin
Window.Title := TITLE + mario.ScaledWidth + ' ' +
mario.ScaledHeight + ' ' +
mario.ScaledSize.ToString;
end;

Процедура ScaleMario изменяет размеры Марио согласно положению движка на
ползунке:
// МАСШТАБИРУЕМ МАРИО
171

procedure ScaleMario(sc : real);
begin
mario.ScaleFactor := sc/100;
Info;
end;

В процедуре Prepare создаём окно программы и ползунок, а также загружаем
нашего героического Марио прямо в пикчерный объект PictureWPF:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH + 120, GW_HEIGHT);
Window.Title := TITLE;
Window.Clear(Colors.SeaShell);
mario := new PictureWPF(10,10,'super-mario.png');
LeftPanel(120, Colors.BurlyWood, 5);
sl := Slider('Коэффициент:', 1, 200, 100);
// изменяем число вершин:
var p: procedure := () → begin
ScaleMario(sl.Value);
end;
sl.ValueChanged := p;
end;

Ползунок принимает и выдаёт только целые значения, поэтому мы дополнительно делим их на 100, так что мысленно проводите эту преобразовательную
математическую операцию:
begin
Prepare;
Info;
end.

172

Смело – а как же иначе, имея такого сумасшедшего героя, как Марио! – запускаем
программу и видим Марио в полный рост (Рис. 1).

Рис. 1. Красавчик!

Но в нашей воле и по силам уменьшить (Рис. 2) или увеличить (Рис. 3) Марио согласно его заслугам и по нашему настроению.
173

Рис. 2. Мини-Марио
174

Рис. 3. Макси-Марио
175

Анимированный Марио WPFO
Всегда удобнее и приятнее делегировать свои обязанности компьютеру, чем заниматься делом самому. И мы это выполним с честью.
В этом проекте Марио будет масштабироваться без нашего непосредственного
рукоприкладства к ползунку. Сначала мы анимируем Марио наивным способом.
В раздел констант прописываем максимальный масштаб Марио, чтобы он всётаки держал себя в рамках приличия:
uses WPFObjects, Controls;
const
// размеры окна:
GW_WIDTH = 640;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
TITLE = ' Анимированный Марио WPFO ';
// макс. масштаб:
SC_MAX = 2;

В разделе переменных указываем текущий масштаб Марио и величину изменения этого масштаба:
var
// картинка:
mario : PictureWPF;
// масштаб:
sc := 1.0;
// в-на изменения масштаба:
dsc := 0.01;

В процедуре Animation зацикливаем изменения размеров Марио в разумных пределах:
176

procedure Animation;
begin
while true do begin
// меняем размер Марио:
sc += dsc;
if sc > SC_MAX then dsc := -0.01
else if sc < 0.1 then dsc := 0.01;
mario.ScaleFactor := sc;
Sleep(10);
end;
end;

Проверка показывает (Рис. 1), что этот способ глумления над Марио действует
вполне сносно.
Более изощрённый способ масштабирования Марио основан на методе
AnimScale, которому следует передать желаемый масштаб и время изменения
масштаба от текущего значения к заданному в секундах:
procedure Animation2;
begin
while true do begin
mario.AnimScale(2, 2);
Sleep(2000);
mario.AnimScale(0.2, 2);
Sleep(2000);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH + 120, GW_HEIGHT);
Window.Title := TITLE;
Window.Clear(Colors.SeaShell);
mario := new PictureWPF(10,10,'super-mario.png');
end;
177

begin
Prepare;
Animation;
//Animation2;
end.

Это способ также действует отлично!

178

Рис. 1. Анимированный Марио
179

Процедура Redraw ускоряет обновления графических объектов:
procedure Redraw(p : ()->());
Ускорение достигается за счёт обновления экрана только после изменения всех
объектов на экране.

Пульсирующие точки 2 WPFO
Ускоряем пульсацию точек:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// макс. диаметр точки:
D_MAX = 60;
var
// диаметр точки:
d := 10;
// в-на изменения диаметра:
dd := 3;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.CenterOnScreen;
Window.Title := ' Пульсирующие точки 2 WPFO ';
Window.Clear(Colors.Black);
end;

180

procedure Create;
begin
// создаём точки -->
for var row := 0 to GW_HEIGHT div D_MAX - 1 do
for var col := 0 to GW_WIDTH div D_MAX - 1 do begin
// координаты центра:
var xc := D_MAX * col + D_MAX div 2;
var yc := D_MAX * row + D_MAX div 2;
// цвет очередной точки:
var clr := RandomColor;
var circle : ObjectWPF := new CircleWPF(xc,yc, d div 2,
clr);
end;
end;
procedure Animation;
begin
// меняем размер точки:
d += dd;
if d > D_MAX then dd := -3
else if d < 2 then dd := 3;
for var i := 0 to Objects.Count-1 do begin
var p := CircleWPF(Objects[i]);
p.Radius := d / 2;
end;
end;
begin
Prepare;
Redraw(Create);
//Create;
var k := 1;
while True do
begin
Redraw(Animation);
k += 1;
Window.Title := Format('{0,5:f2}',k/Milliseconds*1000)+
' кадров в секунду';
//Sleep(33);
end;
end.

181

Занятные приложения знаний и усилий
На этом все возможности модуля WPFObjects изучены и освоены, и мы можем
вплотную заняться своими компьютерными фантазиями.

Картинный фон WPFO
Мы использовали в своих программах такие методы и свойства класса окна
Window:
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Картинный фон WPFO ';
Window.Clear(Colors.SeaShell);

Процедура SetSize задаёт размеры окна программы.
Свойство Title устанавливает заголовок окна программы.
Процедура Clear заливает окно программы заданным цветом.
Этого вполне достаточно для учебных программ. В игровых программах для красоты обычно используют не однотонный фон, а красочную картинку. Класс
Window не умеет загружать фоновую картинку. А вот класс GraphWindow имеет
для этого метод Load, которому нужно передать путь к графическому файлу на
диске:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 980;
GW_HEIGHT =660;
// фоновая картинка:
BACK = 'back.jpg';
procedure Prepare;
begin
182

Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Картинный фон WPFO ';
GraphWindow.Load(BACK);
end;

begin
Prepare;
end.

Картинка не масштабируется, поэтому маленькая картинка оставит часть цветного
фона пустой, а большая картинка уйдёт за границы окна. Поэтому создавайте окно
по размерам картинки или, наоборот, сразу рисуйте картинку нужных размеров,
чтобы не мудрить с окном (Рис. 1).

Рис. 1. Красивый фон
183

Пузыри
Очень простая, но притягательная игра BubbleWrap Popper имитирует всем известный процесс лопания пузырей на пластиковой упаковке.
Уральские пельмени не раз развлекали публику этими пузырями (Рис. 1-2).

Рис. 1. Пузыри на сцене

Рис. 2. И в зале

И сами услаждали свой слух
звуками лопающихся пузырей,
которых они назвали кайфушками (Рис. 3).

184

Рис. 3. Эти звуки можно слушать вечно

В Интернете вы найдёте игру в пузыри на Adobe Flash (Рис. 4).

Рис. 4. Предшественник
185

Но мы за образец возьмём игру на Юнити, которую я написал несколько лет
назад (Рис. 5).

Рис. 5. Исходник

Игровые программы довольно большие и сложные, поэтому их лучше создавать
в виде проекта. Назовите его Пузыри, и тогда среда разработки создаст на диске
одноимённую папку и поместит туда файл проекта Пузыри.pabcproj и главный
файл Пузыри.pas.
Тип проекта должен быть – Консольное приложение (Рис. 6).

186

Рис. 6. Игровой тип

Добавьте к проекту файл Game.pas, в котором мы создадим игровой класс (Рис.
7).

Рис. 7. Классное добавление

Классы программировать удобнее, чем длинный главный файл. А в главном файле
программы нужно подключить игровой файл:
uses Game;
{$apptype windows}

187

Директива {$apptype windows} нужна, чтобы при запуске выполняемого файла с
диска на экране не появлялось Консольное окно.
В главном блоке программы мы создаём экземпляр игры и вызываем открытые
методы Prepare и NewGame:
begin
var game := new Bubble;
game.Prepare;
game.NewGame;
end.

Их ещё нужно создать, поэтому не торопитесь запускать программу.
В игровых программах часто используются мультимедийные файлы, которые
нужно помещать в отдельные папки согласно их назначению (Рис. 8).

Рис. 8. Не жалейте папок, программисты

В папке Fonts хранятся шрифты на тот случай, если нужные шрифты не установлены на компьютере. В этом проекте мы не используем редкие шрифты, поэтому
эта папка вам, скорее всего, не понадобится.
В папку Sounds я скопировал 2 звуковых файла.
А в папке Images вы найдёте все картинки для этой игры.
Фоновую картинку нарисуйте сами, если не сможете удачно и быстро найти себе
замену (Рис. 9).
Размеры картинки - 900 х 600 пикселей. Окно программы должно иметь такие же
размеры, что мы отмечаем в константах:

188

const
// размеры окна:
GW_WIDTH = 900;
GW_HEIGHT =600;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;

Рис. 9. Фон – лицо программы

Картинка с поздравлением имеет размеры 498 х 130 (Рис. 10).
Остались пузыри. Точнее, один пузырь в двух состояниях. На левой картинке он
лопнутый, а на правой – целёхонький (Рис. 11).
В файле Game.pas создаём пустой игровой класс:

189

// КЛАСС ИГРЫ
type
Bubble = class
end;
end.

Рис. 10. Это нужно заслужить

Рис. 11. Два облика одного пузыря

Под названием модуля выписываем модули и пространства имён, которые используются в игровом классе:
unit Game;
uses WPFObjects, System.Media, Timers;

Как вы помните, после создания игрового объекта мы вызываем метод Prepare и
создаём окно программы:
// ГОТОВИМСЯ К ИГРЕ
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := TITLE;

Название программы я записал в константах:
190

// заголовок окна программы:
TITLE = ' Пузыри ';

Туда же я поместил и путь к фоновой картинке:
// фоновая картинка:
BACK = 'Images/imgBack.png';

Загружаем её из файла:
GraphWindow.Load(BACK);

Фоновая картинка смотрится отлично (Рис. 12).
В нашей игре всего 1 кнопка, и та ненастоящая. Она нарисована прямо на фоновой
картинке, поэтому нажимать на неё бесполезно – ею можно только любоваться.
Чтобы заставить кнопку работать, мы положим на неё прозрачный прямоугольник
со скруглёнными углами, который вполне можно беспокоить мышкой.
Под константами, в разделе переменных объявляем переменную btnNewGame:
var
// кнопка:
btnNewGame : RoundRectWPF;

И в методе Prepare создаём прозрачный прямоугольник по размерам и координатам нарисованной кнопки:
// кнопка для новой игры:
btnNewGame := new RoundRectWPF (730-121,500-5, 96,96, 15,
Colors.Transparent);

191

Рис. 12. Не ударили в грязь лицом

Чтобы правильно расположить картинку на фоне, сначала
закрасьте её непрозрачным цветом и в запущенной программе установите точно над нарисованной кнопкой. Затем сделайте кнопку прозрачной.

Поздравление – это простая картинка:
// поздравительная картинка:
imgWin : PictureWPF;

192

Создаём её из файла и располагаем на фоне так, чтобы она не закрывала другие
объекты программы:
// табличка с поздравлением:
imgWin := PictureWPF.CreateInvisible(CX-498/2, CY-130/2,
'Images/imgGameOver.jpg');

Выше кнопки на фоне 2 картинки подсказывают их назначение. Правее картинки
с пузырями мы будем печатать число оставшихся пузырей, а правее картинки с
часами – время игры. Для вывода сообщений нам нужно создать 2 метки:
// информационные метки:
txtTime : TextWPF;
txtBubbles : TextWPF;

Это обычные текстовые объекты:
// метка для показа времени:
txtTime := new TextWPF(730, 410,48, '0:00',
Colors.DarkGreen);
txtTime.FontName := 'Arial Bold';
// метка для числа оставшихся пузырей:
txtBubbles := new TextWPF(730, 320, 48, bubbleLeft.ToString,
Colors.Brown);
txtBubbles.FontName := 'Arial Bold';

В готовой программе они выглядят так (Рис. 13).
Для отсчёта времени нам нужны 2 таймера:
// таймеры:
t, t2: Timer;

Первый таймер отсчитывает игровое время в секундах:
193

// таймер отсчитывает время:
t := new Timer(1000, OnTimer);

Рис. 13. Метки расставлены

Второй таймер спрячет поздравительную табличку через 3 секунды:
// таймер убирает табличку:
t2 := new Timer(3000, OnTimer2);

Каждый тик эти таймеры вызывают методы OnTimer и OnTimer2.

194

Чтобы давить пузыри и кнопку, мы назначаем событию OnMouseDown метод обработчик:
// метод-обработчик нажатия на кнопку мышки:
OnMouseDown := MouseDown;

Уже красиво, но чего-то не хватает. А не хватает главных героев нашей игры – пузырей! И мы создаём их в методе CreateBubbles:
// создаём пузыри:
CreateBubbles();
end;

Пузырьковое поле
Пузыри нужно ровно и аккуратно разместить на сцене так, чтобы они образовали
квадрат FIELD_WIDTH х FIELD_HEIGHT. Размеры поля в клетках (или в пузырях) помещаем в константы:
// размеры поля:
FIELD_WIDTH = 10;
FIELD_HEIGHT = 10;

Не обойтись нам и без констант с размерами пузырей:
// размеры пузырей:
B_WIDTH = 42;
B_HEIGHT = 42;

Очень важно определить начальные координаты пузырей – либо арифметическими вычислениями, либо подобрать их прямо на сцене. Я уже позаботился об
этом, поэтому в методе CreateBubbles всё готово к созидательному процессу:

195

Private
// СОЗДАЁМ ПУЗЫРИ
procedure CreateBubbles();
begin
// начальные координаты пузырей:
var x0 := 70;
var y0 := 90;

Метод CreateBubbles и все последующие, за исключением
метода NewGame нужно поместить в секции private, чтобы
они появлялись в подсказке в главном блоке программы и не
вызывали искушения вызвать их без необходимости.

Каждый пузырь должен знать и занять своё место на сцене, которое определяется
его координатами в пикселях. Размеры пузырей нам известны, поэтому координаты вычисляются очень просто, но к ним нужно добавить начальные координаты:
// создаём пузыри на поле:
for var row := 0 to FIELD_HEIGHT-1 do
for var col := 0 to FIELD_WIDTH-1 do begin
// координаты очередного пузыря на сцене:
var x := x0 + col * B_WIDTH;
var y := y0 + row * B_HEIGHT;

Для хранения координат пузырей на поле создаём простой класс IntPoint:
type IntPoint = auto class
col, row : integer;
end;

Названия файлов с пузырями запоминаем в массиве:

196

// файлы с пузырями:
fnames := | 'Images/b0.png', 'Images/b1.png' |;

Для хранения объектов-пузырей создаём массив для живых пузырей:
// игровое поле:
field1 := new PictureWPF[FIELD_WIDTH, FIELD_HEIGHT];

Каждый объект имеет свойство Tag, в которое можно поместить любую информацию. Мы используем это свойство для хранения координат пузыря.
Сначала мы создаём лопнутые пузыри, а затем живёхонькие:
// создаём новый пузырь:
var bubble := new PictureWPF(x,y,fnames[0]);
bubble := new PictureWPF(x,y,fnames[1]);
bubble.Tag := new IntPoint(col, row);
field1[col,row] := bubble;
end;
end;

И тогда нелопнутые пузыри закроют лопнутые, которые находятся как раз под
ними.
Если вы сейчас запустите программу, то увидите, что пузыри очень удачно и гармонично разместились на игровом поле (Рис. 13⬆).
Мы не можем физически лопнуть пузырь, поэтому просто делаем его невидимым,
но в следующей игре им нужно вернуть видимость, что мы и делаем в методе
RestoreBubbles:
// ВОССТАНАВЛИВАЕМ ПУЗЫРИ
procedure RestoreBubbles;
begin
// восстанавливаем пузыри на поле:
197

for var row := 0 to FIELD_HEIGHT-1 do
for var col := 0 to FIELD_WIDTH-1 do
field1[col,row].Visible := true;
end;

Второй и последний открытый метод игрового класса – NewGame. Здесь мы оживляем невинно убитые пузыри, которые, к счастью, бессмертны, как медузы:
// НАЧИНАЕМ ИГРУ
procedure NewGame;
begin
// оживляем пузыри:
RestoreBubbles;
// все пузыри целые:
bubbleLeft := FIELD_WIDTH * FIELD_HEIGHT;
Update;

Запускаем игровые часы:
// запускаем часы:
gameTime := 0;
t.Start;

И сообщаем программе, что игра началась:
// игра началась:
flgGameOver := false;
end;

Игровые часы
Часы непрерывно тикают:
procedure OnTimer;
begin
gameTime += 1;
198

Update;
end;

Поэтому их показания обновляем в методе Update:
// ОБНОВЛЯЕМ СЦЕНУ
procedure Update;
begin
// игра закончена:
if flgGameOver then exit;
// прошедшее время в секундах:
var dt := gameTime;

Извлекаем минуты и секунды:
// число минут:
var min := Floor(dt / 60);
// число секунд:
var sec := Floor(dt mod 60);

И красиво печатаем время на экране:
// печатаем прошедшее время:
if (sec < 10) then
txtTime.Text := min + ':0' + sec
else
txtTime.Text := min + ':' + sec;

Затем мы сообщаем игроку, сколько ещё пузырей ему не хватает до полной победы:
// печатаем число оставшихся пузырей:
txtBubbles.Text := bubbleLeft.ToString;

199

Пузыри хорошо умеют себя считать, но не знают, что же делать, когда все пузыри
лопнут. А это должны знать не они, а игровой класс. В методе Update мы проверяем, сколько живых пузырей осталось на поле. Если на вопрос «Кто живой?» ответа мы не получим, то посылаем игроку музыкальное и графическое поздравление, а игра заканчивается:
// если все пузыри лопнуты,
if (bubbleLeft = 0) then begin
// заканчиваем игру:
flgGameOver := true;
// выдаём игроку победный звуковой сигнал:
spwin.Play;
// показываем табличку с поздравлением:
imgWin.ToFront;
imgWin.Visible := true;
t2.Start;
end;
end;

Извлекать приятные и пренеприятные звуки непросто! Для это нужно создать звуковые проигрыватели для каждого звука из файлов на диске:
// проигрыватели:
sp : SoundPlayer := new SoundPlayer('Sounds/buljk.wav');
spwin := new SoundPlayer('Sounds/win.wav')

Чтобы озвучить важное игровое событие, вызываем метод Play нужного звукового
проигрывателя.
Тут же предъявляем героическому борцу с пузырями нашу поздравительную картинку (Рис. 14).
Через 3 секунды табличку убираем. Самый простой способ для этого – стартануть
второй таймер:
t2.Start;

200

Рис. 14. Похвала всегда приятна

Он тикнет через 3 секунды, спрячет табличку до следующей победы (целее будет!) и самоостановится:
procedure OnTimer2;
begin
imgWin.Visible := false;
t2.Stop;
end;

Но новая игра не начнётся, пока игрок не нажмёт красную кнопку.

201

Давим пузыри
Чтобы раздавить пузырь, нужно нажать на его пальцем или мышкой. Но на простую картинку давить бесполезно. Как всегда, в таких случаях на помощь приходит
мышка.
В методе Prepare мы назначили событию нажатия на кнопку мышки метод-обработчик:
// метод-обработчик нажатия на кнопку мышки:
OnMouseDown := MouseDown;

В методе MouseDown мы получаем от функции ObjectUnderPoint ссылку на объект, который находится прямиком под мышиной лапкой. Если там пусто, то функция вернёт nil, и мы должны убраться восвояси, поскольку серьёзная программа
не должна обрабатывать щелчки по пустому месту:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;

Но мы должны помнить, что игрок не только давит пузырей, но и нажимает на
кнопку, чтобы инициировать новое побоище. Если тип кликнутого объекта
RoundRectWPF, то мышьёнок стукнул лапкой по кнопке, и программа должна уйти
в метод NewGame:
// кнопка:
if c is RoundRectWPF then begin
NewGame;
exit;
end;

202

Если игра закончена или щелчок пришёлся по невидимой табличке, то мышка
также должна покинуть метод MouseDown:
// игра закончена:
if flgGameOver then exit;
// табличка с поздравлением:
if c.Visible = false then exit;

Все остальные объекты на поле – это пузыри. Если пузырь видимый, то есть цельный, то мы скрываем его, и на сцене с надлежащим звуком появляется лопнутый
пузырь:
// пузырь -->
if c.Visible then begin
c.Visible := false;
// звук лопающегося пузыря:
sp.Play;

Убираем из списка лопнувшего пузыря и проверяем игровую ситуацию в методе
Update:
// уменьшаем число оставшихся пузырей:
bubbleLeft -= 1;
Update;
end;
end;
end;
end.

Теперь вы можете давить пузыри и слушать их лебединую песню (Рис. 15).
О трудной жизни пузырей, лаптей и соломинок смотрите в мультфильме Три дровосека (Рис. 16).

203

Рис. 15. Давление повышается

Рис. 16. Мультик с глубоким смыслом

204

Движение объекта к цели WPFO
В этом проекте наш новый супергерой Квадратик будет собирать игровые объекты на сцене. Вы можете представлять их как вкусняшки для него, а мы просто
нарисуем красные кружочки, которые хорошо видны как нам, так и Квадратику.
Сразу после запуска программы мы создаём первую цель в случайном месте
сцены и сразу отправляем к ней нашего Квадратика:
uses WPFObjects, GraphWPF;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 32;
var
// Квадратик:
rect : SquareWPF;

procedure Draw(ln : LineWPF);
begin
ln.X2 := rect.Center.X;
ln.Y2 := rect.Center.Y;
end;
// СОЗДАЁМ ЦЕЛЬ
procedure CreateTarget(x, y: real; rnd : boolean := false);
begin
var r := 10;
var clr := Colors.Red;
var targetX, targetY : double;
if rnd then begin
targetX := Random(20, GW_WIDTH - 20);
targetY := Random(20, GW_HEIGHT - 20);
205

end
else begin
targetX := x;
targetY := y;
end;
new CircleWPF(targetX, targetY, r, clr);

Для наглядности чертим линию (на самом деле это объект!) за двигающимся
Квадратиком:
var ln := new LineWPF(rect.Center.X, rect.Center.Y,
rect.Center.X, rect.Center.Y,
Colors.Goldenrod);
ln.LineWidth := 4;
rect.AnimMoveTo(targetX-QSIZE/2, targetY-QSIZE/2, 0.5);

Чтобы линия удлинялась вслед за Квадратиком, анимируем этот процесс:
BeginFrameBasedAnimation(() -> Draw(ln));
end;
begin
Prepare;
CreateTarget(0,0,true);
end.

В процедуре Prepare мы назначаем процедуру-обработчик для события нажатия
кнопки мышки и создаём Квадратика:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Движение объекта к цели WPFO ';
Window.Clear(Colors.SeaShell);
OnMouseDown := MouseDown;
206

// Квадратик:
rect := new SquareWPF(CX, CY, 32, Colors.Green);
end;

Следующие цели создаются не случайно, а в местах клика мышки, то есть мы сами
управляем действиями Квадратика:
procedure MouseDown(x,y: real; mb: integer);
begin
EndFrameBasedAnimation;
CreateTarget(x, y);
end;

Рис. 1 показывает Квадратика в действии.

207

Рис. 1. Рождённый ползать ползает быстро

208

Все в сборе WPFO
В этом проекте мы добавим нашему Квадратику толику интеллекта, чтобы он собирал артефакты по всей сцене. Этот процесс можно сравнить с покупкой вкусняшек в разных магазинах.
Как известно, уборочной предшествует посевная, поэтому мы начинаем программу с создания некоторого числа целей. Вполне достаточно десятка:
uses WPFObjects, GraphWPF;
// КЛАСС КООРДИНАТ ТОЧЕК
type Point = auto class
x, y : double;
end;

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 32;
var
// Квадратик:
rect : SquareWPF;
// число целей:
nTargets := 10;

Для покупок Квадратику нужен список целей:
// список целей:
listTargets := new List<Point>();

209

Программа сразу после запуска создаёт цели в случайных местах сцены и отправляет их в список:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Все в сборе WPFO ';
Window.Clear(Colors.SeaShell);
// Квадратик:
rect := new SquareWPF(CX, CY, 32, Colors.Green);
end;

procedure Draw(ln : LineWPF);
begin
Window.Clear(Colors.SeaShell);
ln.X2 := rect.Center.X;
ln.Y2 := rect.Center.Y;
end;
// СОЗДАЁМ ЦЕЛИ
procedure CreateTargets;
begin
var r := 10;
var clr := Colors.Red;
// создаём цели:
loop nTargets do begin
var x := Random(20,
var y := Random(20,
listTargets.Add(new
new CircleWPF(x, y,
end;
end;

GW_WIDTH - 20);
GW_HEIGHT - 20);
Point(x,y));
r, clr);

После создания целей Квадратик отправляется на их собирательство:
// КВАДРАТИК ОБХОДИТ ЦЕЛИ
procedure Собирайка;
begin
210

foreach var p in listTargets do begin
var ln := new LineWPF(rect.Center.X, rect.Center.Y,
rect.Center.X, rect.Center.Y,
Colors.Goldenrod);
ln.LineWidth := 4;
// координаты очередной цели:
var x := p.x;
var y := p.y;
rect.AnimMoveTo(x-QSIZE/2, y-QSIZE/2, 0.6);
BeginFrameBasedAnimation(() -> Draw(ln));
Sleep(800);
EndFrameBasedAnimation;
end;
end;

begin
Prepare;
CreateTargets;
Собирайка;
end.

В процедуре Собирайка Квадратик последовательно получает координаты целей в порядке их создания и отправляется к очередной цели.
Запускаем программу, и наш
Квадратик быстро и аккуратно
собирает все цели на сцене
(Рис. 1).

211

Рис. 1. Не поспешишь – людей не насмешишь

212

Все в сборе 2 WPFO
Поведение нашего Квадратика станет более разумным, если он будет собирать
цели не точно по списку, а каждый раз находить ближайшую цель.
Число целей я увеличил до 20, чтобы напрячь интеллект Квадратика до предела:
// число целей:
var nTargets := 20;

Весь искусственный разум Квадратика мы записали в процедуру Собирайка:
// КВАДРАТИК ОБХОДИТ ЦЕЛИ
procedure Собирайка;
begin
// координаты ближайшей цели:
var xb, yb : double;
var id := -1;

Пока список целей не пустой, мы находим в списке listTargets ближайшую цель:
while listTargets.Count > 0 do begin
var minDist := double.MaxValue;
// координаты Квадратика:
var mx := rect.Center.X;
var my := rect.Center.Y;
// ищем ближайшую цель:
for var i := 0 to listTargets.Count-1 do begin
var p := listTargets[i];
// координаты очередной цели:
var x := p.x;
var y := p.y;

Если очередная цель ближе предыдущих, мы запоминаем квадрат расстояния до
неё, координаты этой цели и её индекс в списке:
213

// дистанция:
var dist := (mx - x) ** 2 + (my - y) ** 2;
if dist < minDist then begin
minDist := dist;
xb := x;
yb := y;
id := i;
end;
end;

Если в списке есть цели, то найдётся и ближайшая к Квадратику. Эту цель мы
удаляем из списка, и список укорачивается на 1 цель. Квадратик отправляется к
выбранной цели, а мы в заголовке окна получаем информацию – сколько целей
собрал Квадратик:
listTargets.RemoveAt(id);
var ln := new LineWPF(rect.Center.X, rect.Center.Y,
rect.Center.X, rect.Center.Y,
Colors.Goldenrod);
ln.LineWidth := 4;
// координаты очередной цели:
var x := xb;
var y := yb;
rect.AnimMoveTo(x-QSIZE/2, y-QSIZE/2, 0.3);
BeginFrameBasedAnimation(() -> Draw(ln));
Sleep(400);
EndFrameBasedAnimation;
Window.Title := $' Все в сборе 2 WPFO --> Найдено целей:
{nTargets - listTargets.Count}';
end;
end;

Запускаем программу и Квадратика. Рис. 1 показывает, что Квадратик ведёт
себя не менее разумно, чем мы, если бы вдруг отправились на сбор целей.

214

Рис. 1. Вполне разумно

215

Свободное падение WPFO
Вплоть до XVII в. учёные были уверены, что скорость падения тел определяется их
весом, то есть тяжёлые предметы падают быстрее лёгких.
Действительно, если мы бросим с одинаковой высоты железную гирю и скомканный кусок бумаги, то убедимся в правоте этого суждения, которое, кстати говоря,
высказал великий учёный древности Аристотель. Его авторитет в научной среде
был настолько велик, что никому и в голову не приходило тщательно проверить
его утверждение экспериментально.
Так как тела движутся в атмосфере Земли, то при падении
на них действует сила сопротивления воздуха, что и приводит к таким результатам. Однако если тела имеют
одинаковую форму, сила сопротивления воздуха будет сопоставима, и падать они будут практически с одинаковой
скоростью.

Так продолжалось более двух тысяч лет, пока итальянский учёный Галилео Галилей не опроверг теорию Аристотеля. Согласно легенде, он одновременно сбрасывал с Пизанской башни тяжёлое пушечное ядро и гораздо более лёгкую мушкетную пулю. Оказалось, что оба предмета одновременно достигали земли, то
есть скорость их падения была одинакова.
На самом деле Галилей провёл свой эксперимент гораздо «хитрее». Ему не пришлось таскать тяжёлые ядра на вершину Пизанской башни. Он просто скатывал
шары по наклонной доске и установил, что время скатывания шаров не зависит от
их массы, причём этот вывод справедлив для разных углов наклона доски, из чего
он и сделал вывод о том, что и при вертикальном падении объекты разной массы
будут падать с одинаковой скоростью.
Более того, он опроверг и другое утверждение Аристотеля - что под воздействием
силы тяжести тела движутся с постоянной скоростью. Его эксперименты показали,
216

что шары катятся с ускорением. Если за первую секунду они прокатятся 1 метр
(естественно, метров в то время ещё не было, но это не имеет значения), то за
две - 4 метра, за три – 9 метров, и так далее, то есть скорость скатывания шаров
увеличивается пропорционально времени.
Мы не будем опровергать красивую легенду, а поднимем Квадратика на высоту
Пизанской башни и сбросим его оттуда. Общая высота башни составляет около 57
метров, но мы проявим квадратиколюбие и сбросим Квадратика с высоты 50
метров (Рис. 1).
Для упрощения физической модели будем считать, что Квадратик падает в безвоздушном пространстве, чтобы не учитывать сопротивление воздуха при падении. Таким образом, наша модель больше годится для Луны, чем для Земли с её
плотной атмосферой.
h – расстояние до поверхности Земли
mg – сила тяжести

Рис. 1. Квадратик в исходном положении

217

В этом случае все тела независимо от их массы должны падать с одинаковым
ускорением, которое в физике принято обозначать буквой g. Его называют ускорением свободного падения. Вблизи поверхности Земли оно равно примерно 9,8
м/с2.
Тогда скорость падения в зависимости от времени можно записать так:
vt = v0 + gt, где
v0 – скорость падения тела в начале эксперимента, то есть на высоте h метров от
поверхности Земли. Мы же собираемся просто выпустить Квадратика из рук, поэтому начальная скорость равна нулю, а уравнение ещё больше упростится:
vt = gt
Путь, пройденный телом при падении, легко рассчитать по формуле:
St = v0t + ½ gt2,
а при v0 = 0:
St = ½ gt2
Итак, в начальный момент времени t = 0 Квадратик находится на расстоянии h
метров от поверхности. Когда Квадратик упадёт на землю, он пролетит S = h метров. Откуда
½ gt2 = h,
а время падения составит
t = √𝟐𝒉/𝒈
Для высоты 50 метров время равно 3,19 секунды.
Модель падения Квадратика готова, и мы приступаем к её компьютерной реализации.
218

Ускорение свободного падения вполне естественно обозначить константой:
uses WPFObjects, GraphWPF;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 32;
// ускорение свободного падения:
g = 9.8;
var
// Квадратик:
rect : SquareWPF;

В процедуре Prepare мы окрашиваем фон небесный цвет, что красиво и правдоподобно:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Свободное падение WPFO ';
Window.Clear(Colors.DeepSkyBlue);
// Квадратик:
rect := new SquareWPF(CX, 20, 32, Colors.Green);
end;

В главном блоке программы вызываем процедуру Fall, в которой и сбрасываем
Квадратика вниз, – но исключительно в научных целях:
begin
Prepare;
Fall;
end.

219

Мы не будем требовать от процедуры Fall точного соблюдения законов физики,
поэтому скорость и время падения Квадратика условны, но правдоподобны:
procedure Fall();
begin
// поверхность земли:
var clr := Colors.SaddleBrown;
var h := GW_HEIGHT - 10;
FillRectangle(0, h, GW_WIDTH, 4, clr);
var h0 := 20;
var t := 0.0;
// приращение времени в секундах:
var dt := 0.05;
// текущая высота Квадратика в метрах:
var n:= 0;
while (True) do begin
// пройденное расстояние:
var s := h0 + g * t ** 2 / 2;
// Квадратик упал на землю:
if (s >= h) then
exit;
// ставим отметки:
if n mod 20 = 0 then
FillCircle(CX, s, 5, Colors.Red);
if s > h - QSIZE then s := h - QSIZE;
// перемещаем Квадратик в новое положение:
rect.AnimMoveTo(CX-QSIZE/2, s, 0.01);
t += dt;
n += 1;
Sleep(10);
end;
end;

В результате физического и физиологического эксперимента Квадратик не пострадал, а мяхко упал на воображаемую землю. Поскольку Квадратик не сиганул
вниз подобно приверженцам банджи-джампинга, а принимал участие в научном
опыте, то по ходу своего падения он отмечал красными точками своё положение

220

через равные промежутки времени. Рис. 2 показывает, что Квадратик не зря потратил время и нервы, - скорость его падения увеличивалась со временем, то есть
Квадратик двигался с ускорением.

Рис. 2. Эксперимент закончен
221

Куда подальше WPFO
Предположим, что мы не просто отпускаем Квадратика в свободное падение, но
и бросаем его с некоторой горизонтальной скоростью vh. Поскольку вертикальная составляющая скорости при этом не изменяется, то время падения Квадратика останется прежним. Но в отсутствие воздуха Квадратик за это время пролетит в горизонтальном направлении vh х t метров, то есть упадёт на расстоянии
vh х t метров от стартовой позиции. При этом Квадратик будет двигаться не по
отвесной прямой, а по нисходящей ветви параболы (Рис. 1).
Если мы не добавим нашему Квадратику жизненного пространства справа, то
она просто улетит за пределы окна и эксперимент получится неполноценным! Поэтому увеличиваем ширину окна, чтобы Квадратик не покинул нас раньше времени:
uses WPFObjects, GraphWPF;
const
// размеры окна:
GW_WIDTH = 740;
GW_HEIGHT =660;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 32;
// ускорение свободного падения:
g = 9.8;
var
// Квадратик:
rect : SquareWPF;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Куда подальше WPFO ';
Window.Clear(Colors.DeepSkyBlue);
222

// Квадратик:
rect := new SquareWPF(CX, 20, 32, Colors.Green);
end;

begin
Prepare;
Fall;
end.

Главный блок программы остался неизменным:
begin
Prepare;
Fall;
end.

А процедуре Fall мы перетаскиваем Квадратика ближе к левому краю окна:
procedure Fall();
begin
// поверхность земли:
var clr := Colors.SaddleBrown;
var h := GW_HEIGHT - 10;
FillRectangle(0, h, GW_WIDTH, 4, clr);
var h0 := 20;
var x0 := 20;
var t := 0.0;
// приращение времени в секундах:
var dt := 0.05;
// текущая высота Квадратика в метрах:
var ht := h0;
var n:= 0;

Горизонтальную скорость Квадратика подбираем так, чтобы он гармонично вписался в оконные габариты:

223

// горизонтальная скорость Квадратика, метров в секунду:
var vh := 62;
while (True) do begin
// пройденное расстояние:
var s := h0 + g * t ** 2 / 2;
// Квадратик упал на землю:
if (s >= h) then
exit;

По горизонтали Квадратик летит с постоянной скоростью, так что вычислить его
удаление от точки старта нетрудно:
// пройденное расстояние по горизонтали:
var dsh := x0 + vh * t;
// ставим отметки:
if n mod 20 = 0 then
FillCircle(dsh, s, 5, Colors.Red);
if s > h - QSIZE then s := h - QSIZE;

Перемещаем Квадратика в обоих направлениях:
// перемещаем Квадратика в новое положение:
rect.AnimMoveTo(dsh, s, 0.01);
t += dt;
n += 1;
Sleep(10);
end;
end;

Пора запускать эксперимент и выпускать Квадратика!
Квадратик изящно падает вниз, оставляя за собой красивый точечный след (Рис. 1).

224

Рис. 1. Падение Квадратика по параболе

225

Метание Квадратика WPFO
Метание кругов и квадратов – старинная спортивная забава, известная нам по скульптуре
Мирона Дискобол. Для круглоты картины Мирон вложил в ладонь дискобола крышку от кастрюли, но мы-то знаем, что метал он вперёд и
вверх не металл, а прапра…прадедушку нашего
Квадратика.
В этом проекте мы поднатужимся и бросим
Квадратика не горизонтально, а под некоторым углом вверх-вправо.
Из прямоугольного треугольника (Рис. 1) мы
легко найдём вертикальную и горизонтальную
составляющие скорости Квадратика в начальный момент времени.
Поскольку теперь Квадратик сначала поднимается вверх, а затем падает вниз с максимальной высоты, то прежняя формула расчёта вертикального пути не годится. Мы будем суммировать отдельные расстояния, которые пролетит Квадратик по вертикали за
время dt:
sv += Abs((vv - g*t) * dt);
принимая во внимание, что текущая вертикальная скорость равна:
vvt = vv - gt
Иначе рассчитываем и текущую высоту Квадратика над поверхностью земли:
y = h0 + g * t ** 2 / 2 - vv * t;

226

Рис. 1. Траектория полета предмета, брошенного под углом к горизонту

Переводим наши теоретические изыскания и изыски на скупой программистский
язык (Рис. 2):
uses WPFObjects, GraphWPF;
const
// размеры окна:
GW_WIDTH = 740;
GW_HEIGHT =660;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 32;
// ускорение свободного падения:
g = 9.8;

227

var
// Квадратик:
rect : SquareWPF;

procedure Fall();
begin
// поверхность земли:
var clr := Colors.SaddleBrown;
var h := GW_HEIGHT - 10;
FillRectangle(0, h, GW_WIDTH, 4, clr);
// начальная высота:
var h0 := 260;
// начальная скорость Квадратика, метров в секунду:
var v0 := 75;
// отступ слева:
var x0 := 20;
var t := 0.0;
// приращение времени в секундах:
var dt := 0.05;
var n:= 0;
// путь по вертикали:
var sv := 0.0;
// угол броска в градусах:
var alpha := DegToRad(60);
// горизонтальная скорость Квадратика, метров в секунду:
var vh := v0 * Cos(alpha);
// начальная вертикальная скорость Квадратика, м/c:
var vv := v0 * Sin(alpha);
while (True) do begin
// текущая высота:
var y := h0 + g * t**2/2 - vv * t;
sv += Abs((vv - g*t) * dt);
// Квадратик упал на землю:
if (y >= h) then
exit;
// пройденное расстояние по горизонтали:
var dsh := x0 + vh * t;
// ставим отметки:
if n mod 20 = 0 then
228

FillCircle(dsh+rect.Width/2, y+rect.Height/2, 5, Colors.Red);
if y > h - QSIZE then y := h - QSIZE;
// перемещаем Квадратика в новое положение:
rect.AnimMoveTo(dsh, y, 0.01);
t += dt;
n += 1;
Sleep(10);
end;
end;

procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Метание Квадратика WPFO ';
Window.Clear(Colors.DeepSkyBlue);
// Квадратик:
rect := new SquareWPF(CX, 20, 32, Colors.Green);
end;

begin
Prepare;
Fall;
end.

229

Рис. 2. Наглядное квадратикометание

230

Тянем-потянем WPFO

Грузчик, грузчик – парень работящий…
Команда КВН Станция Спортивная

Во многих программах игровые объекты перетаскиваются мышкой. Для этого
нужно нажать кнопку мышки, когда она находится над объектом, переместить
объект мышкой в новое положение и, наконец, отпустить кнопку мышки и объект
вместе с ней.
Игровым объектом в этой программе мы опять назначим Квадратика:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// строна квадрата:
QSIZE = 100;
var
// Квадратик:
rect : SquareWPF;

231

Также нам нужно запомнить расстояние между центром объекта и курсором
мышки в момент нажатия кнопки, иначе Квадратик сразу прыгнет своим центром
в горячую точку курсора:
// смещение от центра:
offset : Point;

Флажок flgDrag сообщает программе, что объект перетаскивается мышкой:
// флаг перемещения Квадратика:
flgDrag := false;

В процедуре Prepare мы создаём повзрослевшего Квадратика зелёного цвета и
назначаем мышиным событиям соответствующие процедуры-обработчики:
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Тянем-потянем WPFO ';
Window.Clear(Colors.SeaShell);
// мышиные обработчики:
OnMouseDown := MouseDown;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
// Квадратик:
rect := new SquareWPF(CX, CY, QSIZE, Colors.Green);
end;

begin
Prepare;
end.

232

Когда пользователь мышки нажимает её кнопку в окне программы, возникает событие OnMouseDown, которое мы обрабатываем в процедуре MouseDown. Функция ObjectUnderPoint возвращает ссылку на нажатый объект или nil, если кнопка
нажата на пустом месте:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
var c := ObjectUnderPoint(x,y);

Нас интересует только Квадратик, то есть объект rect. Если это не так (в этой программе иначе быть не может, но в других такая проверка обязательна), то мышка
выходит из процедуры MouseDown с пустыми лапками:
// мимо:
if (c <> rect) then exit;

Если мышка подхватила Квадратика, то мы запоминаем расстояние от курсора
до центра Квадратика, поднимаем флажок flgDrag и опоясываем Квадратика коричневой лентой:
// Квадратик -->
offset := Pnt(c.Center.X - x, c.Center.Y-y);
rect.SetBorder(4, Colors.Brown);
flgDrag := true;
end;

При перемещении мышки возникает событие OnMouseMove, которое мы обрабатываем в процедуре
MouseMove. Это событие возникает, даже если мышка
не тащит за собой Квадратика, и тогда ничего делать
не нужно:

233

// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
if not flgDrag then exit;

Вычисляем новые координаты для Квадратика:
// перемещаем Квадратик в новое положение:
var nx := x + offset.X - QSIZE/2;
var ny := y + offset.Y - QSIZE/2;

И он анимировано следует за мышкой:
rect.AnimMoveTo(nx, ny, 0.01);

Можно обойтись и без анимации, чтобы Квадратик без промедлений и задержек
следовал за мышкой:
//
var nx := x + offset.X;
//
var ny := y + offset.Y;
//
rect.Center := Pnt(nx,ny);
end;

Усталость берёт своё, и мышка отпускает Квадратика на свободу. В программе
возникает событие OnMouseUp, и в процедуре MouseUp мы опускаем флажок
flgDrag и отбираем коричневую ленточку у Квадратика:
// ОТПУСКАЕМ КНОПКУ МЫШКИ
procedure MouseUp(x,y: real; mb: integer);
begin
flgDrag := false;
rect.SetBorder(0);
end;

234

Здесь не обязательно делать проверку, перетаскивает ли мышка Квадратика.
Анимацию в книге не покажешь, но теперь вы можете таскать Квадратика в разные стороны по своему желанию (Рис. 1).

Рис. 1. Следуй за мышкой

235

Тянем-потянем 2 WPFO
Чаще в игре участвуют несколько объектов разного типа. В этом проекте мы создадим по паре Квадратиков и Кружочков:
uses WPFObjects;
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_HEIGHT div 2;
// сторона квадрата:
QSIZE = 100;
// радиус круга:
R = QSIZE div 2;
var
// Квадратики:
rect1, rect2 : SquareWPF;
// Кружочки:
circ1, circ2 : CircleWPF;
// смещение от центра:
offset : Point;

Ссылку на перемещаемый объект мы запишем в переменную dragobj типа
BoundedObjectWPF, которому наследуют квадраты и круги:
// перемещаемый объект:
dragobj : BoundedObjectWPF := nil;

В процедуре Prepare мы создаём подвижных героев нашей программы. Квадратики красим в зелёный цвет, а Кружочки – в оранжевый и слегка разбрасываем их
по сцене, чтобы они излишне не толпились в центре:
procedure Prepare;
236

begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := ' Тянем-потянем WPFO ';
Window.Clear(Colors.SeaShell);
// мышиные обработчики:
OnMouseDown := MouseDown;
OnMouseMove := MouseMove;
OnMouseUp := MouseUp;
// создаём Квадратики:
rect1 := new SquareWPF(CX-100, CY-100, QSIZE, Colors.Green);
rect2 := new SquareWPF(CX+100, CY-100, QSIZE, Colors.Green);
// и Кружочки:
circ1 := new CircleWPF(CX-100, CY+100, R, Colors.DarkOrange);
circ2 := new CircleWPF(CX+100, CY+100, R, Colors.DarkOrange);
end;

begin
Prepare;
end.

Функция ObjectUnderPoint возвращает ссылку на тип Object, поэтому дополнительно нужно привести перемещаемый объект dragobj к типу BoundedObjectWPF,
иначе у него не появятся нужные нам свойства:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
var c := ObjectUnderPoint(x,y);
// мимо:
if (c = nil) then exit;
dragobj := BoundedObjectWPF(c);
offset := Pnt(dragobj.Center.X - x, dragobj.Center.Y-y);
dragobj.SetBorder(4, Colors.Brown);
dragobj.ToFront;
end;

В процедуре MouseMove перемещаемый объект следует за мышкой:
237

// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
if (dragobj = nil) then exit;
// перемещаем объект в новое положение:
var nx := x + offset.X - QSIZE/2;
var ny := y + offset.Y - QSIZE/2;
dragobj.AnimMoveTo(nx, ny, 0.01);
end;

При отпускании кнопки мышки перемещаемый объект теряет контур и ссылку:
// ОТПУСКАЕМ КНОПКУ МЫШКИ
procedure MouseUp(x,y: real; mb: integer);
begin
if (dragobj = nil) then exit;
dragobj.SetBorder(0);
dragobj := nil;
end;

Теперь мышка может таскать кого угодно и
сколько влезет (Рис. 1).

238

Рис. 1. Есть выбор!

239

Круговые столкновения WPFO
Если центр окружности поместить в начало координат, то её уравнение будет
очень простым:

x2 + y2 = R2
Причём равенству удовлетворяют точки самой окружности. На Рис. 1 это точка 1.
Расстояние от этой точки до начала координат равно радиусу R окружности. Если
точка находится внутри окружности (точка 2), то расстояние (d2) от неё до начала
координат меньше радиуса. Если точка расположена вне окружности (точка 3), то
расстояние (d3) больше радиуса.

Рис. 1. Круглая наука

Эти утверждения легко доказываются с помощью теоремы
Пифагора.
240

Если перенести центр окружности в произвольную точку (xc, yc), то уравнение
окружности слегка усугубится:

(x – xc)2 + (y – yc)2 = R2
Но на Рис. 2 видно, что положение точек 1, 2 и 3 относительно центра окружности
при этом не изменяется, то есть все наши выводы применимы и к общему случаю.

Рис. 2. Всё под контролем

Расстояние между центром окружности и заданной точкой (x, y) легко найти по
теореме Пифагора.
При любом перемещении мышки возникает событие OnMouseMove, и программа
переходит в процедуру MouseMove. Сейчас нам нужно просто определить, находится ли горячая точка курсора в круге. Координаты центра круга нам известны:
// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
241

var xc := circ1.Center.X;
var yc := circ1.Center.Y;

Находим расстояния между центром круга и курсором:
// мышка в круге?
var dx := x - xc;
var dy := y - yc;

По теореме Пифагора определяем, находится ли курсор в круге. Извлекать квадратные корни не нужно, поскольку нам достаточно сравнить сумму квадратов катетов с квадратом гипотенузы. Если это так, то перекрашиваем круг в красный
цвет:
if (dx * dx + dy * dy <= r*r) then
circ1.Color := Colors.Red
else circ1.Color := Colors.DarkOrange;
end;

На Рис. 3 показана ситуация, когда курсор попал в объятия Кружочка.
В компьютерных играх часто нужно определять столкновения (коллизии) героев
между собой и с окружающими их предметами. Обычно и те, и другие имеют
сложную форму, так что установление факта пересечения таких фигур становится
трудной задачей. Поэтому фигуры при расчётах заменяют кругами или прямоугольниками, которые приблизительно описывают форму игровых объектов.
В нашем случае «персонажи» уже имеют простую круглую форму, так что давайте
определять, какие круги пересекаются друг с другом при их перемещении.
Функция ObjectsIntersect проверяет, пересекаются ли 2 заданных объекта:
function ObjectsIntersect (ob1, ob2 : ObjectWPF): boolean;

242

Рис. 3. Цепкие лапки

243

Если объекты пересекаются, то функция возвращает true. В противном случае –
false.
Пишем новую версию процедуры MouseMove. Если при перемещении любого
круга он столкнётся с другим кругом, то функция ObjectsIntersect вернёт true, и мы
перекрасим оба круга в красный цвет:
// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
if (dragobj = nil) then exit;
// перемещаем объект в новое положение:
var nx := x + offset.X - QSIZE/2;
var ny := y + offset.Y - QSIZE/2;
dragobj.AnimMoveTo(nx, ny, 0.01);
if ObjectsIntersect(circ1, circ2) then begin
circ1.Color := Colors.Red;
circ2.Color := Colors.Red;
end

Если круги не пересекаются, то мы возвращаем им оригинальный цвет:
else begin
circ1.Color := Colors.DarkOrange;
circ2.Color := Colors.DarkOrange;
end;
end;

На Рис. 4 видно, что эта функция действует верно.
Метод Intersects проверяет, пересекается ли данный объект с другим объектом:
function Intersects(ob : ObjectWPF): boolean;

244

Если объекты пересекаются, то функция возвращает true. В противном случае –
false.

Рис. 4. Если круг оказался вкруг…

Проверка показывает, что этот метод также успешно распознаёт столкновения
кругов:
//if ObjectsIntersect(circ1, circ2) then begin
if circ1.Intersects(circ2) then begin
circ1.Color := Colors.Red;
circ2.Color := Colors.Red;
end
else begin
circ1.Color := Colors.DarkOrange;
circ2.Color := Colors.DarkOrange;
end;

245

Мы сможем и самостоятельно определить, какие круги пересекаются друг с другом при их перемещении, тем более что это совсем нетрудно.
Если мы знаем координаты их центров (x1,y1), (x2,y2) и радиусы R1 и R2, то известным со времён Пифагора способом находим расстояние (distance) между их
центрами и сравниваем его с суммой радиусов.
Если distance > R1 + R2, то окружности не пересекаются (Рис. 5).

Рис. 5. Далековато

Если distance = R1 + R2, то окружности соприкасаются (Рис. 6).

Рис. 6. Нежное касание
246

И наконец, если distance < R1 + R2, то окружности пересекаются (сталкиваются)
(Рис. 7).

Рис. 7. ДТП

Для удобства можно возвести в квадрат левую и правую
части (не)равенства.

В процедуре MouseMove вызываем функцию OverlapCircle:
//if ObjectsIntersect(circ1, circ2) then begin
//if circ1.Intersects(circ2) then begin
if OverlapCircle then begin
circ1.Color := Colors.Red;
circ2.Color := Colors.Red;
end
else begin
circ1.Color := Colors.DarkOrange;
circ2.Color := Colors.DarkOrange;
end;

Функция OverlapCircle очень простая:
function OverlapCircle : boolean;
247

begin
// координаты центра первого круга:
var xc1 := circ1.Center.X;
var yc1 := circ1.Center.Y;
// координаты центра второго круга:
var xc2 := circ2.Center.X;
var yc2 := circ2.Center.Y;
var dx := xc1 - xc2;
var dy := yc1 - yc2;
var mindist := R + R;
Result := (dx * dx + dy * dy <= mindist*mindist);
end;

В нашей программе круги имеют одинаковый радиус, равный R. Остальные вычисления прямо вытекают из теоремы Пифагора.

Квадратные столкновения WPFO
В этом проекте мы рассмотрим столкновения прямоугольников, которые у нас –
исключительно для небольшого упрощения программы - выродились в квадраты.
Как обычно, начнём с теории.
Проведём вертикальную прямую через левую сторону прямоугольника (Рис. 1).
Очевидно, что все точки прямоугольника лежат либо на этой линии, либо правее,
то есть их координаты x >= r.X.
Повторяем операцию на правом фланге (Рис. 2).
Хорошо видно, что все точки прямоугольника лежат на линии r.x + r.Width и левее.
Это значит, что их координаты x <= r.X + r.Width.
Рассуждая аналогично и дальше, мы придём к ситуации, показанной на Рис. 3.
248

Рис. 1. Левая граница

Рис. 2. Правая граница

249

Рис. 3. Взяли в клещи

Теперь превращаем теорию в практику и пишем процедуру MouseMove:
// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
// мышка в квадрате?
var res := x.Between(rect1.Left, rect1.Right) and
y.Between(rect1.Top, rect1.Bottom);
if res then
rect1.Color := Colors.Red
else rect1.Color := Colors.Green;
end;

Полевые же испытания показали добротность нашей техники квадратного программирования (Рис. 4)!

250

Рис. 4. Теория на практике

Сначала мы напишем собственную функцию для определения столкновения прямоугольников:
251

// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
// мышка в квадрате?
//
var res := x.Between(rect1.Left, rect1.Right) and
//
y.Between(rect1.Top, rect1.Bottom);
//
//
if res then
//
rect1.Color := Colors.Red
//
else rect1.Color := Colors.Green;
if (dragobj = nil) then exit;
// перемещаем объект в новое положение:
var nx := x + offset.X - QSIZE/2;
var ny := y + offset.Y - QSIZE/2;
dragobj.AnimMoveTo(nx, ny, 0.01);
//if ObjectsIntersect(rect1, rect2) then begin
//if rect1.Intersects(rect2) then begin
if OverlapRects then begin
rect1.Color := Colors.Red;
rect2.Color := Colors.Red;
end
else begin
rect1.Color := Colors.Green;
rect2.Color := Colors.Green;
end;
end;

252

Рис. 5. Самостоятельная работа

Если вам лень изобретать велосипед,
ObjectsIntersect или методом Intersects.

просто

пользуйтесь

функцией

Квадратно-круговые столкновения WPFO
Определить столкновения объектов разной формы уже не так просто, поэтому мы
воспользуемся в этом проекте методом IntersectionList. Он возвращает список
объектов, с которым пересекается заданный объект.
// ПЕРЕМЕЩАЕМ МЫШКУ
procedure MouseMove(x,y: real; mb: integer);
begin
if (dragobj = nil) then exit;
// перемещаем объект в новое положение:
253

var nx := x + offset.X - QSIZE/2;
var ny := y + offset.Y - QSIZE/2;
dragobj.AnimMoveTo(nx, ny, 0.01);

Но предварительно мы возвращаем всем объектам оригинальный цвет:
foreach var o in Objects do begin
var bo := BoundedObjectWPF(o);
if bo is SquareWPF then bo.Color := Colors.Green
else bo.Color := Colors.DarkOrange;
end;

Затем все объекты в списке lstO перекрашиваем в красный цвет:
var lstO := dragobj.IntersectionList;
foreach var o in lstO do begin
var bo := BoundedObjectWPF(o);
bo.Color := Colors.Red;
end;

Перемещаемый объект сам с собой не пересекается, поэтому в список lstO не попадает. Перекрашиваем его в красный цвет самостоятельно:
if lstO.Count > 0 then
dragobj.Color := Colors.Red;
end;

Проверяем работу программы в деле.
Все объекты окрашиваются и перекрашиваются дружно и великолепно (Рис.
1).

254

Рис. 1. Функция функционирует

Лабиринт WPFO
Лабиринт – дело хорошее, но запутанное. Для бродяжничества по
Лабиринту нужен супергерой, то есть Супер-Марио.
Он охотно и ловко ползает и лазает, поэтому в этом проекте мы запустим его в настоящий Лабиринт! Наша задача – построить Лабиринт
надлежащих размеров, запустить туда Марио и водить его по запутанным коридорам до самого финиша. При большом желании вы можете научить Марио самостоятельно выбираться из Лабиринта, добавить к программе звуковые и прочие эффекты, но это уже слишком далеко от
темы этой скромной книги.
Начнём издалека – с главного блока программы:
255

uses Game;
{$apptype windows}
begin
var game := new Labyrinth;
game.Prepare;
// создаём Лабиринт:
game.MakeLabyrinth;
end.

Как и водится, игровая программа состоит из двух файлов - Лабиринт WPFO.pas
и Game.pas. Структура проекта очень простая (Рис. 1).

Рис. 1. Всё гениально

В методе Prepare создаём окно программы:
unit Game;
uses WPFObjects, GraphWPF;

const
// размеры окна:
GW_WIDTH = 800;
GW_HEIGHT =640;
// заголовок окна программы:
TITLE = ' Лабиринт ';
// КЛАСС ИГРЫ
type
Labyrinth = class
// ГОТОВИМСЯ К ИГРЕ
procedure Prepare;
begin
256

Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := TITLE;
Window.Clear(Colors.DarkGreen);

Поскольку Лабиринт двумерный, то вполне разумно описать его двумерным массивом. Тип элементов массива может быть самым простым:
var
// лабиринт:
Lab : array [,] of integer;
// массив Лабиринта:
Lab := new integer[nCol, nRow];

Размеры Лабиринта в клетках хранятся в глобальных переменных:
// размеры Лабиринта в клетках по умолчанию:
nCol := 49;
nRow := 39;

Для ручного управления нашим героем нам нужна соответствующий метод:
// назначаем процедуру для обработки
// события нажатия на клавишу:
OnKeyDown := KeyDown;

Марио должен появиться в левом верхнем углу Лабиринта (Рис. 2). Эта его стартовая позиция отмечена красным цветом. Выход из Лабиринта находится в правом нижнем углу. Финишная клетка окрашена в зелёный цвет. Важно отметить,
что Лабиринт со всех сторон окружён непроходимой стеной, так что покинуть его
без динамита невозможно. Стены выкрашены в коричневый цвет, а проходы/коридоры – в белый. Наш Марио не настолько пробивной, чтобы проходить сквозь
стены, поэтому должен передвигаться строго по белым клеткам.

257

Рис. 2. На старт!

Марио – это настоящий герой и просто картинка:
// герой:
mario : PictureWPF;

Которую мы загружаем с диска:
// текущие координаты Марио:
colMario := 1;
258

rowMario := 1;
var p := GetXY(colMario, rowMario);
mario := new PictureWPF(p.x,p.y,'Images/super-mario16.png');

Марио оставляет за собой след в виде зелёной полупрозрачной линии, чтобы мы
могли оценить его плутания и заблуждения в лабиринте:
Pen.Color :=
Pen.Width :=
Pen.RoundCap
MoveTo(p.x +
end;

Color.FromArgb(200,0,255,0);
8;
:= true;
mario.Width/2,p.y + mario.Height/2);

При каждом запуске программы создаётся новый Лабиринт, так что вы можете
гонять Марио вечно. За случайность у нас отвечает переменная rand:
// генератор псевдослучайных чисел:
var rand := new Random;

Построение Лабиринта начинается с расстановки стен и пустых клеток:
// СОЗДАЁМ НОВЫЙ ЛАБИРИНТ
procedure MakeLabyrinth();
begin
// всего пустых клеток в Лабиринте:
var EmptyCells := 0;
for var row := 0 to nRow-1 do
for var col := 0 to nCol-1 do begin
Lab[col,row] := WALL;
if (col*row mod 2 = 1) then begin
Lab[col,row] := EMPTY;
EmptyCells += 1;
end;
end;

259

Статус клеток мы обозначили константами:
// клетки в Лабиринте -->
// пустая клетка в лабиринте:
const EMPTY = 0;
// свободная клетка (проход, коридор):
const FREE = 1;
// стена:
const WALL = 15;

После первого этапа строительства Лабиринт совершенно непроходим (Рис. 3).
Теперь мы должны пробить проходы между соседними клетками так, чтобы получился Лабиринт, из которого можно выбраться. Для этого есть много алгоритмов, но нам достаточно самого простого алгоритма со стеком.
Построение Лабиринта можно начинать с любой пустой клетки, потому что все
свободные клетки будут связаны друг с другом проходами.
Для разнообразия мы выбираем случайную пустую клетку и объявляем её свободной:
// алгоритм построения лабиринта DFS
// ---------------------------------// старт - в верхнем левом углу:
var col := 1;
var row := 1;
// старт в произвольной клетке:
repeat
col := rand.Next(nCol-1) + 1;
row := rand.Next(nRow-1) + 1;
until (col * row mod 2 = 1);
Lab[col,row] := FREE;
DrawLabyrinth;

На экране свободные клетки окрашены в белый цвет (Рис. 4). Только по таким
клеткам может гордо ходить Марио.
260

Рис. 3. Выхода нет…

Для алгоритма нужен стек:
// очищаем стек:
var st := new System.Collections.Stack();

Кладём на стек первую свободную клетку:
// добавляем в него первую клетку:
261

st.Push(col*1000+row);
// число готовых клеток:
var nDone := 1;

Рис. 4. Проходная клетка

Чтобы не мудрить со структурами данных, мы считаем, что на стеке лежат целые
числа, поэтому упаковываем 2 координаты клетки в одно число.

262

Сейчас мы находимся в свободной клетке, и хотим пробить стену в соседнюю пустую клетку. Для этого мы ищем возможные направления для продолжения прохода. Все направления запоминаем в массиве Direction:
// направления из текущей клетки:
var Direction := new integer[5];
// пробиваем проходы между пустыми клетками:
while (nDone < EmptyCells) do begin
// считаем стены возле текущей клетки,
// после которых есть ещё не посещённая клетка -->
var cr := integer(st.Peek());
// число стен:
var nWall := 0;
// сверху:
col := cr div 1000;
row := cr mod 1000 - 1;
if (row > 1) and
(Lab[col,row] = WALL) and
(Lab[col, (row-1)] = EMPTY) then begin
nWall += 1;
Direction[nWall] := NORTH;
end;
// справа:
col := cr div 1000 + 1;
row := cr mod 1000;
if (col < nCol-2) and
(Lab[col,row] = WALL) and
(Lab[col+1, row] = EMPTY) then begin
nWall += 1;
Direction[nWall] := EAST;
end;
// снизу:
col := cr div 1000;
row := cr mod 1000 + 1;
if (row < nRow-2) and
(Lab[col,row] = WALL) and
(Lab[col,(row+1)] = EMPTY) then begin
nWall += 1;
Direction[nWall] := SOUTH;
end;
263

// слева:
col := cr div 1000 - 1;
row := cr mod 1000;
if (col > 1) and
(Lab[col,row] = WALL) and
(Lab[col-1,row] = EMPTY) then begin
nWall += 1;
Direction[nWall] := WEST;
end;

Направления движения в Лабиринте обозначаем константами:
// направления движения в Лабиринте:
const NORTH = 0;
const EAST = 1;
const SOUTH = 2;
const WEST = 3;

Если у свободной клетки есть стены, а за ними свободная клетка, то мы выбираем
случайное направление:
// есть стены:
if (nWall > 0) then begin
nDone += 1;
// выбираем случайное направление:
var rndDir := rand.Next(nWall)+1;

В зависимости от выбранного направления мы пробиваем стену. Клетка с бывшей
стеной и следующая за ней пустая клетка становятся свободными:
// идём наверх:
if (Direction[rndDir] = NORTH) then begin
col := cr div 1000;
row := cr mod 1000 - 1;
Lab[col,row] := FREE;
Lab[col,(row-1)] := FREE;
DrawCell(col,row, FREE_COLOR);
264

DrawCell(col,row-1,FREE_COLOR);

Мы закрашиваем их белым цветом и запоминаем координаты второй из новых
свободных клеток на стеке, чтобы потом идти из неё дальше:
st.Push(col*1000 + row-1);
end
// идём направо:
else if (Direction[rndDir] = EAST) then begin
col := cr div 1000 + 1;
row := cr mod 1000;
Lab[col,row] := FREE;
Lab[col+1,row] := FREE;
DrawCell(col,row,FREE_COLOR);
DrawCell(col+1,row,FREE_COLOR);
st.Push((col+1)*1000 + row);
end
// идём вниз:
else if (Direction[rndDir] = SOUTH) then begin
col := cr div 1000;
row := cr mod 1000 + 1;
Lab[col,row] := FREE;
Lab[col, row+1] := FREE;
DrawCell(col,row, FREE_COLOR);
DrawCell(col,row+1, FREE_COLOR);
st.Push(col*1000 + row+1);
end
// идём влево:
else begin
col := cr div 1000 - 1;
row := cr mod 1000;
Lab[col,row] := FREE;
Lab[col-1,row] := FREE;
DrawCell(col,row, FREE_COLOR);
DrawCell(col-1,row, FREE_COLOR);
st.Push((col-1)*1000 + row);
end
end

265

Если у текущей свободной клетки нет стен, то мы извлекаем из стека предпоследнюю свободную клетку, чтобы попытаться продвинуться из неё дальше:
// нет стен:
else
st.Pop();
end; // end Loop

Рано или поздно все пустые клетки превратятся в свободные, и на этом построение Лабиринта закончится:
DrawCell(1,1, Colors.Red);
DrawCell(nCol-2,nRow-2, Colors.Lime);
end;

К этому времени весь Лабиринт уже должен быть нарисован на экране, и мы
программируем этот процесс.
Весь Лабиринт состоит из клеток. Очень удобно рисовать каждую клетку в отдельной процедуре DrawCell:
// РИСУЕМ ОДНУ КЛЕТКУ
procedure DrawCell(col, row: integer; clr: Color);
begin
// col, row - координаты клетки в Лабиринте
// сlr - её цвет
// координаты верхнего левого угла клетки:
var pos := GetXY(col, row);
var x := pos.x;
var y := pos.y;
FillRectangle(x, y, CELL_WIDTH, CELL_HEIGHT, clr);
end;

Опять же для удобства координаты каждой клетки вычисляем в отдельной процедуре GetXY:
266

// ВОЗВРАЩАЕТ ПИКСЕЛЬНЫЕ КООРДИНАТЫ КЛЕТКИ
function GetXY(col, row: integer) : Point;
begin
var offsetX := (GW_WIDTH - (nCol+1) * CELL_WIDTH) / 2;
var offsetY := (GW_HEIGHT - (nRow+1) * CELL_HEIGHT) / 2;
// координаты верхнего левого угла клетки:
var xPosition := offsetX + CELL_WIDTH div 2 + CELL_WIDTH * col;
var yPosition := offsetY + CELL_HEIGHT div 2 + CELL_HEIGHT * row;
Result := new Point(xPosition, yPosition);
end;

Размеры и цвета клеток храним в константах:
// размеры клеток:
CELL_WIDTH = 16;
CELL_HEIGHT = 16;
// цвета клеток -->
// цвет стен:
WALL_COLOR = Colors.Brown;
//цвет проходов:
FREE_COLOR = Colors.White;
//цвет пустых клеток:
EMPTY_COLOR = Colors.Yellow;

Теперь мы без труда нарисуем и весь Лабиринт целиком:
// РИСУЕМ ЛАБИРИНТ НА ЭКРАНЕ
procedure DrawLabyrinth();
begin
// число клеток в Лабиринте:
var nCell := nRow*nCol;
for var i := 0 to nCell-1 do begin
var row := i div nCol;
var col := i - row * nCol;
if (Lab[col, row] = WALL) then
DrawCell(col, row, WALL_COLOR)
else if (Lab[col, row] = FREE) then
DrawCell(col, row, FREE_COLOR)
267

else if (Lab[col, row] = EMPTY) then
DrawCell(col, row,EMPTY_COLOR);
end;
end;

Лабиринт готов к эксплуатации, а Марио занял своё место на старте. Теперь пришёл наш черёд нажимать клавиши со стрелками:
// НАЖИМАЕМ КЛАВИШУ
procedure KeyDown(k : Key);
begin
case k of
Key.Right: MoveRight;
Key.Left: MoveLeft;
Key.Up: MoveUp;
Key.Down: MoveDown;
end;
end;

Параметр k хранит данные о последней нажатой клавише. Клавиши со стрелками
имеют вполне понятные названия и вызывают вполне понятные методы.
В этих методах мы, в первую очередь, проверяем, допустим ли правилами игры
ход в указанном направлении. Если Марио уже упёрся в стену, то он так и останется на своём месте:
// ХОД ИГРОКА
procedure MoveRight;
begin
var newCol := colMario + 1;
if Lab[newCol, rowMario] = WALL then exit;

Если Марио может дать ходу, то мы вычисляем его новые координаты и отсылаем
его куда поближе:
procedure MoveLeft;
268

begin
var newCol := colMario - 1;
if Lab[newCol, rowMario] = WALL then exit;
colMario := newCol;
var xy := GetXY(colMario, rowMario);
//
mario.Left := xy.X;
//
mario.Top := xy.Y;
mario.AnimMoveTo(xy.X, xy.Y, 1);
LineTo(xy.X + mario.Width/2, xy.Y + mario.Height/2);

После каждого хода Марио проверяем, не закончилась ли игра:
IsGameOver;
end;

procedure MoveUp;
begin
var newRow := rowMario - 1;
if Lab[colMario, newRow] = WALL then exit;
rowMario := newRow;
var xy := GetXY(colMario, rowMario);
mario.AnimMoveTo(xy.X, xy.Y, 1);
LineTo(xy.X + mario.Width/2, xy.Y + mario.Height/2);
IsGameOver;
end;
procedure MoveDown;
begin
var newRow := rowMario + 1;
if Lab[colMario, newRow] = WALL then exit;
rowMario := newRow;
var xy := GetXY(colMario, rowMario);
mario.AnimMoveTo(xy.X, xy.Y, 1);
LineTo(xy.X + mario.Width/2, xy.Y + mario.Height/2);
IsGameOver;
end;

269

Наша незамысловатая игра заканчивается в единственном случае – когда Марио
доберётся до финишной клетки в правом нижнем углу Лабиринта:
// ПРОВЕРЯЕМ, НЕ ЗАКОНЧИЛАСЬ ЛИ ИГРА
procedure IsGameOver();
begin
if (colMario = nCol - 2) and (rowMario = nRow - 2) then
MessageBox.Show(' ИГРА ЗАКОНЧЕНА! ',' Лабиринт ');
end;

В отличие от Марио мы видим весь Лабиринт полностью с высоты человеческого
взора и разума, поэтому блуждания по Лабиринту ограничиваются только нашей
наблюдательностью и прозорливостью. Конечно и естественно, каждый любитель прекрасного и программирования, добравшийся вместе с Марио до финиша,
тот ещё проходимец в Лабиринте (Рис. 5).

270

Рис. 5. ПОБЕДА БУДЕТ ЗА НАМИ!

271

Лабиринт 2 WPFO
До сих пор Марио беспечно и беззаботно фланировал по Лабиринту, а это
нельзя. Исходя из лучших побуждений, мы запрём Лабиринт на амбарный замок,
который можно отпереть только таким ключом (Рис. 1).

Рис. 1. Золотой ключик

Добавляем к программе несколько переменных:
// ключ:
ключ : PictureWPF;
// координаты ключа:
colKey, rowKey : integer;
// флаг ключа:
flgkey := false;

Метод Prepare дополняем «ключевыми» операторами:
// ключ в произвольной клетке:
repeat
colKey := rand.Next(nCol-10) + 1;
rowKey := rand.Next(nRow-10) + 1;
until (colKey * rowKey mod 2 = 1);
p := GetXY(colKey, rowKey);
ключ := new PictureWPF(p.x,p.y,'Images/key16.png');
end;

Без ключа Марио не выберется из Лабиринта, поэтому он, прежде всего, должен
до него добраться (Рис. 2).
272

Рис. 2. Бегом за ключом!

Здесь он берёт ключ в охапку (Рис. 3):
// ПРОВЕРЯЕМ, НЕ ЗАКОНЧИЛАСЬ ЛИ ИГРА
procedure IsGameOver();
begin
// ключ:
if (not flgkey) and
(colMario = colKey) and (rowMario = rowKey) then begin);
mario.AddChild(ключ);
273

flgkey := true;
end;
if flgkey and (colMario = nCol - 2) and (rowMario = nRow - 2) then
MessageBox.Show(' ИГРА ЗАКОНЧЕНА! ',' Лабиринт ');
end;

Рис. 3. А вот и ключик

И смело, бодрым шагом устремляется к выходу из Лабиринта.

274

Достигнув выхода из Лабиринта, Марио вонзает ключ в замочную скважину, и
оттуда вырывается свежий воздух свободы (Рис. 4)!

Рис. 4. На выход

Развивая эту ключевую идею, мы должны возложить на Марио повышенные обязательства, то есть полный сбор связки ключей. Но эту негуманную экзекуцию мы
оставим для следующих бродячих проектов.

275

Стек WPFO
Стек – это стопка горшков или других предметов. Для более полного знакомства
с работой стека посмотрите комедию Операция Ы, где Трус берёт нижний горшок
из стека (Рис. 1).

Рис. 1. Горшечный стек

Верхние горшки с шумом и грохотом падают оземь, что предупреждает нас о том,
что горшки следует брать сверху вниз, но никак не наоборот.
В нашей программе мы обойдёмся без горшков и без лишнего шума. Горшки мы
заменим кругами (Рис. 2), а шум – ненавязчивыми информационными звуками.
Круги мы нарисуем сами, надписи – тоже, а фон надобно отыскать по своему вкусу
и разумению. Желательно тёмный и таинственный (Рис. 3).
Я обкорнал его по размерам окна программы, чтобы ничего не торчало из него
наружу.

276

Рис. 2. Обойдёмся без сантехники

277

Рис. 3. Ай, фон – не айфон!

Все игровые программы мы пишем как проекты, чтобы избежать мешанины файлов разных типов в папке с программами.
Главный файл программы очень простой:
278

uses Game;
{$apptype windows}
begin
var game := new StackGame;
game.Prepare;
end.

В игровом файле добавляем модули и пространства имён:
unit Game;
uses WPFObjects, GraphWPF, System.Media, Timers;

Объявляем и определяем константы и переменные:
const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_WIDTH div 2;
// заголовок окна программы:
TITLE = ' Стек WPFO ';
// фоновая картинка:
BACK = 'Images/imgBack.jpg';
// число кругов:
NUM_CIRCLES = 100;
var
// список кругов:
lstC := new List<CircleWPF>();
// проигрыватели:
sp : SoundPlayer := new SoundPlayer('Sounds/buljk.wav');
spwin := new SoundPlayer('Sounds/win.wav');
sperr := new SoundPlayer('Sounds/error.wav');
// информационные метки:
txtTime : TextWPF;
txtCircles : TextWPF;
// таймеры:
279

t, t2: Timer;
// время игры:
gameTime := 0;
// поздравительная картинка:
imgWin : PictureWPF;
// состояние игры:
flgGameOver := false;

Вся эта нехитрая игровая механика известна вам по игре с пузырями. Здесь то же
самое, но хитрее.
Для начала игры следует хорошенько препариться!
// КЛАСС ИГРЫ
type
StackGame = class
// ГОТОВИМСЯ К ИГРЕ
procedure Prepare;
begin

Здесь мы создаём окно с фоновой картинкой:
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := TITLE;
GraphWindow.Load(BACK);

Назначаем метод для мышки:
// назначаем процедуру для обработки
// события нажатия на кнопку мышки:
OnMouseDown := MouseDown;

Создаём поздравительную табличку:
// табличка с поздравлением:
imgWin := PictureWPF.CreateInvisible(CX-498/2, CY-130/2,
280

'Images/imgGameOver.jpg');

Две метки прямо на игровом поле:
// метка для показа времени:
txtTime := new TextWPF(100, 0,48, '0:00', Colors.DarkGreen);
txtTime.FontName := 'Arial Bold';
// метка для числа оставшихся кругов:
txtCircles := new TextWPF(10, 0, 48, lstC.Count.ToString,
Colors.SteelBlue);
txtCircles.FontName := 'Arial Bold';

Пару таймеров:
// таймер отсчитывает время:
t := new Timer(1000, OnTimer);
// таймер убирает табличку:
t2 := new Timer(2500, OnTimer2);

И понеслась:
// начинаем новую игру:
NewGame;
end;

В методе NewGame начинаются созидательные работы:
// НАЧИНАЕМ НОВУЮ ИГРУ
procedure NewGame;
begin
// создаём круги:
CreateCircles(NUM_CIRCLES);

Перемешиваем круги, чтобы они не лежали в правильном порядке:
281

// перемешиваем их:
Shuffle;
// обновляем информацию на экране:
Update;

Запускаем часы пик – и давка начинается:
// запускаем часы:
gameTime := 0;
t.Start;
// игра началась:
flgGameOver := false;
end;

Остальные методы помещаем в секцию private.
Создавать круги вы уже умеете:
private
// СОЗДАЁМ КРУГИ
procedure CreateCircles(n : integer);
begin
var x,y,r : real;
var clr1, clr2 :Color;
lstC.Clear;
// толщина контура:
var t := 2;
for var i := 0 to n-1 do begin
// размер:
r := Random(40, 60);
// координаты центра:
x := Random(r + 10, GW_WIDTH - r -10);
y := Random(r + 10, GW_HEIGHT - r -10);
// цвет заливки:
clr1 := RandomColor;
// цвет контура:
clr2 := RandomColor;
282

// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
lstC.Add(circle);
end;
end;

В методе Shuffle мы аккуратно извлекаем из стопки случайный круг (от этого наш
виртуальный стек не развалится), удаляем его со своего законного места в стопке
и переносим наверх:
// ПЕРЕМЕШИВАЕМ КРУГИ
procedure Shuffle;
begin
loop 200 do begin
// случайный круг:
var c := lstC.RandomElement;
lstC.Remove(c);
lstC.Add(c);
c.ToFront;
end;
end;

При запутывании кругов главное – не запутаться самим, чтобы голова не пошла
кругом.
Метод Update совмещает просветительские функции с контролирующими.
Он предъявляет игроку время игры:
// ОБНОВЛЯЕМ СЦЕНУ
procedure Update;
begin
// игра закончена:
if flgGameOver then exit;
// прошедшее время в секундах:
var dt := gameTime;
// число минут:
283

var min := Floor(dt / 60);
// число секунд:
var sec := Floor(dt mod 60);
// печатаем прошедшее время:
if (sec < 10) then
txtTime.Text := min + ':0' + sec
else
txtTime.Text := min + ':' + sec;

Число оставшихся кругов:
var circleLeft := lstC.Count;
// печатаем число оставшихся пузырей:
txtCircles.Text := circleLeft.ToString;

И заканчивает игру, если все круги подавлены:
// если все круги лопнуты,
if (circleLeft = 0) then begin
// заканчиваем игру:
flgGameOver := true;
// показываем табличку с поздравлением:
imgWin.ToFront;
imgWin.Visible := true;
t2.Start;
// выдаём игроку победный звуковой сигнал:
spwin.Play;
end;
end;
end;
end.

Но пока все круги в добром здравии, и таймер t начал отсчитывать игровое время.
Таймер t2 ждёт сигнала об окончании игры, чтобы выставить поздравительную
табличку на всеобщее обозрение и оборзение:
procedure OnTimer;
284

begin
gameTime += 1;
Update;
end;
procedure OnTimer2;
begin
imgWin.Visible := false;
t2.Stop;
NewGame;
end;

Самый важный и ответственный метод в этой игре – MouseDown:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
// игра закончена:
if flgGameOver then exit;

Если мышка не промахнулась, то мы получаем ссылку на кликнутый объект:
// кликнутый объект:
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;

Но нас интересуют только круги:
// щёлкаем только круги:
if c is CircleWPF then begin

Мы получаем индекс, то есть порядковый номер круга в списке lstC:
// индекс щёлкнутого круга в списке:
var id := lstC.IndexOf(CircleWPF(c));

285

Возможно, он пересекается с другими объектами:
var lstO := c.IntersectionList;
var flgDestroy := true;

Объекты-картинки и надписи пропускаем:
foreach var o in lstO do begin
if (o is PictureWPF) or (o is TextWPF) then
continue;

Если кликнутый круг пересекается с другим кругом, то нам нужно определить, какой из них находится выше, чтобы игрок не смог уничтожить не верхний круг:
var id2 := lstC.IndexOf(CircleWPF(o));

Это легко определить по индексам кругов – чем больше индекс, тем выше находится круг в кучке. Если на нашем круге лежит другой круг, то мы оплошали:
if id < id2 then begin
sperr.Play;
flgDestroy := false;
break;
end;
end;

Если же на кликнутый круг никто не навалился сверху, то мы уничтожаем его:
if flgDestroy then begin
sp.Play;
lstC.Remove(CircleWPF(c));
c.Destroy;
end;
end;
end;

286

При надлежащей сноровке и глазомере дело спорится (Рис. 4).

Рис. 4. Подавляющее преимущество

И вот уже все круги закруглились, и на нас выпала приятная для глаз похвала от
программы (Рис. 5).

287

Рис. 5. Удавили и удивили всех

В этой игре нет кнопок, поэтому следующая игра начинается автоматически и без
промедления. Если это вам не по нраву, то используйте поздравительную табличку как кнопку.
288

Числавряд WPFO
В новой игре мы усилим тяготы игрока. На столе разом появляются 40 пронумерованных кругов, или фишек (Рис. 1). Игрок должен последовательно давить
фишки согласно их порядковым номерам.
В левом верхнем углу игрок мы печатаем подсказку - номер очередной фишки для
удавливания, а также число оставшихся фишек. За каждый неверный ход игрок
наказывается неприятным звуком и десятью штрафными секундами. Рекорды мы
не фиксируем, но можно устроить групповое числопомешательство, чтобы найти
и выявить самого шустрого давителя фишек.
За основу мы примем предыдущий проект, в который нужно внести небольшие
изменения.
Для азартных игрищ отлично годится и подходит деревянный стол (Рис. 1).
В разделе констант изменяем заголовок программы и число кругов/фишек:
// заголовок окна программы:
TITLE = ' Числавряд WPFO ';
// число кругов:
NUM_CIRCLES = 40;

С меньшим числом фишек играть неинтересно, а больше 40 фишек трудно за короткое время столпить на столешнице (Рис. 2).
В раздел переменных вносим номер текущей фишки для бития:
// текущий номер:
num := 1;

Шрифт для меток слегка уменьшаем, чтобы они не занимали излишне много места
на сцене. В методе Prepare вторую метку отстраняем от первой:
289

// метка для показа времени:
txtTime := new TextWPF(160, 0, 32, '0:00', Colors.Green);
txtTime.FontName := 'Arial Bold';
// метка для числа оставшихся кругов:
txtCircles := new TextWPF(10, 0, 32, lstC.Count.ToString,
Colors.SteelBlue);
txtCircles.FontName := 'Arial Bold';

Рис. 1. Стол для столпотворения фишек

290

Рис. 2. Фишки в сборе
291

Из метода NewGame и из программы удаляем метод Shuffle, поскольку фишки
сами собой займут случайные места на сцене.
В методе CreateCircles мы должны разместить круги на сцене так, чтобы они не
перекрывали друг друга, иначе некоторые числа исчезнут под другими кругами,
и игрок не сможет правильно давить их:
// СОЗДАЁМ КРУГИ
procedure CreateCircles(n : integer);
begin
var x,y,r : real;
var clr1, clr2 :Color;
lstC.Clear;
// толщина контура:
var t := 2;

Начинаем нумеровать фишки с единицы:
var i := 1;
while i <= n do begin

Размер фишек уменьшаем, чтобы их больше поместилось на сцене:
// размер:
r := Random(30, 50);

Фишки смещаем и смущаем вниз, чтобы они не наезжали на информационные
метки:
// координаты центра:
x := Random(r + 10, GW_WIDTH - r -10);
y := Random(80, GW_HEIGHT - r -10);

Каждую новую фишку проверяем на пересечение с уже готовыми фишками:
292

var collision := false;
foreach var c in lstC do begin
var rc := c.Radius;
var xc := c.Center.X;
var yc := c.Center.Y;
var mindist2 := (r + rc)**2;

Если новую фишку не удаётся втиснуть между другими фишками на сцене, то мы
пытаемся найти для новой фишки другое место и, возможно, изменяем её радиус:
if (xc - x)**2 +(yc-y)**2 < mindist2 then begin
collision := true;
break;
end;
end;
if collision then continue;

Если новая фишка прошла проверку, то мы присваиваем ей очередной номер и
отсылаем в список lstC:
// цвет заливки:
clr1 := RandomColor;
// цвет контура:
clr2 := RandomColor;
// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
circle.Number := i;
circle.FontName := 'Arial Bold';
circle.FontSize := 40;
lstC.Add(circle);

Переходим к следующему номеру:
i += 1;
end;
end;
293

Процедура CreateCircles заканчивает свою работу, когда все фишки займут достойные места на сцене.
Процедура MouseDown упростилась, поскольку все объекты, кроме фишек,
имеют нулевые значения свойства Number:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
// игра закончена:
if flgGameOver then exit;
// кликнутый объект:
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;
// не фишка:
if c.Number = 0 then exit;

Но значение свойства Number кликнутой фишки должно совпадать с очередным
номером num. Если игрок ошибся или обсчитался, то он «награждается» штрафными секундами:
if c.Number <> num then begin
sperr.Play;
gameTime += 10;
exit;
end;

И только когда всё хорошо или даже прекрасно, игрок уничтожает фишку, а программа переходит к следующему номеру:
sp.Play;
lstC.Remove(CircleWPF(c));
c.Destroy;
num += 1;
end;
294

В методе Update время игры печатаем, как обычно:
// ОБНОВЛЯЕМ СЦЕНУ
procedure Update;
begin
// игра закончена:
if flgGameOver then exit;
var circleLeft := lstC.Count;
// если все круги лопнуты,
if (circleLeft = 0) then begin
// заканчиваем игру:
flgGameOver := true;
// показываем табличку с поздравлением:
imgWin.ToFront;
imgWin.Visible := true;
t2.Start;
// выдаём игроку победный звуковой сигнал:
spwin.Play;
exit;
end;
// прошедшее время в секундах:
var dt := gameTime;
// число минут:
var min := Floor(dt / 60);
// число секунд:
var sec := Floor(dt mod 60);
// печатаем прошедшее время:
if (sec < 10) then
txtTime.Text := min + ':0' + sec
else
txtTime.Text := min + ':' + sec;

Но к числу оставшихся кругов добавляем текущий номер, чтобы игрок не запутался и не впал в депрессию:
var circleLeft := lstC.Count;
// печатаем число кругов:
txtCircles.Text := num + '/' + circleLeft;
295

Мы окрашиваем фишки в случайные цвета, поэтому некоторые номера будут
плохо различимы. Чтобы не злить игрока излишними трудностями, мы каждую
секунду перекрашиваем номера на фишках:
// случайно изменяем цвет номера на фишке:
foreach var c in lstC do
c.FontColor := RandomColor;
end;
end;
end.

Проверку я прошёл, но получил 10 секунд штрафа и посредственное время (Рис.
3).
Совет: не нажимайте по одной фишке
кряду – лучше сразу ознакомьтесь с
расположением фишек, чтобы бить
их сериями. По ходу поиска очередных фишек старайтесь запоминать
местоположение следующих фишек,
так вы сэкономите время на поиски
фишечных кандидатов.

296

Рис. 3. Не зря старался

Это игра, у которой есть фишки!

297

Попорядку WPFO
Опять усложняем игру и меняем фоновую картинку (Рис. 1), чтобы вконец запутать
игрока.

Рис. 1. Брутальный фон
298

В этой игре круги постоянно крутятся, а числа от 1 до 200 записаны с разрывами,
но самое первое число в информационной строке подсказывает игроку очередное число (Рис. 2). Это послабление вы можете убрать, чтобы ещё больше озадачить игрока.

Рис. 2. Проявляем заботу

299

В разделе констант меняем название программы:
// заголовок окна программы:
TITLE = ' Попорядку WPFO ';

В раздел переменных добавляем новый звук и список для чисел:
var
// проигрыватели:
spstart := new SoundPlayer('Sounds/start.wav');
// список чисел:
lstN := new List<integer>();

В методе NewGame текущий номер получаем из списка:
// НАЧИНАЕМ НОВУЮ ИГРУ
procedure NewGame;
begin
. . .
// текущий номер:
num := lstN[0];
// обновляем информацию на экране:
Update;
// звук к началу игры
spstart.Play;
. . .
end;

В методе CreateCircles сразу добавляем в список чисел lstN числа, которые при
вращении вводят игрока в заблуждение:
// СОЗДАЁМ КРУГИ
procedure CreateCircles(n : integer);
begin
var x,y,r : real;
var clr1, clr2 :Color;
300

lstC.Clear;
lstN.Clear;
lstN.Add(6); lstN.Add(9);
lstN.Add(66); lstN.Add(99);
. . .

Добавляем в список lstN случайные числа без повторов:
// макс. число:
var maxn := 200;
// случайное число:
var num := Random(1, maxN);
while num in lstN do begin
// случайное число:
num := Random(1, maxN);
end;
lstN.Add(num);
circle.Number := num;
circle.FontName := 'Arial Bold';
circle.FontSize := 32;
lstC.Add(circle);
i += 1;
end;

Удаляем из списка числа с шестёрками и девятками:
lstN.Remove(6); lstN.Remove(9);
lstN.Remove(66); lstN.Remove(99);
lstN.Sort;
end;

В методе MouseDown сравниваем число на фишке с очередным числом num:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
. . .
301

if c.Number <> num then begin

Если они не совпадают, игрок получает от нас заслуженные штрафные секунды:
sperr.Play;
gameTime += 10;
exit;
end;

А «правильные» фишки мы удаляем с поля:
sp.Play;
lstC.Remove(CircleWPF(c));
c.Destroy;
lstN.Remove(num);

И если в списке lstN ещё остались числа, то следующим должно стать самое первое число:
if lstN.Count > 0 then
num := lstN[0];
Update;
end;

В процедуре Update мы не только изменяем цвет фишки, но и дополнительно крутим её в обе стороны:
// ОБНОВЛЯЕМ СЦЕНУ
procedure Update;
begin
. . .
// случайно изменяем цвет номера на фишке:
foreach var c in lstC do begin
c.FontColor := RandomColor;
302

c.AnimRotate(Random(-360,360));
end;
end;

Запускаем программу. Игра спорится, но уже так споро, как допрежь (Рис. 3).

303

Рис. 3. Избегайте вертижей

304

Попамяти WPFO
Ещё больше нагнетаем и драматизируем! События игры происходят в «тёмном
лесе» (Рис. 1).

Рис. 1. Дремучий лес
305

И вдруг тут, там и сям появляются кружки с числами (Рис. 2).

Рис. 2. Никто не ждал от неожиданности

306

Поначалу их только трое, но затем, по мере успешной игры кругодава к ним добавляются ещё по одному коллеге. Несмотря на тёмный лес, пока ничего страшного для игрока мы не придумали.
Однако, стоит ему кликнуть мышкой по первому кругу, как все круги разом прячут
свои номера (Рис. 3).
Первый круг исчезает, а все остальные круги их давитель должен кликать исключительно по памяти (особо хитрые читеры могут сделать снимок с экрана и подглядывать, но это не наш метод). Любой ошибочный клик начинает игру сызнова,
так что давить круги опять придётся с первого и до последнего.
С завершающим успешным кликом игрок награждает поздравительной табличкой, аплодисментами и новой, более кругочисленной партией. Как и во многих
играх, в нашей давилке нет логического завершения, то есть можно наращивать
свой памятный потенциал до бесконечности. Или пока кругов на столе не накопится так много, что они не влезут в окно программы, и она благополучно сломается. Я не надеюсь, что это когда-нибудь случится или произойдёт, но, как учит
нас телепрограмма Удивительные люди, нет такой игры, которую бы русский не
сломал (Рис. 4).
Никто не любит домашние задания, поэтому защитите
программу от злоумышленных мнемоников, которые способны запоминать десятки и сотни чисел!

Увлёкшись памятными страшилками, я совсем забыл, что мы ещё не написали
программу для терзания людской памяти круглыми числами. Впрочем, предыдущая программа сильно облегчит нашу кодострастную участь. Мы возьмём из неё
всё самое лучшее и добавим новое, но тоже хорошее.
Итак, в раздел переменных добавляем переменную numCircles, которая следит за
числом кругов на текущем уровне игры:
unit Game;
uses WPFObjects, GraphWPF, System.Media, Timers;
307

const
// размеры окна:
GW_WIDTH = 720;
GW_HEIGHT =720;
CX = GW_WIDTH div 2;
CY = GW_WIDTH div 2;
// заголовок окна программы:
TITLE = ' Попамяти WPFO ';
// фоновая картинка:
BACK = 'Images/imgBack.jpg';
var
// список кругов:
lstC := new List<CircleWPF>();
// проигрыватели:
sp : SoundPlayer := new SoundPlayer('Sounds/buljk.wav');
spwin := new SoundPlayer('Sounds/win.wav');
sperr := new SoundPlayer('Sounds/error.wav');
spstart := new SoundPlayer('Sounds/start.wav');
// информационные метки:
txtTime : TextWPF;
txtCircles : TextWPF;
// таймеры:
t, t2: Timer;
// время игры:
gameTime := 0;
// поздравительная картинка:
imgWin : PictureWPF;
// состояние игры:
flgGameOver := false;
// текущий номер:
num := 1;
// число кругов:
numCircles := 3;

В методе Prepare изменяем только цвета меток, чтобы они ярче выделялись на
фоне мрачного лесного фона:
// КЛАСС ИГРЫ
type
308

PopamyatiGame = class
// ГОТОВИМСЯ К ИГРЕ
procedure Prepare;
begin
Window.SetSize(GW_WIDTH, GW_HEIGHT);
Window.Title := TITLE;
GraphWindow.Load(BACK);
// назначаем процедуру для обработки
// события нажатия на кнопку мышки:
OnMouseDown := MouseDown;
// табличка с поздравлением:
imgWin := PictureWPF.CreateInvisible(CX-498/2, CY-130/2,
'Images/imgGameOver.jpg');
// метка для показа времени:
txtTime := new TextWPF(160, 0, 32, '0:00', Colors.Lime);
txtTime.FontName := 'Arial Bold';
// метка для числа оставшихся кругов:
txtCircles := new TextWPF(10, 0, 32, lstC.Count.ToString,
Colors.Fuchsia);
txtCircles.FontName := 'Arial Bold';
// таймер отсчитывает время:
t := new Timer(1000, OnTimer);
// таймер убирает табличку:
t2 := new Timer(2500, OnTimer2);
// начинаем новую игру:
NewGame;
end;

В методе NewGame вообще ничего трогать не надо:
// НАЧИНАЕМ НОВУЮ ИГРУ
procedure NewGame;
begin
// создаём круги:
CreateCircles(numCircles);
// обновляем информацию на экране:
309

Update;
// текущий номер:
num := 1;
spstart.Play;
// запускаем часы:
gameTime := 0;
t.Start;
// игра началась:
flgGameOver := false;
end;

В методе CreateCircles мы должны учесть, что игрок может угодить мимо нужного
круга и попасть впросак. Тогда часть старых кругов перейдёт в новую игру, чем
озадачит не только игрока, но и нас. Поэтому уничтожаем перезрелые круги, даже
если их нет:
// СОЗДАЁМ КРУГИ
procedure CreateCircles(n : integer);
begin
var x,y,r : real;
var clr1, clr2 :Color;
// уничтожаем старые круги:
foreach var c in lstC do
c.Destroy;
lstC.Clear;

310

Рис. 3. Опасная игра в прятки

311

Рис. 4. Он помнит всё

Остальной код непогрешим и в правках не нуждается:
// толщина контура:
var t := 2;
var i := 1;
while i <= n do begin
// размер:
r := Random(30, 50);
// координаты центра:
x := Random(r + 10, GW_WIDTH - r -10);
y := Random(80, GW_HEIGHT - r -10);
var collision := false;
foreach var c in lstC do begin
var rc := c.Radius;
var xc := c.Center.X;
var yc := c.Center.Y;
312

var mindist2 := (r + rc)**2;
if (xc - x)**2 +(yc-y)**2 < mindist2 then begin
collision := true;
break;
end;
end;
if collision then continue;
// цвет заливки:
clr1 := RandomColor;
// цвет контура:
clr2 := RandomColor;
// создаём круг:
var circle := new CircleWPF(x,y, r, clr1, t, clr2);
circle.Number := i;
circle.FontName := 'Arial Bold';
circle.FontSize := 40;
lstC.Add(circle);
i += 1;
end;
end;

Оба таймера исправно несут службу, то есть мирно тикают, как и раньше:
procedure OnTimer;
begin
gameTime += 1;
Update;
end;
procedure OnTimer2;
begin
imgWin.Visible := false;
t2.Stop;
NewGame;
end;

Из метода Update удаляем бессмысленную информацию о номере очередного
круга, поскольку игрок всё равно номеров на сцене не видит:
313

// ОБНОВЛЯЕМ СЦЕНУ
procedure Update;
begin
// игра закончена:
if flgGameOver then exit;
// прошедшее время в секундах:
var dt := gameTime;
// число минут:
var min := Floor(dt / 60);
// число секунд:
var sec := Floor(dt mod 60);
// печатаем прошедшее время:
if (sec < 10) then
txtTime.Text := min + ':0' + sec
else
txtTime.Text := min + ':' + sec;
var circleLeft := lstC.Count;
// печатаем число кругов:
txtCircles.Text := circleLeft.ToString;
// если все круги лопнуты,
if (circleLeft = 0) then begin
// заканчиваем игру:
flgGameOver := true;
// показываем табличку с поздравлением:
imgWin.ToFront;
imgWin.Visible := true;
t2.Start;
// выдаём игроку победный звуковой сигнал:
spwin.Play;

Ежели игрок попался памятливый и уничтожил все круги по порядку, то на следующем круге игры он получает ещё один дополнительный круг:
// добавляем 1 круг:
numCircles += 1;
exit;
end;

314

После первого клика по кружку цвет чисел больше не изменяется:
// случайно изменяем цвет номера на фишке:
if lstC.Count < numCircles then exit;
foreach var c in lstC do
c.FontColor := RandomColor;
end;
end;
end.

И последний, самый ответственный метод нашей кругодавительной на память
игры – MouseDown, в котором игрок жмёт мышке лапку.
Первая ошибка сразу отбрасывает игрока в начало следующей игры на тех же
условиях:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
// игра закончена:
if flgGameOver then exit;
// кликнутый объект:
var c := ObjectUnderPoint(x,y);
// мимо:
if c = nil then exit;
// не фишка:
if c.Number = 0 then exit;
// ошибка!
if c.Number <> num then begin
sperr.Play;
gameTime += 10;
NewGame;
exit;
end;

Время пошло, но игрок может потратить его с пользой, то есть запомнить номера
всех фишек. Но после убиения первой фишки все остальные прячут свои номера:
315

// если нажат первый круг, то
// прячем номера кругов:
foreach var k in lstC do
k.FontColor := k.Color;
// правильный круг:
sp.Play;
lstC.Remove(CircleWPF(c));
c.Destroy;
num += 1;
end;

Ещёстрашнее WPFO
В заколдованных болотах там кикиморы живут, Защекочут до икоты и на дно уволокут.
Будь ты конный, будь ты пеший — заграбастают,
А уж лешие так по лесу и шастают.

Страшно, аж жуть!
Высоцкий, Песня про нечисть

Что может быть страшнее невидимой опасности, ведь она может подкрасться с
любой, самой неожиданной стороны? В этой игре фишки бесследно исчезнут после первого удачного клика игрока. И больше они никогда не появятся!
Я выбрал тёмный фон с мелкими деталями, на котором (возможно) легче запомнить
местоположение отдельных фишек (Рис. 1).
Если мы оттолкнёмся двумями ногами от предыдущего проекта, то нас ждут совсем небольшие переделки.
Начальное число кругов уменьшаем до двух, чтобы игроку сразу стало страшно,
но не жуть:
var
316

. . .
// число кругов:
numCircles := 2;

В методе Prepare усугубляем цвета меток, чтобы они вместе с кругами не затерялись на пёстром фоне:
// КЛАСС ИГРЫ
type
ЕщёстрашнееGame = class
// ГОТОВИМСЯ К ИГРЕ
procedure Prepare;
begin
. . .
// метка для показа времени:
txtTime := new TextWPF(160, 0, 32, '0:00', Colors.DarkGreen);
txtTime.FontName := 'Arial Bold';
// метка для числа оставшихся кругов:
txtCircles := new TextWPF(10, 0, 32, lstC.Count.ToString,
Colors.Red);
. . .
end;

В методе MouseDown прячем все круги после прищёлкнутого первого:
// НАЖИМАЕМ КНОПКУ МЫШКИ
procedure MouseDown(x,y: real; mb: integer);
begin
. . .
// если нажат первый круг, то
// прячем круги:
foreach var k in lstC do
k.Visible := false;
. . .
end;

317

Рис. 1. Фон с подсказками

318

Кликать мышкой в поисках следующей фишки можно
сколько угодно и где угодно. Мы не наказываем игрока за холостые клики, но это расхлябывает и расхолаживает его.
Предлагаю ввести десятисекундное наказание за всякий клик
не в то место, куда следует.

Тут и книжечке конец!
beginло
// А кто не спрятался, тот не молодец.
еndец.

319

Литература

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334