diff --git a/ide/uniteditor.pp b/ide/uniteditor.pp index 2ab4adcd6d..a899333148 100644 --- a/ide/uniteditor.pp +++ b/ide/uniteditor.pp @@ -1518,15 +1518,6 @@ Begin ecFindPrevWordOccurrence: FindNextWordOccurrence(false); - - ecSetFreeBookmark: - FSourceNoteBook.BookMarkSetFreeClicked(Self); - - ecPrevBookmark: - FSourceNoteBook.BookMarkPrevClicked(Self); - - ecNextBookmark: - FSourceNoteBook.BookMarkNextClicked(Self); ecSelectionEnclose: EncloseSelection; diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index f32dcbd126..8ce85e98d8 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -219,6 +219,7 @@ type property Width stored False; end; + { TPageControl } TPageControl = class(TCustomNotebook) @@ -239,7 +240,6 @@ type property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex; property Pages[Index: Integer]: TTabSheet read GetTabSheet; - procedure DockDrop(DockObject: TDragDockObject; X, Y: Integer); override; published property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet; property Align; @@ -247,9 +247,9 @@ type property BorderSpacing; //property BiDiMode; property Constraints; - property DockSite; + //property DockSite; property DragCursor; - property DragKind; + //property DragKind; property DragMode; property Enabled; property Font; @@ -275,25 +275,25 @@ type property OnChange: TNotifyEvent read fOnPageChanged write fOnPageChanged; property OnChanging; property OnContextPopup; - property OnDockDrop; - property OnDockOver; + //property OnDockDrop; + //property OnDockOver; property OnDragDrop; property OnDragOver; //property OnDrawTab; - property OnEndDock; + //property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetImageIndex; - property OnGetSiteInfo; + //property OnGetSiteInfo; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnPageChanged; property OnResize; - property OnStartDock; + //property OnStartDock; property OnStartDrag; - property OnUnDock; + //property OnUnDock; end; diff --git a/lcl/controls.pp b/lcl/controls.pp index 907da0c7c6..80ffc4e285 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -73,8 +73,6 @@ type TControl = class; TWinControlClass = class of TWinControl; TControlClass = class of TControl; - TDragDockObject = class; - TDate = type TDateTime; TTime = type TDateTime; @@ -103,13 +101,6 @@ type Result: LRESULT; End; - TCMFloat = packed record - Msg: Cardinal; - Reserved: Integer; - DockSource: TDragDockObject; - Result: Integer; - end; - TCMDialogChar = TLMKEY; TCMDialogKey = TLMKEY; @@ -371,17 +362,17 @@ type FMouseDeltaX: Double; FMouseDeltaY: Double; FCancelling: Boolean; - DragCapture: HWnd; + function Capture: HWND; 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; - function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; 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 destructor Destroy; override; procedure Assign(Source: TDragObject); virtual; @@ -395,7 +386,7 @@ type property DragPos: TPoint read FDragPos write FDragPos; property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos; 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 MouseDeltaY: Double read FMouseDeltaX; end; @@ -429,6 +420,8 @@ type { TDragDockObject } + TDragDockObject = class; + TDockOrientation = ( doNoOrient, // zone contains a TControl and no child zones. doHorizontal, // zone's children are stacked top-to-bottom. @@ -453,7 +446,6 @@ type FDockRect: TRect; FDropAlign: TAlign; FDropOnControl: TControl; - FEraseDockRect: TRect; FFloating: Boolean; FIncreaseDockArea: Boolean; procedure SetBrush(Value: TBrush); @@ -470,38 +462,14 @@ type procedure Assign(Source: TDragObject); override; property Brush: TBrush read FBrush write SetBrush; property DockRect: TRect read FDockRect write FDockRect;// screen coordinates - property DropAlign: TAlign read FDropAlign write FDropAlign; - property DropOnControl: TControl read FDropOnControl write FDropOnControl; + property DropAlign: TAlign read FDropAlign; + property DropOnControl: TControl read FDropOnControl; property Floating: Boolean read FFloating write FFloating; property FrameWidth: Integer read GetFrameWidth; property IncreaseDockArea: Boolean read FIncreaseDockArea; - property EraseDockRect: TRect read FEraseDockRect write FEraseDockRect; 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 controls. See TDockTree below for the more info. } @@ -1034,7 +1002,7 @@ type procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP; procedure WMRButtonUp(var Message: TLMRButtonUp); message LM_RBUTTONUP; 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 WMSize(var Message: TLMSize); message LM_SIZE; procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED; @@ -1623,7 +1591,6 @@ type function CanTab: Boolean; override; procedure DoDragMsg(var DragMsg: TCMDrag); override; 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 CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED; procedure DoSendShowHideToInterface; virtual; @@ -2222,6 +2189,8 @@ var procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint); procedure SetCaptureControl(Control: TControl); function GetCaptureControl: TControl; +procedure CancelDrag; +procedure DragDone(Drop: Boolean); var NewStyleControls: Boolean; @@ -2262,6 +2231,7 @@ var // The interface knows, which TWinControl has the capture. This stores // what child control of this TWinControl has actually the capture. CaptureControl: TControl=nil; + DockSiteHash: TDynHashArray=nil; procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect; Left, Top, Right, Bottom: integer); @@ -3366,11 +3336,11 @@ initialization //DebugLn('controls.pp - initialization'); Mouse := TMouse.Create; DefaultDockTreeClass := TDockTree; - DragManager := TDragManagerDefault.Create; + RegisterIntegerConsts(TypeInfo(TCursor), @IdentToCursor, @CursorToIdent); finalization - FreeThenNil(DragManager); + FreeThenNil(DockSiteHash); FreeThenNil(Mouse); end. diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 0b04085c90..a005519958 100644 --- a/lcl/extctrls.pp +++ b/lcl/extctrls.pp @@ -1028,8 +1028,6 @@ type { TPanel } TPanel = class(TCustomPanel) - public - property DockManager; published property Align; property Alignment; @@ -1039,7 +1037,6 @@ type property BevelInner; property BevelOuter; property BevelWidth; - //property BiDiMode; property BorderWidth; property BorderStyle; property Caption; @@ -1048,20 +1045,12 @@ type property ClientWidth; property Color; property Constraints; - //property Ctl3D; - property UseDockManager default True; - property DockSite; property DragCursor; - property DragKind; property DragMode; property Enabled; - property FullRepaint; property Font; - //property Locked; - //property ParentBiDiMode; - //property ParentBackground; + property FullRepaint; property ParentColor; - //property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; @@ -1069,27 +1058,18 @@ type property TabOrder; property TabStop; property Visible; - //property OnCanResize; property OnClick; - //property OnConstrainedResize; - //property OnContextPopup; - property OnDockDrop; - property OnDockOver; property OnDblClick; property OnDragDrop; property OnDragOver; - property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; - property OnGetSiteInfo; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; - property OnStartDock; property OnStartDrag; - property OnUnDock; end; { TCustomTrayIcon } diff --git a/lcl/forms.pp b/lcl/forms.pp index 6ce538db77..084ce479d6 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -375,7 +375,6 @@ type FKeyPreview: Boolean; FMenu: TMainMenu; FModalResult: TModalResult; - FOldBorderStyle: TFormBorderStyle; FOnActivate: TNotifyEvent; FOnClose: TCloseEvent; FOnCloseQuery: TCloseQueryEvent; @@ -431,7 +430,6 @@ type procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW; procedure WMSize(var message: TLMSize); message LM_Size; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; - procedure LMDragStart(Var Message: TLMessage); message LM_DRAGSTART;//not in delphi procedure AddHandler(HandlerType: TFormHandlerType; const Handler: TMethod; AsLast: Boolean); procedure RemoveHandler(HandlerType: TFormHandlerType; @@ -604,8 +602,6 @@ type property ClientWidth; property Color; property Constraints; - property DragKind; - property DragMode; property DockSite; property Enabled; property Font; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 1628bdfc91..b08a1e0769 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -62,8 +62,30 @@ end; starts immediately. ------------------------------------------------------------------------------} procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer); +var + P : TPoint; 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; {------------------------------------------------------------------------------ @@ -71,7 +93,7 @@ end; ------------------------------------------------------------------------------} procedure TControl.BeginAutoDrag; begin - DragManager.BeginDrag(Self, Mouse.DragImmediate,Mouse.DragThreshold); + BeginDrag(Mouse.DragImmediate,Mouse.DragThreshold); end; {------------------------------------------------------------------------------ @@ -1093,7 +1115,6 @@ end; ------------------------------------------------------------------------------} Procedure TControl.DoDragMsg(var DragMsg: TCMDrag); var - Target: TWinControl; Accepts: Boolean; Src: TObject; P: TPoint; @@ -1103,7 +1124,6 @@ Begin {$ENDIF} Src := DragMsg.Dragrec^.Source; P:=ScreenToClient(DragMsg.Dragrec^.Pos); - Target := TWinControl(DragMsg.Dragrec^.Target); {$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)); //if P.X<0 then RaiseGDBException(''); @@ -1116,19 +1136,21 @@ Begin dmDragEnter, dmDragLeave, dmDragMove: begin Accepts := True; - if Src is TDragDockObject - then Target.DockOver(TDragDockObject(Src),P.X,P.Y,TDragState(DragMsg.DragMessage),Accepts) - else DragOver(Src,P.X,P.Y,TDragState(DragMsg.DragMessage),Accepts); - DragMsg.Result := Ord(Accepts); + case DragMsg.DragMessage of + dmDragEnter: DragOver(Src,P.X,P.Y,dsDragEnter,Accepts); + dmDragLeave: DragOver(Src,P.X,P.Y,dsDragLeave,Accepts); + dmDragMove : DragOver(Src,P.X,P.Y,dsDragMove,Accepts); + end; + if Accepts then + DragMsg.Result := 1 + else + DragMsg.Result := 0; end; - dmDragDrop: begin - if Src is TDragDockObject - then Target.DockDrop(TDragDockObject(Src), P.X, P.Y) - else DragDrop(Src, P.X, P.Y); - end; + dmDragDrop: + DragDrop(Src, P.X, P.Y); - end; + end; //case end; {------------------------------------------------------------------------------ @@ -1158,9 +1180,6 @@ begin If Assigned(FOnDragDrop) then FOnDragDrop(Self, Source,X,Y); end; - - - {------------------------------------------------------------------------------ TControl Method SetColor "Sets the default color and tells the widget set" ------------------------------------------------------------------------------} @@ -1187,7 +1206,7 @@ end; ------------------------------------------------------------------------------} Function TControl.Dragging: Boolean; Begin - Result := DragManager.Dragging(Self); + Result := (DragControl = self); end; {------------------------------------------------------------------------------ @@ -2400,27 +2419,6 @@ begin 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 ------------------------------------------------------------------------------} @@ -2916,37 +2914,10 @@ end; {------------------------------------------------------------------------------ TControl DefaultDockImage ------------------------------------------------------------------------------} -procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean); -var DrawRect: TRect; - PenSize: Integer; - ACanvas: TCanvas; - DC: HDC; +procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject; + Erase: Boolean); begin - with DragDockObject do begin - 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; + // ToDo Dock: draw or erase dock image end; {------------------------------------------------------------------------------ @@ -3155,6 +3126,15 @@ begin FPopupMenu := Value; end; +{------------------------------------------------------------------------------ + TControl WMDragStart +------------------------------------------------------------------------------} +Procedure TControl.WMDragStart(Var Message: TLMessage); +Begin + //do this here? + BeginDrag(true); +end; + {------------------------------------------------------------------------------ TControl WMMouseMove ------------------------------------------------------------------------------} @@ -3176,6 +3156,7 @@ End; Procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var + P: TPoint; Form: TCustomForm; begin if (not (Self is TWinControl)) or (not TWinControl(Self).CanFocus) then begin @@ -3184,6 +3165,10 @@ begin Form.ActiveControl.EditingDone; 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); end; @@ -3191,7 +3176,17 @@ end; TControl MouseMove ------------------------------------------------------------------------------} Procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; + DragObjectDragging : Boolean; 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); end; @@ -3200,7 +3195,17 @@ end; ------------------------------------------------------------------------------} Procedure TControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); +var + P: TPoint; + DragObjectDragging : Boolean; 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); end; @@ -3218,10 +3223,11 @@ end; {------------------------------------------------------------------------------ procedure TControl.CaptureChanged; - now handled by dragobject + ------------------------------------------------------------------------------} procedure TControl.CaptureChanged; begin + if (DragObject<>nil) then DragObject.CaptureChanged(Self); end; {------------------------------------------------------------------------------ @@ -3475,8 +3481,6 @@ begin DockRect := Bounds(NewPosition.X,NewPosition.Y,Width,Height); end; // map from screen coordinates to new HostSite coordinates - if (NewDockSite is TCustomForm) then - TCustomForm(NewDockSite).HandleNeeded; NewPosition:=NewDockSite.ScreenToClient(NewPosition); // DockDrop DebugLn('TControl.ManualDock DOCKDROP ',Name,' DockRect=',dbgs(DockObject.DockRect),' NewPos=',dbgs(NewPosition)); @@ -3708,14 +3712,7 @@ begin // make sure the capture is released MouseCapture := false; 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); for Side:=Low(FAnchorSides) to High(FAnchorSides) do FreeThenNil(FAnchorSides[Side]); @@ -3769,7 +3766,6 @@ begin FColor := clWindow; FVisible := true; FParentShowHint := True; - FParentFont := True; FParentColor := True; FWindowProc := @WndProc; FCursor := crDefault; diff --git a/lcl/include/customcombobox.inc b/lcl/include/customcombobox.inc index 010cc1864a..be57d76f82 100644 --- a/lcl/include/customcombobox.inc +++ b/lcl/include/customcombobox.inc @@ -431,7 +431,7 @@ var UserDropDown: boolean; begin 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 begin diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 05ef7be3bd..feeb986429 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -940,17 +940,16 @@ begin {$ENDIF} LCLIntf.SetFocus(FocusHandle); if not ContainsForm(Self) then exit; - //LCLIntf.SetFocus(Self.Handle); end; end; end; CM_EXIT: begin - if HostDockSite <> nil then DeActivate; + //TODO: deal with docking if HostDockSite <> nil then DeActivate; end; CM_ENTER: begin - if HostDockSite <> nil then Activate; + //TODO: Deal with docking if HostDockSite <> nil then Activate; end; LM_WINDOWPOSCHANGING: if ([csLoading, csDesigning] * ComponentState = [csLoading]) @@ -1027,18 +1026,9 @@ begin end; procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect); -//Save or restore the form borderstyle before its (un)docked begin - if (NewDockSite <> HostDockSite) and ((NewDockSite = nil) or Floating) then - begin - if NewDockSite = nil then - //Restore the form borderstyle - FFormBorderStyle := FOldBorderStyle - else begin - //Save the borderstyle & set new bordertype - FOldBorderStyle := FFormBorderStyle; - FFormBorderStyle := bsNone; - end; + if (NewDockSite<>HostDockSite) then begin + end; inherited DoDock(NewDockSite, ARect); end; @@ -1438,6 +1428,7 @@ begin inherited Create(AOwner); Visible := False; fCompStyle:= csForm; + FMenu:= nil; ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse, @@ -1456,8 +1447,6 @@ begin FAllowDropFiles := False; End; - - {------------------------------------------------------------------------------ TCustomForm CreateParams ------------------------------------------------------------------------------} @@ -1468,7 +1457,7 @@ begin begin if (Parent = nil) {and (ParentWindow = 0)} then begin - //WndParent := Application.Handle; +// WndParent := Application.Handle; { TODO : No application handle } Style := Style and not Cardinal(WS_GROUP or WS_TABSTOP); if Parent=nil then @@ -2102,13 +2091,6 @@ begin inherited Dock(NewDockSite, ARect); 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 } diff --git a/lcl/include/custompanel.inc b/lcl/include/custompanel.inc index 6659348f09..8cf629f95a 100644 --- a/lcl/include/custompanel.inc +++ b/lcl/include/custompanel.inc @@ -43,7 +43,6 @@ begin Color:=clBtnFace;// clBackground; SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y); ParentColor := True; - UseDockManager := True; end; procedure TCustomPanel.SetAlignment(const Value: TAlignment); diff --git a/lcl/include/dragdock.inc b/lcl/include/dragdock.inc index 94c28a7b25..87481ce0da 100644 --- a/lcl/include/dragdock.inc +++ b/lcl/include/dragdock.inc @@ -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; @@ -24,382 +34,42 @@ begin and (HostDockSite.DockManager<>nil); end; -{ TDragManager } - -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 - DragManager.RegisterDockSite(Site, DoRegister); -end; - -procedure BeginDrag(AControl: TControl; AImmediate: Boolean; AThreshold: Integer); -begin - 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 - AControl.DoStartDock(ADragObject); - if ADragObject = nil then begin - 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; - -procedure TDragManagerDefault.DragTo(const APosition: TPoint); - - function GetDropControl: TControl; - //Select a control where the dragged control will be docked - var ADragTarget: TWinControl; - AControl: TControl; - i: integer; - begin - 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; + if (Site <> nil) then begin + if DockSiteHash = nil then DockSiteHash := TDynHashArray.Create; + if DoRegister then begin + if not DockSiteHash.Contains(Site) then + DockSiteHash.Add(Site); 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; + if DockSiteHash.Contains(Site) then + DockSiteHash.Remove(Site); end; end; end; -function TDragManagerDefault.SendDragMessage(MsgTarget: TControl; Msg: TDragMessage; Source: TDragObject; Target: TControl; const Position: TPoint): LRESULT; -var DragRec: TDragRec; +{------------------------------------------------------------------------------- + Function SendDragMessage(MsgTarget: TControl; Msg: TDragMessage; + Source: TDragObject; Target: TControl; const Pos: TPoint): longint; + + Send a CM_DRAG (TCMDrag) message to MsgTarget. +-------------------------------------------------------------------------------} +Function SendDragMessage(MsgTarget: TControl; Msg: TDragMessage; + Source: TDragObject; Target: TControl; const Position: TPoint): LRESULT; +var + DragRec: TDragRec; DragMsg: TCMDrag; -begin +Begin Result := 0; if MsgTarget = nil then exit; DragRec.Pos := Position; DragRec.Target := Target; DragRec.Source := Source; - DragRec.Docking := FActiveDrag = dopDock; + DragRec.Docking := False;//TODO: not supported at this point FillChar(DragMsg,SizeOf(DragMsg),0); DragMsg.Msg:=CM_DRAG; @@ -411,112 +81,315 @@ begin Result:=DragMsg.Result; end; -procedure TDragManagerDefault.CancelDrag; +{------------------------------------------------------------------------------- + function SendDragOver(DragMsg: TDragMessage): Boolean; + + Send a DragOver message to DragObject.DragTarget. +-------------------------------------------------------------------------------} +function SendDragOver(DragMsg: TDragMessage): Boolean; begin - DragDone(false); - FDragControl := nil; + Result := False; + 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; -procedure TDragManagerDefault.DragDone(Drop : Boolean); -var DockObject:TDragDockObject; - ADragObjectCopy:TDragObject; - ParentForm: TCustomForm; - DragMsg: TDragMEssage; - Accepted: Boolean; - TargetPos: TPoint; +{------------------------------------------------------------------------------- + procedure CancelDrag; + + Aborts dragging. +-------------------------------------------------------------------------------} +procedure CancelDrag; +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 {$IFDEF VerboseDrag} - DebugLn('DragDone Drop=',dbgs(Drop)); + DebugLn('DragInitControl ',Control.Name,':',Control.ClassName,' Immediate=', dbgs(Immediate)); {$ENDIF} - Accepted:=false; - DockObject := nil; - if FDragObject = nil - then Exit; - if FDragObject.Cancelling - then Exit; - - ADragObjectCopy:=FDragObject; + ClearDragObject; + DragControl := Control; + ok:=false; try - FDragObject.Dropped := Drop; - FDragObject.Cancelling := true; - FDragObject.ReleaseCapture; - SetCaptureControl(nil); - - Accepted := FDragObject.DragTarget <> nil; - if FActiveDrag = dopDock then begin - DockObject := FDragObject as TDragDockObject; - DockObject.EraseDragDockImage; - DockObject.Floating := DockObject.DragTarget = nil; - if Drop then begin - if FDragControl.HostDockSite <> nil - then Accepted := FDragControl.HostDockSite.DoUnDock(TWinControl(FDragObject.DragTarget), FDragControl) - else if DockObject.DragTarget = nil - then Accepted := true - else if FDragControl.HostDockSite = nil - then Accepted := true; - end; + if Control.fDragKind = dkDrag then begin + // initialize the DragControl. Note: This can change the DragControl + Control.DoStartDrag(DragObject); + // check if initialization was successful + if DragControl = nil then Exit; + // initialize DragObject, if not already done + if DragObject = nil then Begin + DragObject := TDragControlObject.Create(Control); + DragObjectAutoFree := True; + End; + end else if Control.fDragKind = dkDock then begin + // ToDo: docking + RaiseGDBException('not yet implemented'); end; - if (FDragObject.DragTarget <> nil) and (FDragObject.DragTarget is TControl) - then TargetPos := FDragObject.DragTargetPos //controls can override the position - else TargetPos := FDragObject.DragPos; //otherwise take the current position - Accepted := Accepted and (((FActiveDrag = dopDock) and DockObject.Floating) or - ((FActiveDrag <> dopNone) and SendCmDragMsg(dmDragLeave))) and Drop; + // init the global drag variables + DragObject.DragTarget := nil; + GetCursorPos(DragStartPos); + DragObject.DragPos := DragStartPos; + DragImages := DragObject.GetDragImages; - if FActiveDrag = dopDock then begin - if Accepted and DockObject.Floating then begin - ParentForm := GetParentForm(DockObject.Control); - if (ParentForm <> nil) and (ParentForm.ActiveControl = DockObject.Control) - then ParentForm.ActiveControl := nil; - FDragControl.Perform(CM_FLOAT, 0, Integer(FDragObject)); + //DragCapture := DragObject.Capture; + DragThreshold := Threshold; + + if DragObject is TDragDockObject then begin + with TDragDockObject(DragObject), FDockRect do + 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 else begin - if FDragImageList <> nil - then FDragImageList.EndDrag; - WidgetSet.SetCursor(Screen.Cursors[Screen.Cursor]); + if Immediate then + ActiveDrag := dopDrag + else + ActiveDrag := dopNone; end; - FDragObject:=nil; + if ActiveDrag <> dopNone then DragTo(DragStartPos); - //drop - 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); + ok:=true; finally - //erase global variables (dragging stopped) - if FDragObjectAutoFree - then ADragObjectCopy.Free - else ADragObjectCopy.Cancelling := false; - FDragObject:=nil; - FDragThreshold:=0; - FDragControl := nil; - FDragImageList := nil; - FActiveDrag := dopNone; + if not ok then begin + DragControl := nil; + ClearDragObject; + 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 - if (Site <> nil) then begin - if FDockingPoints = nil - then FDockingPoints := TList.Create; - if DoRegister - then FDockingPoints.Add(Site) - else FDockingPoints.Remove(Site) + Result:=nil; + if DragKind = dkDrag then + begin + Result:=FindControlAtPosition(Position,false); + Result := TControl(SendDragMessage(Result,dmFindTarget,DragObject,nil, + 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; diff --git a/lcl/include/dragobject.inc b/lcl/include/dragobject.inc index 11a6cf1cbe..79e077edc6 100644 --- a/lcl/include/dragobject.inc +++ b/lcl/include/dragobject.inc @@ -31,67 +31,10 @@ begin FAlwaysShowDragImages := Source.FAlwaysShowDragImages; end; -procedure TDragObject.WndProc(var Msg: TLMessage); -//Some drag&dock handling -var P: TPoint; +function TDragObject.Capture: HWND; begin - try - case Msg.Msg of - 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; + Result:=0; + //SetCapture(Result); end; procedure TDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); @@ -109,6 +52,67 @@ begin Result := nil; 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; begin {$IFDEF VerboseDrag} @@ -217,8 +221,6 @@ end; constructor TDragDockObject.Create(AControl: TControl); begin inherited Create(AControl); - FBrush:=TBrush.Create; - FBrush.Color:=clGray; end; destructor TDragDockObject.Destroy; diff --git a/lcl/include/mouse.inc b/lcl/include/mouse.inc index e97b0ec0fa..b552bb65c6 100644 --- a/lcl/include/mouse.inc +++ b/lcl/include/mouse.inc @@ -72,7 +72,7 @@ end; function TMouse.GetIsDragging: Boolean; begin - Result := Dragging; + Result := ActiveDrag <> dopNone; end; // included by controls.pp diff --git a/lcl/include/pagecontrol.inc b/lcl/include/pagecontrol.inc index 1926c3f922..9e7c201152 100644 --- a/lcl/include/pagecontrol.inc +++ b/lcl/include/pagecontrol.inc @@ -113,27 +113,5 @@ begin if NextPage<>nil then ActivePage:=NextPage; 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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index fb9828f21e..c11d669e31 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -4617,7 +4617,6 @@ begin AWinControl.DestroyHandle; end; end; - DestroyWnd; Exclude(FControlState, csDestroyingHandle); end; @@ -4794,19 +4793,14 @@ end; ------------------------------------------------------------------------------} procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); -const - ADockMargin = 10; begin GetWindowRect(Handle,InfluenceRect); - //Margins to test docking - InfluenceRect.Left:= InfluenceRect.Left-ADockMargin; - InfluenceRect.Top:= InfluenceRect.Top-ADockMargin; - InfluenceRect.Right:= InfluenceRect.Right+ADockMargin; - InfluenceRect.Bottom:= InfluenceRect.Bottom+ADockMargin; - + // VCL inflates the docking rectangle. Do we need this too? Why? + //InflateRect(InfluenceRect,?,?); if Assigned(FOnGetSiteInfo) then FOnGetSiteInfo(Self,Client,InfluenceRect,MousePos,CanDock); end; + {------------------------------------------------------------------------------ procedure TWinControl.ReloadDockedControl(const AControlName: string; var AControl: TControl); @@ -4882,21 +4876,6 @@ Begin 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 ------------------------------------------------------------------------------} @@ -5037,6 +5016,13 @@ begin if CharCode = VK_UNKNOWN then Exit; 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 if not (csNoStdEvents in ControlStyle) then begin @@ -5266,6 +5252,12 @@ begin begin 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) then begin KeyUpBeforeInterface(CharCode, ShiftState); @@ -5821,9 +5813,6 @@ begin n := ControlCount; end; - if FDockSite then - DragManager.RegisterDocksite(Self, false); - FreeThenNil(FBrush); FreeThenNil(FChildSizing); FreeThenNil(FDockClients); @@ -6964,7 +6953,7 @@ begin if FDockSite=NewDockSite then exit; FDockSite := NewDockSite; if not (csDesigning in ComponentState) then begin - DragManager.RegisterDockSite(Self,NewDockSite); + RegisterDockSite(Self,NewDockSite); if not NewDockSite then begin FreeAndNil(FDockClients); FDockClients := nil; diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index 116767d0fb..ee03af861c 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -1812,20 +1812,10 @@ begin end; end; end; - WM_NCLBUTTONDOWN:begin + WM_NCLBUTTONDOWN: + begin NotifyUserInput := True; 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; WM_NOTIFY: begin