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 件のコメント:
コメントを投稿