Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как приложению воспользоваться своими шрифтами

Может ли кто-нибудь подсказать или решить такую проблему: мне нужно убедиться, что мое приложение использует доступные, а не ближайшие шрифты, установленные пользователем в системе? Я пробовал копировать файл #.ttf в директорию пользователя windows\system, но мое приложение так и не смогло их увидеть и выбрать для дальнейшего использования.

Ниже приведен код для Delphi, который динамически устанавливает шрифты, загружаемые только во время работы приложения. Вы можете расположить файл(ы) шрифтов в каталоге приложения. Они будут инсталлированы при загрузке формы и выгружены при ее разрушении. Вам возможно придется модифицировать код для работы с Delphi 2, поскольку он использует вызовы Windows API, которые могут как измениться, так и нет. Если в коде вы видите "...", то значит в этом месте может располагаться какой-либо код, не относящийся к существу вопроса.

Ну и, конечно, вы должны заменить "MYFONT" на реальное имя файла вашего шрифта.


 type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     ...
     private
     { Private declarations }
     bLoadedFont: boolean;
   public
     { Public declarations }
   end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   sAppDir: string;
   sFontRes: string;
 begin
   sAppDir := Application.ExeName;
   sAppDir := copy(sAppDir, 1, rpos('\', sAppDir));
 
   sFontRes := sAppDir + 'MYFONT.FOT';
   if not FileExists(sFontRes) then
   begin
     sFontRes := sFontRes + #0;
     sFont := sAppDir + 'MYFONT.TTF' + #0;
     CreateScalableFontResource(0, @sFontRes[1], @sFont[1], nil);
   end;
 
   sFontRes := sAppDir + 'MYFONT.FOT';
   if FileExists(sFontRes) then
   begin
     sFontRes := sFontRes + #0;
     if AddFontResource(@sFontRes[1]) = 0 then
       bLoadedFont := false
     else
     begin
       bLoadedFont := true;
       SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
     end;
   end;
   ...
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 var
   sFontRes: string;
 begin
   if bLoadedFont then
   begin
     sFontRes := sAppDir + 'MYFONT.FOT' + #0;
     RemoveFontResource(@sFontRes[1]);
     SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
   end;
 end;
 

Я поработал с данным кодом и внес некоторые поправки для корректной работы на Delphi 2.0. На Delphi 3.0 не испытано.

Электронная справка по продукту InstallShield показывает, что в системах Win95 и WinNT FOT-файл не нужен. Вам нужен только TTF-файл.

В результате процедура FormCreate стала выглядеть так:


 var
   sAppDir, sFontRes: string;
 begin
   {...другой код...}
   sAppDir := extractfilepath(Application.ExeName);
 
   sFontRes := sAppDir + 'MYFONT.TTF';
   if FileExists(sFontRes) then
   begin
     sFontRes := sFontRes + #0;
     if AddFontResource(@sFontRes[1]) = 0 then
       bLoadedFont := false
     else
     begin
       bLoadedFont := true;
       SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
     end;
   end;
   {...}
 end; {FormCreate}
 

А FormDestroy так:


 var
   sFontRes, sAppDir: string;
 begin
   {...другой код...}
 
   if bLoadedFont then
   begin
     sAppDir := extractfilepath(Application.ExeName);
     sFontRes := sAppDir + 'MYFONT.TTF' + #0;
     RemoveFontResource(@sFontRes[1]);
     SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
   end;
 
   {...другой код...}
 end; {FormDestroy}
 

Для упрощения этого я сделал простую функцию, совмещающую обе этих задачи. Она возвращает логическое значение, говорящая об успехе, или наоборот, о неудаче операции загрузки или выгрузки шрифта.


 {1998-01-16 Функция загрузки и выгрузки шрифта.}
 
 function LoadFont(sFontFileName: string; bLoadIt: boolean): boolean;
 var
   sFont, sAppDir, sFontRes: string;
 begin
   result := TRUE;
 
   if bLoadIt then
   begin
     {Загрузка шрифта.}
     if FileExists(sFontFileName) then
     begin
       sFontRes := sFontFileName + #0;
       if AddFontResource(@sFontRes[1]) = 0 then
         result := FALSE
       else
         SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
     end;
   end
   else
   begin
     {Выгрузка шрифта.}
     sFontRes := sFontFileName + #0;
     result := RemoveFontResource(@sFontRes[1]);
     SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
   end;
 end; {LoadFont}
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS