|
Как приложению воспользоваться своими шрифтами
Может ли кто-нибудь подсказать или решить такую проблему: мне
нужно убедиться, что мое приложение использует доступные, а не ближайшие шрифты,
установленные пользователем в системе? Я пробовал копировать файл #.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}
|
|
