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

started ChildSizing auto layouts for TWinControl

Browse Source 
git-svn-id: trunk@7882 -
This commit is contained in:
mattias 2005-10-02 09:46:55 +00:00
parent a54c8c6d92
commit 00692af0ed
9 changed files with 150 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ide/lazarus.pp
View File

@ -88,6 +88,7 @@ begin
Application.Run;
except
debugln('lazarus.pp - unhandled exception');
Halt;
end;
if (SplashForm<>nil) then begin
SplashForm.Free;

39
lcl/controls.pp
View File

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

2
lcl/include/control.inc
View File

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

43
lcl/include/controlsproc.inc
View File

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

4
lcl/include/customform.inc
View File

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

73
lcl/include/wincontrol.inc
View File

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

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

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

8
lcl/interfaces/win32/win32wscontrols.pp
View File

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

6
lcl/widgetset/wscontrols.pp
View File

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