Subversion Repositories decoder

unit DragDrop;

// -----------------------------------------------------------------------------

// Project:         Drag and Drop Component Suite

// Module:          DragDrop

// Description:     Implements base classes and utility functions.

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

// -----------------------------------------------------------------------------

// TODO -oanme -cPortability : Replace all public use of HWND with THandle. BCB's HWND <> Delphi's HWND.

{$include DragDrop.inc}

interface

uses

  Classes,

  Windows,

  ActiveX;

{$IFDEF BCB}

{$HPPEMIT '#ifndef NO_WIN32_LEAN_AND_MEAN'}

{$HPPEMIT '"Error: The NO_WIN32_LEAN_AND_MEAN symbol must be defined in your projects conditional defines"'}

{$HPPEMIT '#endif'}

{$ENDIF}

const

  DROPEFFECT_NONE   = ActiveX.DROPEFFECT_NONE;

  DROPEFFECT_COPY   = ActiveX.DROPEFFECT_COPY;

  DROPEFFECT_MOVE   = ActiveX.DROPEFFECT_MOVE;

  DROPEFFECT_LINK   = ActiveX.DROPEFFECT_LINK;

  DROPEFFECT_SCROLL = ActiveX.DROPEFFECT_SCROLL;

type

  // TDragType enumerates the three possible drag/drop operations.

  TDragType = (dtCopy, dtMove, dtLink);

  TDragTypes = set of TDragType;

type

  // TDataDirection is used by the clipboard format registration to specify

  // if the clipboard format should be listed in get (read) format enumerations,

  // set (write) format enumerations or both.

  // ddRead : Destination (IDropTarget) can read data from IDataObject.

  // ddWrite : Destination (IDropTarget) can write data to IDataObject.

  TDataDirection = (ddRead, ddWrite);

  TDataDirections = set of TDataDirection;

const

  ddReadWrite = [ddRead, ddWrite];

type

  // TConversionScope is used by the clipboard format registration to specify

  // if a clipboard format conversion is supported by the drop source, the drop

  // target or both.

  // ddSource : Conversion is valid for drop source (IDropSource).

  // ddTarget : Conversion is valid for drop target (IDropTarget).

  TConversionScope = (csSource, csTarget);

  TConversionScopes = set of TConversionScope;

const

  csSourceTarget = [csSource, csTarget];

// C++ Builder's declaration of IEnumFORMATETC is incorrect, so we must generate

// the typedef for C++ Builder.

{$IFDEF BCB}

{$HPPEMIT 'typedef System::DelphiInterface<IEnumFORMATETC> _di_IEnumFORMATETC;' }

{$ENDIF}

////////////////////////////////////////////////////////////////////////////////

//

//              TInterfacedComponent

//

////////////////////////////////////////////////////////////////////////////////

// Top level base class for the drag/drop component hierachy.

// Implements the IUnknown interface.

// Corresponds to TInterfacedObject (see VCL on-line help), but descends from

// TComponent instead of TObject.

// Reference counting is disabled (_AddRef and _Release methods does nothing)

// since the component life span is controlled by the component owner.

////////////////////////////////////////////////////////////////////////////////

type

  TInterfacedComponent = class(TComponent, IUnknown)

  protected

    function QueryInterface(const IID: TGuid; out Obj): HRESULT;

      {$IFDEF VER13_PLUS} override; {$ELSE}

      {$IFDEF VER12_PLUS} reintroduce; {$ENDIF}{$ENDIF} stdcall;

    function _AddRef: Integer; stdcall;

    function _Release: Integer; stdcall;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              TClipboardFormat

//

////////////////////////////////////////////////////////////////////////////////

// Abstract base class. Extracts or injects data of a specific low level format

// from or to an IDataObject.

////////////////////////////////////////////////////////////////////////////////

