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;
效果图: