impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time

git-svn-id: trunk@6226 -

lcl/graphics.pp

@@ -454,6 +454,7 @@ type
     procedure BeginUpdate;
     procedure EndUpdate;
     function HandleAllocated: boolean;
+    function IsDefault: boolean;
     // Extra properties
     // TODO: implement them though GetTextMetrics, not here
     //Function GetWidth(Value: String): Integer;
@@ -1783,6 +1784,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.160  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.159  2004/11/07 01:10:05  mattias
   fixed double calling destructor for resource cache items
 

lcl/include/customform.inc

@@ -1561,7 +1561,7 @@ end;
 procedure TCustomForm.ChildHandlesCreated;
 begin
   inherited ChildHandlesCreated;
-  if Parent<>nil then
+  if Parent=nil then
     ParentFormHandleInitialized;
 end;
 
@@ -1824,6 +1824,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.163  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.162  2004/11/05 22:08:53  mattias
   implemented auto sizing: child to parent sizing
 

lcl/include/font.inc

@@ -622,6 +622,20 @@ begin
   Result:=FFontData.Handle<>0;
 end;
 
+{------------------------------------------------------------------------------
+  function TFont.IsDefault: boolean;
+ ------------------------------------------------------------------------------}
+function TFont.IsDefault: boolean;
+begin
+  Result:=(CharSet=DEFAULT_CHARSET)
+         and (Color=clWindowText)
+         and (Height=0)
+         and (not IsNameStored)
+         and (Pitch=fpDefault)
+         and (Size=0)
+         and (Style=[]);
+end;
+
 {------------------------------------------------------------------------------
   Method: TFont.SetSize
   Params: Value: the new value
@@ -950,6 +964,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.20  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.19  2004/11/07 01:36:18  mattias
   fixed cleaning up unused resource cache item lists
 

lcl/include/wincontrol.inc

@@ -42,9 +42,11 @@ procedure TWinControl.AdjustSize;
 begin
   If not AutoSizeCanStart then exit;
   if AutoSizeDelayed then begin
+    //debugln('TWinControl.AdjustSize AutoSizeDelayed ',DbgSName(Self));
     Include(FWinControlFlags,wcfAutoSizeNeeded);
     exit;
   end;
+  //debugln('TWinControl.AdjustSize DoAutoSize ',DbgSName(Self));
   DoAutoSize;
 end;
 
@@ -55,6 +57,7 @@ function TWinControl.AutoSizeDelayed: boolean;
 begin
   Result:=(wcfCreatingChildHandles in FWinControlFlags)
           or (inherited AutoSizeDelayed);
+  //if Result then debugln('TWinControl.AutoSizeDelayed A ',DbgSName(Self),' wcfCreatingChildHandles=',dbgs(wcfCreatingChildHandles in FWinControlFlags),' csLoading=',dbgs(csLoading in ComponentState));
 end;
 
 {------------------------------------------------------------------------------
@@ -3555,6 +3558,7 @@ begin
     for i := 0 to FWinControls.Count - 1 do
       TWinControl(FWinControls.Items[i]).ParentFormHandleInitialized;
   end;
+  //debugln('TWinControl.ParentFormHandleInitialized A ',DbgSName(Self));
   if wcfAutoSizeNeeded in FWinControlFlags then AdjustSize;
 end;
 
@@ -3565,7 +3569,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TWinControl.ChildHandlesCreated;
 begin
-
+  Exclude(FWinControlFlags,wcfCreatingChildHandles);
 end;
 
 {------------------------------------------------------------------------------
@@ -4121,6 +4125,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.289  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.288  2004/11/07 20:44:49  micha
   handle "re-entrancy" into handleneeded (via parent); fixes crash upon showing file diff dialog
 

lcl/interfaces/gtk/gtkcallback.inc

@@ -172,31 +172,6 @@ end;
   the initialization of a widget.
 
 -------------------------------------------------------------------------------}
-  {$IFDEF CustomFonts}
-  procedure ModifyWidgetStyle(AWinControl: TWinControl; AWidget: PGtkWidget);
-  // MG: design study for changing font in gtkwidgets
-  var
-    RCStyle: PGtkRcStyle;
-  begin
-    {$IfDef GTK1}
-    {$IFDEF NoStyle}
-    exit;
-    {$ENDIF}
-    if not (AWinControl is TCustomButton) then exit;
-    DebugLn('ModifyWidgetStyle A ',AWinControl.Name,':',AWinControl.ClassName,' AWidget=',HexStr(Cardinal(AWidget),8));
-    RCStyle:=gtk_rc_style_new;
-    g_free(RCStyle^.font_name);
-    RCStyle^.font_name:=g_strdup('-urw-chancery l-medium-i-normal-*-*-140-*-*-p-*-iso8859-2');
-
-    gtk_widget_modify_style(AWidget,RCStyle);
-
-    g_free(RCStyle^.font_name);
-    RCStyle^.font_name:=nil;
-    gtk_rc_style_unref(RCStyle);
-    {$EndIf}
-  end;
-  {$ENDIF CustomFonts}
-
 function gtkRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
 var
   WinWidgetInfo: PWinWidgetInfo;
@@ -249,11 +224,9 @@ begin
       end;
 
       if TheWinControl<>nil then begin
+        TheWinControl.InvalidatePreferredSize;
         SetCursor(TheWinControl, crDefault);
         ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
-        {$IFDEF CustomFonts}
-        ModifyWidgetStyle(TheWinControl,Widget);
-        {$ENDIF}
         UpdateWidgetStyleOfControl(TheWinControl);
         
         if TheWinControl is TCustomPage then
@@ -2909,6 +2882,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.251  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.250  2004/11/03 14:18:36  mattias
   implemented preferred size for controls for theme depending AutoSizing
 

lcl/interfaces/gtk/gtkfontcache.pas

@@ -63,6 +63,7 @@ type
     function FindGDKFont(TheGdkFont: PGDKFont): TGdkFontCacheItem;
     function FindGDKFontDesc(const LogFont: TLogFont;
                            const LongFontName: string): TGdkFontCacheDescriptor;
+    function FindADescriptor(TheGdkFont: PGDKFont): TGdkFontCacheDescriptor;
     function Add(TheGdkFont: PGDKFont; const LogFont: TLogFont;
                  const LongFontName: string): TGdkFontCacheDescriptor;
     procedure Reference(TheGdkFont: PGDKFont);
@@ -189,6 +190,18 @@ begin
     Result:=nil;
 end;
 
+function TGdkFontCache.FindADescriptor(TheGdkFont: PGDKFont
+  ): TGdkFontCacheDescriptor;
+var
+  Item: TGdkFontCacheItem;
+begin
+  Item:=FindGDKFont(TheGdkFont);
+  if Item=nil then
+    Result:=nil
+  else
+    Result:=TGdkFontCacheDescriptor(Item.FirstDescriptor);
+end;
+
 function TGdkFontCache.Add(TheGdkFont: PGDKFont; const LogFont: TLogFont;
   const LongFontName: string): TGdkFontCacheDescriptor;
 var

lcl/interfaces/gtk/gtkproc.inc

@@ -796,6 +796,30 @@ begin
            +'B'+HexStr(Color^.Blue,4);
 end;
 
+function GetWidgetStyleReport(Widget: PGtkWidget): string;
+var
+  AStyle: PGtkStyle;
+  ARCStyle: PGtkRcStyle;
+begin
+  Result:='';
+  if Widget=nil then exit;
+  AStyle:=gtk_widget_get_style(Widget);
+  if AStyle=nil then begin
+    Result:='nil';
+    exit;
+  end;
+  Result:=Result+'attach_count='+dbgs(AStyle^.attach_count);
+  ARCStyle:=AStyle^.rc_style;
+  if ARCStyle=nil then begin
+    Result:=Result+' rc_style=nil';
+  end else begin
+    Result:=Result+' rc_style=[';
+    Result:=Result+ARCStyle^.font_name+',';
+    Result:=Result+ARCStyle^.fontset_name+',';
+    Result:=Result+']';
+  end;
+end;
+
 {------------------------------------------------------------------------------
   function WidgetIsDestroyingHandle(Widget: PGtkWidget): boolean;
 
@@ -1372,9 +1396,13 @@ begin
     Green := ((AColor      ) and $00FF00) or ((AColor shr 8 ) and $0000FF);
     Blue :=  ((AColor shr 8) and $00FF00) or ((AColor shr 16) and $0000FF);
   end;
+  {$IFDEF DebugGDK}
   BeginGDKErrorTrap;
+  {$ENDIF}
   gdk_colormap_alloc_color(gdk_colormap_get_system, @Result, False, True);
+  {$IFDEF DebugGDK}
   EndGDKErrorTrap;
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -7154,7 +7182,10 @@ var
   Widget, FixWidget : PGTKWidget;
   NewColor: TGdkColor;
   MainWidget: PGtkWidget;
-  //i: Integer;
+  FontHandle: HFONT;
+  i: Integer;
+  FreeFontName: boolean;
+  FreeFontSetName: boolean;
 
   procedure CreateRCStyle;
   begin
@@ -7162,6 +7193,27 @@ var
       RCStyle:=gtk_rc_style_new;
   end;
   
+  procedure SetRCFont(FontGdiObject: PGdiObject);
+  {$IFDEF GTK1}
+  var
+    FontDesc: TGdkFontCacheDescriptor;
+  {$ENDIF}
+  begin
+    {$IFDEF GTK1}
+    CreateRCStyle;
+    FontDesc:=FontCache.FindADescriptor(FontGdiObject^.GDIFontObject);
+    if (FontDesc<>nil) and (FontDesc.xlfd<>'') then begin
+      RCStyle:=gtk_rc_style_new;
+      g_free(RCStyle^.font_name);
+      RCStyle^.font_name:=g_strdup(PChar(FontDesc.xlfd));
+      g_free(RCStyle^.fontset_name);
+      RCStyle^.fontset_name:=g_strdup(PChar(FontDesc.xlfd));
+
+      //DebugLn('UpdateWidgetStyleOfControl.SetRCFont ',DbgSName(AWinControl),' Widget=',GetWidgetDebugReport(Widget),' Style=',GetWidgetStyleReport(Widget));
+    end;
+    {$ENDIF}
+  end;
+
 begin
   {$IFDEF NoStyle}
   exit;
@@ -7179,6 +7231,8 @@ begin
   if not GTK_WIDGET_REALIZED(Widget) then exit;
 
   RCStyle:=nil;
+  FreeFontName:=false;
+  FreeFontSetName:=false;
   try
     // set default background
     if (AWinControl.Color=clNone) then begin
@@ -7230,23 +7284,55 @@ begin
     
     // set font color
     if (AWinControl.Font.Color and SYS_COLOR_BASE)=0 then begin
-      NewColor:=TColorToTGDKColor(AWinControl.Font.Color);
+      //NewColor:=TColorToTGDKColor(AWinControl.Font.Color);
+      NewColor:=AllocGDKColor(AWinControl.Font.Color);
+      //debugln('UpdateWidgetStyleOfControl New Font Color=',dbgs(NewColor.Pixel),' ',dbgs(NewColor.Red),' ',dbgs(NewColor.Green),' ',dbgs(NewColor.Blue));
       CreateRCStyle;
 
       RCStyle^.text[GTK_STATE_NORMAL]:=NewColor;
+      for i:=0 to 4 do begin
+        RCStyle^.text[i]:=NewColor;
+        RCStyle^.fg[i]:=NewColor;
+        RCStyle^.bg[i]:=NewColor;
+        RCStyle^.base[i]:=NewColor;
+        RCStyle^.color_flags[i]:=
+          RCStyle^.color_flags[i] or 15;
+      end;
 
       // Indicate which colors the GtkRcStyle will affect;
       // unflagged colors will follow the theme
       RCStyle^.color_flags[GTK_STATE_NORMAL]:=
         RCStyle^.color_flags[GTK_STATE_NORMAL] or GTK_RC_TEXT;
 
-      //DebugLn('UpdateWidgetStyleOfControl Font=',AWinControl.Font.Name,' ',AWinControl.Font.Size,' ',HexStr(Cardinal(AWinControl.Font.Color),8));
+      DebugLn('UpdateWidgetStyleOfControl Font Color ',DbgSName(AWinControl),' Color=',HexStr(Cardinal(AWinControl.Font.Color),8));
+    end;
+
+    // set font (currently only TCustomLabel)
+    if (AWinControl is TCustomLabel)
+    and ((AWinControl.Font.Name<>DefFontData.Name)
+      or (AWinControl.Font.Size<>0)
+      or (AWinControl.Font.Style<>[]))
+    then begin
+       // allocate font
+       FontHandle:=AWinControl.Font.Handle;
+       if FontHandle<>0 then
+         SetRCFont(PGdiObject(FontHandle));
     end;
     
   finally
     if RCStyle<>nil then begin
-      DebugLn('UpdateWidgetStyleOfControl Apply Modifications ',AWinControl.Name,' ',GetWidgetClassName(Widget));
+      //DebugLn('UpdateWidgetStyleOfControl Apply Modifications ',AWinControl.Name,' ',GetWidgetClassName(Widget));
       gtk_widget_modify_style(Widget,RCStyle);
+
+      if FreeFontName then begin
+        g_free(RCStyle^.font_name);
+        RCStyle^.font_name:=nil;
+      end;
+      if FreeFontSetName then begin
+        g_free(RCStyle^.fontset_name);
+        RCStyle^.fontset_name:=nil;
+      end;
+      //DebugLn('UpdateWidgetStyleOfControl END ',DbgSName(AWinControl),' Widget=',GetWidgetDebugReport(Widget),' Style=',GetWidgetStyleReport(Widget));
       gtk_rc_style_unref(RCStyle);
     end;
   end;
@@ -7792,6 +7878,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.319  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.318  2004/11/10 15:25:32  mattias
   updated memcheck.pas from heaptrc.pp
 

lcl/interfaces/gtk/gtkproc.pp

@@ -43,7 +43,7 @@ uses
   glib2, gdk2pixbuf, gdk2, gtk2, Pango,
   X, XLib, XUtil, //Keyboard handling
   {$ELSE}
-  glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf}
+  glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
   {$ENDIF}
   LMessages, LCLProc, LCLStrConsts, LCLIntf, LCLType, DynHashArray,
   GraphType, GraphMath, Graphics, GTKWinApiWindow, LResources, Controls, Forms,
@@ -284,6 +284,7 @@ function GetStyleDebugReport(AStyle: PGTKStyle): string;
 function GetRCStyleDebugReport(AStyle: PGtkRcStyle): string;
 function WidgetFlagsToString(Widget: PGtkWidget): string;
 function GdkColorToStr(Color: PGDKColor): string;
+function GetWidgetStyleReport(Widget: PGtkWidget): string;
 
 // gtk resources
 procedure Set_RC_Name(Sender: TObject; AWidget: PGtkWidget);

lcl/interfaces/gtk/gtkwinapi.inc

@@ -1316,6 +1316,7 @@ var
   function LoadFont: boolean;
   var
     S: string;
+    Desc: TGdkFontCacheDescriptor;
   begin
     S:=FontNameRegistry+'-'+Foundry+'-'+FamilyName+'-'+WeightName
        +'-'+Slant+'-'+SetwidthName+'-'+AddStyleName+'-'+PixelSize
@@ -1340,7 +1341,9 @@ var
     Result:=GdiObject^.GDIFontObject<>nil;
     
     if Result then begin
-      FontCache.Add(GdiObject^.GDIFontObject,LogFont,LongFontName);
+      Desc:=FontCache.Add(GdiObject^.GDIFontObject,LogFont,LongFontName);
+      if Desc<>nil then
+        Desc.xlfd:=s;
     end;
     
     {$IFDEF VerboseFonts}
@@ -8726,6 +8729,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.372  2004/11/10 18:23:56  mattias
+  impementing changing a TLabel.Font properties Size, Height, Name, Style - set only at Handle creation time
+
   Revision 1.371  2004/11/08 19:11:55  mattias
   disabled hardly used gtk FillScreenFont, this should be only done on demand, improved getting default font family for gtk