Графика в Паскаль
С помощью графики в Паскаль можно рисовать фигуры и изображения, визуализировать математические вычисления и использовать элементы графики в компьютерных играх. Мы познакомимся как задавать графический режим в паскаль, рисовать точки, окружности, линии, выводить текст в графическом режиме паскаль.
Для того, чтобы рисовать графические фигуры в Паскаль нужно импортировать модуль GraphABC. В Паскаль это можно сделать с помощью команды uses GraphABC .
Чтобы начать работу с графикой в Pascal нужно задать окно для графики. В модуле GraphABC это можно сделать с помощью команды setWindowSize(x, y) , где x это ширина окна, а y высота.
С помощью модуля GraphABC на Паскале можно отобразить точку, линию, прямоугольник, прямоугольник с закруглёнными краями, окружность, дуга, сектор круга, можно вывести текст на экран.
Чтобы задать расположение объекта в графическом окне Паскаль, нужно указать его координаты в системе координат. Начало координат находится в левом верхнем углу окна для графики.Положительное направление оси X слева направо, оси Y сверху вниз. Чем больше X, тем правее точка, чем больше Y, тем точка ниже.
В Pascal в модуле GraphABC был создан новый тип данных для цвета. Цвет задаётся с помощью строки clЦвет . Чтобы установить цвет рисования графических фигур в паскаль, необходимо использовать команду
Основные цвета в графических программах на паскале
clBlack – черный
clPurple – фиолетовый
clWhite – белый
clMaroon – темно-красный
clRed – красный
clNavy – темно-синий
clGreen – зеленый
clBrown – коричневый
clBlue – синий
clSkyBlue – голубой
clYellow – желтый
clCream – кремовый
clAqua – бирюзовый
clOlive – оливковый
clFuchsia – сиреневый
clTeal – сине-зеленый
clGray – темно-серый
clLime – ярко-зеленый
clMoneyGreen – цвет зеленых денег
clLtGray – светло-серый
clDkGray – темно-серый
clMedGray – серый
clSilver – серебряный
Рисование точки в Паскаль
putPixel(x, y, color) , где x и y это координаты точки, color это цвет точки.
Пример программы в паскаль рисование красной точки
uses GraphABC;
begin
setWindowSize(500, 500);
putPixel(30, 30, clRed);
end.
Рисование линии в Паскаль
line(x1, y1, x2, y2) x1, y1 это координаты начала линии, x2, y2 координаты конца линии.
Пример программы в Паскаль рисование линии
uses GraphABC;
begin
setWindowSize(500, 500);
line(30, 30, 40, 40, clBlue);
end.
Рисование прямоугольника в Паскаль
rectangle(x1, y1, x2, y2) x1, y1 это координаты первой точки, x2, y2 координаты второй точки.
Пример программы на паскаль рисование прямоугольника
uses GraphABC;
begin
setWindowSize(500, 500);
rectangle(200, 200, 320, 350);
end.
Для задания в Паскаль прямоугольника с закруглёнными краями используется команда roundRect(x1, y1, x2, y2, w, h) , x1, y1 это координаты первой точки, x2, y2 координаты второй точки, w и h это ширина и высота закругления краёв.
uses GraphABC;
begin
setWindowSize(500, 500);
roundRect(350, 300, 450, 340, 40, 40);
end.
Рисование окружности в Паскаль
drawcircle(x, y, r) где x и y это координаты центра окружности, r это радиус окружности.
пример программы на Паскаль рисование окружности
uses GraphABC;
begin
setWindowSize(500, 500);
drawcircle(47, 47, 10);
end.
Для того,чтобы нарисовать закрашенный круг используется набор команда
SetBrushColor(цвет заполнения круга);
SetPenColor(цвет границы);
cirlce(x, y, r) где x и y это координаты центра круга, r это радиус круга
Пример программы на паскаль для рисования закрашенного круга
uses GraphABC;
begin
setWindowSize(500, 500);
SetBrushColor(clGreen);
SetPenColor(clRed);
circle (100,100,50);
end.
Для рисования эллипса в Паскаль используется команда ellipse(x1, y1, x2, y2), где x и y координаты прямоугольника, ограничивающего эллипс.
uses GraphABC;
begin
setWindowSize(500, 500);
ellipse(100, 100, 150, 200);
end.
Задание дуги и сектора окружности в паскаль схожи. При их задании задаются координаты центра круга, по которому они будут отображаться, радиус этого круга и градусная мера дуги. При задании дуги на экран выводится только сама дуга. В отличии от дуги, при задании сектора отображается не только дуга, но и два отрезка, исходящие из центра окружности, они опираются на дугу.
Дуга рисуется в Паскаль с помощью команды arc(x, y, r, a1, a2) , Сектор в Паскаль рисуется с помощью команды pie(x, y, r, a1, a2) , где x и y это координаты центра окружности, r это радиус окружности, a1 это начальная градусная мера дуги, a2 это конечная градусная мера дуги. Дуги и секторы задаются против часовой стрелки.
Пример программы в паскаль рисование дуги и сектора
uses GraphABC;
begin
setWindowSize(500, 500);
arc(10, 200, 50, 0, 60);
pie(10, 300, 50, 0, 60);
end.
Для вывода текста на экран в графическом режиме Паскаль
используется команда textOut(x, y, s) , где x и y это координаты левой верхней части текста, s это выводящийся текст.
Пример программы на паскаль вывод текста в графическом режиме
uses GraphABC;
begin
setWindowSize(500, 500);
textOut(100, 200, ‘текст’);
end.
Для заливки отображённых объектов в Паскаль используется команда floodFill(x, y, color) , где x и y это координаты точки, находящейся в полости объекта.
Пример программы на паскаль рисование закрашенного прямоугольника
uses GraphABC;
begin
setWindowSize(500, 500);
rectangle(200, 200, 320, 350);
floodFill(250,250, clRed);
end.
В модуле GraphABC в Pascal можно изменять само перо. Для изменения цвета используется setPenColor(color) . Для изменения толщины используется setPenWidth(px) , ширина кисти измеряется в пикселях. Для изменения стиля пера используется команда setPenStyle(x) , в качестве аргумента туда вводится стиль пера, их существует три типа (clSolid, clClear, clDash).
При выведении текста можно изменять его цвет и стиль., для этого есть команда setFontColor(color) и setFontStyle(fsStyle) . Существуют стили fsNormal (обычный), fsBold (полужирный), fsItalic (курсив) и fsUnderline (подчёркивание), можно создавать и их комбинации, например, fsBoldItalicUnderline.
Полезно почитать по теме графика в паскаль
Графика, графика, графика! Часть 1. Введение.
Важна ли графика для начинающих программистов? Или следует в первую очередь изучать конструкции языка, алгоритмы, методику написания программ? А графика — баловство?
Несомненно, все зависит от аудитории. Если программированию обучается школьник, то графика очень важна — мышление конкретное, и хочется сразу видеть результаты своего труда. Абстрактное мышление быстро утомляет. Если программировать учится студент — здесь другая картина. Графика нужна по большей мере как вспомогательное средство для визуализации результатов, динамики выполнения алгоритмов. Но что однозначно — графика нужна.
Меня вот часто спрашивают студенты — как сделать что-нибудь графическое на C++? Много лет уже спрашивают. Уже устал отвечать — не знаю.
Конечно, не каждый язык должен иметь стандартную поддержку графики. Даже универсальный. Но вот от языка для обучения (а язык Паскаль используется в основном для обучения) поддержку графики — ждут.
В старом добром Бейсике — чем он подкупал — на Корветах там всяких, Атари и Синклерах — загрузил среду, написал
Circle(100,100,50)
и получил на экране кружочек — прямо поверх кода. Это потом с появленим MS DOS, где основным режимом стал текстовый, все усложнилось.
На старом добром Turbo Pascal был такой замечательный модуль Graph — подключил его, написал пару строчек непонятных заклинаний — и рисуй себе все что угодно аж 256 цветами! Вот эти заклинания:
uses Graph; var GraphDriver,GraphMode: integer; begin InitGraph(GraphDriver,GraphMode,'d:\turbo\bgi'); end.
Еще в конце там CloseGraph надо было вызвать. И знатоки с умным видом рассказывали новичкам, что у тебя там неправильно установлен путь к графическому драйверу или драйвер у тебя не тот.
Вообщем, прошли те времена — появилась Windows, а в ней основной режим — графический.
Прошли ли? Меня до сих пор спрашивают, почему в PascalABC нет модуля Graph? Отвечаю, что не мог больше терпеть. Но нет-нет да мелькнет в Интернете на форуме пост какого-нибудь новичка — представляете, настолько плохой PascalABC, что даже графики в нем нет или она там какая-то своя! Не та, что описана в груде книжек по Турбо-Паскалю, а другая!
Вот об этой другой графике мы и поговорим.
Те, кто программировал графические приложения под Windows, знают, что рисовать лучше всего в обработчике события WM_PAINT или OnPaint (последнее — если используется какой-нибудь объектный каркас для Windows-приложения). В этом обработчике нельзя рисовать долго, поскольку программа на время его работы блокируется. А если рисовать в других обработчиках, то нарисованное стирается при следующей перерисовке окна. Короче — куча проблем!
Идея была простой: создать графическую библиотеку, подключающуюся крайне просто, где эти проблемы были бы решены. Еще лучше, если графическое приложение будет похоже на обычную программу: чтобы сразу после begin можно было писать графические команды.
Решение было найдено — вот эта простейшая программа:
uses GraphABC; begin Rectangle(10,10,100,100); end.
При запуске такой программы возникает специальное графическое окно, и все рисование происходит именно на нем. Изображение на нем не пропадет при перерисовке, и можно рисовать сколь угодно долго — программа не окажется заблокированной на время рисования. Это значит, в частности, что можно легко делать простую анимацию.
Вот несколько очень простых графических программок — совершенно бесполезны — чистое баловство!
Программа 1. Показывает использование процедуры SetPixel и функции RGB.
uses GraphABC; begin for var x:=0 to Window.Width-1 do for var y:=0 to Window.Height-1 do SetPixel(x,y,RGB(2*x-y,x-3*y,x+y)); end.
Программа 2. Рисование звездочки. Показывает использование процедур MoveTo и LineTo, а также полярных координат.
uses GraphABC; const n = 17; // количество точек n1 = 7; // через сколько точек соединять begin var a := -Pi/2; var Center := Window.Center; var Radius := Window.Height/2.2; MoveTo(Round(Center.X+Radius*cos(a)),Round(Center.Y+Radius*sin(a))); for var i:=1 to n do begin a += n1*2*Pi/n; LineTo(Round(Center.X+Radius*cos(a)),Round(Center.Y+Radius*sin(a))); end; end.
Пример 3. Цифровые часы. Показывает использование процедуры TextOut, а также функций TextWidth, TextHeight.
uses GraphABC,System; begin Font.Size := 80; var x0 := (Window.Width - TextWidth('00:00:00')) div 2; var y0 := (Window.Height - TextHeight('00:00:00')) div 2; while True do begin var t := DateTime.Now; var s := string.Format('::',t.Hour,t.Minute,t.Second); TextOut(x0,y0,s); Sleep(1000); end; end.
Ну вот, для введения и достаточно.
А симпатичные примеры на графику строк эдак на 10-15 — пожалуйста — пишите в комментариях!
Pascal: Занятие № 4 часть II. Графика в Паскале
![]()
Для работы с графикой в pascal abc используется модуль GraphABC. Для его подключения используется следующий код:
uses GraphABC; begin . end.
uses GraphABC; begin . end.
Система координат в Паскале соответствует экранной системе координат и выглядит следующим образом:

Управление цветом
Для того, чтобы использовать цвет, необходимо применить этот цвет к инструменту перо:
- SetPenColor(color) — устанавливает цвет пера, задаваемый параметром color;
- setBrushColor(color) — устанавливает цвет кисти, задаваемый параметром color;
- либо для палитры RGB: SetPenColor(rgb(0-255, 0-255, 0-255));
или использовать для заливки:
После чего можно использовать процедуры для рисования геометрических фигур.
Цвета в pascal abc:
clBlack – черный
clPurple – фиолетовый
clWhite – белый
clMaroon – темно-красный
clRed – красный
clNavy – темно-синий
clGreen – зеленый
clBrown – коричневый
clBlue – синий
clSkyBlue – голубой
clYellow – желтый
clCream – кремовый
clAqua – бирюзовый
clOlive – оливковый
clFuchsia – сиреневый
clTeal – сине-зеленый
clGray – темно-серый
clLime – ярко-зеленый
clMoneyGreen – цвет зеленых денег
clLtGray – светло-серый
clDkGray – темно-серый
clMedGray – серый
clSilver – серебряный
Точки, отрезки и ломаные
Для отображения точки в паскале используется процедура:

uses GraphABC; begin SetPixel(300,200,clred); end.
uses GraphABC; begin SetPixel(300,200,clred); end.
Для рисования линии используется:

uses GraphABC; begin SetPenColor(clgreen); line(100,50,500,250); end.
uses GraphABC; begin SetPenColor(clgreen); line(100,50,500,250); end.

Ломаные можно рисовать с помощью процедур MoveTo (x1, y1) и LineTo (x2, y2) .
Процедуры работают в паре: MoveTo передвигает курсор в определенную точку, а процедура LineTo рисует линию с этой точки до точки, определенной параметром данной процедуры.
uses GraphABC; begin . SetPenColor(clblue); MoveTo (x1, y1); LineTo (x2, y2); LineTo (x3, y3); LineTo (x4, y4); LineTo (x5, y5); end.
uses GraphABC; begin . SetPenColor(clblue); MoveTo (x1, y1); LineTo (x2, y2); LineTo (x3, y3); LineTo (x4, y4); LineTo (x5, y5); end.
Задание 0: При помощи операторов SetPenColor(), LineTo (x2, y2) и MoveTo (x1, y1) нарисовать квадрат и равносторонний треугольник.
[Название файла: L4_2task0.pas ]
Для установки размеров графического окна используется процедура
SetWindowWidth(600); SetWindowHeight(400);
Рисование фигур
Прямоугольник в Паскале рисуется:

uses GraphABC; begin Rectangle(50,50,200,200); end.
uses GraphABC; begin Rectangle(50,50,200,200); end.
Фигуры с заливкой:

uses GraphABC; begin Rectangle(50,50,200,200); FloodFill(100,100,clBlue); end.
uses GraphABC; begin Rectangle(50,50,200,200); FloodFill(100,100,clBlue); end.
Треугольник рисуется процедурами:
Line(x1,y1,x2,y2);
LineTo(x,y);

uses GraphABC; begin setpenwidth(20); setpencolor(clred); moveTo(300,100); lineTo(500,300); lineto(100,300); lineto(300,100); floodfill(300,200,clgreen); end.
uses GraphABC; begin setpenwidth(20); setpencolor(clred); moveTo(300,100); lineTo(500,300); lineto(100,300); lineto(300,100); floodfill(300,200,clgreen); end.
Окружность можно нарисовать с помощью процедуры:

uses GraphABC; begin Circle(500,200,100); FloodFill(500,200,clred); end.
uses GraphABC; begin Circle(500,200,100); FloodFill(500,200,clred); end.
Дуга окружности

1 2 3 4 5
uses GraphABC; Begin SetPenWidth(10); Arc(300,250,150,45,135); end.
uses GraphABC; Begin SetPenWidth(10); Arc(300,250,150,45,135); end.

Задание 1: «Лягушка»
[Название файла: L4_2task1.pas ]

Задание 2: «Корона»
[Название файла: L4_2task2.pas ]
Функция random для использования окраски
Задание 3: Нарисовать горизонтальный ряд окружностей радиусом 10 на расстоянии 100 от верхнего края экрана и с такими горизонтальными координатами 50, 80, 110, 140, … , 290.
* раскрасить круги случайным цветом
[Название файла: L4_2task3.pas ]
Задание 4: «Круги на воде».
Нарисуйте пару десятков концентрических окружностей, то есть окружностей разного радиуса, но имеющих общий центр.
[Название файла: L4_2task4.pas ]

Задание 5:
Воспроизвести изображение при помощи программы:
[Название файла: L4_2task5.pas ]
Штриховка

Нарисовать штриховку на Паскале можно, используя процедуры рисования прямоугольника и линии:
Программа будет выглядеть следующим образом:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
uses graphABC; var i, x1, x2, y1, y2, N: integer; h, x: real; begin x1 := 100; y1 := 100; x2 := 300; y2 := 200; N := 10; Rectangle (x1, y1, x2, y2); h := (x2 - x1) / (N + 1); x := x1 + h; for i:=1 to N do begin Line(round(x), y1, round(x), y2); x := x + h; end; end.
uses graphABC; var i, x1, x2, y1, y2, N: integer; h, x: real; begin x1 := 100; y1 := 100; x2 := 300; y2 := 200; N := 10; Rectangle (x1, y1, x2, y2); h := (x2 — x1) / (N + 1); x := x1 + h; for i:=1 to N do begin Line(round(x), y1, round(x), y2); x := x + h; end; end.
Задание 6:
Нарисуйте шахматную доску.
[Название файла: L4_2task6.pas ]
Анимация в Паскале
Анимация в программировании заключается в том, что сначала рисуется фигура цветным инструментом, затем с тем же координатами рисуется та же фигура белым цветом. После чего происходит сдвиг фигуры и действия повторяются.
Пример: Воспроизвести движение круга по горизонтали.
1 2 3 4 5 6 7 8 9 10 11 12
uses GraphABC; var x:integer; begin x:=40; repeat SetPenColor(clWhite); Circle(x,100,10); SetPenColor(clBlack); Circle(x,100,10); x:=x+1 until x>600; end.
uses GraphABC; var x:integer; begin x:=40; repeat SetPenColor(clWhite); Circle(x,100,10); SetPenColor(clBlack); Circle(x,100,10); x:=x+1 until x>600; end.

Задание 7: Выполнить анимацию движения квадрата по следующей траектории:
[Название файла: L4_2task7.pas ]
Графика. Классы штампов
Обычно начинающие программисты рисуют графические изображения. указывая координаты непосредственно в месте рисования графического объекта. Например, для рисования трех квадратов на равных расстояниях по горизонтали пишут следующий код:
uses GraphABC;
begin
Rectangle(30,30,80,80);
Rectangle(85,30,135,80);
Rectangle(140,30,190,80);
end.
Конечно, такой код плох — лучше попытаться сделать то же самое с помощью цикла:
uses GraphABC;
begin
for var i:=0 to 2 do
Rectangle(30+i*55,30,80+i*55,80);
end.
Уже лучше, но опять в коде — «волшебные» константы. Сделаем их именованными:
uses GraphABC;
const
x0 = 30;
y0 = 30;
w = 50; // размер квадрата
step = 55; // шаг между квадратами
n = 10;
begin
for var i:=0 to n-1 do
Rectangle(x0+i*step,y0,x0+w+i*step,y0+w);
end.
В результате получим следующее изображение:

Ну вот, всё замечательно. Программа хорошая, и на этом статью можно и закончить. Только запись x0 + i * step , y0 , x0 + w + i * step , y0 + w плоховато читается.
И что же нам предлагают?
А как же классы штампов? Может, есть какой-то интересный способ? Позволяющий сделать код рисования более очевидным?
Да. Такой способ есть. Для того чтобы его понять, давайте посмотрим на рисунок по-другому. Мы рисуем первый квадрат — его координаты определить нетрудно. После этого каждый следующий квадрат надо рисовать, сдвигая предыдущий вправо на расстояние на 5 пикселей больше ширины квадрата. И всё. Как же такое реализовать?
Идея проста: надо вначале запомнить все параметры одного изображения в некоторой составной переменной. В качестве такой составной переменной будем использовать объект некоторого класса. В конструкторе этого класса мы будем инициализировать параметры нашего объекта, а в методе Stamp — рисовать объект с сохраненными параметрами. Это напоминает следующее действие: мы вначале выбираем штамп с заданными параметрами, позиционируем его в нужном месте и — штампуем. В результате получается отпечаток — наше изображение. Этот способ хорош тем, что достаточно изменить некоторые (не все) параметры и снова вызвать метод Stamp. Например, если изменить только координаты объекта, то после вызова stamp он «проштампуется» в другом месте.
Класс-штамп прямоугольника
В данном случае нам надо нарисовать квадрат или в общем случае прямоугольник, поэтому создадим класс RectangleStamp:
type
RectangleStamp = class
x,y,w,h: integer;
constructor (xx,yy,ww,hh: integer);
begin
x := xx; y := yy;
w := ww; h := hh;
end;
procedure Stamp;
begin
Rectangle(x,y,x+w,y+h);
end;
end;
Здесь x,y — левый верхний угол прямоугольника, а w и h — его ширина и высота. В конструкторе мы лишь запоминаем эти параметры, а в методе Stamp — рисуем прямоугольник нужного размера в указанной позиции. Чтобы нарисовать еще 9 квадратов, будем изменять x-координату исходного объекта в цикле на величину, равную ширине квадрата + 5, после чего снова штамповать объект.
Вот как выглядит основная программа:
begin
var r := new RectangleStamp(30,30,50,50);
r.Stamp;
for var i:=1 to 9 do
begin
r.x + = r.w + 5;
r.Stamp;
end;
end.
Класс-штамп шахматной доски
Разовьем эту идею дальше для рисования шахматной доски 8 на 8 клеток. Для этого создадим класс штампа одного ряда шахматной доски, рисующий 8 клеток. Для рисования будем использовать предыдущий штамп:
type
RowRectanglesStamp = class
x,y,w,h,n: integer;
constructor (xx,yy,ww,hh,nn: integer);
begin
x := xx; y := yy;
w := ww; h := hh;
n := nn;
end;
procedure Stamp;
begin
var r := new RectangleStamp(x,y,w,h);
r.Stamp;
for var i:=1 to n-1 do
begin
r.x += r.w + 5;
r.Stamp;
end;
end;
end;
Основная программа снова будет простой:
const n=8;
begin
var r := new RowRectanglesStamp(30,30,50,50,n);
r.Stamp;
for var i:=1 to n-1 do
begin
r.y += r.h + 5;
r.Stamp;
end;
end.

Методы увеличения и уменьшения для штампа прямоугольника
Продолжим наши исследования. Доработаем класс RectangleStamp, добавив в него метод MoveOn перемещения объекта на вектор dx,dy, а также методы IncreaseFromCenter и DecreaseFromCenter, увеличивающие и уменьшающие размер прямоугольника, оставляя на месте его центр:
type
RectangleStamp = class
x,y,w,h: integer;
constructor (xx,yy,ww,hh: integer);
begin
x := xx; y := yy;
w := ww; h := hh;
end;
procedure Stamp;
begin
Rectangle(x,y,x+w,y+h);
end;
procedure IncreaseFromCenter(dw: integer);
begin
w += dw*2; h += dw*2;
x -= dw; y -= dw;
end;
procedure DecreaseFromCenter(dw: integer);
begin
IncreaseFromCenter(-dw);
end;
end;
Тогда следующая простая программа
begin
var r := new RectangleStamp(100,100,300,300);
r.Stamp;
while r.w>2 do
begin
r.DecreaseFromCenter(4);
r.Stamp;
end;
end.
выводит ряд уменьшающихся квадратов с общим центром:

