From ce515724530d85148879b6d37b89756f3016301c Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 13 Feb 2004 15:49:54 +0000 Subject: [PATCH] started advanced LCL auto sizing git-svn-id: trunk@5198 - --- lcl/comctrls.pp | 4 +- lcl/controls.pp | 481 ++++++++++++++++++++++++++--- lcl/include/control.inc | 79 +++-- lcl/include/controlsproc.inc | 21 +- lcl/include/sizeconstraints.inc | 6 + lcl/include/toolbutton.inc | 19 +- lcl/include/wincontrol.inc | 171 +++++----- lcl/interfaces/gtk/gtkcallback.inc | 15 +- lcl/interfaces/gtk/gtkobject.inc | 5 +- lcl/interfaces/gtk/gtkproc.inc | 32 +- lcl/interfaces/gtk/gtkproc.pp | 9 +- lcl/interfaces/gtk/gtkwinapi.inc | 106 +++++-- lcl/lcltype.pp | 11 +- 13 files changed, 750 insertions(+), 209 deletions(-) diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 6664d16f29..d348eb8d3d 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -840,7 +840,6 @@ type public constructor Create(TheOwner: TComponent); override; function CheckMenuDropdown: Boolean; dynamic; - procedure ChangeBounds(NewLeft, NewTop, NewWidth, NewHeight: Integer); override; property Index: Integer read GetIndex; published property Action; @@ -2235,6 +2234,9 @@ end. { ============================================================================= $Log$ + Revision 1.109 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.108 2004/02/12 18:09:10 mattias removed win32 specific TToolBar code in new TToolBar, implemented TWinControl.FlipChildren diff --git a/lcl/controls.pp b/lcl/controls.pp index 6349c338f4..263ca59b82 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -26,6 +26,7 @@ unit Controls; {$mode objfpc}{$H+} {off $DEFINE BUFFERED_WMPAINT} + interface {$ifdef Trace} @@ -493,6 +494,10 @@ type TConstraintSize = 0..MaxInt; + TSizeConstraintsOption = (scoAdviceWidthAsMin, scoAdviceWidthAsMax, + scoAdviceHeightAsMin, scoAdviceHeightAsMax); + TSizeConstraintsOptions = set of TSizeConstraintsOption; + TSizeConstraints = class(TPersistent) private FControl: TControl; @@ -505,6 +510,8 @@ type FMinInterfaceWidth: integer; FMinWidth: TConstraintSize; FOnChange: TNotifyEvent; + FOptions: TSizeConstraintsOptions; + procedure SetOptions(const AValue: TSizeConstraintsOptions); protected procedure Change; dynamic; procedure AssignTo(Dest: TPersistent); override; @@ -527,6 +534,7 @@ type property MinInterfaceHeight: integer read FMinInterfaceHeight; property MinInterfaceWidth: integer read FMinInterfaceWidth; property Control: TControl read FControl; + property Options: TSizeConstraintsOptions read FOptions write SetOptions default []; published property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0; property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0; @@ -538,7 +546,58 @@ type var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize) of object; - TTabOrder = -1..32767; + { TControlBorderSpacing } + + { TControlBorderSpacing defines the spacing around a control, around its + childs and between its childs. + + Left, Top, Right, Bottom: integer; + minimum space left to the control. + For example: Control A lies left of control B. + A has borderspacing Right=10 and B has borderspacing Left=5. + Then A and B will have a minimum space of 10 between. + + Around: integer; + same as Left, Top, Right and Bottom all at once. This will be added to + the effective Left, Top, Right and Bottom. + Example: Left=3 and Around=5 results in a minimum spacing to the left + of 8. + + } + + TSpacingSize = 0..MaxInt; + + TControlBorderSpacing = class(TPersistent) + private + FAround: TSpacingSize; + FBottom: TSpacingSize; + FControl: TControl; + FLeft: TSpacingSize; + FOnChange: TNotifyEvent; + FRight: TSpacingSize; + FTop: TSpacingSize; + procedure SetAround(const AValue: TSpacingSize); + procedure SetBottom(const AValue: TSpacingSize); + procedure SetLeft(const AValue: TSpacingSize); + procedure SetRight(const AValue: TSpacingSize); + procedure SetTop(const AValue: TSpacingSize); + protected + procedure Change; dynamic; + public + constructor Create(OwnerControl: TControl); + procedure Assign(Source: TPersistent); override; + procedure AssignTo(Dest: TPersistent); override; + function IsEqual(Spacing: TControlBorderSpacing): boolean; + public + property Control: TControl read FControl; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property Left: TSpacingSize read FLeft write SetLeft; + property Top: TSpacingSize read FTop write SetTop; + property Right: TSpacingSize read FRight write SetRight; + property Bottom: TSpacingSize read FBottom write SetBottom; + property Around: TSpacingSize read FAround write SetAround; + end; { TControlActionLink } @@ -569,6 +628,8 @@ type { TControl } + TTabOrder = -1..32767; + TControlShowHintEvent = procedure(Sender: TObject; HintInfo: Pointer) of object; TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint; var Handled: Boolean) of object; @@ -595,6 +656,7 @@ type FBaseBounds: TRect; FBaseBoundsLock: integer; FBaseParentClientSize: TPoint; + FBorderSpacing: TControlBorderSpacing; FCaption : TCaption; FColor : TColor; FConstraints : TSizeConstraints; @@ -693,6 +755,7 @@ type procedure DoDragMsg(var Dragmsg : TCMDrag); procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton; Shift:TShiftState); procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton); + procedure SetBorderSpacing(const AValue: TControlBorderSpacing); procedure SetBoundsRect(const ARect : TRect); procedure SetClientHeight(Value: Integer); procedure SetClientSize(Value: TPoint); @@ -718,17 +781,36 @@ type procedure SetWidth(Value: Integer); Procedure UpdateTabOrder(value : TTabOrder); protected - AutoSizing : Boolean; FControlState: TControlState; + protected + // sizing/aligning + AutoSizing: Boolean; procedure AdjustSize; dynamic; procedure DoAutoSize; Virtual; procedure SetAlign(Value: TAlign); virtual; procedure SetAnchors(const AValue: TAnchors); virtual; procedure SetAutoSize(const Value : Boolean); virtual; procedure BoundsChanged; dynamic; - procedure DoConstraintsChange(Sender : TObject); virtual; + procedure DoConstraintsChange(Sender: TObject); virtual; + procedure DoBorderSpacingChange(Sender: TObject); virtual; procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); virtual; - procedure Changed; + procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize); virtual; + procedure DoOnResize; virtual; + procedure DoOnChangeBounds; virtual; + procedure Resize; virtual; + procedure RequestAlign; dynamic; + procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize, + UseLoadedValues: boolean); virtual; + procedure LockBaseBounds; + procedure UnlockBaseBounds; + procedure UpdateAnchorRules; + procedure ChangeBounds(ALeft, ATop, AWidth, AHeight : integer); virtual; + procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); virtual; + procedure ChangeScale(M,D : Integer); dynamic; + Function CanAutoSize(var NewWidth, NewHeight : Integer): Boolean; virtual; + procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual; + protected + // protected messages procedure WMLButtonDown(Var Message: TLMLButtonDown); message LM_LBUTTONDOWN; procedure WMRButtonDown(Var Message: TLMRButtonDown); message LM_RBUTTONDOWN; procedure WMMButtonDown(Var Message: TLMMButtonDown); message LM_MBUTTONDOWN; @@ -758,22 +840,10 @@ type procedure CMParentColorChanged(var Message : TLMessage); message CM_PARENTCOLORCHANGED; procedure CMParentShowHintChanged(var Message : TLMessage); message CM_PARENTSHOWHINTCHANGED; procedure CMVisibleChanged(var Message : TLMessage); message CM_VISIBLECHANGED; - procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize); virtual; + procedure Changed; function GetPalette: HPalette; virtual; - procedure DoOnResize; virtual; - procedure DoOnChangeBounds; virtual; - procedure Resize; virtual; procedure Loaded; override; procedure AssignTo(Dest: TPersistent); override; - procedure RequestAlign; dynamic; - procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize, - UseLoadedValues: boolean); virtual; - procedure LockBaseBounds; - procedure UnlockBaseBounds; - procedure UpdateAnchorRules; - procedure ChangeBounds(ALeft, ATop, AWidth, AHeight : integer); virtual; - procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); virtual; - procedure ChangeScale(M,D : Integer); dynamic; procedure BeginAutoDrag; dynamic; procedure DoEndDock(Target: TObject; X, Y: Integer); dynamic; procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); dynamic; @@ -809,7 +879,6 @@ type procedure MouseMove(Shift: TShiftState; X,Y: Integer); Dynamic; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); dynamic; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - Function CanAutoSize(var NewWidth, NewHeight : Integer): Boolean; virtual; Function CanTab: Boolean; virtual; Function Focused : Boolean; dynamic; Procedure SetFocus; virtual; @@ -822,7 +891,6 @@ type Function GetEnabled: Boolean; virtual; Function GetPopupMenu: TPopupMenu; dynamic; procedure DoOnShowHint(HintInfo: Pointer); - procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual; procedure VisibleChanging; dynamic; procedure AddControlHandler(HandlerType: TControlHandlerType; AMethod: TMethod; AsLast: boolean); @@ -831,12 +899,13 @@ type procedure DoContextPopup(const MousePos: TPoint; var Handled: Boolean); virtual; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; protected + // optional properties (not every descendent supports them) property ActionLink: TControlActionLink read FActionLink write FActionLink; property AutoSize: Boolean read FAutoSize write SetAutoSize default FALSE; + property Ctl3D: Boolean read FCtl3D write FCtl3D;//Is this needed for anything other than compatability? property DragCursor: TCursor read FDragCursor write SetDragCursor default crDrag; property DragKind: TDragKind read FDragKind write FDragKind default dkDrag; property DragMode: TDragMode read fDragMode write SetDragMode default dmManual; - property IsControl: Boolean read FIsControl write FIsControl; property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture; property ParentFont: Boolean read FParentFont write FParentFont; property ParentColor: Boolean read FParentColor write SetParentColor; @@ -895,8 +964,8 @@ type Function Dragging : Boolean; procedure Show; procedure Update; virtual; - procedure SetZOrderPosition(Position : Integer); virtual; - Procedure SetZOrder(Topmost: Boolean); virtual; + procedure SetZOrderPosition(NewPosition: Integer); virtual; + Procedure SetZOrder(TopMost: Boolean); virtual; function HandleObjectShouldBeVisible: boolean; virtual; procedure InitiateAction; virtual; public @@ -908,9 +977,11 @@ type AsLast: boolean); procedure RemoveHandlerOnChangeBounds(OnChangeBoundsEvent: TNotifyEvent); public + // standard properties, which should be supported by all descendents property Anchors: TAnchors read FAnchors write SetAnchors default [akLeft,akTop]; property Action: TBasicAction read GetAction write SetAction; property Align: TAlign read FAlign write SetAlign; + property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing; property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; property Caption: TCaption read GetText write SetText stored IsCaptionStored; property ClientOrigin: TPoint read GetClientOrigin; @@ -921,9 +992,13 @@ type property ControlState: TControlState read FControlState write FControlState; property ControlStyle: TControlStyle read FControlStyle write FControlStyle; property Color: TColor read FColor write SetColor stored ColorIsStored default clWindow; - property Ctl3D: Boolean read FCtl3D write FCtl3D;//Is this needed for anything other than compatability? property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True; property Font: TFont read FFont write SetFont stored IsFontStored; + property IsControl: Boolean read FIsControl write FIsControl; + property OnResize: TNotifyEvent read FOnResize write FOnResize; + property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds; + property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; + property OnShowHint: TControlShowHintEvent read FOnShowHint write FOnShowHint; property Parent: TWinControl read FParent write SetParent; property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu; property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False; @@ -941,11 +1016,6 @@ type property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight; property UndockHeight: Integer read GetUndockHeight write FUndockHeight; property UndockWidth: Integer read GetUndockWidth write FUndockWidth; - public - property OnResize: TNotifyEvent read FOnResize write FOnResize; - property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds; - property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; - property OnShowHint: TControlShowHintEvent read FOnShowHint write FOnShowHint; published property Cursor: TCursor read FCursor write SetCursor default crDefault; property Left: Integer read FLeft write SetLeft; @@ -975,6 +1045,140 @@ type TGetChildProc = procedure(Child: TComponent) of Object; + { TControlChildSizing } + + { LeftRightSpacing, TopBottomSpacing: integer; + minimum space between left client border and left most childs. + For example: ClientLeftRight=5 means childs Left position is at least 5. + + HorizontalSpacing, VerticalSpacing: integer; + minimum space between each child horizontally + } + + { Defines how child controls are resized/aligned. + + cesAnchorAligning, cssAnchorAligning + Anchors and Align work like Delphi. For example if Anchors property of + the control is [akLeft], it means fixed distance between left border of + parent's client area. [akRight] means fixed distance between right + border of the control and the right border of the parent's client area. + When the parent is resized the child is moved to keep the distance. + [akLeft,akRight] means fixed distance to left border and fixed distance + to right border. When the parent is resized, the controls width is + changed (resized) to keep the left and right distance. + Same for akTop,akBottom. + + Align=alLeft for a control means set Left leftmost, Top topmost and + maximize Height. The width is kept, if akRight is not set. If akRight + is set in the Anchors property, then the right distance is kept and + the control's width is resized. + If there several controls with Align=alLeft, they will not overlapp and + be put side by side. + Same for alRight, alTop, alBottom. (Always expand 3 sides). + + Align=alClient. The control will fill the whole remaining space. + Setting two childs to Align=alClient does only make sense, if you set + maximum Constraints. + + Order: First all alTop childs are resized, then alBottom, then alLeft, + then alRight and finally alClient. + + cesScaleChilds, cssScaleChilds + Scale childs, keep space between them fixed. + Childs are resized to their normal/adviced size. If there is some space + left in the client area of the parent, then the childs are scaled to + fill the space. You can set maximum Constraints. Then the other childs + are scaled more. + For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and + C.Width=30 (total=60). If the Parent's client area has a ClientWidth of + 120, then the childs are scaled with Factor 2. + If B has a maximum constraint width of 30, then first the childs will be + scaled with 1.5 (A.Width=15, B.Width=30, C.Width=45). Then A and C + (15+45=60 and 30 pixel space left) will be scaled by 1.5 again, to a + final result of: A.Width=23, B.Width=30, C.Width=67 (23+30+67=120). + + cesHomogenousChildGrowth, cssHomogenousChildDecrease + Enlarge childs equally. + Childs are resized to their normal/adviced size. If there is some space + left in the client area of the parent, then the remaining space is + distributed equally to each child. + For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and + C.Width=30 (total=60). If the Parent's client area has a ClientWidth of + 120, then 60/3=20 is added to each Child. + If B has a maximum constraint width of 30, then first 10 is added to + all childs (A.Width=20, B.Width=30, C.Width=40). Then A and C + (20+40=60 and 30 pixel space left) will get 30/2=15 additional, + resulting in: A.Width=35, B.Width=30, C.Width=55 (35+30+55=120). + + + cesHomogenousSpaceGrowth + Enlarge space between childs equally. + Childs are resized to their normal/adviced size. If there is some space + left in the client area of the parent, then the space between the childs + if expanded. + For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and + C.Width=30 (total=60). If the Parent's client area has a ClientWidth of + 120, then there will be 60/2=30 space between A and B and between + B and C. + } + + TChildControlEnlargeStyle = ( + cesAnchorAligning, // (like Delphi) + cesScaleChilds, // scale childs, keep space between childs fixed + cesHomogenousChildGrowth, // enlarge childs equally + cesHomogenousSpaceGrowth // enlarge space between childs equally + ); + TChildControlShrinkStyle = ( + cssAnchorAligning, // (like Delphi) + cssScaleChilds, // scale childs + cssHomogenousChildDecrease // shrink childs equally + ); + + TControlChildSizing = class(TPersistent) + private + FControl: TControl; + FEnlargeHorizontal: TChildControlEnlargeStyle; + FEnlargeVertical: TChildControlEnlargeStyle; + FHorizontalSpacing: integer; + FLeftRightSpacing: integer; + FOnChange: TNotifyEvent; + FShrinkHorizontal: TChildControlShrinkStyle; + FShrinkVertical: TChildControlShrinkStyle; + FTopBottomSpacing: integer; + FVerticalSpacing: integer; + procedure SetEnlargeHorizontal(const AValue: TChildControlEnlargeStyle); + procedure SetEnlargeVertical(const AValue: TChildControlEnlargeStyle); + procedure SetHorizontalSpacing(const AValue: integer); + procedure SetLeftRightSpacing(const AValue: integer); + procedure SetShrinkHorizontal(const AValue: TChildControlShrinkStyle); + procedure SetShrinkVertical(const AValue: TChildControlShrinkStyle); + procedure SetTopBottomSpacing(const AValue: integer); + procedure SetVerticalSpacing(const AValue: integer); + protected + procedure Change; dynamic; + public + constructor Create(OwnerControl: TControl); + procedure Assign(Source: TPersistent); override; + procedure AssignTo(Dest: TPersistent); override; + function IsEqual(Sizing: TControlChildSizing): boolean; + public + property Control: TControl read FControl; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property LeftRightSpacing: integer read FLeftRightSpacing write SetLeftRightSpacing; + property TopBottomSpacing: integer read FTopBottomSpacing write SetTopBottomSpacing; + property HorizontalSpacing: integer read FHorizontalSpacing write SetHorizontalSpacing; + property VerticalSpacing: integer read FVerticalSpacing write SetVerticalSpacing; + property EnlargeHorizontal: TChildControlEnlargeStyle read FEnlargeHorizontal + write SetEnlargeHorizontal default cesAnchorAligning; + property EnlargeVertical: TChildControlEnlargeStyle read FEnlargeVertical + write SetEnlargeVertical default cesAnchorAligning; + property ShrinkHorizontal: TChildControlShrinkStyle read FShrinkHorizontal + write SetShrinkHorizontal default cssAnchorAligning; + property ShrinkVertical: TChildControlShrinkStyle read FShrinkVertical + write SetShrinkVertical default cssAnchorAligning; + end; + { TWinControlActionLink } @@ -1008,6 +1212,7 @@ type FBoundsRealized: TRect; FBrush: TBrush; FAdjustClientRectRealized: TRect; + FChildSizing: TControlChildSizing; FControls: TList; FDefWndProc: Pointer; //FDockSite: Boolean; @@ -1047,6 +1252,7 @@ type function GetIsResizing: boolean; function GetTabOrder: TTabOrder; function GetVisibleDockClientCount: Integer; + procedure SetChildSizing(const AValue: TControlChildSizing); procedure SetDockSite(const AValue: Boolean); procedure SetHandle(NewHandle: HWND); Procedure SetBorderWidth(Value : TBorderWidth); @@ -1060,6 +1266,7 @@ type procedure AdjustSize; override; procedure AdjustClientRect(var Rect: TRect); virtual; procedure AlignControls(AControl : TControl; var ARect: TRect); virtual; + procedure DoChildSizingChange(Sender: TObject); virtual; Function CanTab: Boolean; override; Procedure CMDrag(var Message : TCMDrag); message CM_DRAG; procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED; @@ -1152,11 +1359,12 @@ type function IsControlMouseMsg(var TheMessage : TLMMouse): Boolean; procedure FontChanged(Sender: TObject); override; procedure SetColor(Value : TColor); override; - procedure SetZOrderPosition(Position: Integer); override; + procedure SetZOrderPosition(NewPosition: Integer); override; procedure SetZOrder(Topmost: Boolean); override; procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); override; public - property BorderWidth : TBorderWidth read FBorderWidth write SetBorderWidth default 0; + property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; + property ChildSizing: TControlChildSizing read FChildSizing write SetChildSizing; property DefWndProc: Pointer read FDefWndProc write FDefWndPRoc; property DockClientCount: Integer read GetDockClientCount; property DockClients[Index: Integer]: TControl read GetDockClients; @@ -1207,11 +1415,13 @@ type Procedure DisableAlign; Procedure EnableAlign; Procedure Invalidate; override; - Procedure RemoveControl(AControl : TControl); - Procedure InsertControl(AControl : TControl); - Procedure Insert(AControl : TControl); - Procedure Remove(AControl : TControl); - procedure SetBounds(aLeft, aTop, aWidth, aHeight : integer); override; + Procedure InsertControl(AControl: TControl); + Procedure InsertControl(AControl: TControl; Index: integer); + Procedure RemoveControl(AControl: TControl); + Procedure Insert(AControl: TControl); + Procedure Insert(AControl: TControl; Index: integer); + Procedure Remove(AControl: TControl); + procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override; procedure Hide; procedure Repaint; override; Procedure SetFocus; override; @@ -1887,6 +2097,204 @@ end; {$I mouse.inc} {$I dragobject.inc} +{ TControlBorderSpacing } + +procedure TControlBorderSpacing.SetAround(const AValue: TSpacingSize); +begin + if FAround=AValue then exit; + FAround:=AValue; + Change; +end; + +procedure TControlBorderSpacing.SetBottom(const AValue: TSpacingSize); +begin + if FBottom=AValue then exit; + FBottom:=AValue; + Change; +end; + +procedure TControlBorderSpacing.SetLeft(const AValue: TSpacingSize); +begin + if FLeft=AValue then exit; + FLeft:=AValue; + Change; +end; + +procedure TControlBorderSpacing.SetRight(const AValue: TSpacingSize); +begin + if FRight=AValue then exit; + FRight:=AValue; + Change; +end; + +procedure TControlBorderSpacing.SetTop(const AValue: TSpacingSize); +begin + if FTop=AValue then exit; + FTop:=AValue; + Change; +end; + +constructor TControlBorderSpacing.Create(OwnerControl: TControl); +begin + FControl:=OwnerControl; + inherited Create; +end; + +procedure TControlBorderSpacing.Assign(Source: TPersistent); +var + SrcSpacing: TControlBorderSpacing; +begin + if Source is TControlBorderSpacing then begin + SrcSpacing:=TControlBorderSpacing(Source); + if IsEqual(SrcSpacing) then exit; + + FAround:=SrcSpacing.Around; + FBottom:=SrcSpacing.Bottom; + FLeft:=SrcSpacing.Left; + FRight:=SrcSpacing.Right; + FTop:=SrcSpacing.Top; + + Change; + end else + inherited Assign(Source); +end; + +procedure TControlBorderSpacing.AssignTo(Dest: TPersistent); +begin + Dest.Assign(Self); +end; + +function TControlBorderSpacing.IsEqual(Spacing: TControlBorderSpacing + ): boolean; +begin + Result:=(FAround=Spacing.Around) + and (FBottom=Spacing.Bottom) + and (FLeft=Spacing.Left) + and (FRight=Spacing.Right) + and (FTop=Spacing.Top); +end; + +procedure TControlBorderSpacing.Change; +begin + if Assigned(FOnChange) then FOnChange(Self); +end; + +{ TControlChildSizing } + +procedure TControlChildSizing.SetEnlargeHorizontal( + const AValue: TChildControlEnlargeStyle); +begin + if FEnlargeHorizontal=AValue then exit; + FEnlargeHorizontal:=AValue; + Change; +end; + +procedure TControlChildSizing.SetEnlargeVertical( + const AValue: TChildControlEnlargeStyle); +begin + if FEnlargeVertical=AValue then exit; + FEnlargeVertical:=AValue; + Change; +end; + +procedure TControlChildSizing.SetHorizontalSpacing(const AValue: integer); +begin + if FHorizontalSpacing=AValue then exit; + FHorizontalSpacing:=AValue; + Change; +end; + +procedure TControlChildSizing.SetLeftRightSpacing(const AValue: integer); +begin + if FLeftRightSpacing=AValue then exit; + FLeftRightSpacing:=AValue; + Change; +end; + +procedure TControlChildSizing.SetShrinkHorizontal( + const AValue: TChildControlShrinkStyle); +begin + if FShrinkHorizontal=AValue then exit; + FShrinkHorizontal:=AValue; + Change; +end; + +procedure TControlChildSizing.SetShrinkVertical( + const AValue: TChildControlShrinkStyle); +begin + if FShrinkVertical=AValue then exit; + FShrinkVertical:=AValue; + Change; +end; + +procedure TControlChildSizing.SetTopBottomSpacing(const AValue: integer); +begin + if FTopBottomSpacing=AValue then exit; + FTopBottomSpacing:=AValue; + Change; +end; + +procedure TControlChildSizing.SetVerticalSpacing(const AValue: integer); +begin + if FVerticalSpacing=AValue then exit; + FVerticalSpacing:=AValue; + Change; +end; + +constructor TControlChildSizing.Create(OwnerControl: TControl); +begin + FControl:=OwnerControl; + inherited Create; + FEnlargeHorizontal:=cesAnchorAligning; + FEnlargeVertical:=cesAnchorAligning; + FShrinkHorizontal:=cssAnchorAligning; + FShrinkVertical:=cssAnchorAligning; +end; + +procedure TControlChildSizing.Assign(Source: TPersistent); +var + SrcSizing: TControlChildSizing; +begin + if Source is TControlChildSizing then begin + SrcSizing:=TControlChildSizing(Source); + if IsEqual(SrcSizing) then exit; + + FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal; + FEnlargeVertical:=SrcSizing.EnlargeVertical; + FShrinkHorizontal:=SrcSizing.ShrinkHorizontal; + FShrinkVertical:=SrcSizing.ShrinkVertical; + FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal; + FEnlargeVertical:=SrcSizing.EnlargeVertical; + FShrinkHorizontal:=SrcSizing.ShrinkHorizontal; + FShrinkVertical:=SrcSizing.ShrinkVertical; + + Change; + end else + inherited Assign(Source); +end; + +procedure TControlChildSizing.AssignTo(Dest: TPersistent); +begin + Dest.Assign(Self); +end; + +function TControlChildSizing.IsEqual(Sizing: TControlChildSizing): boolean; +begin + Result:=(FEnlargeHorizontal=Sizing.EnlargeHorizontal) + and (FEnlargeVertical=Sizing.EnlargeVertical) + and (FShrinkHorizontal=Sizing.ShrinkHorizontal) + and (FShrinkVertical=Sizing.ShrinkVertical) + and (FEnlargeHorizontal=Sizing.EnlargeHorizontal) + and (FEnlargeVertical=Sizing.EnlargeVertical) + and (FShrinkHorizontal=Sizing.ShrinkHorizontal) + and (FShrinkVertical=Sizing.ShrinkVertical); +end; + +procedure TControlChildSizing.Change; +begin + if Assigned(FOnChange) then FOnChange(Self); +end; + initialization //writeln('controls.pp - initialization'); @@ -1904,6 +2312,9 @@ end. { ============================================================================= $Log$ + Revision 1.175 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.174 2004/02/12 18:09:10 mattias removed win32 specific TToolBar code in new TToolBar, implemented TWinControl.FlipChildren diff --git a/lcl/include/control.inc b/lcl/include/control.inc index e725a6c8e5..8479d4c0ed 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -757,6 +757,11 @@ begin AdjustSize; end; +procedure TControl.DoBorderSpacingChange(Sender: TObject); +begin + AdjustSize; +end; + {------------------------------------------------------------------------------ procedure TControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean); ------------------------------------------------------------------------------} @@ -1367,6 +1372,12 @@ begin MouseUp(Button, KeysToShiftState(Keys), XPos, YPos); end; +procedure TControl.SetBorderSpacing(const AValue: TControlBorderSpacing); +begin + if FBorderSpacing=AValue then exit; + FBorderSpacing.Assign(AValue); +end; + {------------------------------------------------------------------------------ Method: TControl.WMLButtonDown Params: Message @@ -2344,24 +2355,23 @@ end; { TControl.SetZOrder } {------------------------------------------------------------------------------} -Procedure TControl.SetZOrder(Topmost : Boolean); -var AParent : TWinControl; - AControl : TControl; +Procedure TControl.SetZOrder(Topmost: Boolean); begin -//if FParent <> nil then -// if Topmost then SetZOrderPosition(FParent.FControls.Count-1) -// else -// SetZOrderPosition(0); - if Parent <> nil then begin + if FParent = nil then exit; + if Topmost then + SetZOrderPosition(Parent.ControlCount-1) + else + SetZOrderPosition(0); + {if Parent <> nil then begin AParent:= Parent; - { Just reinsert the control on top. Don't if it already is } + Just reinsert the control on top. Don't if it already is if Topmost then begin if (AParent.Controls[AParent.ControlCount - 1] <> Self) then begin AParent.RemoveControl(Self); AParent.InsertControl(Self); end; end else begin - { Move all other controls over this one } + // Move all other controls over this one if (AParent.Controls[0] <> Self) then begin AParent.RemoveControl(Self); AParent.InsertControl(Self); @@ -2372,7 +2382,7 @@ begin end; end; end; - end; + end; } end; {------------------------------------------------------------------------------ @@ -2449,27 +2459,32 @@ begin end; {------------------------------------------------------------------------------ - TControl.SetZOrderPosition + TControl.SetZOrderPosition + + Set the position of the child control in the Controls list of its parent. + TWinControl overrides this and will position itself in the FWinControls + while this function position itself in the FControls list. + + Notes: + The FControls are always below the FWinControls. + TWinControl overrides this and will position itself in the FWinControls + list. ------------------------------------------------------------------------------} -Procedure TControl.SetZOrderPosition(Position: Integer); +Procedure TControl.SetZOrderPosition(NewPosition: Integer); Var - I : Integer; - Count : Integer; + OldPosition: Integer; + Count: Integer; begin - if FParent <> nil then - Begin - I := FParent.FControls.Indexof(self); - if I >= 0 then - begin - Count := FParent.FControls.Count; - if Position < 0 then Position := 0; - if Position >= Count then Position := Count-1; - if Position <> I then - begin - FParent.FControls.Delete(i); - FParent.FControls.Insert(Position,Self); - InvalidateControl(Visible,True,True); - end; + if Parent = nil then exit; + OldPosition := FParent.FControls.IndexOf(self); + if (OldPosition >= 0) then + begin + Count := FParent.FControls.Count; + if NewPosition < 0 then NewPosition := 0; + if NewPosition >= Count then NewPosition := Count-1; + if NewPosition <> OldPosition then begin + FParent.FControls.Move(OldPosition,NewPosition); + InvalidateControl(Visible,True,True); end; end; end; @@ -2542,6 +2557,7 @@ begin Application.ControlDestroyed(Self); SetParent(nil); FreeThenNil(FActionLink); + FreeThenNil(FBorderSpacing); FreeThenNil(FConstraints); FreeThenNil(FFont); //writeln('[TControl.Destroy] B ',Name,':',ClassName); @@ -2568,6 +2584,8 @@ begin csOpaque]; FConstraints:= TSizeConstraints.Create(Self); FConstraints.OnChange:= @DoConstraintsChange; + FBorderSpacing:=TControlBorderSpacing.Create(Self); + FBorderSpacing.OnChange:= @DoBorderSpacingChange; FAnchors := [akLeft,akTop]; FAlign := alNone; @@ -2735,6 +2753,9 @@ end; { ============================================================================= $Log$ + Revision 1.168 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.167 2004/02/04 23:30:18 mattias completed TControl actions diff --git a/lcl/include/controlsproc.inc b/lcl/include/controlsproc.inc index 923caa588f..a600bb653f 100644 --- a/lcl/include/controlsproc.inc +++ b/lcl/include/controlsproc.inc @@ -1,3 +1,5 @@ +// included by controls.pp + { ***************************************************************************** * * @@ -27,25 +29,24 @@ End; Function ListIndexOf(var List : TList; Item: Pointer) : Longint; Begin Result := -1; - if List = nil then exit; - Result := List.IndexOf(Item); + if List <> nil then Result := List.IndexOf(Item); End; Function ListCount(List : TList) : Longint; Begin Result := 0; - if List = nil then exit; - Result := List.Count; + if List <> nil then Result := List.Count; End; Procedure ListRemove(var List : TList; Item: Pointer); Begin if List=nil then exit; List.Remove(Item); - if List.Count = 0 then - Begin - List.Free; - List := nil; - End; - + if List.Count = 0 then begin + List.Free; + List := nil; + End; End; + +// included by controls.pp + diff --git a/lcl/include/sizeconstraints.inc b/lcl/include/sizeconstraints.inc index a0d691fc36..79db6373d1 100644 --- a/lcl/include/sizeconstraints.inc +++ b/lcl/include/sizeconstraints.inc @@ -169,6 +169,12 @@ begin end; end; +procedure TSizeConstraints.SetOptions(const AValue: TSizeConstraintsOptions); +begin + if FOptions=AValue then exit; + FOptions:=AValue; +end; + {------------------------------------------------------------------------------ Method: TSizeConstraints.Change Params: none diff --git a/lcl/include/toolbutton.inc b/lcl/include/toolbutton.inc index 0ede72a4df..a1e1d1b1b9 100644 --- a/lcl/include/toolbutton.inc +++ b/lcl/include/toolbutton.inc @@ -168,19 +168,6 @@ begin inherited Paint; end; -procedure TToolButton.ChangeBounds(NewLeft, NewTop, NewWidth, NewHeight: Integer); -begin - if ((NewLeft=Left) and (NewTop=Top) and (NewWidth=Width) and (NewHeight=Height)) - or (FUpdateCount>0) or ([csLoading,csDestroying]*ComponentState<>[]) - or (FToolBar=nil) or (not FToolBar.HandleAllocated) then - begin - inherited ChangeBounds(NewLeft, NewTop, NewWidth, NewHeight); - exit; - end; - - // ToDo -end; - function TToolButton.CalculateButtonState: Word; begin Result := 0; @@ -338,7 +325,6 @@ end; procedure TToolButton.EndUpdate; begin Dec(FUpdateCount); - // ToDo: update changed end; function TToolButton.GetIndex: Integer; @@ -356,7 +342,7 @@ end; procedure TToolButton.RefreshControl; begin - UpdateVisibleToolbar; + UpdateControl; end; procedure TToolButton.UpdateControl; @@ -902,6 +888,9 @@ end; { $Log$ + Revision 1.8 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.7 2004/02/12 18:09:10 mattias removed win32 specific TToolBar code in new TToolBar, implemented TWinControl.FlipChildren diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index b7ec52ad1f..7f1b66166e 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -519,6 +519,11 @@ begin if Showing then AdjustSize; end; +procedure TWinControl.DoChildSizingChange(Sender: TObject); +begin + AdjustSize; +end; + Procedure TWinControl.DoAutoSize; var I : Integer; @@ -965,13 +970,13 @@ const var i: integer; begin - if FParent <> nil then - begin + if FParent <> nil then begin if TopMost then i := FParent.FWinControls.Count - 1 else i := 0; - if FParent.FControls <> nil then inc(i, FParent.FControls.Count); + if FParent.FControls <> nil then + inc(i, FParent.FControls.Count); SetZOrderPosition(i); end else if HandleAllocated then begin @@ -1024,16 +1029,6 @@ begin end; WindowProc(TLMessage(MoveMsg)); end; -{// Flags := SWP_NOZORDER or SWP_NOACTIVATE; - Flags := $14; - if not SizeChanged then -// Flags := Flags or SWP_NOSIZE - Flags := Flags or $1 - else - // if not PosChanged then -// Flags := Flags or SWP_NOMOVE; - Flags := Flags or $2; - SetWindowPos(Handle, 0, FLeft, FTop, FWidth, FHeight, Flags);} end; {------------------------------------------------------------------------------} @@ -1078,38 +1073,39 @@ begin end; {------------------------------------------------------------------------------- - procedure TWinControl.SetZOrderPosition(Position: Integer); + procedure TWinControl.SetZOrderPosition(NewPosition: Integer); -------------------------------------------------------------------------------} -procedure TWinControl.SetZOrderPosition(Position: Integer); +procedure TWinControl.SetZOrderPosition(NewPosition: Integer); var - I, Count: Integer; + OldPosition, Count: Integer; Pos: HWND; begin if FParent <> nil then begin if FParent.FControls <> nil then - Dec(Position, FParent.FControls.Count); - I := FParent.FWinControls.IndexOf(Self); - if I >= 0 then + Dec(NewPosition, FParent.FControls.Count); + OldPosition := FParent.FWinControls.IndexOf(Self); + if OldPosition >= 0 then begin Count := FParent.FWinControls.Count; - if Position < 0 then Position := 0; - if Position >= Count then Position := Count - 1; - if Position <> I then + if NewPosition < 0 then NewPosition := 0; + if NewPosition >= Count then NewPosition := Count - 1; + if NewPosition <> OldPosition then begin - FParent.FWinControls.Delete(I); - FParent.FWinControls.Insert(Position, Self); + FParent.FWinControls.Move(OldPosition,NewPosition); end; end; if HandleAllocated then begin - if Position = 0 then Pos := HWND_BOTTOM - else if Position = FParent.FWinControls.Count - 1 then Pos := HWND_TOP - else if Position > I then - Pos := TWinControl(FParent.FWinControls[Position + 1]).Handle - else if Position < I then - Pos := TWinControl(FParent.FWinControls[Position]).Handle + if NewPosition = 0 then + Pos := HWND_BOTTOM + else if NewPosition = FParent.FWinControls.Count - 1 then + Pos := HWND_TOP + else if NewPosition > OldPosition then + Pos := TWinControl(FParent.FWinControls[NewPosition + 1]).Handle + else if NewPosition < OldPosition then + Pos := TWinControl(FParent.FWinControls[NewPosition]).Handle else Exit; SetWindowPos(Handle, Pos, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE); end; @@ -1693,37 +1689,34 @@ end; -------------------------------------------------------------------------------} procedure TWinControl.SetControlIndex(AControl: TControl; NewIndex: integer); begin - if AControl<>nil then - AControl.SetZOrderPosition(NewIndex); + if AControl=nil then exit; + AControl.SetZOrderPosition(NewIndex); end; {------------------------------------------------------------------------------} { TWinControl DestroyHandle } {------------------------------------------------------------------------------} procedure TWinControl.DestroyHandle; -var i : integer; +var + i: integer; + AWinControl: TWinControl; begin if not HandleAllocated then begin writeln('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle not Allocated'); - // create an gdb catchable exception: - // if (length(Name) div (length(Name) div 10000))=0 then ; + //RaiseGDBException(''); end; - { Destroy all children handles, too } - { If we don't do that, GTK does this without notification for us and we crash } - { TODO : We can enable HandleAllocated condition only when all controls, especially - TNotebook / TPage set their Handles correctly, i.e. mirror the GTK behavior } -// if HandleAllocated then begin - if FWinControls <> nil then begin - for i:= 0 to FWinControls.Count - 1 do begin - //writeln(' i=',i); - //writeln(' ',TWinControl(FWinControls[i]).Name,':',TWinControl(FWinControls[i]).ClassName); - if TWinControl(FWinControls[i]).HandleAllocated then - TWinControl(FWinControls[i]).DestroyHandle; - end; + // First destroy all children handles + if FWinControls <> nil then begin + for i:= 0 to FWinControls.Count - 1 do begin + //writeln(' i=',i); + //writeln(' ',TWinControl(FWinControls[i]).Name,':',TWinControl(FWinControls[i]).ClassName); + AWinControl:=TWinControl(FWinControls[i]); + if AWinControl.HandleAllocated then + AWinControl.DestroyHandle; end; - DestroyWnd; -// end; + end; + DestroyWnd; end; {------------------------------------------------------------------------------ @@ -2133,31 +2126,41 @@ end; {------------------------------------------------------------------------------} procedure TWinControl.Insert(AControl : TControl); begin - if AControl <> nil then - begin - if AControl = Self - then begin - Assert(False, 'Trace:[TControl.SetParent] EInvalidOperation --> AControl = Self'); - raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent); - end; - - if AControl is TWinControl then - begin - ListAdd(FWinControls, AControl); - ListAdd(FTabList, AControl); - end else - ListAdd(FControls, AControl); - - AControl.FParent := Self; - - If (csDesigning in ComponentState) - and not (csLoading in ComponentState) - then - If AControl.CanTab then - AControl.TabStop := True; - end; + Insert(AControl,ControlCount); End; +{------------------------------------------------------------------------------ + procedure TWinControl.Insert(AControl: TControl; Index: integer); +------------------------------------------------------------------------------} +procedure TWinControl.Insert(AControl: TControl; Index: integer); +begin + if AControl = nil then exit; + + if AControl = Self then + raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent); + + if AControl is TWinControl then + begin + if (FControls<>nil) then dec(Index,FControls.Count); + if (FWinControls<>nil) and (Indexnil) and (Indexnil then begin - LCLObject:=GetParentLCLObject(FocusedWidget); + LCLObject:=GetNearestLCLObject(FocusedWidget); if LCLObject is TWinControl then begin FocusedWinControl:=TWinControl(LCLObject); if FocusedWidget<>Widget then begin @@ -1419,8 +1419,9 @@ begin if not ControlGetsMouseDownBefore(TControl(Data)) then exit; // grabbing for TSplitter -> Maybe ths is the key for drag&drop - if TWinControl(Data) is TCustomSplitter then begin - CaptureWidget:=PGtkWidget(TCustomSplitter(Data).Handle); + CaptureWidget:=PGtkWidget(TWinControl(Data).Handle); + if (GtkWidgetIsA(CaptureWidget,GTKAPIWidget_GetType)) + or (TWinControl(Data) is TCustomSplitter) then begin CaptureWidget:=GetWidgetInfo(CaptureWidget,true)^.ImplementationWidget; if not gtk_widget_has_focus(CaptureWidget) then gtk_widget_grab_focus(CaptureWidget); @@ -1586,8 +1587,9 @@ begin if not (csDesigning in TComponent(Data).ComponentState) then begin DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease); - if TWinControl(Data) is TCustomSplitter then begin - CaptureWidget:=PGtkWidget(TCustomSplitter(Data).Handle); + CaptureWidget:=PGtkWidget(TWinControl(Data).Handle); + if GtkWidgetIsA(CaptureWidget,GTKAPIWidget_GetType) + or (TWinControl(Data) is TCustomSplitter) then begin CaptureWidget:=GetWidgetInfo(CaptureWidget,true)^.ImplementationWidget; if Event^.button=1 then gtk_grab_remove(CaptureWidget); @@ -3069,6 +3071,9 @@ end; { ============================================================================= $Log$ + Revision 1.219 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.218 2004/02/07 18:04:14 mattias fixed grids OnDrawCells diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 655ca48644..e6dbbfeeb8 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -4930,7 +4930,7 @@ begin // if one of its widgets has the focus then unfocus GtkWindow:=gtk_widget_get_toplevel(Widget); if GtkWidgetIsA(GtkWindow,GTK_TYPE_WINDOW) - and (GetParentLCLObject(PGtkWindow(GtkWindow)^.Focus_Widget)=Sender) + and (GetNearestLCLObject(PGtkWindow(GtkWindow)^.Focus_Widget)=Sender) then begin gtk_window_set_focus(PGtkWindow(GtkWindow),nil); end; @@ -9201,6 +9201,9 @@ end; { ============================================================================= $Log$ + Revision 1.468 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.467 2004/02/12 18:09:10 mattias removed win32 specific TToolBar code in new TToolBar, implemented TWinControl.FlipChildren diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 3325a9bb0c..4b6e2de25e 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -605,7 +605,7 @@ begin Result:=HexStr(Cardinal(Widget),8); if Widget=nil then exit; Result:=Result+'='+GetWidgetClassName(Widget); - LCLObject:=GetParentLCLObject(Widget); + LCLObject:=GetNearestLCLObject(Widget); Result:=Result+' LCLObject='+HexStr(Cardinal(LCLObject),8); if LCLObject=nil then exit; if LCLObject is TControl then @@ -720,7 +720,7 @@ var IsAPIWidget: Boolean; begin MainWidget:=ChildWidget; - LCLObject:=GetParentLCLObject(ChildWidget); + LCLObject:=GetNearestLCLObject(ChildWidget); if (LCLObject is TWinControl) then MainWidget:=PGtkWidget(TWinControl(LCLObject).Handle); IsAPIWidget:=GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType); @@ -2716,26 +2716,27 @@ begin RaiseInvalidFixedWidget; end; -function GetParentWidget(Child: PGtkWidget): PGtkWidget; +function GetWinControlWidget(Child: PGtkWidget): PGtkWidget; +// return the first widget, which is associated with a TWinControl handle var LCLParent: TObject; begin Result:=nil; - LCLParent:=GetParentLCLObject(Child); + LCLParent:=GetNearestLCLObject(Child); if (LCLParent=nil) or (not (LCLParent is TWinControl)) or (not TWinControl(LCLParent).HandleAllocated) then exit; Result:=PGtkWidget(TWinControl(LCLParent).Handle); end; -function GetParentFixedWidget(Child: PGtkWidget): PGtkWidget; +function GetWinControlFixedWidget(Child: PGtkWidget): PGtkWidget; begin - Result:=GetParentWidget(Child); + Result:=GetWinControlWidget(Child); if Result=nil then exit; Result:=GetFixedWidget(Result); end; -function FindFixedChild(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList; +function FindFixedChildListItem(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList; begin Result:=ParentFixed^.children; while (Result<>nil) do begin @@ -2745,11 +2746,23 @@ begin end; end; +function FindFixedLastChildListItem(ParentFixed: PGtkFixed): PGList; +begin + Result:=g_list_last(ParentFixed^.children); +end; + +{------------------------------------------------------------------------------ + procedure MoveGListLinkBehind(First, Item, After: PGList); + + Move the list item 'Item' behind the list item 'After'. + If After=nil then insert as first item. +------------------------------------------------------------------------------} procedure MoveGListLinkBehind(First, Item, After: PGList); var Data: Pointer; NewPos: Integer; begin + if (Item=After) or (Item^.Next=After) then exit; if (g_list_position(First,Item)<0) then RaiseException('MoveGListLinkBehind Item not found'); if (After<>nil) and (g_list_position(First,After)<0) then @@ -2947,7 +2960,7 @@ begin Result := TObject(gtk_object_get_data(Widget, 'Class')); end; -function GetParentLCLObject(Widget: PGtkWidget): TObject; +function GetNearestLCLObject(Widget: PGtkWidget): TObject; begin while (Widget<>nil) do begin Result:=GetLCLObject(Widget); @@ -6307,6 +6320,9 @@ end; { ============================================================================= $Log$ + Revision 1.259 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.258 2004/02/08 11:31:32 mattias TMenuItem.Bitmap is now auto created on read. Added TMenuItem.HasBitmap diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index a48aef70be..f23f9a03f8 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -290,12 +290,13 @@ procedure FreeWinWidgetInfo(Widget: Pointer); procedure DestroyWidget(Widget: PGtkWidget); procedure SetLCLObject(const Widget: Pointer; const AnObject: TObject); function GetLCLObject(const Widget: Pointer): TObject; -function GetParentLCLObject(Widget: PGtkWidget): TObject; +function GetNearestLCLObject(Widget: PGtkWidget): TObject; procedure SetHiddenLCLObject(const Widget: Pointer; const AnObject: TObject); function GetHiddenLCLObject(const Widget: Pointer): TObject; -function GetParentWidget(Child: PGtkWidget): PGtkWidget; -function GetParentFixedWidget(Child: PGtkWidget): PGtkWidget; -function FindFixedChild(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList; +function GetWinControlWidget(Child: PGtkWidget): PGtkWidget; +function GetWinControlFixedWidget(Child: PGtkWidget): PGtkWidget; +function FindFixedChildListItem(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList; +function FindFixedLastChildListItem(ParentFixed: PGtkFixed): PGList; // fixed widgets Procedure FixedMoveControl(Parent, Child : PGTKWIdget; Left, Top : Longint); diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 78748b3354..41bd46cb0c 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -132,7 +132,7 @@ var begin {$IFDEF Gtk1} Widget:=PGtkWidget(Handle); - TargetObject:=GetParentLCLObject(Widget); + TargetObject:=GetNearestLCLObject(Widget); IsDoubleBuffered:=(TargetObject is TWinControl) and TWinControl(TargetObject).DoubleBuffered; // check if Handle is the paint widget of the LCL component @@ -7837,7 +7837,7 @@ begin if (Screen<>nil) and (Screen.FocusedForm<>nil) and (fsModal in Screen.FocusedForm.FormState) - and (GetParentLCLObject(TopLevel)<>Screen.FocusedForm) then begin + and (GetNearestLCLObject(TopLevel)<>Screen.FocusedForm) then begin {$IFDEF VerboseFocus} writeln('[TgtkObject.SetFocus] there is a modal form -> not grabbing'); {$ENDIF} @@ -8146,17 +8146,80 @@ end; function TgtkObject.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): Boolean; + hWnd: Widget to move + hWndInsertAfter: + HWND_BOTTOM to move bottommost + HWND_TOP to move topmost + the Widget, that should ly just on top of hWnd + uFlags: + SWP_NOMOVE: ignore X, Y + SWP_NOSIZE: ignore cx, cy + SWP_NOZORDER: ignore hWndInsertAfter + SWP_NOREDRAW: skip instant redraw + SWP_NOACTIVATE: skip switching focus + ------------------------------------------------------------------------------} function TgtkObject.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; uFlags: UINT): Boolean; -var Widget: PGTKWidget; - { FixedWidget: PGtkWidget; - OldListItem: PGList; - AfterWidget: PGtkWidget; - AfterListItem: PGList;} + + procedure SetZOrderOnFixedWidget(Widget, FixedWidget: PGtkWidget); + var + OldListItem: PGList; + AfterWidget: PGtkWidget; + AfterListItem: PGList; + begin + OldListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),Widget); + if OldListItem=nil then begin + writeln('TgtkObject.SetWindowPos WARNING: Widget not on parents fixed widget'); + exit; + end; + AfterWidget:=nil; + AfterListItem:=nil; + if hWndInsertAfter=HWND_BOTTOM then begin + // HWND_BOTTOM + end else if hWndInsertAfter=HWND_TOP then begin + // HWND_TOP + AfterListItem:=FindFixedLastChildListItem(PGtkFixed(FixedWidget)); + end else begin + // hWndInsertAfter + AfterWidget:=PGtkWidget(hWndInsertAfter); + AfterListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),AfterWidget); + end; + if (AfterListItem=nil) and (AfterWidget<>nil) then begin + writeln('TgtkObject.SetWindowPos WARNING: AfterWidget not on parents fixed widget'); + exit; + end; + if (OldListItem=AfterListItem) or (OldListItem^.next=AfterListItem) then + exit; + writeln('TgtkObject.SetWindowPos Moving GList entry'); + + // reorder + // This trick does not work properly + exit; + MoveGListLinkBehind(PGtkFixed(FixedWidget)^.children, + OldListItem,AfterListItem); + if GTK_WIDGET_VISIBLE(FixedWidget) and GTK_WIDGET_VISIBLE (Widget) + and GTK_WIDGET_MAPPED(Widget) then begin + gtk_widget_queue_resize(FixedWidget); + end; + end; + + procedure SetZOrderOnLayoutWidget(Widget, LayoutWidget: PGtkWidget); + begin + writeln('ToDO: SetZOrderOnLayoutWidget'); + end; + +var + Widget: PGTKWidget; + FixedWidget: PGtkWidget; begin - //writeln('[TgtkObject.SetWindowPos] Top=',hWndInsertAfter=HWND_TOP,' '); Widget:=PGtkWidget(hWnd); + writeln('[TgtkObject.SetWindowPos] ',GetWidgetDebugReport(Widget), + ' Top=',hWndInsertAfter=HWND_TOP, + ' SWP_NOZORDER=',(SWP_NOZORDER and uFlags)<>0, + ' SWP_NOSIZE=',(SWP_NOSIZE and uFlags)<>0, + ' SWP_NOMOVE=',(SWP_NOMOVE and uFlags)<>0, + ''); if GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then begin { case hWndInsertAfter of HWND_BOTTOM: ; //gdk_window_lower(Widget^.Window); @@ -8164,22 +8227,20 @@ begin //gdk_window_raise(Widget^.Window); end; } - end else begin - {AfterWidget:=PGtkWidget(hWndInsertAfter); - FixedWidget:=GetParentFixedWidget(Widget); + end else if (SWP_NOZORDER and uFlags)=0 then begin + FixedWidget:=Widget^.Parent; if FixedWidget=nil then exit; - OldListItem:=FindFixedChild(FixedWidget,Widget); - if OldListItem=nil then begin - writeln('TgtkObject.SetWindowPos WARNING: Widget not on parents fixed widget'); + + writeln('TgtkObject.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget)); + if GtkWidgetIsA(FixedWidget,GTK_Fixed_Get_Type) then begin + // parent's client area is a gtk_fixed widget + SetZOrderOnFixedWidget(Widget,FixedWidget); + exit; + end else if GtkWidgetIsA(FixedWidget,GTK_Layout_Get_Type) then begin + // parent's client area is a gtk_layout widget + SetZOrderOnLayoutWidget(Widget,FixedWidget); exit; end; - AfterListItem:=FindFixedChild(FixedWidget,AfterWidget); - if (AfterListItem=nil) and (AfterWidget<>nil) then begin - writeln('TgtkObject.SetWindowPos WARNING: AfterWidget not on parents fixed widget'); - exit; - end; - MoveGListLinkBehind(PGtkFixed(FixedWidget)^.children, - OldListItem,AfterListItem);} end; Result:=true; end; @@ -8682,6 +8743,9 @@ end; { ============================================================================= $Log$ + Revision 1.329 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.328 2004/02/10 00:05:03 mattias TSpeedButton now uses MaskBlt diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index fd0a8961c3..e9778f90de 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -704,9 +704,9 @@ const SWP_NOSIZE = 1; SWP_NOMOVE = 2; - SWP_NOZORDER = 3; - SWP_NOREDRAW = 4; - SWP_NOACTIVATE = 5; + SWP_NOZORDER = 4; + SWP_NOREDRAW = 8; + SWP_NOACTIVATE = $10; { WMSIZE Message Constants} Size_Restored = 0; // the default @@ -714,7 +714,7 @@ const Size_Maximized = 2; Size_MaxShow = 3; Size_MaxHide = 4; - Size_SourceIsInterface = 128; // this is flag. Can be combined with the above + Size_SourceIsInterface = 128; // this is a flag. Can be combined with the above SIZENORMAL = Size_Restored; SIZEICONIC = Size_Minimized; @@ -1983,6 +1983,9 @@ end. { $Log$ + Revision 1.58 2004/02/13 15:49:54 mattias + started advanced LCL auto sizing + Revision 1.57 2004/02/04 13:40:19 mattias ShortCutToText now deletes any modifier