close

Вход

Забыли?

вход по аккаунту

BGRABitmap - Free Pascal wiki - lazarus

код для вставкиСкачать
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
BGRABitmap
Предисловие
За основу этих уроков взято соответствующие статьи из http://wiki.freepascal.org/BGRABitmap. Перевод
осуществлялся с помощью Google Translator с ручной коррекцией. Автор перевода старался
максимально придерживаться текста оригинала, изменив только часть касательно установки
компонентов в 1 уроке. Если в переводе обнаружатся какие-либо неточности или просто пожелания,
просьба сообщать на e-mail: [email protected] При размещении материалов из этого руководства
ссылки на http://wiki.freepascal.org/BGRABitmap и сайт http://lazarus-games.ru/ обязательны.
Описание
BGRABitmap представляет собой набор модулей, предназначенных для редактирования и обработки
изображений с прозрачностью (альфа-канала). Прямой доступ пикселей позволяет осуществлять
быструю обработку изображений. Библиотека была протестирована на Windows, Ubuntu и Mac OS X
(последняя версия не работает на Mac), с наборами виджетов win32, gtk1, gtk2 и Carbon.
Основной класс TBGRABitmap унаследован от TFPCustomImage. Также существует TBGRAPtrBitmap,
который позволяет обрабатывать заранее размещённые данные BGRA. Этот формат состоит из 4 bytes
для каждого пикселя (голубой, зелёный, красный и альфа в соответствующем порядке).
Использование BGRABitmap
Обзор
Функции имеют длинные имена для понятности. Почти всё доступно в виде функций или
использования свойств объекта TBGRABitmap. Например, Вы можете использовать CanvasBGRA
чтобы иметь канву аналогичную TCanvas (с непрозрачностью и сглаживанием) и Canvas2D чтобы иметь
те же функции, что и HTMLcanvas.
Некоторые особенности требуют подключения дополнительный модулей, но Вам они могут быть не
нужны:





TBGRAMultishapeFiller для сглаженных переходов полигонов в модуле BGRAPolygon
TBGRATextEffect в модуле BGRATextFX
2D трансформация в модуле BGRATransform
TBGRAScene3D в модуле BGRAScene3D
Если Вам нужно использовать слои, модуль BGRALayers обеспечивает TBGRALayeredBitmap
Двойная буферизация на самом деле не является частью BGRABitmap, т. к. это больше относиться к
обработке форм. Для использования двойной буферизации Вы можете использовать
TBGRAVirtualScreen который находится в пакете BGRAControls.
Кроме того, двойная буферизация в BGRABitmap работает точно так же, как любая двойная
буферизация. Вам нужно иметь битмап, где Вы храните ваш рисунок и затем отображаете его одной
командой Draw.
Простой пример
1
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Вы должны скопировать модули BGRABitmap и подключить их к проекту:
Uses Classes, SysUtils, BGRABitmap, BGRABitmapTypes;
Модуль BGRABitmapTypes содержит все необходимые объявления, но можно объявить только
BGRABitmap для того, чтобы загрузить и показать растровое изображение. Затем, первым шагом будет
создание объекта TBGRABitmap:
var bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(100,100,BGRABlack); //создаёт изображение размером 100x100 пикселей с чёрным фоном
bmp.FillRect(20,20,60,60,BGRAWhite, dmSet); //рисует белый прямоугольник без прозрачности
bmp.FillRect(40,40,80,80,BGRA(0,0,255,128), dmDrawWithTransparency); //рисует прозрачный синий прямоугольник
end;
Наконец показываем рисунок:
procedure TFMain.FormPaint(Sender: TObject);
begin
bmp.Draw(Canvas, 0, 0, True); // рисует битмап в непрозрачном режиме (быстрее)
end;
Понятия
Пиксели в изображении с прозрачностью хранятся с 4 значениями, это 4 байта в порядке синий,
зелёный, красный, альфа. Последний канал определяет уровень прозрачности (0 означает прозрачный,
255 означает непрозрачный), другие каналы определяют цвет и интенсивность.
Существуют два основных режима рисования. Первый состоит в замене содержание информации
пикселя, второй состоит в смешивании пикселя уже здесь с новым, который называется альфасмешивание.
Функции BGRABitmap предлагают 4 режима:




dmSet : замена 4 байт рисуемого пикселя, прозрачность не обрабатывается
dmDrawWithTransparency : рисует с альфа-смешиванием и гамма-коррекцией (см. ниже)
dmFastBlend или dmLinearBlend : рисует с альфа-смешиванием, но без гамма-коррекции
(быстрее, но влечёт за собой цветовые искажения низкой интенсивности)
dmXor : применяется Xor для каждого компонента, в т.ч. альфу (если Вы хотите инвертировать
цвета, но использовать альфу, используйте BGRA(255,255,255,0) )
Встроенные функции рисования







прорисовка/очистка пикселей
прорисовка линий с/без сглаживанием
координаты с плавающей точкой
ширина пера с плавающей точкой
прямоугольник (контур или заполненный)
эллипс и полигоны со сглаживанием
вычисление сплайна (округлая кривая)
2
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/




простая заливка (FloodFill) или прогрессивная заливка
градиент цвета рендеринга (линейный, радиальный...)
округленные прямоугольники
текст с прозрачностью
Рисование на канве
Это можно сделать с объектом Canvas, с обычными функциями, но без сглаживания. Непрозрачность
рисунка определяется свойством CanvasOpacity. Этот способ медленнее, поскольку ему необходимо
преобразование изображения. По возможности, используйте CanvasBGRA вместо этого, который
поддерживает прозрачность и сглаживание, имея те же имена функций как с TCanvas.
Прямой доступ к пикселям
Для доступа к пикселям есть два свойства, Data и Scanline. Первый дает указатель на первый пиксель
изображения, а второй дает указатель на первый пиксель данной линии.
var
bmp: TBGRABitmap;
p: PBGRAPixel;
n: integer;
begin
bmp := TBGRABitmap.Create('image.png');
p := bmp.Data;
for n := bmp.NbPixels-1 downto 0 do
begin
p^.red := not p^.red; //инверсия красного канала
inc(p);
end;
bmp.InvalidateBitmap; //внимание, прямой доступ к пикселям
bmp.Draw(Canvas,0,0,True);
bmp.Free;
end;
Необходимо вызвать функцию InvalidateBitmap для восстановления изображение в следующем вызове
Draw, например. Обратите внимание, что порядок линий может быть обратным, в зависимости от
свойства LineOrder.
См. также сравнение методов прямого доступа к пикселям
Работа с изображениями
Доступные фильтры (с префиксом Filter) :



Radial blur : ненаправленное размытие
Motion blur : направленное размытие
Custom blur : размытие по маске




Median : вычисляет медиану цветов каждого пикселя, который смягчает углы
Pixelate : упрощает изображение прямоугольниками того же цвета
Smooth : смягчить все изображение, дополнительно к Sharpen
Sharpen : делает контур более чётким, дополнительно к Smooth

Contour : рисует контуры с белым фоном (аналогично рисованию карандашом)
3
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/


Emboss : рисует контуры с тенью
EmbossHighlight : рисует контуры выделения из определённого оттенка серого


Grayscale : конвертирует в оттенки серого с гамма-коррекцией
Normalize : использует весь спектр цвета светимости





Rotate : поворот изображения вокруг точки
Sphere : искажает изображение, чтобы сделать его похожим на проекцию на сфере
Twirl : искажает изображение с эффектом скручивания
Cylinder : искажает изображение, чтобы сделать его похожим на проекцию на цилиндре
Plane : вычисляет высокую точность проекции на горизонтальную плоскость. Это довольно
медленно.
SmartZoom3 : изменяет размер изображения x3 и обнаруживает границы, чтобы иметь полезную
зум с древних игровых спрайтов

Некоторые функции не имеют префикса Filter, потому что они не возвращают новое размещенное
изображение. Они изменяют образ на месте:







VerticalFlip : переворачивает изображение по вертикали
HorizontalFlip : переворачивает изображение по горизонтали
Negative : инвертирует цвета
LinearNegative : инверсия цветов без гамма-коррекции
SwapRedBlue : меняет местами красный и синий каналы (для конвертации между BGRA и
RGBA)
ConvertToLinearRGB : для конвертирования sRGB в RGB. Примечание: формат, используемый
BGRABitmap является SRGB при использовании dmDrawWithTransparency и RGB при
использовании dmLinearBlend.
ConvertFromLinearRGB : конвертирует RGB в sRGB.
Комбинирование изображений
PutImage основная функция рисования изображений и BlendImage позволяет комбинировать
изображения, как слои в программах редактирования изображений. Доступные следующие режимы:















