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

LCL: added BeginAlign/EndAlign in TWinControl.Loaded to reduce overhead, gtk2 intf: added GetDefaultClientRect for TGroupBox, doing some resizes now immediately

Browse Source 
git-svn-id: trunk@11160 -
This commit is contained in:
mattias 2007-05-17 21:43:48 +00:00
parent 58a04388c9
commit f1ddc29682
16 changed files with 838 additions and 605 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/controls.pp
View File

@ -1465,7 +1465,8 @@ type
wcfEraseBackground,
wcfCreatingHandle, // Set while constructing the handle of this control
wcfInitializing, // Set while initializing during handle creation
wcfCreatingChildHandles // Set while constructing the handles of the childs
wcfCreatingChildHandles, // Set while constructing the handles of the childs
wcfHandleVisible
);
TWinControlFlags = set of TWinControlFlag;
@ -1563,6 +1564,7 @@ type
procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
procedure DoSendShowHideToInterface; virtual;
procedure ControlsAligned; virtual;
procedure DoSendBoundsToInterface; virtual;
procedure RealizeBounds; virtual;

4
lcl/graphics.pp
View File

@ -398,8 +398,8 @@ type
{$ENDIF}
{ TGraphicsObject
In Delphi VCL this is the ancestor of TFon, TPen and TBrush.
With FPC 2.0 the LCL uses TFPCanvasHelper. }
In Delphi VCL this is the ancestor of TFont, TPen and TBrush.
Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor. }
TGraphicsObject = class(TPersistent)
private

23
lcl/include/control.inc
View File

@ -336,6 +336,7 @@ begin
DebugLn('TControl.ChangeBounds A ',Name,':',ClassName,
' Old='+dbgs(Left)+','+dbgs(Top)+','+dbgs(Width),',',dbgs(Height),
' New='+dbgs(ALeft)+','+dbgs(ATop)+','+dbgs(AWidth),',',dbgs(AHeight));
//if (Parent=nil) and (Left>0) and (ALeft=0) then DumpStack; // This can happen if the interface has not yet moved the window and for some reason something applies the interface coords back to the LCL
{$ENDIF}
// constraint the size
DoConstrainedResize(ALeft, ATop, AWidth, AHeight);
@ -1212,17 +1213,17 @@ begin
Result:=ClientRect.Right;
end;
{------------------------------------------------------------------------------}
{ TControl GetEnabled }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TControl GetEnabled
------------------------------------------------------------------------------}
function TControl.GetEnabled: Boolean;
begin
Result := FEnabled;
end;
{------------------------------------------------------------------------------}
{ TControl GetMouseCapture }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TControl GetMouseCapture
------------------------------------------------------------------------------}
Function TControl.GetMouseCapture : Boolean;
Begin
Result := GetCaptureControl = Self;
@ -1236,9 +1237,9 @@ begin
Result := UndockHeight;
end;
{------------------------------------------------------------------------------}
{ TControl GetPopupMenu }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TControl GetPopupMenu
------------------------------------------------------------------------------}
function TControl.GetPopupMenu: TPopupMenu;
begin
Result := FPopupMenu;
@ -2195,8 +2196,10 @@ end;
procedure TControl.SetClientHeight(Value: Integer);
begin
if csLoading in ComponentState then begin
{$IFDEF DisableLoadedClientSize}
FLoadedClientSize.Y:=Value;
Include(FControlFlags,cfClientHeightLoaded);
{$ENDIF}
end else begin
// during loading the ClientHeight is not used to set the Height of the
// control, but only to restore autosizing. For example Anchors=[akBottom]
@ -2223,8 +2226,10 @@ end;
procedure TControl.SetClientWidth(Value: Integer);
begin
if csLoading in ComponentState then begin
{$IFDEF DisableLoadedClientSize}
FLoadedClientSize.X:=Value;
Include(FControlFlags,cfClientWidthLoaded);
{$ENDIF}
end else begin
// during loading the ClientWidth is not used to set the Width of the
// control, but only to restore autosizing. For example Anchors=[akRight]

7
lcl/include/customform.inc
View File

@ -1752,7 +1752,12 @@ procedure TCustomForm.Loaded;
var
Control: TWinControl;
begin
inherited Loaded;
DisableAlign;
try
inherited Loaded;
finally
EnableAlign;
end;
if (ActiveControl <> nil) and (Parent=nil) then
begin
Control := ActiveControl;

210
lcl/include/wincontrol.inc
View File

