PANGO support for GTK2 now works.. sorta. TextOut/ExtTextOut broken?

git-svn-id: trunk@4623 -

lcl/interfaces/gtk/gtkdef.pp

@@ -30,7 +30,7 @@ unit GTKDef;
 {$LONGSTRINGS ON}
 
 {$IFDEF gtk2}
-{off $DEFINE USE_PANGO}
+{$DEFINE USE_PANGO}
 {$EndIf}
 
 interface
@@ -465,6 +465,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.46  2003/09/15 03:10:46  ajgenius
+  PANGO support for GTK2 now works.. sorta. TextOut/ExtTextOut broken?
+
   Revision 1.45  2003/09/09 20:46:38  ajgenius
   more implementation toward pango for gtk2
 

lcl/interfaces/gtk/gtkint.pp

@@ -47,7 +47,7 @@ interface
 {off $Define Disable_GC_SysColors}
 
 {$IFDEF gtk2}
-{off $DEFINE USE_PANGO}
+{$DEFINE USE_PANGO}
 {$EndIf}
 
 uses
@@ -372,6 +372,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.146  2003/09/15 03:10:46  ajgenius
+  PANGO support for GTK2 now works.. sorta. TextOut/ExtTextOut broken?
+
   Revision 1.145  2003/09/12 17:40:45  ajgenius
   fixes for GTK2(accel groups, menu accel, 'draw'),
   more work toward Pango(DrawText now works, UpdateDCTextMetric mostly works)

lcl/interfaces/gtk/gtkproc.pp

@@ -25,7 +25,7 @@ interface
 {$ENDIF}
 
 {$IFDEF gtk2}
-{off $DEFINE USE_PANGO}
+{$DEFINE USE_PANGO}
 {$EndIf}
 uses
   SysUtils, Classes,

lcl/interfaces/gtk2/gtk2int.pas

@@ -30,7 +30,7 @@ interface
 {$ASSERTIONS ON}
 {$endif}
 
-{off $DEFINE USE_PANGO}
+{$DEFINE USE_PANGO}
 
 uses
   Classes, SysUtils,
@@ -520,7 +520,11 @@ function Tgtk2Object.CreateFontIndirectEx(const LogFont: TLogFont;
   const LongFontName: string): HFONT;
 var
   GdiObject: PGdiObject;
-  FamilyName : string;
+  FontNameRegistry, Foundry, FamilyName, WeightName,
+  Slant, SetwidthName, AddStyleName, PixelSize,
+  PointSize, ResolutionX, ResolutionY, Spacing, AverageWidth,
+  CharSetRegistry, CharSetCoding: string;
+  FullString : AnsiString;
   
   procedure LoadDefaultFont;
   begin
@@ -531,6 +535,44 @@ var
 begin
   Result := 0;
   GDIObject := NewGDIObject(gdiFont);
+  Try
+    // set default values
+    FontNameRegistry := '*';
+    Foundry := '*';
+    FamilyName := '*';
+    WeightName := '*';
+    Slant := '*';
+    SetwidthName := '*';
+    AddStyleName := '*';
+    PixelSize := '*';
+    PointSize := '*';
+    ResolutionX := '*';
+    ResolutionY := '*';
+    Spacing := '*';
+    AverageWidth := '*';
+    CharSetRegistry := '*';
+    CharSetCoding := '*';
+
+    // check if LongFontName is in XLFD format
+    if IsFontNameXLogicalFontDesc(LongFontName) then begin
+      FontNameRegistry := ExtractXLFDItem(LongFontName,0);
+      Foundry          := ExtractXLFDItem(LongFontName,1);
+      FamilyName       := ExtractXLFDItem(LongFontName,2);
+      WeightName       := ExtractXLFDItem(LongFontName,3);
+      Slant            := ExtractXLFDItem(LongFontName,4);
+      SetwidthName     := ExtractXLFDItem(LongFontName,5);
+      AddStyleName     := ExtractXLFDItem(LongFontName,6);
+      PixelSize        := ExtractXLFDItem(LongFontName,7);
+      PointSize        := ExtractXLFDItem(LongFontName,8);
+      ResolutionX      := ExtractXLFDItem(LongFontName,9);
+      ResolutionY      := ExtractXLFDItem(LongFontName,10);
+      Spacing          := ExtractXLFDItem(LongFontName,11);
+      AverageWidth     := ExtractXLFDItem(LongFontName,12);
+      CharSetRegistry  := ExtractXLFDItem(LongFontName,13);
+      CharSetCoding    := ExtractXLFDItem(LongFontName,14);
+    end else
+      if (LongFontName <> '') and (Screen.Fonts.IndexOf(LongFontName) > 0) then
+        FamilyName := LongFontName;
 
     with LogFont do begin
       if lfFaceName[0] = #0
