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

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

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

Ниже приведен код для 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}

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com