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.