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

implemented basic manual docking

Browse Source 
git-svn-id: trunk@5821 -
This commit is contained in:
mattias 2004-08-18 22:56:11 +00:00
parent f576d2fccd
commit f46b2eb66c
4 changed files with 137 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/controls.pp
View File

@ -670,7 +670,8 @@ type
cfRequestAlignNeeded,
cfClientWidthLoaded,
cfClientHeightLoaded,
cfLastAlignedBoundsValid
cfLastAlignedBoundsValid,
cfBoundsRectForNewParentValid
);
TControlFlags = set of TControlFlag;
@ -704,6 +705,7 @@ type
FBaseBoundsLock: integer;
FBaseParentClientSize: TPoint;
FBorderSpacing: TControlBorderSpacing;
FBoundsRectForNewParent: TRect;
FCaption: TCaption;
FColor: TColor;
FConstraints: TSizeConstraints;
@ -804,6 +806,7 @@ type
procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
procedure SetBoundsRect(const ARect : TRect);
procedure SetBoundsRectForNewParent(const AValue: TRect);
procedure SetClientHeight(Value: Integer);
procedure SetClientSize(Value: TPoint);
procedure SetClientWidth(Value: Integer);
@ -1074,6 +1077,7 @@ type
property Align: TAlign read FAlign write SetAlign;
property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
property BoundsRectForNewParent: TRect read FBoundsRectForNewParent write SetBoundsRectForNewParent;
property Caption: TCaption read GetText write SetText stored IsCaptionStored;
property ClientOrigin: TPoint read GetClientOrigin;
property ClientRect: TRect read GetClientRect;
@ -1517,7 +1521,7 @@ type
procedure EndUpdateBounds;
procedure LockRealizeBounds;
procedure UnlockRealizeBounds;
procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic;
procedure DockDrop(DockObject: TDragDockObject; X, Y: Integer); dynamic;
Function CanFocus : Boolean;
Function ControlAtPos(const Pos : TPoint; AllowDisabled : Boolean): TControl;
Function ControlAtPos(const Pos : TPoint;
@ -2405,6 +2409,9 @@ end.
{ =============================================================================
$Log$
Revision 1.238 2004/08/18 22:56:11 mattias
implemented basic manual docking
Revision 1.237 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

81
lcl/include/control.inc
View File

@ -99,10 +99,28 @@ end;
------------------------------------------------------------------------------}
procedure TControl.DoDock(NewDockSite: TWinControl; var ARect: TRect);
begin
if (NewDockSite = nil) then Parent := nil;
if NewDockSite<>nil then begin
DebugLn('TControl.DoDock BEFORE Adjusting ',Name,' ',dbgs(ARect));
// adjust new bounds, so that they at least fit into the client area of
// its parent
LCLProc.MoveRectToFit(ARect,NewDockSite.ClientRect);
// consider Align to increase chance the width/height is kept
case Align of
alLeft: OffsetRect(ARect,-ARect.Left,0);
alTop: OffsetRect(ARect,0,-ARect.Top);
alRight: OffsetRect(ARect,NewDockSite.ClientWidth-ARect.Right,0);
alBottom: OffsetRect(ARect,0,NewDockSite.ClientHeight-ARect.Bottom);
end;
DebugLn('TControl.DoDock AFTER Adjusting ',Name,' ',dbgs(ARect),' Align=',AlignNames[Align],' NewDockSite.ClientRect=',dbgs(NewDockSite.ClientRect));
end;
//debugln('TControl.DoDock BEFORE MOVE ',Name,' BoundsRect=',dbgs(BoundsRect),' NewRect=',dbgs(ARect));
BoundsRect := ARect;
//debugln('TControl.DoDock AFTER MOVE ',Name,' BoundsRect=',dbgs(BoundsRect),' NewRect=',dbgs(ARect));
if Parent<>NewDockSite then
BoundsRectForNewParent := ARect
else
BoundsRect := ARect;
debugln('TControl.DoDock AFTER MOVE ',Name,' BoundsRect=',dbgs(BoundsRect),' TriedRect=',dbgs(ARect));
end;
{------------------------------------------------------------------------------
@ -503,15 +521,22 @@ end;
procedure TControl.CalculateDockSizes;
begin
if Floating then begin
// the control is floating. Save Width and Height for undocking
UndockHeight:=Height;
UndockWidth:=Width;
end
else if HostDockSite<>nil then begin
// the control is docked into a HostSite. That means some of it bounds
// were maximized to fit into the HostSite.
if (DockOrientation=doHorizontal)
or (HostDockSite.Align in [alLeft,alRight]) then
// the control is aligned left/right, that means its width is not
// maximized. Save Width for docking.
LRDockWidth:=Width
else if (DockOrientation=doVertical)
or (HostDockSite.Align in [alTop,alBottom]) then
// the control is aligned top/bottom, that means its height is not
// maximized. Save Height for docking.
TBDockHeight:=Height;
end;
end;
@ -650,9 +675,9 @@ begin
Result := FVisible and ((Parent = nil) or (Parent.IsVisible));
end;
{------------------------------------------------------------------------------}
{ TControl SetTabOrder }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TControl SetTabOrder
------------------------------------------------------------------------------}
Procedure TControl.SetTabOrder(Value : TTabOrder);
Begin
if csLoading in ComponentState then
@ -661,9 +686,9 @@ Begin
UpdateTabOrder(Value);
end;
{------------------------------------------------------------------------------}
{ TControl UpdateTabOrder }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TControl UpdateTabOrder
------------------------------------------------------------------------------}
Procedure TControl.UpdateTabOrder(Value : TTabOrder);
var
CurentOrder,
@ -1885,6 +1910,12 @@ Begin
SetBounds(Left,Top,Right - Left, Bottom - Top);
end;
procedure TControl.SetBoundsRectForNewParent(const AValue: TRect);
begin
Include(FControlFlags,cfBoundsRectForNewParentValid);
FBoundsRectForNewParent:=AValue;
end;
{------------------------------------------------------------------------------
TControl SetClientHeight
------------------------------------------------------------------------------}
@ -2497,6 +2528,10 @@ begin
if FParent = NewParent then exit;
CheckNewParent(NewParent);
if FParent <> nil then FParent.RemoveControl(Self);
if cfBoundsRectForNewParentValid in FControlFlags then begin
Exclude(FControlFlags,cfBoundsRectForNewParentValid);
BoundsRect:=BoundsRectForNewParent;
end;
if NewParent <> nil then NewParent.InsertControl(Self);
end;
@ -2794,27 +2829,39 @@ var
begin
if (NewDockSite=nil) then begin
// undock / float this control
// float the control at the same screen position
if HostDockSiteManagerAvailable(HostDockSite) then begin
HostDockSite.DockManager.GetControlBounds(Self,NewBounds);
NewBounds.TopLeft:=HostDockSite.ControlToScreen(NewBounds.TopLeft);
NewBounds.TopLeft:=HostDockSite.ClientToScreen(NewBounds.TopLeft);
end else begin
NewBounds.TopLeft:=ControlOrigin;
end;
NewBounds := Bounds(NewBounds.Left,NewBounds.Top,UndockWidth,UndockHeight);
DebugLn('TControl.ManualDock ',Name,' NewDockSite=nil HostDockSiteManagerAvailable=',dbgs(HostDockSiteManagerAvailable(HostDockSite)),' NewBounds=',dbgs(NewBounds));
Result := ManualFloat(NewBounds);
end
else
begin
// dock / unfloat this control
CalculateDockSizes;
Result := (HostDockSite=nil) or HostDockSite.DoUndock(NewDockSite,Self);
Result := (HostDockSite=nil);
if not Result then begin
// undock from old HostSite
DebugLn('TControl.ManualDock UNDOCKING ',Name);
Result:=HostDockSite.DoUndock(NewDockSite,Self);
end;
if Result then begin
DebugLn('TControl.ManualDock DOCKING ',Name);
// create TDragDockObject for docking parameters
DockObject := TDragDockObject.Create(Self);
try
// map from old HostSite to screen coordinates
NewPosition:=Point(Left,Top);
// get current screen coordinates
if HostDockSite<>nil then
NewPosition:=HostDockSite.ControlToScreen(NewPosition);
NewPosition:=HostDockSite.ClientToScreen(Point(Left,Top))
else
NewPosition:=ControlOrigin;
// initialize DockObject
with DockObject do begin
FDragTarget := NewDockSite;
@ -2822,9 +2869,10 @@ begin
FDropOnControl := DropControl;
DockRect := Bounds(NewPosition.X,NewPosition.Y,Width,Height);
end;
// map from screen to new HostSite coordinates
NewPosition:=NewDockSite.ScreenToControl(NewPosition);
// map from screen coordinates to new HostSite coordinates
NewPosition:=NewDockSite.ScreenToClient(NewPosition);
// DockDrop
DebugLn('TControl.ManualDock DOCKDROP ',Name,' DockRect=',dbgs(DockObject.DockRect),' NewPos=',dbgs(NewPosition));
NewDockSite.DockDrop(DockObject,NewPosition.X,NewPosition.Y);
finally
DockObject.Free;
@ -3227,6 +3275,9 @@ end;
{ =============================================================================
$Log$
Revision 1.211 2004/08/18 22:56:11 mattias
implemented basic manual docking
Revision 1.210 2004/08/18 20:49:02 mattias
simple forms can now be child controls

37
lcl/include/wincontrol.inc
View File

@ -1925,6 +1925,7 @@ end;
function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl
): Boolean;
begin
DebugLn('TWinControl.DoUnDock ',Name,' NewTarget=',DbgSName(NewTarget),' Client=',DbgSName(Client));
if Assigned(FOnUnDock) then begin
Result := True;
FOnUnDock(Self,Client,NewTarget,Result);
@ -3520,9 +3521,40 @@ begin
RealizeBounds;
end;
procedure TWinControl.DockDrop(Source: TDragDockObject; X, Y: Integer);
{------------------------------------------------------------------------------
procedure TWinControl.DockDrop(DockObject: TDragDockObject; X, Y: Integer);
------------------------------------------------------------------------------}
procedure TWinControl.DockDrop(DockObject: TDragDockObject; X, Y: Integer);
var
DestRect: TRect;
ParentForm: TCustomForm;
MappedLeftTop: TPoint;
begin
// get dock destination rectangle and map it to the client area
DestRect := DockObject.DockRect;
MappedLeftTop:=ScreenToClient(DestRect.TopLeft);
OffsetRect(DestRect,
DestRect.Left-MappedLeftTop.X,DestRect.Top-MappedLeftTop.Y);
DebugLn('TWinControl.DockDrop A ',Name,' DockControl=',DbgSName(DockObject.Control),' DestRect=',dbgs(DestRect));
DisableAlign;
try
if (not UseDockManager) or (DockManager=nil) then begin
// Delphi ignores the DropAlign when no DockManager is available
// Why that?
DockObject.Control.Align:=DockObject.DropAlign;
end;
DockObject.Control.Dock(Self, DestRect);
if UseDockManager and (DockManager <> nil) then
DockManager.InsertControl(DockObject.Control,
DockObject.DropAlign, DockObject.DropOnControl);
finally
EnableAlign;
end;
ParentForm := GetParentForm(Self);
if ParentForm<>nil then ParentForm.BringToFront;
if Assigned(FOnDockDrop) then
FOnDockDrop(Self, DockObject, X, Y);
end;
{------------------------------------------------------------------------------
@ -3793,6 +3825,9 @@ end;
{ =============================================================================
$Log$
Revision 1.264 2004/08/18 22:56:11 mattias
implemented basic manual docking
Revision 1.263 2004/08/18 20:49:02 mattias
simple forms can now be child controls

27
lcl/lclproc.pas
View File

@ -29,7 +29,7 @@ unit LCLProc;
interface
uses
Classes, SysUtils, LCLStrConsts, LCLType;
Classes, SysUtils, Math, LCLStrConsts, LCLType;
type
{ TMethodList - array of TMethod }
@ -85,6 +85,7 @@ procedure RegisterInterfaceFinalizationHandler(p: TProcedure);
procedure CallInterfaceFinalizationHandlers;
function OffsetRect(var ARect: TRect; dx,dy: Integer): Boolean;
procedure MoveRectToFit(var ARect: TRect; const MaxRect: TRect);
procedure MakeMinMax(var i1, i2: integer);
procedure CalculateLeftTopWidthHeight(X1,Y1,X2,Y2: integer;
var Left,Top,Width,Height: integer);
@ -488,6 +489,30 @@ begin
if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;
procedure MoveRectToFit(var ARect: TRect; const MaxRect: TRect);
begin
if ARect.Left<MaxRect.Left then begin
// move rectangle right
ARect.Right:=Min(ARect.Right+MaxRect.Left-ARect.Left,MaxRect.Right);
ARect.Left:=MaxRect.Left;
end;
if ARect.Top<MaxRect.Top then begin
// move rectangle down
ARect.Bottom:=Min(ARect.Bottom+MaxRect.Top-ARect.Top,MaxRect.Bottom);
ARect.Top:=MaxRect.Top;
end;
if ARect.Right>MaxRect.Right then begin
// move rectangle left
ARect.Left:=Max(ARect.Left-ARect.Right+MaxRect.Right,MaxRect.Left);
ARect.Right:=MaxRect.Right;
end;
if ARect.Bottom>MaxRect.Bottom then begin
// move rectangle left
ARect.Top:=Max(ARect.Top-ARect.Bottom+MaxRect.Bottom,MaxRect.Top);
ARect.Bottom:=MaxRect.Bottom;
end;
end;
procedure MakeMinMax(var i1, i2: integer);
var
h: Integer;