mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-11 01:38:15 +02:00
LCL: undo docking patch
git-svn-id: trunk@13349 -
This commit is contained in:
parent
767859d068
commit
fd641213fc
@ -1519,15 +1519,6 @@ Begin
|
|||||||
ecFindPrevWordOccurrence:
|
ecFindPrevWordOccurrence:
|
||||||
FindNextWordOccurrence(false);
|
FindNextWordOccurrence(false);
|
||||||
|
|
||||||
ecSetFreeBookmark:
|
|
||||||
FSourceNoteBook.BookMarkSetFreeClicked(Self);
|
|
||||||
|
|
||||||
ecPrevBookmark:
|
|
||||||
FSourceNoteBook.BookMarkPrevClicked(Self);
|
|
||||||
|
|
||||||
ecNextBookmark:
|
|
||||||
FSourceNoteBook.BookMarkNextClicked(Self);
|
|
||||||
|
|
||||||
ecSelectionEnclose:
|
ecSelectionEnclose:
|
||||||
EncloseSelection;
|
EncloseSelection;
|
||||||
|
|
||||||
|
@ -219,6 +219,7 @@ type
|
|||||||
property Width stored False;
|
property Width stored False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TPageControl }
|
{ TPageControl }
|
||||||
|
|
||||||
TPageControl = class(TCustomNotebook)
|
TPageControl = class(TCustomNotebook)
|
||||||
@ -239,7 +240,6 @@ type
|
|||||||
property ActivePageIndex: Integer read GetActivePageIndex
|
property ActivePageIndex: Integer read GetActivePageIndex
|
||||||
write SetActivePageIndex;
|
write SetActivePageIndex;
|
||||||
property Pages[Index: Integer]: TTabSheet read GetTabSheet;
|
property Pages[Index: Integer]: TTabSheet read GetTabSheet;
|
||||||
procedure DockDrop(DockObject: TDragDockObject; X, Y: Integer); override;
|
|
||||||
published
|
published
|
||||||
property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet;
|
property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet;
|
||||||
property Align;
|
property Align;
|
||||||
@ -247,9 +247,9 @@ type
|
|||||||
property BorderSpacing;
|
property BorderSpacing;
|
||||||
//property BiDiMode;
|
//property BiDiMode;
|
||||||
property Constraints;
|
property Constraints;
|
||||||
property DockSite;
|
//property DockSite;
|
||||||
property DragCursor;
|
property DragCursor;
|
||||||
property DragKind;
|
//property DragKind;
|
||||||
property DragMode;
|
property DragMode;
|
||||||
property Enabled;
|
property Enabled;
|
||||||
property Font;
|
property Font;
|
||||||
@ -275,25 +275,25 @@ type
|
|||||||
property OnChange: TNotifyEvent read fOnPageChanged write fOnPageChanged;
|
property OnChange: TNotifyEvent read fOnPageChanged write fOnPageChanged;
|
||||||
property OnChanging;
|
property OnChanging;
|
||||||
property OnContextPopup;
|
property OnContextPopup;
|
||||||
property OnDockDrop;
|
//property OnDockDrop;
|
||||||
property OnDockOver;
|
//property OnDockOver;
|
||||||
property OnDragDrop;
|
property OnDragDrop;
|
||||||
property OnDragOver;
|
property OnDragOver;
|
||||||
//property OnDrawTab;
|
//property OnDrawTab;
|
||||||
property OnEndDock;
|
//property OnEndDock;
|
||||||
property OnEndDrag;
|
property OnEndDrag;
|
||||||
property OnEnter;
|
property OnEnter;
|
||||||
property OnExit;
|
property OnExit;
|
||||||
property OnGetImageIndex;
|
property OnGetImageIndex;
|
||||||
property OnGetSiteInfo;
|
//property OnGetSiteInfo;
|
||||||
property OnMouseDown;
|
property OnMouseDown;
|
||||||
property OnMouseMove;
|
property OnMouseMove;
|
||||||
property OnMouseUp;
|
property OnMouseUp;
|
||||||
property OnPageChanged;
|
property OnPageChanged;
|
||||||
property OnResize;
|
property OnResize;
|
||||||
property OnStartDock;
|
//property OnStartDock;
|
||||||
property OnStartDrag;
|
property OnStartDrag;
|
||||||
property OnUnDock;
|
//property OnUnDock;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -73,8 +73,6 @@ type
|
|||||||
TControl = class;
|
TControl = class;
|
||||||
TWinControlClass = class of TWinControl;
|
TWinControlClass = class of TWinControl;
|
||||||
TControlClass = class of TControl;
|
TControlClass = class of TControl;
|
||||||
TDragDockObject = class;
|
|
||||||
|
|
||||||
|
|
||||||
TDate = type TDateTime;
|
TDate = type TDateTime;
|
||||||
TTime = type TDateTime;
|
TTime = type TDateTime;
|
||||||
@ -103,13 +101,6 @@ type
|
|||||||
Result: LRESULT;
|
Result: LRESULT;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
TCMFloat = packed record
|
|
||||||
Msg: Cardinal;
|
|
||||||
Reserved: Integer;
|
|
||||||
DockSource: TDragDockObject;
|
|
||||||
Result: Integer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TCMDialogChar = TLMKEY;
|
TCMDialogChar = TLMKEY;
|
||||||
TCMDialogKey = TLMKEY;
|
TCMDialogKey = TLMKEY;
|
||||||
|
|
||||||
@ -371,17 +362,17 @@ type
|
|||||||
FMouseDeltaX: Double;
|
FMouseDeltaX: Double;
|
||||||
FMouseDeltaY: Double;
|
FMouseDeltaY: Double;
|
||||||
FCancelling: Boolean;
|
FCancelling: Boolean;
|
||||||
DragCapture: HWnd;
|
function Capture: HWND;
|
||||||
protected
|
protected
|
||||||
procedure Capture;
|
|
||||||
procedure ReleaseCapture;
|
|
||||||
procedure MainWndProc(var Message: TLMessage);
|
|
||||||
procedure WndProc(var Msg: TLMessage); virtual;
|
|
||||||
procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
|
procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
|
||||||
|
|
||||||
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
|
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
|
||||||
function GetDragImages: TDragImageList; virtual;
|
function GetDragImages: TDragImageList; virtual;
|
||||||
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
|
||||||
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); virtual;
|
||||||
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); virtual;
|
||||||
|
procedure CaptureChanged(OldCaptureControl: TControl); virtual;
|
||||||
|
procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
|
||||||
|
procedure KeyUp(var Key: Word; Shift: TShiftState); virtual;
|
||||||
public
|
public
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure Assign(Source: TDragObject); virtual;
|
procedure Assign(Source: TDragObject); virtual;
|
||||||
@ -395,7 +386,7 @@ type
|
|||||||
property DragPos: TPoint read FDragPos write FDragPos;
|
property DragPos: TPoint read FDragPos write FDragPos;
|
||||||
property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
|
property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
|
||||||
property DragTarget: TControl read FDragTarget write FDragTarget;
|
property DragTarget: TControl read FDragTarget write FDragTarget;
|
||||||
property Dropped: Boolean read FDropped write FDropped;
|
property Dropped: Boolean read FDropped;
|
||||||
property MouseDeltaX: Double read FMouseDeltaX;
|
property MouseDeltaX: Double read FMouseDeltaX;
|
||||||
property MouseDeltaY: Double read FMouseDeltaX;
|
property MouseDeltaY: Double read FMouseDeltaX;
|
||||||
end;
|
end;
|
||||||
@ -429,6 +420,8 @@ type
|
|||||||
|
|
||||||
{ TDragDockObject }
|
{ TDragDockObject }
|
||||||
|
|
||||||
|
TDragDockObject = class;
|
||||||
|
|
||||||
TDockOrientation = (
|
TDockOrientation = (
|
||||||
doNoOrient, // zone contains a TControl and no child zones.
|
doNoOrient, // zone contains a TControl and no child zones.
|
||||||
doHorizontal, // zone's children are stacked top-to-bottom.
|
doHorizontal, // zone's children are stacked top-to-bottom.
|
||||||
@ -453,7 +446,6 @@ type
|
|||||||
FDockRect: TRect;
|
FDockRect: TRect;
|
||||||
FDropAlign: TAlign;
|
FDropAlign: TAlign;
|
||||||
FDropOnControl: TControl;
|
FDropOnControl: TControl;
|
||||||
FEraseDockRect: TRect;
|
|
||||||
FFloating: Boolean;
|
FFloating: Boolean;
|
||||||
FIncreaseDockArea: Boolean;
|
FIncreaseDockArea: Boolean;
|
||||||
procedure SetBrush(Value: TBrush);
|
procedure SetBrush(Value: TBrush);
|
||||||
@ -470,38 +462,14 @@ type
|
|||||||
procedure Assign(Source: TDragObject); override;
|
procedure Assign(Source: TDragObject); override;
|
||||||
property Brush: TBrush read FBrush write SetBrush;
|
property Brush: TBrush read FBrush write SetBrush;
|
||||||
property DockRect: TRect read FDockRect write FDockRect;// screen coordinates
|
property DockRect: TRect read FDockRect write FDockRect;// screen coordinates
|
||||||
property DropAlign: TAlign read FDropAlign write FDropAlign;
|
property DropAlign: TAlign read FDropAlign;
|
||||||
property DropOnControl: TControl read FDropOnControl write FDropOnControl;
|
property DropOnControl: TControl read FDropOnControl;
|
||||||
property Floating: Boolean read FFloating write FFloating;
|
property Floating: Boolean read FFloating write FFloating;
|
||||||
property FrameWidth: Integer read GetFrameWidth;
|
property FrameWidth: Integer read GetFrameWidth;
|
||||||
property IncreaseDockArea: Boolean read FIncreaseDockArea;
|
property IncreaseDockArea: Boolean read FIncreaseDockArea;
|
||||||
property EraseDockRect: TRect read FEraseDockRect write FEraseDockRect;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TDragManager }
|
|
||||||
|
|
||||||
TDragManager = class(TPersistent)
|
|
||||||
public
|
|
||||||
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean); virtual;
|
|
||||||
procedure BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);virtual;
|
|
||||||
function Dragging(AControl: TControl): boolean; virtual;
|
|
||||||
procedure DragTo(const APosition: TPoint); virtual;
|
|
||||||
procedure DragDone(ADrop: Boolean); virtual;
|
|
||||||
procedure CancelDrag; virtual;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
DragManager: TDragManager;
|
|
||||||
|
|
||||||
//Drag and Dock wrappers to stay fully compatible
|
|
||||||
procedure BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);
|
|
||||||
function Dragging(AControl: TControl=nil): boolean;
|
|
||||||
procedure DragTo(const APosition: TPoint);
|
|
||||||
procedure DragDone(ADrop: Boolean);
|
|
||||||
procedure CancelDrag;
|
|
||||||
|
|
||||||
type
|
|
||||||
{ TDockManager is an abstract class for managing a dock site's docked
|
{ TDockManager is an abstract class for managing a dock site's docked
|
||||||
controls. See TDockTree below for the more info.
|
controls. See TDockTree below for the more info.
|
||||||
}
|
}
|
||||||
@ -1034,7 +1002,7 @@ type
|
|||||||
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
|
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
|
||||||
procedure WMRButtonUp(var Message: TLMRButtonUp); message LM_RBUTTONUP;
|
procedure WMRButtonUp(var Message: TLMRButtonUp); message LM_RBUTTONUP;
|
||||||
procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
|
procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
|
||||||
procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;
|
procedure WMDragStart(Var Message: TLMessage); message LM_DRAGSTART;//not in delphi
|
||||||
procedure WMMove(var Message: TLMMove); message LM_MOVE;
|
procedure WMMove(var Message: TLMMove); message LM_MOVE;
|
||||||
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
||||||
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
|
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
|
||||||
@ -1623,7 +1591,6 @@ type
|
|||||||
function CanTab: Boolean; override;
|
function CanTab: Boolean; override;
|
||||||
procedure DoDragMsg(var DragMsg: TCMDrag); override;
|
procedure DoDragMsg(var DragMsg: TCMDrag); override;
|
||||||
procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
|
procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
|
||||||
procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;
|
|
||||||
procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
|
procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
|
||||||
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
|
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
|
||||||
procedure DoSendShowHideToInterface; virtual;
|
procedure DoSendShowHideToInterface; virtual;
|
||||||
@ -2222,6 +2189,8 @@ var
|
|||||||
procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
|
procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
|
||||||
procedure SetCaptureControl(Control: TControl);
|
procedure SetCaptureControl(Control: TControl);
|
||||||
function GetCaptureControl: TControl;
|
function GetCaptureControl: TControl;
|
||||||
|
procedure CancelDrag;
|
||||||
|
procedure DragDone(Drop: Boolean);
|
||||||
|
|
||||||
var
|
var
|
||||||
NewStyleControls: Boolean;
|
NewStyleControls: Boolean;
|
||||||
@ -2262,6 +2231,7 @@ var
|
|||||||
// The interface knows, which TWinControl has the capture. This stores
|
// The interface knows, which TWinControl has the capture. This stores
|
||||||
// what child control of this TWinControl has actually the capture.
|
// what child control of this TWinControl has actually the capture.
|
||||||
CaptureControl: TControl=nil;
|
CaptureControl: TControl=nil;
|
||||||
|
DockSiteHash: TDynHashArray=nil;
|
||||||
|
|
||||||
procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
|
procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
|
||||||
Left, Top, Right, Bottom: integer);
|
Left, Top, Right, Bottom: integer);
|
||||||
@ -3366,11 +3336,11 @@ initialization
|
|||||||
//DebugLn('controls.pp - initialization');
|
//DebugLn('controls.pp - initialization');
|
||||||
Mouse := TMouse.Create;
|
Mouse := TMouse.Create;
|
||||||
DefaultDockTreeClass := TDockTree;
|
DefaultDockTreeClass := TDockTree;
|
||||||
DragManager := TDragManagerDefault.Create;
|
|
||||||
RegisterIntegerConsts(TypeInfo(TCursor), @IdentToCursor, @CursorToIdent);
|
RegisterIntegerConsts(TypeInfo(TCursor), @IdentToCursor, @CursorToIdent);
|
||||||
|
|
||||||
finalization
|
finalization
|
||||||
FreeThenNil(DragManager);
|
FreeThenNil(DockSiteHash);
|
||||||
FreeThenNil(Mouse);
|
FreeThenNil(Mouse);
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -1028,8 +1028,6 @@ type
|
|||||||
{ TPanel }
|
{ TPanel }
|
||||||
|
|
||||||
TPanel = class(TCustomPanel)
|
TPanel = class(TCustomPanel)
|
||||||
public
|
|
||||||
property DockManager;
|
|
||||||
published
|
published
|
||||||
property Align;
|
property Align;
|
||||||
property Alignment;
|
property Alignment;
|
||||||
@ -1039,7 +1037,6 @@ type
|
|||||||
property BevelInner;
|
property BevelInner;
|
||||||
property BevelOuter;
|
property BevelOuter;
|
||||||
property BevelWidth;
|
property BevelWidth;
|
||||||
//property BiDiMode;
|
|
||||||
property BorderWidth;
|
property BorderWidth;
|
||||||
property BorderStyle;
|
property BorderStyle;
|
||||||
property Caption;
|
property Caption;
|
||||||
@ -1048,20 +1045,12 @@ type
|
|||||||
property ClientWidth;
|
property ClientWidth;
|
||||||
property Color;
|
property Color;
|
||||||
property Constraints;
|
property Constraints;
|
||||||
//property Ctl3D;
|
|
||||||
property UseDockManager default True;
|
|
||||||
property DockSite;
|
|
||||||
property DragCursor;
|
property DragCursor;
|
||||||
property DragKind;
|
|
||||||
property DragMode;
|
property DragMode;
|
||||||
property Enabled;
|
property Enabled;
|
||||||
property FullRepaint;
|
|
||||||
property Font;
|
property Font;
|
||||||
//property Locked;
|
property FullRepaint;
|
||||||
//property ParentBiDiMode;
|
|
||||||
//property ParentBackground;
|
|
||||||
property ParentColor;
|
property ParentColor;
|
||||||
//property ParentCtl3D;
|
|
||||||
property ParentFont;
|
property ParentFont;
|
||||||
property ParentShowHint;
|
property ParentShowHint;
|
||||||
property PopupMenu;
|
property PopupMenu;
|
||||||
@ -1069,27 +1058,18 @@ type
|
|||||||
property TabOrder;
|
property TabOrder;
|
||||||
property TabStop;
|
property TabStop;
|
||||||
property Visible;
|
property Visible;
|
||||||
//property OnCanResize;
|
|
||||||
property OnClick;
|
property OnClick;
|
||||||
//property OnConstrainedResize;
|
|
||||||
//property OnContextPopup;
|
|
||||||
property OnDockDrop;
|
|
||||||
property OnDockOver;
|
|
||||||
property OnDblClick;
|
property OnDblClick;
|
||||||
property OnDragDrop;
|
property OnDragDrop;
|
||||||
property OnDragOver;
|
property OnDragOver;
|
||||||
property OnEndDock;
|
|
||||||
property OnEndDrag;
|
property OnEndDrag;
|
||||||
property OnEnter;
|
property OnEnter;
|
||||||
property OnExit;
|
property OnExit;
|
||||||
property OnGetSiteInfo;
|
|
||||||
property OnMouseDown;
|
property OnMouseDown;
|
||||||
property OnMouseMove;
|
property OnMouseMove;
|
||||||
property OnMouseUp;
|
property OnMouseUp;
|
||||||
property OnResize;
|
property OnResize;
|
||||||
property OnStartDock;
|
|
||||||
property OnStartDrag;
|
property OnStartDrag;
|
||||||
property OnUnDock;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TCustomTrayIcon }
|
{ TCustomTrayIcon }
|
||||||
|
@ -375,7 +375,6 @@ type
|
|||||||
FKeyPreview: Boolean;
|
FKeyPreview: Boolean;
|
||||||
FMenu: TMainMenu;
|
FMenu: TMainMenu;
|
||||||
FModalResult: TModalResult;
|
FModalResult: TModalResult;
|
||||||
FOldBorderStyle: TFormBorderStyle;
|
|
||||||
FOnActivate: TNotifyEvent;
|
FOnActivate: TNotifyEvent;
|
||||||
FOnClose: TCloseEvent;
|
FOnClose: TCloseEvent;
|
||||||
FOnCloseQuery: TCloseQueryEvent;
|
FOnCloseQuery: TCloseQueryEvent;
|
||||||
@ -431,7 +430,6 @@ type
|
|||||||
procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
|
procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
|
||||||
procedure WMSize(var message: TLMSize); message LM_Size;
|
procedure WMSize(var message: TLMSize); message LM_Size;
|
||||||
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
|
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
|
||||||
procedure LMDragStart(Var Message: TLMessage); message LM_DRAGSTART;//not in delphi
|
|
||||||
procedure AddHandler(HandlerType: TFormHandlerType;
|
procedure AddHandler(HandlerType: TFormHandlerType;
|
||||||
const Handler: TMethod; AsLast: Boolean);
|
const Handler: TMethod; AsLast: Boolean);
|
||||||
procedure RemoveHandler(HandlerType: TFormHandlerType;
|
procedure RemoveHandler(HandlerType: TFormHandlerType;
|
||||||
@ -604,8 +602,6 @@ type
|
|||||||
property ClientWidth;
|
property ClientWidth;
|
||||||
property Color;
|
property Color;
|
||||||
property Constraints;
|
property Constraints;
|
||||||
property DragKind;
|
|
||||||
property DragMode;
|
|
||||||
property DockSite;
|
property DockSite;
|
||||||
property Enabled;
|
property Enabled;
|
||||||
property Font;
|
property Font;
|
||||||
|
@ -62,8 +62,30 @@ end;
|
|||||||
starts immediately.
|
starts immediately.
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
|
procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
|
||||||
|
var
|
||||||
|
P : TPoint;
|
||||||
begin
|
begin
|
||||||
DragManager.BeginDrag(Self, Immediate, Threshold);
|
// start a drag operation, if not already running
|
||||||
|
if (DragControl = nil) then begin
|
||||||
|
|
||||||
|
// if the last mouse down was not followed by a mouse up, simulate a
|
||||||
|
// mouse up. This way applications need only to react to mouse up to
|
||||||
|
// clean up.
|
||||||
|
{$IFDEF VerboseDrag}
|
||||||
|
DebugLn('TControl.BeginDrag ',DbgSName(Self),' Immediate=',dbgs(Immediate));
|
||||||
|
{$endif}
|
||||||
|
if Immediate then
|
||||||
|
SetCaptureControl(nil);
|
||||||
|
if csLButtonDown in ControlState then begin
|
||||||
|
GetCursorPos(p);
|
||||||
|
P := ScreenToClient(p);
|
||||||
|
Perform(LM_LBUTTONUP, 0, Integer(PointToSmallPoint(p)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Threshold < 0 then
|
||||||
|
Threshold := Mouse.DragThreshold;
|
||||||
|
DragInitControl(Self,Immediate,Threshold);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -71,7 +93,7 @@ end;
|
|||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TControl.BeginAutoDrag;
|
procedure TControl.BeginAutoDrag;
|
||||||
begin
|
begin
|
||||||
DragManager.BeginDrag(Self, Mouse.DragImmediate,Mouse.DragThreshold);
|
BeginDrag(Mouse.DragImmediate,Mouse.DragThreshold);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -1093,7 +1115,6 @@ end;
|
|||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
Procedure TControl.DoDragMsg(var DragMsg: TCMDrag);
|
Procedure TControl.DoDragMsg(var DragMsg: TCMDrag);
|
||||||
var
|
var
|
||||||
Target: TWinControl;
|
|
||||||
Accepts: Boolean;
|
Accepts: Boolean;
|
||||||
Src: TObject;
|
Src: TObject;
|
||||||
P: TPoint;
|
P: TPoint;
|
||||||
@ -1103,7 +1124,6 @@ Begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Src := DragMsg.Dragrec^.Source;
|
Src := DragMsg.Dragrec^.Source;
|
||||||
P:=ScreenToClient(DragMsg.Dragrec^.Pos);
|
P:=ScreenToClient(DragMsg.Dragrec^.Pos);
|
||||||
Target := TWinControl(DragMsg.Dragrec^.Target);
|
|
||||||
{$IFDEF VerboseDrag}
|
{$IFDEF VerboseDrag}
|
||||||
DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.Dragrec^.Pos=',IntToStr(DragMsg.Dragrec^.Pos.X),',',IntToStr(DragMsg.Dragrec^.Pos.Y),' -> P=',IntToStr(P.X),IntToStr(P.Y));
|
DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.Dragrec^.Pos=',IntToStr(DragMsg.Dragrec^.Pos.X),',',IntToStr(DragMsg.Dragrec^.Pos.Y),' -> P=',IntToStr(P.X),IntToStr(P.Y));
|
||||||
//if P.X<0 then RaiseGDBException('');
|
//if P.X<0 then RaiseGDBException('');
|
||||||
@ -1116,19 +1136,21 @@ Begin
|
|||||||
dmDragEnter, dmDragLeave, dmDragMove:
|
dmDragEnter, dmDragLeave, dmDragMove:
|
||||||
begin
|
begin
|
||||||
Accepts := True;
|
Accepts := True;
|
||||||
if Src is TDragDockObject
|
case DragMsg.DragMessage of
|
||||||
then Target.DockOver(TDragDockObject(Src),P.X,P.Y,TDragState(DragMsg.DragMessage),Accepts)
|
dmDragEnter: DragOver(Src,P.X,P.Y,dsDragEnter,Accepts);
|
||||||
else DragOver(Src,P.X,P.Y,TDragState(DragMsg.DragMessage),Accepts);
|
dmDragLeave: DragOver(Src,P.X,P.Y,dsDragLeave,Accepts);
|
||||||
DragMsg.Result := Ord(Accepts);
|
dmDragMove : DragOver(Src,P.X,P.Y,dsDragMove,Accepts);
|
||||||
|
end;
|
||||||
|
if Accepts then
|
||||||
|
DragMsg.Result := 1
|
||||||
|
else
|
||||||
|
DragMsg.Result := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
dmDragDrop: begin
|
dmDragDrop:
|
||||||
if Src is TDragDockObject
|
DragDrop(Src, P.X, P.Y);
|
||||||
then Target.DockDrop(TDragDockObject(Src), P.X, P.Y)
|
|
||||||
else DragDrop(Src, P.X, P.Y);
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
end; //case
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -1158,9 +1180,6 @@ begin
|
|||||||
If Assigned(FOnDragDrop) then FOnDragDrop(Self, Source,X,Y);
|
If Assigned(FOnDragDrop) then FOnDragDrop(Self, Source,X,Y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TControl Method SetColor "Sets the default color and tells the widget set"
|
TControl Method SetColor "Sets the default color and tells the widget set"
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
@ -1187,7 +1206,7 @@ end;
|
|||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
Function TControl.Dragging: Boolean;
|
Function TControl.Dragging: Boolean;
|
||||||
Begin
|
Begin
|
||||||
Result := DragManager.Dragging(Self);
|
Result := (DragControl = self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -2400,27 +2419,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TControl.CMFloat(var Message: TCMFloat);
|
|
||||||
var
|
|
||||||
P: TPoint;
|
|
||||||
FloatHost: TWinControl;
|
|
||||||
begin
|
|
||||||
if Floating and (Parent <> nil)then
|
|
||||||
begin
|
|
||||||
P := Parent.ClientToScreen(Point(Left, Top));
|
|
||||||
with Message.DockSource.DockRect do begin
|
|
||||||
Parent.BoundsRect := Bounds(Left + Parent.Left - P.X, Top + Parent.Top - P.Y,
|
|
||||||
Right - Left + Parent.Width - Width, Bottom - Top + Parent.Height - Height);
|
|
||||||
end;
|
|
||||||
end else begin
|
|
||||||
FloatHost := CreateFloatingDockSite(Message.DockSource.DockRect);
|
|
||||||
if FloatHost <> nil then begin
|
|
||||||
Message.DockSource.DragTarget := FloatHost;
|
|
||||||
Message.DockSource.DragHandle := FloatHost.Handle;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TControl GetText
|
TControl GetText
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
@ -2916,37 +2914,10 @@ end;
|
|||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TControl DefaultDockImage
|
TControl DefaultDockImage
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean);
|
procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject;
|
||||||
var DrawRect: TRect;
|
Erase: Boolean);
|
||||||
PenSize: Integer;
|
|
||||||
ACanvas: TCanvas;
|
|
||||||
DC: HDC;
|
|
||||||
begin
|
begin
|
||||||
with DragDockObject do begin
|
// ToDo Dock: draw or erase dock image
|
||||||
if Erase
|
|
||||||
then DrawRect := EraseDockRect
|
|
||||||
else DrawRect := DockRect;
|
|
||||||
PenSize := FrameWidth;
|
|
||||||
end;
|
|
||||||
|
|
||||||
DC := GetDC(0);
|
|
||||||
ACanvas:= TCanvas.Create;
|
|
||||||
try
|
|
||||||
ACanvas.Handle:= DC;
|
|
||||||
ACanvas.Pen.Mode := pmXOR;
|
|
||||||
ACanvas.Pen.Color := clWhite;
|
|
||||||
ACanvas.Pen.Width := PenSize;
|
|
||||||
with DrawRect do begin
|
|
||||||
ACanvas.MoveTo(Left+PenSize, Top+PenSize);
|
|
||||||
ACanvas.LineTo(Right-PenSize,Top+PenSize);
|
|
||||||
ACanvas.LineTo(Right-PenSize, Bottom-PenSize);
|
|
||||||
ACanvas.LineTo(Left+PenSize,Bottom-PenSize);
|
|
||||||
ACanvas.LineTo(Left+PenSize, Top+PenSize);
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
ACanvas.Free;
|
|
||||||
ReleaseDC(0, DC);
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -3155,6 +3126,15 @@ begin
|
|||||||
FPopupMenu := Value;
|
FPopupMenu := Value;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{------------------------------------------------------------------------------
|
||||||
|
TControl WMDragStart
|
||||||
|
------------------------------------------------------------------------------}
|
||||||
|
Procedure TControl.WMDragStart(Var Message: TLMessage);
|
||||||
|
Begin
|
||||||
|
//do this here?
|
||||||
|
BeginDrag(true);
|
||||||
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TControl WMMouseMove
|
TControl WMMouseMove
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
@ -3176,6 +3156,7 @@ End;
|
|||||||
Procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
Procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||||
X, Y: Integer);
|
X, Y: Integer);
|
||||||
var
|
var
|
||||||
|
P: TPoint;
|
||||||
Form: TCustomForm;
|
Form: TCustomForm;
|
||||||
begin
|
begin
|
||||||
if (not (Self is TWinControl)) or (not TWinControl(Self).CanFocus) then begin
|
if (not (Self is TWinControl)) or (not TWinControl(Self).CanFocus) then begin
|
||||||
@ -3184,6 +3165,10 @@ begin
|
|||||||
Form.ActiveControl.EditingDone;
|
Form.ActiveControl.EditingDone;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
if (Button in [mbLeft,mbRight]) and (DragObject<>nil) then begin
|
||||||
|
P:=ClientToScreen(Point(X,Y));
|
||||||
|
DragObject.MouseDown(Button,Shift,P.X,P.Y);
|
||||||
|
end;
|
||||||
if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X,Y);
|
if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X,Y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -3191,7 +3176,17 @@ end;
|
|||||||
TControl MouseMove
|
TControl MouseMove
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
Procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
Procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
DragObjectDragging : Boolean;
|
||||||
begin
|
begin
|
||||||
|
if DragObject <> nil then
|
||||||
|
DragObjectDragging := true else
|
||||||
|
DragObjectDragging := false;
|
||||||
|
if DragObjectDragging then begin
|
||||||
|
P:=ClientToScreen(Point(X,Y));
|
||||||
|
DragObject.MouseMove(Shift,P.X,P.Y);
|
||||||
|
end;
|
||||||
if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X,Y);
|
if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X,Y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -3200,7 +3195,17 @@ end;
|
|||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
Procedure TControl.MouseUp(Button: TMouseButton; Shift:TShiftState;
|
Procedure TControl.MouseUp(Button: TMouseButton; Shift:TShiftState;
|
||||||
X, Y: Integer);
|
X, Y: Integer);
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
DragObjectDragging : Boolean;
|
||||||
begin
|
begin
|
||||||
|
if DragObject <> nil then
|
||||||
|
DragObjectDragging := true else
|
||||||
|
DragObjectDragging := false;
|
||||||
|
if (Button in [mbLeft,mbRight]) and DragObjectDragging then begin
|
||||||
|
P:=ClientToScreen(Point(X,Y));
|
||||||
|
DragObject.MouseUp(Button,Shift,P.X,P.Y);
|
||||||
|
end;
|
||||||
if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X,Y);
|
if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X,Y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -3218,10 +3223,11 @@ end;
|
|||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
procedure TControl.CaptureChanged;
|
procedure TControl.CaptureChanged;
|
||||||
now handled by dragobject
|
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TControl.CaptureChanged;
|
procedure TControl.CaptureChanged;
|
||||||
begin
|
begin
|
||||||
|
if (DragObject<>nil) then DragObject.CaptureChanged(Self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
@ -3475,8 +3481,6 @@ begin
|
|||||||
DockRect := Bounds(NewPosition.X,NewPosition.Y,Width,Height);
|
DockRect := Bounds(NewPosition.X,NewPosition.Y,Width,Height);
|
||||||
end;
|
end;
|
||||||
// map from screen coordinates to new HostSite coordinates
|
// map from screen coordinates to new HostSite coordinates
|
||||||
if (NewDockSite is TCustomForm) then
|
|
||||||
TCustomForm(NewDockSite).HandleNeeded;
|
|
||||||
NewPosition:=NewDockSite.ScreenToClient(NewPosition);
|
NewPosition:=NewDockSite.ScreenToClient(NewPosition);
|
||||||
// DockDrop
|
// DockDrop
|
||||||
DebugLn('TControl.ManualDock DOCKDROP ',Name,' DockRect=',dbgs(DockObject.DockRect),' NewPos=',dbgs(NewPosition));
|
DebugLn('TControl.ManualDock DOCKDROP ',Name,' DockRect=',dbgs(DockObject.DockRect),' NewPos=',dbgs(NewPosition));
|
||||||
@ -3708,13 +3712,6 @@ begin
|
|||||||
// make sure the capture is released
|
// make sure the capture is released
|
||||||
MouseCapture := false;
|
MouseCapture := false;
|
||||||
Application.ControlDestroyed(Self);
|
Application.ControlDestroyed(Self);
|
||||||
if (FHostDockSite <> nil) and not (csDestroying in FHostDockSite.ComponentState) then
|
|
||||||
begin
|
|
||||||
FHostDockSite.Perform(CM_UNDOCKCLIENT, 0, Integer(Self));
|
|
||||||
SetParent(nil);
|
|
||||||
//TODO:Dock(NullDockSite, BoundsRect);
|
|
||||||
FHostDockSite := nil;
|
|
||||||
end else
|
|
||||||
SetParent(nil);
|
SetParent(nil);
|
||||||
FreeThenNil(FActionLink);
|
FreeThenNil(FActionLink);
|
||||||
for Side:=Low(FAnchorSides) to High(FAnchorSides) do
|
for Side:=Low(FAnchorSides) to High(FAnchorSides) do
|
||||||
@ -3769,7 +3766,6 @@ begin
|
|||||||
FColor := clWindow;
|
FColor := clWindow;
|
||||||
FVisible := true;
|
FVisible := true;
|
||||||
FParentShowHint := True;
|
FParentShowHint := True;
|
||||||
FParentFont := True;
|
|
||||||
FParentColor := True;
|
FParentColor := True;
|
||||||
FWindowProc := @WndProc;
|
FWindowProc := @WndProc;
|
||||||
FCursor := crDefault;
|
FCursor := crDefault;
|
||||||
|
@ -431,7 +431,7 @@ var
|
|||||||
UserDropDown: boolean;
|
UserDropDown: boolean;
|
||||||
begin
|
begin
|
||||||
Skip := False;
|
Skip := False;
|
||||||
UserDropDown := ((Shift *[ssAlt] = [ssAlt]) and (Key = VK_DOWN));
|
UserDropDown := ((Shift *[ssCtrl] = [ssCtrl]) and (Key = VK_DOWN));
|
||||||
|
|
||||||
if AutoDropDown or UserDropDown or FReturnArrowState then
|
if AutoDropDown or UserDropDown or FReturnArrowState then
|
||||||
begin
|
begin
|
||||||
|
@ -940,17 +940,16 @@ begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
LCLIntf.SetFocus(FocusHandle);
|
LCLIntf.SetFocus(FocusHandle);
|
||||||
if not ContainsForm(Self) then exit;
|
if not ContainsForm(Self) then exit;
|
||||||
//LCLIntf.SetFocus(Self.Handle);
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
CM_EXIT:
|
CM_EXIT:
|
||||||
begin
|
begin
|
||||||
if HostDockSite <> nil then DeActivate;
|
//TODO: deal with docking if HostDockSite <> nil then DeActivate;
|
||||||
end;
|
end;
|
||||||
CM_ENTER:
|
CM_ENTER:
|
||||||
begin
|
begin
|
||||||
if HostDockSite <> nil then Activate;
|
//TODO: Deal with docking if HostDockSite <> nil then Activate;
|
||||||
end;
|
end;
|
||||||
LM_WINDOWPOSCHANGING:
|
LM_WINDOWPOSCHANGING:
|
||||||
if ([csLoading, csDesigning] * ComponentState = [csLoading])
|
if ([csLoading, csDesigning] * ComponentState = [csLoading])
|
||||||
@ -1027,18 +1026,9 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect);
|
procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect);
|
||||||
//Save or restore the form borderstyle before its (un)docked
|
|
||||||
begin
|
begin
|
||||||
if (NewDockSite <> HostDockSite) and ((NewDockSite = nil) or Floating) then
|
if (NewDockSite<>HostDockSite) then begin
|
||||||
begin
|
|
||||||
if NewDockSite = nil then
|
|
||||||
//Restore the form borderstyle
|
|
||||||
FFormBorderStyle := FOldBorderStyle
|
|
||||||
else begin
|
|
||||||
//Save the borderstyle & set new bordertype
|
|
||||||
FOldBorderStyle := FFormBorderStyle;
|
|
||||||
FFormBorderStyle := bsNone;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
inherited DoDock(NewDockSite, ARect);
|
inherited DoDock(NewDockSite, ARect);
|
||||||
end;
|
end;
|
||||||
@ -1438,6 +1428,7 @@ begin
|
|||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
Visible := False;
|
Visible := False;
|
||||||
fCompStyle:= csForm;
|
fCompStyle:= csForm;
|
||||||
|
|
||||||
FMenu:= nil;
|
FMenu:= nil;
|
||||||
|
|
||||||
ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse,
|
ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse,
|
||||||
@ -1456,8 +1447,6 @@ begin
|
|||||||
FAllowDropFiles := False;
|
FAllowDropFiles := False;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TCustomForm CreateParams
|
TCustomForm CreateParams
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
@ -1468,7 +1457,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
if (Parent = nil) {and (ParentWindow = 0)} then
|
if (Parent = nil) {and (ParentWindow = 0)} then
|
||||||
begin
|
begin
|
||||||
//WndParent := Application.Handle;
|
// WndParent := Application.Handle;
|
||||||
{ TODO : No application handle }
|
{ TODO : No application handle }
|
||||||
Style := Style and not Cardinal(WS_GROUP or WS_TABSTOP);
|
Style := Style and not Cardinal(WS_GROUP or WS_TABSTOP);
|
||||||
if Parent=nil then
|
if Parent=nil then
|
||||||
@ -2102,13 +2091,6 @@ begin
|
|||||||
inherited Dock(NewDockSite, ARect);
|
inherited Dock(NewDockSite, ARect);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomForm.LMDragStart(var Message: TLMessage);
|
|
||||||
begin
|
|
||||||
if (Message.wParam = HTCAPTION) and (DragKind = dkDock) and
|
|
||||||
not (csDesigning in ComponentState) and(WindowState <> wsMinimized)
|
|
||||||
then DragManager.BeginDrag(Self, not Floating, -1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
//==============================================================================
|
//==============================================================================
|
||||||
|
|
||||||
{ TForm }
|
{ TForm }
|
||||||
|
@ -43,7 +43,6 @@ begin
|
|||||||
Color:=clBtnFace;// clBackground;
|
Color:=clBtnFace;// clBackground;
|
||||||
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
|
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
|
||||||
ParentColor := True;
|
ParentColor := True;
|
||||||
UseDockManager := True;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomPanel.SetAlignment(const Value: TAlignment);
|
procedure TCustomPanel.SetAlignment(const Value: TAlignment);
|
||||||
|
@ -14,6 +14,16 @@
|
|||||||
*****************************************************************************
|
*****************************************************************************
|
||||||
}
|
}
|
||||||
|
|
||||||
|
var
|
||||||
|
DragControl: TControl=nil; // control, that started the drag
|
||||||
|
DragObject: TDragObject; // the drag information object
|
||||||
|
DragObjectAutoFree: Boolean; // True, if DragObject was auto created
|
||||||
|
DragStartPos: TPoint; // mouse position at start of drag
|
||||||
|
ActiveDrag: TDragOperation;// current phase of drag operation
|
||||||
|
DragThreshold: Integer;// treshold before the drag becomes activated
|
||||||
|
DragImages: TDragImageList; // DragObject.GetDragImages
|
||||||
|
|
||||||
|
Procedure DragTo(const Position: TPoint); forward;
|
||||||
|
|
||||||
{-------------------------------------------------------------------------------
|
{-------------------------------------------------------------------------------
|
||||||
function HostDockSiteManagerAvailable(HostDockSite: TWinControl): boolean;
|
function HostDockSiteManagerAvailable(HostDockSite: TWinControl): boolean;
|
||||||
@ -24,382 +34,42 @@ begin
|
|||||||
and (HostDockSite.DockManager<>nil);
|
and (HostDockSite.DockManager<>nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TDragManager }
|
{-------------------------------------------------------------------------------
|
||||||
|
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
||||||
procedure TDragManager.BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);
|
-------------------------------------------------------------------------------}
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragManager.DragTo(const APosition: TPoint);
|
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragManager.CancelDrag;
|
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragManager.DragDone(ADrop: Boolean);
|
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TDragManager.Dragging(AControl: TControl): boolean;
|
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
Result := false;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragManager.RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
|
||||||
begin
|
|
||||||
//Nothing, only avoiding abstract errors the dirty way
|
|
||||||
end;
|
|
||||||
|
|
||||||
//Drag and Drop wrappers
|
|
||||||
|
|
||||||
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
||||||
begin
|
begin
|
||||||
DragManager.RegisterDockSite(Site, DoRegister);
|
if (Site <> nil) then begin
|
||||||
end;
|
if DockSiteHash = nil then DockSiteHash := TDynHashArray.Create;
|
||||||
|
if DoRegister then begin
|
||||||
procedure BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);
|
if not DockSiteHash.Contains(Site) then
|
||||||
begin
|
DockSiteHash.Add(Site);
|
||||||
DragManager.BeginDrag(AControl, AImmediate, AThreshold);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function Dragging(AControl: TControl=nil): boolean;
|
|
||||||
begin
|
|
||||||
Result:=DragManager.Dragging(AControl);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function Dragging: boolean;
|
|
||||||
begin
|
|
||||||
Result:=DragManager.Dragging(nil);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure DragTo(const APosition: TPoint);
|
|
||||||
begin
|
|
||||||
DragManager.DragTo(APosition);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure DragDone(ADrop: Boolean);
|
|
||||||
begin
|
|
||||||
DragManager.DragDone(ADrop);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure CancelDrag;
|
|
||||||
begin
|
|
||||||
DragManager.CancelDrag;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
type
|
|
||||||
TDragManagerDefault = class(TDragManager)
|
|
||||||
private
|
|
||||||
FDockingPoints: TList;
|
|
||||||
FDragControl: TWinControl; //control that started the drag
|
|
||||||
FDragObject: TDragObject; // the drag information object
|
|
||||||
FActiveDrag: TDragOperation; // current phase of drag operation
|
|
||||||
FDragStartPos: TPoint; // mouse position at start of drag
|
|
||||||
FDragThreshold: Integer;// treshold before the drag becomes activated
|
|
||||||
FDragObjectAutoFree: Boolean; //Free the dragobject
|
|
||||||
FDragImageList: TDragImageList; //Images
|
|
||||||
protected
|
|
||||||
function SendCmDragMsg(DragMsg: TDragMessage): Boolean;
|
|
||||||
function SendDragMessage(MsgTarget: TControl; Msg: TDragMessage; Source: TDragObject; Target: TControl; const Position: TPoint): LRESULT;
|
|
||||||
protected
|
|
||||||
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);override;
|
|
||||||
procedure BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer); override;
|
|
||||||
function Dragging(AControl: TControl): boolean; override;
|
|
||||||
procedure DragTo(const APosition: TPoint); override;
|
|
||||||
procedure DragDone(Drop: Boolean); override;
|
|
||||||
procedure CancelDrag; override;
|
|
||||||
public
|
|
||||||
destructor Destroy; override;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ TDragManagerDefault }
|
|
||||||
|
|
||||||
destructor TDragManagerDefault.Destroy;
|
|
||||||
begin
|
|
||||||
FDockingPoints.Free;
|
|
||||||
inherited Destroy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TDragManagerDefault.Dragging(AControl: TControl): boolean;
|
|
||||||
//No need to let a TControl know the contents of dragmanager
|
|
||||||
begin
|
|
||||||
if AControl = nil
|
|
||||||
then Result := FActiveDrag <> dopNone
|
|
||||||
else Result := FDragControl=AControl;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TDragManagerDefault.SendCmDragMsg(DragMsg: TDragMessage): Boolean;
|
|
||||||
//Send a CM_DRAG message to the window..
|
|
||||||
begin
|
|
||||||
if FDragObject.DragTarget <> nil
|
|
||||||
then Result := boolean(SendDragMessage(FDragObject.DragTarget, DragMsg, FDragObject, FDragObject.DragTarget, FDragObject.DragPos))
|
|
||||||
else Result := false;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TDragManagerDefault.BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer);
|
|
||||||
//Start a drag operation, if not already running
|
|
||||||
var ADragObject: TDragObject;
|
|
||||||
begin
|
|
||||||
if FDragControl = nil then begin
|
|
||||||
ADragObject:=nil;
|
|
||||||
GetCursorPos(FDragStartPos);
|
|
||||||
FDragObjectAutoFree := false;
|
|
||||||
try
|
|
||||||
if AImmediate
|
|
||||||
then SetCaptureControl(nil);
|
|
||||||
|
|
||||||
//Use default value when Threshold < 0
|
|
||||||
if AThreshold >= 0
|
|
||||||
then FDragThreshold := AThreshold
|
|
||||||
else FDragThreshold := Mouse.DragThreshold; //Mayby move it to DragManager? (same for DragImmediate)
|
|
||||||
|
|
||||||
//From DragInitControl(AControl,AImmediate,AThreshold); ======================
|
|
||||||
if AControl is TWinControl
|
|
||||||
then FDragControl := TWinControl(AControl)
|
|
||||||
else raise Exception.CreateFmt('Dragged control %s is not a TWinControl',[AControl.Name]);
|
|
||||||
|
|
||||||
if AControl.DragKind = dkDrag then begin
|
|
||||||
AControl.DoStartDrag(ADragObject);
|
|
||||||
if ADragObject = nil then begin
|
|
||||||
ADragObject := TDragControlObject.Create(AControl);
|
|
||||||
FDragObjectAutoFree := true;
|
|
||||||
end
|
|
||||||
end else begin
|
end else begin
|
||||||
AControl.DoStartDock(ADragObject);
|
if DockSiteHash.Contains(Site) then
|
||||||
if ADragObject = nil then begin
|
DockSiteHash.Remove(Site);
|
||||||
ADragObject := TDragDockObject.Create(AControl);
|
|
||||||
FDragObjectAutoFree := true;
|
|
||||||
end;
|
|
||||||
|
|
||||||
with TDragDockObject(ADragObject)do begin
|
|
||||||
if AControl is TWinControl
|
|
||||||
then GetWindowRect(TWinControl(AControl).Handle, DockRect)
|
|
||||||
else begin
|
|
||||||
if(AControl.Parent = nil)and not(AControl is TWinControl)
|
|
||||||
then GetCursorPos(DockRect.TopLeft)
|
|
||||||
else DockRect.TopLeft := AControl.ClientToScreen(Point(0, 0));
|
|
||||||
DockRect.BottomRight := Point(DockRect.Left + AControl.Width,DockRect.Top + AControl.Height);
|
|
||||||
end;
|
|
||||||
EraseDockRect := DockRect;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
//From DragInit(ADragObject, AImmediate, AThreshold); ======================
|
|
||||||
FDragObject := ADragObject;
|
|
||||||
FDragObject.DragTarget := nil;
|
|
||||||
FDragObject.DragPos := FDragStartPos;
|
|
||||||
SetCaptureControl(AControl);
|
|
||||||
FDragObject.Capture;
|
|
||||||
if FDragObject is TDragDockObject then begin
|
|
||||||
with TDragDockObject(FDragObject), DockRect do begin
|
|
||||||
if AImmediate then begin
|
|
||||||
FActiveDrag := dopDock;
|
|
||||||
DrawDragDockImage;
|
|
||||||
end
|
|
||||||
else FActiveDrag := dopNone;
|
|
||||||
end;
|
|
||||||
end else begin
|
|
||||||
if AImmediate
|
|
||||||
then FActiveDrag := dopDrag
|
|
||||||
else FActiveDrag := dopNone;
|
|
||||||
end;
|
|
||||||
|
|
||||||
FDragImageList := FDragObject.GetDragImages; //crash?
|
|
||||||
if FDragImageList <> nil
|
|
||||||
then with FDragStartPos do FDragImageList.BeginDrag(0, X, Y);
|
|
||||||
|
|
||||||
if FActiveDrag <> dopNone
|
|
||||||
then DragTo(FDragStartPos);
|
|
||||||
except
|
|
||||||
FDragControl := nil;
|
|
||||||
raise;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDragManagerDefault.DragTo(const APosition: TPoint);
|
{-------------------------------------------------------------------------------
|
||||||
|
Function SendDragMessage(MsgTarget: TControl; Msg: TDragMessage;
|
||||||
|
Source: TDragObject; Target: TControl; const Pos: TPoint): longint;
|
||||||
|
|
||||||
function GetDropControl: TControl;
|
Send a CM_DRAG (TCMDrag) message to MsgTarget.
|
||||||
//Select a control where the dragged control will be docked
|
-------------------------------------------------------------------------------}
|
||||||
var ADragTarget: TWinControl;
|
Function SendDragMessage(MsgTarget: TControl; Msg: TDragMessage;
|
||||||
AControl: TControl;
|
Source: TDragObject; Target: TControl; const Position: TPoint): LRESULT;
|
||||||
i: integer;
|
var
|
||||||
begin
|
DragRec: TDragRec;
|
||||||
Result := nil;
|
|
||||||
ADragTarget := TWinControl(FDragObject.DragTarget);
|
|
||||||
if ADragTarget <> nil then begin
|
|
||||||
if ADragTarget.UseDockManager then begin
|
|
||||||
if ADragTarget.DockClientCount > 0 then begin
|
|
||||||
//Did the user drop it on the same positon? ?
|
|
||||||
AControl := ADragTarget.DockClients[0];
|
|
||||||
if (ADragTarget.DockClientCount = 1)and (AControl = FDragControl)
|
|
||||||
then Exit;
|
|
||||||
|
|
||||||
AControl := FindDragTarget(FDragObject.DragPos, false);
|
|
||||||
while(AControl <> nil)and(AControl <> ADragTarget)do begin
|
|
||||||
for i:=0 to ADragTarget.DockClientCount-1 do begin
|
|
||||||
if ADragTarget.DockClients[i]=AControl then begin
|
|
||||||
Result := ADragTarget.DockClients[i];
|
|
||||||
Exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
AControl := AControl.Parent;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function IsControlChildOfClient(AControl:TWinControl): Boolean;
|
|
||||||
begin
|
|
||||||
Result := False;
|
|
||||||
while Assigned(AControl) do begin
|
|
||||||
if AControl=FDragControl then begin
|
|
||||||
Result:=true;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
AControl:=AControl.Parent;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FindDockSiteAtPosition: TWinControl;
|
|
||||||
var
|
|
||||||
AControl: TWinControl;
|
|
||||||
CanDock: Boolean;
|
|
||||||
QualifyingSites:TList;
|
|
||||||
ARect: TRect;
|
|
||||||
I: Integer;
|
|
||||||
begin
|
|
||||||
Result:=nil;
|
|
||||||
if FDragControl=nil then exit;
|
|
||||||
if FDockingPoints=nil then exit;
|
|
||||||
|
|
||||||
QualifyingSites:=TList.Create;
|
|
||||||
try
|
|
||||||
for i:=0 to FDockingPoints.Count - 1 do begin
|
|
||||||
AControl:=TWinControl(FDockingPoints[i]);
|
|
||||||
//Sanity checks..
|
|
||||||
if AControl=FDragControl then continue;
|
|
||||||
if not AControl.Showing then continue;
|
|
||||||
if not AControl.Enabled then continue;
|
|
||||||
if not AControl.Visible then continue;
|
|
||||||
if IsControlChildOfClient(AControl) then continue;
|
|
||||||
|
|
||||||
if (FDragControl.HostDockSite <> AControl) or (AControl.VisibleDockClientCount > 1) then begin
|
|
||||||
CanDock := True;
|
|
||||||
AControl.GetSiteInfo(FDragControl, ARect, APosition, CanDock);
|
|
||||||
if CanDock and PtInRect(ARect, APosition)
|
|
||||||
then QualifyingSites.Add(AControl);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if QualifyingSites.Count > 0 then begin
|
|
||||||
Result := TWinControl(QualifyingSites[0]); //.GetTopSite; TODO!!!
|
|
||||||
//if not ValidDockTarget(Result) TODO!!!
|
|
||||||
//then Result := nil; TODO!!!
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
QualifyingSites.Free;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var ATarget: TControl;
|
|
||||||
DragCursor: TCursor;
|
|
||||||
AErasePrevious: boolean;
|
|
||||||
begin
|
|
||||||
if(FActiveDrag <> dopNone)or(Abs(FDragStartPos.X - APosition.X) >= FDragThreshold)or(Abs(FDragStartPos.Y - APosition.Y) >= FDragThreshold) then begin
|
|
||||||
|
|
||||||
if FDragControl.DragKind=dkDock then begin
|
|
||||||
ATarget:=FindDockSiteAtPosition;
|
|
||||||
end else begin
|
|
||||||
ATarget := FindControlAtPosition(APosition,false);
|
|
||||||
ATarget := TControl(SendDragMessage(ATarget,dmFindTarget,FDragObject,nil,APosition));
|
|
||||||
end;
|
|
||||||
|
|
||||||
if(FActiveDrag = dopNone)and(FDragImageList <> nil)
|
|
||||||
then with FDragStartPos do FDragImageList.BeginDrag(0, X, Y);
|
|
||||||
if FDragControl.DragKind = dkDrag then begin
|
|
||||||
FActiveDrag := dopDrag;
|
|
||||||
AErasePrevious := false;
|
|
||||||
end else begin
|
|
||||||
AErasePrevious := FActiveDrag <> dopNone;
|
|
||||||
FActiveDrag := dopDock;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//Inform user of entering and leaving
|
|
||||||
if ATarget <> FDragObject.DragTarget then begin
|
|
||||||
SendCmDragMsg(dmDragLeave);
|
|
||||||
FDragObject.DragTarget := TWinControl(ATarget);
|
|
||||||
if ATarget is TWinControl
|
|
||||||
then FDragObject.DragHandle := TWinControl(ATarget).Handle
|
|
||||||
else if (ATarget<>nil) and (ATarget.Parent<>nil)
|
|
||||||
then FDragObject.DragHandle := ATarget.Parent.Handle;
|
|
||||||
FDragObject.DragPos := APosition;
|
|
||||||
SendCmDragMsg(dmDragEnter);
|
|
||||||
end;
|
|
||||||
|
|
||||||
FDragObject.DragPos := APosition;
|
|
||||||
if FDragObject.DragTarget <> nil
|
|
||||||
then FDragObject.DragTargetPos := TControl(FDragObject.DragTarget).ScreenToClient(APosition);
|
|
||||||
DragCursor := FDragObject.GetDragCursor(SendCmDragMsg(dmDragMove),APosition.X, APosition.Y);
|
|
||||||
if FDragImageList <> nil then begin
|
|
||||||
if(ATarget = nil)or(csDisplayDragImage in ATarget.ControlStyle) then begin
|
|
||||||
FDragImageList.DragCursor := DragCursor;
|
|
||||||
if not FDragImageList.Dragging
|
|
||||||
then FDragImageList.BeginDrag(0, APosition.X, APosition.Y)
|
|
||||||
else FDragImageList.DragMove(APosition.X, APosition.Y);
|
|
||||||
end
|
|
||||||
else FDragImageList.EndDrag;
|
|
||||||
end;
|
|
||||||
WidgetSet.SetCursor(Screen.Cursors[DragCursor]);
|
|
||||||
|
|
||||||
|
|
||||||
//Draw borders for the docking section or the boundaries of the dragged form
|
|
||||||
if FActiveDrag = dopDock then begin
|
|
||||||
with TDragDockObject(FDragObject)do begin
|
|
||||||
if DragTarget = nil
|
|
||||||
then FDragControl.DockTrackNoTarget(TDragDockObject(FDragObject), APosition.X, APosition.Y)
|
|
||||||
else begin
|
|
||||||
DropOnControl := GetDropControl;
|
|
||||||
if DropOnControl = nil
|
|
||||||
then with FDragObject do DropAlign := DragTarget.GetDockEdge(DragTargetPos)
|
|
||||||
else DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition));
|
|
||||||
end;
|
|
||||||
|
|
||||||
//Draw the form outlines when the position has changed
|
|
||||||
if not CompareMem(@DockRect, @EraseDockRect, SizeOf(TRect)) then begin
|
|
||||||
if AErasePrevious
|
|
||||||
then EraseDragDockImage;
|
|
||||||
DrawDragDockImage;
|
|
||||||
EraseDockRect := DockRect;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TDragManagerDefault.SendDragMessage(MsgTarget: TControl; Msg: TDragMessage; Source: TDragObject; Target: TControl; const Position: TPoint): LRESULT;
|
|
||||||
var DragRec: TDragRec;
|
|
||||||
DragMsg: TCMDrag;
|
DragMsg: TCMDrag;
|
||||||
begin
|
Begin
|
||||||
Result := 0;
|
Result := 0;
|
||||||
if MsgTarget = nil then exit;
|
if MsgTarget = nil then exit;
|
||||||
|
|
||||||
DragRec.Pos := Position;
|
DragRec.Pos := Position;
|
||||||
DragRec.Target := Target;
|
DragRec.Target := Target;
|
||||||
DragRec.Source := Source;
|
DragRec.Source := Source;
|
||||||
DragRec.Docking := FActiveDrag = dopDock;
|
DragRec.Docking := False;//TODO: not supported at this point
|
||||||
|
|
||||||
FillChar(DragMsg,SizeOf(DragMsg),0);
|
FillChar(DragMsg,SizeOf(DragMsg),0);
|
||||||
DragMsg.Msg:=CM_DRAG;
|
DragMsg.Msg:=CM_DRAG;
|
||||||
@ -411,112 +81,315 @@ begin
|
|||||||
Result:=DragMsg.Result;
|
Result:=DragMsg.Result;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDragManagerDefault.CancelDrag;
|
{-------------------------------------------------------------------------------
|
||||||
|
function SendDragOver(DragMsg: TDragMessage): Boolean;
|
||||||
|
|
||||||
|
Send a DragOver message to DragObject.DragTarget.
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
function SendDragOver(DragMsg: TDragMessage): Boolean;
|
||||||
begin
|
begin
|
||||||
DragDone(false);
|
Result := False;
|
||||||
FDragControl := nil;
|
if (DragObject.DragTarget = nil) then exit;
|
||||||
|
if not (DragObject.DragTarget is TControl) then begin
|
||||||
|
RaiseGDBException('invalid DragTarget');
|
||||||
|
end;
|
||||||
|
Result := LongBool(SendDragMessage(DragObject.DragTarget, DragMsg,
|
||||||
|
DragObject, DragObject.DragTarget, DragObject.DragPos));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDragManagerDefault.DragDone(Drop : Boolean);
|
{-------------------------------------------------------------------------------
|
||||||
var DockObject:TDragDockObject;
|
procedure CancelDrag;
|
||||||
ADragObjectCopy:TDragObject;
|
|
||||||
ParentForm: TCustomForm;
|
Aborts dragging.
|
||||||
DragMsg: TDragMEssage;
|
-------------------------------------------------------------------------------}
|
||||||
Accepted: Boolean;
|
procedure CancelDrag;
|
||||||
TargetPos: TPoint;
|
begin
|
||||||
|
DragDone(False);
|
||||||
|
DragControl := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-------------------------------------------------------------------------------
|
||||||
|
procedure ClearDragObject;
|
||||||
|
|
||||||
|
Set the global variable DragObject to nil.
|
||||||
|
If DragObjectAutoFree is set, then the DragObject was auto created by the LCL
|
||||||
|
and is freed here.
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
procedure ClearDragObject;
|
||||||
|
begin
|
||||||
|
if DragObjectAutoFree then begin
|
||||||
|
DragObjectAutoFree:=false;
|
||||||
|
FreeThenNil(DragObject);
|
||||||
|
end else
|
||||||
|
DragObject := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-------------------------------------------------------------------------------
|
||||||
|
Procedure DragInitControl(Control : TControl; Immediate : Boolean;
|
||||||
|
Threshold: Integer);
|
||||||
|
|
||||||
|
Initializes the dragging. If Immediate=True it starts the dragging, otherwise
|
||||||
|
it will be started when the user moves the mouse more than DragThreshold
|
||||||
|
pixel.
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
Procedure DragInitControl(Control: TControl; Immediate: Boolean;
|
||||||
|
Threshold: Integer);
|
||||||
|
var
|
||||||
|
ok: boolean;
|
||||||
begin
|
begin
|
||||||
{$IFDEF VerboseDrag}
|
{$IFDEF VerboseDrag}
|
||||||
DebugLn('DragDone Drop=',dbgs(Drop));
|
DebugLn('DragInitControl ',Control.Name,':',Control.ClassName,' Immediate=', dbgs(Immediate));
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Accepted:=false;
|
ClearDragObject;
|
||||||
DockObject := nil;
|
DragControl := Control;
|
||||||
if FDragObject = nil
|
ok:=false;
|
||||||
then Exit;
|
|
||||||
if FDragObject.Cancelling
|
|
||||||
then Exit;
|
|
||||||
|
|
||||||
ADragObjectCopy:=FDragObject;
|
|
||||||
try
|
try
|
||||||
FDragObject.Dropped := Drop;
|
if Control.fDragKind = dkDrag then begin
|
||||||
FDragObject.Cancelling := true;
|
// initialize the DragControl. Note: This can change the DragControl
|
||||||
FDragObject.ReleaseCapture;
|
Control.DoStartDrag(DragObject);
|
||||||
SetCaptureControl(nil);
|
// check if initialization was successful
|
||||||
|
if DragControl = nil then Exit;
|
||||||
Accepted := FDragObject.DragTarget <> nil;
|
// initialize DragObject, if not already done
|
||||||
if FActiveDrag = dopDock then begin
|
if DragObject = nil then Begin
|
||||||
DockObject := FDragObject as TDragDockObject;
|
DragObject := TDragControlObject.Create(Control);
|
||||||
DockObject.EraseDragDockImage;
|
DragObjectAutoFree := True;
|
||||||
DockObject.Floating := DockObject.DragTarget = nil;
|
End;
|
||||||
if Drop then begin
|
end else if Control.fDragKind = dkDock then begin
|
||||||
if FDragControl.HostDockSite <> nil
|
// ToDo: docking
|
||||||
then Accepted := FDragControl.HostDockSite.DoUnDock(TWinControl(FDragObject.DragTarget), FDragControl)
|
RaiseGDBException('not yet implemented');
|
||||||
else if DockObject.DragTarget = nil
|
|
||||||
then Accepted := true
|
|
||||||
else if FDragControl.HostDockSite = nil
|
|
||||||
then Accepted := true;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if (FDragObject.DragTarget <> nil) and (FDragObject.DragTarget is TControl)
|
// init the global drag variables
|
||||||
then TargetPos := FDragObject.DragTargetPos //controls can override the position
|
DragObject.DragTarget := nil;
|
||||||
else TargetPos := FDragObject.DragPos; //otherwise take the current position
|
GetCursorPos(DragStartPos);
|
||||||
Accepted := Accepted and (((FActiveDrag = dopDock) and DockObject.Floating) or
|
DragObject.DragPos := DragStartPos;
|
||||||
((FActiveDrag <> dopNone) and SendCmDragMsg(dmDragLeave))) and Drop;
|
DragImages := DragObject.GetDragImages;
|
||||||
|
|
||||||
if FActiveDrag = dopDock then begin
|
//DragCapture := DragObject.Capture;
|
||||||
if Accepted and DockObject.Floating then begin
|
DragThreshold := Threshold;
|
||||||
ParentForm := GetParentForm(DockObject.Control);
|
|
||||||
if (ParentForm <> nil) and (ParentForm.ActiveControl = DockObject.Control)
|
if DragObject is TDragDockObject then begin
|
||||||
then ParentForm.ActiveControl := nil;
|
with TDragDockObject(DragObject), FDockRect do
|
||||||
FDragControl.Perform(CM_FLOAT, 0, Integer(FDragObject));
|
begin
|
||||||
|
if Right > Left then
|
||||||
|
FMouseDeltaX := (DragPos.x - Left) / (Right - Left)
|
||||||
|
else
|
||||||
|
FMouseDeltaX := 0;
|
||||||
|
|
||||||
|
if Bottom > Top then
|
||||||
|
FMouseDeltaY := (DragPos.y - Top) / (Bottom - Top)
|
||||||
|
else
|
||||||
|
FMouseDeltaY := 0;
|
||||||
|
|
||||||
|
if Immediate then
|
||||||
|
begin
|
||||||
|
ActiveDrag := dopDock;
|
||||||
|
//DrawDragDockImage;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ActiveDrag := dopNone;
|
||||||
end;
|
end;
|
||||||
end else begin
|
end else begin
|
||||||
if FDragImageList <> nil
|
if Immediate then
|
||||||
then FDragImageList.EndDrag;
|
ActiveDrag := dopDrag
|
||||||
WidgetSet.SetCursor(Screen.Cursors[Screen.Cursor]);
|
else
|
||||||
|
ActiveDrag := dopNone;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FDragObject:=nil;
|
if ActiveDrag <> dopNone then DragTo(DragStartPos);
|
||||||
|
|
||||||
//drop
|
ok:=true;
|
||||||
if ADragObjectCopy.DragTarget <> nil then begin
|
|
||||||
DragMsg := dmDragDrop;
|
|
||||||
if not Accepted then begin
|
|
||||||
TargetPos.X := 0;
|
|
||||||
TargetPos.Y := 0;
|
|
||||||
DragMsg := dmDragCancel;
|
|
||||||
ADragObjectCopy.DragPos.X := 0;
|
|
||||||
ADragObjectCopy.DragPos.Y := 0;
|
|
||||||
end;
|
|
||||||
SendDragMessage(ADragObjectCopy.DragTarget, DragMsg,ADragObjectCopy,ADragObjectCopy.DragTarget, ADragObjectCopy.DragPos);
|
|
||||||
end;
|
|
||||||
|
|
||||||
//release the OldDragObject
|
|
||||||
ADragObjectCopy.Finished(TObject(ADragObjectCopy.DragTarget),TargetPos.X,TargetPos.Y,Accepted);
|
|
||||||
finally
|
finally
|
||||||
//erase global variables (dragging stopped)
|
if not ok then begin
|
||||||
if FDragObjectAutoFree
|
DragControl := nil;
|
||||||
then ADragObjectCopy.Free
|
ClearDragObject;
|
||||||
else ADragObjectCopy.Cancelling := false;
|
end;
|
||||||
FDragObject:=nil;
|
|
||||||
FDragThreshold:=0;
|
|
||||||
FDragControl := nil;
|
|
||||||
FDragImageList := nil;
|
|
||||||
FActiveDrag := dopNone;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{-------------------------------------------------------------------------------
|
{-------------------------------------------------------------------------------
|
||||||
procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
function GetDragTargetAt(const Position: TPoint; DragKind: TDragKind;
|
||||||
|
Client: TControl): Pointer;
|
||||||
|
|
||||||
|
Search a control at position and ask for a dragging/docking target.
|
||||||
|
Client is the Source control.
|
||||||
-------------------------------------------------------------------------------}
|
-------------------------------------------------------------------------------}
|
||||||
procedure TDragManagerDefault.RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
|
function GetDragTargetAt(const Position: TPoint; DragKind: TDragKind;
|
||||||
|
Client: TControl): TControl;
|
||||||
begin
|
begin
|
||||||
if (Site <> nil) then begin
|
Result:=nil;
|
||||||
if FDockingPoints = nil
|
if DragKind = dkDrag then
|
||||||
then FDockingPoints := TList.Create;
|
begin
|
||||||
if DoRegister
|
Result:=FindControlAtPosition(Position,false);
|
||||||
then FDockingPoints.Add(Site)
|
Result := TControl(SendDragMessage(Result,dmFindTarget,DragObject,nil,
|
||||||
else FDockingPoints.Remove(Site)
|
Position));
|
||||||
|
if (Result<>nil) and (not (Result is TControl)) then
|
||||||
|
RaiseGDBException('invalid DragTarget');
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
// ToDo: docking
|
||||||
|
RaiseGDBException('not implemented yet');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-------------------------------------------------------------------------------
|
||||||
|
Procedure DragTo(const Position: TPoint);
|
||||||
|
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
Procedure DragTo(const Position: TPoint);
|
||||||
|
var
|
||||||
|
TargetControl: TControl;
|
||||||
|
ADragCursor: TCursor;
|
||||||
|
AAccepted: Boolean;
|
||||||
|
Begin
|
||||||
|
{$IFDEF VerboseDrag}
|
||||||
|
DebugLn('DragTo P=', IntToStr(Position.X), ',', IntToStr(Position.Y));
|
||||||
|
{$ENDIF}
|
||||||
|
if (DragControl = nil) or ((ActiveDrag = dopNone) and
|
||||||
|
(Abs(DragStartPos.X - Position.X) < DragThreshold) and
|
||||||
|
(Abs(DragStartPos.Y - Position.Y) < DragThreshold)) then
|
||||||
|
begin
|
||||||
|
// dragging not yet started
|
||||||
|
// or CancelDrag happened (DragControl = nil)
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TargetControl := GetDragTargetAt(Position, DragControl.DragKind, DragControl);
|
||||||
|
|
||||||
|
if DragControl.DragKind = dkDrag then
|
||||||
|
ActiveDrag := dopDrag
|
||||||
|
else
|
||||||
|
ActiveDrag := dopDock;
|
||||||
|
|
||||||
|
if TargetControl <> DragObject.DragTarget then
|
||||||
|
begin
|
||||||
|
// Target changed => send dmDragLeave to old target and dmDragEnter to new
|
||||||
|
SendDragOver(dmDragLeave);
|
||||||
|
if DragObject = nil then Exit;
|
||||||
|
DragObject.DragTarget := TargetControl;
|
||||||
|
if TargetControl is TWinControl then
|
||||||
|
DragObject.DragHandle := TWinControl(TargetControl).Handle
|
||||||
|
else if (TargetControl<>nil) and (TargetControl.Parent<>nil) then
|
||||||
|
DragObject.DragHandle := TargetControl.Parent.Handle;
|
||||||
|
DragObject.DragPos := Position;
|
||||||
|
SendDragOver(dmDragEnter);
|
||||||
|
if DragObject = nil then Exit;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
// same target => send dmDragMove
|
||||||
|
DragObject.DragPos := Position;
|
||||||
|
AAccepted := SendDragOver(dmDragMove);
|
||||||
|
// on DragMove someone can call CancelDrag and this cause crash w/o this check
|
||||||
|
if DragObject = nil then Exit;
|
||||||
|
ADragCursor := DragObject.GetDragCursor(AAccepted, Position.X, Position.Y);
|
||||||
|
if DragImages <> nil then
|
||||||
|
begin
|
||||||
|
if (DragObject.DragTarget = nil) or (csDisplayDragImage in DragObject.DragTarget.ControlStyle) or
|
||||||
|
(DragObject.AlwaysShowDragImages) then
|
||||||
|
begin
|
||||||
|
DragImages.DragLock(0, Position.X, Position.Y);
|
||||||
|
DragImages.DragCursor := ADragCursor;
|
||||||
|
DragImages.DragMove(Position.X, Position.Y);
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
// we can hide drag image
|
||||||
|
DragImages.DragUnLock;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
WidgetSet.SetCursor(Screen.Cursors[ADragCursor]);
|
||||||
|
if DragObject = nil then Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// update Position
|
||||||
|
DragObject.DragPos := Position;
|
||||||
|
if DragObject.DragTarget <> nil then
|
||||||
|
DragObject.DragTargetPos := DragObject.DragTarget.ScreenToClient(Position);
|
||||||
|
|
||||||
|
// ToDo: docking
|
||||||
|
end;
|
||||||
|
|
||||||
|
{-------------------------------------------------------------------------------
|
||||||
|
Procedure DragDone(Drop : Boolean);
|
||||||
|
|
||||||
|
Ends the current dragging operation.
|
||||||
|
Invokes DragMessage,
|
||||||
|
Frees the DragObject if autocreated by the LCL,
|
||||||
|
Finish: DragSave.Finished
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
Procedure DragDone(Drop : Boolean);
|
||||||
|
var
|
||||||
|
Accepted: Boolean;
|
||||||
|
OldDragObject: TDragObject;
|
||||||
|
OldDragAutoFree: Boolean;
|
||||||
|
DragMsg: TDragMEssage;
|
||||||
|
TargetPos: TPoint;
|
||||||
|
Begin
|
||||||
|
{$IFDEF VerboseDrag}
|
||||||
|
DebugLn('DragDone Drop=',dbgs(Drop));
|
||||||
|
{$ENDIF}
|
||||||
|
Accepted:=false;
|
||||||
|
if (DragObject = nil) or DragObject.Cancelling then Exit;
|
||||||
|
|
||||||
|
// take over the DragObject
|
||||||
|
// (to prevent auto destruction during the next operations)
|
||||||
|
OldDragObject := DragObject;
|
||||||
|
OldDragAutoFree:=DragObjectAutoFree;
|
||||||
|
DragObjectAutoFree:=false;
|
||||||
|
try
|
||||||
|
// mark DragObject for end phase of drag
|
||||||
|
DragObject.Cancelling := True;
|
||||||
|
DragObject.FDropped := Drop;
|
||||||
|
ReleaseCapture;
|
||||||
|
|
||||||
|
if ActiveDrag = dopDock then
|
||||||
|
begin
|
||||||
|
RaiseGDBException('not implemented yet');
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (DragObject.DragTarget <> nil)
|
||||||
|
and (TObject(DragObject.DragTarget) is TControl) then
|
||||||
|
// controls can override the target position
|
||||||
|
TargetPos := DragObject.DragTargetPos
|
||||||
|
else
|
||||||
|
// otherwise just take the current drag position
|
||||||
|
TargetPos := DragObject.DragPos;
|
||||||
|
|
||||||
|
// last DragOver message (make sure, there is at least one)
|
||||||
|
Accepted:=(ActiveDrag <> dopNone) and SendDragOver(dmDragLeave) and Drop;
|
||||||
|
|
||||||
|
if DragImages <> nil then
|
||||||
|
DragImages.EndDrag;
|
||||||
|
WidgetSet.SetCursor(Screen.Cursors[Screen.Cursor]);
|
||||||
|
// erase global variables (dragging stopped)
|
||||||
|
DragControl := nil;
|
||||||
|
DragObject := nil;
|
||||||
|
DragImages := nil;
|
||||||
|
|
||||||
|
// drop
|
||||||
|
if (OldDragObject<>nil) and (OldDragObject.DragTarget <> nil) then
|
||||||
|
Begin
|
||||||
|
DragMsg := dmDragDrop;
|
||||||
|
if not Accepted then begin
|
||||||
|
DragMsg := dmDragCancel;
|
||||||
|
OldDragObject.FDragPos.X := 0;
|
||||||
|
OldDragObject.FDragPos.Y := 0;
|
||||||
|
TargetPos.X := 0;
|
||||||
|
TargetPos.Y := 0;
|
||||||
|
end;
|
||||||
|
SendDragMessage(OldDragObject.DragTarget, DragMsg,
|
||||||
|
OldDragObject, OldDragObject.DragTarget, OldDragObject.DragPos);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// release the OldDragObject
|
||||||
|
OldDragObject.Cancelling := False;
|
||||||
|
OldDragObject.Finished(TObject(OldDragObject.DragTarget),
|
||||||
|
TargetPos.X,TargetPos.Y,Accepted);
|
||||||
|
finally
|
||||||
|
DragControl := nil;
|
||||||
|
if OldDragAutoFree then
|
||||||
|
OldDragObject.Free;
|
||||||
|
DragObject:=nil;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -31,67 +31,10 @@ begin
|
|||||||
FAlwaysShowDragImages := Source.FAlwaysShowDragImages;
|
FAlwaysShowDragImages := Source.FAlwaysShowDragImages;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDragObject.WndProc(var Msg: TLMessage);
|
function TDragObject.Capture: HWND;
|
||||||
//Some drag&dock handling
|
|
||||||
var P: TPoint;
|
|
||||||
begin
|
begin
|
||||||
try
|
Result:=0;
|
||||||
case Msg.Msg of
|
//SetCapture(Result);
|
||||||
LM_MOUSEMOVE: begin
|
|
||||||
P := SmallPointToPoint(TLMMouseMove(Msg).Pos);
|
|
||||||
ClientToScreen(DragCapture, P);
|
|
||||||
DragManager.DragTo(P);
|
|
||||||
end;
|
|
||||||
LM_CAPTURECHANGED: DragManager.DragDone(false);
|
|
||||||
LM_LBUTTONUP, LM_RBUTTONUP: DragManager.DragDone(True);
|
|
||||||
{ Forms.IsKeyMsg sends WM_KEYxxx messages here (+CN_BASE) when a
|
|
||||||
TPUtilWindow has the mouse capture. }
|
|
||||||
CN_KEYUP:
|
|
||||||
//TODO: This is never called! Missing code?
|
|
||||||
if Msg.WParam = VK_CONTROL
|
|
||||||
then DragManager.DragTo(DragPos);
|
|
||||||
CN_KEYDOWN:begin
|
|
||||||
//TODO: This is never called! Missing code?
|
|
||||||
case Msg.WParam of
|
|
||||||
VK_CONTROL: DragManager.DragTo(DragPos);
|
|
||||||
VK_ESCAPE:begin
|
|
||||||
{ Consume keystroke and cancel drag operation }
|
|
||||||
Msg.Result := 1;
|
|
||||||
DragManager.DragDone(false);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
except
|
|
||||||
DragManager.DragDone(false);
|
|
||||||
Application.HandleException(Self);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragObject.MainWndProc(var Message: TLMessage);
|
|
||||||
begin
|
|
||||||
try
|
|
||||||
WndProc(Message);
|
|
||||||
except
|
|
||||||
Application.HandleException(Self);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragObject.Capture;
|
|
||||||
begin
|
|
||||||
if DragCapture=0 then begin
|
|
||||||
DragCapture := WidgetSet.AllocateHWnd(@MainWndProc);
|
|
||||||
WidgetSet.SetCapture(DragCapture);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDragObject.ReleaseCapture;
|
|
||||||
begin
|
|
||||||
if DragCapture<>0 then begin
|
|
||||||
WidgetSet.ReleaseCapture;
|
|
||||||
WidgetSet.DeallocateHWnd(DragCapture);
|
|
||||||
DragCapture := 0;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
|
procedure TDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
|
||||||
@ -109,6 +52,67 @@ begin
|
|||||||
Result := nil;
|
Result := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
P: TPoint;
|
||||||
|
begin
|
||||||
|
P:=Point(X,Y);
|
||||||
|
DragTo(P);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
DragDone(True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.CaptureChanged(OldCaptureControl: TControl);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
IsDragging: Boolean;
|
||||||
|
begin
|
||||||
|
// if this is TWinControl, and it have controls (not TWinControls)
|
||||||
|
// then we should check Dragging in those controls
|
||||||
|
IsDragging := OldCaptureControl.Dragging;
|
||||||
|
if (not IsDragging) and (OldCaptureControl is TWinControl) then
|
||||||
|
begin
|
||||||
|
for i := 0 to TWinControl(OldCaptureControl).ControlCount - 1 do
|
||||||
|
begin
|
||||||
|
IsDragging := IsDragging or TWinControl(OldCaptureControl).Controls[i].Dragging;
|
||||||
|
if IsDragging then
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
DragDone(IsDragging);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
case Key of
|
||||||
|
|
||||||
|
VK_CONTROL:
|
||||||
|
DragTo(DragObject.DragPos);
|
||||||
|
|
||||||
|
VK_ESCAPE:
|
||||||
|
begin
|
||||||
|
Key:=VK_UNKNOWN; // Consume keystroke and cancel drag operation
|
||||||
|
DragDone(False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDragObject.KeyUp(var Key: Word; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if Key = VK_CONTROL then DragTo(DragObject.DragPos);
|
||||||
|
end;
|
||||||
|
|
||||||
destructor TDragObject.Destroy;
|
destructor TDragObject.Destroy;
|
||||||
begin
|
begin
|
||||||
{$IFDEF VerboseDrag}
|
{$IFDEF VerboseDrag}
|
||||||
@ -217,8 +221,6 @@ end;
|
|||||||
constructor TDragDockObject.Create(AControl: TControl);
|
constructor TDragDockObject.Create(AControl: TControl);
|
||||||
begin
|
begin
|
||||||
inherited Create(AControl);
|
inherited Create(AControl);
|
||||||
FBrush:=TBrush.Create;
|
|
||||||
FBrush.Color:=clGray;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TDragDockObject.Destroy;
|
destructor TDragDockObject.Destroy;
|
||||||
|
@ -72,7 +72,7 @@ end;
|
|||||||
|
|
||||||
function TMouse.GetIsDragging: Boolean;
|
function TMouse.GetIsDragging: Boolean;
|
||||||
begin
|
begin
|
||||||
Result := Dragging;
|
Result := ActiveDrag <> dopNone;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
// included by controls.pp
|
// included by controls.pp
|
||||||
|
@ -113,27 +113,5 @@ begin
|
|||||||
if NextPage<>nil then ActivePage:=NextPage;
|
if NextPage<>nil then ActivePage:=NextPage;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TPageControl.DockDrop(DockObject: TDragDockObject; X, Y: Integer);
|
|
||||||
var DockObjectVisible: Boolean;
|
|
||||||
FNewDockTabSheet: TTabSheet;
|
|
||||||
begin
|
|
||||||
FNewDockTabSheet := TTabSheet.Create(Self);
|
|
||||||
FNewDockTabSheet.Parent := Self;
|
|
||||||
try
|
|
||||||
FNewDockTabSheet.PageControl := Self;
|
|
||||||
if DockObject.Control is TCustomForm then
|
|
||||||
FNewDockTabSheet.Caption := TCustomForm(DockObject.Control).Caption;
|
|
||||||
DockObject.Control.Dock(FNewDockTabSheet, DockObject.DockRect);
|
|
||||||
DockObject.Control.Align := alClient;
|
|
||||||
except
|
|
||||||
FNewDockTabSheet.Free;
|
|
||||||
raise;
|
|
||||||
end;
|
|
||||||
DockObjectVisible := DockObject.Control.Visible;
|
|
||||||
FNewDockTabSheet.TabVisible := DockObjectVisible;
|
|
||||||
if DockObjectVisible
|
|
||||||
then ActivePage := FNewDockTabSheet;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// included by comctrls.pp
|
// included by comctrls.pp
|
||||||
|
@ -4617,7 +4617,6 @@ begin
|
|||||||
AWinControl.DestroyHandle;
|
AWinControl.DestroyHandle;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
DestroyWnd;
|
DestroyWnd;
|
||||||
Exclude(FControlState, csDestroyingHandle);
|
Exclude(FControlState, csDestroyingHandle);
|
||||||
end;
|
end;
|
||||||
@ -4794,19 +4793,14 @@ end;
|
|||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
|
procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
|
||||||
MousePos: TPoint; var CanDock: Boolean);
|
MousePos: TPoint; var CanDock: Boolean);
|
||||||
const
|
|
||||||
ADockMargin = 10;
|
|
||||||
begin
|
begin
|
||||||
GetWindowRect(Handle,InfluenceRect);
|
GetWindowRect(Handle,InfluenceRect);
|
||||||
//Margins to test docking
|
// VCL inflates the docking rectangle. Do we need this too? Why?
|
||||||
InfluenceRect.Left:= InfluenceRect.Left-ADockMargin;
|
//InflateRect(InfluenceRect,?,?);
|
||||||
InfluenceRect.Top:= InfluenceRect.Top-ADockMargin;
|
|
||||||
InfluenceRect.Right:= InfluenceRect.Right+ADockMargin;
|
|
||||||
InfluenceRect.Bottom:= InfluenceRect.Bottom+ADockMargin;
|
|
||||||
|
|
||||||
if Assigned(FOnGetSiteInfo) then
|
if Assigned(FOnGetSiteInfo) then
|
||||||
FOnGetSiteInfo(Self,Client,InfluenceRect,MousePos,CanDock);
|
FOnGetSiteInfo(Self,Client,InfluenceRect,MousePos,CanDock);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
procedure TWinControl.ReloadDockedControl(const AControlName: string;
|
procedure TWinControl.ReloadDockedControl(const AControlName: string;
|
||||||
var AControl: TControl);
|
var AControl: TControl);
|
||||||
@ -4882,21 +4876,6 @@ Begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TWinControl.CMFloat(var Message: TCMFloat);
|
|
||||||
var WasVisible: Boolean;
|
|
||||||
begin
|
|
||||||
if FloatingDockSiteClass = ClassType then begin
|
|
||||||
WasVisible := Visible;
|
|
||||||
try
|
|
||||||
Dock(nil, Message.DockSource.FDockRect);
|
|
||||||
finally
|
|
||||||
if WasVisible
|
|
||||||
then BringToFront;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
TWinControl KeyDown
|
TWinControl KeyDown
|
||||||
------------------------------------------------------------------------------}
|
------------------------------------------------------------------------------}
|
||||||
@ -5037,6 +5016,13 @@ begin
|
|||||||
if CharCode = VK_UNKNOWN then Exit;
|
if CharCode = VK_UNKNOWN then Exit;
|
||||||
ShiftState := KeyDataToShiftState(KeyData);
|
ShiftState := KeyDataToShiftState(KeyData);
|
||||||
|
|
||||||
|
// let drag object handle the key
|
||||||
|
if Dragging and (DragObject<>nil) then
|
||||||
|
begin
|
||||||
|
DragObject.KeyDown(CharCode, ShiftState);
|
||||||
|
if CharCode = VK_UNKNOWN then Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
// let user handle the key
|
// let user handle the key
|
||||||
if not (csNoStdEvents in ControlStyle) then
|
if not (csNoStdEvents in ControlStyle) then
|
||||||
begin
|
begin
|
||||||
@ -5266,6 +5252,12 @@ begin
|
|||||||
begin
|
begin
|
||||||
ShiftState := KeyDataToShiftState(KeyData);
|
ShiftState := KeyDataToShiftState(KeyData);
|
||||||
|
|
||||||
|
if Dragging and (DragObject<>nil) then
|
||||||
|
begin
|
||||||
|
DragObject.KeyUp(CharCode, ShiftState);
|
||||||
|
if CharCode = VK_UNKNOWN then exit;
|
||||||
|
end;
|
||||||
|
|
||||||
if not (csNoStdEvents in ControlStyle)
|
if not (csNoStdEvents in ControlStyle)
|
||||||
then begin
|
then begin
|
||||||
KeyUpBeforeInterface(CharCode, ShiftState);
|
KeyUpBeforeInterface(CharCode, ShiftState);
|
||||||
@ -5821,9 +5813,6 @@ begin
|
|||||||
n := ControlCount;
|
n := ControlCount;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if FDockSite then
|
|
||||||
DragManager.RegisterDocksite(Self, false);
|
|
||||||
|
|
||||||
FreeThenNil(FBrush);
|
FreeThenNil(FBrush);
|
||||||
FreeThenNil(FChildSizing);
|
FreeThenNil(FChildSizing);
|
||||||
FreeThenNil(FDockClients);
|
FreeThenNil(FDockClients);
|
||||||
@ -6964,7 +6953,7 @@ begin
|
|||||||
if FDockSite=NewDockSite then exit;
|
if FDockSite=NewDockSite then exit;
|
||||||
FDockSite := NewDockSite;
|
FDockSite := NewDockSite;
|
||||||
if not (csDesigning in ComponentState) then begin
|
if not (csDesigning in ComponentState) then begin
|
||||||
DragManager.RegisterDockSite(Self,NewDockSite);
|
RegisterDockSite(Self,NewDockSite);
|
||||||
if not NewDockSite then begin
|
if not NewDockSite then begin
|
||||||
FreeAndNil(FDockClients);
|
FreeAndNil(FDockClients);
|
||||||
FDockClients := nil;
|
FDockClients := nil;
|
||||||
|
@ -1812,20 +1812,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
WM_NCLBUTTONDOWN:begin
|
WM_NCLBUTTONDOWN:
|
||||||
|
begin
|
||||||
NotifyUserInput := True;
|
NotifyUserInput := True;
|
||||||
Assert(False, 'Trace:WindowProc - Got WM_NCLBUTTONDOWN');
|
Assert(False, 'Trace:WindowProc - Got WM_NCLBUTTONDOWN');
|
||||||
|
|
||||||
//Drag&Dock support TCustomForm => Start BeginDrag()
|
|
||||||
if lWinControl <> nil then begin
|
|
||||||
LMessage.Msg := LM_DRAGSTART;
|
|
||||||
LMessage.WParam := WParam;
|
|
||||||
LMessage.LParam := LParam;
|
|
||||||
DeliverMessage(lWinControl, PLMsg^);
|
|
||||||
//no need to deliver this message later on..
|
|
||||||
LMessage.Msg := LM_NULL;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
end;
|
||||||
WM_NOTIFY:
|
WM_NOTIFY:
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user