Опять-таки, следует обратить особое внимание на короткую и интуитивно понятную основную программу.
Штамп текста
Создадим также текстовый штамп — он потребуется нам в дальнейшем:
type
TextStamp = class
x,y,pt: integer;
Text: string;
constructor (xx,yy,ppt: integer; t: string);
begin
x := xx; y := yy;
pt := ppt;
Text := t;
end;
procedure Stamp;
begin
Font.Size := pt;
TextOut(x,y,text);
end;
procedure MoveOn(dx,dy: integer);
begin
x += dx; y += dy;
end;
end;
Здесь pt — это размер шрифта в пунктах, а метод MoveOn используется для перемещения координат объекта на заданный вектор.
Основная программа, выводящая две фразы одну под другой, имеет вид:
begin
var txt := new TextStamp(200,200,14,'Привет!');
txt.Stamp;
txt.MoveOn(0,40);
txt.Text := 'До свидания!';
txt.Stamp;
end.

Группировка штампов. Гистограмма
Следующая идея — объединить несколько простых штампов для создания более сложного. Например, для создания гистограммы необходимо выводить прямоугольник заданной высоты и подписывать его снизу числом, совпадающим с высотой прямоугольника.
Для вывода гистограммы в цвете немного модифицируем методы Stamp для прямоугольника-штампа:
procedure Stamp;
begin
Brush.Color := clRandom;
Rectangle(x,y,x+w,y+h);
end;
и для текста-штампа:
procedure Stamp;
begin
Font.Size := pt;
Brush.Color := clWhite;
TextOut(x,y,text);
end;
После этого создадим штамп прямоугольника с текстовой подписью внизу:
type
RectWithTextStamp = class
rs: RectangleStamp;
ts: TextStamp;
constructor (x,y,w,h: integer; t: string);
begin
rs := new RectangleStamp(x,y,w,-h);
ts := new TextStamp(x,y+3,10,t);
end;
procedure Draw;
begin
rs.Stamp;
ts.Stamp;
end;
procedure MoveOn(dx,dy: integer);
begin
rs.MoveOn(dx,dy);
ts.MoveOn(dx,dy);
end;
procedure SetHeight(h: integer);
begin
rs.h := -h;
end;
procedure SetText(t: string);
begin
ts.Text := t;
end;
end;
Здесь вспомогательные штампы прямоугольника и текста описаны как поля основного штампа, конструируются в конструкторе основного штампа, и выполнение всех операций оновной штамп переадресует им. В частности, метод Stamp класса RectWithTextStamp вызывает методы Stamp штампа-прямоугольника и штампа-текста.
Воспользуемся описанным классом для рисования гистограммы, задаваемой массивом чисел:
begin
var a: array of integer := (100,70,50,120,90,200,111,150,230,11,44);
var rt := new RectWithTextStamp(100,300,30,a[0],IntToStr(a[0]));
rt.Draw;
for var i:=1 to a.Length-1 do
begin
rt.MoveOn(40,0);
rt.SetHeight(a[i]);
rt.SetText(IntToStr(a[i]));
rt.Draw;
end;
end.

Штамп креста. Создание мозаики
Продолжим наши исследования. Создадим более сложный штамп креста:
type
CrossStamp = class
x,y,w: integer;
constructor (xx,yy,ww: integer);
begin
x := xx; y := yy;
w := ww;
end;
procedure Stamp;
begin
MoveTo(x,y);
LineTo(x+w,y);
LineTo(x+w,y+w);
LineTo(x+2*w,y+w);
LineTo(x+2*w,y);
LineTo(x+3*w,y);
LineTo(x+3*w,y-w);
LineTo(x+2*w,y-w);
LineTo(x+2*w,y-2*w);
LineTo(x+w,y-2*w);
LineTo(x+w,y-w);
LineTo(x,y-w);
LineTo(x,y);
end;
procedure MoveOn(dx,dy: integer);
begin
x += dx; y += dy;
end;
end;
Добавим в этот класс метод MoveOnRel, сдвигающий крест на величину, пропорциональную его щирине:
procedure MoveOnRel(a,b: integer);
begin
MoveOn(a*w,b*w);
end;
Д ля получения одного ряда мозаики составим следующую программу:
begin
var r := new CrossStamp(100,150,20);
for var i:=1 to 8 do
begin
r.Stamp;
r.MoveOnRel(2,1);
end;
end.

