From 9489cc0bd24ec69eb04c23203c33cae7ddf8b97c Mon Sep 17 00:00:00 2001 From: ajgenius Date: Thu, 18 Sep 2003 14:06:30 +0000 Subject: [PATCH] fixed Tgtkobject.drawtext for Pango till the native pango one works better git-svn-id: trunk@4643 - --- lcl/interfaces/gtk/gtkproc.inc | 74 +++++++++++++++++++++++++++++--- lcl/interfaces/gtk/gtkproc.pp | 5 ++- lcl/interfaces/gtk/gtkwinapi.inc | 4 +- lcl/interfaces/gtk2/gtk2int.pas | 10 +++++ 4 files changed, 86 insertions(+), 7 deletions(-) diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 2d16535ed4..9f83bf787a 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/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 diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index 173598fc71..4b39dcd1b2 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/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 diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 67c8e00e78..1b3ac2d1bf 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/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 diff --git a/lcl/interfaces/gtk2/gtk2int.pas b/lcl/interfaces/gtk2/gtk2int.pas index ac49b13c45..c076c5b014 100644 --- a/lcl/interfaces/gtk2/gtk2int.pas +++ b/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