Mega Code Archive
How to accept dropped files from the explorer
<![CDATA[
Title: how to accept dropped files from the explorer?
{
This way you can drag and drop files to a specific control in a Delphi form.
Just create a project and add a ListBox component to Form1.}
{ 1. First, a procedure to handle the message but without handling it. }
interface
procedure WMDROPFILES(var Msg: TMessage);
implementation
procedure TForm1.WMDROPFILES(var Msg: TWMDropFiles);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
{
2. Second, a WindowProc method to replace ListBox1 WindowProc default method
and a variable to store ListBox1 WindowProc default method.
}
interface
procedure LBWindowProc(var Message: TMessage);
implementation
var
OldLBWindowProc: TWndMethod;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
{3. In Form1 OnCreate event, initialize all.}
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
{4. In Form1 OnDestroy event, uninitialize all. Not necesary but a good practice.}
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
{5. To complete source code, the AddFile method.}
interface
procedure AddFile(sFileName: string);
implementation
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
{6. Do not forget to add ShellAPI unit to the uses clause. }
Complete code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure WMDROPFILES(var Msg: TMessage);
procedure LBWindowProc(var Message: TMessage);
procedure AddFile(sFileName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
ShellAPI;
var
OldLBWindowProc: TWndMethod;
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
end.
]]>