Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создание шрифтов формата BMP для использования в играх! Также постейший фильтр изображений

Оформил: XVeL
Автор: Spose
WEB-сайт: http://daddy.mirgames.ru

Итак я уже писал про отрисовку таких шрифтов в игре, но в том примере все было сильно неадаптировано под програмный код и занимало несколько страниц!
Для создания своих шрифтов будем писать программу: "ФонтГен"
На форме должны присутствовать:
Button1: TButton; //Кнопка генерации
Image1: TImage; //Тут будем рисовать
Edit1: TEdit;//От суда будем брать название шрифта
Edit3: TEdit;//От суда будем брать цвет шрифта

На нажатие кнопки(OnClick) пишем:
var
   x,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;
Прога действительно делает шрифты, но минус - если менять размер шрифта, то параметры отрисовки каждой буквы придется менять! Иначе возможны глюки!
Теперь идет процедура отрисовки:
procedure Tmainform.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)}
Вот в принципе и всё.
Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay