ドラグドロップでファイル名を取得

参照元


redball.gif目次へ戻る

参照元の API の稿の「９−１ ドラグドロップによるファイル名の取得」と重複するが、いまや FAQ とも言えるこのトピックについてここでまとめておくことは、意味が無いわけではないだろう。

エクスプローラなどのファイラから、アプリケーションの特定のコントロールにファイルのリストをドラグドロップすることにより、アプリケーションが処理する対象としてのファイル名を受け取ることができる。多くのエディタやワープロなどのメジャーなアプリケーションは、必ずといっていいほどこの機能を持っている。この機能は、ShellAPI.pas で定義されている DragAcceptFiles( )、DragQueryFile( )、DragFinish( ) の三つのＡＰＩをつかい、WM_DROPFILES というメッセージを一つ処理するだけで実現できる。それでは、リストボックスでファイル名を受け取るもっとも典型的な例から始めよう。

TWinControl の派生クラスのコントロールで、ドラグドロップによりファイル名を取得するには、まず、そのコントロールがファイルを受け取れるようにしなければならない。そのためには、

procedure DragAcceptFiles(Wnd: HWND; 
                         Accept: BOOL); stdcall;

を Accept を true にして実行すると、Wnd パラメータでそのハンドルを指定されたコントロールのクライアント領域でファイルのドロップを受け付けるようになる。ファイルのドロップが起こると、ＯＳからそのウィンドウ関数に WM_DROPFILES メッセージを送られてくる。

WM_DROPFILES 
 
hDrop = (HANDLE) wParam;  // handle of internal drop structure

この wParam のドロップハンドルを使って、OS にドロップされたファイルの数とそのそれぞれのファイルのフルパスを DragQueryFile で問い合わせる。

function DragQueryFile(Drop: HDROP; 
                  FileIndex: UINT; 
                   FileName: PChar; 
                         cb: UINT): UINT; stdcall;

Drop には、WM_DROPFILES メッセージから受け取ったドロップハンドルを設定する。最初は、ファイルの数を知るために FileIndex を $FFFFFFFF に設定する。そうすると、この関数の戻り値としてドロップされたファイルの数が返される。数が分かったところで、個々のファイルのフルパスを取得するには、FileIndex にゼロから（ドロップ数-1）までのインデックスを設定し、FileName に受け取るバッファを指定し、そのバッファのサイズを cb にバイト単位で設定して実行する。そうすると、Filename にインデックス番目のファイルのフルパスが設定されて戻ってくる。このときのこの関数の戻り値は、Filename に設定されたヌルどめを除いたバイト数である。全てのファイル名を取得したら、処理の最後に DragFinish( ) を呼び出して、メッセージの処理が終了したことをＯＳに通知する。

procedure DragFinish(Drop: HDROP); stdcall;

そのコントロールがドラグドロップを受け付けなくするためには、DragAcceptFiles() の Accept を false にして実行する。それではさっそくやってみよう。Form1 に ListBox1 と Button1 と Label1 を置いて、以下のようにする。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure OnDropFiles(var Msg: TMessage);
  public
    OriginalProc:TWndMethod;
    procedure SubClassProc(var Message:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShellAPI;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalProc := ListBox1.WindowProc;
  ListBox1.WindowProc := SubClassProc;

  DragAcceptFiles(ListBox1.Handle,true);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(ListBox1.Handle,false);
end;

procedure TForm1.OnDropFiles(var Msg:TMessage);
var
  hDP: HDROP;
  i,numFile,sizeCopied: integer;
  PC: PChar;
  s: string;
begin
  hDP := HDROP(Msg.WParam);
  numFile := DragQueryFile(hDP,$FFFFFFFF,nil,0);

  ListBox1.Items.BeginUpdate;
  ListBox1.Clear;
  GetMem(PC,MAX_PATH+1);
  for i := 0 to numFile-1 do begin
    sizeCopied := DragQueryFile(hDP,i,PC,MAX_PATH+1);
    SetString(s,PC,sizeCopied);
    ListBox1.Items.Add(s);
  end;
  FreeMem(PC);
  DragFinish(hDP);
  ListBox1.Items.EndUpdate;
  Label1.Caption := Format('%d 個のファイルを受け取りました',[numFile]);
end;

procedure TForm1.SubClassProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_DROPFILES:OnDropFiles(Message);
  else
    OriginalProc(Message);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.MultiSelect := true;
end;

end.
n01001.gif

実行して、ファイラからドロップすると右図のようになる。


コードを調べよう。

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalProc := ListBox1.WindowProc;
  ListBox1.WindowProc := SubClassProc;

  DragAcceptFiles(ListBox1.Handle,true);
end;

WM_DROPFILES メッセージを受け取るために、ListBox1 をサブクラス化している。それから DragAcceptFiles() を実行して、ドロップファイルを受け取れるようにしている。サブクラスのウィンドウ関数では、

procedure TForm1.SubClassProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_DROPFILES:OnDropFiles(Message);
  else
    OriginalProc(Message);
  end;
end;

のようにして、WM_DROPFILES のときだけ処理関数 OnDropFiles() にメッセージを渡し、オリジナル関数を実行しない。それ以外は、もとの関数にメッセージを渡してデフォルトの処理を、つまりリストボックスの機能を実現してもらう。処理関数では、

procedure TForm1.OnDropFiles(var Msg:TMessage);
var
  hDP: HDROP;
  i,numFile,sizeCopied: integer;
  PC: PChar;
  s: string;
begin
  hDP := HDROP(Msg.WParam);
  numFile := DragQueryFile(hDP,$FFFFFFFF,nil,0);
  ListBox1.Items.BeginUpdate;
  ListBox1.Clear;
  GetMem(PC,MAX_PATH+1);
  for i := 0 to numFile-1 do begin
    sizeCopied := DragQueryFile(hDP,i,PC,MAX_PATH+1);
    SetString(s,PC,sizeCopied);
    ListBox1.Items.Add(s);
  end;
  FreeMem(PC);
  DragFinish(hDP);
  ListBox1.Items.EndUpdate;
  Label1.Caption := Format('%d 個のファイルを受け取りました',[numFile]);
end;

ファイルの数を numFile に取得し、PC にメモリバッファを確保してから順次ファイル名を取得して、最後に DragFinish() を実行している。

さて、Button1 を押してみよう。

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.MultiSelect := true;
end;

これは、ListBox1 を多選択可能にするものである。そうすると、試してみると分かるが、もう、ドロップファイルを受け付けなくなる。これはどうしてだろうか？

API の稿で何度も出会ったが、コントロールの機能を規定するウィンドウスタイルは、コントロール作成後に SetWindowLong() を使って動的に変更できる場合と、できない場合がある。単選択リストボックスに LBS_MULTIPLESEL スタイルを加えて、多選択リストボックスに動的に変更することはできないのである。このように、動的に変更できないスタイルはかなりあって、VCL では、CreateParams() のパラメータを変更して、コントロールウィンドウを作り直すことで対応している。したがって、今の場合、FormCreate イベントで設定した DragAcceptFiles() のウィンドウハンドルがコントロールウィンドウが破棄されたため無効になってしまったのである。したがって、ドロップファイルを受け付けなくなったのである。これを回避するためには、サブクラスのウィンドウ関数を以下のように変更するとよい。

List 2

function IsAcceptFiles(WC:TWinControl):Boolean;
var
  ExStyle:LongInt;
begin
  ExStyle := GetWindowLong(WC.Handle,GWL_EXSTYLE);
  result := (ExStyle and WS_EX_ACCEPTFILES) <> 0;
end;

procedure TForm1.SubClassProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_DROPFILES:OnDropFiles(Message);
    CM_RECREATEWND:begin
      OriginalProc(Message);
      if ListBox1.HandleAllocated and not IsAcceptFiles(ListBox1) then
        DragAcceptFiles(ListBox1.Handle,true);
    end;
  else
    OriginalProc(Message);
  end;
end;

ここでは、WM_DROPFILES メッセージのほかに、VCL のカスタムメッセージ CM_RECREATEWND を捕まえて、まず、もとのウィンドウ関数を実行し、それから、ウィンドウハドルの有無と、WS_EX_ACCEPTFILES スタイルの有無を確認してから、あらためて DragAcceptFiles(ListBox1.Handle,true); を実行している。実は、DragAcceptFiles(WinControl.Handle,true); の実行は、エクストラスタイルに WS_EX_ACCEPTFILES を追加することと同じなのである。IsAcceptFiles() は、このスタイルが設定されているかどうかを判断している。以上のようにして、プロパティーの変更に伴うコントロールウィンドウの再生成にも対応できた。なお、TWinControl のソースコードを読むと分かるように、CM_RECREATEWND を受け取ると必ずコントロールウィンドウを直後に再生成するわけではないのである。しかし、Visible が false の TForm の場合を除いて、子コントロールの場合は、必ず直後に再生成されるようである。

これまで調べたことを元にして、この機能を非可視のコンポーネントにしてみよう。これは、TControl クラスをサブクラス化して汎用的にメッセージ処理をできるようにするサブクラス化コンポーネントの、WM_DOPFILES メッセージと CM_RECREATEWND メッセージだけを処理する特別な場合であることに気づくだろう。したがって、TSubClass コンポーネントをすこし書き換えるだけですぐに作ることができる。以下に全コードを示す。

List 3

unit DropFilesUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ShellAPI;

type

TDropMessage = procedure (Sender:TObject;Files :TStrings) of object;


TDropFiles = class(TComponent)
private
  OriginalProc:TWndMethod;
  FOnDrop:TDropMessage;
  FTarget:TWinControl;
  FList:TStringList;
  procedure SetTarget(Ctrl:TWinControl);
protected
  procedure SubClassProc(var Msg:TMessage);
  procedure OnDropFiles(Msg:TMessage);
  procedure DoSet;
  function IsAcceptFiles(WC: TWinControl): Boolean;
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy;override;
  procedure Notification(AComponent: TComponent;
                               Operation: TOperation);override;
published
  property TargetControl:TWinControl read FTarget write SetTarget;
  property OnDrop:TDropMessage read FOnDrop write FOnDrop;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TDropFiles]);