@ -27,8 +27,8 @@
{ $DEFINE CHECK_POSITION}
{ $IFDEF CHECK_POSITION}
const CheckPostionClassName = 'THintWindow';
const CheckPostionName = 'ListBox1';
const CheckPostionClassName = 'xxTHintWindow';
const CheckPostionName = 'xxListBox1';
function CheckPosition(AControl: TControl): boolean;
begin
@ -1065,6 +1065,8 @@ var
var
NewLeft, NewTop, NewWidth, NewHeight: Integer;
ParentBaseClientSize: TPoint;
ParentClientWidth: integer;
ParentClientHeight: integer;
CurBaseBounds: TRect;
NewRight: Integer;// temp variable, not always valid, use with care !
NewBottom: Integer;// temp variable, not always valid, use with care !
@ -1194,8 +1196,9 @@ var
ConstraintWidth(NewLeft,NewWidth);
ConstraintHeight(NewTop,NewHeight);
end;
ParentClientWidth:=Control.Parent.ClientWidth;
ParentClientHeight:=Control.Parent.ClientHeight;
InitAnchorSideCache;
{ Recalculate the anchors
@ -1205,7 +1208,7 @@ var
This is controlled with the AnchorSide properties.
1. If AnchorSide[].Control is not set, the distance is kept relative to
the edges of the client are of its parent.
the edges of the client area of its parent.
When its parent is resized, the control holds its position relative to the
edges to which it is anchored.
If a control is anchored to opposite edges of its parent, the control
@ -1230,8 +1233,7 @@ var
ParentBaseClientSize:=Control.FBaseParentClientSize;
if (ParentBaseClientSize.X=0)
and (ParentBaseClientSize.Y=0) then
ParentBaseClientSize:=Point(Control.Parent.ClientWidth,
Control.Parent.ClientHeight);
ParentBaseClientSize:=Point(ParentClientWidth,ParentClientHeight);
// get base bounds of Control
CurBaseBounds:=Control.FBaseBounds;
@ -1246,7 +1248,7 @@ var
' Self='+DbgSName(Self),' Control='+DbgSName(Control),
' CurBaseBounds='+dbgs(CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Top)+','+dbgs(CurBaseBounds.Right-CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Bottom-CurBaseBounds.Top),
' ParentBaseClientSize='+dbgs(ParentBaseClientSize.X)+','+dbgs(ParentBaseClientSize.Y),
' ControlParent.Client='+dbgs(Control.Parent.ClientWidth)+','+dbgs(Control.Parent.ClientHeight),
' ControlParent.Client='+dbgs(ParentClientWidth)+','+dbgs(ParentClientHeight),
' NewBounds='+dbgs(NewLeft)+','+dbgs(NewTop)+','+dbgs(NewWidth)+','+dbgs(NewHeight),
'');
{$ENDIF}
@ -1257,7 +1259,7 @@ var
if akRight in CurAnchors then begin
// keep distance to right side of parent or another sibling
// -> change the width
NewRight:=Control.Parent.ClientWidth
NewRight:=ParentClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
if (not (akRight in CurAlignAnchors))
and (akRight in Control.Anchors) then
@ -1272,7 +1274,7 @@ var
if akRight in CurAnchors then begin
// keep distance to right side of parent
// and keep new width
NewRight:=Control.Parent.ClientWidth
NewRight:=ParentClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
if (not (akRight in CurAlignAnchors))
and (akRight in Control.Anchors) then
@ -1281,7 +1283,7 @@ var
end else begin
// do not anchor to the right
// -> keep new width and center horizontally
NewLeft:=(Control.Parent.ClientWidth-NewWidth) div 2;
NewLeft:=(ParentClientWidth-NewWidth) div 2;
end;
end;
@ -2146,21 +2148,11 @@ end;
-------------------------------------------------------------------------------}
procedure TWinControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer);
begin
if wcfClientRectNeedsUpdate in FWinControlFlags then begin
GetClientRect;
end;
{$IFDEF VerboseClientRectBugFix}
DbgOut('[TWinControl.DoSetBounds] ',Name,':',ClassName,' OldClient=',DbgS(FClientWidth),',',DbgS(FClientHeight),
DbgOut('[TWinControl.DoSetBounds] ',Name,':',ClassName,
' OldHeight=',DbgS(FHeight),' NewHeight=',DbgS(AHeight));
{$ENDIF}
inc(FClientWidth,AWidth-FWidth);
if (FClientWidth<0) then FClientWidth:=0;
inc(FClientHeight,AHeight-FHeight);
if (FClientHeight<0) then FClientHeight:=0;
{$IFDEF VerboseClientRectBugFix}
DebugLn(' NewClient=',DbgS(FClientWidth),',',DbgS(FClientHeight));
{$ENDIF}
InvalidateClientRectCache(false);
inherited DoSetBounds(ALeft,ATop,AWidth,AHeight);
end;
@ -2307,20 +2299,35 @@ function TWinControl.GetClientRect: TRect;
var
InterfaceWidth, InterfaceHeight: integer;
begin
if not HandleAllocated then begin
Result:=inherited GetClientRect;
StoreClientRect(Result);
end else if wcfClientRectNeedsUpdate in FWinControlFlags then begin
// update clientrect from interface
LCLIntf.GetClientRect(Handle, Result);
// the LCL is not always in sync with the interface
// -> adjust client rect based on LCL bounds
// for example: if the Width in LCL differ from the Width of the Interface
// object, then adjust the clientwidth accordingly
LCLIntf.GetWindowSize(Handle, InterfaceWidth, InterfaceHeight);
//debugln('TWinControl.GetClientRect ',DbgSName(Self),' Interface=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect));
Result.Right:=Width-(InterfaceWidth-Result.Right);
Result.Bottom:=Height-(InterfaceHeight-Result.Bottom);
if wcfClientRectNeedsUpdate in FWinControlFlags then begin
if TWSWinControlClass(WidgetSetClass).GetDefaultClientRect(Self,
Left, Top, Width, Height, Result)
then begin
// the LCL interface provided a ClientRect
end
else if HandleAllocated then begin
// update clientrect from interface
LCLIntf.GetClientRect(Handle, Result);
// the LCL is not always in sync with the interface
// -> adjust client rect based on LCL bounds
// for example: if the Width in LCL differ from the Width of the Interface
// object, then adjust the clientwidth accordingly
// this often anticipates later LM_SIZE messages from the interface
// and reduces resizes
LCLIntf.GetWindowSize(Handle, InterfaceWidth, InterfaceHeight);
//debugln('TWinControl.GetClientRect ',DbgSName(Self),' Interface=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect));
Result.Right:=Width-(InterfaceWidth-Result.Right);
Result.Bottom:=Height-(InterfaceHeight-Result.Bottom);
end else begin
// no handle and no interface help => use defaults
Result:=inherited GetClientRect;
if csLoading in ComponentState then begin
if cfClientWidthLoaded in FControlFlags then
Result.Right:=FLoadedClientSize.X;
if cfClientHeightLoaded in FControlFlags then
Result.Bottom:=FLoadedClientSize.Y;
end;
end;
StoreClientRect(Result);
{r:=inherited GetClientRect;
@ -4509,7 +4516,7 @@ end;
------------------------------------------------------------------------------}
constructor TWinControl.Create(TheOwner : TComponent);
begin
// do not set borderstyle, as tcustomform needs to set it before calling
// do not set borderstyle, because TCustomForm needs to set it before calling
// inherited, to have it set before handle is created via streaming
// use property that bsNone is zero
//FBorderStyle := bsNone;
@ -4521,11 +4528,12 @@ begin
FParentCtl3D:=true;
FTabOrder := -1;
FTabStop := False;
InvalidateClientRectCache(false);
end;
{------------------------------------------------------------------------------}
{ TWinControl CreateParented }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TWinControl CreateParented
------------------------------------------------------------------------------}
constructor TWinControl.CreateParented(ParentWindow: hwnd);
begin
FParentWindow := ParentWindow;
@ -4845,8 +4853,8 @@ var
begin
{$IFDEF VerboseSizeMsg}
if CheckPosition(Self) then
DebugLn('TWinControl.WMSize A ',Name,':',ClassName,' Message=',dbgs(Message.Width),',',dbgs(Message.Height),
' BoundsRealized=',dbgs(FBoundsRealized),' FromIntf=',(Message.SizeType and Size_SourceIsInterface)>0));
DebugLn(['TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height,
' BoundsRealized=',dbgs(FBoundsRealized),' FromIntf=',(Message.SizeType and Size_SourceIsInterface)>0]);
{$ENDIF}
NewLeft:=Left;
NewTop:=Top;
@ -4859,7 +4867,7 @@ begin
GetWindowRelativePosition(Handle,NewLeft,NewTop);
//DebugLn('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop);
NewBoundsRealized:=Bounds(NewLeft,NewTop,Message.Width,Message.Height);
If CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit;
if CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit;
FBoundsRealized:=NewBoundsRealized;
InvalidatePreferredSize;
end;
@ -5390,54 +5398,57 @@ var
AChild: TControl;
LoadedClientSize: TPoint;
begin
//DebugLn(['TWinControl.Loaded ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']);
if cfClientWidthLoaded in FControlFlags then
LoadedClientSize.X:=FLoadedClientSize.X
else begin
LoadedClientSize.X:=ClientWidth;
if LoadedClientSize.X<=0 then
LoadedClientSize.X:=Width;
end;
if cfClientHeightLoaded in FControlFlags then
LoadedClientSize.Y:=FLoadedClientSize.Y
else begin
LoadedClientSize.Y:=ClientHeight;
if LoadedClientSize.Y<=0 then
LoadedClientSize.Y:=Height;
end;
for i:=0 to ControlCount-1 do begin
AChild:=Controls[i];
if AChild=nil then ;
AChild.FBaseParentClientSize:=LoadedClientSize;
//DebugLn(['TWinControl.Loaded Self=',DbgSName(Self),' AChild=',AChild,' AChild.FBaseParentClientSize=',dbgs(AChild.FBaseParentClientSize)]);
end;
if HandleAllocated then begin
// Set cached caption
if GetCachedText(CachedText) then
TWSWinControlClass(WidgetSetClass).SetText(Self, CachedText);
InvalidatePreferredSize;
if wcfColorChanged in FWinControlFlags then begin
TWSWinControlClass(WidgetSetClass).SetColor(Self);
Exclude(FWinControlFlags,wcfColorChanged);
DisableAlign;
try
//DebugLn(['TWinControl.Loaded ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']);
if cfClientWidthLoaded in FControlFlags then
LoadedClientSize.X:=FLoadedClientSize.X
else begin
LoadedClientSize.X:=ClientWidth;
if LoadedClientSize.X<=0 then
LoadedClientSize.X:=Width;
end;
if wcfFontChanged in FWinControlFlags then begin
TWSWinControlClass(WidgetSetClass).SetFont(Self,Font);
NotifyControls(CM_PARENTCOLORCHANGED);
for i := 0 to ControlCount - 1 do
Controls[i].ParentFontChanged;
FWinControlFlags:=FWinControlFlags-[wcfFontChanged];
if cfClientHeightLoaded in FControlFlags then
LoadedClientSize.Y:=FLoadedClientSize.Y
else begin
LoadedClientSize.Y:=ClientHeight;
if LoadedClientSize.Y<=0 then
LoadedClientSize.Y:=Height;
end;
for i:=0 to ControlCount-1 do begin
AChild:=Controls[i];
if AChild=nil then ;
AChild.FBaseParentClientSize:=LoadedClientSize;
//DebugLn(['TWinControl.Loaded Self=',DbgSName(Self),' AChild=',AChild,' AChild.FBaseParentClientSize=',dbgs(AChild.FBaseParentClientSize)]);
end;
if HandleAllocated then begin
// Set cached caption
if GetCachedText(CachedText) then
TWSWinControlClass(WidgetSetClass).SetText(Self, CachedText);
InvalidatePreferredSize;
if wcfColorChanged in FWinControlFlags then begin
TWSWinControlClass(WidgetSetClass).SetColor(Self);
Exclude(FWinControlFlags,wcfColorChanged);
end;
if wcfFontChanged in FWinControlFlags then begin
TWSWinControlClass(WidgetSetClass).SetFont(Self,Font);
NotifyControls(CM_PARENTCOLORCHANGED);
for i := 0 to ControlCount - 1 do
Controls[i].ParentFontChanged;
FWinControlFlags:=FWinControlFlags-[wcfFontChanged];
end;
end;
inherited Loaded;
FixupTabList;
RealizeBounds;
if HandleAllocated and ([csDestroying]*ComponentState=[]) then
DoSendShowHideToInterface;
finally
EnableAlign;
end;
inherited Loaded;
FixupTabList;
RealizeBounds;
// align the childs
if wcfReAlignNeeded in FWinControlFlags then
ReAlign;
end;
procedure TWinControl.FormEndUpdated;
@ -5774,7 +5785,7 @@ end;
are relevant.
WithThemeSpace: If true, adds space for stacking. For example: TRadioButton
has a minimum size. But for staking multiple TRadioButtons there should be
has a minimum size. But for stacking multiple TRadioButtons there should be
some space around. This space is theme dependent, so it passed parameter to
the widgetset.
------------------------------------------------------------------------------}
@ -5799,7 +5810,7 @@ begin
if PreferredHeight>0 then
inc(PreferredHeight,BorderSpacing.InnerBorder*2);
end;
if ControlCount>0 then begin
// get the size requirements for the child controls
@ -5997,6 +6008,20 @@ begin
ResizeDelayedAutoSizeChildren;
end;
procedure TWinControl.DoSendShowHideToInterface;
var
NewVisible: Boolean;
begin
NewVisible:=HandleObjectShouldBeVisible;
if NewVisible<>(wcfHandleVisible in FWinControlFlags) then begin
if NewVisible then
Include(FWinControlFlags,wcfHandleVisible)
else
Exclude(FWinControlFlags,wcfHandleVisible);
TWSWinControlClass(WidgetSetClass).ShowHide(Self);
end;
end;
procedure TWinControl.ControlsAligned;
begin
@ -6052,9 +6077,8 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.CMShowingChanged(var Message: TLMessage);
begin
// ToDo: do not send this while loading, send it after loading.
if HandleAllocated and ([csDestroying]*ComponentState=[])then
TWSWinControlClass(WidgetSetClass).ShowHide(Self);
if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then
DoSendShowHideToInterface;
end;
{------------------------------------------------------------------------------

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

@ -1115,11 +1115,12 @@ begin
// if iconified in changed then OnIconify...
if TObject(Data) is TCustomForm then begin
TheForm := TCustomForm(Data);
//DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
if TheForm.Parent = nil then begin (* toplevel window, just as a sanity check *)
if GTK_WIDGET_REALIZED(Widget) then begin
if GTK_WIDGET_REALIZED(Widget) then begin
if TObject(Data) is TCustomForm then begin
TheForm := TCustomForm(Data);
//DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
if TheForm.Parent = nil then begin
// toplevel window
// send a WMSize Message (see TCustomForm.WMSize)
GtkWidth:=Widget^.Allocation.Width;
if GtkWidth<0 then GtkWidth:=0;
@ -1130,12 +1131,13 @@ begin
{$IFDEF HasX}
NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True);
if NetAtom > 0 then begin
if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex)
if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL,
0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex)
then begin
NetAtom := gdk_atom_intern('_NET_CURRENT_DESKTOP', True);
if gdk_property_get(gdk_get_default_root_window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @ADesktop)
then if ADesktop^ <> AIndex^ then begin
// form is not on active desktop => ignore
g_free(ADesktop);
g_free(AIndex);
exit;
@ -1164,6 +1166,13 @@ begin
Width := SmallInt(GtkWidth);
Height := SmallInt(GtkHeight);
end;
{$IFDEF VerboseSizeMsg}
DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),
' GTK=',GtkWidth,'x',GtkHeight,
' LCL=',TheForm.Width,'x',TheForm.Height,
' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface'
]);
{$ENDIF}
DeliverMessage(TheForm, SizeMsg);
end;
end;
@ -2353,8 +2362,9 @@ begin
TControl(Data).Name+':'+TControl(Data).ClassName,
' widget='+DbgS(Widget)+WidgetFlagsToString(widget)+
' fixwidget=',DbgS(GetFixedWidget(Widget)),
' NewSize=',dbgs(Size^.Width),',',dbgs(Size^.Height),
' GtkPos=',dbgs(Widget^.allocation.x)+','+dbgs(Widget^.allocation.y),
','+dbgs(Widget^.allocation.width)+'x'+dbgs(Widget^.allocation.width)+
','+dbgs(Widget^.allocation.width)+'x'+dbgs(Widget^.allocation.height)+
' LCLPos='+dbgs(TControl(Data).Left)+','+dbgs(TControl(Data).Top),
','+dbgs(TControl(Data).Width)+'x'+dbgs(TControl(Data).Height));
{$ENDIF}
@ -2362,8 +2372,16 @@ begin
if TControl(Data) is TCustomForm then
DebugLn('VFP gtksize_allocateCB: ',TControl(Data).ClassName,' ',dbgs(Size^.X),',',dbgs(Size^.Y));
{$ENDIF}
if GTK_WIDGET_REALIZED(Widget) then
if GTK_WIDGET_REALIZED(Widget) then begin
{$IFDEF Gtk1}
SaveSizeNotification(Widget);
{$ELSE}
if GetFixedWidget(Widget)=Widget then
SendSizeNotificationToLCL(Widget)
else
SaveSizeNotification(Widget);
{$ENDIF}
end;
end;
function gtksize_allocate_client(widget: PGtkWidget; size: pGtkAllocation;
@ -2390,8 +2408,13 @@ begin
end;
MainWidget:=PGtkWidget(TWinControl(Data).Handle);
ClientWidget:=GetFixedWidget(MainWidget);
if GTK_WIDGET_REALIZED(ClientWidget) then
if GTK_WIDGET_REALIZED(ClientWidget) then begin
{$IFDEF Gtk1}
SaveClientSizeNotification(ClientWidget);
{$ELSE}
SendSizeNotificationToLCL(MainWidget);
{$ENDIF}
end;
end else begin
// owner is not TWinControl -> ignore
DebugLn('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=',

6
lcl/interfaces/gtk/gtkdef.pp
View File

@ -445,6 +445,7 @@ var
procedure GtkDefDone;
function dbgs(g: TGDIType): string; overload;
function dbgs(r: TGDKRectangle): string; overload;
implementation
@ -830,6 +831,11 @@ begin
end;
end;
function dbgs(r: TGDKRectangle): string;
begin
Result:=dbgs(Rect(r.x,r.y,r.width,r.height));
end;
initialization
GtkDefInit;

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

@ -113,6 +113,7 @@ type
lgsStatusBar,
lgsHScale,
lgsVScale,
lgsGroupBox,
// user defined
lgsUserDefined
);
@ -138,6 +139,7 @@ const
'notebook',
'hscale',
'vscale',
'groupbox',
''
);
@ -372,6 +374,7 @@ var
// each fixed widget that was resized by the gtk is stored here
// (hasharray of PGtkWidget)
FFixWidgetsResized: TDynHashArray;
FWidgetsWithResizeRequest: TDynHashArray; // hasharray of PGtkWidget
const
aGtkJustification: array[TAlignment] of TGTKJustification =