@@ -539,13 +581,23 @@ begin
         Exit;
       end;
 
-    FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*');
+      if (FamilyName = '') or (AnsiCompareText(FamilyName,'*')=0) then begin
+        FamilyName := StrPas(lfFaceName);
         if AnsiCompareText(FamilyName,'default')=0 then begin
           LoadDefaultFont;
           exit;
         end;
+        FullString := AnsiString(FamilyName + ' ' + IntToStr(Abs(lfHeight)));
+      end
+      else begin
+        FullString := AnsiString(FamilyName);
+        if (PointSize = '') or (AnsiCompareText(PointSize,'*')=0) then
+          FullString := FullString + ' 12'
+        else
+          FullString := FullString + ' ' + PointSize;
+      end;
       
-    GdiObject^.GDIFontObject := pango_font_description_from_string(PChar(AnsiString(FamilyName + ' ' + IntToStr(Abs(lfHeight)))));
+      GdiObject^.GDIFontObject := pango_font_description_from_string(PChar(FullString));
       If lfWeight <> FW_DONTCARE then
         pango_font_description_set_weight(GdiObject^.GDIFontObject, lfWeight);
       
@@ -559,6 +611,16 @@ begin
 
       Result := HFONT(GdiObject);
     end;
+  finally
+    if GdiObject^.GDIFontObject = nil
+    then begin
+      DisposeGDIObject(GdiObject);
+      Result := 0;
+    end
+    else begin
+      Result := HFONT(GdiObject);
+    end;
+  end;
 end;
 
 function Tgtk2Object.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer;
@@ -582,11 +644,6 @@ begin
   if Result and (Count>0)
   then with TDeviceContext(DC) do
   begin
-    if GC = nil
-    then begin
-      WriteLn('WARNING: [Tgtk2Object.GetTextExtentPoint] Uninitialized GC');
-    end
-    else begin
       if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
       then begin
         UseFontDesc := GetDefaultFontDesc(true);
@@ -605,7 +662,7 @@ begin
         WriteLn('WARNING: [Tgtk2Object.GetTextExtentPoint] Missing Font')
       else begin
         DCOrigin:=GetDCOffset(TDeviceContext(DC));
-
+        GetStyle('default');
         Layout := gtk_widget_create_pango_layout (GetStyleWidget('default'), nil);
         pango_layout_set_font_description(Layout, UseFontDesc);
         AttrList := pango_layout_get_attributes(Layout);
@@ -661,7 +718,6 @@ begin
       end;
   end;
 end;
-end;
 
 {------------------------------------------------------------------------------
   procedure Tgtk2Object.UpdateDCTextMetric(DC: TDeviceContext);
@@ -898,6 +954,9 @@ end.
 
 {
   $Log$
+  Revision 1.11  2003/09/15 03:10:46  ajgenius
+  PANGO support for GTK2 now works.. sorta. TextOut/ExtTextOut broken?
+
   Revision 1.10  2003/09/12 17:40:46  ajgenius
   fixes for GTK2(accel groups, menu accel, 'draw'),
   more work toward Pango(DrawText now works, UpdateDCTextMetric mostly works)

lcl/interfaces/gtk2/gtk2interface.lpk

@@ -2,6 +2,15 @@
 <CONFIG>
   <Package>
     <Name Value="GTK2Interface"/>
+    <CompilerOptions>
+      <SearchPaths>
+        <LCLWidgetType Value="gtk"/>
+        <SrcPath Value="$(LazarusDir)/;$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/"/>
+      </SearchPaths>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
     <Files Count="20">
       <Item1>
         <Filename Value="interfaces.pas"/>
@@ -102,15 +111,4 @@
       <IgnoreBinaries Value="False"/>
     </PublishOptions>
   </Package>
-  <CompilerOptions>
-    <SearchPaths>
-      <OtherUnitFiles Value="../gtk/;../../units/"/>
-      <UnitOutputDirectory Value="../../units/gtk2"/>
-      <LCLWidgetType Value="gtk"/>
-    </SearchPaths>
-    <Other>
-      <CustomOptions Value="-dGTK2"/>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
-  </CompilerOptions>
 </CONFIG>