fixed Tgtkobject.drawtext for Pango till the native pango one works better

git-svn-id: trunk@4643 -

lcl/interfaces/gtk/gtkproc.inc

@@ -301,6 +301,64 @@ begin
   result := gdk_region_copy(source1);
   GDK2.gdk_region_xor(result, source2);
 end;
+
+Procedure gdk_text_extents(FontDesc : PPangoFontDescription; Str : PChar;
+  LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
+var
+  Layout : PPangoLayout;
+  AttrList : PPangoAttrList;
+  Attr : PPangoAttribute;
+  Extents : TPangoRectangle;
+begin
+  GetStyle('default');
+  Layout := gtk_widget_create_pango_layout (GetStyleWidget('default'), nil);
+  pango_layout_set_font_description(Layout, FontDesc);
+  AttrList := pango_layout_get_attributes(Layout);
+
+  If (AttrList = nil) then
+    AttrList := pango_attr_list_new();
+
+  Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
+
+  pango_attr_list_change(AttrList,Attr);
+
+  Attr := pango_attr_strikethrough_new(False);
+  pango_attr_list_change(AttrList,Attr);
+
+  pango_layout_set_attributes(Layout, AttrList);
+
+  pango_layout_set_single_paragraph_mode(Layout, TRUE);
+  pango_layout_set_width(Layout, -1);
+
+  pango_layout_set_alignment(Layout, PANGO_ALIGN_LEFT);
+
+  //fix me... and what about UTF-8 conversion?
+  //this could be a massive problem since we
+  //will need to know before hand what the current
+  //locale is, and if we stored UTF-8 string this would break
+  //cross-compatibility with GTK1.2 and win32 interfaces.....
+
+  pango_layout_set_text(Layout,  Str, Linelength);
+
+  if Assigned(width) then
+    pango_layout_get_pixel_size(Layout, width, nil);
+
+  pango_layout_get_extents(Layout, nil, @Extents);
+  g_object_unref(Layout);
+
+  if Assigned(lbearing) then
+    lbearing^ := PANGO_LBEARING(extents) div PANGO_SCALE;
+
+  if Assigned(rbearing) then
+    rBearing^ := PANGO_RBEARING(extents) div PANGO_SCALE;
+
+  if Assigned(ascent) then
+    ascent^ := PANGO_ASCENT(extents) div PANGO_SCALE;
+
+  if Assigned(descent) then
+    descent^ := PANGO_DESCENT(extents) div PANGO_SCALE;
+end;
+
 {$EndIf}
 
 {------------------------------------------------------------------------------
@@ -4510,19 +4568,18 @@ begin
 end;
 
 {-------------------------------------------------------------------------------
-  Function GetTextExtentIgnoringAmpersands(Font : PGDKFont; Str : PChar; 
+  Function GetTextExtentIgnoringAmpersands(Font : PGDKFont; Str : PChar;
                     LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
 
   Gets text extent of a string, ignoring escaped Ampersands.
 -------------------------------------------------------------------------------}
-{$Ifdef USE_PANGO} // we should implement pango for gtk2 soon
+{$Ifdef USE_PANGO}
 Procedure GetTextExtentIgnoringAmpersands(FontDesc : PPangoFontDescription; Str : PChar;
   LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
-begin
-end;
 {$Else}
 Procedure GetTextExtentIgnoringAmpersands(Font : PGDKFont; Str : PChar;
   LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
+{$EndIf}
 var
   NewStr : PChar;
   i: integer;
@@ -4537,12 +4594,16 @@ begin
       LineLength:=StrLen(NewStr);
     end;
   end;
+{$Ifdef USE_PANGO}
+  gdk_text_extents(FontDesc, NewStr, LineLength,
+                   lbearing, rBearing, width, ascent, descent);
+{$Else}
   gdk_text_extents(Font, NewStr, LineLength,
                    lbearing, rBearing, width, ascent, descent);
+{$EndIf}
   if NewStr<>Str then
     StrDispose(NewStr);
 end;
-{$EndIf}
 
 {------------------------------------------------------------------------------
   function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
@@ -4743,6 +4804,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.208  2003/09/18 14:06:30  ajgenius
+  fixed Tgtkobject.drawtext for Pango till the native pango one works better
+
   Revision 1.207  2003/09/17 19:40:46  ajgenius
   Initial DoubleBuffering Support for GTK2
 

lcl/interfaces/gtk/gtkproc.pp

@@ -434,7 +434,7 @@ Function DeleteAmpersands(var Str : String) : Longint;
 function Ampersands2Underscore(Src: PChar) : PChar;
 function RemoveAmpersands(Src: PChar; LineLength : Longint) : PChar;
 
-{$Ifdef USE_PANGO} // we should implement pango for gtk2 soon
+{$Ifdef USE_PANGO}
 Procedure GetTextExtentIgnoringAmpersands(FontDesc : PPangoFontDescription; Str : PChar;
   LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
 {$Else}
@@ -590,6 +590,9 @@ function gtk_widget_get_ythickness(Style : PGTKWidget) : gint; overload;
   Function gdk_region_union(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
   Function gdk_region_subtract(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
   Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
+
+  //mimic GDKFont Routines With Pango -->
+  Procedure gdk_text_extents(FontDesc : PPangoFontDescription; Str : PChar; LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
 {$EndIf}
 
 implementation

lcl/interfaces/gtk/gtkwinapi.inc

@@ -2645,7 +2645,6 @@ var
     else begin
       If (Flags and DT_WordBreak) <> DT_WordBreak then
         MaxLength := Count*TM.tmMaxCharWidth;
-
       Self.WordWrap(DC, Str, MaxLength, Lines, NumLines);
       
       If (Lines = nil) or (NumLines = 0) then
@@ -8796,6 +8795,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.286  2003/09/18 14:06:30  ajgenius
+  fixed Tgtkobject.drawtext for Pango till the native pango one works better
+
   Revision 1.285  2003/09/18 12:15:01  mattias
   fixed is checks for TCustomXXX controls
 

lcl/interfaces/gtk2/gtk2int.pas

@@ -90,6 +90,9 @@ implementation
   Method:  DrawText
   Params:  DC, Str, Count, Rect, Flags
   Returns: If the string was drawn, or CalcRect run
+  
+  inherited routine apears to work fine so, turned off for now. Doesn't work
+  properly, and needs to take & into account before its fully useable....
  ------------------------------------------------------------------------------}
 function TGTK2Object.DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer;
 
@@ -124,6 +127,10 @@ var
   X, Y, Width, Height : Integer;
   DCOrigin: TPoint;
 begin
+  result :=  inherited DrawText(DC, Str, Count, Rect, Flags);
+
+  exit;
+
   if (Str=nil) or (Str[0]=#0) then exit;
   Assert(False, Format('trace:> [Tgtk2Object.DrawText] DC:0x%x, Str:''%s'', Count: %d, Rect = %d,%d,%d,%d, Flags:%d',
     [DC, Str, Count, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Flags]));
@@ -1046,6 +1053,9 @@ end.
 
 {
   $Log$
+  Revision 1.16  2003/09/18 14:06:30  ajgenius
+  fixed Tgtkobject.drawtext for Pango till the native pango one works better
+
   Revision 1.15  2003/09/18 09:21:03  mattias
   renamed LCLLinux to LCLIntf