Partially implements GetTextMetrics and improves GetSystemMetrics on the Qt interface.

git-svn-id: trunk@10193 -

lcl/interfaces/qt/qtobjects.pas

@@ -90,6 +90,8 @@ type
     procedure setStrikeOut(p1: Boolean);
     procedure setRawName(p1: string);
     procedure setFamily(p1: string);
+    procedure family(retval: PWideString);
+    function fixedPitch: Boolean;
   end;
 
   { TQtFontMetrics }
@@ -104,6 +106,11 @@ type
   public
     function height: Integer;
     function width(p1: PWideString): Integer;
+    function ascent: Integer;
+    function descent: Integer;
+    function leading: Integer;
+    function maxWidth: Integer;
+    function charWidth(str: WideString; pos: Integer): Integer;
   end;
 
   { TQtBrush }
@@ -118,7 +125,7 @@ type
     procedure setStyle(style: QtBrushStyle);
   end;
 
-{ TQtPen }
+  { TQtPen }
 
   TQtPen = class(TObject)
   private
@@ -136,7 +143,7 @@ type
   end;
 
 
-{ TQtRegion }
+  { TQtRegion }
 
   TQtRegion = class(TObject)
   private
@@ -418,6 +425,16 @@ begin
   QFont_setFamily(Widget, @Str);
 end;
 
+procedure TQtFont.family(retval: PWideString);
+begin
+  QFont_family(Widget, retval);
+end;
+
+function TQtFont.fixedPitch: Boolean;
+begin
+  Result := QFont_fixedPitch(Widget);
+end;
+
 { TQtFontMetrics }
 
 constructor TQtFontMetrics.Create(Parent: QFontH);
@@ -442,6 +459,31 @@ begin
   Result := QFontMetrics_width(Widget, p1);
 end;
 
+function TQtFontMetrics.ascent: Integer;
+begin
+  Result := QFontMetrics_ascent(Widget);
+end;
+
+function TQtFontMetrics.descent: Integer;
+begin
+  Result := QFontMetrics_descent(Widget);
+end;
+
+function TQtFontMetrics.leading: Integer;
+begin
+  Result := QFontMetrics_leading(Widget);
+end;
+
+function TQtFontMetrics.maxWidth: Integer;
+begin
+  Result := QFontMetrics_maxWidth(Widget);
+end;
+
+function TQtFontMetrics.charWidth(str: WideString; pos: Integer): Integer;
+begin
+  Result := QFontMetrics_charWidth(Widget, @str, pos);
+end;
+
 { TQtBrush }
 
 {------------------------------------------------------------------------------
@@ -598,11 +640,11 @@ end;
  ------------------------------------------------------------------------------}
 constructor TQtRegion.Create(CreateHandle: Boolean);
 begin
-  // Creates the widget
   {$ifdef VerboseQt}
     WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
   {$endif}
 
+  // Creates the widget
   if CreateHandle then Widget := QRegion_create;
 end;
 
@@ -613,11 +655,11 @@ end;
  ------------------------------------------------------------------------------}
 constructor TQtRegion.Create(CreateHandle: Boolean; X1,Y1,X2,Y2:Integer);
 begin
-  // Creates the widget
   {$ifdef VerboseQt}
     WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
   {$endif}
 
+  // Creates the widget
   if CreateHandle then Widget := QRegion_create(X1,Y1,X2,Y2);
 end;
 
@@ -633,6 +675,7 @@ begin
   {$endif}
 
   QRegion_destroy(Widget);
+
   inherited Destroy;
 end;
 

lcl/interfaces/qt/qtwinapi.inc

@@ -1223,15 +1223,15 @@ begin
       begin
         Assert(False, 'Trace:TODO: [TGtkWidgetSet.GetSystemMetrics] --> SM_CYFULLSCREEN     ');
       end;
+    { Size of the array bitmap on the horizontal scrollbar
+      Currently hardcoded, but more research should be made to check if Qt gives this info }
     SM_CXHSCROLL:
       begin
-{        P:=GetStyleWidget(lgsVerticalScrollbar);
+        Result := 15;
-        Result := GTK_Widget(P)^.requisition.Width;}
       end;
     SM_CYHSCROLL:
       begin
-{        P:=GetStyleWidget(lgsHorizontalScrollbar);
+        Result := 15;
-        Result := GTK_Widget(P)^.requisition.Height;}
       end;
     SM_CXHTHUMB:
       begin
@@ -1357,15 +1357,15 @@ begin
       begin
         Assert(False, 'Trace:TODO: [TGtkWidgetSet.GetSystemMetrics] --> SM_CYSMSIZE         ');
       end;
+    { Size of the array bitmap on the vertical scrollbar
+      Currently hardcoded, but more research should be made to check if Qt gives this info }
     SM_CXVSCROLL:
       begin
-{        P:=GetStyleWidget(lgsVerticalScrollbar);
+        Result := 15;
-        Result := GTK_Widget(P)^.requisition.Width;}
       end;
     SM_CYVSCROLL:
       begin
-{        P:=GetStyleWidget(lgsHorizontalScrollbar);
+        Result := 15;
-        Result := GTK_Widget(P)^.requisition.Height;}
       end;
     SM_CYCAPTION:
       begin
@@ -1441,7 +1441,7 @@ end;
 
 {------------------------------------------------------------------------------
   Function: GetTextColor
-  Params:  DC
+  Params:  DC     - A device context
   Returns: TColorRef
 
   Gets the Font Color currently assigned to the Device Context
@@ -1493,10 +1493,14 @@ end;
 
 {------------------------------------------------------------------------------
   Function: GetTextMetrics
-  Params:  none
+  Params:  DC     - A device context with a font selected
-  Returns: Nothing
+           TM     - The structure to receive the font information
+  Returns: If successfull
  ------------------------------------------------------------------------------}
 function TQtWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
+var
+  QtFontMetrics: TQtFontMetrics;
+  FontFamily: WideString;
 begin
   {$ifdef VerboseQtWinAPI}
     WriteLn('[WinAPI GetTextMetrics]');
@@ -1506,6 +1510,38 @@ begin
 
   if Result then
   begin
+    QtFontMetrics := TQtFontMetrics.Create(TQtDeviceContext(DC).font.Widget);
+    try
+      TM.tmHeight := QtFontMetrics.height;
+      TM.tmAscent := QtFontMetrics.ascent;
+      TM.tmDescent := QtFontMetrics.descent;
+      TM.tmInternalLeading := QtFontMetrics.leading;
+      TM.tmExternalLeading := 0;
+      TM.tmAveCharWidth := QtFontMetrics.charWidth('x', 0);
+      TM.tmMaxCharWidth := QtFontMetrics.maxWidth;
+      TM.tmWeight := TQtDeviceContext(DC).font.weight;
+      TM.tmOverhang := 0;
+      TM.tmDigitizedAspectX := 0;
+      TM.tmDigitizedAspectY := 0;
+      TM.tmFirstChar := 'a';
+      TM.tmLastChar := 'z';
+      TM.tmDefaultChar := 'x';
+      TM.tmBreakChar := '?';
+      TM.tmItalic := 0;
+      TM.tmUnderlined := 0;
+      TM.tmStruckOut := 0;
+      
+      TQtDeviceContext(DC).font.family(@FontFamily);
+      
+      { Defaults to a TrueType font }
+      if TQtDeviceContext(DC).font.fixedPitch then
+        TM.tmPitchAndFamily := TRUETYPE_FONTTYPE
+      else TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
+
+      TM.tmCharSet := EASTEUROPE_CHARSET;
+    finally
+      QtFontMetrics.Free;
+    end;
   end;
 end;
 

lcl/interfaces/qt/qtwscontrols.pp

@@ -213,7 +213,7 @@ end;
 
   Returns: Nothing
 
-  Shows or hides a widget.
+  Shows or hides a wi/dget.
  ------------------------------------------------------------------------------}
 class procedure TQtWSWinControl.ShowHide(const AWinControl: TWinControl);
 begin
@@ -244,8 +244,9 @@ end;
   Sets the color of the widget.
  ------------------------------------------------------------------------------}
 class procedure TQtWSWinControl.SetColor(const AWinControl: TWinControl);
-var QColor : TQColor;
+var
-    Color  : TColor;
+  QColor: TQColor;
+  Color: TColor;
 begin
   if AWinControl = nil then exit;