* 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
This commit is contained in:
blikblum
2008-01-02 18:10:02 +00:00
parent dcd5a69d38
commit 7be94078d0
6 changed files with 49 additions and 47 deletions

View File

@ -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