2012-11-12 4 views
5

Um eine Schriftauswahl zu erstellen, muss ich die Liste der verfügbaren Schriftarten für Firemonkey abrufen. Da Screen.Fonts in FireMonkey nicht existiert, dachte ich, ich müsste FMX.Platform verwenden? zB:Wie bekomme ich die Liste der verfügbaren Schriftarten - Delphi XE3 + Firemonkey 2?

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

jedoch die einzige Funktion ist die Standard-Schriftnamen zurückzukehren.

Im Moment stört mich die plattformübergreifende Unterstützung nicht, aber wenn ich zu Firemonkey ziehe, würde ich mich lieber nicht auf Windows-Aufrufe verlassen, wo es möglich ist.

Antwort

7

Die plattformübergreifende Lösung sollte die MacApi.AppKit und Windows.Winapi zusammen in bedingten Definitionen verwenden.

zuerst diesen Code auf Ihre uses-Klausel hinzufügen:

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

Sie dann diesen Code in Ihrer Implementierung hinzu:

{$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; 

Jetzt können Sie CollectFonts Verfahren verwenden. Vergessen Sie nicht, eine non-nil TStringlist an die Prozedur zu übergeben. Eine typische Verwendung könnte so aussehen.

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; 
+0

Vielen Dank! Ich werde es als korrekt akzeptieren, wenn ich die Chance bekomme, es zu testen, aber es sieht wie eine gute Antwort für mich aus :) – sergeantKK

+0

Hallo, Sie können in meinem Blog nach einer funktionierenden Lösung suchen: http://delphiscience.wordpress.com/2012/11/20/getting-system-fonts-liste-in-firemonkey-the-new-tplatformextensions-class/ –

+0

@ mehmed.ali Übrigens; In Ihrem Profil gibt es einen Platz, an dem Sie einen Link zur Startseite Ihres Blogs hinzufügen können (und sollten). –

3

Ich habe folgende Lösung verwendet:

Printer.ActivePrinter; 
    memo1.lines.AddStrings(Printer.Fonts); 

FMX.Printer in den Verwendungen zu deklarieren.

+0

Danke - das scheint auch zu funktionieren! – sergeantKK

+0

Hallo, haben Sie es auf MAcSide getestet. RefreshFonts-Methode von TPrinter ist nicht auf MacSide implementiert, also denke ich, wenn Sie es verwenden, wird Ihr Code nicht plattformübergreifend sein. –

0

unit Unit1; 

interface 

uses 
    Windows, SysUtils, Classes, Forms, Controls, StdCtrls; 

type 
    TForm1 = class(TForm) 
    ComboBox1: TComboBox; 
    procedure FormShow(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.DFM}      

procedure TForm1.FormShow(Sender: TObject); 
begin 
    ComboBox1.Items.Assign(Screen.Fonts); 
    ComboBox1.Text := 'Fonts...'; 
end; 

end. 

Verwandte Themen