LinearBlend : просто наложение без гамма-коррекции (эквивалент dmFastBlend)
Transparent : Наложение с гамма-коррекцией
Multiply : умножение значений цвета (с гамма-коррекцией)
LinearMultiply : умножение значений цвета (без гамма-коррекции)
Additive : Добавление цветовых значений (с гамма-коррекцией)
LinearAdd : добавление цветовых значений (без гамма-коррекции)
Difference : разность значений цвета (с гамма-коррекцией)
LinearDifference : разность значений цвета (без гамма-коррекции)
Negation : делает распространенные цвета исчезающими (с гамма-коррекцией)
LinearNegation : делает распространенные цвета исчезающими (без гамма-коррекции)
Reflect, Glow : для световых эффектов
ColorBurn, ColorDodge, Overlay, Screen : различные фильтры
Lighten :сохраняет самые светлые цветовые значения
Darken : сохраняет самые тёмные цветовые значения
Xor : исключающее или цветовых значений
4
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Эти режимы могут быть использованы в TBGRALayeredBitmap, что делает его легче, потому что только
BlendImage обеспечивает основные операции смешивания.
Скриншоты
5
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Лицензия
modified LGPL
Автор: Johann ELSASS (Facebook)
Скачать
Sourceforge с LazPaint и BGRABitmap : http://sourceforge.net/projects/lazpaint/files/src/
6
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 1. Установка, подключение и рисование
Установка
Сначала необходимо скачать исходники BGRABitmap на http://sourceforge.net/projects/lazpaint/files/src/ и
вызуальные компоненты BGRAControls на http://sourceforge.net/projects/bgra-controls/ либо последние
изменения из SVN:
svn co https://lazpaint.svn.sourceforge.net/svnroot/lazpaint lazpaint
svn co svn://svn.code.sf.net/p/bgracontrols/svn/ bgracontrols-svn
После распаковки архивов сначала откройте файл bgrabitmappack.lpk из пакета BGRABitmapPack и
скомпилируйте его. От пересборки IDE пока откажитесь. Дальше откройте файл пакета bgracontrols.lpk
из пакета BGRAControls и также скомпилируйте, после чего выберите Установить и согласитесь на
пересборку IDE. Дождитесь окончания компиляции и перезапуска IDE, после чего в палитре
компонентов появится новая вкладка — BGRAControls.
Создайте новое приложение с помощью меню Проект > Новый проект.
Модуль главной формы нового проекта выглядит примерно так:
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs;
type
{ TForm1 }
TForm1 = class(TForm)
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
initialization
{$I UMain.lrs}
end.
Если Вы не можете найти его, нажмите Ctrl-F12 для показа списка файлов.
7
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Сохраните Ваш проект с помощью меню Файл > Сохранить все (необязательно в папку с
BGRABitmap).
Добавление ссылки на BGRABitmap
С помощью Инспектора проекта (вызывается с помощью меню Проект > Инспектор проекта)
добавьте новую зависимость BGRABitmapPack.
В разделе подключения модулей, добавьте BGRABitmap и BGRABitmapTypes после Dialogs.
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes;
Добавим немного рисования
Добавим событие рисования. Чтобы сделать это, кликните на форме, затем перейдите в Инспектор
объектов, на вкладку События, и дважды кликните по строке OnPaint. Lazarus автоматически добавит
обработчик FormPaint в модуль главной формы. Для примера добавьте следующий код в этот
обработчик:
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRABlack);
bmp.FillRect(20, 20, 100, 40, BGRA(255,192,0), dmSet); //заполнить оранжевый прямоугольник
bmp.Draw(Canvas, 0, 0, True);
//отобразить BGRABitmap на форме
bmp.Free;
//освободить память
end;
Как видите, необходимо объявить переменную типа TBGRABitmap и создать объект. Есть несколько
конструкторов для TBGRABitmap. Тот, что используется здесь создает растровое изображение
размером ClientWidth х ClientHeight и заполняет черным цветом. ClientWidth и ClientHeight являются
свойствами формы, которые возвращают доступное пространство для рисования внутри формы.
8
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Процедура FillRect принимает обычные параметры для рисования прямоугольника, левый верхний угол
и правый нижний угол плюс 1. Это означает, что пиксель на (100,40) исключается из прямоугольника.
После этого, есть параметр цвета с красной/зеленой/синей компонентами, и режим рисования. dmSet
означает просто заменить пиксели.
Не забудьте освободить объект после использования, чтобы избежать утечки памяти.
Результирующий код
Вы должны получить следующий код:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormPaint(Sender: TObject);
var bmp : TBGRABitmap;
begin
bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRABlack);
bmp.FillRect(20, 20, 100, 40, BGRA(255,192,0), dmSet); //заполнить оранжевый прямоугольник
bmp.Draw(Canvas, 0, 0, True);
//отобразить BGRABitmap на форме
bmp.Free;
//освободить память
end;
end.
Запуск программы
Вы должны получить черное окно с оранжевым
прямоугольником внутри.
9
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 2. Загрузка изображений
Создание нового проекта
Создайте новый проект и добавьте ссылку на BGRABitmap, тем же путём, что и в первом уроке.
Загрузка изображения
Скопируйте изображение в папку Вашего проекта. Давайте назовём его image.png.
Добавим в раздел private формы переменную, где будет находиться изображение:
TForm1 = class(TForm)
private
{ private declarations }
image: TBGRABitmap;
public
{ public declarations }
end;
Будем загружать изображение во время создания формы. Чтобы сделать это, дважды кликните на
форме, соответствующая процедура добавится в исходный код. Добавим команды для загрузки:
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create('image.png');
end;
Прорисовка изображения
Добавим событие OnPaint. Чтобы сделать это, кликните на форме, затем перейдите в Инспектор
объектов, на вкладку События, и дважды кликните по строке OnPaint. Затем добавим код для
рисования:
procedure TForm1.FormPaint(Sender: TObject);
begin
image.Draw(Canvas,0,0,True);
end;
Обратите внимание, что последний параметр установлен в True, что означает непрозрачный. Если вы
хотите принять во внимание прозрачные пиксели закодированные в альфа-канале, вы должны вместо
этого использовать False. Но использование прозрачного рисунка на стандартном холсте может
работать медленно, так что если это не необходимо, используйте только непрозрачный рисунок.
Код
В конечном результате Вы должны получить следующее:
unit UMain;
10
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
image: TBGRABitmap;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create('image.png');
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
image.Draw(Canvas,0,0,True);
end;
initialization
{$I UMain.lrs}
end.
Запуск программы
Вы должны увидеть форму с изображением, нарисованным от левого верхнего угла.
11
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Центрирование изображения
Вы можете захотеть центрировать изображение на форме. Чтобы сделать это, измените процедуру
FormPaint:
procedure TForm1.FormPaint(Sender: TObject);
var ImagePos: TPoint;
begin
ImagePos := Point( (ClientWidth - Image.Width) div 2,
(ClientHeight - Image.Height) div 2 );
// тест на отрицательные координаты
if ImagePos.X < 0 then ImagePos.X := 0;
if ImagePos.Y < 0 then ImagePos.Y := 0;
image.Draw(Canvas,ImagePos.X,ImagePos.Y,True);
end;
Для просчёта положения, нам необходимо рассчитать расстояние между изображением и левой
границей формы (X координата) и расстояние между изображением и верхней границей формы (Y
координата). Выражение ClientWidth - Image.Width возвращает доступное горизонтальное расстояние, и
мы делим его пополам чтобы получить левое поле.
Результат может быть негативным, если изображение больше, чем ширина формы. В этом случае,
граница просто устанавливается в 0.
Вы можете запустить программу и посмотреть как это работает. Обратите внимание, что произойдет,
если мы уберем тест на отрицательную позицию.
Растяжение изображения
Чтобы растянуть изображение, нам необходимо создать временное растянутое изображение:
procedure TForm1.FormPaint(Sender: TObject);
var stretched: TBGRABitmap;
begin
stretched := image.Resample(ClientWidth, ClientHeight) as TBGRABitmap;
stretched.Draw(Canvas,0,0,True);
stretched.Free;
end;
По умолчанию используется качественная дискретизация, но если Вы хотите использовать просто
растяжение (быстрее) :
stretched := image.Resample(ClientWidth, ClientHeight, rmSimpleStretch) as TBGRABitmap;
Вы также можете указать фильтр интерполяции со свойством ResampleFilter:
image.ResampleFilter := rfMitchell;
stretched := image.Resample(ClientWidth, ClientHeight) as TBGRABitmap;
12
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 3. Рисование
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Создайте изображение
В разделе private главной формы добавьте переменную для хранения изображения:
TForm1 = class(TForm)
private
{ private declarations }
image: TBGRABitmap;
public
{ public declarations }
end;
Создайте изображение при создании формы. Чтобы сделать это, дважды кликните на форме,
соответствующая процедура добавится в Редакторе кода. Добавьте следующую инструкцию для
создания:
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create(640,480,BGRAWhite);
end;
//создаёт изображение размером 640x480
Рисование изображения
Добавим обработчик OnPaint. Чтобы сделать это выберите форму, затем перейдите в инспектор
объектов, на вкладку события, и дважды кликните напротив строки OnPaint. Затем добавьте код для
рисования:
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
Добавим процедуру PaintImage:
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
После написания этого, поставьте курсор на PaintImage и нажмите Ctrl-Shift-C для добавления
декларации в интерфейсную часть.
Обработка мыши
13
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
С помощью инспектора объектов, добавим обработчики для событий MouseDown и MouseMove:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then DrawBrush(X,Y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then DrawBrush(X,Y);
end;
Добавим процедуру DrawBrush:
procedure TForm1.DrawBrush(X, Y: Integer);
const radius = 5;
begin
image.GradientFill(X-radius,Y-radius, X+radius,Y+radius,
BGRABlack,BGRAPixelTransparent, gtRadial,
PointF(X,Y), PointF(X+radius,Y), dmDrawWithTransparency);
PaintImage;
end;
После написания этого кода, поставьте курсор на DrawBrush и нажмите Ctrl-Shift-C для добавления
описания в интерфейсную часть.
Эта процедура рисует как радиальным градиентом (gtRadial) :



ограничивающий прямоугольник является (X-radius,Y-radius, X+radius,Y+radius).
центр черный, граница прозрачна
центр как (X,Y) и граница как (X+radius,Y)
Код
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
image: TBGRABitmap;
procedure DrawBrush(X, Y: Integer);
procedure PaintImage;
public
{ public declarations }
14
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create(640,480,BGRAWhite);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then DrawBrush(X,Y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then DrawBrush(X,Y);
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.DrawBrush(X, Y: Integer);
const radius = 20;
begin
image.GradientFill(X-radius,Y-radius, X+radius,Y+radius,
BGRABlack,BGRAPixelTransparent,gtRadial,
PointF(X,Y), PointF(X+radius,Y), dmDrawWithTransparency);
PaintImage;
end;
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
initialization
{$I UMain.lrs}
end.
Запуск программы
Вы можете рисовать на форме
15
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Непрерывное рисование
Чтобы иметь непрерывное рисование, необходимо добавить дополнительные переменные:
TForm1 = class(TForm)
...
private
{ private declarations }
image: TBGRABitmap;
mouseDrawing: boolean;
mouseOrigin: TPoint;
mouseDrawing будет True пока рисуем (с нажатой левой кнопкой мыши) и mouseOrigin станет
начальной точкой для сегмента который рисуется.
Обработчик клика станет немного сложнее:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
mouseDrawing := True;
mouseOrigin := Point(X,Y);
DrawBrush(X,Y,True);
end;
end;
Это инициализирует рисование с текущей позиции. Затем, рисуется закрытый сегмент (обратите
внимание на новый параметр для DrawBrush). Действительно, в начале, сегмент закрыт и имеет
нулевую длину, которая дает диска :
Мало-помалу мы добавляем новую часть, которая является открытым сегментом:
Вот почему нам нужен новый параметр для функции DrawBrush, которая становится:
procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
16
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
begin
image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,BGRA(0,0,0,128),brushRadius,Closed);
mouseOrigin := Point(X,Y);
PaintImage;
end;
Мы передаем параметр Closed для DrawLineAntialias, чтобы указать, является ли сегмент закрыт или
нет. Обратите внимание на порядок координат. Начальная и конечная позиции поменялись местами.
Действительно, для DrawLineAntialias, Действительно, для DrawLineAntialias, что открывается конец, в
то время как в этом случае, мы хотим, что бы открывалось начало.
Определение DrawBrush необходимо обновить в интерфейсной части.
Обработчик MouseMove станет:
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mouseDrawing then DrawBrush(X,Y,False);
end;
В конечном результате, нам нужен обработчик MouseUp для обновления mouseDrawing:
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
mouseDrawing := False;
end;
Код
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
image: TBGRABitmap;
mouseDrawing: boolean;
mouseOrigin: TPoint;
procedure DrawBrush(X, Y: Integer; Closed: boolean);
17
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
procedure PaintImage;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create(640,480,BGRAWhite);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
mouseDrawing := True;
mouseOrigin := Point(X,Y);
DrawBrush(X,Y,True);
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if mouseDrawing then DrawBrush(X,Y,False);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
mouseDrawing := False;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
begin
image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,BGRA(0,0,0,128),brushRadius,Closed);
mouseOrigin := Point(X,Y);
PaintImage;
end;
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
initialization
{$I UMain.lrs}
end.
Запуск программы
Теперь рисунок почти непрерывный:
18
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 4. Прямой доступ к пикселям
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Добавим обработку прорисовки
С помощью инспектора объектов, добавим обработчик OnPaint и напишем:
procedure TForm1.FormPaint(Sender: TObject);
var x,y: integer;
p: PBGRAPixel;
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
for y := 0 to image.Height-1 do
begin
p := image.Scanline[y];
for x := 0 to image.Width-1 do
begin
p^.red := x*256 div image.Width;
p^.green := y*256 div image.Height;
p^.blue := 0;
p^.alpha := 255;
inc(p);
end;
end;
image.InvalidateBitmap; // изменено прямым доступом
image.Draw(Canvas,0,0,True);
image.free;
end;
Эта процедура создаст рисунок размером на всю доступную клиентскую область. Затем в цикле прямым
доступом к данным пикселей задаётся двумерный градиент. Наконец изображение выводится и
освобождается.
Чтобы получить доступ к растровым данным, Вы можете использовать свойство Data, если Вы не
возражаете против порядка линий, или Scanline для доступа к конкретной линии. В пределах линии,
пиксели упорядочены слева направо. Каждый компонент определяется. Например:
p^.red := x*256 div image.Width;
Определяет красную составляющую варьирующуюся от 0 до 255 с лева на право. Максимальное
значение изображения. Ширина никогда не достигает x, так как красная составляющая никогда не
достигает 256.
Запуск программы
Вы увидите форму с градиентом, где углы чёрный, красный, жёлтый и зелёный. Когда Вы изменяете
размеры формы, градиент изменяется соответственно.
19
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Использование пространства цветов HSLA
Вы можете использовать оттенок, насыщенность и яркость. Для этого, объявите переменную типа
THSLAPixel. Её значение варьируется от 0 до 65535. Для конвертации в стандартный RGB пиксель,
используйте HSLAToBGRA.
procedure TForm1.FormPaint(Sender: TObject);
var x,y: integer;
p: PBGRAPixel;
image: TBGRABitmap;
hsla: THSLAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
hsla.lightness := 32768;
hsla.alpha := 65535;
for y := 0 to image.Height-1 do
begin
p := image.Scanline[y];
hsla.saturation := y*65536 div image.Height;
for x := 0 to image.Width-1 do
begin
hsla.hue := x*65536 div image.Width;
p^:= HSLAToBGRA(hsla);
inc(p);
end;
end;
image.InvalidateBitmap; // changed by direct access
image.Draw(Canvas,0,0,True);
image.free;
end;
Коррекция цвета
20
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Цвета HSLA имеют гамма-коррекцию, но есть и другие возможные коррекции. Например, H означает
"оттенок". В классической версии модели HSLA, каждый диапазон между основными цветами
(красный/зелёный/голубой) представлен 120 градусами, что эквивалентно 21845 цветам в THSLAPixel.
Однако, мы не воспринимаем те же различия цветов в этих различных диапазонах. Функции HtoG и
GtoH применяют либо отменяют изменения, где в оттенок G, диапазоны не имеют того же размера.
Чтобы получить скорректированный оттенок, напишем:
hsla.hue := GtoH(x*65536 div image.Width);
Обратите внимание, что диапазон оранжевых оттенков шире. Окончательно, в модели HSLA, светлость
L не соответствует воспринимаемой светлости. Вместо того, чтобы только корректировать оттенок, вы
можете использовать GSBAToBGRA и BGRAToGSBA вместо HLSAToBGRA и BGRAToHSLA. G в
данном случае означает, что оттенок автоматически корректируется и B означает, что это
воспринимается светлость (иногда используют термин яркость), которая учитывается. Поэтому Вам нет
необходимости использовать GtoH и HtoG явно.
Простой код приводится ниже:
procedure TForm1.FormPaint(Sender: TObject);
var x,y: integer;
p: PBGRAPixel;
image: TBGRABitmap;
hsla: THSLAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
hsla.lightness := 32768;
hsla.alpha := 65535;
for y := 0 to image.Height-1 do
begin
p := image.Scanline[y];
hsla.saturation := y*65536 div image.Height;
for x := 0 to image.Width-1 do
begin
hsla.hue := x*65536 div image.Width;
p^:= GSBAToBGRA(hsla);
inc(p);
end;
end;
image.InvalidateBitmap; // изменено прямым доступом
image.Draw(Canvas,0,0,True);
image.free;
end;
Обратите внимание, что используется тип THSLAPixel, независимо от коррекции цветовой модели..
Запуск программы
С полной коррекцией цвета, градиент более
прогрессивный, и выглядит как еслибы Вы
использовали цветовую модель Lab.
21
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 5. Использование слоёв
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
О масках
Маска представляет собой изображение в градациях серого цвета. Когда маска применяется к
изображению, те части изображения, которые перекрываются черными частями маски удаляются, и
становятся прозрачными, а части, которые частично совпадают с белыми частями маски остаются.
Другими словами, маска как альфа-канал определяет непрозрачность. Если значение маски равно нулю,
то становится прозрачным, а если значение маски 255, становится непрозрачным.
В этом примере, изображение, начальное изображение в левом верхнем углу, маска в верхнем правом
углу, и результат применения маски в левом нижнем углу.
Код события OnPaint:
var temp,tex,mask: TBGRABitmap;
begin
temp:= TBGRABitmap.Create(640,480,ColorToBGRA(ColorToRGB(clBtnFace)));
//загрузка и скалирование текстуры
tex := TBGRABitmap.Create('texture.png');
BGRAReplace(tex,tex.Resample(128,80));
//показываем изображение в левом верхнем углу
temp.PutImage(10,10,tex,dmDrawWithTransparency);
//создаём маску с эллипсом и прямоугольником
mask := TBGRABitmap.Create(128,80,BGRABlack);
mask.FillEllipseAntialias(40,40,30,30,BGRAWhite);
mask.FillRectAntialias(60,40,100,70,BGRAWhite);
//показываем маску в правом верхнем углу
temp.PutImage(150,10,mask,dmDrawWithTransparency);
//применяем маску на изображение
tex.ApplyMask(mask);
//показываем результат в левом нижнем углу
temp.PutImage(10,100,tex,dmDrawWithTransparency);
22
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
mask.Free;
tex.Free;
//выводим всё на экран
image.Draw(Canvas,0,0,True);
image.Free;
end;
Удаление частей изображения
Некоторые функции позволяют стереть эллипс, прямоугольник и т.д. Это означает, что часть
изображения становится прозрачной. Таким образом, можно сделать отверстие в изображении. Если
альфа параметр равен 255, отверстие полностью прозрачно. Если нет, отверстие полупрозрачно.
Здесь эллипс стирается слева с альфа параметром 255, а другой эллипс стирается справа с альфа
параметром 128.
Код события OnPaint :
var image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(640,480,ColorToBGRA(ColorToRGB(clBtnFace)));
//загружаем и скалируем текстуру
tex := TBGRABitmap.Create('texture.png');
BGRAReplace(tex,tex.Resample(128,80));
//показываем изображение
image.PutImage(10,10,tex,dmDrawWithTransparency);
//стираем части
tex.EraseEllipseAntialias(40,40,30,30,255);
tex.EraseEllipseAntialias(80,40,30,30,128);
//показываем результат
image.PutImage(10,100,tex,dmDrawWithTransparency);
tex.Free;
//выводим всё на экран
image.Draw(Canvas,0,0,True);
image.Free;
end;
Добавляем событие рисования
23
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
С помощью инспектора объектов, добавим обработчик OnPaint и напишем:
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
size: single;
procedure DrawMoon;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,size*0.4,size*0.4,BGRA(224,224,224,128));
layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.3,size*0.3,255);
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
//вычисляем доступное пространство в обеих направлениях
if image.Height < image.Width then
size := image.Height
else
size := image.Width;
image.GradientFill(0,0,image.Width,image.Height,
BGRA(128,192,255),BGRA(0,0,255),
gtLinear,PointF(0,0),PointF(0,image.Height),
dmSet);
DrawMoon;
image.Draw(Canvas,0,0,True);
image.free;
end;
Процедура создает изображение и заполняет его голубым градиентом. Это фоновый слой.
Процедура DrawMoon создаёт слой, рисует на нём луну. Рисуется первый белый диск, затем вычитается
меньший диск. Наконец, этот слой сливается с фоном.
Запуск программы
Вы можете видеть голубое небо с луной. При изменении размера формы, размеры изображения
изменяются соответственно.
Добавим ещё один слой с солнцем
В событии OnPaint, добавим следующую субпроцедуру:
24
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
procedure DrawSun;
var layer,mask: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,0),BGRA(255,0,0),
gtRadial,PointF(layer.Width/2,layer.Height/2size*0.15),PointF(layer.Width/2+size*0.45,layer.Height/2-size*0.15),
dmSet);
mask := TBGRABitmap.Create(layer.Width,layer.Height,BGRABlack);
mask.FillEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.25,size*0.25,BGRAWhite);
layer.ApplyMask(mask);
mask.Free;
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
Эта процедура создает радиальный градиент красного и оранжевого и применяет круговую маску к
нему. В результате получается цветной диск. В конечном результате слой сливается с фоном.
Добавим вызов этой процедуры для рисования после луны.
Запуск программы
Вы можете видеть голубое небо с луной и солнцем. При изменении размера формы, размеры
изображения изменяются соответственно.
Добавим слой света
В событии OnPaint, добавим следующую субпроцедуру:
procedure ApplyLight;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,255),BGRA(64,64,64),
gtRadial,PointF(layer.Width*5/6,layer.Height/2),PointF(layer.Width*1/3,layer.Height/4),
dmSet);
image.BlendImage(0,0,layer,boMultiply);
layer.Free;
end;
25
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Эта процедура рисует слой с белым радиальным градиентом. Затем применяется для сложения с
изображением.
Результирующий код
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
size: single;
procedure DrawMoon;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,size*0.4,size*0.4,BGRA(224,224,224,128));
layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.3,size*0.3,255);
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
procedure DrawSun;
var layer,mask: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,0),BGRA(255,0,0),
gtRadial,PointF(layer.Width/2,layer.Height/2size*0.15),PointF(layer.Width/2+size*0.45,layer.Height/2-size*0.15),
dmSet);
mask := TBGRABitmap.Create(layer.Width,layer.Height,BGRABlack);
mask.FillEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.25,size*0.25,BGRAWhite);
layer.ApplyMask(mask);
mask.Free;
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
procedure ApplyLight;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,255),BGRA(64,64,64),
gtRadial,PointF(layer.Width*5/6,layer.Height/2),PointF(layer.Width*1/3,layer.Height/4),
dmSet);
image.BlendImage(0,0,layer,boMultiply);
layer.Free;
end;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
if image.Height < image.Width then
size := image.Height
else
size := image.Width;
image.GradientFill(0,0,image.Width,image.Height,
BGRA(128,192,255),BGRA(0,0,255),
gtLinear,PointF(0,0),PointF(0,image.Height),
dmSet);
DrawMoon;
DrawSun;
ApplyLight;
image.Draw(Canvas,0,0,True);
image.free;
end;
Запуск программы
26
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Вы можете видеть голубое небо с луной и солнцем и эффектами света. При изменении размера формы,
размеры изображения изменяются соответственно.
27
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 6. Стили линий и фигур
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Добавим обработку прорисовки
С помощью инспектора объектов, добавим обработчик OnPaint и напишем:
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
image.RectangleAntialias(80,80,300,200,c,50);
image.Draw(Canvas,0,0,True);
image.free;
end;
Запуск программы
Это должно нарисовать прямоугольник с широким черным пером.
Изменим стиль соединения
Если вам нужны округленные углы, вы можете определить:
image.JoinStyle := pjsRound;
28
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Запуск программы
Это должно нарисовать прямоугольник с широким черным пером и скругленными углами.
Смешивание различных стилей
Вы можете смешать стили соединений для прямоугольника, как это:
image.FillRoundRectAntialias(80,80,300,200, 20,20, c, [rrTopRightSquare,rrBottomLeftSquare]);
Эта функция по умолчанию использует округленные углы, но вы можете заменить их квадратными
углами или коническими углами. Вы должны получить следующее изображение.
Изменение стиля карандаша
29
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Вы можете нарисовать точечную линию как эта:
image.JoinStyle := pjsBevel;
image.PenStyle := psDot;
image.DrawPolyLineAntialias([PointF(40,200), PointF(120,100), PointF(170,140), PointF(250,60)],c,10);
Вы должны получить следующее изображение. Обратите внимание, что строка начинается с округлой
крышки.
Изменение линии крышки
Вы можете нарисовать ломаную линию с квадратной крышкой, как это:
image.JoinStyle := pjsBevel;
image.LineCap := pecSquare;
image.PenStyle := psSolid;
image.DrawPolyLineAntialias([PointF(40,200), PointF(120,100), PointF(170,140), PointF(250,60)],c,10);
Рисование открытой линии
30
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Вы можете нарисовать линию, которая открыта, то есть конец линии округляется внутри.
image.DrawPolyLineAntialias([PointF(40,200), PointF(120,100), PointF(170,140), PointF(250,60)],c,10,False);
Таким образом, вы можете подключить линии одну за другой, не прорисовывая стык два раза, что
полезно с полупрозрачным рисунком. Вы можете сравнить это так:
c := BGRA(0,0,0,128);
image.DrawLineAntialias(40,150, 120,50, c, 10);
image.DrawLineAntialias(120,50, 170,90, c, 10);
image.DrawLineAntialias(170,90, 250,10, c, 10);
image.DrawLineAntialias(40,250, 120,150, c, 10, False);
image.DrawLineAntialias(120,150, 170,190, c, 10, False);
image.DrawLineAntialias(170,190, 250,110, c, 10, True);
31
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 7. Использование сплайнов
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Рисование открытого сплайна
С помощью инспектора объектов добавьте обработчик OnPaint и напишите:
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
pts: array of TPointF;
storedSpline: array of TPointF;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
//прямоугольная полилиния
setlength(pts,4);
pts[0] := PointF(50,50);
pts[1] := PointF(150,50);
pts[2] := PointF(150,150);
pts[3] := PointF(50,150);
image.DrawPolylineAntialias(pts,BGRA(255,0,0,150),1);
//вычисляем точки сплайна и рисуем как полилинию
storedSpline := image.ComputeOpenedSpline(pts);
image.DrawPolylineAntialias(storedSpline,c,1);
end;
image.Draw(Canvas,0,0,True);
image.free;
Эти две строчки рисуют сплайн. Первая вычисляет точки сплайна, и вторая рисует его. Обратите
внимание, что это специфическая функция для открытых сплайнов.
Рисование закрытого сплайна
Перед image.Draw, добавим следующие строчки:
for i := 0 to 3 do
pts[i].x += 200;
image.DrawPolylineAntialias(pts,BGRA(255,0,0,150),1);
storedSpline := image.ComputeClosedSpline(pts);
image.DrawPolygonAntialias(storedSpline,c,1);
Поставьте текстовый курсор на идентификатор 'i' и нажмите Ctrl-Shift-C чтобы добавить определение
переменной. Цикл смещает точки вправо.
Две новые строчки рисуют закрытый сплайн. Обратите внимание на специфическую функцию которая
рассчитывает закрытые сплайны и вызов DrawPolygonAntialias.
Вы можете избежать использования переменной для хранения точек сплайна, как это:
32
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
image.DrawPolygonAntialias(image.ComputeClosedSpline(pts),c,1);
Однако, если Вы сделаете так, Вы не сможете использовать рассчитанные точки более одного раза,
олни должны рассчитываться каждый раз когда Вам нужно их использовать.
Запуск программы
Рисуется два сплайна, открытый слева и закрытый справа.
Обратите внимание, что сплайн проходит через каждую точку. Если Вы хотите кривую внутри или
определить касательную, Вам необходимо использовать контрольные точки, которые доступны в
кривых Безье
Использование кривых Безье
Перед image.Draw добавим эти строки:
storedSpline := image.ComputeBezierSpline([BezierCurve(PointF(50,50),PointF(150,50),PointF(150,100)),
BezierCurve(PointF(150,100),PointF(150,150),PointF(50,150))]);
image.DrawPolylineAntialias(storedSpline,c,2);
Функция BezierCurve определяет кривую от начала до назначения, и одна или две контрольных точки.
Тут есть только одна контрольная точка. Здесь контрольные точки определены так, что кривая
касательная к прямоугольнику определённому ранее.
Сплайн Безье является простой
разновидностью кривых Безье. Таким
образом, функция ComputeBezierSpline
связывает массив кривых Безье. Тут мы
строим хороший разворот с двумя кривыми.
Запуск программы
Вы можете увидеть жирную кривую Безье
внутри левого прямоугольника.
33
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 8. Использование текстур
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Использование текстур кисти
Простейшая текстура штриховкой кисти.
С помощью инспектора объектов добавьте обработчик OnPaint и напишите:
procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
c: TBGRAPixel;
x,y,rx,ry: single;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
//координаты эллипса
x := 150;
y := 100;
rx := 100;
ry := 50;
//загружает кисть "diagcross" с белым рисунком и оранжевым фоном
tex := image.CreateBrushTexture(bsDiagCross,BGRAWhite,BGRA(255,192,0)) as TBGRABitmap;
image.FillEllipseAntialias(x,y,rx-0.5,ry-0.5,tex);
image.EllipseAntialias(x,y,rx,ry,c,1); //рисуем контур
tex.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Как Вы видите, текстура всего лишь изображение. Чтобы заполнить эллипс текстурой, просто
передайте текстуру в качестве параметра вместо цвета.
Две команды определяют эллипс. Первая заполняет, а вторая добавляет контур. Обратите внимание, что
радиус 0.5 пикселя меньше для заполнения. Действительно, когда толщина пера 1, внутренний радиус
0.5 меньше и внешний радиус 0.5 больше. Тем не менее, даже если Вы обратите внимание на это,
результат не будет идеальным. Если вы хотите сглаженный переход между полигонами, вам нужно
использовать TBGRAMultishapeFiller в модуле BGRAPolygon и сделать все сразу.
Используя команды для контура, мы добиваемся рисования текстурированного эллипса с границей. Но
если функция контура не доступна, Вы можете также использовать другую команду заливки с большим
радиусом с цветом границы первой, а затем с меньшим радиусом для внутренней.
Добавьте следующие строки перед tex.Free :
image.RoundRectAntialias(x-rx-10,y-ry-10,x+rx+10,y+ry+10,20,20,c,11);
34
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
image.RoundRectAntialias(x-rx-10,y-ry-10,x+rx+10,y+ry+10,20,20,tex,9);
Первая команда рисует широкий округленный прямоугольник (шириной 11) включающий границы.
Вторая команда заполняет текстурой с меньшей шириной (9). Это превосходно работает пока текстура
не прозрачна.
Запуск программы
Вы должны получить округлый прямоугольник с эллипсом внутри него. Каждая вигура заполнена
оранжевой текстурой.
Генерирование текстур
Основы карты шумов Перлина
Возможно генерирование случайных мозаичных текстур с использованием функции
CreateCyclicPerlinNoiseMap которая находится в модуле BGRAGradients.
С помощью инспектора объектов, определите обработчик OnPaint:
uses
BGRABitmap, BGRABitmapTypes, BGRAGradients;
procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
tex := CreateCyclicPerlinNoiseMap(100,100);
image.FillRect(0,0,image.Width,image.Height, tex, dmSet);
tex.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Это создаст текстуру размером 100x100, и заполнит ей форму. Вы должны получить что-то вроде этого:
35
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Изменение цвета
Это слишком чёрно-белое. Мы можем добавить немного цвета. Для этого, нам необходима некоторая
функция для интерполяции значений. Вот она:
function Interp256(value1,value2,position: integer): integer; inline;
begin
result := (value1*(256-position) + value2*position) shr 8;
end;
Эта функция вычисляет значение, идущее от Value1 до Value2. Позиция число между 0 и 256 которое
указывает, как близко результат ко второму значению. Выражение "shr 8" оптимизированный
эквивалент для "div 256" для положительных значений. Это бинарный сдвиг на 8 разрядов.
Мы хотим интерполировать цвета, так что давайте напишем функцию для интерполяции цвета:
function Interp256(color1,color2: TBGRAPixel; position: integer): TBGRAPixel; inline;
begin
result.red := Interp256(color1.red,color2.red, position);
result.green := Interp256(color1.green,color2.green, position);
result.blue := Interp256(color1.blue,color2.blue, position);
result.alpha := Interp256(color1.alpha,color2.alpha, position);
end;
Это просто: каждый компонент цвета с интерполяцией между color1 и color2 значений.
Теперь у нас есть все, чтобы сделать немного цвета. После CreatePerlinNoiseMap, добавим следующие
строки:
p := tex.Data;
for i := 0 to tex.NbPixels-1 do
begin
p^ := Interp256( BGRA(0,128,0), BGRA(192,255,0), p^.red );
inc(p);
end;
Вам нужны переменные 'p' и 'i', поэтому кликните на каждой и нажмите Ctrl-Shift-C.
Этот цикл перебирает каждый пиксель и создает цвет от темно-зеленого до светло-зелено-желтого.
36
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Получаем древовидный зеленый цвет:
Использование пороговых значений
Вместо того, чтобы изменения были непрерывны, цвет может изменяться с использованием пороговых
значений. Например, мы можем разграничить море и острова:
p := tex.Data;
for i := 0 to tex.NbPixels-1 do
begin
if p^.red > 196 then
p^ := BGRA(192,160,96) else //остров
p^ := BGRA(0,128,196); //море
inc(p);
end;
Мы можем использовать больше пороговых значений. Вот камуфляж:
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
v := p^.red;
if v < 64 then p^:= BGRA(31,33,46) else
if v < 128 then p^:= BGRA(89,71,57) else
if v < 192 then p^:= BGRA(80,106,67) else
p^:= BGRA(161,157,121);
inc(p);
end;
Функция синуса
Мы можем тут применить функцию синуса до значений шума. Давайте создадим для этого процедуру:
37
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
function CreateCustomTexture(tx,ty: integer): TBGRABitmap;
var
colorOscillation: integer;
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
colorOscillation := round(((sin(p^.red*Pi/32)+1)/2)*256);
p^ := Interp256(BGRA(181,157,105),BGRA(228,227,180),colorOscillation);
inc(p);
end;
end;
Колебание цвета — это значение между 0 и 256. Оно рассчитывается из интенсивности (p^.red). Здесь
мы применяем функцию синуса с полупериодом 32. Это даёт ряд чисел между -1 и 1. Чтобы поставить
его в диапазоне 0..1, мы добавим 1 и разделим на 2. В конечном результате, мы умножаем на 256 чтобы
получить число для Interp256.
Процедура OnPaint станет проще:
var
image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
tex := CreateCustomTexture(100,100);
image.FillRoundRectAntialias(20,20,300,200,20,20,tex);
image.RoundRectAntialias(20,20,300,200,20,20,BGRABlack,1);
tex.free;
end;
image.Draw(Canvas,0,0,True);
image.free;
Вы должны получить что-то наподобие этого:
Теперь, если мы хотим иметь вид как мрамор, нам нужно меньше колебаний. Например, мы можем
использовать полупериод 80. На мраморе, черные части очень тонкие. Мы можем исказить колебания,
применяя функцию возведения в степень: показатель между 0 и 1 сделает значения ближе к 1 и
38
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
показатель больше 1 сделает значения ближе к 0. Давайте изменим колебания, как в функции
CreateCustomTexture :
colorOscillation := round(power((sin(p^.red*Pi/80)+1)/2,0.2)*256);
Теперь мы имеем что-то более похожее на мрамор:
Текстура древесины
Текстура древесины также может быть получена с помощью функции синуса. Текстура древесины
содержит два колебания, одно для светлых цветов, и другое для тёмных цветов. Так что мы должны
применять глобальный различия между этими колебаниями:
function CreateWoodTexture(tx,ty: integer): TBGRABitmap;
var
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
colorOscillation :=
round(sqrt((sin(p^.red*Pi/16)+1)/2)*256);
globalColorVariation := p^.red;
p^:=
Interp256( Interp256(BGRA(247,188,120),BGRA(255,218,170
),colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),colorOscill
ation), globalColorVariation);
inc(p);
end;
end;
Тут полупериод 16, и глобальное изменение просто
интенсивность. В результате получается нечто
вроде этого:
39
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Большую часть времени, текстура древесины ориентирована вдоль оси. Для этого, вместо
использования интенсивности только в качестве глобальной позиции, нам нужно комбинировать её с
позицией по оси x:
function CreateVerticalWoodTexture(tx,ty: integer): TBGRABitmap;
var
globalPos: single;
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
x: integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty);
p := result.Data;
x := 0;
for i := 0 to result.NbPixels-1 do
begin
globalPos := p^.red*Pi/32+x*2*Pi/tx*8;
colorOscillation := round(sqrt((sin(globalPos)+1)/2)*256);
globalColorVariation := round(sin(globalPos/8)*128+128);
p^:= Interp256( Interp256(BGRA(247,188,120),BGRA(255,218,170),colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),colorOscillation), globalColorVariation);
inc(p);
inc(x);
if x = tx then x := 0;
end;
end;
Мы получили следующее:
40
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 9. Использование затенения Фонга для
создания текстур
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Затенение Фонга и свет
Для использования затенения Фонга, вам нужно создать экземпляр класса TPhongShading. Он описан в
модуле BGRAGradients.
Давайте добавим переменную в определении формы:
TForm1 = class(TForm)
...
phong: TPhongShading;
При создании формы мы создаём экземпляр класса :
procedure TForm1.FormCreate(Sender: TObject);
begin
phong := TPhongShading.Create;
phong.LightPositionZ := 150;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.LightSourceIntensity := 250;
phong.LightSourceDistanceTerm := 200;
end;
Индекс зеркальности показывает, насколько концентрированный отраженный свет.
Когда форма уничтожается:
procedure TForm1.FormDestroy(Sender: TObject);
begin
phong.Free;
end;
Когда форма перерисовывается, добавим некоторый объект с затенением Фонга:
var
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
image.Draw(Canvas,0,0,True);
image.free;
41
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
end;
В качестве параметра функции DrawSphere изображение назначения, границы объекта, максимальная
высота и цвет. Диаметр сферы 100 поэтому максимальная высота of a полушария 50.
Наконец, когда мышь перемещается, было бы неплохо чтобы источник света следовал за курсором :
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
phong.LightPosition := point(X,Y);
FormPaint(Sender);
end;
Запуск программы
Вы можете поиграться с освещением сферы :
Использование затенения Фонга для создания текстуры
Следующая процедура создаст кусок шоколада:
function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
square,map: TBGRABitmap;
phong: TPhongShading;
margin: integer;
begin
margin := tx div 20; //пустое место вокруг квадрата
square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
//создать карту с квадратом посредине
map := TBGRABitmap.Create(tx,ty,BGRABlack);
map.PutImage(margin,margin,square,dmDrawWithTransparency);
//применить размытие, чтобы сделать его более гладким
BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
square.free;
//создание результирующего изображения
result := TBGRABitmap.Create(tx,ty);
//использование затенения Фонга
phong := TPhongShading.Create;
42
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50,-100);
phong.LightPositionZ := 80;
//нарисовать кусочек шоколада с максимальной высотой 20
phong.Draw(result,map,20,0,0,BGRA(86,41,38));
map.Free;
phong.Free;
end;
Шейдер Фонга использует карту высот для визуализации световых эффектов. Здесь, карта содержит
квадрат.
Среди свойств шейдера Фонга есть LightSourceDistanceFactor и LightDestFactor. Установка этих
значений в ноль делает результат мозаичным. В самом деле, когда коэффициент равен нулю, расстояние
между светом и объектом не учитывается, и когда фактор назначения света равен нулю, то положение
объекта не принимается во внимание при вычислении угла света.
Теперь, когда форма создана, создадим текстуру шоколада:
chocolate := CreateChocolateTexture(80,80);
И когда форма уничтожается:
chocolate.Free;
Перед phong.DrawSphere в событии OnPaint добавим эту строчку:
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
Результирующий код
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, BGRABitmap, BGRABitmapTypes, BGRAGradients;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
43
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
{ private declarations }
public
{ public declarations }
phong: TPhongShading;
chocolate: TBGRABitmap;
end;
var
Form1: TForm1;
implementation
function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
square,map: TBGRABitmap;
phong: TPhongShading;
margin: integer;
begin
margin := tx div 20;
square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
map := TBGRABitmap.Create(tx,ty,BGRABlack);
map.PutImage(margin,margin,square,dmDrawWithTransparency);
BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
square.free;
result := TBGRABitmap.Create(tx,ty);
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50,-100);
phong.LightPositionZ := 80;
phong.Draw(result,map,20,0,0,BGRA(86,41,38));
map.Free;
phong.Free;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
phong := TPhongShading.Create;
phong.LightPositionZ := 150;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.LightSourceIntensity := 250;
phong.LightSourceDistanceTerm := 200;
chocolate := CreateChocolateTexture(80,80);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
phong.Free;
chocolate.Free;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
phong.LightPosition := point(X,Y);
FormPaint(Sender);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
image.Draw(Canvas,0,0,True);
image.free;
44
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
end;
initialization
{$I UMain.lrs}
end.
Запуск программы
Вы должны увидеть хороший кусок шоколада с большой вишней:
Использование Шума Перлина и затенения Фонга вместе
Идея состоит в том, чтобы создать карту с шумом Перлина, а затем использовать затенение Фонга для
отображения. Вот как создаётся текстура камня:
function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
var
temp: TBGRABitmap;
phong: TPhongShading;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,0.6);
temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 100;
phong.LightPositionZ := 100;
phong.NegativeDiffusionFactor := 0.3;
phong.AmbientFactor := 0.5;
phong.Draw(result,temp,30,-2,-2,BGRA(170,170,170));
phong.Free;
temp.Free;
end;
Во-первых, мы создаем циклическую карту. Важно, чтобы он был циклическим, для того, чтобы сделать
мозаичную текстуру. Но затем, когда мы будем применять затенение Фонга, мы должны сделать
шейдер в курсе цикла. Так, с GetPart, мы извлекаем сгенерированную карту с еще 2 пикселями на
каждой границе, таким образом шейдер может быть применен к карте с циклом.
45
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Вызов phong.Draw со смещением (-2,-2) отображает карту в нужном месте, tпринимая во внимание, что
мы добавили два пикселя.
Теперь в событии OnPaint:
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
stone: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
stone := CreateStoneTexture(100,100);
image.FillEllipseAntialias(200,100,150,50,stone);
stone.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Запуск программы
Вы можете увидеть форму с фоном камня.
Рендеринг воды
Это почти та же процедура для получения текстуры воды:
function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
const blurSize = 5;
var
temp: TBGRABitmap;
phong: TPhongShading;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize)) as TBGRABitmap;
BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 150;
phong.LightPositionZ := 80;
phong.LightColor := BGRA(105,233,240);
phong.NegativeDiffusionFactor := 0.3;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));
phong.Free;
temp.Free;
46
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
end;
Главное отличие в том, что мы применяем фильтр размытия, чтобы сделать воду гладкой и
устанавливаем светлый цвет.
Использование пороговых значений для визуализации снежных отпечатков
Есть возможность хранить лишь небольшой поддиапазон высот, иметь текстуру, которая показывает
отпечатки ног на снегу.
function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
var
v: integer;
p: PBGRAPixel;
i: Integer;
temp: TBGRABitmap;
phong: TPhongShading;
begin
//здесь генерируется случайная карта
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
//теперь мы применяем пороговые значения
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
v := p^.red;
//если значение выше 80 или ниже 50, то мы делим его на 10
//чтобы сделать её почти горизонтально
if v > 80 then v := (v-80) div 10+80;
if v < 50 then v := 50-(50-v) div 10;
p^.red := v;
p^.green := v;
p^.blue := v;
inc(p);
end;
//сделать шейдер Фонга в курсе цикла
temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
//применить радиальное размытие
BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 100;
phong.LightPositionZ := 100;
phong.NegativeDiffusionFactor := 0.3; //хотим теней
phong.Draw(result,temp,30,-2,-2,BGRAWhite);
phong.Free;
temp.Free;
47
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
end;
Мы получим это:
48
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 10. Наложение текстур
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Использование не конкретного сопоставления
Давайте посмотрим, что произойдет, если мы нарисуем многоугольник с текстурой, используя
сопоставление по умолчанию:
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
//чёрный фон
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png'); //загрузка изображения
image.FillPolyAntialias( [PointF(110,10), PointF(250,10), PointF(350,160), PointF(10,160)], tex);
tex.Free;
image.Draw(Canvas,0,0,True); //рисуем на экране
image.free;
end;
Запуск программы
Вы должны получить что-то вроде этого:
Как видите, изображение не деформируется.
Афинное преобразование
Мы можем применить аффинное преобразование, как это:
uses BGRABitmap, BGRABitmapTypes, BGRATransform;
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
49
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
affine: TBGRAAffineBitmapTransform;
begin
//чёрный фон
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png'); //загрузка изображения
//создать вращение 45°
affine := TBGRAAffineBitmapTransform.Create(tex,True);
affine.RotateDeg(45);
//использовать эту трансформацию в качестве параметра вместо tex
image.FillPolyAntialias( [PointF(110,10), PointF(250,10), PointF(350,160), PointF(10,160)], affine);
affine.Free;
tex.Free;
image.Draw(Canvas,0,0,True); //draw on the screen
image.free;
end;
Запуск программы
Вы должны получить повернутую картину на полигоне:
Наложение текстур
Теперь, если мы хотим, чтобы текстура была выровнена с границей полигона, мы можем использовать
наложение текстуры.
Линейное отображение
Линейное отображение растягивает изображение линейно вдоль границ. Чтобы сделать это:
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png');
image.FillPolyLinearMapping( [PointF(110,10), PointF(250,10), PointF(350,160), PointF(10,160)], tex,
[PointF(0,0), PointF(tex.width-1,0), PointF(tex.Width-1,tex.Height-1), PointF(0,tex.Height-1)],
true);
tex.Free;
image.Draw(Canvas,0,0,True);
50
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
image.free;
end;
Чтобы сделать отображение, мы используем FillPolyLinearMapping. Появляются некоторые новые
параметры. Координаты текстуры определяют, для каждой точки полигона, расположения в текстуре.
Опция интерполяции используется для лучшего качества.
Запуск программы
Теперь текстура деформируется в соответствии с фигурой полигона.
Перспективное отображение
Перспективное отображение позволяет изменять глубину каждой точки.
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png');
image.FillPolyPerspectiveMapping( [PointF(110,10), PointF(250,10), PointF(350,160), PointF(10,160)],
[75,
75,
50,
50],
tex, [PointF(0,0), PointF(tex.width-1,0), PointF(tex.Width-1,tex.Height-1), PointF(0,tex.Height-1)],
true);
tex.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Здесь глубина 75 для верхней части полигона и 50 для нижней части полигона. То есть низ ближе к
наблюдателю, как если бы он был горизонтальным, как пол.
Запуск программы
Теперь кажется, что это 3D полигон:
51
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Заключение
Использование этой техники позволяет деформировать изображение, как с помощью инструмента
LazPaint "grid deformation", или для рендеринга 3D объектов с текстурами, как в тестах 19-21
testbgrafunc (также в архиве LazPaint).
Урок 11. Объединение трансформаций
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Аффинное преобразование радиального градиента
Вот аффинное преобразование, примененное на градиент, как мы делали с текстурами:
uses BGRAGradientScanner, BGRATransform;
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
grad: TBGRAGradientScanner;
affine: TBGRAAffineScannerTransform;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAGradientScanner.Create(BGRA(0,0,255),BGRAWhite,gtRadial,PointF(0,0),PointF(1,0),True,True);
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(150,80);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
image.Fill(affine);
affine.free;
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Основа градиента радиальная, с центром в (0,0), радиус 1.
Аффинное преобразование делает следующее :
52
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/