type

  TCustomDataFormat = class;

  TClipboardFormat = class(TObject)

  private

    FDataDirections: TDataDirections;

    FDataFormat: TCustomDataFormat;

  protected

    FFormatEtc: TFormatEtc;

    constructor CreateFormat(Atymed: Longint); virtual;

    constructor CreateFormatEtc(const AFormatEtc: TFormatEtc); virtual;

    { Extracts data from the specified medium }

    function DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean; virtual;

    { Transfer data to the specified medium }

    function DoSetData(const FormatEtcIn: TFormatEtc;

      var AMedium: TStgMedium): boolean; virtual;

    function GetClipboardFormat: TClipFormat; virtual;

    procedure SetClipboardFormat(Value: TClipFormat); virtual;

    function GetClipboardFormatName: string; virtual;

    procedure SetClipboardFormatName(const Value: string); virtual;

    procedure SetFormatEtc(const Value: TFormatEtc);

  public

    constructor Create; virtual; abstract;

    destructor Destroy; override;

    { Determines if the object can read from the specified data object }

    function HasValidFormats(ADataObject: IDataObject): boolean; virtual;

    { Determines if the object can read the specified format }

    function AcceptFormat(const AFormatEtc: TFormatEtc): boolean; virtual;

    { Extracts data from the specified IDataObject }

    function GetData(ADataObject: IDataObject): boolean; virtual;

    { Extracts data from the specified IDataObject via the specified medium }

    function GetDataFromMedium(ADataObject: IDataObject;

      var AMedium: TStgMedium): boolean; virtual;

    { Transfers data to the specified IDataObject }

    function SetData(ADataObject: IDataObject; const FormatEtcIn: TFormatEtc;

      var AMedium: TStgMedium): boolean; virtual;

    { Transfers data to the specified medium }

    function SetDataToMedium(const FormatEtcIn: TFormatEtc;

      var AMedium: TStgMedium): boolean;

    { Copies data from the specified source format to the object }

    function Assign(Source: TCustomDataFormat): boolean; virtual;

    { Copies data from the object to the specified target format }

    function AssignTo(Dest: TCustomDataFormat): boolean; virtual;

    { Clears the objects data }

    procedure Clear; virtual; abstract;

    { Returns true if object can supply data }

    function HasData: boolean; virtual;

    { Unregisters the clipboard format and all mappings involving it from the global database }

    class procedure UnregisterClipboardFormat;

    { Returns the clipboard format value }

    property ClipboardFormat: TClipFormat read GetClipboardFormat

      write SetClipboardFormat;

    { Returns the clipboard format name }

    property ClipboardFormatName: string read GetClipboardFormatName

      write SetClipboardFormatName;

    { Provides access to the objects format specification }

    property FormatEtc: TFormatEtc read FFormatEtc;

    { Specifies whether the format can read and write data }

    property DataDirections: TDataDirections read FDataDirections

      write FDataDirections;

    { Specifies the data format which owns and controls this clipboard format }

    property DataFormat: TCustomDataFormat read FDataFormat write FDataFormat;

  end;

  TClipboardFormatClass = class of TClipboardFormat;

  // TClipboardFormats

  // List of TClipboardFormat objects.

  TClipboardFormats = class(TObject)

  private

    FList: TList;

    FOwnsObjects: boolean;

    FDataFormat: TCustomDataFormat;

  protected

    function GetFormat(Index: integer): TClipboardFormat;

    function GetCount: integer;

  public

    constructor Create(ADataFormat: TCustomDataFormat; AOwnsObjects: boolean);

    destructor Destroy; override;

    procedure Clear;

    function Add(ClipboardFormat: TClipboardFormat): integer;

    function Contain(ClipboardFormatClass: TClipboardFormatClass): boolean;

    function FindFormat(ClipboardFormatClass: TClipboardFormatClass): TClipboardFormat;

    property Formats[Index: integer]: TClipboardFormat read GetFormat; default;

    property Count: integer read GetCount;

    property DataFormat: TCustomDataFormat read FDataFormat;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              TDragDropComponent

//

////////////////////////////////////////////////////////////////////////////////

// Base class for drag/drop components.

////////////////////////////////////////////////////////////////////////////////

  TDataFormats = class;

  TDragDropComponent = class(TInterfacedComponent)

  private

  protected

    FDataFormats: TDataFormats;

    //: Only used by TCustomDropMultiSource and TCustomDropMultiTarget and

    // their descendants.

    property DataFormats: TDataFormats read FDataFormats;

  public

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              TCustomFormat

//

////////////////////////////////////////////////////////////////////////////////

// Abstract base class.

// Renders the data of one or more TClipboardFormat objects to or from a

// specific high level data format.

////////////////////////////////////////////////////////////////////////////////

  TCustomDataFormat = class(TObject)

  private

    FCompatibleFormats  : TClipboardFormats;

    FFormatList         : TDataFormats;

    FOwner              : TDragDropComponent;

    FOnChanging         : TNotifyEvent;

  protected

    { Determines if the object can accept data from the specified source format }

    function SupportsFormat(ClipboardFormat: TClipboardFormat): boolean;

    procedure DoOnChanging(Sender: TObject);

    procedure Changing; virtual;

    property FormatList: TDataFormats read FFormatList;

  public

    constructor Create(AOwner: TDragDropComponent); virtual;

    destructor Destroy; override;

    procedure Clear; virtual; abstract;

    { Copies data between the specified clipboard format to the object }

    function Assign(Source: TClipboardFormat): boolean; virtual;

    function AssignTo(Dest: TClipboardFormat): boolean; virtual;

    { Extracts data from the specified IDataObject }

    function GetData(DataObject: IDataObject): boolean; virtual;

    { Determines if the object contains *any* data }

    function HasData: boolean; virtual; abstract;

    { Determines if the object needs/can use *more* data }

    function NeedsData: boolean; virtual;

    { Determines if the object can read from the specified data object }

    function HasValidFormats(ADataObject: IDataObject): boolean; virtual;

    { Determines if the object can read the specified format }

    function AcceptFormat(const FormatEtc: TFormatEtc): boolean; virtual;

    { Registers the data format in the data format list }

    class procedure RegisterDataFormat;

    { Registers the specified clipboard format as being compatible with the data format }

    class procedure RegisterCompatibleFormat(ClipboardFormatClass: TClipboardFormatClass;

      Priority: integer {$ifdef VER12_PLUS} = 0 {$endif};

      ConversionScopes: TConversionScopes {$ifdef VER12_PLUS} = csSourceTarget {$endif};

      DataDirections: TDataDirections {$ifdef VER12_PLUS} = [ddRead] {$endif});

    { Unregisters the specified clipboard format from the compatibility list }

    class procedure UnregisterCompatibleFormat(ClipboardFormatClass: TClipboardFormatClass);

    { Unregisters data format and all mappings involving it from the global database }

    class procedure UnregisterDataFormat;

    { List of compatible source formats }

    property CompatibleFormats: TClipboardFormats read FCompatibleFormats;

    property Owner: TDragDropComponent read FOwner;

    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;

    // TODO : Add support for delayed rendering with DelayedRender property.

  end;

  // TDataFormats

  // List of TCustomDataFormat objects.

  TDataFormats = class(TObject)

  private

    FList: TList;

  protected

    function GetFormat(Index: integer): TCustomDataFormat;

    function GetCount: integer;

  public

    constructor Create;

    destructor Destroy; override;

    function Add(DataFormat: TCustomDataFormat): integer; virtual;

    function IndexOf(DataFormat: TCustomDataFormat): integer; virtual;

    procedure Remove(DataFormat: TCustomDataFormat); virtual;

    property Formats[Index: integer]: TCustomDataFormat read GetFormat; default;

    property Count: integer read GetCount;

  end;

  // TDataFormatClasses

  // List of TCustomDataFormat classes.

  TDataFormatClass = class of TCustomDataFormat;

  TDataFormatClasses = class(TObject)

  private

    FList: TList;

  protected

    function GetFormat(Index: integer): TDataFormatClass;

    function GetCount: integer;

    { Provides singleton access to the global data format database }

    class function Instance: TDataFormatClasses;

  public

    constructor Create;

    destructor Destroy; override;

    function Add(DataFormat: TDataFormatClass): integer; virtual;

    procedure Remove(DataFormat: TDataFormatClass); virtual;

    property Formats[Index: integer]: TDataFormatClass read GetFormat; default;

    property Count: integer read GetCount;

  end;

  // TDataFormatMap

  // Format conversion database. Contains mappings between TClipboardFormat

  // and TCustomDataFormat.

  // Used internally by TCustomDropMultiTarget and TCustomDropMultiSource.

  TDataFormatMap = class(TObject)

    FList: TList;

  protected

    function FindMap(DataFormatClass: TDataFormatClass; ClipboardFormatClass: TClipboardFormatClass): integer;

    procedure Sort;

    { Provides singleton access to the global format map database }

    class function Instance: TDataFormatMap;

  public

    constructor Create;

    destructor Destroy; override;

    procedure Add(DataFormatClass: TDataFormatClass;

      ClipboardFormatClass: TClipboardFormatClass;

      Priority: integer {$ifdef VER12_PLUS} = 0 {$endif};

      ConversionScopes: TConversionScopes {$ifdef VER12_PLUS} = csSourceTarget {$endif};

      DataDirections: TDataDirections {$ifdef VER12_PLUS} = [ddRead] {$endif});

    procedure Delete(DataFormatClass: TDataFormatClass;

      ClipboardFormatClass: TClipboardFormatClass);

    procedure DeleteByClipboardFormat(ClipboardFormatClass: TClipboardFormatClass);

    procedure DeleteByDataFormat(DataFormatClass: TDataFormatClass);

    procedure GetSourceByDataFormat(DataFormatClass: TDataFormatClass;

      ClipboardFormats: TClipboardFormats; ConversionScope: TConversionScope);

    function CanMap(DataFormatClass: TDataFormatClass;

      ClipboardFormatClass: TClipboardFormatClass): boolean;

    { Registers the specified format mapping }

    procedure RegisterFormatMap(DataFormatClass: TDataFormatClass;

      ClipboardFormatClass: TClipboardFormatClass;

      Priority: integer {$ifdef VER12_PLUS} = 0 {$endif};

      ConversionScopes: TConversionScopes {$ifdef VER12_PLUS} = csSourceTarget {$endif};

      DataDirections: TDataDirections {$ifdef VER12_PLUS} = [ddRead] {$endif});

    { Unregisters the specified format mapping }

    procedure UnregisterFormatMap(DataFormatClass: TDataFormatClass;

      ClipboardFormatClass: TClipboardFormatClass);

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              TDataFormatAdapter

//

////////////////////////////////////////////////////////////////////////////////

// Helper component used to add additional data formats to a drop source or

// target at design time.

// Requires that data formats have been registered with

// TCustomDataFormat.RegisterDataFormat.

////////////////////////////////////////////////////////////////////////////////

  TDataFormatAdapter = class(TComponent)

  private

    FDragDropComponent: TDragDropComponent;

    FDataFormat: TCustomDataFormat;

    FDataFormatClass: TDataFormatClass;

    FEnabled: boolean;

    function GetDataFormatName: string;

    procedure SetDataFormatName(const Value: string);

  protected

    procedure SetDataFormatClass(const Value: TDataFormatClass);

    procedure SetDragDropComponent(const Value: TDragDropComponent);

    function GetEnabled: boolean;

    procedure SetEnabled(const Value: boolean);

    procedure Notification(AComponent: TComponent;

      Operation: TOperation); override;

    procedure Loaded; override;

  public

    destructor Destroy; override;

    property DataFormatClass: TDataFormatClass read FDataFormatClass

      write SetDataFormatClass;

    property DataFormat: TCustomDataFormat read FDataFormat;

  published

    property DragDropComponent: TDragDropComponent read FDragDropComponent

      write SetDragDropComponent;

    property DataFormatName: string read GetDataFormatName

      write SetDataFormatName;

    property Enabled: boolean read GetEnabled write SetEnabled;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              Drag Drop helper interfaces

//

////////////////////////////////////////////////////////////////////////////////

// Requires Windows 2000 or later.

////////////////////////////////////////////////////////////////////////////////

type

  PSHDRAGIMAGE = ^TSHDRAGIMAGE;

  {_$EXTERNALSYM _SHDRAGIMAGE}

  _SHDRAGIMAGE = packed record

    sizeDragImage: TSize;               { The length and Width of the rendered image }

    ptOffset: TPoint;                   { The Offset from the mouse cursor to the upper left corner of the image }

    hbmpDragImage: HBitmap;             { The Bitmap containing the rendered drag images }

    crColorKey: COLORREF;               { The COLORREF that has been blitted to the background of the images }

  end;

  TSHDRAGIMAGE = _SHDRAGIMAGE;

  {_$EXTERNALSYM SHDRAGIMAGE}

  SHDRAGIMAGE = _SHDRAGIMAGE;

const

  CLSID_DragDropHelper: TGUID = (

    D1:$4657278a; D2:$411b; D3:$11d2; D4:($83,$9a,$00,$c0,$4f,$d9,$18,$d0));

  SID_DragDropHelper = '{4657278A-411B-11d2-839A-00C04FD918D0}';

const

  IID_IDropTargetHelper: TGUID = (

    D1:$4657278b; D2:$411b; D3:$11d2; D4:($83,$9a,$00,$c0,$4f,$d9,$18,$d0));

  SID_IDropTargetHelper = '{4657278B-411B-11d2-839A-00C04FD918D0}';

type

  {_$HPPEMIT 'typedef DragDrop::DelphiInterface<IDropTargetHelper> _di_IDropTargetHelper;'}

  {_$EXTERNALSYM IDropTargetHelper}

  IDropTargetHelper = interface(IUnknown)

    [SID_IDropTargetHelper]

    function DragEnter(hwndTarget: HWND; const DataObj: IDataObject;

      var pt: TPoint; dwEffect: Longint): HResult; stdcall;

    function DragLeave: HResult; stdcall;

    function DragOver(var pt: TPoint; dwEffect: longInt): HResult; stdcall;

    function Drop(const DataObj: IDataObject; var pt: TPoint;

      dwEffect: longInt): HResult; stdcall;

    function Show(Show: BOOL): HResult; stdcall;

  end;

const

  IID_IDragSourceHelper: TGUID = (

    D1:$de5bf786; D2:$477a; D3:$11d2; D4:($83,$9d,$00,$c0,$4f,$d9,$18,$d0));

  SID_IDragSourceHelper = '{DE5BF786-477A-11d2-839D-00C04FD918D0}';

type

  {_$HPPEMIT 'typedef DragDrop::DelphiInterface<IDragSourceHelper> _di_IDragSourceHelper;'}

  {_$EXTERNALSYM IDragSourceHelper}

  IDragSourceHelper = interface(IUnknown)

    [SID_IDragSourceHelper]

    function InitializeFromBitmap(var shdi: TSHDRAGIMAGE;

      const DataObj: IDataObject): HResult; stdcall;

    function InitializeFromWindow(hwnd: HWND; var pt: TPoint;

      const DataObj: IDataObject): HResult; stdcall;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              Async data transfer interfaces

//

////////////////////////////////////////////////////////////////////////////////

// Requires Windows 2000 or later.

////////////////////////////////////////////////////////////////////////////////

const

  IID_IAsyncOperation: TGUID = (

    D1:$3D8B0590; D2:$F691; D3:$11D2; D4:($8E,$A9,$00,$60,$97,$DF,$5B,$D4));

  SID_IAsyncOperation = '{3D8B0590-F691-11D2-8EA9-006097DF5BD4}';

type

  {_$HPPEMIT 'typedef DragDrop::DelphiInterface<IAsyncOperation> _di_IAsyncOperation;'}

  {_$EXTERNALSYM IAsyncOperation}

  IAsyncOperation = interface(IUnknown)

    [SID_IAsyncOperation]

    function SetAsyncMode(fDoOpAsync: BOOL): HResult; stdcall;

    function GetAsyncMode(out fDoOpAsync: BOOL): HResult; stdcall;

    function StartOperation(const pbcReserved: IBindCtx): HResult; stdcall;

    function InOperation(out pfInAsyncOp: BOOL): HResult; stdcall;

    function EndOperation(hResult: HRESULT; const pbcReserved: IBindCtx;

      dwEffects: DWORD): HResult; stdcall;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              TRawClipboardFormat & TRawDataFormat

//

////////////////////////////////////////////////////////////////////////////////

// These clipboard and data format classes are special in that they don't

// interpret the data in any way.

// Their primary purpose is to enable the TCustomDropMultiSource class to accept

// and store arbitrary (and unknown) data types. This is a requirement for

// drag drop helper object support.

////////////////////////////////////////////////////////////////////////////////

// The TRawDataFormat class does not perform any storage of data itself. Instead

// it relies on the TRawClipboardFormat objects to store data.

////////////////////////////////////////////////////////////////////////////////

  TRawDataFormat = class(TCustomDataFormat)

  private

    FMedium: TStgMedium;

  protected

  public

    procedure Clear; override;

    function HasData: boolean; override;

    function NeedsData: boolean; override;

    property Medium: TStgMedium read FMedium write FMedium;

  end;

  TRawClipboardFormat = class(TClipboardFormat)

  private

    FMedium: TStgMedium;

  protected

    function DoGetData(ADataObject: IDataObject;

      const AMedium: TStgMedium): boolean; override;

    function DoSetData(const FormatEtcIn: TFormatEtc;

      var AMedium: TStgMedium): boolean; override;

    procedure SetClipboardFormatName(const Value: string); override;

    function GetClipboardFormat: TClipFormat; override;

    function GetString: string;

    procedure SetString(const Value: string);

  public

    constructor Create; override;

    constructor CreateFormatEtc(const AFormatEtc: TFormatEtc); override;

    function Assign(Source: TCustomDataFormat): boolean; override;

    function AssignTo(Dest: TCustomDataFormat): boolean; override;

    procedure Clear; override;

    // Methods to handle the corresponding TRawDataFormat functioinality.

    procedure ClearData;

    function HasData: boolean; override;

    function NeedsData: boolean;

    // All of these should be moved/mirrored in TRawDataFormat:

    procedure CopyFromStgMedium(const AMedium: TStgMedium);

    procedure CopyToStgMedium(var AMedium: TStgMedium);

    property AsString: string read GetString write SetString;

    property Medium: TStgMedium read FMedium write FMedium;

  end;

////////////////////////////////////////////////////////////////////////////////

//

//              Utility functions

//

////////////////////////////////////////////////////////////////////////////////

function DropEffectToDragType(DropEffect: longInt; var DragType: TDragType): boolean;

function DragTypesToDropEffect(DragTypes: TDragTypes): longint; // V4: New

// Coordinate space conversion.

function ClientPtToWindowPt(Handle: THandle; pt: TPoint): TPoint;

// Replacement for KeysToShiftState.

function KeysToShiftStatePlus(Keys: Word): TShiftState; // V4: New

function ShiftStateToDropEffect(Shift: TShiftState; AllowedEffects: longint;

  Fallback: boolean): longint;

// Replacement for the buggy DragDetect API function.

function DragDetectPlus(Handle: THandle; p: TPoint): boolean; // V4: New

// Wrapper for urlmon.CopyStgMedium.

// Note: Only works with IE4 or later installed.

function CopyStgMedium(const SrcMedium: TStgMedium; var DstMedium: TStgMedium): boolean;

// Get the name of a clipboard format as a Delphi string.

function GetClipboardFormatNameStr(Value: TClipFormat): string;

// Raise last Windows API error as an exception.

procedure _RaiseLastWin32Error;

////////////////////////////////////////////////////////////////////////////////

//

//              Global variables

//

////////////////////////////////////////////////////////////////////////////////

var

  ShellMalloc: IMalloc;

// Name of the IDE component palette page the drag drop components are

// registered to

var

  DragDropComponentPalettePage: string = 'DragDrop';

////////////////////////////////////////////////////////////////////////////////

//

//              Misc drop target related constants

//

////////////////////////////////////////////////////////////////////////////////

// Drag Drop constants from ActiveX unit

var

  // Default inset-width of the auto scroll hot zone.

  // Specified in pixels.

  // Not used! Instead the height of the target control's font is used.

  DragDropScrollInset: integer = DD_DEFSCROLLINSET; // 11

  // Default delay after entering the scroll zone, before scrolling starts.

  // Specified in milliseconds.

  DragDropScrollDelay: integer = DD_DEFSCROLLDELAY; //  50

  // Default scroll interval during auto scroll.

  // Specified in milliseconds.

  DragDropScrollInterval: integer = DD_DEFSCROLLINTERVAL; // 50

  // Default delay before dragging should start.

  // Specified in milliseconds.

  DragDropDragDelay: integer = DD_DEFDRAGDELAY; // 200

  // Default minimum distance (radius) before dragging should start.

  // Specified in pixels.

  // Not used! Instead the SM_CXDRAG and SM_CYDRAG system metrics are used.

  DragDropDragMinDistance: integer = DD_DEFDRAGMINDIST; // 2

////////////////////////////////////////////////////////////////////////////////

//

//              Misc drag drop API related constants

//

////////////////////////////////////////////////////////////////////////////////

// The following DVASPECT constants are missing from some versions of Delphi and

// C++ Builder.

{$ifndef VER135_PLUS}

const

{$ifndef VER10_PLUS}

  DVASPECT_SHORTNAME = 2; // use for CF_HDROP to get short name version of file paths

{$endif}

  DVASPECT_COPY = 3; // use to indicate format is a "Copy" of the data (FILECONTENTS, FILEDESCRIPTOR, etc)

  DVASPECT_LINK = 4; // use to indicate format is a "Shortcut" to the data (FILECONTENTS, FILEDESCRIPTOR, etc)

{$endif}

////////////////////////////////////////////////////////////////////////////////

//

//              Component registration

//

////////////////////////////////////////////////////////////////////////////////

procedure Register;

(*******************************************************************************

**

**                      IMPLEMENTATION

**

*******************************************************************************)

implementation

uses

{$ifdef DEBUG}

  ComObj,

{$endif}

  DropSource,

  DropTarget,

  DragDropFormats, // Used by TRawClipboardFormat

  Messages,

  ShlObj,

  MMSystem,

  SysUtils;

resourcestring

  sImplementationRequired = 'Internal error: %s.%s needs implementation';

  sInvalidOwnerType = '%s is not a valid owner for %s. Owner must be derived from %s';

  sFormatNameReadOnly = '%s.ClipboardFormat is read-only';

  sNoCopyStgMedium = 'A required system function (URLMON.CopyStgMedium) was not available on this system. Operation aborted.';

  sBadConstructor = 'The %s class can not be instantiated with the default constructor';

  sUnregisteredDataFormat = 'The %s data format has not been registered by any of the used units';

////////////////////////////////////////////////////////////////////////////////

//

//              Component registration

//

////////////////////////////////////////////////////////////////////////////////

procedure Register;

begin

  RegisterComponents(DragDropComponentPalettePage, [TDataFormatAdapter]);

end;

////////////////////////////////////////////////////////////////////////////////

//

//              TInterfacedComponent

//

////////////////////////////////////////////////////////////////////////////////

function TInterfacedComponent.QueryInterface(const IID: TGuid; out Obj): HRESULT;

{$ifdef DEBUG}

  function GuidToString(const IID: TGuid): string;

  var

    GUID: string;

  begin

    GUID := ComObj.GUIDToString(IID);

    Result := GetRegStringValue('Interface\'+GUID, '');

    if (Result = '') then

      Result := GUID;

  end;

{$endif}

begin

{$ifdef VER12_PLUS}

  if GetInterface(IID, Obj) then

    Result := 0

  else if (VCLComObject <> nil) then

    Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj)

  else

    Result := E_NOINTERFACE;

{$else}

  Result := inherited QueryInterface(IID, Obj);

{$endif}

{$ifdef DEBUG}

  OutputDebugString(PChar(format('%s.QueryInterface(%s): %d (%d)',

    [ClassName, GuidToString(IID), Result, ord(pointer(Obj) <> nil)])));

{$endif}

end;

function TInterfacedComponent._AddRef: Integer;

var

  Outer: IUnknown;

begin

  // In case we are the inner object of an aggregation, we attempt to delegate

  // the reference counting to the outer object. We assume that the component

  // owner is the outer object.

  if (Owner <> nil) and (Owner.GetInterface(IUnknown, Outer)) then

    Result := Outer._AddRef

  else

  begin

{$ifdef VER12_PLUS}

    inherited _AddRef;

{$else}

    if (VCLComObject <> nil) then

      inherited _AddRef;

{$endif}

    Result := -1;

  end;

end;

function TInterfacedComponent._Release: Integer;

var

  Outer: IUnknown;

begin

  // See _AddRef for comments.

  if (Owner <> nil) and (Owner.GetInterface(IUnknown, Outer)) then

    Result := Outer._Release

  else

  begin

{$ifdef VER12_PLUS}

    inherited _Release;

{$else}

    if (VCLComObject <> nil) then

      inherited _Release;

{$endif}

    Result := -1;

  end;

end;

////////////////////////////////////////////////////////////////////////////////

//

//              TClipboardFormat

//

////////////////////////////////////////////////////////////////////////////////

destructor TClipboardFormat.Destroy;

begin

  // Warning: Do not call Clear here. Descendant class has already

  // cleaned up and released resources!

  inherited Destroy;

end;

constructor TClipboardFormat.CreateFormat(Atymed: Longint);

begin

  inherited Create;

  FDataDirections := [ddRead];

  FFormatEtc.cfFormat := ClipboardFormat;

  FFormatEtc.ptd := nil;

  FFormatEtc.dwAspect := DVASPECT_CONTENT;

  FFormatEtc.lindex := -1;

  FFormatEtc.tymed := Atymed;

end;

constructor TClipboardFormat.CreateFormatEtc(const AFormatEtc: TFormatEtc);

begin

  inherited Create;

  FDataDirections := [ddRead];

  FFormatEtc := AFormatEtc;

end;

function TClipboardFormat.HasValidFormats(ADataObject: IDataObject): boolean;

begin

  Result := (ADataObject.QueryGetData(FormatEtc) = S_OK);

end;

function TClipboardFormat.AcceptFormat(const AFormatEtc: TFormatEtc): boolean;

begin

  Result := (AFormatEtc.cfFormat = FFormatEtc.cfFormat) and

    (AFormatEtc.ptd = nil) and

    (AFormatEtc.dwAspect = FFormatEtc.dwAspect) and

    (AFormatEtc.tymed AND FFormatEtc.tymed <> 0);

end;

function TClipboardFormat.Assign(Source: TCustomDataFormat): boolean;

begin

  Result := False;

end;

function TClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;

begin

  Result := False;

end;

function TClipboardFormat.DoGetData(ADataObject: IDataObject; const AMedium: TStgMedium): boolean;

begin

  Result := False;

end;

function TClipboardFormat.DoSetData(const FormatEtcIn: TFormatEtc;

  var AMedium: TStgMedium): boolean;

begin

  Result := False;

end;