Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
И
так я уже писал про отрисовку таких шрифтов в игре, но в том примере все было сильно неадаптировано под програмный код и занимало несколько страниц!
Д
ля создания своих шрифтов будем писать программу:
"ФонтГен"
Н
а форме должны присутствовать:
Button1: TButton; //Кнопка генерации Image1: TImage; //Тут будем рисовать Edit1: TEdit;//От суда будем брать название шрифта Edit3: TEdit;//От суда будем брать цвет шрифта На нажатие кнопки(OnClick) пишем:
varx,y,z:integer; c:char; begin
Image1.Picture.LoadFromFile('shablon.bmp'); //Ну берем 24 разрядный фон из БИТМАПА x:=2; //Устанавливаем место отрисовки первой буквы на 2 (первое место будет пробелом) for
c:='!' to
'я' do
//Из таблицы символов от "!" до буквы "я" делаем: with
image1.Canvas do begin
font.Name:=(edit1.Text); //Узнаем название шрифта font.Size:=12; //Его размер ставим на 12 font.Style:=[fsBold]; //Делаем шрифт ЖИРНЫМ font.Color:=stringtocolor(edit3.Text); //Ставим цвет шрифта textout(x*20-trunc(textwidth(c)*1.5),10-(textheight(c) div
2),c); //Рисуем данный(по номеру) символ из таблицы символов (см. выше) на этом месте x:=x+1; //Следующее место отрисовки end
; //Отрисовали все символы!!! //Далее идет фильтр обводящий каждую букву черным цветом for
y:=0 to
x*20 do
//20 - ширина кадра(в одном кадре - одна буква) for
z:=0 to
20 do if
image1.Canvas.Pixels[y,z]=stringtocolor(edit3.Text) then
//Если цвет пикселя=Цвету шрифта то begin if
image1.Canvas.Pixels[y-1,z]=clWhite then
//Если надо то обводим image1.Canvas.Pixels[y-1,z]:=clBlack; if
image1.Canvas.Pixels[y-1,z-1]=clWhite then
image1.Canvas.Pixels[y-1,z-1]:=clBlack; if
image1.Canvas.Pixels[y+1,z-1]=clWhite then
image1.Canvas.Pixels[y+1,z-1]:=clBlack; if
image1.Canvas.Pixels[y,z+1]=clWhite then
image1.Canvas.Pixels[y,z+1]:=clBlack; if
image1.Canvas.Pixels[y,z-1]=clWhite then
image1.Canvas.Pixels[y,z-1]:=clBlack; if
image1.Canvas.Pixels[y+1,z+1]=clWhite then
image1.Canvas.Pixels[y+1,z+1]:=clBlack; if
image1.Canvas.Pixels[y+1,z]=clWhite then
image1.Canvas.Pixels[y+1,z]:=clBlack; if
image1.Canvas.Pixels[y-1,z+1]=clWhite then
image1.Canvas.Pixels[y-1,z+1]:=clBlack; end
; image1.picture.SaveToFile(edit1.text+'.bmp'); //Сохраняем полученый БИТМАП в "Название Шрифта".bmp end
;
П
рога действительно делает шрифты, но минус - если менять размер шрифта, то параметры отрисовки каждой буквы придется менять! Иначе возможны глюки!
Т
еперь идет процедура отрисовки:
procedureTmainform.DCN(Text:string
;x,y:integer;center:integer); var
h:Tpicturecollectionitem; z:integer; begin
h:=imagelist.Items.Find('cnb'); if
center=1 then for
z:=1 to
strlen(pchar(text)) do
h.Draw(dxdraw.Surface,x+trunc(h.Width*0.65)*(z-1)-trunc(h.Width*0.65)*trunc(strlen(pchar(text))*0.5), y,ord(text[z])-32) else for
z:=1 to
strlen(pchar(text)) do
h.Draw(dxdraw.Surface,x+trunc(h.Width*0.65)*(z-1),y,ord(text[z])-32); end
;
К
ак использовать эту процедуру: DCN
({Координаты по икс},{Координаты по игрик},'ТЕКСТ', {Центрировать или нет (1 или 0)} В
от в принципе и всё.