0,0 → 1,1605 |
unit DropTarget; |
|
// ----------------------------------------------------------------------------- |
// Project: Drag and Drop Component Suite |
// Module: DropTarget |
// Description: Implements the drop target base classes which allows your |
// application to accept data dropped on it from other |
// applications. |
// Version: 4.0 |
// Date: 18-MAY-2001 |
// Target: Win32, Delphi 5-6 |
// Authors: Anders Melander, anders@melander.dk, http://www.melander.dk |
// Copyright © 1997-2001 Angus Johnson & Anders Melander |
// ----------------------------------------------------------------------------- |
// General changes: |
// - Some component glyphs has changed. |
// - New components: |
// * TDropMetaFileTarget |
// * TDropImageTarget |
// * TDropSuperTarget |
// * Replaced all use of KeysToShiftState with KeysToShiftStatePlus for |
// correct mapping of Alt key. |
// TCustomDropTarget changes: |
// - New protected method SetDataObject. |
// Provides write access to DataObject property for use in descendant classes. |
// - New protected methods: GetPreferredDropEffect and SetPerformedDropEffect. |
// - New protected method DoUnregister handles unregistration of all or |
// individual targets. |
// - Unregister method has been overloaded to handle multiple drop targets |
// (Delphi 4 and later only). |
// - All private methods has been made protected. |
// - New public methods: FindTarget and FindNearestTarget. |
// For use with multiple drop targets. |
// - New published property MultiTarget enables multiple drop targets. |
// - New public property Targets for support of multiple drop targets. |
// - Visibility of Target property has changed from public to published and |
// has been made writable. |
// - PasteFromClipboard method now handles all formats via DoGetData. |
// - Now "handles" situations where the target window handle is recreated. |
// - Implemented TCustomDropTarget.Assign to assign from TClipboard and any object |
// which implements IDataObject. |
// - Added support for optimized moves and delete-on-paste with new |
// OptimizedMove property. |
// - Fixed inconsistency between GetValidDropEffect and standard IDropTarget |
// behaviour. |
// - The HasValidFormats method has been made public and now accepts an |
// IDataObject as a parameter. |
// - The OnGetDropEffect Effect parameter is now initialized to the drop |
// source's allowed drop effect mask prior to entry. |
// - Added published AutoScroll property and OnScroll even´t and public |
// NoScrollZone property. |
// Auto scroling can now be completely customized via the OnDragEnter, |
// OnDragOver OnGetDropEffect and OnScroll events and the above properties. |
// - Added support for IDropTargetHelper interface. |
// - Added support for IAsyncOperation interface. |
// - New OnStartAsyncTransfer and OnEndAsyncTransfer events. |
// |
// TDropDummy changes: |
// - Bug in HasValidFormats fixed. Spotted by David Polberger. |
// Return value changed from True to False. |
// |
// ----------------------------------------------------------------------------- |
|
interface |
|
uses |
DragDrop, |
Windows, ActiveX, Classes, Controls, CommCtrl, ExtCtrls, Forms; |
|
{$include DragDrop.inc} |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TControlList |
// |
//////////////////////////////////////////////////////////////////////////////// |
// List of TWinControl objects. |
// Used for the TCustomDropTarget.Targets property. |
//////////////////////////////////////////////////////////////////////////////// |
type |
TControlList = class(TObject) |
private |
FList: TList; |
function GetControl(AIndex: integer): TWinControl; |
function GetCount: integer; |
protected |
function Add(AControl: TWinControl): integer; |
procedure Insert(Index: Integer; AControl: TWinControl); |
procedure Remove(AControl: TWinControl); |
procedure Delete(AIndex: integer); |
public |
constructor Create; |
destructor Destroy; override; |
function IndexOf(AControl: TWinControl): integer; |
property Count: integer read GetCount; |
property Controls[AIndex: integer]: TWinControl read GetControl; default; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCustomDropTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
// Top level abstract base class for all drop target classes. |
// Implements the IDropTarget and IDataObject interfaces. |
// Do not derive from TCustomDropTarget! Instead derive from TCustomDropTarget. |
// TCustomDropTarget will be replaced by/renamed to TCustomDropTarget in a future |
// version. |
//////////////////////////////////////////////////////////////////////////////// |
type |
TScrolDirection = (sdUp, sdDown, sdLeft, sdRight); |
TScrolDirections = set of TScrolDirection; |
|
TDropTargetScrollEvent = procedure(Sender: TObject; Point: TPoint; |
var Scroll: TScrolDirections; var Interval: integer) of object; |
|
TScrollBars = set of TScrollBarKind; |
|
TDropTargetEvent = procedure(Sender: TObject; ShiftState: TShiftState; |
APoint: TPoint; var Effect: Longint) of object; |
|
TCustomDropTarget = class(TDragDropComponent, IDropTarget) |
private |
FDataObject : IDataObject; |
FDragTypes : TDragTypes; |
FGetDataOnEnter : boolean; |
FOnEnter : TDropTargetEvent; |
FOnDragOver : TDropTargetEvent; |
FOnLeave : TNotifyEvent; |
FOnDrop : TDropTargetEvent; |
FOnGetDropEffect : TDropTargetEvent; |
FOnScroll : TDropTargetScrollEvent; |
FTargets : TControlList; |
FMultiTarget : boolean; |
FOptimizedMove : boolean; |
FTarget : TWinControl; |
|
FImages : TImageList; |
FDragImageHandle : HImageList; |
FShowImage : boolean; |
FImageHotSpot : TPoint; |
FDropTargetHelper : IDropTargetHelper; |
// FLastPoint points to where DragImage was last painted (used internally) |
FLastPoint : TPoint; |
// Auto scrolling enables scrolling of target window during drags and |
// paints any drag image 'cleanly'. |
FScrollBars : TScrollBars; |
FScrollTimer : TTimer; |
FAutoScroll : boolean; |
FNoScrollZone : TRect; |
FIsAsync : boolean; |
FOnEndAsyncTransfer : TNotifyEvent; |
FOnStartAsyncTransfer: TNotifyEvent; |
FAllowAsync : boolean; |
protected |
// IDropTarget implementation |
function DragEnter(const DataObj: IDataObject; grfKeyState: Longint; |
pt: TPoint; var dwEffect: Longint): HRESULT; stdcall; |
function DragOver(grfKeyState: Longint; pt: TPoint; |
var dwEffect: Longint): HRESULT; stdcall; |
function DragLeave: HRESULT; stdcall; |
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; |
var dwEffect: Longint): HRESULT; stdcall; |
|
procedure DoEnter(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); virtual; |
procedure DoDragOver(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); virtual; |
procedure DoDrop(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); virtual; |
procedure DoLeave; virtual; |
procedure DoOnPaste(var Effect: Integer); virtual; |
procedure DoScroll(Point: TPoint; var Scroll: TScrolDirections; |
var Interval: integer); virtual; |
|
function GetData(Effect: longInt): boolean; virtual; |
function DoGetData: boolean; virtual; abstract; |
procedure ClearData; virtual; abstract; |
function GetValidDropEffect(ShiftState: TShiftState; pt: TPoint; |
dwEffect: LongInt): LongInt; virtual; // V4: Improved |
function GetPreferredDropEffect: LongInt; virtual; // V4: New |
function SetPerformedDropEffect(Effect: LongInt): boolean; virtual; // V4: New |
function SetPasteSucceded(Effect: LongInt): boolean; virtual; // V4: New |
procedure DoUnregister(ATarget: TWinControl); // V4: New |
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
function GetTarget: TWinControl; |
procedure SetTarget(const Value: TWinControl); |
procedure DoAutoScroll(Sender: TObject); // V4: Renamed from DoTargetScroll. |
procedure SetShowImage(Show: boolean); |
procedure SetDataObject(Value: IDataObject); // V4: New |
procedure DoEndAsyncTransfer(Sender: TObject); |
property DropTargetHelper: IDropTargetHelper read FDropTargetHelper; |
public |
constructor Create(AOwner: TComponent); override; |
destructor Destroy; override; |
procedure Register(ATarget: TWinControl); |
{$ifdef VER12_PLUS} |
procedure Unregister(ATarget: TWinControl = nil); // V4: New |
{$else} |
procedure Unregister; |
{$endif} |
function FindTarget(p: TPoint): TWinControl; virtual; // V4: New |
function FindNearestTarget(p: TPoint): TWinControl; // V4: New |
procedure Assign(Source: TPersistent); override; // V4: New |
function HasValidFormats(ADataObject: IDataObject): boolean; virtual; abstract; // V4: Improved |
function PasteFromClipboard: longint; virtual; // V4: Improved |
property DataObject: IDataObject read FDataObject; |
property Targets: TControlList read FTargets; // V4: New |
property NoScrollZone: TRect read FNoScrollZone write FNoScrollZone; // V4: New |
property AsyncTransfer: boolean read FIsAsync; |
published |
property Dragtypes: TDragTypes read FDragTypes write FDragTypes; |
property GetDataOnEnter: Boolean read FGetDataOnEnter write FGetDataOnEnter; |
// Events... |
property OnEnter: TDropTargetEvent read FOnEnter write FOnEnter; |
property OnDragOver: TDropTargetEvent read FOnDragOver write FOnDragOver; |
property OnLeave: TNotifyEvent read FOnLeave write FOnLeave; |
property OnDrop: TDropTargetEvent read FOnDrop write FOnDrop; |
property OnGetDropEffect: TDropTargetEvent read FOnGetDropEffect |
write FOnGetDropEffect; // V4: Improved |
property OnScroll: TDropTargetScrollEvent read FOnScroll write FOnScroll; // V4: New |
property OnStartAsyncTransfer: TNotifyEvent read FOnStartAsyncTransfer |
write FOnStartAsyncTransfer; |
property OnEndAsyncTransfer: TNotifyEvent read FOnEndAsyncTransfer |
write FOnEndAsyncTransfer; |
// Drag Images... |
property ShowImage: boolean read FShowImage write SetShowImage; |
// Target |
property Target: TWinControl read GetTarget write SetTarget; // V4: Improved |
property MultiTarget: boolean read FMultiTarget write FMultiTarget default False; // V4: New |
// Auto scroll |
property AutoScroll: boolean read FAutoScroll write FAutoScroll default True; // V4: New |
// Misc |
property OptimizedMove: boolean read FOptimizedMove write FOptimizedMove default False; // V4: New |
// Async transfer... |
property AllowAsyncTransfer: boolean read FAllowAsync write FAllowAsync; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
// Deprecated base class for all drop target components. |
// Replaced by the TCustomDropTarget class. |
//////////////////////////////////////////////////////////////////////////////// |
TDropTarget = class(TCustomDropTarget) |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropDummy |
// |
//////////////////////////////////////////////////////////////////////////////// |
// The sole purpose of this component is to enable drag images to be displayed |
// over the registered TWinControl(s). The component does not accept any drops. |
//////////////////////////////////////////////////////////////////////////////// |
TDropDummy = class(TCustomDropTarget) |
protected |
procedure ClearData; override; |
function DoGetData: boolean; override; |
public |
function HasValidFormats(ADataObject: IDataObject): boolean; override; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCustomDropMultiTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
// Drop target base class which can accept multiple formats. |
//////////////////////////////////////////////////////////////////////////////// |
TAcceptFormatEvent = procedure(Sender: TObject; |
const DataFormat: TCustomDataFormat; var Accept: boolean) of object; |
|
TCustomDropMultiTarget = class(TCustomDropTarget) |
private |
FOnAcceptFormat: TAcceptFormatEvent; |
protected |
procedure ClearData; override; |
function DoGetData: boolean; override; |
procedure DoAcceptFormat(const DataFormat: TCustomDataFormat; |
var Accept: boolean); virtual; |
property OnAcceptFormat: TAcceptFormatEvent read FOnAcceptFormat |
write FOnAcceptFormat; |
public |
constructor Create(AOwner: TComponent); override; |
destructor Destroy; override; |
function HasValidFormats(ADataObject: IDataObject): boolean; override; |
property DataFormats; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropEmptyTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
// Do-nothing target for use with TDataFormatAdapter and such |
//////////////////////////////////////////////////////////////////////////////// |
TDropEmptyTarget = class(TCustomDropMultiTarget); |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Misc. |
// |
//////////////////////////////////////////////////////////////////////////////// |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Component registration |
// |
//////////////////////////////////////////////////////////////////////////////// |
procedure Register; |
|
|
(******************************************************************************* |
** |
** IMPLEMENTATION |
** |
*******************************************************************************) |
implementation |
|
uses |
DragDropFormats, |
ComObj, |
SysUtils, |
Graphics, |
Messages, |
ShlObj, |
ClipBrd, |
ComCtrls; |
|
resourcestring |
sAsyncBusy = 'Can''t clear data while async data transfer is in progress'; |
// sRegisterFailed = 'Failed to register %s as a drop target'; |
// sUnregisterActiveTarget = 'Can''t unregister target while drag operation is in progress'; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Component registration |
// |
//////////////////////////////////////////////////////////////////////////////// |
procedure Register; |
begin |
RegisterComponents(DragDropComponentPalettePage, [TDropEmptyTarget, TDropDummy]); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Misc. |
// |
//////////////////////////////////////////////////////////////////////////////// |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TControlList |
// |
//////////////////////////////////////////////////////////////////////////////// |
constructor TControlList.Create; |
begin |
inherited Create; |
FList := TList.Create; |
end; |
|
destructor TControlList.Destroy; |
begin |
FList.Free; |
inherited Destroy; |
end; |
|
function TControlList.Add(AControl: TWinControl): integer; |
begin |
Result := FList.Add(AControl); |
end; |
|
procedure TControlList.Insert(Index: Integer; AControl: TWinControl); |
begin |
FList.Insert(Index, AControl); |
end; |
|
procedure TControlList.Delete(AIndex: integer); |
begin |
FList.Delete(AIndex); |
end; |
|
function TControlList.IndexOf(AControl: TWinControl): integer; |
begin |
Result := FList.IndexOf(AControl); |
end; |
|
function TControlList.GetControl(AIndex: integer): TWinControl; |
begin |
Result := TWinControl(FList[AIndex]); |
end; |
|
function TControlList.GetCount: integer; |
begin |
Result := FList.Count; |
end; |
|
procedure TControlList.Remove(AControl: TWinControl); |
begin |
FList.Remove(AControl); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCustomDropTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
constructor TCustomDropTarget.Create(AOwner: TComponent); |
var |
bm : TBitmap; |
begin |
inherited Create(AOwner); |
FScrollTimer := TTimer.Create(Self); |
FScrollTimer.Enabled := False; |
FScrollTimer.OnTimer := DoAutoScroll; |
|
// Note: Normally we would call _AddRef or coLockObjectExternal(Self) here to |
// make sure that the component wasn't deleted prematurely (e.g. after a call |
// to RegisterDragDrop), but since our ancestor class TInterfacedComponent |
// disables reference counting, we do not need to do so. |
|
FGetDataOnEnter := False; |
FTargets := TControlList.Create; |
|
FImages := TImageList.Create(Self); |
// Create a blank image for FImages which we will use to hide any cursor |
// 'embedded' in a drag image. |
// This avoids the possibility of two cursors showing. |
bm := TBitmap.Create; |
try |
bm.Height := 32; |
bm.Width := 32; |
bm.Canvas.Brush.Color := clWindow; |
bm.Canvas.FillRect(bm.Canvas.ClipRect); |
FImages.AddMasked(bm, clWindow); |
finally |
bm.Free; |
end; |
FDataObject := nil; |
ShowImage := True; |
FMultiTarget := False; |
FOptimizedMove := False; |
FAutoScroll := True; |
end; |
|
destructor TCustomDropTarget.Destroy; |
begin |
FDataObject := nil; |
FDropTargetHelper := nil; |
Unregister; |
FImages.Free; |
FScrollTimer.Free; |
FTargets.Free; |
inherited Destroy; |
end; |
|
// TDummyWinControl is declared just to expose the protected property - Font - |
// which is used to calculate the 'scroll margin' for the target window. |
type |
TDummyWinControl = Class(TWinControl); |
|
function TCustomDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; |
pt: TPoint; var dwEffect: Longint): HRESULT; |
var |
ShiftState : TShiftState; |
TargetStyles : longint; |
begin |
ClearData; |
FDataObject := dataObj; |
Result := S_OK; |
|
// Find the target control. |
FTarget := FindTarget(pt); |
|
(* |
** If no target control has been registered we disable all features which |
** depends on the existence of a drop target (e.g. drag images and auto |
** scroll). Presently, this situation can only arise if the drop target is |
** being used as a drop handler (TDrophandler component). |
** Note also that if no target control exists, the mouse coordinates are |
** relative to the screen, not the control as is normally the case. |
*) |
if (FTarget = nil) then |
begin |
ShowImage := False; |
AutoScroll := False; |
end else |
begin |
pt := FTarget.ScreenToClient(pt); |
FLastPoint := pt; |
end; |
|
(* |
** Refuse the drag if we can't handle any of the data formats offered by |
** the drop source. We must return S_OK here in order for the drop to continue |
** to generate DragOver events for this drop target (needed for drag images). |
*) |
if HasValidFormats(FDataObject) then |
begin |
|
FScrollBars := []; |
|
if (AutoScroll) then |
begin |
// Determine if the target control has scroll bars (and which). |
TargetStyles := GetWindowLong(FTarget.Handle, GWL_STYLE); |
if (TargetStyles and WS_HSCROLL <> 0) then |
include(FScrollBars, sbHorizontal); |
if (TargetStyles and WS_VSCROLL <> 0) then |
include(FScrollBars, sbVertical); |
|
// The Windows UI guidelines recommends that the scroll margin be based on |
// the width/height of the scroll bars: |
// From "The Windows Interface Guidelines for Software Design", page 82: |
// "Use twice the width of a vertical scroll bar or height of a |
// horizontal scroll bar to determine the width of the hot zone." |
// Previous versions of these components used the height of the current |
// target control font as the scroll margin. Yet another approach would be |
// to use the DragDropScrollInset constant. |
if (FScrollBars <> []) then |
begin |
FNoScrollZone := FTarget.ClientRect; |
if (sbVertical in FScrollBars) then |
InflateRect(FNoScrollZone, 0, -GetSystemMetrics(SM_CYHSCROLL)); |
// InflateRect(FNoScrollZone, 0, -abs(TDummyWinControl(FTarget).Font.Height)); |
if (sbHorizontal in FScrollBars) then |
InflateRect(FNoScrollZone, -GetSystemMetrics(SM_CXHSCROLL), 0); |
// InflateRect(FNoScrollZone, -abs(TDummyWinControl(FTarget).Font.Height), 0); |
end; |
end; |
|
// It's generally more efficient to get data only if and when a drop occurs |
// rather than on entering a potential target window. |
// However - sometimes there is a good reason to get it here. |
if FGetDataOnEnter then |
if (not GetData(dwEffect)) then |
begin |
FDataObject := nil; |
dwEffect := DROPEFFECT_NONE; |
Result := DV_E_CLIPFORMAT; |
exit; |
end; |
|
ShiftState := KeysToShiftStatePlus(grfKeyState); |
|
// Create a default drop effect based on the shift state and allowed |
// drop effects (or an OnGetDropEffect event if implemented). |
dwEffect := GetValidDropEffect(ShiftState, Pt, dwEffect); |
|
// Generate an OnEnter event |
DoEnter(ShiftState, pt, dwEffect); |
|
// If IDropTarget.DragEnter returns with dwEffect set to DROPEFFECT_NONE it |
// means that the drop has been rejected and IDropTarget.DragOver should |
// not be called (according to MSDN). Unfortunately IDropTarget.DragOver is |
// called regardless of the value of dwEffect. We work around this problem |
// (bug?) by setting FDataObject to nil and thus internally rejecting the |
// drop in TCustomDropTarget.DragOver. |
if (dwEffect = DROPEFFECT_NONE) then |
FDataObject := nil; |
|
end else |
begin |
FDataObject := nil; |
dwEffect := DROPEFFECT_NONE; |
end; |
|
// Display drag image. |
// Note: This was previously done prior to caling GetValidDropEffect and |
// DoEnter. The SDK documentation states that IDropTargetHelper.DragEnter |
// should be called last in IDropTarget.DragEnter (presumably after dwEffect |
// has been modified), but Microsoft's own demo application calls it as the |
// very first thing (same for all other IDropTargetHelper methods). |
if ShowImage then |
begin |
// Attempt to create Drag Drop helper object. |
// At present this is only supported on Windows 2000. If the object can't be |
// created, we fall back to the old image list based method (which only |
// works on Win9x). |
CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, |
IDropTargetHelper, FDropTargetHelper); |
|
if (FDropTargetHelper <> nil) then |
begin |
// If the call to DragEnter fails (which it will do if the drop source |
// doesn't support IDropSourceHelper or hasn't specified a drag image), |
// we release the drop target helper and fall back to imagelist based |
// drag images. |
if (DropTargetHelper.DragEnter(FTarget.Handle, DataObj, pt, dwEffect) <> S_OK) then |
FDropTargetHelper := nil; |
end; |
|
if (FDropTargetHelper = nil) then |
begin |
FDragImageHandle := ImageList_GetDragImage(nil, @FImageHotSpot); |
if (FDragImageHandle <> 0) then |
begin |
// Currently we will just replace any 'embedded' cursor with our |
// blank (transparent) image otherwise we sometimes get 2 cursors ... |
ImageList_SetDragCursorImage(FImages.Handle, 0, FImageHotSpot.x, FImageHotSpot.y); |
with ClientPtToWindowPt(FTarget.Handle, pt) do |
ImageList_DragEnter(FTarget.handle, x, y); |
end; |
end; |
end else |
FDragImageHandle := 0; |
end; |
|
procedure TCustomDropTarget.DoEnter(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); |
begin |
if Assigned(FOnEnter) then |
FOnEnter(Self, ShiftState, Point, Effect); |
end; |
|
function TCustomDropTarget.DragOver(grfKeyState: Longint; pt: TPoint; |
var dwEffect: Longint): HResult; |
var |
ShiftState: TShiftState; |
IsScrolling: boolean; |
begin |
// Refuse drop if we dermined in DragEnter that a drop weren't possible, |
// but still handle drag images provided we have a valid target. |
if (FTarget = nil) then |
begin |
dwEffect := DROPEFFECT_NONE; |
Result := E_UNEXPECTED; |
exit; |
end; |
|
pt := FTarget.ScreenToClient(pt); |
|
if (FDataObject <> nil) then |
begin |
|
ShiftState := KeysToShiftStatePlus(grfKeyState); |
|
// Create a default drop effect based on the shift state and allowed |
// drop effects (or an OnGetDropEffect event if implemented). |
dwEffect := GetValidDropEffect(ShiftState, pt, dwEffect); |
|
// Generate an OnDragOver event |
DoDragOver(ShiftState, pt, dwEffect); |
|
// Note: Auto scroll is detected by the GetValidDropEffect method, but can |
// also be started by the user via the OnDragOver or OnGetDropEffect events. |
// Auto scroll is initiated by specifying the DROPEFFECT_SCROLL value as |
// part of the drop effect. |
|
// Start the auto scroll timer if auto scroll were requested. Do *not* rely |
// on any other mechanisms to detect auto scroll since the user can only |
// specify auto scroll with the DROPEFFECT_SCROLL value. |
IsScrolling := (dwEffect and DROPEFFECT_SCROLL <> 0); |
if (IsScrolling) and (not FScrollTimer.Enabled) then |
begin |
FScrollTimer.Interval := DragDropScrollDelay; // hardcoded to 100 in previous versions. |
FScrollTimer.Enabled := True; |
end; |
|
Result := S_OK; |
end else |
begin |
// Even though this isn't an error condition per se, we must return |
// an error code (e.g. E_UNEXPECTED) in order for the cursor to change |
// to DROPEFFECT_NONE. |
IsScrolling := False; |
Result := DV_E_CLIPFORMAT; |
end; |
|
// Move drag image |
if (DropTargetHelper <> nil) then |
begin |
OleCheck(DropTargetHelper.DragOver(pt, dwEffect)); |
end else |
if (FDragImageHandle <> 0) then |
begin |
if (not IsScrolling) and ((FLastPoint.x <> pt.x) or (FLastPoint.y <> pt.y)) then |
with ClientPtToWindowPt(FTarget.Handle, pt) do |
ImageList_DragMove(x, y); |
end; |
|
FLastPoint := pt; |
end; |
|
procedure TCustomDropTarget.DoDragOver(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); |
begin |
if Assigned(FOnDragOver) then |
FOnDragOver(Self, ShiftState, Point, Effect); |
end; |
|
function TCustomDropTarget.DragLeave: HResult; |
begin |
ClearData; |
FScrollTimer.Enabled := False; |
|
FDataObject := nil; |
|
if (DropTargetHelper <> nil) then |
begin |
DropTargetHelper.DragLeave; |
end else |
if (FDragImageHandle <> 0) then |
ImageList_DragLeave(FTarget.Handle); |
|
// Generate an OnLeave event. |
// Protect resources against exceptions in event handler. |
try |
DoLeave; |
finally |
FTarget := nil; |
FDropTargetHelper := nil; |
end; |
|
Result := S_OK; |
end; |
|
procedure TCustomDropTarget.DoLeave; |
begin |
if Assigned(FOnLeave) then |
FOnLeave(Self); |
end; |
|
function TCustomDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; |
pt: TPoint; var dwEffect: Longint): HResult; |
var |
ShiftState: TShiftState; |
ClientPt: TPoint; |
begin |
FScrollTimer.Enabled := False; |
|
// Protect resources against exceptions in OnDrop event handler. |
try |
// Refuse drop if we have lost the data object somehow. |
// This can happen if the drop is rejected in one of the other IDropTarget |
// methods (e.g. DragOver). |
if (FDataObject = nil) then |
begin |
dwEffect := DROPEFFECT_NONE; |
Result := E_UNEXPECTED; |
end else |
begin |
|
ShiftState := KeysToShiftStatePlus(grfKeyState); |
|
// Create a default drop effect based on the shift state and allowed |
// drop effects (or an OnGetDropEffect event if implemented). |
if (FTarget <> nil) then |
ClientPt := FTarget.ScreenToClient(pt) |
else |
ClientPt := pt; |
dwEffect := GetValidDropEffect(ShiftState, ClientPt, dwEffect); |
|
// Get data from source and generate an OnDrop event unless we failed to |
// get data. |
if (FGetDataOnEnter) or (GetData(dwEffect)) then |
DoDrop(ShiftState, ClientPt, dwEffect) |
else |
dwEffect := DROPEFFECT_NONE; |
Result := S_OK; |
end; |
|
if (DropTargetHelper <> nil) then |
begin |
DropTargetHelper.Drop(DataObj, pt, dwEffect); |
end else |
if (FDragImageHandle <> 0) and (FTarget <> nil) then |
ImageList_DragLeave(FTarget.Handle); |
finally |
// clean up! |
ClearData; |
FDataObject := nil; |
FDropTargetHelper := nil; |
FTarget := nil; |
end; |
end; |
|
procedure TCustomDropTarget.DoDrop(ShiftState: TShiftState; Point: TPoint; var Effect: Longint); |
begin |
if Assigned(FOnDrop) then |
FOnDrop(Self, ShiftState, Point, Effect); |
|
(* |
Optimized move (from MSDN): |
|
Scenario: A file is moved from the file system to a namespace extension using |
an optimized move. |
|
In a conventional move operation, the target makes a copy of the data and the |
source deletes the original. This procedure can be inefficient because it |
requires two copies of the data. With large objects such as databases, a |
conventional move operation might not even be practical. |
|
With an optimized move, the target uses its understanding of how the data is |
stored to handle the entire move operation. There is never a second copy of |
the data, and there is no need for the source to delete the original data. |
Shell data is well suited to optimized moves because the target can handle the |
entire operation using the shell API. A typical example is moving files. Once |
the target has the path of a file to be moved, it can use SHFileOperation to |
move it. There is no need for the source to delete the original file. |
|
Note The shell normally uses an optimized move to move files. To handle shell |
data transfer properly, your application must be capable of detecting and |
handling an optimized move. |
|
Optimized moves are handled in the following way: |
|
1) The source calls DoDragDrop with the dwEffect parameter set to |
DROPEFFECT_MOVE to indicate that the source objects can be moved. |
2) The target receives the DROPEFFECT_MOVE value through one of its |
IDropTarget methods, indicating that a move is allowed. |
3) The target either copies the object (unoptimized move) or moves the object |
(optimized move). |
4) The target then tells the source whether it needs to delete the original |
data. |
An optimized move is the default operation, with the data deleted by the |
target. To inform the source that an optimized move was performed: |
- The target sets the pdwEffect value it received through its |
IDropTarget::Drop method to some value other than DROPEFFECT_MOVE. It is |
typically set to either DROPEFFECT_NONE or DROPEFFECT_COPY. The value |
will be returned to the source by DoDragDrop. |
- The target also calls the data object's IDataObject::SetData method and |
passes it a CFSTR_PERFORMEDDROPEFFECT format identifier set to |
DROPEFFECT_NONE. This method call is necessary because some drop targets |
might not set the pdwEffect parameter of DoDragDrop properly. The |
CFSTR_PERFORMEDDROPEFFECT format is the reliable way to indicate that an |
optimized move has taken place. |
If the target did an unoptimized move, the data must be deleted by the |
source. To inform the source that an unoptimized move was performed: |
- The target sets the pdwEffect value it received through its |
IDropTarget::Drop method to DROPEFFECT_MOVE. The value will be returned |
to the source by DoDragDrop. |
- The target also calls the data object's IDataObject::SetData method and |
passes it a CFSTR_PERFORMEDDROPEFFECT format identifier set to |
DROPEFFECT_MOVE. This method call is necessary because some drop targets |
might not set the pdwEffect parameter of DoDragDrop properly. The |
CFSTR_PERFORMEDDROPEFFECT format is the reliable way to indicate that an |
unoptimized move has taken place. |
5) The source inspects the two values that can be returned by the target. If |
both are set to DROPEFFECT_MOVE, it completes the unoptimized move by |
deleting the original data. Otherwise, the target did an optimized move and |
the original data has been deleted. |
*) |
|
// TODO : Why isn't this code in the Drop method? |
// Report performed drop effect back to data originator. |
if (Effect <> DROPEFFECT_NONE) then |
begin |
// If the transfer was an optimized move operation (target deletes data), |
// we convert the move operation to a copy operation to prevent that the |
// source deletes the data. |
if (FOptimizedMove) and (Effect = DROPEFFECT_MOVE) then |
Effect := DROPEFFECT_COPY; |
SetPerformedDropEffect(Effect); |
end; |
end; |
|
type |
TDropTargetTransferThread = class(TThread) |
private |
FCustomDropTarget: TCustomDropTarget; |
FDataObject: IDataObject; |
FEffect: Longint; |
FMarshalStream: pointer; |
protected |
procedure Execute; override; |
property MarshalStream: pointer read FMarshalStream write FMarshalStream; |
public |
constructor Create(ACustomDropTarget: TCustomDropTarget; |
const ADataObject: IDataObject; AEffect: Longint); |
property CustomDropTarget: TCustomDropTarget read FCustomDropTarget; |
property DataObject: IDataObject read FDataObject; |
property Effect: Longint read FEffect; |
end; |
|
constructor TDropTargetTransferThread.Create(ACustomDropTarget: TCustomDropTarget; |
const ADataObject: IDataObject; AEffect: longInt); |
begin |
inherited Create(True); |
FreeOnTerminate := True; |
FCustomDropTarget := ACustomDropTarget; |
OnTerminate := FCustomDropTarget.DoEndAsyncTransfer; |
FEffect := AEffect; |
OleCheck(CoMarshalInterThreadInterfaceInStream(IDataObject, ADataObject, |
IStream(FMarshalStream))); |
end; |
|
procedure TDropTargetTransferThread.Execute; |
var |
Res: HResult; |
begin |
CoInitialize(nil); |
try |
try |
OleCheck(CoGetInterfaceAndReleaseStream(IStream(MarshalStream), |
IDataObject, FDataObject)); |
MarshalStream := nil; |
CustomDropTarget.FDataObject := DataObject; |
CustomDropTarget.DoGetData; |
Res := S_OK; |
except |
Res := E_UNEXPECTED; |
end; |
(FDataObject as IAsyncOperation).EndOperation(Res, nil, Effect); |
finally |
FDataObject := nil; |
CoUninitialize; |
end; |
end; |
|
procedure TCustomDropTarget.DoEndAsyncTransfer(Sender: TObject); |
begin |
// Reset async transfer flag once transfer completes and... |
FIsAsync := False; |
|
// ...Fire event. |
if Assigned(FOnEndAsyncTransfer) then |
FOnEndAsyncTransfer(Self); |
end; |
|
function TCustomDropTarget.GetData(Effect: longInt): boolean; |
var |
DoAsync: LongBool; |
AsyncOperation: IAsyncOperation; |
// h: HResult; |
begin |
ClearData; |
|
// Determine if drop source supports and has enabled asynchronous data |
// transfer. |
(* |
h := DataObject.QueryInterface(IAsyncOperation, AsyncOperation); |
h := DataObject.QueryInterface(IDropSource, AsyncOperation); |
OutputDebugString(PChar(SysErrorMessage(h))); |
*) |
if not(AllowAsyncTransfer and |
Succeeded(DataObject.QueryInterface(IAsyncOperation, AsyncOperation)) and |
Succeeded(AsyncOperation.GetAsyncMode(DoAsync))) then |
DoAsync := False; |
|
// Start an async data transfer... |
if (DoAsync) then |
begin |
// Fire event. |
if Assigned(FOnStartAsyncTransfer) then |
FOnStartAsyncTransfer(Self); |
FIsAsync := True; |
// Notify drop source that an async data transfer is starting. |
AsyncOperation.StartOperation(nil); |
// Create the data transfer thread and launch it. |
with TDropTargetTransferThread.Create(Self, DataObject, Effect) do |
Resume; |
|
Result := True; |
end else |
Result := DoGetData; |
end; |
|
procedure TCustomDropTarget.Notification(AComponent: TComponent; |
Operation: TOperation); |
begin |
inherited Notification(AComponent, Operation); |
if (Operation = opRemove) and (AComponent is TWinControl) then |
begin |
if (csDesigning in ComponentState) and (AComponent = FTarget) then |
FTarget := nil; |
if (FTargets.IndexOf(TWinControl(AComponent)) <> -1) then |
DoUnregister(TWinControl(AComponent)); |
end; |
end; |
|
type |
TWinControlProxy = class(TWinControl) |
protected |
procedure DestroyWnd; override; |
procedure CreateWnd; override; |
end; |
|
procedure TWinControlProxy.CreateWnd; |
begin |
inherited CreateWnd; |
OleCheck(RegisterDragDrop(Parent.Handle, TCustomDropTarget(Owner))); |
Visible := False; |
end; |
|
procedure TWinControlProxy.DestroyWnd; |
begin |
if (Parent.HandleAllocated) then |
RevokeDragDrop(Parent.Handle); |
// Control must be visible in order to guarantee that CreateWnd is called when |
// parent control recreates window handle. |
Visible := True; |
inherited DestroyWnd; |
end; |
|
procedure TCustomDropTarget.Register(ATarget: TWinControl); |
|
function Contains(Parent, Child: TWinControl): boolean; |
var |
i: integer; |
begin |
if (Child.Parent <> Parent) then |
begin |
Result := False; |
for i := 0 to Parent.ControlCount-1 do |
if (Parent.Controls[i] is TWinControl) and |
Contains(TWinControl(Parent.Controls[i]), Child) then |
begin |
Result := True; |
break; |
end; |
end else |
Result := True; |
end; |
|
var |
i: integer; |
Inserted: boolean; |
begin |
// Don't register if the target is already registered. |
// TODO -cImprovement : Maybe we should unregister and reregister the target if it has already been registered (in case the handle has changed)... |
if (FTargets.IndexOf(ATarget) <> -1) then |
exit; |
|
// Unregister previous target unless MultiTarget is enabled (for backwards |
// compatibility). |
if (not FMultiTarget) and not(csLoading in ComponentState) then |
Unregister; |
|
if (ATarget = nil) then |
exit; |
|
// Insert the target in Z order, Topmost last. |
// Note: The target is added to the target list even though the drop target |
// registration may fail below. This is done because we would like |
// the target to be unregistered (RevokeDragDrop) even if we failed to |
// register it. |
Inserted := False; |
for i := FTargets.Count-1 downto 0 do |
if Contains(FTargets[i], ATarget) then |
begin |
FTargets.Insert(i+1, ATarget); |
Inserted := True; |
break; |
end; |
if (not Inserted) then |
begin |
FTargets.Add(ATarget); |
// ATarget.FreeNotification(Self); |
end; |
|
|
// If the target is a TRichEdit control, we disable the rich edit control's |
// built-in drag/drop support. |
if (ATarget is TCustomRichEdit) then |
RevokeDragDrop(ATarget.Handle); |
|
// Create a child control to monitor the target window handle. |
// The child control will perform the drop target registration for us. |
with TWinControlProxy.Create(Self) do |
Parent := ATarget; |
end; |
|
{$ifdef VER12_PLUS} |
procedure TCustomDropTarget.Unregister(ATarget: TWinControl); |
begin |
// Unregister a single targets (or all targets if ATarget is nil). |
DoUnregister(ATarget); |
end; |
{$else} |
procedure TCustomDropTarget.Unregister; |
begin |
// Unregister all targets (for backward compatibility). |
DoUnregister(nil); |
end; |
{$endif} |
|
procedure TCustomDropTarget.DoUnregister(ATarget: TWinControl); |
var |
i : integer; |
begin |
if (ATarget = nil) then |
begin |
for i := FTargets.Count-1 downto 0 do |
DoUnregister(FTargets[i]); |
exit; |
end; |
|
i := FTargets.IndexOf(ATarget); |
if (i = -1) then |
exit; |
|
if (ATarget = FTarget) then |
FTarget := nil; |
// raise Exception.Create(sUnregisterActiveTarget); |
|
FTargets.Delete(i); |
|
(* Handled by proxy |
if (ATarget.HandleAllocated) then |
// Ignore failed unregistrations - nothing to do about it anyway |
RevokeDragDrop(ATarget.Handle); |
*) |
|
// Delete target proxy. |
// The target proxy willl unregister the drop target for us when it is |
// destroyed. |
for i := ATarget.ControlCount-1 downto 0 do |
if (ATarget.Controls[i] is TWinControlProxy) and |
(TWinControlProxy(ATarget.Controls[i]).Owner = Self) then |
with TWinControlProxy(ATarget.Controls[i]) do |
begin |
Parent := nil; |
Free; |
break; |
end; |
end; |
|
function TCustomDropTarget.FindTarget(p: TPoint): TWinControl; |
(* |
var |
i: integer; |
r: TRect; |
Parent: TWinControl; |
*) |
begin |
|
Result := FindVCLWindow(p); |
while (Result <> nil) and (Targets.IndexOf(Result) = -1) do |
begin |
Result := Result.Parent; |
end; |
(* |
// Search list in Z order. Top to bottom. |
for i := Targets.Count-1 downto 0 do |
begin |
Result := Targets[i]; |
|
// If the control or any of its parent aren't visible, we can't drop on it. |
Parent := Result; |
while (Parent <> nil) do |
begin |
if (not Parent.Showing) then |
break; |
Parent := Parent.Parent; |
end; |
if (Parent <> nil) then |
continue; |
|
GetWindowRect(Result.Handle, r); |
if PtInRect(r, p) then |
exit; |
end; |
Result := nil; |
*) |
end; |
|
function TCustomDropTarget.FindNearestTarget(p: TPoint): TWinControl; |
var |
i : integer; |
r : TRect; |
pc : TPoint; |
Control : TWinControl; |
Dist , |
BestDist : integer; |
|
function Distance(r: TRect; p: TPoint): integer; |
var |
dx , |
dy : integer; |
begin |
if (p.x < r.Left) then |
dx := r.Left - p.x |
else if (p.x > r.Right) then |
dx := r.Right - p.x |
else |
dx := 0; |
if (p.y < r.Top) then |
dy := r.Top - p.y |
else if (p.y > r.Bottom) then |
dy := r.Bottom - p.y |
else |
dy := 0; |
Result := dx*dx + dy*dy; |
end; |
|
begin |
Result := nil; |
BestDist := high(integer); |
for i := 0 to Targets.Count-1 do |
begin |
Control := Targets[i]; |
r := Control.ClientRect; |
inc(r.Right); |
inc(r.Bottom); |
pc := Control.ScreenToClient(p); |
if (PtInRect(r, p)) then |
begin |
Result := Control; |
exit; |
end; |
Dist := Distance(r, pc); |
if (Dist < BestDist) then |
begin |
Result := Control; |
BestDist := Dist; |
end; |
end; |
end; |
|
function TCustomDropTarget.GetTarget: TWinControl; |
begin |
Result := FTarget; |
if (Result = nil) and not(csDesigning in ComponentState) then |
begin |
if (FTargets.Count > 0) then |
Result := TWinControl(FTargets[0]) |
else |
Result := nil; |
end; |
end; |
|
procedure TCustomDropTarget.SetTarget(const Value: TWinControl); |
begin |
if (FTarget = Value) then |
exit; |
|
if (csDesigning in ComponentState) then |
FTarget := Value |
else |
begin |
// If MultiTarget isn't enabled, Register will automatically unregister do |
// no need to do it here. |
if (FMultiTarget) and not(csLoading in ComponentState) then |
Unregister; |
Register(Value); |
end; |
end; |
|
procedure TCustomDropTarget.SetDataObject(Value: IDataObject); |
begin |
FDataObject := Value; |
end; |
|
procedure TCustomDropTarget.SetShowImage(Show: boolean); |
begin |
FShowImage := Show; |
if (DropTargetHelper <> nil) then |
DropTargetHelper.Show(Show) |
else |
if (FDataObject <> nil) then |
ImageList_DragShowNolock(FShowImage); |
end; |
|
function TCustomDropTarget.GetValidDropEffect(ShiftState: TShiftState; |
pt: TPoint; dwEffect: LongInt): LongInt; |
begin |
// dwEffect 'in' parameter = set of drop effects allowed by drop source. |
// Now filter out the effects disallowed by target... |
Result := dwEffect AND DragTypesToDropEffect(FDragTypes); |
|
Result := ShiftStateToDropEffect(ShiftState, Result, True); |
|
// Add Scroll effect if necessary... |
if (FAutoScroll) and (FScrollBars <> []) then |
begin |
// If the cursor is inside the no-scroll zone, clear the drag scroll flag, |
// otherwise set it. |
if (PtInRect(FNoScrollZone, pt)) then |
Result := Result AND NOT integer(DROPEFFECT_SCROLL) |
else |
Result := Result OR integer(DROPEFFECT_SCROLL); |
end; |
|
// 'Default' behaviour can be overriden by assigning OnGetDropEffect. |
if Assigned(FOnGetDropEffect) then |
FOnGetDropEffect(Self, ShiftState, pt, Result); |
end; |
|
function TCustomDropTarget.GetPreferredDropEffect: LongInt; |
begin |
with TPreferredDropEffectClipboardFormat.Create do |
try |
if GetData(DataObject) then |
Result := Value |
else |
Result := DROPEFFECT_NONE; |
finally |
Free; |
end; |
end; |
|
function TCustomDropTarget.SetPasteSucceded(Effect: LongInt): boolean; |
var |
Medium: TStgMedium; |
begin |
with TPasteSuccededClipboardFormat.Create do |
try |
Value := Effect; |
Result := SetData(DataObject, FormatEtc, Medium); |
finally |
Free; |
end; |
end; |
|
function TCustomDropTarget.SetPerformedDropEffect(Effect: longInt): boolean; |
var |
Medium: TStgMedium; |
begin |
with TPerformedDropEffectClipboardFormat.Create do |
try |
Value := Effect; |
Result := SetData(DataObject, FormatEtc, Medium); |
finally |
Free; |
end; |
end; |
|
(* |
The basic procedure for a delete-on-paste operation is as follows (from MSDN): |
|
1) The source marks the screen display of the selected data. |
2) The source creates a data object. It indicates a cut operation by adding the |
CFSTR_PREFERREDDROPEFFECT format with a data value of DROPEFFECT_MOVE. |
3) The source places the data object on the Clipboard using OleSetClipboard. |
4) The target retrieves the data object from the Clipboard using |
OleGetClipboard. |
5) The target extracts the CFSTR_PREFERREDDROPEFFECT data. If it is set to only |
DROPEFFECT_MOVE, the target can either do an optimized move or simply copy |
the data. |
6) If the target does not do an optimized move, it calls the |
IDataObject::SetData method with the CFSTR_PERFORMEDDROPEFFECT format set |
to DROPEFFECT_MOVE. |
7) When the paste is complete, the target calls the IDataObject::SetData method |
with the CFSTR_PASTESUCCEEDED format set to DROPEFFECT_MOVE. |
8) When the source's IDataObject::SetData method is called with the |
CFSTR_PASTESUCCEEDED format set to DROPEFFECT_MOVE, it must check to see if it |
also received the CFSTR_PERFORMEDDROPEFFECT format set to DROPEFFECT_MOVE. If |
both formats are sent by the target, the source will have to delete the data. |
If only the CFSTR_PASTESUCCEEDED format is received, the source can simply |
remove the data from its display. If the transfer fails, the source updates |
the display to its original appearance. |
*) |
function TCustomDropTarget.PasteFromClipboard: longint; |
var |
Effect: longInt; |
begin |
// Get an IDataObject interface to the clipboard. |
// Temporarily pretend that the IDataObject has been dropped on the target. |
OleCheck(OleGetClipboard(FDataObject)); |
try |
Effect := GetPreferredDropEffect; |
// Get data from the IDataObject. |
if (GetData(Effect)) then |
Result := Effect |
else |
Result := DROPEFFECT_NONE; |
|
DoOnPaste(Result); |
finally |
// Clean up |
FDataObject := nil; |
end; |
end; |
|
procedure TCustomDropTarget.DoOnPaste(var Effect: longint); |
begin |
// Generate an OnDrop event |
DoDrop([], Point(0,0), Effect); |
|
// Report performed drop effect back to data originator. |
if (Effect <> DROPEFFECT_NONE) then |
// Delete on paste: |
// We now set the CF_PASTESUCCEDED format to indicate to the source |
// that we are using the "delete on paste" protocol and that the |
// paste has completed. |
SetPasteSucceded(Effect); |
end; |
|
procedure TCustomDropTarget.Assign(Source: TPersistent); |
begin |
if (Source is TClipboard) then |
PasteFromClipboard |
else if (Source.GetInterface(IDataObject, FDataObject)) then |
begin |
try |
// Get data from the IDataObject |
if (not GetData(DROPEFFECT_COPY)) then |
inherited Assign(Source); |
finally |
// Clean up |
FDataObject := nil; |
end; |
end else |
inherited Assign(Source); |
end; |
|
procedure TCustomDropTarget.DoAutoScroll(Sender: TObject); |
var |
Scroll: TScrolDirections; |
Interval: integer; |
begin |
// Disable timer until we are ready to auto-repeat the scroll. |
// If no scroll is performed, the scroll stops here. |
FScrollTimer.Enabled := False;; |
|
Interval := DragDropScrollInterval; |
Scroll := []; |
|
// Only scroll if the pointer is outside the non-scroll area |
if (not PtInRect(FNoScrollZone, FLastPoint)) then |
begin |
with FLastPoint do |
begin |
// Determine which way to scroll. |
if (Y < FNoScrollZone.Top) then |
include(Scroll, sdUp) |
else if (Y > FNoScrollZone.Bottom) then |
include(Scroll, sdDown); |
|
if (X < FNoScrollZone.Left) then |
include(Scroll, sdLeft) |
else if (X > FNoScrollZone.Right) then |
include(Scroll, sdRight); |
end; |
end; |
|
DoScroll(FLastPoint, Scroll, Interval); |
|
// Note: Once the OnScroll event has been fired and the user has had a |
// chance of overriding the auto scroll logic, we should *only* use to Scroll |
// variable to determine if and how to scroll. Do not use FScrollBars past |
// this point. |
|
// Only scroll if the pointer is outside the non-scroll area |
if (Scroll <> []) then |
begin |
// Remove drag image before scrolling |
if (FDragImageHandle <> 0) then |
ImageList_DragLeave(FTarget.Handle); |
try |
if (sdUp in Scroll) then |
FTarget.Perform(WM_VSCROLL,SB_LINEUP, 0) |
else if (sdDown in Scroll) then |
FTarget.Perform(WM_VSCROLL,SB_LINEDOWN, 0); |
|
if (sdLeft in Scroll) then |
FTarget.Perform(WM_HSCROLL,SB_LINEUP, 0) |
else if (sdRight in Scroll) then |
FTarget.Perform(WM_HSCROLL,SB_LINEDOWN, 0); |
finally |
// Restore drag image |
if (FDragImageHandle <> 0) then |
with ClientPtToWindowPt(FTarget.Handle, FLastPoint) do |
ImageList_DragEnter(FTarget.Handle, x, y); |
end; |
|
// Reset scroll timer interval once timer has fired once. |
FScrollTimer.Interval := Interval; |
FScrollTimer.Enabled := True; |
end; |
end; |
|
procedure TCustomDropTarget.DoScroll(Point: TPoint; |
var Scroll: TScrolDirections; var Interval: integer); |
begin |
if Assigned(FOnScroll) then |
FOnScroll(Self, FLastPoint, Scroll, Interval); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropDummy |
// |
//////////////////////////////////////////////////////////////////////////////// |
function TDropDummy.HasValidFormats(ADataObject: IDataObject): boolean; |
begin |
Result := False; |
end; |
|
procedure TDropDummy.ClearData; |
begin |
// Abstract method override - doesn't do anything as you can see. |
end; |
|
function TDropDummy.DoGetData: boolean; |
begin |
Result := False; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCustomDropMultiTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
constructor TCustomDropMultiTarget.Create(AOwner: TComponent); |
begin |
inherited Create(AOwner); |
DragTypes := [dtLink, dtCopy]; |
GetDataOnEnter := False; |
FDataFormats := TDataFormats.Create; |
end; |
|
destructor TCustomDropMultiTarget.Destroy; |
var |
i : integer; |
begin |
// Delete all target formats owned by the object. |
for i := FDataFormats.Count-1 downto 0 do |
FDataFormats[i].Free; |
FDataFormats.Free; |
inherited Destroy; |
end; |
|
function TCustomDropMultiTarget.HasValidFormats(ADataObject: IDataObject): boolean; |
var |
GetNum , |
GotNum : longInt; |
FormatEnumerator : IEnumFormatEtc; |
i : integer; |
SourceFormatEtc : TFormatEtc; |
begin |
Result := False; |
|
if (ADataObject.EnumFormatEtc(DATADIR_GET, FormatEnumerator) <> S_OK) or |
(FormatEnumerator.Reset <> S_OK) then |
exit; |
|
GetNum := 1; // Get one format at a time. |
|
// Enumerate all data formats offered by the drop source. |
// Note: Depends on order of evaluation. |
while (not Result) and |
(FormatEnumerator.Next(GetNum, SourceFormatEtc, @GotNum) = S_OK) and |
(GetNum = GotNum) do |
begin |
// Determine if any of the associated clipboard formats can |
// read the current data format. |
for i := 0 to FDataFormats.Count-1 do |
if (FDataFormats[i].AcceptFormat(SourceFormatEtc)) and |
(FDataFormats[i].HasValidFormats(ADataObject)) then |
begin |
Result := True; |
DoAcceptFormat(FDataFormats[i], Result); |
if (Result) then |
break; |
end; |
end; |
end; |
|
procedure TCustomDropMultiTarget.ClearData; |
var |
i : integer; |
begin |
if (AsyncTransfer) then |
raise Exception.Create(sAsyncBusy); |
for i := 0 to DataFormats.Count-1 do |
DataFormats[i].Clear; |
end; |
|
function TCustomDropMultiTarget.DoGetData: boolean; |
var |
i: integer; |
Accept: boolean; |
begin |
Result := False; |
|
// Get data for all target formats |
for i := 0 to DataFormats.Count-1 do |
begin |
// This isn't strictly nescessary and adds overhead, but it reduces |
// unnescessary calls to DoAcceptData (format is asked if it can accept data |
// even though no data is available to the format). |
if not(FDataFormats[i].HasValidFormats(DataObject)) then |
continue; |
|
// Only get data from accepted formats. |
// TDropComboTarget uses the DoAcceptFormat method to filter formats and to |
// allow the user to disable formats via an event. |
Accept := True; |
DoAcceptFormat(DataFormats[i], Accept); |
if (not Accept) then |
Continue; |
|
Result := DataFormats[i].GetData(DataObject) or Result; |
end; |
end; |
|
procedure TCustomDropMultiTarget.DoAcceptFormat(const DataFormat: TCustomDataFormat; |
var Accept: boolean); |
begin |
if Assigned(FOnAcceptFormat) then |
FOnAcceptFormat(Self, DataFormat, Accept); |
end; |
|
end. |
|