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;

---

效果图：

---