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

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

Сразу рассмотрим плюсы и минусы помещения каждой буквы в отдельное изображение!
Плюсы :
1.Более быстрая отрисовка (так как ищется только номер картинки).
2.Буквы рисуются аккуратно, на одинаковом расстоянии друг от друга.
Минусы:
1.Много файлов (256 штук) - этот минус отпадает сам, так как я буду использовать псевдо архив.
2.Довольно медленная загрузка (надо прочитать архив и повторить процедуру загрузки картинки в память 256 раз)

Сначала нам нужны все символы от 1 до 256 в BMP формате (желательно 256 цветов) из них и будет состоять шрифт. Сейчас мы напишем программу сохраняющая ваши символы в псевдо архив fnt. Создаем проект и после слова TYPE пишем:

Thead=record //Заголовок fnt файла
   count:integer; //Количество изображений (вдруг вам русский шрифт не нужен а нужен только английский - тогда картинок будет 128
   name:string[5]; //Имя шрифта (нужно для распаковки картинок)
   tcl:tcolor; //Цвет прозрачности
end;
Добавляем на форму:
Имя компонента: Название компонента: Описание
DXDIB TDXDIB Тут изображение сжимается
dlb TDirectoryListBox Тут выбор каталога с изображениями
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;
Пример fnt файла.
Исходник программы по созданию fnt архива.
Исходник программы распаковывающей fnt архив (работает с командной строки).
Вот в принципе и всё.
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.