如何从字体文件中获取字体名称？ [英] How do I get the font name from a font file?

问题描述

我想枚举中的所有文件C：\Windows\Fonts\

首先，我使用 FindFirst& FindNext 获取所有文件

代码：

 路径：='C：\Windows\Fonts'; 
如果FindFirst（Path +'\ *'，faNormal，FileRec）= 0，那么
重复
 
 Memo1.Lines.Add（FileRec.Name）; 
 
直到FindNext（FileRec）<> 0; 
 FindClose（FileRec）; 
  

它得到一些这样的名字 tahoma.ttf 在Windows字体文件夹中显示 Tahoma常规。

但是如何才能获得？

第二个我为什么不能枚举 C：\Windows\Fonts\ by shell

代码：

  var 
 psfDeskTop：IShellFolder; 
 psfFont：IShellFolder; 
 pidFont：PITEMIDLIST 
 pidChild：PITEMIDLIST; 
 pidAbsolute：PItemIdList; 
 FileInfo：SHFILEINFOW; 
 pEnumList：IEnumIDList; 
 celtFetched：ULONG; 
 begin 
 OleCheck（SHGetDesktopFolder（psfDeskTop））; 
 //字体文件夹路径
 OleCheck（SHGetSpecialFolderLocation（0，CSIDL_FONTS，pidFont））; 
 OleCheck（psfDeskTop.BindToObject（pidFont，nil，IID_IShellFolder，psfFont））; 
 OleCheck（psfFont.EnumObjects（0，SHCONTF_NONFOLDERS或SHCONTF_INCLUDEHIDDEN 
或SHCONTF_FOLDERS，pEnumList））; 
 while pEnumList.Next（0，pidChild，celtFetched）= 0 do 
 begin 
 // break in here 
 pidAbsolute：= ILCombine（pidFont，pidChild）; 
 SHGetFileInfo（LPCTSTR（pidAbsolute）），0，FileInfo，SizeOf（FileInfo），
 SHGFI_PIDL或SHGFI_DISPLAYNAME）; 
 Memo1.Lines.Add（FileInfo.szDisplayName）; 
结束
结束
  

我知道使用 Screen.Fonts 获取字体列表，但它显示不同于 C：\Windows\Fonts\ ;

解决方案

GetFontResourceInfo 未记录的功能可以从字体文件中获取字体的名称。

尝试此示例

  {$ APPTYPE CONSOLE} 
 
 {$ R * .res} 
 
使用
 Windows， 
 SysUtils; 
 
 
函数GetFontResourceInfo（lpszFilename：PChar; var cbBuffer：DWORD; lpBuffer：PChar; dwQueryType：DWORD）：DWORD;标准外部'gdi32.dll'名称'GetFontResourceInfoW'; 
 
程序ListFonts; 
 const 
 QFR_DESCRIPTION = 1; 
 var 
 FileRec：TSearchRec; 
 cbBuffer：DWORD; 
 lpBuffer：数组[0..MAX_PATH-1]的Char; 
 begin 
如果FindFirst（'C：\Windows\Fonts\ *。*'，faNormal，FileRec）= 0然后
尝试
重复
 cbBuffer ：= SizeOf（lpBuffer）; 
 GetFontResourceInfo（PWideChar（'C：\Windows\Fonts\'+ FileRec.Name），cbBuffer，lpBuffer，QFR_DESCRIPTION）; 
 Writeln（格式（'％s  - ％s'，[FileRec.Name，lpBuffer]））; 
直到FindNext（FileRec）<> 0; 
 finally 
 FindClose（FileRec）; 
结束
结束
 
 
 begin 
 try 
 ListFonts; 
除了
在E：Exception do 
 Writeln（E.ClassName，'：'，E.Message）; 
结束
 Readln; 
结束。 
  

关于您的第二个问题
替换此行

  while pEnumList.Next（0，pidChild，b）= 0 do 
  

与

  while pEnumList.Next（0，pidChild，celtFetched）= 0 do 
  

I want to enumerate all the file in the C:\Windows\Fonts\

First I use FindFirst&FindNext to get all the file

Code:

Path := 'C:\Windows\Fonts';
  if FindFirst(Path + '\*', faNormal, FileRec) = 0 then
    repeat

      Memo1.Lines.Add(FileRec.Name);

    until FindNext(FileRec) <> 0;
  FindClose(FileRec);

it get some name like this tahoma.ttf which display Tahoma regular in windows font folder .

but how can I get that ?

second I why can't enumerate files in C:\Windows\Fonts\ by shell

Code :

var
  psfDeskTop : IShellFolder;
  psfFont : IShellFolder;
  pidFont : PITEMIDLIST;
  pidChild : PITEMIDLIST;
  pidAbsolute : PItemIdList;
  FileInfo : SHFILEINFOW;
  pEnumList : IEnumIDList;
  celtFetched : ULONG;
begin
  OleCheck(SHGetDesktopFolder(psfDeskTop));
  //Font folder path
  OleCheck(SHGetSpecialFolderLocation(0, CSIDL_FONTS, pidFont));
  OleCheck(psfDeskTop.BindToObject(pidFont, nil, IID_IShellFolder, psfFont));
  OleCheck(psfFont.EnumObjects(0, SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN
    or SHCONTF_FOLDERS, pEnumList));
  while pEnumList.Next(0, pidChild, celtFetched ) = 0 do
  begin
   //break in here
    pidAbsolute := ILCombine(pidFont, pidChild);
    SHGetFileInfo(LPCTSTR(pidAbsolute), 0, FileInfo, SizeOf(FileInfo),
    SHGFI_PIDL or SHGFI_DISPLAYNAME );
    Memo1.Lines.Add(FileInfo.szDisplayName);
  end;
end;

and I know use Screen.Fonts can get font list but it display different from C:\Windows\Fonts\;

解决方案

The GetFontResourceInfo undocumented function can get the name of the font from a font file.

Try this sample

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  SysUtils;


function GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD; lpBuffer: PChar; dwQueryType: DWORD): DWORD; stdcall; external 'gdi32.dll' name 'GetFontResourceInfoW';

procedure ListFonts;
const
  QFR_DESCRIPTION  =1;
var
  FileRec : TSearchRec;
  cbBuffer : DWORD;
  lpBuffer: array[0..MAX_PATH-1] of Char;
begin
  if FindFirst('C:\Windows\Fonts\*.*', faNormal, FileRec) = 0 then
  try
    repeat
      cbBuffer:=SizeOf(lpBuffer);
      GetFontResourceInfo(PWideChar('C:\Windows\Fonts\'+FileRec.Name), cbBuffer, lpBuffer, QFR_DESCRIPTION);
      Writeln(Format('%s - %s',[FileRec.Name ,lpBuffer]));
    until FindNext(FileRec) <> 0;
  finally
    FindClose(FileRec);
  end;
end;


begin
  try
   ListFonts;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end. 

About your second question replace this line

  while pEnumList.Next(0, pidChild, b) = 0 do 

with

  while pEnumList.Next(0, pidChild, celtFetched) = 0 do

这篇关于如何从字体文件中获取字体名称？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！