При построении следующего ряда возникает неприятная проблема: следующий ряд крестов необходимо начинать с креста, получаемого смещением исходного креста-штампа до изменения его координат. Но в результате выполнения цикла координаты исходного креста изменились.
Клонирование штампа
Решение проблемы может быть следующим: создадим клон исходного креста-штампа еще до его перемещения. Для клонирования добавим в класс креста-штампа следующий метод:
function Clone(): CrossStamp;
begin
Result := new CrossStamp(x,y,w);
end;
Он создает крест-штамп с точно такими же параметрами, что и исходный, и возвращает его.
Воспользуемся этим методом, создавая в начале ряда клон r1 креста-штампа r и сдвигая именно его на вектор (2,1). После этого сдвинем исходный крест-штамп вниз на вектор (-1,2) и повторим указанные действия 2 раза:
begin
var r := new CrossStamp(100,150,20);
for var k:=1 to 2 do
begin
var r1 := r.Clone;
for var i:=1 to 8 do
begin
r1.Stamp;
r1.MoveOnRel(2,1);
end;
r.MoveOnRel(-1,2);
end;
end.

Очевидно, модифицировав данную программу, нетрудно получить мозаику из крестов.
Штамп шестиугольника
Следующий вариант использования штампов также связан с мозаиками. Но на этот раз мозаика выполняется штампами-правильными шестиугольниками, что приводит к необходимости хранить в классе штампа вещественные координаты:
type
RegularPolygonStamp = class
x,y,r: real;
n: integer;
constructor (xx,yy,rr: real; nn: integer);
begin
x := xx; y := yy;
r := rr; n := nn;
end;
procedure Stamp;
begin
var t := 0.0;
var xr := r*cos(t);
var yr := r*sin(t);
MoveTo(Round(x + xr),Round(y + yr));
for var i:=1 to n do
begin
t += 2*Pi/n;
xr := Round(r*cos(t));
yr := Round(r*sin(t));
LineTo(Round(x + xr),Round(y + yr));
end;
end;
procedure MoveOn(dx,dy: real);
begin
x += dx; y += dy;
end;
function Clone: RegularPolygonStamp;
begin
Result := new RegularPolygonStamp(x,y,r,n);
end;
end;
Обратим внимание, что вещественные координаты превращаются в целые лишь при выводе.
Построим с помощью этого штампа шестиугольник в центре экрана, окруженный с каждой стороны шестиугольниками того же размера. Для этого в цикле будем клонировать исходный шестиугольник и смещать его на нужныый вектор. Длина этого вектора равна двум высотам равностороннего треугольника со стороной, совпадающей с радиусом шестиугольника. Нетрудно видеть, что удвоенная высота равна sqrt(3)*r, где r — радиус шестиугольника. Нетрудно также видеть, что первый угол поворота этого вектора равен 1/12 от 360 градусов. Итак, код:
begin
var r := new RegularPolygonStamp(Window.Center.X,Window.Center.Y,50,6);
r.Stamp;
var t := 2*Pi/12;
var rr := r.r*sqrt(3)+10;
for var i:=1 to 6 do
begin
var r1 := r.Clone;
r1.MoveOn(rr*cos(t),rr*sin(t));
r1.Stamp;
t += 2*Pi/6;
end;
end.
Здесь в выражении r . r * sqrt ( 3 ) + 10 величина 10 необходима для формирования отступа между шестиугольниками. В результате запуска такой программы получаем:

