paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

added docking properties

Browse Source 
git-svn-id: trunk@4316 -
This commit is contained in:
mattias 2003-06-25 18:12:32 +00:00
parent 3057f78850
commit 0cf05a0a1c
3 changed files with 252 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
lcl/controls.pp
View File

@ -159,7 +159,8 @@ const
type
TWinControl = class;
TControl = class;
TWinControlClass = class of TWinControl;
TDate = type TDateTime;
TTime = type TDateTime;
@ -323,16 +324,19 @@ type
{ TDragObject }
TDragState = (dsDragEnter, dsDragLEave, dsDragMove);
TDragObject = class;
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
TDragMode = (dmManual , dmAutomatic);
TDragKind = (dkDrag, dkDock);
TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop,
dmDragCancel,dmFindTarget);
TDragOverEvent = Procedure(Sender, Source: TObject;
X,Y : Integer; State: TDragState; Var Accept: Boolean) of Object;
TDragDropEvent = Procedure(Sender, Source: TObject; X,Y : Integer) of Object;
TDragObject = class;
TDragDropEvent = Procedure(Sender, Source: TObject; X,Y: Integer) of Object;
TStartDragEvent = Procedure(Sender: TObject; DragObject: TDragObject) of Object;
TEndDragEvent = Procedure(Sender, Target: TObject; X,Y: Integer) of Object;
PDragRec = ^TDragRec;
TDragRec = record
@ -357,6 +361,7 @@ type
FDragHandle: HWND;
FDragPos: TPoint;
FDragTargetPos: TPoint;
FDropped: Boolean;
FMouseDeltaX: Double;
FMouseDeltaY: Double;
FCancelling: Boolean;
@ -378,27 +383,87 @@ type
property DragPos: TPoint read FDragPos write FDragPos;
property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
property DragTarget: Pointer read FDragTarget write FDragTarget;
property Dropped: Boolean read FDropped;
property MouseDeltaX: Double read FMouseDeltaX;
property MouseDeltaY: Double read FMouseDeltaX;
end;
TStartDragEvent = Procedure(Sender : TObject; DragObject: TDragObject) of Object;
TEndDragEvent = Procedure(Sender , Target: TObject; X,Y : Integer) of Object;
TDragObjectClass = class of TDragObject;
{ TBaseDragControlObject }
TBaseDragControlObject = class(TDragObject)
private
FControl : TControl;
protected
Procedure EndDrag(Target: TObject; X,Y : Integer); Virtual;
Procedure EndDrag(Target: TObject; X, Y: Integer); Virtual;
procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); override;
Public
constructor Create(AControl : TControl); virtual;
property Control : TControl read FControl write FControl;
end;
TDragControlObject = class(TBaseDragControlObject)
constructor Create(AControl: TControl); virtual;
property Control: TControl read FControl write FControl;
end;
{ TDragControlObject }
TDragControlObject = class(TBaseDragControlObject)
protected
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
function GetDragImages: TDragImageList; override;
public
procedure HideDragImage; override;
procedure ShowDragImage; override;
end;
{ TDragDockObject }
TDragDockObject = class;
TDockOrientation = (
doNoOrient, // zone contains a TControl and no child zones.
doHorizontal, // zone's children are stacked top-to-bottom.
doVertical // zone's children are arranged left-to-right.
);
TDockDropEvent = procedure(Sender: TObject; Source: TDragDockObject;
X, Y: Integer) of object;
TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState;
var Accept: Boolean) of object;
TUnDockEvent = procedure(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean) of object;
TStartDockEvent = procedure(Sender: TObject;
var DragObject: TDragDockObject) of object;
TDragDockObject = class(TBaseDragControlObject)
private
FBrush: TBrush;
FDockRect: TRect;
FDropAlign: TAlign;
FDropOnControl: TControl;
//FEraseDockRect: TRect;
FFloating: Boolean;
procedure SetBrush(Value: TBrush);
protected
procedure AdjustDockRect(ARect: TRect); virtual;
procedure DrawDragDockImage; virtual;
procedure EndDrag(Target: TObject; X, Y: Integer); override;
procedure EraseDragDockImage; virtual;
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
function GetFrameWidth: Integer; virtual;
public
constructor Create(AControl: TControl); override;
destructor Destroy; override;
procedure Assign(Source: TDragObject); override;
property Brush: TBrush read FBrush write SetBrush;
property DockRect: TRect read FDockRect write FDockRect;
property DropAlign: TAlign read FDropAlign;
property DropOnControl: TControl read FDropOnControl;
property Floating: Boolean read FFloating write FFloating;
property FrameWidth: Integer read GetFrameWidth;
end;
{ TSizeConstraints }
@ -497,10 +562,12 @@ type
FControlStyle: TControlStyle;
FCtl3D : Boolean;
FCursor : TCursor;
FDockOrientation: TDockOrientation;
FDragCursor : TCursor;
FDragKind : TDragKind;
FDragMode : TDragMode;
FEnabled : Boolean;
FFloatingDockSiteClass: TWinControlClass;
FFont: TFont;
FHeight: Integer;
FHelpContext: THelpContext;
@ -518,6 +585,7 @@ type
FLastResizeWidth: integer;
FLeft: Integer;
FLoadedClientSize: TPoint;
FLRDockWidth: Integer;
FMouseEntered: boolean;
FOnChangeBounds: TNotifyEvent;
FOnClick: TNotifyEvent;
@ -545,16 +613,25 @@ type
FSizeLock: integer;
FTabOrder: integer;
FTabStop : Boolean;
FTBDockHeight: Integer;
FText : TCaption;
FTop: Integer;
FUndockHeight: Integer;
FUndockWidth: Integer;
FVisible: Boolean;
FWidth: Integer;
FWindowProc: TWndMethod;
function GetBoundsRect : TRect;
function GetClientHeight: Integer;
function GetClientWidth: Integer;
function GetFloating: Boolean;
function GetFloatingDockSiteClass: TWinControlClass;
function GetLRDockWidth: Integer;
function GetMouseCapture : Boolean;
Function GetTabOrder: TTabOrder;
function GetTBDockHeight: Integer;
Function GetTabOrder: TTabOrder;
function GetUndockHeight: Integer;
function GetUndockWidth: Integer;
function IsAnchorsStored: boolean;
function IsCaptionStored : Boolean;
function IsHelpContextStored: boolean;
@ -576,6 +653,7 @@ type
procedure SetHeight(Value: Integer);
procedure SetHelpContext(const AValue: THelpContext);
procedure SetHelpKeyword(const AValue: String);
procedure SetHostDockSite(const AValue: TWinControl);
procedure SetLeft(Value: Integer);
procedure SetMouseCapture(Value : Boolean);
procedure SetParentShowHint(Value : Boolean);
@ -636,10 +714,11 @@ type
procedure LockBaseBounds;
procedure UnlockBaseBounds;
procedure UpdateAnchorRules;
procedure BeginAutoDrag; dynamic;
procedure ChangeBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
procedure ChangeScale(M,D : Integer); dynamic;
procedure BeginAutoDrag; dynamic;
procedure Dock(NewDockSite: TWinControl; ARect: TRect); dynamic;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure TripleClick; dynamic;
@ -766,7 +845,6 @@ type
property Ctl3D: Boolean read FCtl3D write FCtl3D;//Is this needed for anything other than compatability?
property Enabled: Boolean read GetEnabled write SetEnabled default True;
property Font: TFont read FFont write SetFont;
property HostDockSite: TWincontrol read FHostDockSite write FHostDockSite;
property Parent: TWinControl read FParent write SetParent;
property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu;
property ShowHint: Boolean read FShowHint write SetShowHint default False;
@ -774,6 +852,16 @@ type
property WindowProc: TWndMethod read FWindowProc write FWindowProc;
property TabStop: Boolean read FTabStop write SetTabStop;
property TabOrder: TTabOrder read GetTabOrder write SetTaborder default -1;
public
// docking properties
property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation;
property Floating: Boolean read GetFloating;
property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass;
property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite;
property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth;
property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
property UndockHeight: Integer read GetUndockHeight write FUndockHeight;
property UndockWidth: Integer read GetUndockWidth write FUndockWidth;
public
property OnResize: TNotifyEvent read FOnResize write FOnResize;
property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
@ -1507,7 +1595,7 @@ end;
{$ENDIF}
{$I sizeconstraints.inc}
{$I BaseDragControlObject.inc}
{$I basedragcontrolobject.inc}
{$I controlsproc.inc}
{$I controlcanvas.inc}
{$I scrolledwindow.inc}
@ -1536,6 +1624,9 @@ end.
{ =============================================================================
$Log$
Revision 1.133 2003/06/25 18:12:32 mattias
added docking properties
Revision 1.132 2003/06/23 09:42:09 mattias
fixes for debugging lazarus

60
lcl/include/control.inc
View File

@ -81,6 +81,11 @@ begin
BeginDrag(Mouse.DragImmediate,Mouse.DragThreshold);
end;
procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);
begin
end;
{------------------------------------------------------------------------------}
{ TControl.BoundsChanged
}
@ -338,6 +343,28 @@ begin
Result := ClientRect.Right;
end;
function TControl.GetFloating: Boolean;
var
CurHostDockSite: TWinControl;
begin
CurHostDockSite:=HostDockSite;
Result := (CurHostDockSite <> nil)
and (CurHostDockSite is FloatingDockSiteClass);
end;
function TControl.GetFloatingDockSiteClass: TWinControlClass;
begin
Result := FFloatingDockSiteClass;
end;
function TControl.GetLRDockWidth: Integer;
begin
if FLRDockWidth>0 then
Result := FLRDockWidth
else
Result := UndockWidth;
end;
function TControl.IsAnchorsStored: boolean;
begin
Result:=Anchors<>[akLeft,akTop];
@ -376,6 +403,22 @@ Begin
Result := -1;
end;
function TControl.GetUndockHeight: Integer;
begin
if FUndockHeight>0 then
Result := FUndockHeight
else
Result := Height;
end;
function TControl.GetUndockWidth: Integer;
begin
if FUndockWidth>0 then
Result := FUndockWidth
else
Result := Width;
end;
{------------------------------------------------------------------------------}
{ TControl SetTabOrder }
{------------------------------------------------------------------------------}
@ -894,6 +937,14 @@ Begin
Result := GetCaptureControl = Self;
end;
function TControl.GetTBDockHeight: Integer;
begin
if FTBDockHeight>0 then
Result := FTBDockHeight
else
Result := UndockHeight;
end;
{------------------------------------------------------------------------------}
{ TControl GetPopupMenu }
{------------------------------------------------------------------------------}
@ -1893,6 +1944,12 @@ begin
FHelpKeyword:=AValue;
end;
procedure TControl.SetHostDockSite(const AValue: TWinControl);
begin
if AValue=FHostDockSite then exit;
Dock(AValue, BoundsRect);
end;
{------------------------------------------------------------------------------
Procedure TControl.SetParent(AParent : TWinControl);
------------------------------------------------------------------------------}
@ -2419,6 +2476,9 @@ end;
{ =============================================================================
$Log$
Revision 1.138 2003/06/25 18:12:32 mattias
added docking properties
Revision 1.137 2003/06/23 09:42:09 mattias
fixes for debugging lazarus

84
lcl/include/dragobject.inc
View File

@ -1,3 +1,5 @@
// included by controls.pp
{******************************************************************************
TDragObject
******************************************************************************
@ -16,6 +18,8 @@
*****************************************************************************
}
{ TDragObject }
procedure TDragObject.Assign(Source: TDragObject);
begin
FDragTarget := Source.FDragTarget;
@ -117,3 +121,83 @@ procedure TDragObject.ShowDragImage;
begin
// do nothing
end;
{ TDragControlObject }
function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
): TCursor;
begin
Result:=inherited GetDragCursor(Accepted, X, Y);
end;
function TDragControlObject.GetDragImages: TDragImageList;
begin
Result:=inherited GetDragImages;
end;
procedure TDragControlObject.HideDragImage;
begin
inherited HideDragImage;
end;
procedure TDragControlObject.ShowDragImage;
begin
inherited ShowDragImage;
end;
{ TDragDockObject }
procedure TDragDockObject.SetBrush(Value: TBrush);
begin
end;
procedure TDragDockObject.AdjustDockRect(ARect: TRect);
begin
end;
procedure TDragDockObject.DrawDragDockImage;
begin
end;
procedure TDragDockObject.EndDrag(Target: TObject; X, Y: Integer);
begin
inherited EndDrag(Target, X, Y);
end;
procedure TDragDockObject.EraseDragDockImage;
begin
end;
function TDragDockObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
): TCursor;
begin
Result:=inherited GetDragCursor(Accepted, X, Y);
end;
function TDragDockObject.GetFrameWidth: Integer;
begin
Result:=4;
end;
constructor TDragDockObject.Create(AControl: TControl);
begin
inherited Create(AControl);
end;
destructor TDragDockObject.Destroy;
begin
inherited Destroy;
end;
procedure TDragDockObject.Assign(Source: TDragObject);
begin
inherited Assign(Source);
end;
// included by controls.pp