How can I allow a form to accept file dropping without handling Windows messages?

Question

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

Wadesworth

What's wrong with handling messages? If the message technique suits your needs, it's a lot easier than the IDropTarget technique. – Offertory

+1 I was under the impression that WM_DROPFILES did not allow you to signal whether or not the drop would be accepted. Otherwise I agree that it's easier than IDropTarget. – Norahnorbert

I just dont like using winapi when i can avoid it. Both techniques messages and IDropTarget uses winapi. I am impressed that delphi still does not support file dropping... – Wadesworth

I agree it's preferable to use a VCL based solution rather than a Windows API one, but if there is not VCL based solution surely it's then better to have any solution rather than no solution. If you don't like IDropTarget, would you be prepared to accept an answer that stated "No, what you desire is not possible"? – Norahnorbert

Still better than nothing )) I accpet your answer with IDropTarget – Wadesworth

There is a VCL-based solution - use Anders Melander's Drag&Drop components instead of implementing IDropTarget manually. For instance, he provides a TDropFileTarget component for accepting dragged files. – Legible

Answer 1

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.

Norahnorbert

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; – Brookebrooker

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? – Upbringing

@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. – Norahnorbert

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? – Henninger

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

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

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

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? – Groupie

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

A simple usage example would have been nice. – Dealfish

@Dealfish Agreed. Lazy of me. I'll do it tomorrow. – Norahnorbert

You said that 3 years ago ;) – Dealfish

@Dealfish Maybe this time I'll do it! – Norahnorbert

Answer 2

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

Radiophone

Answer 3

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

Kure

Answer 4

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.

Greenbelt

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. – Norahnorbert

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

Answer 5

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

Pooka

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. – Pooka

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... – Kure

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

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...) – Kure