5
lcl/interfaces/gtk/gtkint.pp
View File

@ -92,7 +92,6 @@ type
FRCFilename: string;
FRCFileParsed: boolean;
FRCFileAge: integer;
FWidgetsWithResizeRequest: TDynHashArray; // hasharray of PGtkWidget
FGTKToolTips: PGtkToolTips;
FLogHandlerID: guint; // ID returend by set_handler
@ -230,8 +229,6 @@ type
// forms and dialogs
procedure BringFormToFront(Sender: TObject);
procedure SetWindowSizeAndPosition(Window: PGtkWindow;
AWinControl: TWinControl);virtual;
procedure UntransientWindow(GtkWindow: PGtkWindow);
procedure InitializeFileDialog(FileDialog: TFileDialog;
var SelWidget: PGtkWidget; Title: PChar); virtual;
@ -273,8 +270,6 @@ type
procedure SendPaintMessagesForInternalWidgets(AWinControl: TWinControl);
function LCLtoGtkMessagePending: boolean;virtual;
procedure SendCachedGtkMessages;virtual;
procedure RealizeWidgetSize(Widget: PGtkWidget;
NewWidth, NewHeight: integer); virtual;
procedure FinishComponentCreate(const ALCLObject: TObject;
const AGTKObject: Pointer); virtual;

496
lcl/interfaces/gtk/gtkobject.inc
View File