end;

constructor TDropFiles.Create(AOwner: TComponent);
begin
  inherited;
  FList := TStringList.Create;
end;

destructor TDropFiles.Destroy;
begin
  SetTarget(nil);
  FList.Free;
  inherited;
end;

procedure TDropFiles.SetTarget(Ctrl:TWinControl);
begin
  if FTarget<>nil then
  begin
    FTarget.WindowProc := OriginalProc;
    FTarget.RemoveFreeNotification(Self);
  end;

  if FTarget<>Ctrl then
  begin
    FTarget := Ctrl;
    if FTarget<>nil then
    begin
      FTarget.FreeNotification(Self);
      OriginalProc := Ctrl.WindowProc;
      Ctrl.WindowProc := SubClassProc;
      DragAcceptFiles(FTarget.Handle,true);
    end;
  end;
end;

procedure TDropFiles.SubClassProc(var Msg:TMessage);
begin
  case Msg.Msg of
    WM_DROPFILES:OnDropFiles(Msg);
    CM_RECREATEWND:begin
      OriginalProc(Msg);
      DoSet;
    end;
  else
    OriginalProc(Msg);
  end;
end;

procedure TDropFiles.Notification(AComponent: TComponent;
                                 Operation: TOperation);
begin
  inherited;
  if (AComponent=FTarget) and (Operation=opRemove) then
    SetTarget(nil);
end;

procedure TDropFiles.OnDropFiles(Msg: TMessage);
var
  hDP: HDROP;
  i,numFile,sizeCopied: integer;
  PC: PChar;
  s: string;
begin
  hDP := HDROP(Msg.WParam);
  numFile := DragQueryFile(hDP,$FFFFFFFF,nil,0);
  FList.Clear;
  GetMem(PC,MAX_PATH+1);
  for i := 0 to numFile-1 do begin
    sizeCopied := DragQueryFile(hDP,i,PC,MAX_PATH+1);
    SetString(s,PC,sizeCopied);
    FList.Add(s);
  end;
  FreeMem(PC);
  DragFinish(hDP);
  if Assigned(FOnDrop) then FOnDrop(self,FList);
end;

procedure TDropFiles.DoSet;
begin
  if FTarget.HandleAllocated and not IsAcceptFiles(FTarget) then
       DragAcceptFiles(FTarget.Handle,true);
end;

function TDropFiles.IsAcceptFiles(WC:TWinControl):Boolean;
var
  ExStyle:LongInt;
begin
  ExStyle := GetWindowLong(WC.Handle,GWL_EXSTYLE);
  result := (ExStyle and WS_EX_ACCEPTFILES) <> 0;
end;

end.

このコンポーネントをテストするプログラムを以下に示す。ここでは、TargetControl をオブジェクトインスペクタで Memo1 に設定した。

List 4

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    DropFiles1: TDropFiles;
    Button1: TButton;
    Label1: TLabel;
    procedure DropFiles1Drop(Sender: TObject; Files: TStrings);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DropFiles1Drop(Sender: TObject; Files: TStrings);
begin
  Memo1.Lines.Assign(Files);
  Label1.Caption := Format('%d 個のファイルを受け取りました',[Files.Count]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;
end;

end.
n01002.gif

実行結果を右図に示す。Button1 を押すと垂直スクロールバーが付けられる。このとき Memo1 は再生成されるが、その後も順調にファイルを受け取れる。


 

redball.gif目次へ戻る