Нормальная процедура отображения графических шрифтов

Code:

Thead=record //Заголовок fnt файла

  count:integer; //Количество изображений (вдруг вам русский шрифт не нужен а нужен только английский - тогда картинок будет 128

  name:string[5]; //Имя шрифта (нужно для распаковки картинок)

  tcl:tcolor; //Цвет прозрачности

end;

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

  fs:Tfilestream;

  m:Tmemorystream;

  size:int64;

  h:thead;

  i:integer;

begin

  fs:=tfilestream.Create('what.fnt',fmCreate); //Создаем архив

  h.count:=flb.Count; //Заносим данные в заголовок файла(3 строки)

  h.name:=edit2.Text;

  h.tcl:=stringtocolor(edit1.Text);

  fs.Write(h,sizeof(h)); //Записываем заголовок

  for i:=0 to h.count-1 do //Теперь от 0 до количества изображений-1 делаем:

  begin       dxdib.DIB.LoadFromFile(flb.Items[i]); //Загружаем картинку в TDIB

     dxdib.DIB.Compress; //Сжимаем

     m:=tmemorystream.Create; //Создаем поток в памяти

     dxdib.DIB.SaveToStream(m); //Сохраняем изображение в поток

     size:=m.Size; //Получаем размер изображения в байтах

     fs.Write(size,sizeof(size)); //Записываем размер изображения в архив

     m.Position:=0; //Просто это нужно

     fs.CopyFrom(m,size); //Записываем поток изображения в файл

     m.Free; //Очищаем память от изображения

  end;

  fs.Free; //Сохраняем архив

end;

В игре необходимо загрузить шрифты из папки fonts процедурой:

procedure loadfont(name:string); //Не забудте указать название шрифта (имя файла)

var

  item:Tpicturecollectionitem; //Изображение в памяти

  fs:Tfilestream; //Файловый поток для чтения архива

  m:Tmemorystream; //Поток в памяти (туда будет копироваться изображение)

  size:int64; //Размер изображения в архиве

  h:thead; //Заголовок архива

  i:integer; //Просто нужно для счета

begin

  fs:=tfilestream.Create('fonts\'+changefileext(name,'.fnt'),fmOpenRead); //Открываем нужный файл

  fs.Read(h,sizeof(h)); //Читаем заголовок

  for i:=0 to h.count-1 do //От 0 до количества изображений-1 делаем:

  begin

     fs.Read(size,sizeof(size)); //Читаем размер файла

     m:=tmemorystream.Create; //Создаем поток в памяти

     m.Position:=0; //Нужно

     m.SetSize(size); //Указываем размер участка памяти (чтобы память не засорять)

     m.CopyFrom(fs,size); //Вставляем в память изображение из архива

     m.Position:=0; //Нужно

     myform.DXDIB.DIB.LoadFromStream(m); //Грузим изображение из памяты в TDIB

     item:=Tpicturecollectionitem.Create(myform.il.Items); //Добавляем в коллекцию ещё одно изображение

     item.Name:=h.name+inttostr(i); //Его имя + номер символа

     item.Transparent:=true; //Прозрачен

     item.TransparentColor:=h.tcl; //Цвет прозрачности

     item.PatternWidth:=myform.dxdib.DIB.Width; //Ширина

     item.PatternHeight:=myform.dxdib.DIB.Height; //Высота

     item.SystemMemory:=false; //Нужно

     item.Picture.Graphic:=myform.dxdib.DIB; //Указываем изображения

     item.Restore; //Принимаем изменение

     m.Free; //Очищаем память

  end;

  fs.Free; //Закрываем архив

end;

Code:

Procedure dNt(Text:string;x,y:integer;whatfont:String; center:integer); //Процедура отрисовки букв

var

  h:Tpicturecollectionitem;

  z:integer;

  dlina:integer;

  dlina2:integer;

begin

  if center=1 then

  begin

     dlina2:=0;

     for z:=1 to strlen(pchar(text)) do

     begin

        h:=myform.il.Items.Find(whatfont+inttostr(ord(text[z])));

        dlina2:=dlina2+h.PatternWidth+1;

     end;

     dnt(Text,x-dlina2 div 2,y,whatfont,0);

  end

  else

  begin

     dlina:=x;

     for z:=1 to strlen(pchar(text)) do

     begin

        h:=myform.il.Items.Find(whatfont+inttostr(ord(text[z])));

        h.Draw(myform.dxdraw.Surface,dlina,y,0);

        dlina:=dlina+h.PatternWidth+1;

     end;

  end;

end;