2008年8月1日

エクスプローラからのファイルのドラッグアンドドロップを特定のコントロールで受け入れる

fエクスプローラからファイルをドラッグアンドドロップで受け入れるにはDragAcceptFilesで受け入れを許可し、WM_DROPFILESメッセージで通知を受け付け、DragQueryFileでドロップされた各ファイルを受け取ります。特定のコントロールでこれを行うには、ウィンドウプロシージャを置き換える必要があります。この例ではListBoxでドラッグアンドドロップを受け入れています。
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 件のコメント: