delphi 获取一个ttf字体的字体名

unit Unit1;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

  TForm1 = class(TForm)

    Memo1: TMemo;

    OpenDialog1: TOpenDialog;

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

function GetFontNameFromFile(FontFile: WideString): string;

type

  TGetFontResourceInfoW = function(Name: PWideChar; var BufSize: Cardinal;

    Buffer: Pointer; InfoType: Cardinal): LongBool; stdcall;

var

  GFRI: TGetFontResourceInfoW;

  AddFontRes, I: Integer;

  LogFont: array of TLogFontW;

  lfsz: Cardinal;

  hFnt: HFONT;

begin

  GFRI := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');

  if @GFRI = nil then

    raise Exception.Create('GetFontResourceInfoW in gdi32.dll not found.');

  if LowerCase(ExtractFileExt(FontFile)) = '.pfm' then

    FontFile := FontFile + '|' + ChangeFileExt(FontFile, '.pfb');

  AddFontRes := AddFontResourceW(PWideChar(FontFile));

  try

    if AddFontRes > 0 then

      begin

        SetLength(LogFont, AddFontRes);

        lfsz := AddFontRes * SizeOf(TLogFontW);

        if not GFRI(PWideChar(FontFile), lfsz, @LogFont[0], 2) then

          raise Exception.Create('GetFontResourceInfoW failed.');

        AddFontRes := lfsz div SizeOf(TLogFont);

        for I := 0 to AddFontRes - 1 do

          begin

            hFnt := CreateFontIndirectW(LogFont[I]);

            try

              Result := LogFont[I].lfFaceName;

            finally

              DeleteObject(hFnt);

            end;

          end; // for I := 0 to AddFontRes - 1

      end; // if AddFontRes > 0

  finally

    RemoveFontResourceW(PWideChar(FontFile));

  end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 if OpenDialog1.Execute then

    MessageDlg(Format('The font name of %s is'#13#10'%s.', [OpenDialog1.FileName,

      GetFontNameFromFile(OpenDialog1.FileName)]), mtInformation, [mbOK], 0);

end;

end.