GdiPlus[25]: IGPInstalledFontCollection: 获取已安装的字体列表

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    ListBox1: TListBox;

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses GdiPlus;



//通过 IGPInstalledFontCollection 获取字体列表

procedure TForm1.Button1Click(Sender: TObject);

var

  FontCollection: IGPInstalledFontCollection;

  FontFamily: IGPFontFamily;

begin

  FontCollection := TGPInstalledFontCollection.Create;



  Text := Format('字体总数: %d', [FontCollection.Families.Count]);



  ListBox1.Clear;

  for FontFamily in FontCollection.Families do

  begin

    ListBox1.Items.Add(FontFamily.FamilyName);

  end;

end;



//通过 Screen 获取字体列表

procedure TForm1.Button2Click(Sender: TObject);

begin

  Text := Format('字体总数: %d', [Screen.Fonts.Count]);

  ListBox1.Items.Assign(Screen.Fonts);

end;



end.