растягивает градиент до размера 150x80
повернуть на 30 градусов против часовой стрелки
центрирует его на форме
Команда Fill рисует результат на изображении.
Запуск программы
Вы должны получить голубой и белый эллиптический градиент.
Объединение со скручиванием
Мы можем добавить еще одно преобразование к этому:
var image: TBGRABitmap;
grad: TBGRAGradientScanner;
affine: TBGRAAffineScannerTransform;
twirl: TBGRATwirlScanner;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAGradientScanner.Create(BGRA(0,0,255),BGRAWhite,gtRadial,PointF(0,0),PointF(1,0),True,True);
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(150,80);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
twirl := TBGRATwirlScanner.Create(affine,Point(ClientWidth div 2, ClientHeight div 2),100);
image.Fill(twirl);
twirl.Free;
affine.free;
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Тут мы просто создаём преобразование скручивания применительно к предыдущему, и заполняем ним.
Запуск программы
Теперь центр градиента закручен.
53
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Использование настраиваемого сканера
Мы можем захотеть создать собственный генератор градиентов. Вот, например, множественный
градиент:
type
{ TBGRAMultiplyScanner }
TBGRAMultiplyScanner = class(TBGRACustomScanner)
function ScanAt(X, Y: Single): TBGRAPixel; override;
end;
{ TBGRAMultiplyScanner }
function TBGRAMultiplyScanner.ScanAt(X, Y: Single): TBGRAPixel;
function cycle512(value: integer): integer; inline;
begin
result := value and 511;
if result >= 256 then result := 511-result;
end;
var
mul: integer;
begin
mul := cycle512(round(x*y));
result := BGRA(mul,mul,mul,255);
end;
Он является производным от TBGRACustomScannerдля который используется для заполнения, и
функция ScanAt переназначена. Это вычисляет произведение как от координат и делать с ним цикл 512
(от 0 to 255 и затем от 255 до 0).
Давайте нарисуем его на экране с помощью простого аффинного преобразования:
var image: TBGRABitmap;
grad: TBGRAMultiplyScanner;
affine: TBGRAAffineScannerTransform;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAMultiplyScanner.Create;
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(6,4);
affine.Translate(ClientWidth/2, ClientHeight/2);
image.Fill(affine);
affine.free;
54
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Запуск программы
Это должно выглядеть примерно так:
Делаем красиво
Добавьте немного цвета путем изменения процедуры ScanAt из умножения градиента :
var
mul: integer;
begin
mul := round(x*y);
result := BGRA(cycle512(round(x*10)),cycle512(mul),cycle512(round(y*10)),255);
end;
Красные и синие интенсивности заполнены в цикле х и у позиции.
И добавим немного вращения:
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(6,4);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
55
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 12. Вывод текста
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Простой текст
Вы можете вывести простой текст:
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, ColorToBGRA(ColorToRGB(clBtnFace)) );
c := ColorToBGRA(ColorToRGB(clBtnText)); //получить цвет текста по умолчанию
image.FontHeight := 30;
image.FontAntialias := true;
image.FontStyle := [fsBold];
image.TextOut(ClientWidth-5,5,'Hello world',c,);
image.SetPixel(5,5,c);
image.Draw(Canvas,0,0,True);
image.free;
end;
Здесь размер шрифта установлен в 30 пикселей, со сглаживанием. Использование сглаживания шрифта
работает медленнее, но красивее выглядит.
Верхний левый угол текста находится в (5,5). Такое начало всегда отображается с SetPixel.
Использование выравнивания
Всего лишь замените строки TextOut и SetPixel следующими:
image.TextOut(ClientWidth-5,5,'Hello world',c,taRightJustify);
image.SetPixel(ClientWidth-5,5,c);
Теперь начало находится на правой стороне формы, и текст выравнивается вправо.
56
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Поворот текста
Также просто рисовать текст с разворотом. Для этого используйте TextOutAngle или установите
свойство FontOrientation:
image.TextOutAngle(30,5,-450,'Hello world',c, taLeftJustify);
image.SetPixel(30,5,c);
Угол в десятой части градуса и положительное значение означает против часовой стрелки.
Обратите внимание, где начало координат текста(добавлен пиксель).
Перенос текста
Существует простой в использовании вариант TextRect:
image.TextRect(rect(5,5,ClientWidth-5,ClientHeight-5),'This is a text that should be word
wrapped',taCenter,tlCenter,c);
image.Rectangle(rect(5,5,ClientWidth-5,ClientHeight-5),c,dmSet);
Параметры:





ограничивающая рамка
текст
горизонтальное выравнивание
вертикальное выравнивание
цвет
Текст с тенью
57
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Можно получить текст с тенью с эффектом размытия:
var
image,txt: TBGRABitmap;
grad: TBGRAGradientScanner;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, ColorToBGRA(ColorToRGB(clBtnFace)) );
c := ColorToBGRA(ColorToRGB(clBtnText));
txt := TextShadow(ClientWidth,ClientHeight,'Hello world',30,c,BGRABlack,5,5,5);
image.PutImage(0,0,txt,dmDrawWithTransparency);
txt.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;
Процедура TextShadow создаёт изображение содержащее текст с тенью. Параметры:






размер изображения
текст
высота текста
цвет текста
цвет тени
смещение тени и размер размытия
Не забывайте освобождать изображение после использования.
Текст с градиентом
Как и в других функциях рисования, Вы можете назначить градиент или текстуру для заполнения
текста. Вот пример:
uses BGRAGradientScanner;
var
image: TBGRABitmap;
grad: TBGRAGradientScanner;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, ColorToBGRA(ColorToRGB(clBtnFace)) );
grad :=
TBGRAGradientScanner.Create(BGRA(255,255,0),BGRA(255,0,0),gtLinear,PointF(0,0),PointF(0,35),True,True);
image.FontHeight := 30;
image.FontAntialias := true;
image.FontStyle := [fsBold];
image.TextOut(6,6,'Hello world',BGRABlack); //рисуем чёрную рамку
image.TextOut(5,5,'Hello world',grad);
//рисуем градиентный текст
grad.free;
image.Draw(Canvas,0,0,True);
58
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
image.free;
end;
Сперва создаётся горизонтальный синусный градиент, с жёлтым и красным цветами. Затем он
используется в качестве текстуры.
59
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 13. Координаты пикселя
Стандартные процедуры холста используют целочисленные координаты. Этот же подход применяется и
в свойстве CanvasBGRA, который эмулирует стандартные функции холста, но со сглаживанием
(AntialiasingMode), альфасмешиванием (свойство Opacity у Pen, Brush и Font) и гамма-коррекцией.
При использовании чисто целочисленными координатами без сглаживания, координаты определяются
позицией пикселя, напр. квадрат. Поэтому когда рисуется линия от (0,0) до (5,5), левый верхний
пиксель первый прорисовываемый пиксель. На стандартном холсте, последний пиксель не рисуется,
поэтому окончание линии будет в (4,4).
Когда рисуется эллипс, ограничивающий прямоугольник определяет пиксели, которые будут
использоваться для визуализации эллипса. Ещё раз, на стандартном холсте, нижняя правая координата
исключается из прорисовки, таким образом заполняемый прямоугольник (0,0)-(5,5) будет на самом деле
заполнять пиксели с координатами от 0 до 4.
Координаты с плавающей точкой
Теперь, при работе со значениями с плавающей точкой, координаты определяют позицию которая
может быть в любом месте пикселей. Значение ширины пера означает действительно расстояние, а не
количество пикселей. Так что же означает (0.0,0.0)?
Верхнее левое расстояние в координатах с плавающей точкой
Это может быть, например, расстояние от верхнего левого угла (это не в случае с BGRABitmap). В этом
случае, эти координаты могут быть левым верхним углом первого пикселя. Но если вы это сделаете,
поведение незначительно отличается между целочисленными координатами и координатами с
плавающей точкой. Действительно, представим, что мы нарисовали горизонтальный сегмент между
пикселями с координатами (0,1) и (4,1). В координатах пикселей это будет линия (0,1)-(5,1) и ширина
будет1 пиксель. Теперь, если мы хотим определить этот сегмент в координатах с плавающей точкой.
Левая сторона будет в 0.0, правая в 5.0, это нормально. Верх будет в 1.0 и низ в 2.0. Вот в чём проблема.
60
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Центр линии будет в вертикальной координате 1.5. Поэтому чтобы нарисовать эту линию, мы должны
поставить координаты (0.0,1.5)-(5.0,1.5).
На самом деле каждый 1-пиксель линии с целочисленными координатами будет нарисован между
пикселями, и со сглаживанием, это приводит к смазыванию линий. То, что казалось хорошо с
горизонтальными координатами, на самом деле иллюзия, потому что если линия имеет окончания,
правильные координаты (0.5,1.5)-(4.5,1.5). Если мы будем игнорировать проблему последнего пикселя,
мы видим, что эти координаты просто больше на 0,5.
Координаты с плавающей точкой центра пикселя
Координаты могут быть расстоянием от центра верхнего левого пиксела. Другими словами,
целочисленные значения в центре пикселей. Это в случае с функциями BGRABitmap. Используя эти
координаты, линия, которая заполняет пиксели от (0,1) до (4,1) просто (0.0,1.0)-(4.0,1.0).
61
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Это странно с математической точки зрения, но очень удобно, потому что можно использовать
целочисленные координаты для рисования обычных линий толщиной в 1 пиксель. Таким образом,
существует очень мало разницы между вызовами функций CanvasBGRA и обычных функций с
плавающей запятой BGRABitmap.
Создайте новый проект
Создайте проект и добавьте ссылку на BGRABitmapPack так, как описано в первом уроке.
Canvas и BGRACanvas
Давайте попробуем показать, что происходит на уровне пикселей.
Сперва используем обычный Canvas :
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
begin
image := TBGRABitmap.Create(10,10);
with image.Canvas do
begin
//очистка белым
brush.color := clWhite;
FillRect(0,0,image.width,image.height);
//blue ellipse with black border
brush.style := bsClear;
pen.color := clBlack;
Ellipse(0,0,9,9);
end;
//растянуть изображение, чтобы мы могли увидеть пиксели
BGRAReplace(image,image.Resample(image.Width*10,image.Height*10,rmSimpleStretch));
image.Draw(Canvas,0,0,True);
image.free;
end;
Опция частоты дискретизации rmSimpleStretch мешает использовать интерполяции фильтры.
Вы должны получить это:
Пиксели в координате 9 не заполнены как описано выше приблизительно в пределах прямоугольника.
Теперь, давайте нарисуем это с помощью BGRACanvas. Всего лишь изменим строку 'with':
with image.CanvasBGRA do
Теперь вы должны получить это:
62
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Результаты очень похожи за исключением сглаживания.
Тонкие рассуждения
Предположим, мы хотим заполнить сглаженный эллипс, который вписывется в точности в рисунок
размером 9x9. Мы можем попробовать следующий код:
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
begin
image := TBGRABitmap.Create(9,9,BGRAWhite);
image.FillEllipseAntialias(4,4, 4,4, BGRABlack);
BGRAReplace(image,image.Resample(image.Width*10,image.Height*10,rmSimpleStretch));
image.Draw(Canvas,0,0,True);
image.free;
end;
Мы получим:
Как видите, граница не полностью заполнена. Эллипс меньше ожидаемого. На самом деле, центр
эллипса (4,4) поэтому левая граница (0,4). Но помните, что это центр пикселя. Так что если мы хотим
чтобы эллипс подходил к граничному пикселю, нам необходимо добавить 0.5 к радиусу:
image.FillEllipseAntialias(4,4, 4.5,4.5, BGRABlack);
63
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Заполненные фигуры с холста
Следует отметить, что с помощью стандартного холста, результат крайне удивляет. Предположим, мы
хотим сделать то же самое. Мы можем попробовать это:
brush.color := clWhite;
FillRect(0,0,image.width,image.height);
brush.color := clBlue;
pen.style := psClear;
Ellipse(0,0,9,9);
Мы получим следующее:
Таким образом, в данном случае есть ещё один вычтенный пиксель. Эллипс 8 пикселей шириной тогда
как ожидаемая граница имеет 9 пикселей ширины.
64
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 14. Свойство Canvas2D BGRABitmap
Первая программа
Здесь очень простой пример:
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
ctx: TBGRACanvas2D;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRA(210,210,210));
ctx := bmp.Canvas2D;
ctx.fillStyle('rgb(240,128,0)');
ctx.fillRect(30,30,80,60);
ctx.strokeRect(50,50,80,60);
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
Биитмап имеет свойство Canvas2D которое обеспечивает функции fillRect и strokeRect. fillStyle
определён в оранжевый указанием цвета строки css. Когда фигура заполнена, используется стиль
заливки, и когда прорисовывается граница, используется стиль обводки.
Этот код равносильный коду на JavaScript: <javascript>
var canvas = document.getElementsByTagName("canvas")[0];
canvas.width = 200
canvas.height = 200
if (canvas.getContext){
var ctx = canvas.getContext("2d");
ctx.fillStyle = "rgb(240,128,0)";
ctx.fillRect(30,30,80,60);
ctx.strokeRect(50,50,80,60);
}
</javascript>
Сложные фигуры
Для рисования сложной фигуры, необходимо определить путь:
65
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
procedure pave();
begin
ctx.fillStyle ('rgb(130,100,255)');
ctx.strokeStyle ('rgb(0,0,255)');
ctx.beginPath();
ctx.lineWidth:=2;
ctx.moveTo(5,5);ctx.lineTo(20,10);ctx.lineTo(55,5);ctx.lineTo(45,18);ctx.lineTo(30,50);
ctx.closePath();
ctx.stroke();
ctx.fill();
end;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRA(210,210,210));
ctx := bmp.Canvas2D;
pave();
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
Обратите внимание, что толщина линии определяется свойством lineWidth и путь начинается с вызова
beginPath. Если Вы хотите получить больше информации о том, как работает путь, см. документацию по
javascript.
Использование трансформаций
Теперь мы можем нарисовать треугольник шесть раз с вращением путем вызова функций
преобразования.
procedure six();
var
i: Integer;
begin
ctx.save();
for i := 0 to 5 do
begin
ctx.rotate(2*PI/6);
pave();
end;
ctx.restore();
end;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRA(210,210,210));
ctx := bmp.Canvas2D;
ctx.translate(80,80);
six;
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
66
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Градиенты и использование памяти
Для использования градиентов, Canvas2D предоставляет функции createLinearGradient и createPattern.
Эти functions возвращают интерфейсный объект. Вы не должны освобождать их явно. Они
освобождаются когда на них больше нет ссылок. Например:
var
grad: IBGRACanvasGradient2D;
begin
grad := ctx.createLinearGradient(0,0,320,240);
grad.addColorStop(0.3, '#ff0000');
grad.addColorStop(0.6, '#0000ff');
ctx.fillStyle(grad);
grad := ctx.createLinearGradient(0,0,320,240);
grad.addColorStop(0.3, '#ffffff');
grad.addColorStop(0.6, '#000000');
ctx.strokeStyle(grad);
ctx.lineWidth := 5;
ctx.moveto(160,120);
ctx.arc(160,120,100,Pi/6,-Pi/6,false);
ctx.fill();
ctx.stroke();
end;
Переменной grad назначается градиентный объект, но нет вызова Free.
Больше примеров
Другие примеры находятся в папке testcanvas2d
архива BGRABitmap. Скрипты взяты с сайта Jean-Paul
Davalan где содержатся примеры HTML Canvas.
67
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 15. Отображение 3D объектов с
использованием TBGRAScene3D
Объект сцены
Объект сцены находится в модуле BGRAScene3D. Вот простой пример:
uses BGRAScene3D, BGRABitmap, BGRABitmapTypes;
procedure TForm1.FormPaint(Sender: TObject);
var
scene: TBGRAScene3D;
bmp: TBGRABitmap;
base: array of IBGRAVertex3D;
topV: IBGRAVertex3D;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRABlack);
scene := TBGRAScene3D.Create(bmp);
//создаём пирамиду
with scene.CreateObject(BGRA(255,240,128)) do
begin
//создаём вершины
topV := MainPart.Add(0,-15,0);
//основание пирамиды находится по часовой стрелке, если мы посмотрим на пирамиду снизу
base := MainPart.Add([-20,15,-20, 20,15,-20, 20,15,20, -20,15,20]);
AddFace(base);
//добавить четыре стороны, три вершины находятся по часовой стрелке
AddFace([base[0],topV,base[1]]);
AddFace([base[1],topV,base[2]]);
AddFace([base[2],topV,base[3]]);
AddFace([base[3],topV,base[0]]);
end;
scene.Render;
scene.Free;
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
Объект сцены рисует себя на объекте TBGRABitmap. Вы можете либо передать растровое изображение
в качестве параметра при создании объекта, как это было сделано тут, или назначить свойство
поверхности потом. Сцена автоматически центрируется на изображении.
Объект сцены предоставляет функцию CreateObject, которая возвращает интерфейс созданного объекта.
Объекты внутри сцены освобождаются автоматически, когда вы освобождаете сцену.
Объект имеет свойство MainPart позволяющее создавать и получать доступ к вершинам. Координаты
могут быть предоставлены в виде трех отдельных значений, записи TPoint3D, или массивом отдельных
значенийдлина которого должна быть кратна 3. Когда Вы создаёте вершину, Вы передаёте интерфейс
IBGRAVertex3D который используется для создания поверхностей. Вы можете добавить подчасти
внутри MainPart используя метод CreatePart. Там могут быть вложенные подчасти, каждая из которых
вращается с собственной матрицей относительно основной части.
Ось X направлена вправо, ось Y направлена вниз, и ось Z направлена вперёд (позади экрана). Это
означает, что XY работает так же, как и с рисунком, и есть значение глубины. Поверхности должны
быть по часовой стрелке, чтобы быть видимыми.
68
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Здесь цвет установлен для всего объекта при его создании, но вы можете настроить его индивидуально
для каждой поверхности, или для каждой вершины.
Как видите, пирамида воспринимается с одной стороны, поэтому мы видим оду поверхность. Либо там
нет освещения.
В блоке 'with', добавим следующие строки:
MainPart.Scale(1.3);
MainPart.RotateYDeg(30);
MainPart.RotateXDeg(20);
MainPart.Translate(0,-5,0);
Первая строка делает объект немного больше. Применяется два поворота. Первый вокруг оси Y и
второй вокруг оси X. Чтобы разобраться со знаком поворота, представьте, что вы смотрите в
направлении оси. Положительные значения в градусах означают поворот по часовой стрелке, и
позитивные значения в радианах означают поворот против часовой стрелки.
Наконец вертикальный перевод применяется для центрирования объекта.
Теперь добавим немного света:
//установить окружающее освещение к темному (1 нормальное освещение, 2 полностью белый)
scene.AmbiantLightness := 0.5;
//добавить направленный свет сверху-слева, максимальная освещенность будет 0.5 + 1 = 1.5
scene.AddDirectionalLight(Point3D(1,1,1), 1);
Пример использует значения освещённости. 0 означает чёрный, 1 означает цвет без изменения, и 2
означает белый. Направление берёт в качестве параметра Point3D для определения направления лучей.
Это не нужно нормализовать.
69
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Наследование от TBGRAScene3D
Код сцены может быть встроен в объект. Вот предыдущий пример в одном модуле:
unit ex1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, BGRAScene3D, BGRABitmapTypes;
type
{ TExample1 }
TExample1 = class(TBGRAScene3D)
SandColor: TBGRAPixel;
constructor Create;
procedure Render; override;
end;
implementation
{ TExample1 }
constructor TExample1.Create;
var
base: array of IBGRAVertex3D;
top: IBGRAVertex3D;
begin
inherited Create;
SandColor := BGRA(255,240,128);
//создаём пирамиду
with CreateObject(SandColor) do
begin
top := MainPart.Add(0,-15,0);
//основание пирамиды находится по часовой стрелке, если мы посмотрим на пирамиду снизу
base := MainPart.Add([-20,15,-20, 20,15,-20, 20,15,20, -20,15,20]);
AddFace(base);
//добавить четыре стороны, три вершины находятся по часовой стрелке
AddFace([base[0],top,base[1]]);
AddFace([base[1],top,base[2]]);
AddFace([base[2],top,base[3]]);
AddFace([base[3],top,base[0]]);
MainPart.Scale(1.3);
MainPart.RotateYDeg(30);
MainPart.RotateXDeg(20);
MainPart.Translate(0,-5,0);
end;
//установить окружающее освещение к темному (1 нормальное освещение, 2 полностью белый)
AmbiantLightness := 0.5;
70
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
//добавить направленный свет сверху-слева, максимальная освещенность будет 0.5 + 1 = 1.5
AddDirectionalLight(Point3D(1,1,1),1);
//у нас может быть сглаживание, потому что это простая сцена
Antialiasing := True;
end;
procedure TExample1.Render;
begin
//заполнить фон
Surface.GradientFill(0,0,Surface.Width,Surface.Height,SandColor,MergeBGRA(SandColor,BGRABlack),gtRadial,PointF(0
,0),PointF(Surface.Width,Surface.Height),dmSet);
inherited Render;
end;
end.
Теперь, для рисования сцены, просто делаем:
uses BGRABitmap, BGRABitmapTypes, BGRAScene3D, ex1;
procedure TForm1.FormPaint(Sender: TObject);
var
bmp: TBGRABitmap;
scene: TBGRAScene3D;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRABlack);
scene := TExample1.Create;
scene.Surface := bmp;
scene.Render;
scene.Free;
bmp.Draw(Canvas,0,0);
bmp.Free;
end;
Кстати, были добавлены сглаживание и фон. Обратите внимание, что сглаживание работает только для
простых сцен. Сложные сцены с текстурой и прозрачными цветами могут не отображаться правильно.
71
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Урок 16. Использование текстур с 3D-объектами
Создание текстур
Для создания текстур мы будем использовать следующий модуль. Для понимания как это работает, Вы
должны посмотреть Урок 8. Вот модуль:
unit utexture;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, BGRABitmap, BGRABitmapTypes;
function CreateGrassTexture(tx,ty: integer): TBGRABitmap;
function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
function CreateWoodTexture(tx,ty: integer): TBGRABitmap;
implementation
uses BGRAGradients;
function Interp256(value1,value2,position: integer): integer; inline;
begin
result := (value1*(256-position)+value2*position) shr 8;
end;
function Interp256(color1,color2: TBGRAPixel; position: integer): TBGRAPixel; inline;
begin
result.red := Interp256(color1.red,color2.red,position);
result.green := Interp256(color1.green,color2.green,position);
result.blue := Interp256(color1.blue,color2.blue,position);
result.alpha := Interp256(color1.alpha,color2.alpha,position);
end;
function CreateWoodTexture(tx,ty: integer): TBGRABitmap;
var
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1.5,1.5,1,rfBestQuality);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
colorOscillation := round(sqrt((sin(p^.red*Pi/16)+1)/2)*256);
globalColorVariation := p^.red;
p^:= Interp256( Interp256(BGRA(247,188,120),BGRA(255,218,170),colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),colorOscillation), globalColorVariation);
inc(p);
end;
end;
function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
var
globalPos: single;
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
x,nbVertical: integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1,rfBestQuality);
p := result.Data;
x := 0;
nbVertical := tx div 128;
if nbVertical = 0 then nbVertical := 1;
for i := 0 to result.NbPixels-1 do
begin
globalPos := p^.red*Pi/32 + nbVertical*x*2*Pi/tx*8;
72
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
colorOscillation := round(sqrt((sin(globalPos)+1)/2)*256);
globalColorVariation := p^.red; //round(sin(globalPos/8)*128+128);
p^:= Interp256( Interp256(BGRA(247,188,120),BGRA(255,218,170),colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),colorOscillation), globalColorVariation);
inc(p);
inc(x);
if x = tx then x := 0;
end;
end;
function CreateGrassTexture(tx,ty: integer): TBGRABitmap;
var
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1,rfBestQuality);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
p^ := Interp256( BGRA(0,128,0), BGRA(192,255,0), p^.red );
inc(p);
end;
end;
end.
Деревянный ящик на траве
Вот модуль, который создаёт сцену с прямоугольником травы с деревянным ящиком на ней:
unit ex2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, BGRAScene3D, BGRABitmap, BGRABitmapTypes;
type
{ TExample2 }
TExample2 = class(TBGRAScene3D)
grass,wood,vWood: TBGRABitmap;
constructor Create;
procedure ApplyTexCoord(face: IBGRAFace3D; Times: integer = 2);
procedure Render; override;
destructor Destroy; override;
end;
implementation
uses utexture;
const texSize = 128;
{ TExample2 }
constructor TExample2.Create;
var
base,v: array of IBGRAVertex3D;
box : IBGRAObject3D;
begin
inherited Create;
//создать текстуры
grass := CreateGrassTexture(texSize,texSize);
vWood := CreateVerticalWoodTexture(texSize,texSize);
wood := CreateWoodTexture(texSize,texSize);
73
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
//создать землю
with CreateObject(grass) do
begin
base := MainPart.Add([-50,20,-50, -50,20,50, 50,20,50, 50,20,-50]);
ApplyTexCoord(AddFace(base),4);
end;
//создать деревянный ящик
box := CreateObject(vWood);
with box do
begin
v := MainPart.Add([-1,-1,-1, 1,-1,-1, 1,1,-1, -1,1,-1,
-1,-1,+1, 1,-1,+1, 1,1,+1, -1,1,+1]);
ApplyTexCoord(AddFace([v[0],v[1],v[2],v[3]]));
ApplyTexCoord(AddFace([v[4],v[5],v[1],v[0]],wood));
ApplyTexCoord(AddFace([v[7],v[6],v[5],v[4]]));
ApplyTexCoord(AddFace([v[3],v[2],v[6],v[7]],wood));
ApplyTexCoord(AddFace([v[1],v[5],v[6],v[2]]));
ApplyTexCoord(AddFace([v[4],v[0],v[3],v[7]]));
MainPart.Scale(20);
end;
//RemoveObject(box);
ViewPoint := Point3D(-40,-40,-100);
end;
procedure TExample2.ApplyTexCoord(face: IBGRAFace3D; Times: integer);
begin
with face do
begin
TexCoord[0] := PointF(0,0);
TexCoord[1] := PointF(texSize*Times-1,0);
TexCoord[2] := PointF(texSize*Times-1,texSize*Times-1);
TexCoord[3] := PointF(0,texSize*Times-1);
end;
end;
procedure TExample2.Render;
begin
inherited Render;
end;
destructor TExample2.Destroy;
begin
grass.free;
wood.free;
vWood.free;
inherited Destroy;
end;
end.
Сперва создаются необходимые текстуры. Трава создаётся как объект с текстурой травы, определённый
4 вершинами. Текстура передаётся параметром функции CreateObject. Функция AddFace возвращает
объект IBGRAFace3D который передаётся пользовательской процедуре ApplyTexCoord. Эта процедура
устанавливает свойство TexCoord для каждой вершины поверхности. Эти координаты с плавающей
точкой - координаты центра пикселей.
Деревянный ящик создаётся как объект с вертикальной текстурой дерева. Вершины определяют куб с
единичными координатами. Он масштабируется позже. Когда создаются верхняя и нижняя
поверхности, применяются другие текстуры которая является перпендикулярной текстурой древесины.
Наконец устанавливается точка просмотра. Чтобы быть немного сбоку. Значение по умолчанию (0,0,100). Таким образом, сцена имеет немного перспективный вид.
74
Цикл уроков по компоненту BGRABitmap. Перевод сайта http://lazarus-games.ru/
Освещение и нормали
Возможно добавить немного освещения:
LightingNormal:= lnFace;
AmbiantLightness := 0.25;
with CreateObject do
begin
AddPointLight(MainPart.Add(-100,-80,0),140,0.5);
end;
Здесь освещение используется как в предыдущем уроке. Но свет это точка. Для определения вершины,
необходимо создать объект, содержащий её. Это возможно позднее для перемещения света. Чем дальше
объект находится от света, тем он темнее. Оптимальное расстояние определяется параметром
расстояния, для которого интенсивность света определяется следующим параметром. Это означает, что
если объект находится на расстоянии 140, будет добавлено 0.5 освещения.
Обратите внимание, что мы определили LightingNormal для lnFace. Это означает, что свет вычисляется
с учётом плоскости поверхности. Тут нет округления добавленного к освещению. Это может быть
полезно в других случаях, но не здесь
75
1/--страниц
Пожаловаться на содержимое документа