simplified GTK2 CreateFontIndirectEx

git-svn-id: trunk@9203 -

lcl/graphics.pp

@@ -1319,6 +1319,8 @@ function ClearXLFDHeight(const LongFontName: string): string;
 function ClearXLFDPitch(const LongFontName: string): string;
 function ClearXLFDStyle(const LongFontName: string): string;
 function XLFDHeightIsSet(const LongFontName: string): boolean;
+procedure FontNameToPangoFontDescStr(const LongFontName: string;
+  var aFamily,aStyle:String; var aSize: Integer);
 
 // graphics
 type

lcl/include/font.inc

@@ -508,6 +508,86 @@ begin
   Result:=(MinusCnt=14);
 end;
 
+// split a given fontName into Pango Font description components
+// font name is supposed to follow this layout:
+// [FAMILY-LIST][STYLE-LIST][SIZE]
+// where:
+// [FAMILY-LIST]  is a comma separated list of families optionally
+//                ended by a comma
+// [STYLE-LIST]   is white space separated list of words where each word
+//                describe one of style, variant, slant, weight or stretch
+// [SIZE]         is a decimal number (size in points) (... and points in PANGO_UNITS)
+// any of these options may be absent.
+procedure FontNameToPangoFontDescStr(const LongFontName: string;
+  var aFamily,aStyle: string; var aSize: Integer);
+
+var
+  i: Integer;
+  
+  procedure addStyle(const s: string);
+  begin
+    if (s<>'') and (s<>'*') then begin
+      if aStyle<>'' then
+        aStyle := aStyle + ' ' + s
+      else
+        aStyle := s;
+    end;
+  end;
+
+  function GetSize: string;
+  var
+    c: char;
+    validblank: boolean;
+    
+    function IsBlank: boolean;
+    begin
+      result := c in [#0..' '];
+    end;
+    
+    function IsDigit: boolean;
+    begin
+      result := c in ['0'..'9'];
+    end;
+    
+  begin
+    Result := '';
+    validblank := true;
+    i := Length(LongFontname);
+    while i>0 do begin
+      c := longFontName[i];
+      if IsBlank then
+        if ValidBlank then begin
+          dec(i);
+          continue
+        end else
+          break;
+      ValidBlank := false;
+      if IsDigit then begin
+        Result := C + Result;
+        dec(i);
+      end else
+        break;
+    end;
+  end;
+begin
+  aStyle := '';
+  if IsFontNameXLogicalFontDesc(LongFontName) then begin
+    aFamily := ExtractXLFDItem(LongFontName, XLFD_FAMILY);
+    if aFamily='*' then
+      aFamily:='';
+    aSize := StrToIntDef(ExtractXLFDItem(LongFontName, XLFD_POINTSIZE),12);
+    addStyle( ExtractXLFDItem(LongFontName, XLFD_STYLENAME ));
+    addStyle( ExtractXLFDItem(LongFontname, XLFD_WEIGHTNAME));
+    addStyle( ExtractXLFDItem(LongFontname, XLFD_SLANT));
+    addStyle( ExtractXLFDItem(LongFontname, XLFD_WidthName));
+  end else begin
+    // this could go trhough, but we want to know at least the pointSize from
+    // the fontname
+    aSize := StrToIntDef(GetSize,0);
+    aFamily := Copy(LongFontName, 1, i);
+    // todo: parse aFamily to separate Family and Style
+  end;
+end;
 
 { TFont }
 

lcl/interfaces/gtk2/gtk2winapi.inc

@@ -61,104 +61,56 @@ function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
   const LongFontName: string): HFONT;
 var
   GdiObject: PGdiObject;
-  FontNameRegistry, Foundry, FamilyName, WeightName,
+  FullString: String;
-  Slant, SetwidthName, AddStyleName, PixelSize,
+  aFamily,aStyle: String;
-  PointSize, ResolutionX, ResolutionY, Spacing, AverageWidth,
+  aSize: Integer;
-  CharSetRegistry, CharSetCoding: string;
-  FullString : AnsiString;
-  SizeFont   : integer;
 
   procedure LoadDefaultFont;
   begin
     DisposeGDIObject(GdiObject);
     GdiObject:=CreateDefaultFont;
   end;
-
+  
 begin
