From 7be94078d01d31fb4a3e4ea3e5fa150501ff958b Mon Sep 17 00:00:00 2001 From: blikblum Date: Wed, 2 Jan 2008 18:10:02 +0000 Subject: [PATCH] * Change drag and drop code to adapt to LCL changes * Use TFpList instead of TList git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@307 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../virtualtreeview-unstable/VirtualTrees.pas | 96 ++++++++++--------- .../{dragmanager.inc => vtvdragmanager.inc} | 0 .../{dragmanager.inc => vtvdragmanager.inc} | 0 .../{dragmanager.inc => vtvdragmanager.inc} | 0 .../{dragmanager.inc => vtvdragmanager.inc} | 0 .../{dragmanager.inc => vtvdragmanager.inc} | 0 6 files changed, 49 insertions(+), 47 deletions(-) rename components/virtualtreeview-unstable/include/intf/carbon/{dragmanager.inc => vtvdragmanager.inc} (100%) rename components/virtualtreeview-unstable/include/intf/gtk/{dragmanager.inc => vtvdragmanager.inc} (100%) rename components/virtualtreeview-unstable/include/intf/gtk2/{dragmanager.inc => vtvdragmanager.inc} (100%) rename components/virtualtreeview-unstable/include/intf/qt/{dragmanager.inc => vtvdragmanager.inc} (100%) rename components/virtualtreeview-unstable/include/intf/win32/{dragmanager.inc => vtvdragmanager.inc} (100%) diff --git a/components/virtualtreeview-unstable/VirtualTrees.pas b/components/virtualtreeview-unstable/VirtualTrees.pas index bea86a497..9d42723d1 100644 --- a/components/virtualtreeview-unstable/VirtualTrees.pas +++ b/components/virtualtreeview-unstable/VirtualTrees.pas @@ -2094,7 +2094,7 @@ TBaseVirtualTree = class(TCustomControl) procedure CMCtl3DChanged(var Message: TLMessage); message CM_CTL3DCHANGED; procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMDenySubclassing(var Message: TLMessage); message CM_DENYSUBCLASSING; - procedure CMDrag(var Message: TCMDrag); message CM_DRAG; + //procedure CMDrag(var Message: TCMDrag); message CM_DRAG; procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED; procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; @@ -2210,6 +2210,8 @@ TBaseVirtualTree = class(TCustomControl) function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; virtual; procedure DoDragging(P: TPoint); virtual; procedure DoDragExpand; virtual; + function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; + ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT; override; function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: LongWord): Boolean; virtual; procedure DoDragDrop(Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; @@ -2659,7 +2661,7 @@ TBaseVirtualTree = class(TCustomControl) property ChildrenInitialized[Node: PVirtualNode]: Boolean read GetChildrenInitialized; property CutCopyCount: Integer read GetCutCopyCount; property DragImage: TVTDragImage read FDragImage; - property DragManager: IVTDragManager read GetDragManager; + property VTVDragManager: IVTDragManager read GetDragManager; property DropTargetNode: PVirtualNode read FDropTargetNode; property EditLink: IVTEditLink read FEditLink; property Expanded[Node: PVirtualNode]: Boolean read GetExpanded write SetExpanded; @@ -3538,7 +3540,7 @@ type TClipboardFormatList = class private - FList: TList; + FList: TFpList; procedure Sort; public constructor Create; @@ -3562,7 +3564,7 @@ var constructor TClipboardFormatList.Create; begin - FList := TList.Create; + FList := TFpList.Create; end; //---------------------------------------------------------------------------------------------------------------------- @@ -5439,7 +5441,7 @@ end; {$endif UseLocalMemoryManager} -{$i dragmanager.inc} +{$i vtvdragmanager.inc} //----------------- TVirtualTreeHintWindow ----------------------------------------------------------------------------- @@ -9526,8 +9528,8 @@ begin // start actual dragging if allowed if (hoDrag in FOptions) and Treeview.DoHeaderDragging(FColumns.FDownIndex) then begin - if ((Abs(FDragStart.X - P.X) > Mouse.DragThreshold) or - (Abs(FDragStart.Y - P.Y) > Mouse.DragThreshold)) then + if ((Abs(FDragStart.X - P.X) > DragManager.DragThreshold) or + (Abs(FDragStart.Y - P.Y) > DragManager.DragThreshold)) then begin KillTimer(Treeview.Handle, HeaderTimer); I := FColumns.FDownIndex; @@ -11618,7 +11620,7 @@ end; procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Integer; DataObject: IDataObject; DragEffect: Integer); begin - ActiveX.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect); + ActiveX.DoDragDrop(DataObject, VTVDragManager as IDropSource, AllowedEffects, @DragEffect); end; //---------------------------------------------------------------------------------------------------------------------- @@ -14125,7 +14127,8 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.CMDrag(var Message: TCMDrag); +function TBaseVirtualTree.DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; + ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT; var S: TObject; @@ -14134,10 +14137,10 @@ var Formats: TFormatArray; begin - Logger.EnterMethod([lcDrag],'CMDrag'); - with Message, DragRec^ do + Logger.EnterMethod([lcDrag],'DoDragMsg'); + with Self do begin - S := Source; + S := ADragObject; Formats := nil; // Let the ancestor handle dock operations. @@ -14147,18 +14150,18 @@ begin begin // We need an extra check for the control drag object as there might be other objects not derived from // this class (e.g. TActionDragObject). - if not (tsUserDragObject in FStates) and (S is TBaseDragControlObject) then - S := (S as TBaseDragControlObject).Control; - case DragMessage of + if not (tsUserDragObject in FStates) and (S is TDragControlObject) then + S := (S as TDragControlObject).Control; + case ADragMessage of dmDragEnter, dmDragLeave, dmDragMove: begin - if DragMessage = dmDragEnter then + if ADragMessage = dmDragEnter then DoStateChange([tsVCLDragging]); - if DragMessage = dmDragLeave then + if ADragMessage = dmDragLeave then DoStateChange([], [tsVCLDragging]); - if DragMessage = dmDragMove then - with ScreenToClient(Pos) do + if ADragMessage = dmDragMove then + with ScreenToClient(APosition) do DoAutoScroll(X, Y); ShiftState := 0; @@ -14170,10 +14173,10 @@ begin // Allowed drop effects are simulated for VCL dd. Result := DROPEFFECT_MOVE or DROPEFFECT_COPY; - DragOver(S, ShiftState, TDragState(DragMessage), Pos, LongWord(Result)); + DragOver(S, ShiftState, TDragState(ADragMessage), APosition, LongWord(Result)); FLastVCLDragTarget := FDropTargetNode; FVCLDragEffect := Result; - if (DragMessage = dmDragLeave) and Assigned(FDropTargetNode) then + if (ADragMessage = dmDragLeave) and Assigned(FDropTargetNode) then begin InvalidateNode(FDropTargetNode); FDropTargetNode := nil; @@ -14193,8 +14196,7 @@ begin if Assigned(FDropTargetNode) then InvalidateNode(FDropTargetNode); FDropTargetNode := FLastVCLDragTarget; - P := Point(Pos.X, Pos.Y); - P := ScreenToClient(P); + P := ScreenToClient(APosition); DoDragDrop(S, nil, Formats, KeysToShiftState(ShiftState), P, FVCLDragEffect, FLastDropMode); if Assigned(FDropTargetNode) then begin @@ -14204,7 +14206,7 @@ begin end; dmFindTarget: begin - Result := Integer(ControlAtPos(ScreenToClient(Pos), False)); + Result := Integer(ControlAtPos(ScreenToClient(APosition), False)); if Result = 0 then Result := Integer(Self); @@ -14216,7 +14218,7 @@ begin end; end; end; - Logger.ExitMethod([lcDrag],'CMDrag'); + Logger.ExitMethod([lcDrag],'DoDragMsg'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -16611,7 +16613,7 @@ begin // Don't scroll the client area if the header is currently doing tracking or dragging. // Do auto scroll only if there is a draw selection in progress or the tree is the current drop target or // wheel panning/scrolling is active. - IsDropTarget := Assigned(FDragManager) and DragManager.IsDropTarget; + IsDropTarget := Assigned(FDragManager) and VTVDragManager.IsDropTarget; IsDrawSelecting := [tsDrawSelPending, tsDrawSelecting] * FStates <> []; IsWheelPanning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; Result := ((toAutoScroll in FOptions.FAutoOptions) or IsWheelPanning) and @@ -16932,7 +16934,7 @@ begin {$ifdef Windows} // Register tree as OLE drop target. if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then - RegisterDragDrop(Handle, DragManager as IDropTarget); + RegisterDragDrop(Handle, VTVDragManager as IDropTarget); {$endif} if toCheckSupport in FOptions.FMiscOptions then @@ -17373,7 +17375,7 @@ begin // Since scrolling during dragging is not handled via the timer we do a check here whether the auto // scroll timeout already has elapsed or not. if (Result <> []) and - ((Assigned(FDragManager) and DragManager.IsDropTarget) or + ((Assigned(FDragManager) and VTVDragManager.IsDropTarget) or (FindDragTarget(Point(X, Y), False) = Self)) then begin if FDragScrollStart = 0 then @@ -17803,7 +17805,7 @@ begin DoStartDrag(DragObject); DragObject.Free; - DataObject := DragManager.DataObject; + DataObject := VTVDragManager.DataObject; PrepareDragImage(P, DataObject); FLastDropMode := dmOnNode; @@ -17812,7 +17814,7 @@ begin AllowedEffects := GetDragOperations; try DragAndDrop(AllowedEffects, DataObject, DragEffect); - DragManager.ForceDragLeave; + VTVDragManager.ForceDragLeave; finally GetCursorPos(P); P := ScreenToClient(P); @@ -17856,15 +17858,15 @@ begin not (vsExpanded in FDropTargetNode.States) then begin if Assigned(FDragManager) then - SourceTree := TBaseVirtualTree(DragManager.DragSource) + SourceTree := TBaseVirtualTree(VTVDragManager.DragSource) else SourceTree := nil; - if not DragManager.DropTargetHelperSupported and Assigned(SourceTree) then + if not VTVDragManager.DropTargetHelperSupported and Assigned(SourceTree) then SourceTree.FDragImage.HideDragImage; ToggleNode(FDropTargetNode); UpdateWindow(Handle); - if not DragManager.DropTargetHelperSupported and Assigned(SourceTree) then + if not VTVDragManager.DropTargetHelperSupported and Assigned(SourceTree) then SourceTree.FDragImage.ShowDragImage; end; end; @@ -18869,7 +18871,7 @@ begin else begin // Scroll only if there is no drag'n drop in progress. Drag'n drop scrolling is handled in DragOver. - if ((FDragManager = nil) or not DragManager.IsDropTarget) and ((DeltaX <> 0) or (DeltaY <> 0)) then + if ((FDragManager = nil) or not VTVDragManager.IsDropTarget) and ((DeltaX <> 0) or (DeltaY <> 0)) then DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), DefaultScrollUpdateFlags, nil); end; UpdateWindow(Handle); @@ -19028,7 +19030,7 @@ begin // Ask explicitly again whether the action is allowed. Otherwise we may accept a drop which is intentionally not // allowed but cannot be prevented by the application because when the tree was scrolling while dropping // no DragOver event is created by the OLE subsystem. - Result := DragOver(DragManager.DragSource, KeyState, dsDragMove, Pt, Effect); + Result := DragOver(VTVDragManager.DragSource, KeyState, dsDragMove, Pt, Effect); try if (Result <> NOERROR) or ((Effect and not DROPEFFECT_SCROLL) = DROPEFFECT_NONE) then Result := E_FAIL @@ -19056,7 +19058,7 @@ begin SetLength(Formats, Length(Formats) + 1); Formats[High(Formats)] := OLEFormat.cfFormat; end; - DoDragDrop(DragManager.DragSource, DataObject, Formats, Shift, Pt, Effect, FLastDropMode); + DoDragDrop(VTVDragManager.DragSource, DataObject, Formats, Shift, Pt, Effect, FLastDropMode); except Result := E_UNEXPECTED; raise; @@ -19098,8 +19100,8 @@ begin if tsRightButtonDown in FStates then Include(Shift, ssRight); Pt := ScreenToClient(Pt); - Effect := SuggestDropEffect(DragManager.DragSource, Shift, Pt, Effect); - Accept := DoDragOver(DragManager.DragSource, Shift, dsDragEnter, Pt, FLastDropMode, Effect); + Effect := SuggestDropEffect(VTVDragManager.DragSource, Shift, Pt, Effect); + Accept := DoDragOver(VTVDragManager.DragSource, Shift, dsDragEnter, Pt, FLastDropMode, Effect); if not Accept then Effect := DROPEFFECT_NONE else @@ -19125,8 +19127,8 @@ begin // If the drag source is a virtual tree then we know how to control the drag image // and can show it even if the source is not the target tree. // This is only necessary if we cannot use the drag image helper interfaces. - if not DragManager.DropTargetHelperSupported and Assigned(DragManager.DragSource) then - TBaseVirtualTree(DragManager.DragSource).FDragImage.ShowDragImage; + if not VTVDragManager.DropTargetHelperSupported and Assigned(VTVDragManager.DragSource) then + TBaseVirtualTree(VTVDragManager.DragSource).FDragImage.ShowDragImage; Result := NOERROR; except Result := E_UNEXPECTED; @@ -19170,8 +19172,8 @@ var begin KillTimer(Handle, ExpandTimer); - if not DragManager.DropTargetHelperSupported and Assigned(DragManager.DragSource) then - TBaseVirtualTree(DragManager.DragSource).FDragImage.HideDragImage; + if not VTVDragManager.DropTargetHelperSupported and Assigned(VTVDragManager.DragSource) then + TBaseVirtualTree(VTVDragManager.DragSource).FDragImage.HideDragImage; if Assigned(FDropTargetNode) then begin @@ -19211,7 +19213,7 @@ var begin //Logger.EnterMethod([lcDrag],'DragOver'); - if not DragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then + if not VTVDragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then begin Tree := Source as TBaseVirtualTree; ScrollOptions := [suoUpdateNCArea]; @@ -21180,8 +21182,8 @@ begin begin InvalidateRect(Handle, @FNewSelRect, False); UpdateWindow(Handle); - if (Abs(FNewSelRect.Right - FNewSelRect.Left) > Mouse.DragThreshold) or - (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > Mouse.DragThreshold) then + if (Abs(FNewSelRect.Right - FNewSelRect.Left) > DragManager.DragThreshold) or + (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > DragManager.DragThreshold) then begin if tsClearPending in FStates then begin @@ -21204,7 +21206,7 @@ begin // middle mouse button. This means panning is being used, hence remove the wheel scroll flag. if [tsWheelPanning, tsWheelScrolling] * FStates = [tsWheelPanning, tsWheelScrolling] then begin - if ((Abs(FLastClickPos.X - X) >= Mouse.DragThreshold) or (Abs(FLastClickPos.Y - Y) >= Mouse.DragThreshold)) then + if ((Abs(FLastClickPos.X - X) >= DragManager.DragThreshold) or (Abs(FLastClickPos.Y - Y) >= DragManager.DragThreshold)) then DoStateChange([], [tsWheelScrolling]); end; @@ -23012,7 +23014,7 @@ begin begin // Drag start position has already been recorded in WMMouseDown. if Threshold < 0 then - FDragThreshold := Mouse.DragThreshold + FDragThreshold := DragManager.DragThreshold else FDragThreshold := Threshold; if Immediate then diff --git a/components/virtualtreeview-unstable/include/intf/carbon/dragmanager.inc b/components/virtualtreeview-unstable/include/intf/carbon/vtvdragmanager.inc similarity index 100% rename from components/virtualtreeview-unstable/include/intf/carbon/dragmanager.inc rename to components/virtualtreeview-unstable/include/intf/carbon/vtvdragmanager.inc diff --git a/components/virtualtreeview-unstable/include/intf/gtk/dragmanager.inc b/components/virtualtreeview-unstable/include/intf/gtk/vtvdragmanager.inc similarity index 100% rename from components/virtualtreeview-unstable/include/intf/gtk/dragmanager.inc rename to components/virtualtreeview-unstable/include/intf/gtk/vtvdragmanager.inc diff --git a/components/virtualtreeview-unstable/include/intf/gtk2/dragmanager.inc b/components/virtualtreeview-unstable/include/intf/gtk2/vtvdragmanager.inc similarity index 100% rename from components/virtualtreeview-unstable/include/intf/gtk2/dragmanager.inc rename to components/virtualtreeview-unstable/include/intf/gtk2/vtvdragmanager.inc diff --git a/components/virtualtreeview-unstable/include/intf/qt/dragmanager.inc b/components/virtualtreeview-unstable/include/intf/qt/vtvdragmanager.inc similarity index 100% rename from components/virtualtreeview-unstable/include/intf/qt/dragmanager.inc rename to components/virtualtreeview-unstable/include/intf/qt/vtvdragmanager.inc diff --git a/components/virtualtreeview-unstable/include/intf/win32/dragmanager.inc b/components/virtualtreeview-unstable/include/intf/win32/vtvdragmanager.inc similarity index 100% rename from components/virtualtreeview-unstable/include/intf/win32/dragmanager.inc rename to components/virtualtreeview-unstable/include/intf/win32/vtvdragmanager.inc