5

I would like to accept files as soon as someone drops a file to a specific control (e.g. TMemo). I started with this example: http://delphi.about.com/od/windowsshellapi/a/accept-filedrop.htm and modified it like this:

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles( Memo1.Handle, True ) ;
end;

This allows the control to show the dragging icon but the proper WM_DROPFILES message is not getting called because DragAcceptFiles needs a (Parent?)windowhandle. I could determine the MemoHandle in the WMDROPFILES procedure but I don't how, plus the dragging cursor applies for all the controls now. How do I allow dragging for a specific control (and block other controls from dragging)?

Ben
  • 3,380
  • 2
  • 44
  • 98
  • 1
    @BenjaminWeiss My code here (http://stackoverflow.com/questions/4354071/how-can-i-allow-a-form-to-accept-file-dropping-without-handling-windows-messages) makes things a little easier, I think. – David Heffernan May 20 '13 at 12:33
  • 2
    @Andreas Your deleted answer is correct. The now deleted comments were bogus. Please undelete your answer. The only issue with your code is that you need to deal with re-creation. The call to `DragAcceptFiles` needs to be in CreateWnd, with a matching one passing `False` in `DestroyWnd`. – David Heffernan May 20 '13 at 12:38
  • @DavidHeffernan +1 for your alternative. – Ben May 20 '13 at 12:41

1 Answers1

8

You should indeed pass the window handle of the memo control, but then you also need to listen to the WM_DROPFILES message sent to it:

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI;

type
  TMemo = class(StdCtrls.TMemo)
  protected
    procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  end;

  TForm5 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.FormCreate(Sender: TObject);
begin
end;

{ TMemo }

procedure TMemo.CreateWnd;
begin
  inherited;
  DragAcceptFiles(Handle, true);
end;

procedure TMemo.DestroyWnd;
begin
  DragAcceptFiles(Handle, false);
  inherited;
end;

procedure TMemo.WMDropFiles(var Message: TWMDropFiles);
var
  c: integer;
  fn: array[0..MAX_PATH-1] of char;
begin

  c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH);

  if c <> 1 then
  begin
    MessageBox(Handle, 'Too many files.', 'Drag and drop error', MB_ICONERROR);
    Exit;
  end;

  if DragQueryFile(Message.Drop, 0, fn, MAX_PATH) = 0 then Exit;

  Text := fn;

end;


end.

The example above only accept a single file dropped. The file name will be put in the memo control. But you can also allow a multiple selection to be dropped:

var c: integer; fn: array[0..MAX_PATH-1] of char; i: Integer; begin

c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH);

Clear;
for i := 0 to c - 1 do
begin
  if DragQueryFile(Message.Drop, i, fn, MAX_PATH) = 0 then Exit;
  Lines.Add(fn);
end;
Andreas Rejbrand
  • 105,602
  • 8
  • 282
  • 384
  • Correct me if I'm wrong but shouldn't you set `DragAcceptFiles` to false BEFORE you `inherit destroy`? – Ben May 20 '13 at 13:10
  • 1
    @Benjamin: I believe you should. I am not sure if it matters, but if it does, it should be before. I made the correction. – Andreas Rejbrand May 20 '13 at 13:12
  • 1
    Actually, it is not necessary since this behaviour turned on and off by mere setting and resetting `WS_EX_ACCEPTFILES`. I wonder if this information was already present in those deleted "bogus" comments. Please undelete them as well. – OnTheFly May 20 '13 at 13:26
  • @user539484 You are incorrect in your guessing about the deleted comments. No mention there of `WS_EX_ACCEPTFILES`. I'm sorry to disappoint you. – David Heffernan May 20 '13 at 13:55
  • As for `WS_EX_ACCEPTFILES`, that handles the calls to `DragAcceptFiles`. You still need to handle `WM_DROPFILES`. – David Heffernan May 20 '13 at 13:59