gpt4 book ai didi

delphi - 如何获取可用字体列表 - Delphi XE3 + Firemonkey 2?

转载 作者:行者123 更新时间:2023-12-03 15:06:20 26 4
gpt4 key购买 nike

为了创建字体选择器,我需要获取 Firemonkey 可用的字体列表。由于 FireMonkey 中不存在 Screen.Fonts 我想我需要使用 FMX.Platform ?例如:

if TPlatformServices.Current.SupportsPlatformService(IFMXSystemFontService, IInterface(FontSvc)) then
begin
edit1.Text:= FontSvc.GetDefaultFontFamilyName;
end
else
edit1.Text:= DefaultFontFamily;

但是,唯一可用的函数是返回默认字体名称。

目前我并不关心跨平台支持,但如果我要转向 Firemonkey,我宁愿尽可能不依赖 Windows 调用。

最佳答案

跨平台解决方案应在条件定义中一起使用 MacApi.AppKit 和 Windows.Winapi。

首先将这些代码添加到您的uses子句中:

{$IFDEF MACOS}
MacApi.Appkit,Macapi.CoreFoundation, Macapi.Foundation,
{$ENDIF}
{$IFDEF MSWINDOWS}
Winapi.Messages, Winapi.Windows,
{$ENDIF}

然后将此代码添加到您的实现中:

{$IFDEF MSWINDOWS}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
var
S: TStrings;
Temp: string;
begin
S := TStrings(Data);
Temp := LogFont.lfFaceName;
if (S.Count = 0) or (AnsiCompareText(S[S.Count-1], Temp) <> 0) then
S.Add(Temp);
Result := 1;
end;
{$ENDIF}

procedure CollectFonts(FontList: TStringList);
var
{$IFDEF MACOS}
fManager: NsFontManager;
list:NSArray;
lItem:NSString;
{$ENDIF}
{$IFDEF MSWINDOWS}
DC: HDC;
LFont: TLogFont;
{$ENDIF}
i: Integer;
begin

{$IFDEF MACOS}
fManager := TNsFontManager.Wrap(TNsFontManager.OCClass.sharedFontManager);
list := fManager.availableFontFamilies;
if (List <> nil) and (List.count > 0) then
begin
for i := 0 to List.Count-1 do
begin
lItem := TNSString.Wrap(List.objectAtIndex(i));
FontList.Add(String(lItem.UTF8String))
end;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
DC := GetDC(0);
FillChar(LFont, sizeof(LFont), 0);
LFont.lfCharset := DEFAULT_CHARSET;
EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, Winapi.Windows.LPARAM(FontList), 0);
ReleaseDC(0, DC);
{$ENDIF}
end;

现在您可以使用 CollectFonts 程序了。不要忘记向过程传递一个非零的 TStringlist。典型的用法可能是这样的。

procedure TForm1.FormCreate(Sender: TObject);
var fList: TStringList;
i: Integer;
begin
fList := TStringList.Create;
CollectFonts(fList);
for i := 0 to fList.Count -1 do
begin
ListBox1.Items.Add(FList[i]);
end;
fList.Free;
end;

关于delphi - 如何获取可用字体列表 - Delphi XE3 + Firemonkey 2?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/13346620/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com