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

=== Нормальная процедура отображения графических шрифтов ===
WEB-сайт: http://daddy.mirgames.ru 
Сразу рассмотрим плюсы и минусы помещения каждой буквы в отдельное изображение!
Плюсы:
* Более быстрая отрисовка (так как ищется только номер картинки).
* Буквы рисуются аккуратно, на одинаковом расстоянии друг от друга.
Минусы:
* Много файлов (256 штук) - этот минус отпадает сам, так как я буду использовать псевдо архив.
* Довольно медленная загрузка (надо прочитать архив и повторить процедуру загрузки картинки в память 256 раз)
Сначала нам нужны все символы от 1 до 256 в BMP формате (желательно 256 цветов) из них и будет состоять шрифт. Сейчас мы напишем программу сохраняющая ваши символы в псевдо архив fnt. Создаем проект и после слова TYPE пишем:
THead = record // Заголовок fnt файла
 Count: Integer; // Количество изображений (вдруг вам русский шрифт не нужен а нужен только английский - тогда картинок будет 128
 Name: string[5]; // Имя шрифта (нужно для распаковки картинок)
 tcl: TColor; // Цвет прозрачности
end;
Добавляем на форму:
Имя компонента	Название компонента	Описание
DXDIB 	TDXDIB 	Тут изображение сжимается
flb 	TFileListBox 	Тут список BMP файлов
dcb 	TDriveComboBox 	Тут выбор диска с изображениями
Button1 	TButton 	Начало сжатия
Button2 	TButton 	Выход из программы
Edit1 	TEdit 	Тут в формате String хранится цвет прозрачности
Edit2 	TEdit 	Отсюда берется название изображений
Теперь на нажатие первой кнопки пишем:
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;
Далее идет процедура отрисовки текста (Текст, икс, игрик, название шрифта, по центру (1-0)) 
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;
Source: http://delphiworld.narod.ru/
ID: 01934