started ChildSizing auto layouts for TWinControl

git-svn-id: trunk@7882 -

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;

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)
+    FControls: TFPList;    // the child controls (only TControl, no TWinControl)
-    FWinControls: TList; // the child controls (only TWinControl, no TControl)
+    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;

lcl/include/control.inc

@@ -2256,7 +2256,7 @@ var
   function BackgroundClipped: Boolean;
   var
     R: TRect;
-    List: TList;
+    List: TFPList;
     I: Integer;
     C: TControl;
   begin

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
 

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

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;

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;

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;

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;