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

Материал из DRKB

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

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;

Добавляем на форму:

dlb TDirectoryListBox Тут выбор каталога с изображениями
Имя компонента Название компонента Описание
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