@ -614,60 +614,6 @@ end;
{$endif}
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.SetWindowSizeAndPosition
Params: Widget: PGtkWidget; AWinControl: TWinControl
Returns: Nothing
Set the size and position of a top level window.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SetWindowSizeAndPosition(Window: PGtkWindow;
AWinControl: TWinControl);
var
Width, Height: integer;
//Info: PGtkWindowGeometryInfo;
begin
Width:=AWinControl.Width;
// 0 and negative values have a special meaning, so don't use them
if Width<=0 then Width:=1;
Height:=AWinControl.Height;
if Height<=0 then Height:=1;
//DebugLn('TGtkWidgetSet.SetWindowSizeAndPosition ',AWinControl.Name,':',AWinControl.ClassName,' ',AWinControl.Visible,' Old=',PGtkWidget(Window)^.allocation.Width,',',PGtkWidget(Window)^.allocation.Width,' New=',Width,',',Height);
// set geometry default size
//Info:=gtk_window_get_geometry_info(Window, TRUE);
//if (Info^.default_width<>Width) or (Info^.default_height<>Height) then
gtk_window_set_default_size(Window,Width,Height);
{$IFDEF Gtk2}
// resize
gtk_window_set_default_size(Window,Width,Height);
gtk_window_resize(Window,Width,Height);
// reposition
gtk_window_move(Window,AWinControl.Left,AWinControl.Top);
{$ELSE}
// resize
if assigned(PGtkWidget(Window)^.Window) then
// widget is realized, resize gdkwindow directly
gdk_window_move_resize(PGtkWidget(Window)^.Window,AWinControl.Left,
AWinControl.Top,Width,Height)
else begin
// widget is not yet realized, force resize needed for shrinking under gtk1
gtk_widget_set_usize(PGtkWidget(Window), -1,-1);
end;
// reposition
gtk_widget_set_usize(PGtkWidget(Window),Width,Height);
gtk_widget_set_uposition(PGtkWidget(Window),AWinControl.Left,AWinControl.Top);
{$ENDIF}
{$IFDEF VerboseSizeMsg}
DebugLn(['TGtkWidgetSet.SetWindowSizeAndPosition B ',DbgSName(AWinControl),
' Visible=',AWinControl.Visible,
' Old=',PGtkWidget(Window)^.allocation.X,',',PGtkWidget(Window)^.allocation.Y,
' New=',AWinControl.Left,',',AWinControl.Top,',',Width,'x',Height]);
{$ENDIF}
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.UpdateTransientWindows;
------------------------------------------------------------------------------}
@ -935,20 +881,11 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
procedure SendCachedLCLResizeRequests;
var
Widget, ParentFixed, ParentWidget: PGtkWidget;
LCLControl: TControl;
Widget: PGtkWidget;
LCLControl: TWinControl;
IsTopLevelWidget: boolean;
TopologicalList: TFPList; // list of PGtkWidget;
i, LCLWidth, LCLHeight: integer;
WinWidgetInfo: PWinWidgetInfo;
procedure WriteBigWarning;
begin
DebugLn('WARNING: resizing BIG ',
' Control=',LCLControl.Name,':',LCLControl.ClassName,
' NewSize=',dbgs(LCLWidth),',',dbgs(LCLHeight));
//RaiseException('');
end;
i: integer;
procedure RaiseWidgetWithoutControl;
begin
@ -956,16 +893,6 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
+DbgS(Widget)+' without LCL control');
end;
procedure WriteWarningParentWidgetNotFound;
begin
DebugLn('WARNING: TGtkWidgetSet.SendCachedLCLMessages - '
,'Parent''s Fixed Widget not found');
DebugLn(' Control=',LCLControl.Name,':',LCLControl.ClassName,
' Parent=',LCLControl.Parent.Name,':',LCLControl.Parent.ClassName,
' ParentWidget=',DbgS(ParentWidget),
'');
end;
begin
if FWidgetsWithResizeRequest.Count=0 then exit;
{$IFDEF VerboseSizeMsg}
@ -977,12 +904,12 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
Widget:=TopologicalList[i];
// resize widget
LCLControl:=TControl(GetLCLObject(Widget));
LCLControl:=TWinControl(GetLCLObject(Widget));
if (LCLControl=nil) or (not (LCLControl is TControl)) then begin
RaiseWidgetWithoutControl;
end;
{$IFDEF VerboseSizeMsg}
if AnsiCompareText(LCLControl.ClassName,'TScrollBar')=0 then
if CompareText(LCLControl.ClassName,'TScrollBar')=0 then
DebugLn('SendCachedLCLMessages ',LCLControl.Name,':',LCLControl.ClassName,
' ',dbgs(LCLControl.Left)+','+dbgs(LCLControl.Top)+','+dbgs(LCLControl.Width)+'x'+dbgs(LCLControl.Height));
{$ENDIF}
@ -991,38 +918,7 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
and (LCLControl.Parent = nil);
if not IsTopLevelWidget then begin
// resize widget
LCLWidth:=LCLControl.Width;
if LCLWidth<=0 then
LCLWidth:=1;
LCLHeight:=LCLControl.Height;
if LCLHeight<=0 then
LCLHeight:=1;
if (LCLWidth>10000) or (LCLHeight>10000) then begin
WriteBigWarning;
if LCLWidth>10000 then
LCLWidth:=10000
else
LCLHeight:=10000;
end;
RealizeWidgetSize(Widget,LCLWidth, LCLHeight);
// move widget on the fixed widget of parent control
if (LCLControl.Parent<>nil) and (LCLControl.Parent.HandleAllocated) then
begin
ParentWidget:=pgtkWidget(LCLControl.Parent.Handle);
ParentFixed := GetFixedWidget(ParentWidget);
if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE)
or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin
FixedMoveControl(ParentFixed, Widget,
LCLControl.Left,LCLControl.Top);
end else begin
WinWidgetInfo:=GetWidgetInfo(Widget,false);
if (WinWidgetInfo=nil)
or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
WriteWarningParentWidgetNotFound;
end;
end;
SetWidgetSizeAndPosition(LCLControl);
end
else begin
// resize form
@ -1065,257 +961,6 @@ end;
Some Gtk messages are not sent directly to the LCL. Send them now.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SendCachedGtkMessages;
procedure SendSizeNotificationToLCL(MainWidget: PGtkWidget);
var
LCLControl: TWinControl;
LCLLeft, LCLTop, LCLWidth, LCLHeight: integer;
GtkLeft, GtkTop, GtkWidth, GtkHeight: integer;
TopLeftChanged, WidthHeightChanged, IsTopLevelWidget: boolean;
MessageDelivered: boolean;
PosMsg : TLMWindowPosChanged;
SizeMsg: TLMSize;
MoveMsg: TLMMove;
procedure UpdateLCLRect;
begin
LCLLeft:=LCLControl.Left;
LCLTop:=LCLControl.Top;
LCLWidth:=LCLControl.Width;
LCLHeight:=LCLControl.Height;
TopLeftChanged:=(LCLLeft<>GtkLeft) or (LCLTop<>GtkTop);
WidthHeightChanged:=(LCLWidth<>GtkWidth) or (LCLHeight<>GtkHeight);
end;
begin
if not GTK_WIDGET_REALIZED(MainWidget) then begin
{$IFDEF VerboseSizeMsg}
DebugLn('SendSizeNotificationToLCL ',LCLControl.Name,':',LCLControl.ClassName,' MainWidget=',WidgetFlagsToString(MainWidget),' Ignored, because not realized ');
{$ENDIF}
exit;
end;
LCLControl:=TWinControl(GetLCLObject(MainWidget));
if LCLControl=nil then exit;
{$IFDEF VerboseSizeMsg}
DebugLn('JJJ1 SendSizeNotificationToLCL ',LCLControl.Name,':',LCLControl.ClassName,' MainWidget=',WidgetFlagsToString(MainWidget));
{$ENDIF}
GtkLeft:=MainWidget^.Allocation.X;
GtkTop:=MainWidget^.Allocation.Y;
{$Ifdef GTK2}
if GTK_WIDGET_NO_WINDOW(MainWidget) and GTK_WIDGET_NO_WINDOW(MainWidget^.Parent)
// and (not GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType))
then begin
Dec(GtkLeft, MainWidget^.parent^.Allocation.X);
Dec(GtkTop, MainWidget^.parent^.Allocation.Y);
end;
{$EndIf}
GtkWidth:=MainWidget^.Allocation.Width;
if GtkWidth<0 then GtkWidth:=0;
GtkHeight:=MainWidget^.Allocation.Height;
if GtkHeight<0 then GtkHeight:=0;
IsTopLevelWidget:=(LCLControl is TCustomForm) and (LCLControl.Parent=nil);
if IsTopLevelWidget then begin
if not GTK_WIDGET_VISIBLE(MainWidget) then begin
// size/move messages of invisible windows are not reliable
// -> ignore
exit;
end;
if (GtkWidth=1) and (GtkHeight=1) then begin
// this is default size of the gtk. Ignore.
exit;
end;
if GetControlWindow(MainWidget)<>nil then begin
gdk_window_get_root_origin(GetControlWindow(MainWidget), @GtkLeft, @GtkTop);
end else begin
GtkLeft:=LCLControl.Left;
GtkTop:=LCLControl.Top;
end;
{$IFDEF VerboseFormPositioning}
DebugLn(['VFP SendSizeNotificationToLCL ',DbgSName(LCLControl),' ',
GtkLeft,',',GtkTop,',',GtkWidth,',',GtkHeight,' ',GetWidgetDebugReport(MainWidget)]);
{$ENDIF}
end;
UpdateLCLRect;
{$IFDEF VerboseSizeMsg}
DebugLn('SendSizeNotificationToLCL ',DbgSName(LCLControl),
' GTK=',dbgs(GtkLeft)+','+dbgs(GtkTop)+','+dbgs(GtkWidth)+'x'+dbgs(GtkHeight),
' LCL=',dbgs(LCLLeft)+','+dbgs(LCLTop)+','+dbgs(LCLWidth)+'x'+dbgs(LCLHeight)
);
{$ENDIF}
// first send a LM_WINDOWPOSCHANGED message
if TopLeftChanged or WidthHeightChanged then begin
PosMsg.Msg := LM_WINDOWPOSCHANGED; //LM_SIZEALLOCATE;
PosMsg.Result := 0;
New(PosMsg.WindowPos);
try
with PosMsg.WindowPos^ do begin
hWndInsertAfter := 0;
x := GtkLeft;
y := GtkTop;
cx := GtkWidth;
cy := GtkHeight;
flags := 0;
end;
MessageDelivered := DeliverMessage(LCLControl, PosMsg) = 0;
finally
Dispose(PosMsg.WindowPos);
end;
if (not MessageDelivered) then exit;
if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
UpdateLCLRect;
end;
// then send a LM_SIZE message
if WidthHeightChanged then begin
{$IFDEF VerboseSizeMsg}
DebugLn('Send LM_SIZE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
{$ENDIF}
with SizeMsg do
begin
Result := 0;
Msg := LM_SIZE;
{$IFDEF GTK1}
if GDK_WINDOW_GET_MAXIMIZED(PGdkWindowPrivate(MainWidget^.window)) then
SizeType := SIZEFULLSCREEN or Size_SourceIsInterface
else
SizeType := SIZENORMAL or Size_SourceIsInterface;
{$ELSE}
if LCLControl is TCustomForm then begin
// if the LCL gets an event without a State it resets it to SIZENORMAL
// so we send it the state it already is
case TCustomForm(LCLControl).WindowState of
wsNormal: SizeType := SIZENORMAL or Size_SourceIsInterface;
wsMinimized: SizeType := SIZEICONIC or Size_SourceIsInterface;
wsMaximized: SizeType := SIZEFULLSCREEN or Size_SourceIsInterface;
end;
end
else
SizeType := Size_SourceIsInterface;
{$ENDIF}
Width := SmallInt(GtkWidth);
Height := SmallInt(GtkHeight);
end;
MessageDelivered := (DeliverMessage(LCLControl, SizeMsg) = 0);
if not MessageDelivered then exit;
if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
UpdateLCLRect;
end;
// then send a LM_MOVE message
if TopLeftChanged then begin
{$IFDEF VerboseSizeMsg}
DebugLn('Send LM_MOVE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
{$ENDIF}
with MoveMsg do
begin
Result := 0;
Msg := LM_MOVE;
MoveType := Move_SourceIsInterface;
XPos := SmallInt(GtkLeft);
YPos := SmallInt(GtkTop);
end;
MessageDelivered := (DeliverMessage(LCLControl, MoveMsg) = 0);
if not MessageDelivered then exit;
end;
end;
procedure SendCachedGtkResizeNotifications;
{ This proc sends all cached size messages from the gtk to lcl but in an
optimized order.
When sending the LCL a size/move/windowposchanged messages the LCL will
automatically realign all child controls. This realigning is based on the
clientrect.
Therefore, before a size message is sent to the lcl, all clientrect must be
updated.
If a size message results in resizing a widget that was also resized, then
the message for the dependent widget is not sent to the lcl, because the lcl
resize was after the gtk resize.
}
var
FixWidget, MainWidget: PGtkWidget;
LCLControl: TWinControl;
List: TFPList;
i: integer;
procedure RaiseInvalidLCLControl;
begin
RaiseGDBException(Format('SendCachedGtkResizeNotifications FixWidget=%p MainWidget=%p LCLControl=%p',
[FixWidget, MainWidget, Pointer(LCLControl)]));
end;
begin
if (FFixWidgetsResized.Count=0) and (FWidgetsResized.Count=0) then exit;
List:=TFPList.Create;
{ if any fixed widget was resized then a client area of a LCL control was
resized
-> invalidate client rectangles
}
{$IFDEF VerboseSizeMsg}
DebugLn('HHH1 SendCachedGtkClientResizeNotifications Invalidating ClientRects ... '
,' FixSizeMsgCount=',dbgs(FFixWidgetsResized.Count));
{$ENDIF}
FFixWidgetsResized.AssignTo(List);
for i:=0 to List.Count-1 do begin
FixWidget:=List[i];
MainWidget:=GetMainWidget(FixWidget);
LCLControl:=TWinControl(GetLCLObject(MainWidget));
if (LCLControl=nil) or (not (LCLControl is TWinControl)) then
RaiseInvalidLCLControl;
LCLControl.InvalidateClientRectCache(false);
end;
{ if any main widget (= not fixed widget) was resized
then a LCL control was resized
-> send WMSize, WMMove, and WMWindowPosChanged messages
}
{$IFDEF VerboseSizeMsg}
DebugLn('HHH2 SendCachedGtkClientResizeNotifications SizeMsgCount=',dbgs(FWidgetsResized.Count));
{$ENDIF}
repeat
MainWidget:=FWidgetsResized.First;
if MainWidget<>nil then begin
FWidgetsResized.Remove(MainWidget);
if not FWidgetsWithResizeRequest.Contains(MainWidget) then begin
SendSizeNotificationToLCL(MainWidget);
FixWidget:=GetFixedWidget(MainWidget);
end;
end else break;
until Application.Terminated;
{ if any client area was resized, which MainWidget Size was already in sync
with the LCL, no message was sent. So, tell each changed client area to
check its size.
}
{$IFDEF VerboseSizeMsg}
DebugLn('HHH3 SendCachedGtkClientResizeNotifications Updating ClientRects ...');
{$ENDIF}
repeat
FixWidget:=FFixWidgetsResized.First;
if FixWidget<>nil then begin
FFixWidgetsResized.Remove(FixWidget);
MainWidget:=GetMainWidget(FixWidget);
LCLControl:=TWinControl(GetLCLObject(MainWidget));
LCLControl.DoAdjustClientRectChange;
end else begin
break;
end;
until Application.Terminated;
List.Free;
{$IFDEF VerboseSizeMsg}
DebugLn('HHH4 SendCachedGtkClientResizeNotifications completed.');
{$ENDIF}
end;
begin
SendCachedGtkResizeNotifications;
end;
@ -1502,71 +1147,6 @@ begin
{$ENDIF}
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.RealizeWidgetSize(Widget: PGtkWidget; NewWidth,
NewHeight: integer);
Note: gtk_window is resized in TGtkWidgetSet.SetWindowSizeAndPosition
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.RealizeWidgetSize(Widget: PGtkWidget; NewWidth,
NewHeight: integer);
var
Requisition: TGtkRequisition;
{$IFDEF VerboseSizeMsg}
LCLObject: TObject;
{$ENDIF}
FixedWidget: PGtkWidget;
begin
if NewWidth<=0 then NewWidth:=1;
if NewHeight<=0 then NewHeight:=1;
{$IFDEF VerboseSizeMsg}
LCLObject:=GetNearestLCLObject(Widget);
DbgOut('TGtkWidgetSet.RealizeWidgetSize Widget='+DbgS(Widget)+WidgetFlagsToString(Widget)+
' New='+dbgs(NewWidth)+','+dbgs(NewHeight));
if (LCLObject<>nil) and (LCLObject is TControl) then begin
with TControl(LCLObject) do
DebugLn(' LCL=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
end else begin
DebugLn(' LCL=',DbgS(LCLObject));
end;
{$ENDIF}
if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLBAR) then
begin
// the width of a scrollbar is fixed and depends only on the theme
gtk_widget_size_request(widget, @Requisition);
if GtkWidgetIsA(Widget, GTK_TYPE_HSCROLLBAR) then
begin
NewHeight:=Requisition.height;
end else begin
NewWidth:=Requisition.width;
end;
//DebugLn('TGtkWidgetSet.RealizeWidgetSize A ',Newwidth,',',Newheight);
end;
gtk_widget_set_usize(Widget, NewWidth, NewHeight);
//DebugLn(['TGtkWidgetSet.RealizeWidgetSize ',GetWidgetDebugReport(Widget),' NewWidth=',NewWidth,' NewHeight=',NewHeight]);
if GtkWidgetIsA(Widget, GTK_TYPE_COMBO) then
begin
// the combobox has an entry, which height is not resized
// automatically. Do it manually.
gtk_widget_set_usize(PGtkCombo(Widget)^.entry,
PGtkCombo(Widget)^.entry^.allocation.width, NewHeight);
end;
if GtkWidgetIsA(Widget,gtk_toolbar_get_type) then begin
FixedWidget:=GetFixedWidget(Widget);
if (FixedWidget<>nil) and (FixedWidget<>Widget) then begin
//DebugLn('WARNING: ToDo TGtkWidgetSet.RealizeWidgetSize for TToolBar ',NewWidth,',',NewHeight);
gtk_widget_set_usize(FixedWidget,NewWidth,NewHeight);
end;
end;
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.SendPaintMessagesForInternalWidgets(
AWinControl: TWinControl);
@ -1831,7 +1411,6 @@ begin
end;
// proceed until all messages are handled
until (not PendingGtkMessagesExists) or Application.Terminated;
end;
@ -3584,16 +3163,35 @@ procedure TGtkWidgetSet.ResizeChild(Sender : TObject;
Left, Top, Width, Height : Integer);
var
Widget: PGtkWidget;
LCLControl: TWinControl;
Later: boolean;
{$IFDEF Gtk2}
IsTopLevelWidget: Boolean;
{$ENDIF}
begin
//DebugLn('[TGtkWidgetSet.ResizeChild] START ',TControl(Sender).Name,':',Sender.Classname,' Left=',Left,' Top=',Top,' Width=',Width,' Height=',Height);
Assert(false, (Format('trace: [TGtkWidgetSet.ResizeChild] %s --> Resize', [Sender.ClassNAme])));
if Sender is TWinControl then begin
if TWinControl(Sender).HandleAllocated then begin
Widget := pgtkWidget(TWinControl(Sender).Handle);
SetResizeRequest(Widget);
LCLControl:=TWinControl(Sender);
if LCLControl.HandleAllocated then begin
Widget := pgtkWidget(LCLControl.Handle);
Later:=true;
{$IFDEF Gtk2}
if GTK_WIDGET_REALIZED(Widget) then begin
// add resize request immediately
IsTopLevelWidget:= (LCLControl is TCustomForm)
and (LCLControl.Parent = nil);
if not IsTopLevelWidget then begin
SetWidgetSizeAndPosition(LCLControl);
Later:=false;
end;
end;
{$ENDIF}
if Later then
SetResizeRequest(Widget);
//if (Sender is TCustomForm) then
//if AnsiCompareText(Sender.ClassName,'TScrollBar')=0 then
//if CompareText(Sender.ClassName,'TScrollBar')=0 then
// DebugLn(' FFF ResizeChild ',Sender.ClassName,' ',Left,',',Top,',',Width,',',Height);
end;
end;
@ -5909,11 +5507,13 @@ procedure TGtkWidgetSet.ShowHide(Sender : TObject);
end;
var FormIconGdiObject: PGDIObject;
SenderWidget, ParentFixed, ParentWidget: PGTKWidget;
SenderWidget: PGTKWidget;
LCLControl: TWinControl;
Decor, Func : Longint;
AWindow: PGdkWindow;
ACustomForm: TCustomForm;
ParentFixed: PGTKWidget;
ParentWidget: PGTKWidget;
{$IFDEF Gtk1}
AWindowPrivate: PGdkWindowPrivate;
{$ENDIF}
@ -5941,9 +5541,6 @@ begin
ShareWindowAccelGroups(SenderWidget);
end;
if gtk_widget_visible(SenderWidget) then
exit;
// before making the widget visible, set the position and size
if FWidgetsWithResizeRequest.Contains(SenderWidget) then begin
if (ACustomForm<>nil) and (ACustomForm.Parent=nil) then begin
@ -5958,6 +5555,9 @@ begin
SetWindowSizeAndPosition(PgtkWindow(SenderWidget),LCLControl);
end else if (LCLControl.Parent<>nil) then begin
// resize widget
{$IFDEF VerboseSizeMsg}
DebugLn(['TGtkWidgetSet.ShowHide ',DbgSName(LCLControl)]);
{$ENDIF}
RealizeWidgetSize(SenderWidget,LCLControl.Width,LCLControl.Height);
// move widget on the fixed widget of parent control
ParentWidget:=pgtkWidget(LCLControl.Parent.Handle);
@ -5994,6 +5594,9 @@ begin
ReleaseMouseCapture;
end;
if gtk_widget_visible(SenderWidget) then
exit;
gtk_widget_show(SenderWidget);
if (ACustomForm<>nil) and (ACustomForm.Parent=nil) then begin
@ -7157,9 +6760,9 @@ end;
Because the gtk puts all size requests into a queue, it will process the
requests not immediately, but _after_ all requests. This results in changing
the widget size four times and everytime the LCL gets a message. If the
control has childs, this will result resizing the childs four times.
control has childs, this will resize the childs four times.
Therefore LCL size requests for a widget are cached and only the final one is
sent.
sent in: TGtkWidgetSet.SendCachedLCLMessages.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SetResizeRequest(Widget: PGtkWidget);
{$IFDEF VerboseSizeMsg}
@ -7169,15 +6772,11 @@ var
begin
{$IFDEF VerboseSizeMsg}
LCLControl:=TWinControl(GetLCLObject(Widget));
DbgOut('PPP TGtkWidgetSet.SetResizeRequest Widget=',DbgS(Widget));
if (LCLControl<>nil) then begin
if LCLControl is TWinControl then
DebugLn(' ',LCLControl.Name,':',LCLControl.ClassName)
else
DebugLn(' ERROR: ',LCLControl.ClassName);
end else begin
DebugLn(' ERROR: LCLControl=nil');
end;
DbgOut('TGtkWidgetSet.SetResizeRequest Widget=',DbgS(Widget));
if LCLControl is TWinControl then
DebugLn(' ',DbgSName(LCLControl),' LCLBounds=',dbgs(LCLControl.BoundsRect))
else
DebugLn(' ERROR: ',DbgSName(LCLControl));
{$ENDIF}
if not FWidgetsWithResizeRequest.Contains(Widget) then
FWidgetsWithResizeRequest.Add(Widget);
@ -7194,6 +6793,11 @@ end;
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.UnsetResizeRequest(Widget: PGtkWidget);
begin
{$IFDEF VerboseSizeMsg}
if FWidgetsWithResizeRequest.Contains(Widget) then begin
DebugLn(['TGtkWidgetSet.UnsetResizeRequest ',GetWidgetDebugReport(Widget)]);
end;
{$ENDIF}
FWidgetsWithResizeRequest.Remove(Widget);
end;

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

@ -6441,6 +6441,446 @@ begin
//debugln('GetGTKDefaultSize PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;
procedure SendSizeNotificationToLCL(MainWidget: PGtkWidget);
var
LCLControl: TWinControl;
LCLLeft, LCLTop, LCLWidth, LCLHeight: integer;
GtkLeft, GtkTop, GtkWidth, GtkHeight: integer;
TopLeftChanged, WidthHeightChanged, IsTopLevelWidget: boolean;
MessageDelivered: boolean;
SizeMsg: TLMSize;
MoveMsg: TLMMove;
PosMsg : TLMWindowPosChanged;
procedure UpdateLCLRect;
begin
LCLLeft:=LCLControl.Left;
LCLTop:=LCLControl.Top;
LCLWidth:=LCLControl.Width;
LCLHeight:=LCLControl.Height;
TopLeftChanged:=(LCLLeft<>GtkLeft) or (LCLTop<>GtkTop);
WidthHeightChanged:=(LCLWidth<>GtkWidth) or (LCLHeight<>GtkHeight);
end;
begin
if not GTK_WIDGET_REALIZED(MainWidget) then begin
{$IFDEF VerboseSizeMsg}
LCLControl:=TWinControl(GetLCLObject(MainWidget));
DebugLn('SendSizeNotificationToLCL ',DbgSName(LCLControl),' MainWidget=',WidgetFlagsToString(MainWidget),' Ignored, because not realized ');
{$ENDIF}
exit;
end;
LCLControl:=TWinControl(GetLCLObject(MainWidget));
if LCLControl=nil then exit;
{$IFDEF VerboseSizeMsg}
DebugLn('SendSizeNotificationToLCL checking ... ',DbgSName(LCLControl),' MainWidget=',WidgetFlagsToString(MainWidget));
{$ENDIF}
GtkLeft:=MainWidget^.Allocation.X;
GtkTop:=MainWidget^.Allocation.Y;
{$Ifdef GTK2}
if GTK_WIDGET_NO_WINDOW(MainWidget) and GTK_WIDGET_NO_WINDOW(MainWidget^.Parent)
// and (not GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType))
then begin
//DebugLn(['SendSizeNotificationToLCL widget has no gdkwindow, fixing coords by adding parent coords: MainWidget^.Allocation=',MainWidget^.Allocation.X,',',MainWidget^.Allocation.Y,' MainWidget^.parent^.Allocation=',MainWidget^.parent^.Allocation.X,',',MainWidget^.parent^.Allocation.Y,' ',GetWidgetDebugReport(MainWidget)]);
Dec(GtkLeft, MainWidget^.parent^.Allocation.X);
Dec(GtkTop, MainWidget^.parent^.Allocation.Y);
end;
{$EndIf}
GtkWidth:=MainWidget^.Allocation.Width;
if GtkWidth<0 then GtkWidth:=0;
GtkHeight:=MainWidget^.Allocation.Height;
if GtkHeight<0 then GtkHeight:=0;
IsTopLevelWidget:=(LCLControl is TCustomForm) and (LCLControl.Parent=nil);
if IsTopLevelWidget then begin
if not GTK_WIDGET_VISIBLE(MainWidget) then begin
// size/move messages of invisible windows are not reliable
// -> ignore
exit;
end;
if (GtkWidth=1) and (GtkHeight=1) then begin
// this is default size of the gtk. Ignore.
exit;
end;
//DebugLn(['SendSizeNotificationToLCL FORM ',GetWidgetDebugReport(MainWidget)]);
if GetControlWindow(MainWidget)<>nil then begin
gdk_window_get_root_origin(GetControlWindow(MainWidget), @GtkLeft, @GtkTop);
end else begin
GtkLeft:=LCLControl.Left;
GtkTop:=LCLControl.Top;
end;
{$IFDEF VerboseFormPositioning}
DebugLn(['VFP SendSizeNotificationToLCL ',DbgSName(LCLControl),' ',
GtkLeft,',',GtkTop,',',GtkWidth,'x',GtkHeight,' ',GetWidgetDebugReport(MainWidget)]);
{$ENDIF}
end;
UpdateLCLRect;
// first send a LM_WINDOWPOSCHANGED message
if TopLeftChanged or WidthHeightChanged then begin
{$IFDEF VerboseSizeMsg}
DebugLn('SendSizeNotificationToLCL ',DbgSName(LCLControl),
' GTK=',dbgs(GtkLeft)+','+dbgs(GtkTop)+','+dbgs(GtkWidth)+'x'+dbgs(GtkHeight),
' LCL=',dbgs(LCLLeft)+','+dbgs(LCLTop)+','+dbgs(LCLWidth)+'x'+dbgs(LCLHeight)
);
{$ENDIF}
PosMsg.Msg := LM_WINDOWPOSCHANGED; //LM_SIZEALLOCATE;
PosMsg.Result := 0;
New(PosMsg.WindowPos);
try
with PosMsg.WindowPos^ do begin
hWndInsertAfter := 0;
x := GtkLeft;
y := GtkTop;
cx := GtkWidth;
cy := GtkHeight;
flags := 0;
end;
MessageDelivered := DeliverMessage(LCLControl, PosMsg) = 0;
finally
Dispose(PosMsg.WindowPos);
end;
if (not MessageDelivered) then exit;
if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
UpdateLCLRect;
end;
// then send a LM_SIZE message
if WidthHeightChanged then begin
{$IFDEF VerboseSizeMsg}
DebugLn('Send LM_SIZE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
{$ENDIF}
with SizeMsg do
begin
Result := 0;
Msg := LM_SIZE;
{$IFDEF GTK1}
if GDK_WINDOW_GET_MAXIMIZED(PGdkWindowPrivate(MainWidget^.window)) then
SizeType := SIZEFULLSCREEN
else
SizeType := SIZENORMAL;
{$ELSE}
if LCLControl is TCustomForm then begin
// if the LCL gets an event without a State it resets it to SIZENORMAL
// so we send it the state it already is
case TCustomForm(LCLControl).WindowState of
wsNormal: SizeType := SIZENORMAL;
wsMinimized: SizeType := SIZEICONIC;
wsMaximized: SizeType := SIZEFULLSCREEN;
end;
end
else
SizeType := 0;
{$ENDIF}
SizeType := SizeType or Size_SourceIsInterface;
Width := SmallInt(GtkWidth);
Height := SmallInt(GtkHeight);
end;
MessageDelivered := (DeliverMessage(LCLControl, SizeMsg) = 0);
if not MessageDelivered then exit;
if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
UpdateLCLRect;
end;
// then send a LM_MOVE message
if TopLeftChanged then begin
{$IFDEF VerboseSizeMsg}
DebugLn('Send LM_MOVE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
{$ENDIF}
with MoveMsg do
begin
Result := 0;
Msg := LM_MOVE;
MoveType := Move_SourceIsInterface;
XPos := SmallInt(GtkLeft);
YPos := SmallInt(GtkTop);
end;
MessageDelivered := (DeliverMessage(LCLControl, MoveMsg) = 0);
if not MessageDelivered then exit;
end;
end;
procedure SendCachedGtkResizeNotifications;
{ This proc sends all cached size messages from the gtk to lcl but in an
optimized order.
When sending the LCL a size/move/windowposchanged messages the LCL will
automatically realign all child controls. This realigning is based on the
clientrect.
Therefore, before a size message is sent to the lcl, all clientrect must be
updated.
If a size message results in resizing a widget that was also resized, then
the message for the dependent widget is not sent to the lcl, because the lcl
resize was after the gtk resize.
}
var
FixWidget, MainWidget: PGtkWidget;
LCLControl: TWinControl;
List: TFPList;
i: integer;
procedure RaiseInvalidLCLControl;
begin
RaiseGDBException(Format('SendCachedGtkResizeNotifications FixWidget=%p MainWidget=%p LCLControl=%p',
[FixWidget, MainWidget, Pointer(LCLControl)]));
end;
begin
if (FWidgetsResized.Count=0) and (FFixWidgetsResized.Count=0) then exit;
List:=TFPList.Create;
{ if any fixed widget was resized then a client area of a LCL control was
resized
-> invalidate client rectangles
}
{$IFDEF VerboseSizeMsg}
DebugLn('HHH1 SendCachedGtkClientResizeNotifications Invalidating ClientRects ... '
,' FixSizeMsgCount=',dbgs(FFixWidgetsResized.Count));
{$ENDIF}
FFixWidgetsResized.AssignTo(List);
for i:=0 to List.Count-1 do begin
FixWidget:=List[i];
MainWidget:=GetMainWidget(FixWidget);
LCLControl:=TWinControl(GetLCLObject(MainWidget));
if (LCLControl=nil) or (not (LCLControl is TWinControl)) then
RaiseInvalidLCLControl;
LCLControl.InvalidateClientRectCache(false);
end;
{ if any main widget (= not fixed widget) was resized
then a LCL control was resized
-> send WMSize, WMMove, and WMWindowPosChanged messages
}
{$IFDEF VerboseSizeMsg}
if FWidgetsResized.First<>nil then
DebugLn('HHH2 SendCachedGtkClientResizeNotifications SizeMsgCount=',dbgs(FWidgetsResized.Count));
{$ENDIF}
repeat
MainWidget:=FWidgetsResized.First;
if MainWidget<>nil then begin
FWidgetsResized.Remove(MainWidget);
if not FWidgetsWithResizeRequest.Contains(MainWidget) then begin
SendSizeNotificationToLCL(MainWidget);
end;
end else break;
until Application.Terminated;
{ if any client area was resized, which MainWidget Size was already in sync
with the LCL, no message was sent. So, tell each changed client area to
check its size.
}
{$IFDEF VerboseSizeMsg}
if FFixWidgetsResized.First<>nil then
DebugLn('HHH3 SendCachedGtkClientResizeNotifications Updating ClientRects ...');
{$ENDIF}
repeat
FixWidget:=FFixWidgetsResized.First;
if FixWidget<>nil then begin
FFixWidgetsResized.Remove(FixWidget);
MainWidget:=GetMainWidget(FixWidget);
LCLControl:=TWinControl(GetLCLObject(MainWidget));
LCLControl.DoAdjustClientRectChange;
end else begin
break;
end;
until Application.Terminated;
List.Free;
{$IFDEF VerboseSizeMsg}
DebugLn('HHH4 SendCachedGtkClientResizeNotifications completed.');
{$ENDIF}
end;
{------------------------------------------------------------------------------
procedure RealizeWidgetSize(Widget: PGtkWidget; NewWidth,
NewHeight: integer);
Note: gtk_window is resized in SetWindowSizeAndPosition
------------------------------------------------------------------------------}
procedure RealizeWidgetSize(Widget: PGtkWidget; NewWidth,
NewHeight: integer);
var
Requisition: TGtkRequisition;
{$IFDEF VerboseSizeMsg}
LCLObject: TObject;
{$ENDIF}
FixedWidget: PGtkWidget;
begin
if NewWidth<=0 then NewWidth:=1;
if NewHeight<=0 then NewHeight:=1;
{$IFDEF VerboseSizeMsg}
LCLObject:=GetNearestLCLObject(Widget);
DbgOut('TGtkWidgetSet.RealizeWidgetSize Widget='+DbgS(Widget)+WidgetFlagsToString(Widget)+
' New='+dbgs(NewWidth)+','+dbgs(NewHeight));
if (LCLObject<>nil) and (LCLObject is TControl) then begin
with TControl(LCLObject) do
DebugLn(' LCL=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
end else begin
DebugLn(' LCL=',DbgS(LCLObject));
end;
{$ENDIF}
if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLBAR) then
begin
// the width of a scrollbar is fixed and depends only on the theme
gtk_widget_size_request(widget, @Requisition);
if GtkWidgetIsA(Widget, GTK_TYPE_HSCROLLBAR) then
begin
NewHeight:=Requisition.height;
end else begin
NewWidth:=Requisition.width;
end;
//DebugLn('TGtkWidgetSet.RealizeWidgetSize A ',Newwidth,',',Newheight);
end;
gtk_widget_set_usize(Widget, NewWidth, NewHeight);
//DebugLn(['TGtkWidgetSet.RealizeWidgetSize ',GetWidgetDebugReport(Widget),' NewWidth=',NewWidth,' NewHeight=',NewHeight]);
{$IFDEF Gtk1}
if GtkWidgetIsA(Widget, GTK_TYPE_COMBO) then
begin
// the combobox has an entry, which height is not resized
// automatically. Do it manually.
gtk_widget_set_usize(PGtkCombo(Widget)^.entry,
PGtkCombo(Widget)^.entry^.allocation.width, NewHeight);
end;
{$ENDIF}
if GtkWidgetIsA(Widget,gtk_toolbar_get_type) then begin
FixedWidget:=GetFixedWidget(Widget);
if (FixedWidget<>nil) and (FixedWidget<>Widget) then begin
//DebugLn('WARNING: ToDo TGtkWidgetSet.RealizeWidgetSize for TToolBar ',NewWidth,',',NewHeight);
gtk_widget_set_usize(FixedWidget,NewWidth,NewHeight);
end;
end;
end;
procedure SetWidgetSizeAndPosition(LCLControl: TWinControl);
var
LCLWidth: LongInt;
LCLHeight: LongInt;
Widget: PGtkWidget;
ParentWidget: PGtkWidget;
ParentFixed: PGtkWidget;
WinWidgetInfo: PWidgetInfo;
procedure WriteBigWarning;
begin
DebugLn('WARNING: SetWidgetSizeAndPosition: resizing BIG ',
' Control=',LCLControl.Name,':',LCLControl.ClassName,
' NewSize=',dbgs(LCLWidth),',',dbgs(LCLHeight));
//RaiseException('');
end;
procedure WriteWarningParentWidgetNotFound;
begin
DebugLn('WARNING: SetWidgetSizeAndPosition - '
,'Parent''s Fixed Widget not found');
DebugLn(' Control=',LCLControl.Name,':',LCLControl.ClassName,
' Parent=',LCLControl.Parent.Name,':',LCLControl.Parent.ClassName,
' ParentWidget=',DbgS(ParentWidget),
'');
end;
begin
// resize widget
LCLWidth:=LCLControl.Width;
if LCLWidth<=0 then
LCLWidth:=1;
LCLHeight:=LCLControl.Height;
if LCLHeight<=0 then
LCLHeight:=1;
if (LCLWidth>10000) or (LCLHeight>10000) then begin
WriteBigWarning;
if LCLWidth>10000 then
LCLWidth:=10000
else
LCLHeight:=10000;
end;
{$IFDEF VerboseSizeMsg}
DebugLn(['SetWidgetSizeAndPosition ',DbgSName(LCLControl)]);
{$ENDIF}
Widget:=PGtkWidget(LCLControl.Handle);
RealizeWidgetSize(Widget,LCLWidth, LCLHeight);
// move widget on the fixed widget of parent control
if (LCLControl.Parent<>nil) and (LCLControl.Parent.HandleAllocated) then
begin
ParentWidget:=pgtkWidget(LCLControl.Parent.Handle);
ParentFixed := GetFixedWidget(ParentWidget);
if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE)
or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin
FixedMoveControl(ParentFixed, Widget,
LCLControl.Left,LCLControl.Top);
end else begin
WinWidgetInfo:=GetWidgetInfo(Widget,false);
if (WinWidgetInfo=nil)
or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
WriteWarningParentWidgetNotFound;
end;
end;
end;
{------------------------------------------------------------------------------
Method: SetWindowSizeAndPosition
Params: Widget: PGtkWidget; AWinControl: TWinControl
Returns: Nothing
Set the size and position of a top level window.
------------------------------------------------------------------------------}
procedure SetWindowSizeAndPosition(Window: PGtkWindow;
AWinControl: TWinControl);
var
Width, Height: integer;
//Info: PGtkWindowGeometryInfo;
begin
Width:=AWinControl.Width;
// 0 and negative values have a special meaning, so don't use them
if Width<=0 then Width:=1;
Height:=AWinControl.Height;
if Height<=0 then Height:=1;
//DebugLn('TGtkWidgetSet.SetWindowSizeAndPosition ',AWinControl.Name,':',AWinControl.ClassName,' ',AWinControl.Visible,' Old=',PGtkWidget(Window)^.allocation.Width,',',PGtkWidget(Window)^.allocation.Width,' New=',Width,',',Height);
// set geometry default size
//Info:=gtk_window_get_geometry_info(Window, TRUE);
//if (Info^.default_width<>Width) or (Info^.default_height<>Height) then
gtk_window_set_default_size(Window,Width,Height);
{$IFDEF Gtk2}
// resize
gtk_window_resize(Window,Width,Height);
// reposition
gtk_window_move(Window,AWinControl.Left,AWinControl.Top);
{$ELSE}
// resize
if assigned(PGtkWidget(Window)^.Window) then
// widget is realized, resize gdkwindow directly
gdk_window_move_resize(PGtkWidget(Window)^.Window,AWinControl.Left,
AWinControl.Top,Width,Height)
else begin
// widget is not yet realized, force resize needed for shrinking under gtk1
gtk_widget_set_usize(PGtkWidget(Window), -1,-1);
end;
// reposition
gtk_widget_set_usize(PGtkWidget(Window),Width,Height);
gtk_widget_set_uposition(PGtkWidget(Window),AWinControl.Left,AWinControl.Top);
{$ENDIF}
{$IFDEF VerboseSizeMsg}
DebugLn(['SetWindowSizeAndPosition B ',DbgSName(AWinControl),
' Visible=',AWinControl.Visible,
' Old=',PGtkWidget(Window)^.allocation.X,',',PGtkWidget(Window)^.allocation.Y,
' New=',AWinControl.Left,',',AWinControl.Top,',',Width,'x',Height]);
{$ENDIF}
end;
Procedure ReportNotObsolete(const Texts : String);
Begin
DebugLn('*********************************************');
@ -6932,7 +7372,7 @@ function IndexOfStyleWithName(const WName : String): integer;
begin
if Styles<>nil then begin
for Result:=0 to Styles.Count-1 do
if AnsiCompareText(WName,Styles[Result])=0 then exit;
if CompareText(WName,Styles[Result])=0 then exit;
end;
Result:=-1;
end;
@ -6946,24 +7386,13 @@ end;
'default', checkbox', etc. This should only be called on theme change or on
application terminate.
------------------------------------------------------------------------------}
Type
PStyleObject = ^TStyleObject;
TStyleObject = Record
Style : PGTKStyle;
Widget : PGTKWidget;
end;
var
StandardStyles: array[TLazGtkStyle] of PStyleObject;
Function NewStyleObject : PStyleObject;
function NewStyleObject : PStyleObject;
begin
New(Result);
Result^.Widget := nil;
Result^.Style := nil;
FillChar(Result^,SizeOf(TStyleObject),0);
end;
Procedure FreeStyleObject(var StyleObject : PStyleObject);
procedure FreeStyleObject(var StyleObject : PStyleObject);
// internal function to dispose a styleobject
// it does *not* remove it from the style lists
begin
@ -7066,6 +7495,8 @@ end;
of Styles.
------------------------------------------------------------------------------}
function GetStyleWithName(const WName: String) : PGTKStyle;
var
StyleObject : PStyleObject;
function CreateStyleNotebook: PGTKWidget;
var
@ -7091,11 +7522,29 @@ function GetStyleWithName(const WName: String) : PGTKStyle;
NoteBookTabLabel,NoteBookTabMenuLabel);
gtk_widget_set_usize(Result,200,200);
end;
procedure ResizeWidget(CurWidget: PGTKWidget; NewWidth, NewHeight: integer);
{$IFDEF Gtk1}
begin
gtk_widget_set_usize(StyleObject^.Widget,NewWidth,NewHeight);
end;
{$ELSE}
var
allocation: TGtkAllocation;
begin
allocation.x:=0;
allocation.y:=0;
allocation.width:=NewWidth;
allocation.height:=NewHeight;
//gtk_widget_set_usize(StyleObject^.Widget,NewWidth,NewHeight);
gtk_widget_size_allocate(CurWidget,@allocation);
StyleObject^.FrameBordersValid:=false;
end;
{$ENDIF}
var
Tp : Pointer;
l : Longint;
StyleObject : PStyleObject;
NoName: PGChar;
lgs: TLazGtkStyle;
WidgetName: String;
@ -7111,11 +7560,11 @@ begin
exit;
{$ENDIF}
If (WName='') then exit;
if (WName='') then exit;
l:=IndexOfStyleWithName(WName);
//DebugLn('GetStyleWithName START ',WName,' ',l);
//DebugLn(['GetStyleWithName START ',WName,' ',l]);
If l >= 0 then begin
if l >= 0 then begin
StyleObject:=PStyleObject(Styles.Objects[l]);
Result := StyleObject^.Style;
@ -7237,17 +7686,24 @@ begin
else
If CompareText(WName,LazGtkStyleNames[lgsHScale])=0 then begin
lgs:=lgsHScale;
AddToStyleWindow:=true;
TP := PGtkWidget( gtk_adjustment_new (0, 0, 100, 1, 10, 0));
StyleObject^.Widget := gtk_hscale_new (PGTKADJUSTMENT (TP));
end
else
If CompareText(WName,LazGtkStyleNames[lgsVScale])=0 then begin
lgs:=lgsVScale;
AddToStyleWindow:=true;
TP := PGtkWidget( gtk_adjustment_new (0, 0, 100, 1, 10, 0));
StyleObject^.Widget := gtk_vscale_new (PGTKADJUSTMENT (TP));
end
else
If CompareText(WName,LazGtkStyleNames[lgsGroupBox])=0 then begin
lgs:=lgsGroupBox;
StyleObject^.Widget := gtk_frame_new('GroupBox');
WindowFixedWidget:=CreateFixedClientWidget;
gtk_widget_show(WindowFixedWidget);
gtk_container_add(PGtkContainer(StyleObject^.Widget), WindowFixedWidget);
gtk_object_set_data(PGtkObject(StyleObject^.Widget),'fixedwidget',WindowFixedWidget);
end
else
If CompareText(WName,LazGtkStyleNames[lgsGTK_Default])=0 then begin
lgs:=lgsGTK_Default;
@ -7277,10 +7733,9 @@ begin
StyleWindowWidget:=GetStyleWidget(lgsWindow);
WindowFixedWidget:=PGTKWidget(
gtk_object_get_data(PGtkObject(StyleWindowWidget),'fixedwidget'));
//DebugLn('AddToStyleWindow A ',GetWidgetDebugReport(StyleObject^.Widget));
//DebugLn('AddToStyleWindow adding on hidden stylewindow ',WName,' ',GetWidgetDebugReport(StyleObject^.Widget));
//gtk_box_pack_end(PGTKBox(VBox), WindowFixedWidget, True, True, 0);
gtk_fixed_put(PGtkFixed(WindowFixedWidget),StyleObject^.Widget,0,0);
gtk_widget_set_usize(StyleObject^.Widget,200,200);
gtk_fixed_put(PGtkFixed(WindowFixedWidget),StyleObject^.Widget,10,10);
end;
WidgetName:='LazStyle'+WName;
@ -7290,19 +7745,24 @@ begin
StyleObject^.Style:=gtk_widget_get_style(StyleObject^.Widget);
// ToDo: find out, why sometimes the style is not initialized.
// for example: why the following occurs:
If CompareText(WName,'button')=0 then begin
if CompareText(WName,'button')=0 then begin
if StyleObject^.Style^.light_gc[GTK_STATE_NORMAL]=nil then begin
//DebugLn('GetStyleWithName ',WName);
if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_GET_TYPE) then begin
gtk_widget_realize(StyleObject^.Widget);
end;
end;
end;
if AddToStyleWindow then begin
if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_GET_TYPE) then begin
//DebugLn(['GetStyleWithName realizing ...']);
gtk_widget_realize(StyleObject^.Widget);
//DebugLn('AddToStyleWindow realized: ',WName,' ',GetWidgetDebugReport(StyleObject^.Widget));
end;
ResizeWidget(StyleObject^.Widget,200,200);
end;
end;
// increase refcount of style
If StyleObject^.Style <> nil then
If AnsiCompareText(WName,LazGtkStyleNames[lgsGTK_Default])<>0 then
If CompareText(WName,LazGtkStyleNames[lgsGTK_Default])<>0 then
StyleObject^.Style:=GTK_Style_Ref(StyleObject^.Style);
// if successful add to style objects list
@ -7312,7 +7772,7 @@ begin
StandardStyles[lgs]:=StyleObject;
Result:=StyleObject^.Style;
If (StyleObject^.Widget <> nil)
and (AnsiCompareText(WName,LazGtkStyleNames[lgsWindow])=0) then
and (CompareText(WName,LazGtkStyleNames[lgsWindow])=0) then
UpdateSysColorMap(StyleObject^.Widget);
// ToDo: create all gc of the style
@ -7878,6 +8338,38 @@ begin
RealizeGtkStyleColor(Style,Result);
end;
{$IFDEF Gtk2}
function GetStyleGroupboxFrameBorders: TRect;
var
StyleObject: PStyleObject;
allocation: TGtkAllocation;
FrameWidget: PGtkFrame;
f: TRect;
begin
GetStyleWidget(lgsGroupBox);
StyleObject:=StandardStyles[lgsGroupBox];
if not StyleObject^.FrameBordersValid then begin
allocation.x:=0;
allocation.y:=0;
allocation.width:=200;
allocation.height:=200;
gtk_widget_size_allocate(StyleObject^.Widget,@allocation);
FrameWidget:=pGtkFrame(StyleObject^.Widget);
GTK_FRAME_GET_CLASS(FrameWidget)^.compute_child_allocation(
FrameWidget,@allocation);
//DebugLn(['GetStyleGroupboxFrame BBB2 ',dbgs(allocation)]);
f.Left:=Min(200,Max(0,allocation.x));
f.Top:=Min(200,Max(0,allocation.y));
f.Right:=Max(0,Min(200-f.Left,200-allocation.x-allocation.width));
f.Bottom:=Max(0,Min(200-f.Top,200-allocation.x-allocation.width));
StyleObject^.FrameBorders:=f;
//DebugLn(['GetStyleGroupboxFrame FrameBorders=',dbgs(StyleObject^.FrameBorders)]);
StyleObject^.FrameBordersValid:=true;
end;
Result:=StyleObject^.FrameBorders
end;
{$ENDIF}
procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC; Color : TColorRef; x, y, width, height : gint);
var
style : PGTKStyle;

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

