トップへ(mam-mam.net/)

アプリのウィンドウからファイルをドラッグ＆ドロップ(VCL) ～Delphiソースコード集

検索：

アプリケーションからエクスプローラーやデスクトップにファイルをドラッグ＆ドロップ[Ole Drag&Drop]出来る方法をサンプルソースコードで解説TPanelを継承したTOleDragPanelクラスを作成して使用する(VCL) ～Delphiでお手軽プログラミング

エクスプローラーやデスクトップなどに、アプリケーションからファイルをドラッグ＆ドロップできる、 TPanelを継承したTOleDragPanelクラスを使用して、ドラッグ＆ドロップアプリケーションを作成します。

プロジェクトの作成

Delphi IDEを起動し、「ファイル」⇒「Windows VCLアプリケーション -Delphi」をクリックします。
「ファイル」⇒「すべて保存」からプロジェクト保存用フォルダを作成してユニットとプロジェクトを保存します。
プロジェクトやユニットを保存したフォルダに本ページの下に記載の「UOleDragPanel.pas」ファイルを保存します。
[オブジェクトインスペクタ]の[イベント]タブをクリックし、[OnCreate]の右側の何もない場所をダブルクリックしてソースを記述します。

ソースコードの記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,  Vcl.ExtCtrls,
  Vcl.Imaging.pngimage, UOleDragPanel;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    procedure OnDrop(Sender:TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var DragPanel:TOleDragPanel;
    img:TImage;
    png:TPngImage;
begin
  DragPanel:=TOleDragPanel.Create(self);
  DragPanel.Parent:=self;
  DragPanel.Caption:='';
  //dp.FileName:=Application.ExeName;
  //DragPanel.FileName:=ExpandFileName(ExtractFilePath(Application.ExeName)+'..\..\test.png');
  DragPanel.FileName:=ExtractFilePath(Application.ExeName)+'test.png';
  DragPanel.Width:=160;
  DragPanel.Height:=160;
  DragPanel.Left:=0;
  DragPanel.Top:=0;

  img:=TImage.Create(self);
  img.Parent:=DragPanel;
  img.Align:=alClient;
  img.Width:=160;
  img.Height:=160;
  img.Stretch:=True;
  img.Proportional:=True;
  img.Picture.Bitmap.Width:=160;
  img.Picture.Bitmap.Height:=160;
  img.Picture.Bitmap.Canvas.TextOut(10,0,'「test.png」として');
  img.Picture.Bitmap.Canvas.TextOut(10,20,'デスクトップ等に');
  img.Picture.Bitmap.Canvas.TextOut(10,40,'ドラッグ＆ドロップできます');
  Img.Picture.Bitmap.Canvas.MoveTo(20,60);
  Img.Picture.Bitmap.Canvas.LineTo(180,200);
  png:=TPngImage.Create;
  try
    png.Assign(Img.Picture.Bitmap);
    png.SaveToFile(ExtractFilePath(Application.ExeName)+'test.png');
  finally
    png.Free;
  end;

  DragPanel:=TOleDragPanel.Create(self);
  DragPanel.Parent:=self;
  DragPanel.Caption:=
    'test.csvファイルとしてエクスプローラー等に'+
    'ドラッグ＆ドロップできます';
  DragPanel.FileName:=ExtractFilePath(Application.ExeName)+'test.csv';
  DragPanel.Width:=340;
  DragPanel.Height:=80;
  DragPanel.Left:=0;
  DragPanel.Top:=161;
  DragPanel.OnDrop:=Self.OnDrop;
end;


procedure TForm1.OnDrop(Sender: TObject);
var stl:TStringList;
begin
  //ドロップ直後にファイルを生成する場合
  stl:=TStringList.Create;
  try
    stl.Add('a,b,c,d');
    stl.Add('1,2,3,4');
    stl.Add('5,6,7,8');
    stl.SaveToFile(TOleDragPanel(Sender).FileName);
  finally
    stl.Free;
  end;
end;

end.

実行する

上側のTOleDragPanelをデスクトップやエクスプローラーにドラッグ＆ドロップすると「test.png」ファイルがコピーされます。
下側のTOleDragPanelをデスクトップやエクスプローラーにドラッグ＆ドロップすると「test.csv」ファイルがコピーされます。

「UOleDragPanel.pas」ファイル

以下ソースコードを「UOleDragPanel.pas」ファイル名として保存し、プロジェクトフォルダに保存して使用します。 
unit UOleDragPanel;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils,System.Classes,
     Vcl.Controls,Vcl.ExtCtrls,
     Winapi.Activex,Winapi.ShlObj;

type
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  TOleDragPanel=class(TPanel,IDropSource)
  private
    { Private 宣言 }
    FFileName:String;
    FThreshHold:Integer;
    FIsDragging:boolean;
    FMouseDownPoint:TPoint;
    DataObject:IDataObject;
    FOnDrop:TNotifyEvent;
    FEffects:Integer;
    //元々のウィンドウプロシージャを保存する変数
    FOldWndProc:TWndMethod;
    //置き換えるウィンドウプロシージャ
    procedure NewWndProc(var msg:TMessage);
  protected
    function getDataObject(Path:String):IDataObject;
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HRESULT; stdcall;
    function GiveFeedback(dwEffect: Longint): HRESULT; stdcall;

    procedure SetFileName(Value: string);
    function GetFileName: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy();
  published
    property FileName: string read GetFileName write SetFileName;
    property OnDrop:TNotifyEvent read FOnDrop write FOnDrop;
    //ドロップ時に移動(DROPEFFECT_MOVE)又はコピー(DROPEFFECT_COPY)
    //又は両方(DROPEFFECT_MOVE + DROPEFFECT_COPY)を許可するか設定
    property Effects:Integer read FEffects write FEffects;
  End;

procedure Register;

implementation

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

{ TOleDragPanel }

//■コンストラクタ
constructor TOleDragPanel.Create(AOwner: TComponent);
begin
  inherited;
  FIsDragging:=False;
  FMouseDownPoint.X:=0;
  FMouseDownPoint.Y:=0;
  FThreshHold:=4;
  FOnDrop:=nil;
  //ドロップ時に移動(DROPEFFECT_MOVE)又はコピー(DROPEFFECT_COPY)
  //又は両方(DROPEFFECT_MOVE + DROPEFFECT_COPY)を許可するか設定
  FEffects:=DROPEFFECT_COPY;
  //ウィンドウプロシージャ置き換え(サブクラス化)
  FOldWndProc:=self.WindowProc;
  self.WindowProc:=NewWndProc;
end;

//■デストラクタ
destructor TOleDragPanel.Destroy;
begin
  //ウィンドウプロシージャを戻す
  self.WindowProc:=FOldWndProc;
  inherited;
end;

//■フルパスのファイル名からIDataObjectを取得する
function TOleDragPanel.getDataObject(Path: String): IDataObject;
var SFolder:IShellFolder;
    hRes:HRESULT;
    pidl:PItemIDList;
begin
  result:=nil;

  //デスクトップフォルダのSFolder:IShellFolderを取得する
  hRes:=SHGetDesktopFolder(SFolder);
  if hRes<>NOERROR then exit;

  //ILCreateFromPathでItemIDListを取得（ファイルが存在しないとNG）
  pidl:=ILCreateFromPath(PChar(path));
  if pidl=nil then
  begin
    //SHSimpleIDListFromPathでItemIDListを取得（ファイルが存在しなくてもOK）
    pidl:=PItemIDList(SHSimpleIDListFromPath(PChar(path)));
    if pidl=nil then exit;
  end;
  //ItemIDListからDataObject取得
  hres:=SFolder.GetUIObjectOf(0,1,pidl,IDataObject,nil,DataObject);
  //メモリを解放
  ILFree(PItemIDList(pidl));

  if hRes=NOERROR then
    result:=DataObject;  //IDataObjectを返す
end;

//■ファイル名を返す
function TOleDragPanel.GetFileName: string;
begin
  Result:=FFilename;
end;

//■ファイル名を設定
procedure TOleDragPanel.SetFileName(Value: string);
begin
  if Value<>FFilename then FFilename := Trim(Value);
end;

//■ファイルドラッグ中にユーザーに視覚的なフィードバックを提供
function TOleDragPanel.GiveFeedback(dwEffect: Longint): HRESULT;
begin
  //標準のマウスカーソルを返す
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

//■サブクラス化したウィンドウプロシージャ
procedure TOleDragPanel.NewWndProc(var msg:TMessage);
var dwEffect:Integer;
begin
  if (msg.Msg=WM_LBUTTONDOWN) and
     (FIsDragging=False) and (FFileName<>'') then
  begin
    //マウスの左ボタンが押された時
    FMouseDownPoint.X:=TWMMouse(msg).Pos.x;
    FMouseDownPoint.Y:=TWMMouse(msg).Pos.y;
    FIsDragging:=True;
  end
  else if (msg.Msg=WM_MOUSEMOVE) and FIsDragging and
          (
            (Abs(FMouseDownPoint.X-TWMMouse(msg).Pos.x)>FThreshHold) or
            (Abs(FMouseDownPoint.Y-TWMMouse(msg).Pos.y)>FThreshHold)
          ) then
  begin
    //マウスの左ボタンが押された後にThreshHold以上移動した時
    DataObject:=getDataObject(FFileName);
    if assigned(DataObject) then
    begin
      //ファイルのドラッグ処理を開始
      DoDragDrop(
        DataObject,  //IDataObjectを渡す
        self,        //IDropSourceを渡す
        FEffects,    //ドロップ時にコピーや移動を許可する
        dwEffect     //DoDrawDropが制御を返した時の最後のエフェクトを受取る
      );
    end;
  end
  else if msg.Msg=WM_LBUTTONUP then
  begin
    //マウスの左ボタンが離された時
    FIsDragging:=False;
  end;
  //元のウィンドウプロシージャを呼ぶ
  FOldWndProc(msg);
end;

//■ファイルドラッグ中の動作
function TOleDragPanel.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Longint): HRESULT;
begin
  //「Esc」キーが押されたか、マウス右ボタンが押された場合
  if fEscapePressed or ((grfKeyState and MK_RBUTTON) = MK_RBUTTON) then
  begin
    //●ドラッグキャンセルされた場合
    //ドラッグ操作をキャンセル
    Result := DRAGDROP_S_CANCEL;
    FIsDragging:=False;
  end     //マウス左ボタンが離された
  else if (grfKeyState and MK_LBUTTON) = 0 then
  begin
    //●ドロップ実行された場合
    //OnDropプロパティが設定されていたら呼び出す
    if assigned(FOnDrop) then FOnDrop(Self);
    //ドロップ実行
    Result := DRAGDROP_S_DROP;
    FIsDragging:=False;
  end
  else
  begin
    //●ドラッグ中の場合
    //ドラッグ操作を続行
    Result := S_OK;
  end;
end;

initialization
  //COMライブラリを初期化
  OleInitialize(nil);
finalization
  //COMライブラリを閉じリソースを解放する
  OleUninitialize;

end.