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