By Astronavigator


2010-12-04 14:50:40 8 Comments

In Delphi XE can I allow my form to accept file 'drag and drop' but without having to handle bare windows messages?

5 comments

@David Heffernan 2010-12-04 16:09:05

You don't need to handle messages to implement this. You just need to implement IDropTarget and call RegisterDragDrop/RevokeDragDrop. It's really very very simple. You can actually implement IDropTarget in your form code but I prefer to do it in a helper class that looks like this:

uses
  Winapi.Windows,
  Winapi.ActiveX,
  Winapi.ShellAPI,
  System.StrUtils,
  Vcl.Forms;

type
  IDragDrop = interface
    function DropAllowed(const FileNames: array of string): Boolean;
    procedure Drop(const FileNames: array of string);
  end;

  TDropTarget = class(TObject, IInterface, IDropTarget)
  private
    // IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  private
    // IDropTarget
    FHandle: HWND;
    FDragDrop: IDragDrop;
    FDropAllowed: Boolean;
    procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>);
    procedure SetEffect(var dwEffect: Integer);
    function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): 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;
  public
    constructor Create(AHandle: HWND; const ADragDrop: IDragDrop);
    destructor Destroy; override;
  end;

{ TDropTarget }

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop);
begin
  inherited Create;
  FHandle := AHandle;
  FDragDrop := ADragDrop;
  RegisterDragDrop(FHandle, Self)
end;

destructor TDropTarget.Destroy;
begin
  RevokeDragDrop(FHandle);
  inherited;
end;

function TDropTarget.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then begin
    Result := S_OK;
  end else begin
    Result := E_NOINTERFACE;
  end;
end;

function TDropTarget._AddRef: Integer;
begin
  Result := -1;
end;

function TDropTarget._Release: Integer;
begin
  Result := -1;
end;

procedure TDropTarget.GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>);
var
  i: Integer;
  formatetcIn: TFormatEtc;
  medium: TStgMedium;
  dropHandle: HDROP;
begin
  FileNames := nil;
  formatetcIn.cfFormat := CF_HDROP;
  formatetcIn.ptd := nil;
  formatetcIn.dwAspect := DVASPECT_CONTENT;
  formatetcIn.lindex := -1;
  formatetcIn.tymed := TYMED_HGLOBAL;
  if dataObj.GetData(formatetcIn, medium)=S_OK then begin
    (* This cast needed because HDROP is incorrectly declared as Longint in ShellAPI.pas.  It should be declared as THandle
       which is an unsigned integer.  Without this fix the routine fails in top-down memory allocation scenarios. *)
    dropHandle := HDROP(medium.hGlobal);
    SetLength(FileNames, DragQueryFile(dropHandle, $FFFFFFFF, nil, 0));
    for i := 0 to high(FileNames) do begin
      SetLength(FileNames[i], DragQueryFile(dropHandle, i, nil, 0));
      DragQueryFile(dropHandle, i, @FileNames[i][1], Length(FileNames[i])+1);
    end;
  end;
end;

procedure TDropTarget.SetEffect(var dwEffect: Integer);
begin
  if FDropAllowed then begin
    dwEffect := DROPEFFECT_COPY;
  end else begin
    dwEffect := DROPEFFECT_NONE;
  end;
end;

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  FileNames: TArray<string>;
begin
  Result := S_OK;
  Try
    GetFileNames(dataObj, FileNames);
    FDropAllowed := (Length(FileNames)>0) and FDragDrop.DropAllowed(FileNames);
    SetEffect(dwEffect);
  Except
    Result := E_UNEXPECTED;
  End;
end;

function TDropTarget.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
  Try
    SetEffect(dwEffect);
  Except
    Result := E_UNEXPECTED;
  End;
end;

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  FileNames: TArray<string>;
begin
  Result := S_OK;
  Try
    GetFileNames(dataObj, FileNames);
    if Length(FileNames)>0 then begin
      FDragDrop.Drop(FileNames);
    end;
  Except
    Application.HandleException(Self);
  End;
end;

The idea here is to wrap up the complexity of the Windows IDropTarget in TDropTarget. All you need to do is to implement IDragDrop which is much simpler. Anyway, I think this should get you going.

Create the drop target object from your control's CreateWnd. Destroy it in the DestroyWnd method. That point is important because VCL window re-creation means that a control can have its window handle destroyed and re-created during its lifetime.

Note that reference counting on TDropTarget is suppressed. That is because when RegisterDragDrop is called it increments the reference count. This creates a circular reference and this code to suppress reference counting breaks that. This means that you would use this class through a class variable rather than an interface variable, in order to avoid leaking.

The usage would look something like this:

type
  TMainForm = class(TForm, IDragDrop)
    ....
  private
    FDropTarget: TDropTarget;

    // implement IDragDrop
    function DropAllowed(const FileNames: array of string): Boolean;
    procedure Drop(const FileNames: array of string);
  protected
    procedure CreateWindowHandle; override;
    procedure DestroyWindowHandle; override;
  end;

....

procedure TMainForm.CreateWindowHandle;
begin
  inherited;
  FDropTarget := TDropTarget.Create(WindowHandle, Self);
end;

procedure TMainForm.DestroyWindowHandle;
begin
  FreeAndNil(FDropTarget);
  inherited;
end;

function TMainForm.DropAllowed(const FileNames: array of string): Boolean;
begin
  Result := True;
end;

procedure TMainForm.Drop(const FileNames: array of string);
begin
  ; // do something with the file names
end;

Here I am using a form as the drop target. But you could use any other windowed control in a similar fashion.

@Mark Patterson 2013-09-12 04:16:38

Thanks. I turned that code into a unit, and it is working for me. I simplified the uses clause as follows. interface uses Winapi.Windows, Winapi.ActiveX; implementation uses Winapi.ShellAPI, Vcl.Forms;

@peiman F. 2014-03-13 22:50:47

can some one explain a bit more for me? i can run the code but it dont do anything!! how can i use it in a project? for example how to set up a TPanel to grab files?

@David Heffernan 2014-03-13 23:41:22

@peiman I'll add some usage to the answer. That is missing. Sorry. Basically you implement IDragDrop in one of your classes. And the pass that to the constructor of TDropTarget. Typically you do it in an overridden CreateWnd.

@RobertFrank 2015-02-07 16:34:29

David, Great code, as usual from you. Can you explain why one typically does it from an overridden CreateWnd rather than just in a FormCreate?

@David Heffernan 2015-02-07 19:12:23

Because windows can get re-created during a form's life @robert

@Marus Nebunu 2015-07-09 14:38:01

David, how can I get the ADragDrop variable to pass it to the TDropTarget.Create method ?

@David Heffernan 2015-07-09 15:16:44

@MarusNebunu You need to create an object that implements the IDragDrop interface

@srayner 2016-03-18 12:24:27

I put this code into a new unit. I have a component on my form. What do i need to do to that component to implement this interface?

@David Heffernan 2016-03-18 12:45:02

Implement the functions of the interface just like any interface implementation.

@kobik 2017-01-19 23:01:57

A simple usage example would have been nice.

@David Heffernan 2017-01-19 23:05:03

@kobik Agreed. Lazy of me. I'll do it tomorrow.

@kobik 2017-01-19 23:08:13

You said that 3 years ago ;)

@David Heffernan 2017-01-19 23:09:21

@kobik Maybe this time I'll do it!

@Progman 2014-02-03 13:18:36

I used David Heffernan's solution as base for my test application and got 'Invalid pointer operation' on application close. The solution for that problem was to change the TDropTarget.Create by adding '_Release;'

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop);
begin
  inherited Create;
  FHandle := AHandle;
  FDragDrop := ADragDrop;
  RegisterDragDrop(FHandle, Self);
  _Release;
end;

A discussion about this problem you can see on Embarcadero forum.

@David Heffernan 2015-02-08 10:03:31

Whatever the problem in your code is, this is not the solution. Your code presumably got the reference counting all wrong. I'm writing this for the sake of future readers so that they don't take this answer at face value.

@David Heffernan 2017-01-19 13:38:21

This is indeed the wrong fix, but your are correct that there is a problem. The latest version of the answer solves that problem.

@Torbins 2010-12-05 14:48:56

If you don't like pure WinAPI, then you can use components. Drag and Drop Component Suite is free with sources.

@Jeroen Wiert Pluimers 2010-12-04 15:32:48

You have to either write code yourself, or install a 3rd party product like DropMaster, which lets you do drag and drop in much older Delphi versions as well.

--jeroen

@Free Consulting 2010-12-04 17:51:30

70 bucks for like ~30 LoC?!

@Jeroen Wiert Pluimers 2010-12-04 19:29:09

That totally depends how fast you write 30 well tested lines of code, that work across a lot of different versions of Windows and other tools that behave like Windows Explorer.

@Free Consulting 2010-12-04 20:34:54

Well, i dunno... given old API (DragXXX) it stable, compatible with any Windows version and pretty well documented... probably really quick. I have no idea about third-party tool and their bug and quirks, tho...

@Free Consulting 2010-12-04 20:39:39

18 minutes :) (w/o isolating that behaviour into distinct component)

@Free Consulting 2010-12-04 22:25:18

Actually, i'm completely stuck with that isolation concept (because accepting files from the shell is merely a window style, and message handler belongs to window too...)

@Free Consulting 2010-12-04 15:03:14

No, unless you are about to peruse some custom TForm descendant which have this functionality built-in already.

Related Questions

Sponsored Content

1 Answered Questions

Drag and Drop to Outlook Message to Windows Form

2 Answered Questions

[SOLVED] Delphi XE custom build target is always disabled

1 Answered Questions

[SOLVED] Accept Drop in an embedde form

  • 2017-07-18 16:41:07
  • Fabio Vitale
  • 124 View
  • 1 Score
  • 1 Answer
  • Tags:   delphi

8 Answered Questions

[SOLVED] Is there a good jQuery Drag-and-drop file upload plugin?

1 Answered Questions

2 Answered Questions

[SOLVED] Handle file drop in TShellListView descendant

1 Answered Questions

[SOLVED] Prevent TWebBrowser from accepting dropped files

1 Answered Questions

Drag and drop from windows forms to desktop and windows explorer

  • 2011-11-22 13:29:58
  • user1056128
  • 4787 View
  • 5 Score
  • 1 Answer
  • Tags:   c# drag-and-drop

2 Answered Questions

2 Answered Questions

[SOLVED] Disable Drag & Drop of windows explorer using Delphi

Sponsored Content