アプリケーションからエクスプローラーやデスクトップにファイルをドラッグ&ドロップ[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.