उपलब्ध फ़ॉन्ट्स की सूची कैसे प्राप्त करें - डेल्फी XE3 + Firemonkey 2?

Question

फ़ॉन्ट पिकर बनाने के लिए मुझे फायरमोनकी में उपलब्ध फ़ॉन्ट्स की सूची प्राप्त करने की आवश्यकता है। स्क्रीन के रूप में। FireMonkey में फ़ॉन्ट मौजूद नहीं है मैंने सोचा कि मुझे FMX.Platform का उपयोग करने की आवश्यकता होगी? जैसे:

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

हालांकि, केवल समारोह उपलब्ध डिफ़ॉल्ट फ़ॉन्ट का नाम वापस जाने के लिए है।

फिलहाल मुझे क्रॉस-प्लेटफ़ॉर्म समर्थन के बारे में परेशान नहीं है, लेकिन अगर मैं फायरमोनकी में जाने जा रहा हूं तो मैं जहां संभव हो वहां विंडोज कॉल पर भरोसा नहीं करता।

Answer 1

क्रॉस प्लेटफ़ॉर्म समाधान को मैकएपी.एपकिट और विंडोज़ विनापी का सशर्त परिभाषाओं में एक साथ उपयोग करना चाहिए।

सबसे पहले अपने उपयोगों खंड करने के लिए इन कोड जोड़ें:

{$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 पास करने के लिए मत भूलना। एक सामान्य उपयोग इस तरह हो सकता है।

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

उपयोग में FMX.Printer की घोषणा:

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; 

Answer 2

मैं निम्नलिखित समाधान का उपयोग किया है।

Answer 3

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.