From 74bfea219da3b719ae61b445fc04c40948e2bca4 Mon Sep 17 00:00:00 2001
From: graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>
Date: Sat, 11 Aug 2007 14:45:24 +0000
Subject: * Implemented fpgApplicatio.GetFontfaceList (GDI untested)

---
 examples/gui/gridtest/gridtest.lpr |  8 ++++++++
 src/corelib/gdi/gfx_gdi.pas        | 26 ++++++++++++++++++++++++++
 src/corelib/gfxbase.pas            |  9 +++++++++
 src/corelib/x11/gfx_x11.pas        | 34 ++++++++++++++++++++++++++++++++++
 4 files changed, 77 insertions(+)

diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr
index 3f461155..24372c22 100644
--- a/examples/gui/gridtest/gridtest.lpr
+++ b/examples/gui/gridtest/gridtest.lpr
@@ -57,7 +57,15 @@ begin
 end;
 
 procedure TMainForm.btnQuitClick(Sender: TObject);
+var
+  sl: TStringList;
+  i: integer;
 begin
+  sl := fpgApplication.GetFontFaceList;
+  Writeln('Fontface Listing:');
+  for i := 0 to sl.Count-1 do
+    Writeln('  ', sl[i]);
+  sl.Free;
   Close;
 end;
 
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index ee92b156..44923000 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -168,6 +168,7 @@ type
     FFocusedWindow: THANDLE;
     LastClickWindow: TfpgWinHandle; // double click generation
     LastWinClickTime: longword;
+    function    DoGetFontFaceList: TStringList; override;
   public
     constructor Create(const aparams: string); override;
     function    DoMessagesPending: boolean;
@@ -713,6 +714,31 @@ end;
 
 { TfpgApplicationImpl }
 
+function TfpgApplicationImpl.DoGetFontFaceList: TStringList;
+  //------
+  function MyFontEnumerator(var LogFont: ENUMLOGFONTEX; var TextMetric: NEWTEXTMETRICEX;
+      FontType: Integer; data: LPARAM): Integer; stdcall;
+  var
+    sl: TStringList;
+    s: string;
+  begin
+    sl  := TStringList(data);
+    s   := LogFont.elfLogFont.lfFaceName;
+    if ((sl.Count = 0) or (sl.Strings[sl.Count-1] <> s)) then
+      sl.Add(s);
+    Result := 1;
+  end;
+
+var
+  LFont: TLogFont;
+begin
+  Result := TStringList.Create;
+  FillChar(LFont, sizeof(LFont), 0);
+  LFont.lfCharset := DEFAULT_CHARSET;
+  EnumFontFamiliesEx(Display, @LFont, @MyFontEnumerator, LongInt(result), 0);
+  Result.Sort;
+end;
+
 constructor TfpgApplicationImpl.Create(const aparams: string);
 begin
   FIsInitialized  := False;
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 4a43fb49..78ef4b66 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -368,8 +368,10 @@ type
     FTopModalForm: TfpgWindowBase;
   protected
     FIsInitialized: Boolean;
+    function    DoGetFontFaceList: TStringList; virtual; abstract;
   public
     constructor Create(const AParams: string); virtual; abstract;
+    function    GetFontFaceList: TStringList;
     property    IsInitialized: boolean read FIsInitialized;
     property    TopModalForm: TfpgWindowBase read FTopModalForm write FTopModalForm;
     property    MainForm: TfpgWindowBase read FMainForm write FMainForm;
@@ -1474,5 +1476,12 @@ begin
   result := 2.0;
 end;
 
+{ TfpgApplicationBase }
+
+function TfpgApplicationBase.GetFontFaceList: TStringList;
+begin
+  Result := DoGetFontFaceList;
+end;
+
 end.
 
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 03f3c945..f11bfd38 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -181,6 +181,7 @@ type
     InputContext: PXIC;
     LastClickWindow: TfpgWinHandle;   // double click generation
     LastWinClickTime: longword;
+    function    DoGetFontFaceList: TStringList; override;
   public
     constructor Create(const aparams: string); override;
     destructor  Destroy; override;
@@ -480,6 +481,39 @@ begin
       SizeOf(FComposeBuffer) - 1, @Result, @FComposeStatus));
 end;
 
+function TfpgApplicationImpl.DoGetFontFaceList: TStringList;
+var
+  pfs: PFcFontSet;
+  ppat: PPFcPattern;
+  n: integer;
+  s: string;
+  pc: PChar;
+  fl: TStringList;
+begin
+  pfs := XftListFonts(Display, DefaultScreen, [FC_SCALABLE, FcTypeBool, 1, 0, FC_FAMILY, 0]);
+
+  if pfs = nil then
+    Exit; //==>
+
+  Result := TStringList.Create;
+
+  GetMem(pc, 128);
+  n := 0;
+  ppat := pfs^.fonts;
+  while n < pfs^.nfont do
+  begin
+    XftNameUnparse(ppat^, pc, 127);  //XftNameUnparse does not free the name string!
+    s := pc;
+    Result.Add(s);
+    inc(PChar(ppat), sizeof(pointer));
+    inc(n);
+  end;
+  FreeMem(pc);
+  FcFontSetDestroy(pfs);
+
+  Result.Sort;
+end;
+
 constructor TfpgApplicationImpl.Create(const aparams: string);
 var
   wa: TXWindowAttributes;
-- 
cgit v1.2.3-70-g09d2