@ -704,6 +704,11 @@ procedure SaveClientSizeNotification(FixWidget: PGtkWidget);
function CreateTopologicalSortedWidgets(HashArray: TDynHashArray): TFPList;
procedure GetGTKDefaultWidgetSize(AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
procedure SendSizeNotificationToLCL(MainWidget: PGtkWidget);
procedure SendCachedGtkResizeNotifications;
procedure RealizeWidgetSize(Widget: PGtkWidget; NewWidth, NewHeight: integer);
procedure SetWidgetSizeAndPosition(LCLControl: TWinControl);
procedure SetWindowSizeAndPosition(Window: PGtkWindow; AWinControl: TWinControl);
// debug
procedure ReportNotObsolete(const Texts: String);
@ -723,6 +728,18 @@ function GdkAtomToStr(const Atom: TGdkAtom): string;
function CreateFormContents(AForm: TCustomForm; var FormWidget: Pointer): Pointer;
// styles
type
PStyleObject = ^TStyleObject;
TStyleObject = Record
Style : PGTKStyle;
Widget : PGTKWidget;
FrameBordersValid: boolean;
FrameBorders: TRect;
end;
var
StandardStyles: array[TLazGtkStyle] of PStyleObject;
function IndexOfStyle(aStyle: TLazGtkStyle): integer;
function IndexOfStyleWithName(const WName: String): integer;
procedure ReleaseAllStyles;
@ -732,6 +749,9 @@ function GetStyle(aStyle: TLazGtkStyle): PGTKStyle;
function GetStyleWithName(const WName: String): PGTKStyle;
function GetStyleWidget(aStyle: TLazGtkStyle): PGTKWidget;
function GetStyleWidgetWithName(const WName: String): PGTKWidget;
{$IFDEF Gtk2}
function GetStyleGroupboxFrameBorders: TRect;
{$ENDIF}
procedure StyleFillRectangle(drawable: PGDKDrawable; GC: PGDKGC;
Color: TColorRef; x, y, width, height: gint);
function StyleForegroundColor(Color: TColorRef; DefaultColor: PGDKColor): PGDKColor;

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

@ -6407,11 +6407,33 @@ end;
------------------------------------------------------------------------------}
function TGtkWidgetSet.GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
var
aWidget: PGtkWidget;
{$IFDEF Gtk2}
GdkWindow: PGdkWindow;
GtkLeft, GtkTop: gint;
{$ENDIF}
begin
if GtkWidgetIsA(PGtkWidget(Handle),GTK_TYPE_WIDGET) then begin
aWidget:=PGtkWidget(Handle);
if GtkWidgetIsA(aWidget,GTK_TYPE_WIDGET) then begin
Result:=true;
Left:=PGtkWidget(Handle)^.Allocation.X;
Top:=PGtkWidget(Handle)^.Allocation.Y;
Left:=aWidget^.allocation.X;
Top:=aWidget^.allocation.Y;
{$IFDEF Gtk2}
if (aWidget^.window=nil) and (aWidget^.parent<>nil) then begin
inc(Left,aWidget^.parent^.allocation.X);
inc(Top,aWidget^.parent^.allocation.Y);
end;
if GtkWidgetIsA(aWidget,GTK_TYPE_WINDOW) then begin
GdkWindow:=GetControlWindow(aWidget);
if GdkWindow<>nil then begin
gdk_window_get_root_origin(GdkWindow, @GtkLeft, @GtkTop);
Left:=GtkLeft;
Top:=GtkTop;
end;
end;
//DebugLn(['TGtkWidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top]);
{$ENDIF}
end else
Result:=false;
end;

2
lcl/interfaces/gtk2/gtk2int.pas
View File

@ -60,10 +60,8 @@ type
procedure HookSignals(const AGTKObject: PGTKObject; const ALCLObject: TObject); override;
function LoadStockPixmap(StockID: longint) : HBitmap; override;
procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: boolean);override;
//procedure SetLabel(Sender : TObject; Data : Pointer);
procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
MultiSelect, ExtendedSelect: boolean); override;
//function SetTopIndex(Sender: TObject; NewTopIndex: integer): integer; override;
procedure InitializeFileDialog(FileDialog: TFileDialog;
var SelWidget: PGtkWidget; Title: PChar); override;

27
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -81,6 +81,9 @@ type
private
protected
public
class function GetDefaultClientRect(const AWinControl: TWinControl;
const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
): boolean; override;
end;
{ TGtk2WSGroupBox }
@ -1259,6 +1262,28 @@ begin
inherited DestroyHandle(AWinControl);
end;
{ TGtk2WSCustomGroupBox }
class function TGtk2WSCustomGroupBox.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;
var
FrameBorders: TRect;
begin
Result:=false;
//DebugLn(['TGtk2WSCustomGroupBox.GetDefaultClientRect ',DbgSName(AWinControl),' ',aWidth,'x',aHeight]);
if AWinControl.HandleAllocated then begin
end else begin
FrameBorders:=GetStyleGroupboxFrameBorders;
aClientRect:=Rect(0,0,
Max(0,aWidth-FrameBorders.Left-FrameBorders.Right),
Max(0,aHeight-FrameBorders.Top-FrameBorders.Bottom));
Result:=true;
end;
//if Result then DebugLn(['TGtk2WSCustomGroupBox.GetDefaultClientRect AAA2 FrameBorders=',dbgs(FrameBorders),' aClientRect=',dbgs(aClientRect)]);
end;
initialization
////////////////////////////////////////////////////
@ -1268,7 +1293,7 @@ initialization
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TScrollBar, TGtk2WSScrollBar);
// RegisterWSComponent(TCustomGroupBox, TGtk2WSCustomGroupBox);
RegisterWSComponent(TCustomGroupBox, TGtk2WSCustomGroupBox);
// RegisterWSComponent(TGroupBox, TGtk2WSGroupBox);
RegisterWSComponent(TCustomComboBox, TGtk2WSCustomComboBox);
// RegisterWSComponent(TComboBox, TGtk2WSComboBox);

11
lcl/widgetset/wscontrols.pp
View File

@ -86,6 +86,7 @@ type
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; virtual;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; virtual;
class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); virtual;
class function GetDefaultClientRect(const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect): boolean; virtual;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual;
@ -99,9 +100,10 @@ type
class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual;
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); virtual;
{ TODO: this procedure is only used in win32 interface }
{ TODO: move AdaptBounds: it is only used in winapi interfaces }
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean); virtual;
class procedure ConstraintsChange(const AWinControl: TWinControl); virtual;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; virtual;
@ -202,6 +204,13 @@ class procedure TWSWinControl.GetPreferredSize(const AWinControl: TWinControl;
begin
end;
class function TWSWinControl.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;
begin
Result:=false;
end;
class procedure TWSWinControl.Invalidate(const AWinControl: TWinControl);
begin
end;