From 00692af0eddad130e927b2d4444333f539e4c3eb Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 2 Oct 2005 09:46:55 +0000 Subject: [PATCH] started ChildSizing auto layouts for TWinControl git-svn-id: trunk@7882 - --- ide/lazarus.pp | 1 + lcl/controls.pp | 39 +++++++++++-- lcl/include/control.inc | 2 +- lcl/include/controlsproc.inc | 43 +++++++++++++++ lcl/include/customform.inc | 4 +- lcl/include/wincontrol.inc | 73 +++++++++++++++++++------ lcl/interfaces/gtk/gtkwscontrols.pp | 6 +- lcl/interfaces/win32/win32wscontrols.pp | 8 ++- lcl/widgetset/wscontrols.pp | 6 +- 9 files changed, 150 insertions(+), 32 deletions(-) diff --git a/ide/lazarus.pp b/ide/lazarus.pp index 6df4dc819a..493a2de15d 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -88,6 +88,7 @@ begin Application.Run; except debugln('lazarus.pp - unhandled exception'); + Halt; end; if (SplashForm<>nil) then begin SplashForm.Free; diff --git a/lcl/controls.pp b/lcl/controls.pp index 99922a5d7d..f1b280e0b1 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1281,6 +1281,12 @@ type cssScaleChilds, // scale childs cssHomogenousChildDecrease // shrink childs equally (i.e. by the same amount of pixel) ); + + TControlChildrenLayout = ( + cclNone, + cclLeftToRightThenTopToBottom, + cclTopToBottomThenLeftToRight + ); TControlChildSizing = class(TPersistent) private @@ -1288,15 +1294,19 @@ type FEnlargeHorizontal: TChildControlEnlargeStyle; FEnlargeVertical: TChildControlEnlargeStyle; FHorizontalSpacing: integer; + FLayout: TControlChildrenLayout; FLeftRightSpacing: integer; + FLines: integer; FOnChange: TNotifyEvent; FShrinkHorizontal: TChildControlShrinkStyle; FShrinkVertical: TChildControlShrinkStyle; FTopBottomSpacing: integer; FVerticalSpacing: integer; + procedure SetLines(const AValue: integer); procedure SetEnlargeHorizontal(const AValue: TChildControlEnlargeStyle); procedure SetEnlargeVertical(const AValue: TChildControlEnlargeStyle); procedure SetHorizontalSpacing(const AValue: integer); + procedure SetLayout(const AValue: TControlChildrenLayout); procedure SetLeftRightSpacing(const AValue: integer); procedure SetShrinkHorizontal(const AValue: TChildControlShrinkStyle); procedure SetShrinkVertical(const AValue: TChildControlShrinkStyle); @@ -1321,6 +1331,8 @@ type write SetShrinkHorizontal default cssAnchorAligning; property ShrinkVertical: TChildControlShrinkStyle read FShrinkVertical write SetShrinkVertical default cssAnchorAligning; + property Layout: TControlChildrenLayout read FLayout write SetLayout default cclNone; + property Lines: integer read FLines write SetLines; published property LeftRightSpacing: integer read FLeftRightSpacing write SetLeftRightSpacing; property TopBottomSpacing: integer read FTopBottomSpacing write SetTopBottomSpacing; @@ -1366,10 +1378,10 @@ type FBrush: TBrush; FAdjustClientRectRealized: TRect; FChildSizing: TControlChildSizing; - FControls: TList; // the child controls (only TControl, no TWinControl) - FWinControls: TList; // the child controls (only TWinControl, no TControl) + FControls: TFPList; // the child controls (only TControl, no TWinControl) + FWinControls: TFPList; // the child controls (only TWinControl, no TControl) FDefWndProc: Pointer; - FDockClients: TList; + FDockClients: TFPList; //FDockSite: Boolean; FDoubleBuffered: Boolean; FClientWidth: Integer; @@ -1396,7 +1408,7 @@ type FShowing: Boolean; FTabOrder: integer; FTabStop: Boolean; - FTabList: TList; + FTabList: TFPList; FUseDockManager: Boolean; procedure AlignControl(AControl: TControl); function GetBrush: TBrush; @@ -1430,7 +1442,7 @@ type procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); virtual; function DoAlignChildControls(TheAlign: TAlign; AControl: TControl; - AControlList: TList; var ARect: TRect): Boolean; virtual; + AControlList: TFPList; var ARect: TRect): Boolean; virtual; procedure DoChildSizingChange(Sender: TObject); virtual; procedure ResizeDelayedAutoSizeChildren; virtual; function CanTab: Boolean; override; @@ -1646,7 +1658,7 @@ type Procedure SetFocus; virtual; Function FindChildControl(const ControlName: String): TControl; procedure FlipChildren(AllLevels: Boolean); dynamic; - Procedure GetTabOrderList(List: TList); + procedure GetTabOrderList(List: TFPList); function HandleAllocated: Boolean; procedure HandleNeeded; function BrushCreated: Boolean; @@ -2563,6 +2575,13 @@ begin Change; end; +procedure TControlChildSizing.SetLines(const AValue: integer); +begin + if FLines=AValue then exit; + FLines:=AValue; + Change; +end; + procedure TControlChildSizing.SetEnlargeVertical( const AValue: TChildControlEnlargeStyle); begin @@ -2578,6 +2597,13 @@ begin Change; end; +procedure TControlChildSizing.SetLayout(const AValue: TControlChildrenLayout); +begin + if FLayout=AValue then exit; + FLayout:=AValue; + Change; +end; + procedure TControlChildSizing.SetLeftRightSpacing(const AValue: integer); begin if FLeftRightSpacing=AValue then exit; @@ -2619,6 +2645,7 @@ constructor TControlChildSizing.Create(OwnerControl: TControl); begin FControl:=OwnerControl; inherited Create; + FLayout:=cclNone; FEnlargeHorizontal:=cesAnchorAligning; FEnlargeVertical:=cesAnchorAligning; FShrinkHorizontal:=cssAnchorAligning; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 6b6731ca7a..c024efcd71 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -2256,7 +2256,7 @@ var function BackgroundClipped: Boolean; var R: TRect; - List: TList; + List: TFPList; I: Integer; C: TControl; begin diff --git a/lcl/include/controlsproc.inc b/lcl/include/controlsproc.inc index 1bd67f442d..82eb9c388d 100644 --- a/lcl/include/controlsproc.inc +++ b/lcl/include/controlsproc.inc @@ -58,5 +58,48 @@ Begin End; End; +Procedure ListAdd(var List : TFPList; Item: Pointer); +Begin + if List = nil then List := TFPList.Create; + List.Add(Item); +End; + +Procedure ListInsert(var List : TFPList; Index : Longint; Item: Pointer); +Begin + if List = nil then List := TFPList.Create; + List.Insert(Index, Item); +End; + +Function ListIndexOf(var List : TFPList; Item: Pointer) : Longint; +Begin + Result := -1; + if List <> nil then Result := List.IndexOf(Item); +End; + +Function ListCount(List : TFPList) : Longint; +Begin + Result := 0; + if List <> nil then Result := List.Count; +End; + +Procedure ListRemove(var List : TFPList; Item: Pointer); +Begin + if List=nil then exit; + List.Remove(Item); + if List.Count = 0 then begin + List.Free; + List := nil; + End; +End; + +Procedure ListDelete(var List : TFPList; Index: integer); +Begin + if List=nil then exit; + List.Delete(Index); + if List.Count = 0 then begin + List.Free; + List := nil; + End; +End; // included by controls.pp diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 9b666237ec..c334f24885 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -386,10 +386,10 @@ procedure TCustomForm.WMShowWindow(var message: TLMShowWindow); function FindFirstControl: TWinControl; var - List: TList; + List: TFPList; I: Integer; begin - List := TList.Create; + List := TFPList.Create; Result := nil; try GetTabOrderList(List); diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 8c295092ee..a9b8ef1334 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -71,7 +71,7 @@ end; procedure TWinControl.AlignControls(AControl: TControl; var RemainingClientRect: TRect); var - AlignList: TList; + AlignList: TFPList; BoundsMutated: boolean; RemainingBorderSpace: TRect; // borderspace around RemainingClientRect // e.g. Right=3 means borderspace of 3 @@ -628,7 +628,43 @@ var for I := 0 to AlignList.Count - 1 do DoPosition(TControl(AlignList[I]), AAlign); end; - + + procedure DoAlignNotAligned; + // All controls, not aligned by their own properties, can be auto aligned. + var + i: Integer; + Control: TControl; + LineCount: LongInt; + begin + // check if other aligning is enabled + if (ChildSizing.EnlargeHorizontal=cesAnchorAligning) + and (ChildSizing.EnlargeVertical=cesAnchorAligning) + and (ChildSizing.ShrinkHorizontal=cssAnchorAligning) + and (ChildSizing.ShrinkVertical=cssAnchorAligning) + and (ChildSizing.Layout=cclNone) + then + exit; + + /// collect all 'not aligned' controls + AlignList.Clear; + for i:=0 to ControlCount-1 do begin + Control := Controls[i]; + if (Control.Align=alNone) + and (Control.Anchors=[akLeft,akTop]) + and (Control.AnchorSide[akLeft].Control=nil) + and (Control.AnchorSide[akTop].Control=nil) + then begin + AlignList.Add(Control); + end; + end; + if AlignList.Count=0 then exit; + + // + LineCount:=ChildSizing.Lines; + if LineCount>AlignList.Count then LineCount:=AlignList.Count; + + end; + var i: Integer; ChildControl: TControl; @@ -660,7 +696,7 @@ begin ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing, ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing); //DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',RemainingClientRect.Left,',',RemainingClientRect.Top,',',RemainingClientRect.Right,',',RemainingClientRect.Bottom); - AlignList := TList.Create; + AlignList := TFPList.Create; try // Auto aligning/anchoring can be very interdependent. // In worst case the n-2 depends on the n-1, the n-3 depends on n-2 @@ -679,6 +715,7 @@ begin DoAlign(alClient); DoAlign(alCustom); DoAlign(alNone); + DoAlignNotAligned; if not BoundsMutated then break; // update again RemainingClientRect:=OldRemainingClientRect; @@ -697,7 +734,7 @@ begin end; function TWinControl.DoAlignChildControls(TheAlign: TAlign; AControl: TControl; - AControlList: TList; var ARect: TRect): Boolean; + AControlList: TFPList; var ARect: TRect): Boolean; begin Result:=false; end; @@ -1265,9 +1302,10 @@ end; * The FControls are always below the FWinControls. * FControls and FWinControls can be nil ------------------------------------------------------------------------------} -procedure TWinControl.SetChildZPosition(const AChild: TControl; const APosition: Integer); +procedure TWinControl.SetChildZPosition(const AChild: TControl; + const APosition: Integer); var - list: TList; + list: TFPList; idx, NewPos: Integer; IsWinControl: boolean; begin @@ -1309,7 +1347,8 @@ begin if IsWinControl then begin if HandleAllocated and TWinControl(AChild).HandleAllocated - then TWSWinControlClass(WidgetSetClass).SetChildZPosition(Self, TWinControl(AChild), idx, NewPos, list); + then TWSWinControlClass(WidgetSetClass).SetChildZPosition(Self, + TWinControl(AChild), idx, NewPos, list); end else begin AChild.InvalidateControl(AChild.Visible, True, True); @@ -1479,7 +1518,7 @@ function TWinControl.PerformTab(ForwardTab: boolean): boolean; var I : Integer; - List : TList; + List : TFPList; FirstFocus, OldFocus, NewFocus : TWinControl; TopLevel : TWinControl; begin @@ -1489,7 +1528,7 @@ begin If TopLevel = nil then exit; try - List := TList.Create; + List := TFPList.Create; TopLevel.GetTabOrderList(List); FirstFocus := nil; For I := 0 to List.Count - 1 do @@ -1555,11 +1594,11 @@ end; procedure TWinControl.FlipChildren(AllLevels: Boolean); var i: Integer; - FlipControls: TList; + FlipControls: TFPList; CurControl: TControl; begin if ControlCount = 0 then exit; - FlipControls := TList.Create; + FlipControls := TFPList.Create; DisableAlign; try @@ -1601,13 +1640,13 @@ end; function TWinControl.FindNextControl(CurrentControl: TWinControl; GoForward, CheckTabStop, CheckParent: boolean): TWinControl; var - List : TList; + List : TFPList; Next : TWinControl; I, J : Longint; begin Try Result := nil; - List := TList.Create; + List := TFPList.Create; GetTabOrderList(List); //for i:=0 to List.Count-1 do begin // debugln('TWinControl.FindNextControl TabOrderList ',dbgs(i),' ',DbgSName(TObject(List[i]))); @@ -1654,12 +1693,12 @@ end; procedure TWinControl.FixupTabList; var Count, I, J: Integer; - List: TList; + List: TFPList; Control: TWinControl; begin if FWinControls <> nil then begin - List := TList.Create; + List := TFPList.Create; try Count := FWinControls.Count; List.Count := Count; @@ -1683,7 +1722,7 @@ end; {------------------------------------------------------------------------------ TWinControl GetTabOrderList ------------------------------------------------------------------------------} -Procedure TWinControl.GetTabOrderList(List: TList); +Procedure TWinControl.GetTabOrderList(List: TFPList); var I : Integer; lWinControl : TWinControl; @@ -4314,7 +4353,7 @@ begin FDockManager := nil; end else begin - if FDockClients = nil then FDockClients := TList.Create; + if FDockClients = nil then FDockClients := TFPList.Create; FDockManager := CreateDockManager; end; end; diff --git a/lcl/interfaces/gtk/gtkwscontrols.pp b/lcl/interfaces/gtk/gtkwscontrols.pp index 2dfded066a..8b2ff83a75 100644 --- a/lcl/interfaces/gtk/gtkwscontrols.pp +++ b/lcl/interfaces/gtk/gtkwscontrols.pp @@ -86,7 +86,7 @@ type class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override; - class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); override; + class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override; class procedure SetColor(const AWinControl: TWinControl); override; class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); override; class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; @@ -349,7 +349,9 @@ begin GtkWidgetSet.SetCallback(LM_MOUSEWHEEL, AGTKObject, AComponent); end; -procedure TGtkWSWinControl.SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); +procedure TGtkWSWinControl.SetChildZPosition( + const AWinControl, AChild: TWinControl; + const AOldPos, ANewPos: Integer; const AChildren: TFPList); var n: Integer; child: TWinControlHack; diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index f1eda429ac..1d0b98cdc9 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/lcl/interfaces/win32/win32wscontrols.pp @@ -70,7 +70,9 @@ type class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override; class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override; - class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); override; + class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; + const AOldPos, ANewPos: Integer; + const AChildren: TFPList); override; class procedure SetColor(const AWinControl: TWinControl); override; class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; class procedure SetText(const AWinControl: TWinControl; const AText: string); override; @@ -323,7 +325,9 @@ begin RecreateWnd(AWinControl); end; -procedure TWin32WSWinControl.SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); +procedure TWin32WSWinControl.SetChildZPosition( + const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; + const AChildren: TFPList); var AfterWnd: hWnd; n, StopPos: Integer; diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 89d4fd93e5..2ea0d01bcd 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -80,7 +80,7 @@ type class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); virtual; class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); virtual; class procedure SetColor(const AWinControl: TWinControl); virtual; - class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); virtual; + class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); virtual; class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); virtual; class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); virtual; class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); virtual; @@ -187,7 +187,9 @@ procedure TWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABo begin end; -procedure TWSWinControl.SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TList); +procedure TWSWinControl.SetChildZPosition( + const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; + const AChildren: TFPList); begin end;