Наконец, в заключение нашей короткой 🙂 статьи приведем еще один полезный штамп — штамп рисования графика заданной функции в заданном прямоугольнике.
Штамп графика функции
В этой программе используются не очень сложные для вывода формулы, которые преобразуют «мировой» прямоугольник с вещественными координатами (xf0,yf0,wf,hf) в «экранный» прямоугольник с целыми координатами (xs0,ys0,ws,hs). Здесь x,y — левый верхний угол каждого прямоугольника, а w,h — их ширина и высота.
Формулы преобразования из «мировых» координат (xf,yf) в экранные (xs,ys) имеют вид:
a := ws/wf;
b := xs0-a*xf0;
c := hs/hf;
d := ys0-c*yf0;
xs := Round(a*xf+b);
ys := hs + 2*ys0 - Round(c*yf+d);
Здесь a,b,c,d — промежуточные коэффициенты.
В правильность этих формул мы просим либо поверить, либо доказать эти формулы самостоятельно. На выбор.
Далее приводим полный тип класса-штампа для рисования графика функции в прямоугольнике. Здесь надо обратить внимание на несколько мелочей:
type
FuncType = function (r: real): real;
FuncStamp = class
xs0,ys0,ws,hs: integer;
xf0,yf0,wf,hf: real;
f: FuncType;
constructor (xs0p,ys0p,xs1p,ys1p: integer; xf0p,yf0p,xf1p,yf1p: real; ff: FuncType);
begin
SetScreenWindow(xs0p,ys0p,xs1p,ys1p);
SetFuncWindow(xf0p,yf0p,xf1p,yf1p);
f := ff;
end;
function WorldToScreenX(xf: real): integer;
begin
var a := ws/wf;
var b := xs0-a*xf0;
Result := Round(a * xf + b);
end;
function WorldToScreenY(yf: real): integer;
begin
var c := hs/hf;
var d := ys0-c*yf0;
Result := hs + 2*ys0 - Round(c * yf + d);
end;
procedure Stamp;
const n = 100;
begin
Pen.Color := Color.Gray;
Rectangle(xs0,ys0,xs0+ws,ys0+hs);
Pen.Color := Color.Black;
var x := xf0;
var y := f(x);
var h := wf/n;
var xs := WorldToScreenX(x);
var ys := WorldToScreenY(y);
MoveTo(xs,ys);
for var i:=1 to n do
begin
x += h;
y := f(x);
xs := WorldToScreenX(x);
ys := WorldToScreenY(y);
LineTo(xs,ys);
end;
end;
procedure SetScreenWindow(xs0p,ys0p,xs1p,ys1p: integer);
begin
xs0 := xs0p; ys0 := ys0p;
ws := xs1p-xs0p; hs := ys1p-ys0p;
end;
procedure SetFuncWindow(xf0p,yf0p,xf1p,yf1p: real);
begin
xf0 := xf0p; yf0 := yf0p;
wf := xf1p-xf0p; hf := yf1p-yf0p;
end;
procedure MoveOn(dx,dy: integer);
begin
xs0 += dx; ys0 += dy;
end;
end;
1. В конструкторе мы инициализируем оба прямоугольника — «мировой» и «экранный» — координатами левого верхнего и правого нижнего углов. а в классе храним координаты левого верхнего угла, ширину и высоту прямоугольников. Так оказывеается удобнее.
2. Мы создаем отдельные методы SetScreenWindow и SetFuncWindow для изменения соответствующих окон класса-штампа вывода функции в ходе работы программы. Первый нужен чтобы выводить тот же участок функции в другом месте экрана, а второй — чтобы выводить другой участок функции.
3. Функция передается в класс-штамп в виде процедурной переменной типа FuncType = function (r: real): real;
4. При рисовании графика функции вначале серым цветом рисуется прямоугольник, в границах которого рисуется график.
Реализуем также пару функций, которые мы будем выводить в разных окнах:
function f(x: real): real;
begin
Result := x*sin(5*x);
end;
function g(x: real): real;
begin
Result := sin(3*x)+sin(4*x);
end;
Вот код основной программы:
begin
var fs := new FuncStamp(10,10,310,230,0,-2*Pi,2*Pi,2*Pi,f);
fs.Stamp;
fs.MoveOn(320,0);
fs.SetFuncWindow(-Pi,-1,Pi,1);
fs.f := sin;
fs.Stamp;
fs.MoveOn(-320,240);
fs.f := cos;
fs.Stamp;
fs.MoveOn(320,0);
fs.SetFuncWindow(-2*Pi,-2,2*Pi,2);
fs.f := g;
fs.Stamp;
end.
Он выводит четыре графика функций в четырех окнах (прямоугольниках) на экране. Результат приведен ниже:

Итоги
Подведем итоги. Мы использовали одну идею — создание классов-штампов — для запоминания ряда параметров рисуемого графического объекта. Часть этих параметров мы затем меняли (как правило — координаты), после чего рисовали объект вызовом метода Stamp.
Заметим, что мы практически не использовали ряд средств объектно-ориентированного программирования, таких как свойства, защита доступа, наследование и полиморфизм, которые крайне уместны при реализации классов-штампов и могут быть задействованы учащимися для создания собственных классов-штампов.
У классов мы использовали лишь их самую главную роль — быть кирпичиками гибко изменяемого конструктора, из которых можно строить весьма нетривиальные и красивые программы.
еtype
RectangleStamp = class
x,y,w,h: integer;
constructor (xx,yy,ww,hh: integer);
begin
x := xx; y := yy;
w := ww; h := hh;
end;
procedure Stamp;
begin
Rectangle(x,y,x+w,y+h);
end;
end;
