richmemo: added wsgetfontparams to handle missing informations

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4010 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/richmemo/richmemo.pas

@@ -292,19 +292,25 @@ end;
 
 function GetFontParams(AFont: TFont): TFontParams; overload;
 var
-  data    : TFontData;
+  data   : TFontData;
+  wstest : Boolean;
 begin
   InitFontParams(Result);
   if not Assigned(AFont) then Exit;
 
   if AFont.Reference.Handle <> 0 then begin
-    data:=GetFontData(AFont.Reference.Handle);
+    // WSGetFontParams is introduced, because default Gtk widgetset returns
-    if data.Height<0
+    // only FontName from the handle.
-      then Result.Size:=round(abs(data.Height)/ScreenInfo.PixelsPerInchY*72)
+    wstest:= Assigned(WSGetFontParams) and WSGetFontParams(AFont.Reference.Handle, Result);
-      else Result.Size:=data.Height;
+    if not wstest then begin
-    Result.Name:=data.Name;
+      data:=GetFontData(AFont.Reference.Handle);
-    Result.Color:=AFont.Color;
+      if data.Height<0
-    Result.Style:=data.Style;
+        then Result.Size:=round(abs(data.Height)/ScreenInfo.PixelsPerInchY*72)
+        else Result.Size:=data.Height;
+      Result.Name:=data.Name;
+      Result.Color:=AFont.Color;
+      Result.Style:=data.Style;
+    end;
   end else begin
     Result.Name := AFont.Name;
     Result.Color := AFont.Color;

components/richmemo/wsrichmemo.pas

@@ -25,6 +25,7 @@ interface
 
 uses
   Types, Classes, SysUtils,
+  LCLType,
   Graphics, Controls, StdCtrls,
   WSStdCtrls, RichMemo;
 
@@ -103,6 +104,10 @@ type
   
 function WSRegisterCustomRichMemo: Boolean; external name 'WSRegisterCustomRichMemo';
 
+var
+  //note: this internal function might go away eventually!
+  WSGetFontParams: function (wsfontref: HFONT; var params: TFontParams): Boolean = nil;
+
 implementation
 
 { TWSCustomRichMemo }