Содержание материала

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

 

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

 

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

 

Code:

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;

  

 

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

 


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

 

Code:

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 так:

 

Code:

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}

  

 


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

 

Code:

 

{Функция загрузки и выгрузки шрифта.}

 

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}

  

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить