uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FPrevListBoxWindowProc: TWndMethod;
procedure ListBoxWindowProc(var Message: TMessage);
procedure ListBoxWMDropFiles(var Msg: TWMDropFiles);
public
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{ Replace window procedure }
FPrevListBoxWindowProc := ListBox1.WindowProc;
ListBox1.WindowProc := ListBoxWindowProc;
{ Enable to accept drop files }
DragAcceptFiles(ListBox1.Handle,True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
{ Disable to accept drop files }
DragAcceptFiles(ListBox1.Handle,False);
{ Restore window procedure }
ListBox1.WindowProc := FPrevListBoxWindowProc;
end;
procedure TForm1.ListBoxWindowProc(var Message: TMessage);
begin
if Message.Msg <> WM_DROPFILES then
begin
{ Call previous window procedure }
FPrevListBoxWindowProc(Message);
Exit;
end;
{ Call WM_DROPFILES handler }
ListBoxWMDropFiles(TWMDropFiles(Message));
Message.Result := 1;
end;
procedure TForm1.ListBoxWMDropFiles(var Msg: TWMDropFiles);
var
Index: Integer;
Count: Integer;
Size: Integer;
Filename: String;
begin
try
{ Get dropped filename }
Count := DragQueryFile(Msg.Drop,DWORD(-1),nil,0);
for Index := 0 to Count - 1 do
begin
{ Get filename length }
Size := DragQueryFile(Msg.Drop,Index,nil,0) + 1;
{ Get filename }
SetLength(Filename,Size);
Size := DragQueryFile(Msg.Drop,Index,PChar(Filename),Size);
SetLength(Filename,Size);
ListBox1.Items.Add(Filename)
end;
finally
{ Finish }
DragFinish(Msg.Drop);
end;
end;
2010/08/04追記: こちらに詳細に説明していますが、Windows Vista/7ではUIPIにより下位ILのプロセスから上位ILのプロセスに対して通信、この場合はファイルのドラッグアンドドロップを行うことができなくなっています。
0 件のコメント:
コメントを投稿