Estou desenvolvendo um pequeno aplicativo que lê um .MDB, da qual existem nomes de fonte. Então verifico se estas fontes estão instaladas , se não , instalo-as .Mas tenho que saber o nome de Titulo da Fonte que fica dentro da tela de propriedades/Datalhes para saber com exatidão a fonte a ser inserida. Uma vez que tenho nome do arquivo = "x.ttf" e nome na aba detalhes "x.ttf" , ai ok funciona bem , mas quando tenho "x.ttf" = nome do arquivo e "xx.ttf" na propriedade ai dá tudo errado.
1 Resposta
Vale responder para termos o histórico e caso no futuro alguém precise.
A forma mais simples é instalar, verificar e desinstalar, assim tendo acesso ao nome da fonte. Segue rotina:
Function NomedaFonte(Font: WideString):WideString;
type
TGetFontResourceInfoW = function(Name: PWideChar; var BufSize: Cardinal;
Buffer: pointer; InfoType: Cardinal): LongBool; stdcall;
var
naf, k, y: integer;
gfri: TGetFontResourceInfoW;
lf: array of TLogFontW;
lfsz: Cardinal;
hfnt: HFONT;
Nome: WideString;
begin
gfri := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');
if @gfri = nil then
raise Exception.Create('GetFontResourceInfoW in gdi32.dll não funciona.');
if LowerCase(ExtractFileExt(Font)) = '.pfm' then
Font := Font + '|' + ChangeFileExt(Font, '.pfb');
naf := AddFontResourceW(PWideChar(Font)); //carrega fonte
try
if naf > 0 then
begin
SetLength(lf, naf);
lfsz := naf * SizeOf(TLogFontW);
if not gfri(PWideChar(Font), lfsz, @lf[0], 2) then
raise Exception.Create('GetFontResourceInfoW não pode ser chamado.');
y := 0;
naf := lfsz div SizeOf(TLogFont);
for k := 0 to naf - 1 do
begin
hfnt := CreateFontIndirectW(lf[k]);
try
Nome := lf[k].lfFaceName; //Pega nome da fonte
Result := Nome;
finally
DeleteObject(hfnt);
end;
end;
end;
finally
RemoveFontResourceW(PWideChar(Font)); //Descarrega fonte
end;
end;
Fonte(em alemão).