-  Result := 0;
+  result := 0;
-  GDIObject := NewGDIObject(gdiFont);
+  GdiObject := NewGdiObject(gdiFont);
-  Try
+  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
       then begin
         Assert(false,'ERROR: [Tgt2kObject.CreateFontIndirectEx] No fontname');
         Exit;
       end;
-
+      
-      if (FamilyName = '') or (CompareText(FamilyName,'*')=0) then begin
+      if CompareText(lfFacename,'default')=0 then begin
-        FamilyName := StrPas(lfFaceName);
+        LoadDefaultFont;
-        if CompareText(FamilyName,'default')=0 then begin
+        Result := HFONT(GdiObject);
-          LoadDefaultFont;
+        exit;
-          exit;
-        end;
       end;
-      sizeFont:=0;
+      
-      if IsFontNameXLogicalFontDesc(LongFontName) then
+      FontNameToPangoFontDescStr(LongFontname, aFamily, aStyle, aSize);
-          if  (PointSize <> '') and  (CompareText(PointSize,'*')<>0) then
+      
-            sizeFont:=StrToInt(PointSize) div 10;
+      // if font specified size, prefer this instead of 'posibly' inacurate lfHeight
-      if sizeFont = 0 then sizeFont:=abs(lfHeight);
+      // note that lfHeight may actually have a most acurate value but there is no
-      if sizeFont = 0 then sizeFont:=12;
+      // way to know this at this point.
-
+      
-
+      // setting the size, this could be done in two ways
-
+      // method 1: fontdesc using fontname like "helvetica 12"
-
+      // method 2: fontdesc using fontname like "helvetica" and later modify size
-      FullString := FamilyName + ' '+ IntToStr(sizeFont );
+      
-
+      // to obtain consistent font sizes method 2 should be used
-      if FontNameRegistry='' then ;
+      // for method 1 converting lfheight to fontsize can lead to rounding errors
-      if Foundry='' then ;
+      //   for example, font size=12, lfheight=-12 (75dpi), at 75 dpi aSize=11
-      if WeightName='' then ;
+      //   so we would get a font "helvetica 11" instead of "helvetica 12"
-      if Slant='' then ;
+      // size information, and later modify font size
-      if SetwidthName='' then ;
+      
-      if AddStyleName='' then ;
+      // using method 2
-      if PixelSize='' then ;
+      FullString := AFamily + ' ' + aStyle;
-      if ResolutionX='' then ;
+      
-      if ResolutionY='' then ;
-      if Spacing='' then ;
-      if AverageWidth='' then ;
-      if CharSetCoding='' then ;
-      if CharSetRegistry='' then ;
-
       GdiObject^.GDIFontObject :=
-                          pango_font_description_from_string(PChar(FullString));
+        pango_font_description_from_string(PChar(FullString));
-      if lfWeight <> FW_DONTCARE then
+
+      If lfWeight <> FW_DONTCARE then
         pango_font_description_set_weight(GdiObject^.GDIFontObject, lfWeight);
 
       if lfItalic = 0 then
@@ -167,13 +119,22 @@ begin
       else
         pango_font_description_set_style(GdiObject^.GDIFontObject,
                                          PANGO_STYLE_ITALIC);
-      if lfHeight<>0 then
+                                         
-        pango_font_description_set_size(GdiObject^.GDIFontObject,abs(lfHeight)*PANGO_SCALE);
+      if aSize=0 then begin
+        // a size is not specified, try to calculate one based on lfHeight
+        // and use this value not in the font name but set this value appart
+        // NOTE: in gtk2.8 is possible to use pango_font_description_set_absolute_size
+        // which would be great with the given lfheight value, but older gtk2 version
+        // doesn't have this funtion
+        aSize:= (abs(lfheight) * 72) div ScreenInfo.PixelsPerInchX;
+        if aSize=0 then
+          aSize := 12;
+      end;
+      pango_font_description_set_size( GdiObject^.GDIFontObject, aSize*PANGO_SCALE);
 
       GdiObject^.StrikeOut := lfStrikeOut <> 0;
       GdiObject^.Underline := lfUnderline <> 0;
 
-      Result := HFONT(GdiObject);
     end;
   finally
     if GdiObject^.GDIFontObject = nil
@@ -187,6 +148,7 @@ begin
   end;
 end;
 
+
 {------------------------------------------------------------------------------
   Function: EndPaint
   Params:  none