paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 18:20:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@6226 -
This commit is contained in:
mattias 2004-11-10 18:23:56 +00:00
parent d160b3b743
commit d4214e5175
9 changed files with 154 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/graphics.pp
View File

@ -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

5
lcl/include/customform.inc
View File

@ -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

17
lcl/include/font.inc
View File

@ -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

11
lcl/include/wincontrol.inc
View File

@ -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;
{------------------------------------------------------------------------------
@ -3532,7 +3535,7 @@ begin
if not (csDesigning in ComponentState) then
EnableWindow(Handle, Enabled);
// Delay the setting of text until it is completely loaded
if not (csLoading in ComponentState)
then TWSWinControlClass(WidgetSetClass).SetText(Self, FCaption);
@ -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

32
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -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

13
lcl/interfaces/gtk/gtkfontcache.pas
View File

@ -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

99
lcl/interfaces/gtk/gtkproc.inc
View File

@ -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,13 +7182,37 @@ var
Widget, FixWidget : PGTKWidget;
NewColor: TGdkColor;
MainWidget: PGtkWidget;
//i: Integer;
FontHandle: HFONT;
i: Integer;
FreeFontName: boolean;
FreeFontSetName: boolean;
procedure CreateRCStyle;
begin
if RCStyle=nil then
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}
@ -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

3
lcl/interfaces/gtk/gtkproc.pp
View File

@ -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);

8
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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