paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 07:59:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

TSplitter can now also work with Align=alNone and AnchorSide

Browse Source 
git-svn-id: trunk@7334 -
This commit is contained in:
mattias 2005-07-09 16:20:50 +00:00
parent b6106285b6
commit d787ff4438
9 changed files with 597 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
lcl/controls.pp
View File

@ -441,7 +441,7 @@ type
This class exists for Delphi compatibility.
}
TDockManager = class
TDockManager = class(TPersistent)
public
procedure BeginUpdate; virtual; abstract;
procedure EndUpdate; virtual; abstract;
@ -1713,7 +1713,6 @@ type
FChildControl: TControl;
FChildCount: integer;
FFirstChildZone: TDockZone;
FHostDockSite: TWinControl;
FTree: TDockTree;
FParentZone: TDockZone;
FOrientation: TDockOrientation;
@ -1730,27 +1729,29 @@ type
function GetWidth: Integer; virtual;
public
constructor Create(TheTree: TDockTree; TheChildControl: TControl);
//procedure ExpandZoneLimit(NewLimit: Integer); Needed?
function FindZone(AControl: TControl): TDockZone;
function FirstVisibleChild: TDockZone;
function GetNextVisibleZone: TDockZone;
function NextVisible: TDockZone;
function PrevVisible: TDockZone;
//procedure ResetChildren; Needed?
//procedure ResetZoneLimits; Needed?
//procedure Update; Needed?
property Tree: TDockTree read FTree;
procedure AddAsFirstChild(NewChildZone: TDockZone);
procedure AddAsLastChild(NewChildZone: TDockZone);
function GetLastChild: TDockZone;
public
property ChildControl: TControl read FChildControl;
property ChildCount: Integer read FChildCount;
property FirstChild: TDockZone read FFirstChildZone;
property Height: Integer read GetHeight;
property Left: Integer read GetLeft;
property LimitBegin: Integer read GetLimitBegin; // returns Left or Top
property LimitSize: Integer read GetLimitSize; // returns Width or Height
property Orientation: TDockOrientation read FOrientation write FOrientation;
property Parent: TDockZone read FParentZone;
property Top: Integer read GetTop;
property Tree: TDockTree read FTree;
property Visible: Boolean read GetVisible;
property VisibleChildCount: Integer read GetVisibleChildCount;
property Width: Integer read GetWidth;
property ChildControl: TControl read FChildControl;
property Orientation: TDockOrientation read FOrientation;
property HostDockSite: TWinControl read FHostDockSite;
end;
TDockZoneClass = class of TDockZone;
@ -1853,11 +1854,12 @@ type
TDockTree = class(TDockManager)
private
FBorderWidth: Integer; // width of the border of the preview rectangle
FDockSite: TWinControl;
FDockZoneClass: TDockZoneClass;
//FGrabberSize: Integer;
//FGrabbersOnTop: Boolean;
FFlags: TDockTreeFlags;
FTopZone: TDockZone;
FRootZone: TDockZone;
//FTopXYLimit: Integer;
FUpdateCount: Integer;
procedure DeleteZone(Zone: TDockZone);
@ -1886,6 +1888,8 @@ type
procedure PaintSite(DC: HDC); override;
public
property DockZoneClass: TDockZoneClass read FDockZoneClass;
property DockSite: TWinControl read FDockSite write FDockSite;
property RootZone: TDockZone read FRootZone;
end;
@ -1928,6 +1932,12 @@ const
{ alCustom }
[akLeft, akTop]
);
OppositeAnchor: array[TAnchorKind] of TAnchorKind = (
akBottom, // akTop,
akRight, // akLeft,
akLeft, // akRight,
akTop // akBottom
);
DefaultSideForAnchorKind: array[TAnchorKind] of TAnchorSideReference = (
// akTop
asrBottom,
@ -2941,6 +2951,9 @@ end.
{ =============================================================================
$Log$
Revision 1.308 2005/07/09 16:20:50 mattias
TSplitter can now also work with Align=alNone and AnchorSide
Revision 1.307 2005/07/07 20:20:45 mattias
fixed clean all in IDE, added SystemKey parameter to IntfUTF8KeyPress

22
lcl/extctrls.pp
View File

@ -369,7 +369,15 @@ type
TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer;
var Accept: Boolean) of object;
{ TCustomSplitter is a control to interactively resize another control.
It is a vertical or horizontal bar anchored to a side of a control.
You can either set the Align property to alLeft (alRight,alTop,alBottom),
then it will become a vertical bar, aligned to the left and when the user
moves it with the mouse, the control to the left with the same Align=alLeft
will be resized.
The second more flexible possibility is to set the properties Align=alNone,
AnchorSides and Orientation.
}
TCustomSplitter = class(TCustomControl)
private
FAutoSnap: boolean;
@ -377,13 +385,17 @@ type
FMinSize: integer;
FOnCanResize: TCanResizeEvent;
FOnMoved: TNotifyEvent;
FResizeAnchor: TAnchorKind;
FResizeStyle: TResizeStyle;
FSplitDragging: Boolean;
fSplitterStartMouseXY: TPoint; // in screen coordinates
fSplitterStartLeftTop: TPoint; // in screen coordinates
function GetResizeControl: TControl;
procedure SetAutoSnap(const AValue: boolean);
procedure SetBeveled(const AValue: boolean);
procedure SetMinSize(const AValue: integer);
procedure SetResizeAnchor(const AValue: TAnchorKind);
procedure SetResizeControl(const AValue: TControl);
procedure SetResizeStyle(const AValue: TResizeStyle);
protected
procedure StartSplitterMove(Restart: boolean; const MouseXY: TPoint);
@ -391,6 +403,7 @@ type
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
function FindAlignControl: TControl;
function FindAlignOtherControl: TControl;
procedure SetAlign(Value: TAlign); override;
procedure SetAnchors(const AValue: TAnchors); override;
procedure CheckAlignment;
@ -398,6 +411,9 @@ type
procedure Paint; override;
public
constructor Create(TheOwner: TComponent); override;
procedure AnchorSplitter(Kind: TAnchorKind; AControl: TControl);
property ResizeControl: TControl read GetResizeControl write SetResizeControl;
function GetOtherResizeControl: TControl;
public
property Align default alLeft;
property ResizeStyle: TResizeStyle read FResizeStyle write SetResizeStyle default rsUpdate;
@ -408,6 +424,7 @@ type
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property Width default 5;
property Cursor default crHSplit;
property ResizeAnchor: TAnchorKind read FResizeAnchor write SetResizeAnchor default akLeft;
end;
@ -996,6 +1013,9 @@ end.
{
$Log$
Revision 1.138 2005/07/09 16:20:50 mattias
TSplitter can now also work with Align=alNone and AnchorSide
Revision 1.137 2005/06/29 09:24:14 mattias
implemented auto ident completion after point plus idle

7
lcl/include/control.inc
View File

@ -2944,8 +2944,8 @@ end;
Docks this control to DropControl or on NewDockSite.
If DropControl is not nil, ControlSide defines on which side of DropControl
this control is docked. (alNone for stacked in pages). DropControl will
become part of a TDockManager.
this control is docked. (alNone,alClient for stacked in pages). DropControl
will become part of a TDockManager.
If DropControl is nil, then DropControl becomes a normal child of NewDockSite
and ControlSide is ignored.
------------------------------------------------------------------------------}
@ -3553,6 +3553,9 @@ end;
{ =============================================================================
$Log$
Revision 1.265 2005/07/09 16:20:50 mattias
TSplitter can now also work with Align=alNone and AnchorSide
Revision 1.264 2005/07/05 10:50:23 micha
mousecapture debug compilation fixes

406
lcl/include/customsplitter.inc
View File

@ -38,6 +38,22 @@ begin
FAutoSnap:=AValue;
end;
function TCustomSplitter.GetResizeControl: TControl;
begin
if Align in [alLeft,alRight,alTop,alBottom] then
Result:=FindAlignControl
else
Result:=AnchorSide[ResizeAnchor].Control;
end;
function TCustomSplitter.GetOtherResizeControl: TControl;
begin
if Align in [alLeft,alRight,alTop,alBottom] then
Result:=FindAlignOtherControl
else
Result:=AnchorSide[OppositeAnchor[ResizeAnchor]].Control;
end;
procedure TCustomSplitter.SetBeveled(const AValue: boolean);
begin
if FBeveled=AValue then exit;
@ -51,6 +67,35 @@ begin
FMinSize:=AValue;
end;
procedure TCustomSplitter.SetResizeAnchor(const AValue: TAnchorKind);
begin
if FResizeAnchor=AValue then exit;
FResizeAnchor:=AValue;
if ResizeAnchor in [akLeft,akRight] then
Cursor := crHSplit
else
Cursor := crVSplit;
if not (csLoading in ComponentState) then begin
Align:=alNone;
end;
end;
procedure TCustomSplitter.SetResizeControl(const AValue: TControl);
begin
if Align in [alLeft,alRight,alTop,alBottom] then begin
if AValue<>nil then begin
case Align of
alLeft: Left:=AValue.Left+1;
alTop: Top:=AValue.Top+1;
alRight: Left:=AValue.Left-1;
alBottom: Top:=AValue.Top-1;
end;
end;
end else begin
AnchorSide[ResizeAnchor].Control:=AValue;
end;
end;
procedure TCustomSplitter.StartSplitterMove(Restart: boolean;
const MouseXY: TPoint);
begin
@ -121,6 +166,7 @@ begin
end;
function FindVirtualOppositeControl(Control: TControl): TControl;
function CompPos(CurControl, Control: TControl): Boolean;
begin
Result := False;
@ -143,6 +189,7 @@ function FindVirtualOppositeControl(Control: TControl): TControl;
then Result := True;
end;
end;
function OppositeControl(CurControl,Control: TControl): Boolean;
begin
Result := False;
@ -153,6 +200,7 @@ function FindVirtualOppositeControl(Control: TControl): TControl;
alBottom: if (CurControl.Align = alTop) then Result := True;
end;
end;
var
i,count: Integer;
CurControl: TControl;
@ -174,74 +222,92 @@ end;
procedure TCustomSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
var
AlignControl, LastControl, VirtualOppositeControl, ClientControl: TControl;
CurResizeControl,
LastControl, VirtualOppositeControl, CurOtherResizeControl: TControl;
function GetParentClientSize: Integer;
begin
case Self.Align of
alLeft, alRight: Result := Parent.ClientWidth;
alTop, alBottom: Result := Parent.ClientHeight;
case ResizeAnchor of
akLeft, akRight: Result := Parent.ClientWidth;
akTop, akBottom: Result := Parent.ClientHeight;
end;
end;
function GetControlMinPos(Control: TControl): Integer;
begin
if Assigned(Control)
then case Self.Align of
alLeft,alRight: Result := Control.Left;
alTop,alBottom: Result := Control.Top;
end
else case Self.Align of
alLeft,alTop: Result := 0;
alRight,alBottom: Result := GetParentClientSize;
end;
then
case ResizeAnchor of
akLeft,akRight: Result := Control.Left;
akTop,akBottom: Result := Control.Top;
end
else
case ResizeAnchor of
akLeft,akTop: Result := 0;
akRight,akBottom: Result := GetParentClientSize;
end;
end;
function GetControlSize(Control: TControl): Integer;
begin
Result := 0;
if Assigned(Control)
then case Self.Align of
alLeft, alRight: Result := Control.Width;
alTop, alBottom: Result := Control.Height;
then case ResizeAnchor of
akLeft, akRight: Result := Control.Width;
akTop, akBottom: Result := Control.Height;
end;
end;
function GetControlConstraintsMinSize(Control: TControl): Integer;
begin
case Self.Align of
alLeft, alRight: Result := Control.Constraints.MinWidth;
alTop, alBottom: Result := Control.Constraints.MinHeight;
case ResizeAnchor of
akLeft, akRight: Result := Control.Constraints.EffectiveMinWidth;
akTop, akBottom: Result := Control.Constraints.EffectiveMinHeight;
end;
end;
function GetControlConstraintsMaxSize(Control: TControl): Integer;
begin
case ResizeAnchor of
akLeft, akRight: Result := Control.Constraints.EffectiveMaxWidth;
akTop, akBottom: Result := Control.Constraints.EffectiveMaxHeight;
end;
end;
procedure SetAlignControlSize(NewSize: Integer);
begin
case Self.Align of
alLeft:
AlignControl.Width := NewSize;
alRight:
case ResizeAnchor of
akLeft:
CurResizeControl.Width := NewSize;
akRight:
begin
Parent.DisableAlign;
AlignControl.Left := AlignControl.Left + (AlignControl.Width - NewSize);
AlignControl.Width := NewSize;
CurResizeControl.Left := CurResizeControl.Left
+ (CurResizeControl.Width - NewSize);
CurResizeControl.Width := NewSize;
Parent.EnableAlign;
end;
alTop:
AlignControl.Height := NewSize;
alBottom:
akTop:
CurResizeControl.Height := NewSize;
akBottom:
begin
Parent.DisableAlign;
AlignControl.Top := AlignControl.Top + (AlignControl.Height - NewSize);
AlignControl.Height := NewSize;
CurResizeControl.Top := CurResizeControl.Top
+ (CurResizeControl.Height - NewSize);
CurResizeControl.Height := NewSize;
Parent.EnableAlign;
end;
end;
end;
function CalcNewSize(StartSize, EndSize, Offset: Integer): Integer;
var
NewSize: Integer;
begin
NewSize := GetControlSize(AlignControl);
case Self.Align of
alLeft, alTop: Inc(NewSize, Offset);
alRight, alBottom: Dec(NewSize, Offset);
NewSize := GetControlSize(CurResizeControl);
case ResizeAnchor of
akLeft, akTop: Inc(NewSize, Offset);
akRight, akBottom: Dec(NewSize, Offset);
end;
if NewSize > EndSize then NewSize := EndSize;
@ -251,26 +317,29 @@ var
then NewSize := StartSize;
Result := NewSize;
end;
function GetVirtualControlMinPos(Control: TControl): Integer;
begin
case Self.Align of
alLeft: Result := Control.Left;
alRight: Result := Control.BoundsRect.Right;
alTop: Result := Control.Top;
alBottom: Result := Control.BoundsRect.Bottom;
case ResizeAnchor of
akLeft: Result := Control.Left;
akRight: Result := Control.BoundsRect.Right;
akTop: Result := Control.Top;
akBottom: Result := Control.BoundsRect.Bottom;
end;
end;
function CalcOffset(X,Y: Integer): Integer;
begin
case Self.Align of
alLeft, alRight:
case ResizeAnchor of
akLeft, akRight:
Result := (X-fSplitterStartMouseXY.X)
- (Self.Left-fSplitterStartLeftTop.X);
alTop, alBottom:
akTop, akBottom:
Result := (Y-fSplitterStartMouseXY.Y)
- (Self.Top-fSplitterStartLeftTop.Y);
end;
end;
function FindClientControl: TControl;
var
CurControl: TControl;
@ -288,6 +357,7 @@ var
end;
end; // for count
end; // function FindClientControl
function FindLastControl(Control: TControl): TControl;
var
CurControl: TControl;
@ -298,7 +368,25 @@ var
CurControl := FindOppositeControl(Control);
end;
Result := Control;
end; // function FindLastControl
end;
function GetParentsClientLimit: integer;
// returns the maximum size of the CurResizeControl due to parent's client
// area
begin
if ResizeAnchor in [akLeft,akRight] then begin
if ResizeAnchor=akRight then
Result:=CurResizeControl.Left+CurResizeControl.Width-Width
else
Result:=Parent.ClientWidth-CurResizeControl.Left-Width;
end else begin
if ResizeAnchor=akBottom then
Result:=CurResizeControl.Top+CurResizeControl.Height-Height
else
Result:=Parent.ClientHeight-CurResizeControl.Top-Height;
end;
end;
var
Offset: Integer;
StartSize: Integer;
@ -307,57 +395,93 @@ var
MousePos: TPoint;
begin
inherited MouseMove(Shift, X, Y);
if not (Self.Align in [alLeft, alRight, alTop, alBottom]) then Exit;
if (ssLeft in Shift) and (Parent <> nil) then begin
AlignControl := FindAlignControl;
if not Assigned(AlignControl) then Exit;
// get the control to resize
CurResizeControl := GetResizeControl;
if not Assigned(CurResizeControl) then Exit;
// While resizing X, Y are not valid. Use absolute mouse position.
GetCursorPos(MousePos);
StartSplitterMove(False,MousePos);
Offset := CalcOffset(MousePos.X, MousePos.Y);
if Offset = 0 then Exit;
ClientControl := FindClientControl;
StartSize := 1;
if not fAutoSnap
then Inc(StartSize, Max(fMinSize, GetControlConstraintsMinSize(AlignControl)));
if StartSize > 1 then Dec(StartSize);
CurOtherResizeControl := GetOtherResizeControl;
if Assigned(ClientControl)
then EndSize := GetControlSize(AlignControl)
+ GetControlSize(ClientControl)
- fMinSize
else begin
VirtualOppositeControl := FindVirtualOppositeControl(Self);
LastControl := FindLastControl(Self);
case Self.Align of
alLeft, alTop: begin
if Assigned(VirtualOppositeControl) then
begin
EndSize := GetControlSize(AlignControl)
+ (GetControlMinPos(VirtualOppositeControl)
- (GetControlMinPos(LastControl)
+ GetControlSize(LastControl)));
end
else EndSize := GetControlSize(AlignControl)
+ (GetParentClientSize
- GetControlMinPos(LastControl)
- GetControlSize(LastControl))
end;
if Align in [alLeft,alTop,alRight,alBottom] then begin
// aligned Splitter
// -> consider aligned siblings for minimum and maximum movement
alRight, alBottom: begin
if Assigned(VirtualOppositeControl) then
EndSize := GetControlSize(AlignControl)
+ (GetControlMinPos(LastControl)
- (GetControlMinPos(VirtualOppositeControl)
+ GetControlSize(VirtualOppositeControl)))
else EndSize := GetControlSize(AlignControl)
+ GetControlMinPos(LastControl);
end;
end; // case Self.Align
// calculate minimum size
StartSize := 1;
if not fAutoSnap
then Inc(StartSize,
Max(fMinSize, GetControlConstraintsMinSize(CurResizeControl)));
if StartSize > 1 then Dec(StartSize);
// calculate maximum size
if Assigned(CurOtherResizeControl)
then EndSize := GetControlSize(CurResizeControl)
+ GetControlSize(CurOtherResizeControl)
- fMinSize
else begin
VirtualOppositeControl := FindVirtualOppositeControl(Self);
LastControl := FindLastControl(Self);
case ResizeAnchor of
akLeft, akTop: begin
if Assigned(VirtualOppositeControl) then
begin
EndSize := GetControlSize(CurResizeControl)
+ (GetControlMinPos(VirtualOppositeControl)
- (GetControlMinPos(LastControl)
+ GetControlSize(LastControl)));
end
else EndSize := GetControlSize(CurResizeControl)
+ (GetParentClientSize
- GetControlMinPos(LastControl)
- GetControlSize(LastControl))
end;
akRight, akBottom: begin
if Assigned(VirtualOppositeControl) then
EndSize := GetControlSize(CurResizeControl)
+ (GetControlMinPos(LastControl)
- (GetControlMinPos(VirtualOppositeControl)
+ GetControlSize(VirtualOppositeControl)))
else EndSize := GetControlSize(CurResizeControl)
+ GetControlMinPos(LastControl);
end;
end;
end;
end else begin
// anchored Splitter
// -> consider anchored siblings for minimum and maximum movement
StartSize := Max(fMinSize,
GetControlConstraintsMinSize(CurResizeControl));
EndSize := GetControlConstraintsMaxSize(CurResizeControl);
//debugln('TCustomSplitter.MouseMove A StartSize=',dbgs(StartSize),' EndSize=',dbgs(EndSize));
if (CurOtherResizeControl<>nil)
and (OppositeAnchor[FResizeAnchor]
in (CurOtherResizeControl.Anchors
+AnchorAlign[CurOtherResizeControl.Align]))
then begin
// CurOtherResizeControl will be resized too
// -> consider Constraints of CurOtherResizeControl too
if GetControlConstraintsMaxSize(CurOtherResizeControl)>0 then
StartSize := Max(StartSize,
GetControlSize(CurResizeControl)
+GetControlConstraintsMaxSize(CurOtherResizeControl)
-GetControlSize(CurOtherResizeControl));
EndSize := Min(EndSize,
GetControlSize(CurResizeControl)
+GetControlSize(CurOtherResizeControl)
-GetControlConstraintsMinSize(CurOtherResizeControl));
//debugln('TCustomSplitter.MouseMove B CurOtherResizeControl=',DbgSName(CurOtherResizeControl),' StartSize=',dbgs(StartSize),' EndSize=',dbgs(EndSize));
end;
// do not move Splitter out of Parent's client area
EndSize := Min(EndSize,GetParentsClientLimit);
//debugln('TCustomSplitter.MouseMove C StartSize=',dbgs(StartSize),' EndSize=',dbgs(EndSize));
end;
NewSize := CalcNewSize(StartSize, EndSize, Offset);
@ -372,7 +496,6 @@ procedure TCustomSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if not (Self.Align in [alLeft,alTop,alRight,alBottom]) then Exit;
if FSplitDragging then begin
if Assigned(OnMoved) then OnMoved(Self);
FSplitDragging := False;
@ -386,6 +509,7 @@ var
begin
Result := nil;
if (Parent = nil) then Exit;
if not (Align in [alLeft,alTop,alRight,alBottom]) then exit;
for i := Parent.ControlCount-1 downto 0 do begin
CurControl := Parent.Controls[i];
if (CurControl <> Self)
@ -409,36 +533,69 @@ begin
if (CurControl.Width = Self.Width)
and (CurControl.Top-Self.Height = Self.Top)
then Result := CurControl;
end; // case Self.Align
end;
if Assigned(Result) then Break;
end;
end;
end;
function TCustomSplitter.FindAlignOtherControl: TControl;
// if this splitter is aligned, then it returns the control that will be
// resized as well. Normally an alClient aligned control.
// Or: if alTop,alBottom the alLeft/alRight controls.
var
CurControl: TControl;
i: Integer;
begin
Result := nil;
for i := Parent.ControlCount-1 downto 0 do begin
CurControl := Parent.Controls[i];
if (CurControl <> Self)
and ((CurControl.Align = alClient)
or ((Self.Align in [alTop,alBottom])
and (CurControl.Align in [alLeft,alRight]))) then begin
Result := CurControl;
exit;
end;
end;
end;
procedure TCustomSplitter.SetAlign(Value: TAlign);
var
OldAlign: TAlign;
OldWidth: Integer;
OldHeight: Integer;
OldResizeAnchor: TAnchorKind;
begin
if (Self.Align = Value)
or (not (Value in [alLeft,alTop,alRight,alBottom]))
then Exit;
if (Self.Align = Value) or (Value=alClient) then Exit;
OldWidth := Self.Width;
OldHeight := Self.Height;
OldAlign := Self.Align;
OldResizeAnchor:=ResizeAnchor;
case Value of
alLeft: FResizeAnchor:=akLeft;
alTop: FResizeAnchor:=akTop;
alRight: FResizeAnchor:=akRight;
alBottom: FResizeAnchor:=akBottom;
end;
inherited SetAlign(Value);
if Self.Align in [alLeft,alRight]
then Self.Cursor := crHSplit
else Self.Cursor := crVSplit;
if ResizeAnchor in [akLeft,akRight] then
Cursor := crHSplit
else
Cursor := crVSplit;
CheckAlignment;
if (OldAlign in [alLeft,alRight])=(Align in [alLeft,alRight]) then begin
if (OldResizeAnchor in [akLeft,akRight])=(ResizeAnchor in [akLeft,akRight])
then begin
// keep width and height
SetBounds(Left,Top,OldWidth,OldHeight);
end else begin
// switch Width and Height
SetBounds(Left,Top,OldHeight,OldWidth);
// resize
if Align in [alLeft,alRight] then
Width:=OldHeight
else if Align in [alTop,alBottom] then
Height:=OldWidth;
end;
end;
@ -468,7 +625,8 @@ end;
procedure TCustomSplitter.Paint;
begin
DrawSplitter(Canvas.Handle,Rect(0,0,Width,Height),Align in [alTop,alBottom]);
DrawSplitter(Canvas.Handle,Rect(0,0,Width,Height),
FResizeAnchor in [akTop,akBottom]);
end;
constructor TCustomSplitter.Create(TheOwner: TComponent);
@ -478,9 +636,63 @@ begin
fAutoSnap:=true;
FBeveled:=false;
FMinSize:=30;
FResizeAnchor:=akLeft;
Align:=alLeft;
Width:=5;
end;
procedure TCustomSplitter.AnchorSplitter(Kind: TAnchorKind; AControl: TControl
);
procedure AnchorSplitterSides(
ResizeSide,// the side of the Splitter, where AControl is touched and moved
OppositeResizeSide, // opposite of ResizeSide
FixedSide1,// the first non moving side
FixedSide2:// the second non moving side
TAnchorKind);
begin
Anchors:=Anchors-[OppositeResizeSide]+[ResizeSide,FixedSide1,FixedSide2];
AnchorSide[OppositeResizeSide].Control:=nil;
AnchorToNeighbour(ResizeSide,0,AControl);
AnchorParallel(FixedSide1,0,AControl);
AnchorParallel(FixedSide2,0,AControl);
end;
var
OldResizeAnchor: TAnchorKind;
OldWidth: LongInt;
OldHeight: LongInt;
begin
OldWidth := Self.Width;
OldHeight := Self.Height;
OldResizeAnchor := FResizeAnchor;
Align := alNone;
FResizeAnchor := Kind;
if ResizeAnchor in [akLeft,akRight] then
Cursor := crHSplit
else
Cursor := crVSplit;
case FResizeAnchor of
akLeft: AnchorSplitterSides(akLeft,akRight,akTop,akBottom);
akRight: AnchorSplitterSides(akRight,akLeft,akTop,akBottom);
akTop: AnchorSplitterSides(akTop,akBottom,akLeft,akRight);
akBottom: AnchorSplitterSides(akBottom,akTop,akLeft,akRight);
end;
if (OldResizeAnchor in [akLeft,akRight])=(ResizeAnchor in [akLeft,akRight])
then begin
// keep width and height
SetBounds(Left,Top,OldWidth,OldHeight);
end else begin
// resize
if FResizeAnchor in [akLeft,akRight] then
Width:=OldHeight
else
Height:=OldWidth;
end;
end;
// included by extctrls.pp

7
lcl/include/docktree.inc
View File

@ -114,17 +114,18 @@ end;
constructor TDockTree.Create(TheDockSite: TWinControl);
begin
FDockZoneClass:=TDockZone;
if FDockZoneClass=nil then FDockZoneClass:=TDockZone;
FDockSite:=TheDockSite;
inherited Create;
FBorderWidth:=4;
//FGrabberSize:=DefaultDockGrabberSize;
//FGrabbersOnTop:=(FDockSite.Align <> alTop) and (FDockSite.Align <> alBottom);
FTopZone:=FDockZoneClass.Create(Self,TheDockSite);
FRootZone:=FDockZoneClass.Create(Self,TheDockSite);
end;
destructor TDockTree.Destroy;
begin
DeleteZone(FTopZone);
DeleteZone(FRootZone);
inherited Destroy;
end;

49
lcl/include/dockzone.inc
View File

@ -25,8 +25,6 @@ function TDockZone.GetHeight: Integer;
begin
if not Visible then
Result:=0
else if FHostDockSite<>nil then
Result:=FChildControl.HostDockSite.ClientHeight
else if (FChildControl<>nil) then
Result:=FChildControl.Height
else if FParentZone<>nil then
@ -146,8 +144,6 @@ function TDockZone.GetWidth: Integer;
begin
if not Visible then
Result:=0
else if FHostDockSite<>nil then
Result:=FChildControl.HostDockSite.ClientWidth
else if (FChildControl<>nil) then
Result:=FChildControl.Width
else if FParentZone<>nil then
@ -169,6 +165,20 @@ begin
FChildControl:=TheChildControl;
end;
function TDockZone.FindZone(AControl: TControl): TDockZone;
begin
if AControl=ChildControl then begin
Result:=Self;
exit;
end;
if FFirstChildZone<>nil then begin
Result:=FFirstChildZone.FindZone(AControl);
if Result<>nil then exit;
end;
if FNextSibling<>nil then
Result:=FNextSibling.FindZone(AControl);
end;
function TDockZone.FirstVisibleChild: TDockZone;
begin
if FFirstChildZone<>nil then begin
@ -193,5 +203,36 @@ begin
while (Result<>nil) and (not Result.Visible) do Result:=Result.FPrevSibling;
end;
procedure TDockZone.AddAsFirstChild(NewChildZone: TDockZone);
begin
NewChildZone.FParentZone:=Self;
NewChildZone.FNextSibling:=FFirstChildZone;
if FFirstChildZone<>nil then
FFirstChildZone.FPrevSibling:=NewChildZone;
FFirstChildZone:=NewChildZone;
inc(FChildCount);
end;
procedure TDockZone.AddAsLastChild(NewChildZone: TDockZone);
var
LastChild: TDockZone;
begin
NewChildZone.FParentZone:=Self;
LastChild:=GetLastChild;
NewChildZone.FPrevSibling:=LastChild;
if LastChild<>nil then
LastChild.FNextSibling:=NewChildZone
else
FFirstChildZone:=NewChildZone;
inc(FChildCount);
end;
function TDockZone.GetLastChild: TDockZone;
begin
Result:=FFirstChildZone;
if Result=nil then exit;
while (Result.FNextSibling<>nil) do Result:=Result.FNextSibling;
end;
// included by control.pp

15
lcl/include/wincontrol.inc
View File

@ -203,11 +203,11 @@ var
end;
Result:=DefaultPosition;
CurAnchorSide:=Control.AnchorSide[Kind];
//debugln('GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',DbgSName(CurAnchorSide.Control));
//debugln('GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' CurAnchorSide.Control=',DbgSName(CurAnchorSide.Control));
CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position);
if ReferenceControl<>nil then
Result:=Position;
//debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(Result));
//debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' Result=',dbgs(Result));
AnchorSideCacheValid[Kind]:=true;
AnchorSideCache[Kind]:=Result;
end;
@ -311,7 +311,7 @@ var
NewRight:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
if (not (akRight in CurAlignAnchors))
and (akRight in Anchors) then
and (akRight in Control.Anchors) then
NewRight:=GetAnchorSidePosition(akRight,NewRight);
NewWidth:=ConstraintWidth(NewRight-NewLeft);
end else begin
@ -326,7 +326,7 @@ var
NewRight:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
if (not (akRight in CurAlignAnchors))
and (akRight in Anchors) then
and (akRight in Control.Anchors) then
NewRight:=GetAnchorSidePosition(akRight,NewRight);
NewLeft:=NewRight-NewWidth;
end else begin
@ -345,7 +345,7 @@ var
NewBottom:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom);
if (not (akBottom in CurAlignAnchors))
and (akBottom in Anchors) then
and (akBottom in Control.Anchors) then
NewBottom:=GetAnchorSidePosition(akBottom,NewBottom);
NewHeight:=ConstraintHeight(NewBottom-NewTop);
end else begin
@ -360,7 +360,7 @@ var
NewBottom:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom);
if (not (akBottom in CurAlignAnchors))
and (akBottom in Anchors) then
and (akBottom in Control.Anchors) then
NewBottom:=GetAnchorSidePosition(akBottom,NewBottom);
NewTop:=NewBottom-NewHeight;
end else begin
@ -4579,6 +4579,9 @@ end;
{ =============================================================================
$Log$
Revision 1.336 2005/07/09 16:20:50 mattias
TSplitter can now also work with Align=alNone and AnchorSide
Revision 1.335 2005/07/07 20:20:45 mattias
fixed clean all in IDE, added SystemKey parameter to IntfUTF8KeyPress

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

@ -2367,7 +2367,7 @@ begin
{$ELSE}
Result:=EventStopped;
{$ENDIF}
DebugLn('[HandleGTKKeyUpDown] ',DbgSName(TObject(Data)),' Result=',dbgs(Result),' EventStopped=',dbgs(EventStopped));
//DebugLn('[HandleGTKKeyUpDown] ',DbgSName(TObject(Data)),' Result=',dbgs(Result),' EventStopped=',dbgs(EventStopped));
end;
{------------------------------------------------------------------------------
@ -8250,6 +8250,9 @@ end;
{ =============================================================================
$Log$
Revision 1.368 2005/07/09 16:20:50 mattias
TSplitter can now also work with Align=alNone and AnchorSide
Revision 1.367 2005/07/07 20:56:29 mattias
clean up

177
lcl/ldocktree.pas
View File

@ -31,18 +31,33 @@ unit LDockTree;
interface
uses
Classes, SysUtils, Forms, Controls, ExtCtrls;
Classes, SysUtils, LCLProc, Forms, Controls, ExtCtrls;
type
TLazDockPages = class;
TLazDockZone = class(TDockZone)
end;
{ TLazDockTree }
TLazDockTree = class(TDockTree)
private
FAutoFreeDockSite: boolean;
protected
procedure UndockControlForDocking(TheControl: TControl);
public
constructor Create(TheDockSite: TWinControl); override;
destructor Destroy; override;
procedure InsertControl(AControl: TControl; InsertAt: TAlign;
DropControl: TControl); override;
public
property AutoFreeDockSite: boolean read FAutoFreeDockSite write FAutoFreeDockSite;
end;
{ TLazDockForm
The default DockSite for a TLazDockTree
If DockZone is a leaf (DockZone.ChildCount=0) then
Only child control is DockZone.ChildControl
else
@ -87,6 +102,20 @@ type
write SetActiveNotebookPageComponent;
property Pages;
end;
TLazDockSplitter = class(TCustomSplitter)
end;
const
DockAlignOrientations: array[TAlign] of TDockOrientation = (
doPages, //alNone,
doVertical, //alTop,
doVertical, //alBottom,
doHorizontal,//alLeft,
doHorizontal,//alRight,
doPages, //alClient,
doPages //alCustom
);
implementation
@ -114,5 +143,151 @@ begin
inherited Create(TheOwner);
end;
{ TLazDockTree }
procedure TLazDockTree.UndockControlForDocking(AControl: TControl);
var
AWinControl: TWinControl;
begin
// undock AControl
if AControl is TWinControl then begin
AWinControl:=TWinControl(AControl);
if AWinControl.DockManager<>nil then begin
// TODO
end;
if AWinControl.DockSite<>nil then begin
// TODO
end;
end;
if AControl.Parent<>nil then begin
AControl.Parent:=nil;
end;
end;
constructor TLazDockTree.Create(TheDockSite: TWinControl);
begin
DockZoneClass:=TLazDockZone;
if TheDockSite=nil then begin
TheDockSite:=TLazDockForm.Create(nil);
TheDockSite.DockManager:=Self;
FAutoFreeDockSite:=true;
end;
inherited Create(TheDockSite);
end;
destructor TLazDockTree.Destroy;
begin
if FAutoFreeDockSite then begin
if FDockSite.DockManager=Self then
FDockSite.DockManager:=nil;
FDockSite.Free;
FDockSite:=nil;
end;
inherited Destroy;
end;
procedure TLazDockTree.InsertControl(AControl: TControl; InsertAt: TAlign;
DropControl: TControl);
{ undocks AControl and docks it into the tree
It creates a new TDockZone for AControl and inserts it as a new leaf.
It automatically changes the tree, so that the parent of the new TDockZone
will have the Orientation for InsertAt.
Example 1:
A newly created TLazDockTree has only a DockSite (TLazDockForm) and a single
TDockZone - the RootZone, which has as ChildControl the DockSite.
Visual:
+-DockSite--+
| |
+-----------+
Tree of TDockZone:
RootZone (DockSite,doNoOrient)
Inserting the first control: InsertControl(Form1,alLeft,nil);
Visual:
+-DockSite---+
|+--Form1---+|
|| ||
|+----------+|
+------------+
Tree of TDockZone:
RootZone (DockSite,doHorizontal)
+-Zone2 (Form1,doNoOrient)
Dock Form2 right of Form1: InsertControl(Form2,alLeft,Form1);
Visual:
+-DockSite----------+
|+-Form1-+|+-Form2-+|
|| || ||
|+-------+|+-------+|
+-------------------+
Tree of TDockZone:
RootZone (DockSite,doHorizontal)
+-Zone2 (Form1,doNoOrient)
+-Zone3 (Form2,doNoOrient)
}
var
DropZone: TDockZone;
NewZone: TDockZone;
begin
if DropControl=nil then
DropControl:=DockSite;
DropZone:=RootZone.FindZone(DropControl);
if DropZone=nil then
raise Exception.Create('TLazDockTree.InsertControl DropControl is not part of this TDockTree');
NewOrientation:=DockAlignOrientations[InsertAt];
// TODO: check what needs to be done
// undock
UndockControlForDocking(AControl);
// dock
// create a new zone for AControl
NewZone:=DockZoneClass.Create(Self,AControl);
// insert new zone into tree
if (DropZone=RootZone) and (RootZone.FirstChild=nil) then begin
// this is the first child
debugln('TLazDockTree.InsertControl First Child');
RootZone.Orientation:=NewOrientation;
RootZone.AddAsFirstChild(NewZone);
if not AControl.Visible then
DockSite.Visible:=false;
DockSite.BoundsRect:=AControl.BoundsRect;
AControl.Parent:=DockSite;
if AControl.Visible then
DockSite.Visible:=true;
end else begin
// there are already other childs
if DropZone.Parent=nil then begin
// insert as child of RootZone
// TODO
RaiseGDBException('TLazDockTree.InsertControl TODO: DropZone.Parent=nil');
end else begin
if (DropZone.Parent.Orientation=NewOrientation)
or (DropZone.Parent.Orientation=doNoOrient)
or (DropZone.Parent.ChildCount<=1) then begin
// insert as first or last child
DropZone.Parent.Orientation:=NewOrientation;
if InsertAt in [alLeft,alTop] then
DropZone.Parent.AddAsFirstChild(NewZone)
else
DropZone.Parent.AddAsLastChild(NewZone);
// resize DockSite
// add splitter control
// add control to DockSite
// TODO
RaiseGDBException('TLazDockTree.InsertControl TODO: DropZone.Parent<>nil');
end;
end;
end;
end;
end.