delphi 如何从字体文件中获取字体名称？

program Project2;

{$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\*.ttf', faNormal, FileRec) = 0 then

  try //delphiw.com

    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.