Нарисовать текст в перспективе особой сложности нет. Более проблемно заставить такой текст быть текстурным. Рассмотрим в статье, как нарисовать текст в перспективной проекции с использованием текстуры в качестве заливки. Также разрешим ряд часто задаваемых вопросов.
В аффинных преобразованиях нет перспективной трансформации. Это явно следует из определения таких преобразований:
Аффинное преобразование … отображение плоскости …, при котором параллельные прямые переходят в параллельные прямые, пересекающиеся — в пересекающиеся, скрещивающиеся — в скрещивающиеся
Википедия
А восприятие перспективы в первую очередь строится на схождении параллельных прямых в горизонте. Поэтому здесь будет идти речь о деформации.
Подготовка
Нам нужен GDI+ для Delphi 7. По прежнему продолжаю тему «универсального исходника», который без проблем скомпилируется и в Delphi 7, и в XE 7,10,11. В статье «Как подключить GDI+ для Delphi 7 и не иметь проблем в XE» подробно расписано, как это сделать.
Нам нужно изображение для заливки текста. Из статьи «Как вставить изображение из буфера обмена» берем код для вставки изображения и загрузки из файла.
Здесь будет применена трансформация по четырем точкам, задающих четырехугольник, по которому будет деформироваться текст. Для хранения данных используем в приватной секции формы два массива:
|
1 2 3 4 5 6 7 |
// array of points, for the original text rectangle // массив точек, для исходного прямоугольника текста FPoints: Array[0..3] of TGPPointF; // array of points, for the transformation polygon in which we draw // массив точек, для многоугольника трансформации, в котором рисуем FWarps: Array[0..3] of TGPPointF; |
Чтобы деформировать что либо, надо иметь представление «этого» в наборе вершин, линий и кривых. За хранение подобного набора, что в GDI, что в GDI+ отвечает объект траектории. Траектория в GDI+ представлена классом TGPGraphicsPath.
Преобразовать текст в траекторию
Текст в траекторию можно добавить методом AddString. В обойме GDIPlus для метода целых 4 перегруженных реализаций. По сути, они различаются только в типе координат — целочисленные или вещественные, и способом задания координат — рисовать либо от точки, либо в прямоугольнике. Поэтому рассмотрим один метод:
|
1 2 3 4 5 6 7 8 |
function TGPGraphicsPath.AddString( string_: WideString; length: Integer; family : TGPFontFamily; style : Integer; emSize : Single; // World units origin : TGPPointF; format : TGPStringFormat): TStatus; |
Параметры метода AddString
| string_: WideString |
| Текст, который требуется нарисовать. Может включать в себя переносы строк. |
| length: Integer |
| Длина текста, которые отображается. Если задать -1, будет отображен весь текст. |
| family: TGPFontFamily |
| Множество шрифтов одного семейства. Указатель на объект определяющий семейство шрифтов для строки. |
| style: Integer |
| Стиль шрифта. Результат побитового ИЛИ, примененного к двум или более из этих элементов: FontStyleRegular = Integer(0); FontStyleBold = Integer(1); FontStyleItalic = Integer(2); FontStyleBoldItalic = Integer(3); FontStyleUnderline = Integer(4); FontStyleStrikeout = Integer(8); |
| emSize: Single |
| Размер строковых символов в мировых единицах. |
| origin: TGPPointF |
| Координаты начала строки, указанные мировых единицах. |
| format: TGPStringFormat |
| Указатель на объект TGPStringFormat, который определяет информацию о формате вывода (выравнивание, обрезка, позиции табуляции и т. п.) для строки. |
Про TGPStringFormat можно целую статью написать, поэтому останавливаться на нем смысла нет. Тем более здесь он нам не нужен.
Как получить или создать TGPFontFamily?
TGPFontFamily — важный параметр, без которого работать с текстом не получится. Это объект, у него есть специальный конструктор. Его можно инициализировать вручную. А можно получить очень простым способом — из объекта gfont типа TGPFont. Как создать gfont смотрим тут.
|
1 2 |
gfamily := TGPFontFamily.Create; gfont.GetFamily(gfamily); |
Нарисовать текст
Чтобы нарисовать текст, надо нарисовать траекторию. Для рисования рамки траектории используется метод DrawPath. Для заливки траектории используется метод FillPath.
|
1 2 3 4 |
function TGPGraphics.FillPath(brush: TGPBrush; path: TGPGraphicsPath): TStatus; function TGPGraphics.DrawPath(pen: TGPPen; path: TGPGraphicsPath): TStatus; |
Таким образом, вывод текста будет выглядеть так:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
// get font family // получить семейство шрифтов gfont.GetFamily(gfamily); // add text to path // добавить текст в траекторию gpath.AddString(Text, -1, // draw all text gfamily, // font family 0, // normal style gfont.GetSize, // size in Unit (pixel) MakePoint(box.X, box.Y),// origin point nil // formatting is not used ); // draw text (as path) if Assigned(gbrush) then gpg.FillPath(gbrush, gpath); gpg.DrawPath(gpen, gpath); |
| gpath: TGPGraphicsPath |
| Траектория GDI+. gpath := TGPGraphicsPath.Create; |
| gpen: TGPPen |
| Перо GDI+. Конструктор принимает цвет и толщину. gpen := TGPPen.Create($FFBBBBBB, 0.5); |
| gbrush: TGPBrush |
| Кисть GDI+. В нашем случае используем текстурную кисть, которая определяется классом TGPTextureBrush, который является наследником класса TGPBrush. gbrush := TGPTextureBrush.Create(gbmp); Где gbmp — экземпляр TGPBitmap. В нем хранится текстура. |
| gpg: TGPGraphics |
| Холст GDI+. gpg := TGPGraphics.Create(bmp.Canvas.Handle); Где bmp — экземпляр TBitmap, который создается как буфер при отрисовке в PaintBox’е. |
Шрифт GDI+
Не будем останавливаться на всех нюансах работы со шрифтом в GDI+. Здесь только то, что нужно сейчас.
В тексте выше есть такая переменная gfont: TGPFont. Создать шрифт GDI+ можно кучей разных способов. Но мы сейчас рассмотрим способ, который Д. Осипов назвал чисто теоретическим, не видя в нем практического применения. Это использование конструктора:
|
1 |
constructor Create(hdc: HDC; hfont: HFONT); reintroduce; overload; |
У конструктора есть вполне практическое применение. Например, сейчас у меня есть PaintBox, в нем есть шрифт, который я настроил на этапе дизайна. Это удобно и быстро. Рисую на обычном TBitmap. У которого есть Canvas, в котором есть свойство Font. Этот Font инициализирую шрифтом из PaintBox’а.
|
1 |
bmp.Canvas.Font.Assign(pb.Font); |
И теперь я хочу иметь точно такой же шрифт для GDI+. И вместо процедуры инициализации шрифта(1) имею одну строку (2).
1) Инициализация TGPFont из TFont
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
function GPFontStyle(const AStyle : TFontStyles) : FontStyle; begin Result := FontStyleRegular; if fsBold in AStyle then Result := Result + FontStyleBold; if fsItalic in AStyle then Result := Result + FontStyleItalic; if fsUnderline in AStyle then Result := Result + FontStyleUnderline; if fsStrikeOut in AStyle then Result := Result + FontStyleStrikeout; end; function GPFont(const AFont: TFont) : TGPFont; var fsl: FontStyle; begin fsl := GPFontStyle(AFont.Style); Result := TGPFont.Create(AFont.Name, abs(AFont.Height), fsl, UnitPixel, nil); end; |
Более полный вариант с использованием коллекции TGPFontCollection и пример использования TGPStringFormat можно посмотреть тут.
2) Одна строка создания TGPFont из существующего TFont:
|
1 2 3 4 |
// make TGPFont very easy // сделать TGPFont очень просто with bmp.Canvas do gfont := TGPFont.Create(Handle, Font.Handle); |
В исходниках есть оба метода создания шрифта. Можно поэкспериментировать.
Как узнать размер текста в GDI+?
Для того, чтобы узнать размер текста, нужен экземпляр TGPFont. Размер или прямоугольник текста нам нужен, чтобы получить начальные параметры четырехугольника деформации текста.
|
1 2 3 |
// get text height and width // получить высоту и ширину текста gpg.MeasureString(Text, -1, gfont, MakePoint(0,0.0), box); |
Результат работы метода помещается в переменную box: TGPRectF. Это прямоугольник, который занимает выводимый текст с заданным шрифтом. Чтобы отцентрировать его и проинициализировать массив вершин прямоугольника, дополнительно напишем следующее:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
// move the box to the center // сместить бокс по центру box.x := (WidthRect(rct) - box.Width) / 2; box.y := (HeightRect(rct) - box.Height) / 2; // initialization of the vertices of the rectangle // that defines the text in the "normal" state // инициализация вершин прямоугольника, // задающего текст в "нормальном" состоянии FPoints[0] := MakePoint(box.X, box.Y); FPoints[1] := MakePoint(box.X + box.Width, box.Y); FPoints[2] := MakePoint(box.X, box.Y + box.Height); FPoints[3] := MakePoint(box.X + box.Width, box.Y + box.Height); |
Это тот самый box, который фигурирует в вызове функции AddString выше:
|
1 2 3 |
... MakePoint(box.X, box.Y),// origin point ... |
В итоге, пока у нас нет кисти для заливки, получаем рамку текста.
Текстурная кисть TGPTextureBrush
В GDI+ кисть текстурная представлена классом TGPTextureBrush. Выбираем самый простой конструктор:
|
1 2 |
constructor Create(image: TGPImage; wrapMode: TWrapMode = WrapModeTile); reintroduce; overload; |
А конструкторов у текстурной кисти целых 8 штук! Вообще, программисты GDIP — большие любители перегружать конструкторы и методы.
В любой другой ситуации пригодился бы конструктор с параметром dstRect: TGPRectF, но из специфики задачи он не нужен. Возможно, при случае расскажу. Не пропустите, подписывайтесь на телеграм-канал!
Второй параметр нас устраивает значением по умолчанию. TWrapMode имеет следующие значения:
| WrapModeTile |
| 0 — картинка повторяется (плитка) |
| WrapModeTileFlipX |
| 1 — зеркалка относительно вертикальной оси |
| WrapModeTileFlipY |
| 2 — зеркалка относительно горизонтальной оси |
| WrapModeTileFlipXY |
| 3 — зеркалка по обеим осям |
| WrapModeClamp |
| 4 — нет заливки |
Как создать TGPBitmap из TBitmap
Почему TGPBitmap, а не TGPImage, как указано в параметрах конструктора текстурной кисти? Потому что: 1) TGPBitmap — наследник TGPImage, 2) битмап — это то, с чем на самом деле работает Windows, 3) и его очень просто создать из TBitmap.
|
1 2 |
if Assigned(tmp) then gbmp := TGPBitmap.Create(tmp.Handle, tmp.Palette); |
Теперь можно создать кисть:
|
1 2 |
if Assigned(gbmp) then gbrush := TGPTextureBrush.Create(gbmp); |
На рисунке 2 видно, что в заливке участвует только верхняя часть картинки. Сама картинка размером 800х600. Именно в таком размере она и выступает в качестве заливки. Кисть не умеет масштабировать текстуру под нужный размер выводимого примитива, потому что это вообще не ее дело. Перед тем, как создать кисть, надо вначале определенным образом поработать с текстурой или использовать другой конструктор.
Текст в перспективе
Ну вот, собственно, добрались и до сабжа. Деформацией в TGPGraphicsPath занимается метод, который так и называется — Warp. Это почти единичный случай, когда метод GDIP не перегружен и существует в единственном экземпляре:
|
1 2 3 4 5 6 7 8 9 10 |
// Once this is called, the resultant path is made of line segments and // the original path information is lost. When matrix is NULL, the // identity matrix is assumed. // При вызова этого метода, исходная информация о пути теряется и // и путь состоит из сегментов линии. Когда матрица имеет значение // NULL, предполагается единичная матрица. function Warp(destPoints: PGPPointF; count: Integer; srcRect: TGPRectF; matrix: TGPMatrix = nil; warpMode: TWarpMode = WarpModePerspective; flatness: Single = FlatnessDefault): TStatus; |
Метод Warp, помимо деформации, преобразует кривые, из которых состоит траектория, в набор отрезков. За качество аппроксимации отвечает параметр flatness. По умолчанию, он равен 0.25. Это официальная версия.
Но лично я никаких изменений от этого параметра не обнаружил. Чтобы реально ощутить мощь параметра, необходимо использовать метод Flatten, о котором в ближайшем будущем будет спето немало песен. Если тема аппроксимации кривых интересна, подписывайтесь на телегу!
Параметры метода Warp
| destPoints: PGPPointF |
| Массив из 4 точек (или из трех). Задает вершины четырехугольника, по которому будет происходить деформация. Если в массиве содержится три точки, четвертая рассчитывается автоматически и четырехугольник становится параллелограммом. |
| count: Integer |
| Указывает, что в массиве либо 4 точки — и это произвольный четырехугольник, либо 3 — и это параллелограмм. |
| srcRect: TGPRectF |
| Исходный прямоугольник, из которого будет происходить перенос в четырехугольник деформации. В нашем случае, это box, про который говорилось выше. |
| matrix: TGPMatrix = nil |
| Можно также наложить аффинное преобразование поверх деформации. Но этого сейчас мы делать не станем. |
| warpMode: TWarpMode = WarpModePerspective |
| Режим деформации. Имеет два значения: WarpModePerspective и WarpModeBilinear. Используем значение по умолчанию WarpModePerspective. WarpModeBilinear задает билинейную деформацию. Реализация которой в GDI+ сделана настолько коряво, что надо сделать ряд телодвижений и написать статью, чтобы ею воспользоваться. |
| flatness: Single = FlatnessDefault |
| Параметр, определяющий качество аппроксимации. Чем он меньше, тем отрезки, из которых состоит получившаяся траектория, короче, их количество больше, качество лучше. Возрастает нагрузка на |
Порядок вершин в параметре destPoints
Для параметра destPoints важен индекс. В нулевом индексе содержится координата верхней левой вершины четырехугольника, в первом — верхней правой, во 2-м — левая нижняя вершина и в 3-м — правая нижняя.
Нарисовать текст в перспективе
Сейчас будет представлен фрагмент кода. Этот код промежуточный, призван показать все вышесказанное в связке. Окончательный вариант можно посмотреть в конце статьи или в исходниках.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
procedure TFmMain.pbPaint(Sender: TObject); var i: Integer; rct: TRect; bmp: TBitmap; tmp: TBitmap; Text: String; // GDI+ gpg: TGPGraphics; gpen: TGPPen; gbmp: TGPBitmap; gpath: TGPGraphicsPath; gfont: TGPFont; gbrush: TGPBrush; gfamily: TGPFontFamily; // for measure text box: TGPRectF; begin rct := pb.ClientRect; bmp := CreateBmpRect(rct, pf24Bit); tmp := nil; gpg := TGPGraphics.Create(bmp.Canvas.Handle); gpen := TGPPen.Create($FFBBBBBB, 0.5); gpath := TGPGraphicsPath.Create; gfamily := TGPFontFamily.Create; gbmp := nil; gfont := nil; gbrush := nil; Text := Memo1.Lines.Text; try gpg.SetSmoothingMode(SmoothingModeAntiAlias8x4); gpg.SetPageUnit(UnitPixel); with bmp.Canvas do begin Font.Assign(pb.Font); rct := ClipRect; Brush.Color := clWhite; FIllRect(rct); // make TGPFont very easy // сделать TGPFont очень просто gfont := TGPFont.Create(Handle, Font.Handle); // for experiments: //gfont := GPFont(Font); // get font family // получить семейство шрифтов gfont.GetFamily(gfamily); // get text height and width // получить высоту и ширину текста gpg.MeasureString(Text, -1, gfont, MakePoint(0,0.0), box); // move the box to the center // сместить бокс по центру box.x := (WidthRect(rct) - box.Width) / 2; box.y := (HeightRect(rct) - box.Height) / 2; // initialization of the vertices of the rectangle // that defines the text in the "normal" state // инициализация вершин прямоугольника, // задающего текст в "нормальном" состоянии FPoints[0] := MakePoint(box.X, box.Y); FPoints[1] := MakePoint(box.X + box.Width, box.Y); FPoints[3] := MakePoint(box.X + box.Width, box.Y+box.Height); FPoints[2] := MakePoint(box.X, box.Y+box.Height); // If required, add a background rectangle // In this case, the letters will be cut out of the background // Если требуется, добавить прямоугольник фона // В этом случае, буквы будут вырезаны на фоне if CheckBox2.Checked then gpath.AddRectangle(box); // add text to path // добавить текст в траекторию gpath.AddString(Text, -1, // draw all text gfamily, // font family 0, // normal style gfont.GetSize, // size in Unit (pixel) MakePoint(box.X, box.Y),// origin point nil // formatting is not used ); end; // WARP!!! gpath.Warp(@FWarps, 4, box, nil, WarpModePerspective, 0.5); // if texture is required // Если указано, что требуется текстура if not RadioButton1.Checked then begin tmp := TBitmap.Create; tmp.Assign(FBitmap); if Assigned(tmp) then gbmp := TGPBitmap.Create(tmp.Handle, tmp.Palette); if Assigned(gbmp) then gbrush := TGPTextureBrush.Create(gbmp); end; // DRAW!!! if Assigned(gbrush) then gpg.FillPath(gbrush, gpath); gpg.DrawPath(gpen, gpath); finally pb.Canvas.Draw(0,0,bmp); FreeANdNil(bmp); FreeANdNil(tmp); FreeANdNil(gpg); FreeANdNil(gpen); FreeANdNil(gbmp); FreeANdNil(gfont); FreeANdNil(gpath); FreeANdNil(gbrush); FreeANdNil(gfamily); end; end; |
Добавлена возможность присоединить к траектории еще прямоугольник. В этом случае символы текста будут как-бы вырезаны в фоне. В таком режиме лучше видно, что происходит с картинкой при деформации.
Обратите внимание на заполнение массива вершин FPoints — оно происходит согласно этому правилу.
На рисунке 4 видим, что вывод текста в перспективе происходит замечательно, а вот текстура остается на месте и никакие деформации на нее не действуют.
Текстура в перспективе
Очевидно, что необходимо подвергнуть текстуру такой же деформации, что и текст в траектории. Для этого надо вспомнить хорошо забытое старое — Perspective Transformation. У нас есть готовая функция для таких дел. Подключим модуль IP76ProjectiveTransform и заменим создание битмапа tmp на следующий код:
|
1 2 |
tmp := GetPerspTransformBitmap(FBitmap, TPointF(FWarps[0]), TPointF(FWarps[1]), TPointF(FWarps[3]), TPointF(FWarps[2])); |
Обращаю внимание на порядок вершин в параметрах функции. Он отличается от нумерации в массиве destPoints.
Поэтому нас и не интересовали другие конструкторы для текстурной кисти. Мы формируем картинку, как раз под текущий вывод текста в перспективе. С нужными размерами, с нужным искажением.
Откуда берутся точки для деформации?
Из работы с мышью )))) Есть в интерфейсе кнопка — «Сброс деформации», ее обработчик таков:
|
1 2 3 4 5 6 7 8 9 10 |
procedure TFmMain.btnResetWarpClick(Sender: TObject); var i: Integer; begin pbPaint(pb); for i := 0 to 3 do FWarps[i] := FPoints[i]; CreateCoords(pb.Width, pb.Height); pbPaint(pb); end; |
Потом анализируем нажатия и движения мыши. Спрячу в спойлер, потому что не по теме статьи, но может пригодится кому. В спойлере происходит анализ попадания не только в вершины, но и на соединительные линии, потому что по точкам таскать не всегда удобно, и лучше сразу линией. Материал на эту тему можно найти в статье Принадлежность точки отрезку.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
function TFmMain.CheckPoint(X,Y: Integer; var Offset: TGPPointF): Integer; var i: Integer; p: TPointF; begin Result := -1; for i := 0 to 3 do begin if (Abs(X-FWarps[i].X) < 4) and (Abs(Y-FWarps[i].Y) < 4) then begin Result := i; p := TPointF(FWarps[i]); Break; end; end; if Result > -1 then Exit; if PtInSegEx(TPointF(FWarps[0]), TPointF(FWarps[1]), PointF(X,Y), 3, p)=3 then Result := 4 else if PtInSegEx(TPointF(FWarps[1]),TPointF(FWarps[3]), PointF(X,Y), 3, p)=3 then Result := 5 else if PtInSegEx(TPointF(FWarps[3]),TPointF(FWarps[2]), PointF(X,Y), 3, p)=3 then Result := 6 else if PtInSegEx(TPointF(FWarps[2]),TPointF(FWarps[0]), PointF(X,Y), 3, p)=3 then Result := 7; if Result < 0 then Exit; Offset.x := X - p.X; Offset.y := Y - p.Y; end; procedure TFmMain.pbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FMouseDowning := Button = mbLeft; if FMouseDowning then begin FPointIndex := CheckPoint(X,Y, FPointOffset); FMouseDowning := FPointIndex in [0..7]; FMousePoint := Point(X,Y); end; pbPaint(pb); end; procedure OffsetPoint(var p: TGPPointF; offset: TGPPointF); begin p.x := p.x + offset.x; p.y := p.y + offset.y; end; procedure OffsetPoints(var p1, p2: TGPPointF; offset: TPoint); begin OffsetPoint(p1, MakePoint(offset.x,offset.Y+0.0)); OffsetPoint(p2, MakePoint(offset.x,offset.Y+0.0)); end; procedure TFmMain.pbMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if FMouseDowning then begin FMousePoint := Point(X - FMousePoint.X, Y - FMousePoint.Y); if FPointIndex in [0..3] then FWarps[FPointIndex] := MakePoint(X + FPointOffset.X, Y + FPointOffset.Y) else case FPointIndex of 4: OffsetPoints(FWarps[0], FWarps[1], FMousePoint); 5: OffsetPoints(FWarps[1], FWarps[3], FMousePoint); 6: OffsetPoints(FWarps[3], FWarps[2], FMousePoint); 7: OffsetPoints(FWarps[2], FWarps[0], FMousePoint); end; FMousePoint := Point(X,Y); Screen.Cursor := crHandPoint; CreateCoords(pb.Width, pb.Height); end else begin if CheckPoint(X,Y, FPointOffset) > -1 then Screen.Cursor := crHandPoint else Screen.Cursor := crDefault; end; pbPaint(pb); end; procedure TFmMain.pbMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FMouseDowning := False; Screen.Cursor := crDefault; pbPaint(pb); end; |
А как из TGPBitmap получить TBitmap?
Вопрос связан с тем, что пламя, которое (конечно) присутствует в исходнике, работает с TGPBitmap. А функция перспективной трансформации работает с TBitmap. Следовательно, надо как-то получить TBitmap из TGPBitmap.
Проще всего это сделать с помощью метода TGPBitmap.GetHBITMAP:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
// work with flame's TGPBitmap // работаем с TGPBitmap пламени if not Assigned(FFlame) then FFlame := CreateFlameBitmap(320, 120, TFireColorMode(idx)); FlameBitmap(FFlame); // get TBitmap from TGPBitmap // получаем TBitmap из TGPBitmap FFlame.GetHBITMAP(aclWhite, h); FreeAndNil(FFire); FFire := TBitmap.Create; FFire.Handle := h; // cut off the ugly bottom // отсечь некрасивую нижнюю часть FFire.Height := FFlame.GetHeight - 6; |
Полный текст отрисовки
Он не такой большой, как кажется. Уберите все комментарии, и ужмется раза в два.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 |
procedure TFmMain.pbPaint(Sender: TObject); var i: Integer; rct: TRect; bmp: TBitmap; tmp: TBitmap; Text: String; // GDI+ gpg: TGPGraphics; gpen: TGPPen; gbmp: TGPBitmap; gpath: TGPGraphicsPath; gfont: TGPFont; gbrush: TGPBrush; gfamily: TGPFontFamily; // for measure text box: TGPRectF; begin rct := pb.ClientRect; bmp := CreateBmpRect(rct, pf24Bit); tmp := nil; gpg := TGPGraphics.Create(bmp.Canvas.Handle); gpen := TGPPen.Create($FFBBBBBB, 0.5); gpath := TGPGraphicsPath.Create; gfamily := TGPFontFamily.Create; gbmp := nil; gfont := nil; gbrush := nil; Text := Memo1.Lines.Text; try gpg.SetSmoothingMode(SmoothingModeAntiAlias8x4); gpg.SetPageUnit(UnitPixel); with bmp.Canvas do begin Font.Assign(pb.Font); rct := ClipRect; Brush.Color := clWhite; FIllRect(rct); // make TGPFont very easy // сделать TGPFont очень просто gfont := TGPFont.Create(Handle, Font.Handle); // for experiments: //gfont := GPFont(Font); // get font family // получить семейство шрифтов gfont.GetFamily(gfamily); // get text height and width // получить высоту и ширину текста gpg.MeasureString(Text, -1, gfont, MakePoint(0,0.0), box); // move the box to the center // сместить бокс по центру box.x := (WidthRect(rct) - box.Width) / 2; box.y := (HeightRect(rct) - box.Height) / 2; // initialization of the vertices of the rectangle // that defines the text in the "normal" state // инициализация вершин прямоугольника, // задающего текст в "нормальном" состоянии FPoints[0] := MakePoint(box.X, box.Y); FPoints[1] := MakePoint(box.X + box.Width, box.Y); FPoints[3] := MakePoint(box.X + box.Width, box.Y+box.Height); FPoints[2] := MakePoint(box.X, box.Y+box.Height); // If required, add a background rectangle // In this case, the letters will be cut out of the background // Если требуется, добавить прямоугольник фона // В этом случае, буквы будут вырезаны на фоне if CheckBox2.Checked then gpath.AddRectangle(box); // add text to path // добавить текст в траекторию gpath.AddString(Text, -1, // draw all text gfamily, // font family 0, // normal style gfont.GetSize, // size in Unit (pixel) MakePoint(box.X, box.Y),// origin point nil // formatting is not used ); end; // WARP!!! gpath.Warp(@FWarps, 4, box, nil, WarpModePerspective, 0.5); // if texture is required // Если указано, что требуется текстура if not RadioButton1.Checked then begin // https://ip76.ru/perspective-transformation/ // the selected image is the texture // текстурой является выбранное изображение if RadioButton2.Checked and Assigned(FBitmap) then tmp := GetPerspTransformBitmap(FBitmap, TPointF(FWarps[0]), TPointF(FWarps[1]), TPointF(FWarps[3]), TPointF(FWarps[2])); // the texture is the image of the flame // текстурой является изображение пламени if RadioButton3.Checked and Assigned(FFire) then tmp := GetPerspTransformBitmap(FFire, TPointF(FWarps[0]), TPointF(FWarps[1]), TPointF(FWarps[3]), TPointF(FWarps[2])); if Assigned(tmp) then gbmp := TGPBitmap.Create(tmp.Handle, tmp.Palette); if Assigned(gbmp) then gbrush := TGPTextureBrush.Create(gbmp); end; if Assigned(gbrush) then gpg.FillPath(gbrush, gpath); gpg.DrawPath(gpen, gpath); FreeAndNil(gbrush); gbrush := TGPSolidBrush.Create(aclSteelBlue); // draw a quad // нарисовать четырехугольник gpg.DrawLine(gpen,FWarps[0],FWarps[1]); gpg.DrawLine(gpen,FWarps[1],FWarps[3]); gpg.DrawLine(gpen,FWarps[3],FWarps[2]); gpg.DrawLine(gpen,FWarps[2],FWarps[0]); // draw quad vertices // нарисовать вершины четырехугольника TGPSolidBrush(gbrush).SetColor(aclOrangeRed); for i := 0 to 3 do begin gpg.FillEllipse(gbrush, FWarps[i].X-3, FWarps[i].Y-3, 6, 6); gpg.DrawEllipse(gpen, FWarps[i].X-3, FWarps[i].Y-3, 6, 6); end; finally pb.Canvas.Draw(0,0,bmp); FreeANdNil(bmp); FreeANdNil(tmp); FreeANdNil(gpg); FreeANdNil(gpen); FreeANdNil(gbmp); FreeANdNil(gfont); FreeANdNil(gpath); FreeANdNil(gbrush); FreeANdNil(gfamily); end; end; |
Практическое применение
Можно использовать, когда требуется растянуть или сжать текст в границах заданного прямоугольника. Речь не идет о нахождении оптимальных параметров шрифта. Это именно о том, чтоб «влезло». Аналогичного эффекта можно добиться, если использовать аффинное преобразование масштабирования.
Можно применять для замены аффинного сдвига, либо поворота. Как известно, с помощью сдвига можно осуществить и поворот. Только смысла в этом особого не вижу. Все равно придется рассчитывать координаты по формулам аффинных преобразований, отчего бы этим не заняться специализированному движку?
Конечно, это имитация 3D. Если взять аффинные преобразования для 3D, рассчитать координаты и вывести с помощью перспективной деформации, можно добиться эффекта пространства. Например, при создании проволочной модели будущей сцены для 3D-рендеринга. Или математических изысканий.
Безусловно, самое интересное применение — это расположить текст по кругу, эллипсу и произвольной траектории. Уже год планирую про это написать. Напишу. Надо сесть, оформить исходник, взять музу в заложники. Ну и как мантру повторю — подписывайтесь на канал, оставляйте комментарии, регистрируйтесь на сайте, это мотивирует продолжать мое безнадежное дело.
Ну и чисто декоративное применение, конечно. Для заставок, инфографики и прочей попсы. Все картинки кликабельны.
Скачать
Друзья, спасибо за внимание!
Исходник (zip) 347 Кб. Delphi 7, XE 7, XE 10, XE 11
Для XE открываем файл .dpr и спокойно build’им. Путь ..\GDIPlus\ из Search Path можно убрать, а можно и не убирать, модули из него никак не задействованы в XE из-за директивного условия.
Пустой подкаталог _dcu в архиве — для Delphi 7. Он указан в настройках проекта, как Unit output directory. Если его не окажется, XE просто молча создаст, а Delphi 7 выругается. Поэтому присутствует, чтобы никто не ругался )
Исполняемый файл (zip) 447 Кб.
Исполняемый файл, скомпилированный в XE 11 (zip) 1.22 Мб.
Для XE 11 исполняемый файл скомпилирован в release на том же самом исходнике. Но если в распакованном виде для Delphi 7, exe весит 717 Кб, то для XE 11 уже 2.82 Мб. Прогресс — он ведь в размерах измеряется.
Скачать текст а-ля «Звездные войны»
Скачать можно из телеги. Там уже много вкусного, подписывайтесь )))