Direct2D (35) : 通过 DirectWrite 获取字体列表

uses Direct2D, D2D1;

procedure TForm1.Button1Click(Sender: TObject);
var
  iFontCollection: IDWriteFontCollection;     //字体集合
  iFontFamily: IDWriteFontFamily;             //字族
  iLocalizedStrings: IDWriteLocalizedStrings; //按区域设置名称编制索引的字符串集合
  i,j: Integer;
  buf: array[0..LF_FACESIZE] of Char;
begin
  ListBox1.Clear;
  DWriteFactory.GetSystemFontCollection(iFontCollection);
  for i := 0 to iFontCollection.GetFontFamilyCount - 1 do
  begin
    iFontCollection.GetFontFamily(i, iFontFamily);
    iFontFamily.GetFamilyNames(iLocalizedStrings);
    for j := 0 to iLocalizedStrings.GetCount - 1 do
    begin
      iLocalizedStrings.GetString(j, buf, Length(buf));
      ListBox1.Items.Add(buf);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  iFontCollection: IDWriteFontCollection;
  iFontFamily: IDWriteFontFamily;
  iLocalizedStrings: IDWriteLocalizedStrings;
  buf: array[0..LOCALE_NAME_MAX_LENGTH] of Char;
  cn: string;
  n: Cardinal;
  b: LongBool;
  i: Integer;
begin
  ListBox1.Clear;
  LCIDToLocaleName(GetUserDefaultLangID, buf, Length(buf), 0);
  cn := buf; //'zh-CN'
  DWriteFactory.GetSystemFontCollection(iFontCollection);
  for i := 0 to iFontCollection.GetFontFamilyCount - 1 do
  begin
    iFontCollection.GetFontFamily(i, iFontFamily);
    iFontFamily.GetFamilyNames(iLocalizedStrings);
    iLocalizedStrings.FindLocaleName(cn[1], n, b);
    if not b then Continue;
    iLocalizedStrings.GetString(n, buf, Length(buf));
    ListBox1.Items.Add(buf);
  end;
end;

效果图：