Direct2D (35) : 通过 DirectWrite 获取字体列表
Direct2D (35) : 通过 DirectWrite 获取字体列表
涂孟超 发表于3年前
Direct2D (35) : 通过 DirectWrite 获取字体列表
  • 发表于 3年前
  • 阅读 4
  • 收藏 0
  • 点赞 0
  • 评论 0

腾讯云 技术升级10大核心产品年终让利>>>   


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;


效果图:



共有 人打赏支持
粉丝 13
博文 2004
码字总数 14107
×
涂孟超
如果觉得我的文章对您有用,请随意打赏。您的支持将鼓励我继续创作!
* 金额(元)
¥1 ¥5 ¥10 ¥20 其他金额
打赏人
留言
* 支付类型
微信扫码支付
打赏金额:
已支付成功
打赏金额: