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

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

Ниже приведен код для Delphi 1, который динамически устанавливает шрифты, загружаемые только во время работы приложения. Вы можете расположить файл(ы) шрифтов в каталоге приложения. Они будут инсталлированы при загрузке формы и выгружены при ее разрушении. Вам возможно придется модифицировать код для работы с 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;

<
/p> Я поработал с данным кодом и внес некоторые поправки для корректной работы на 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}

Дополнение

предлагает следующее решение:

Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно следующим образом:

{$IFDEF WIN32}
AddFontResource( PChar( my_font_PathName { AnsiString } ) );
{$ELSE}
var
ss : array [ 0..255 ] of Char;
AddFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

Убрать его по окончании работы:

{$IFDEF WIN32}
RemoveFontResource ( PChar(my_font_PathName) );
{$ELSE}
RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 )

При этом не надо никаких перезагрузок и прочего, после добавления фонт сразу можно использовать. my_font_PathName: string ( не string[nn] для D2 и выше) - содержит полный путь с именем и расширением необходимого фонта. После удаления фонта форточки о нем забывают. Если его не удалить, он (кажется) так и останется проинсталенным. В любом случае я это не проверял. [000090]

Содержание раздела