Нормальная процедура отображения графических шрифтов
Материал из 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