◆ [Delphi] TFileListBoxからエクスプローラへドラッグ&ドロップする。
こんばんワイン。どーもボキです。

前回参考にしたDelFusa Floorのアーカイブ(Delphi Users’ Forum)を作ってみた。元ネタはMouseMoveイベントとなっていたが、DragOverイベントに置き換えた。
a0021757_0433863.gif



こちらも、ドラッグ&ドロップ処理が多重に動いているような動作をする(ドロップ処理がすぐに終了しない)が、
読み込み違反エラーは起きない。TShellListView側にも問題があるのかも知れない。
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj, ExtCtrls;

type
TForm1 = class(TForm, IDropSource)
GroupBox1: TGroupBox;
Splitter1: TSplitter;
GroupBox2: TGroupBox;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FileListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure FileListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
private
{ Private 宣言 }
FDragStartPos: TPoint;

//IDropSource のメソッド 以下2つ
function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
function GiveFeedback(dwEffect: Longint): HResult; stdcall;
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}


//ファイル名からIDataObjectインターフェイスを取得
function GetFileListDataObject(const Directory: String; Files : TStringList) : IDataObject;
type
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
Malloc : IMalloc;
fDesktop,fTargetFolder : IShellFolder;
i : Integer;
Dirpidl : PItemIDList;
p : PArrayOfPItemIDList;
chEaten,dwAttributes: ULONG;
begin
Result := nil;
if Files.Count = 0 then exit;

OleCheck(SHGetMalloc(Malloc));
OleCheck(SHGetDesktopFolder(fDesktop));
OleCheck(fDesktop.ParseDisplayName(0, nil, PWideChar(WideString(Directory)), chEaten, Dirpidl, dwAttributes));
try
OleCheck(fDesktop.BindToObject(Dirpidl, nil, IShellFolder, fTargetFolder));
p := AllocMem(SizeOf(PItemIDList) * Files.Count);
try
for i := 0 to Files.Count -1 do begin
OleCheck(fTargetFolder.ParseDisplayName(0, nil, PWideChar(WideString(Files[i])), chEaten, p[i], dwAttributes));
end;
OleCheck(fTargetFolder.GetUIObjectOf(0, Files.Count, p[0], IDataObject, nil, Pointer(Result)));
finally
for i := 0 to Files.Count -1 do begin
if p[i] <> nil then Malloc.Free(p[i]);
end;
FreeMem(p);
end;
finally
Malloc.Free(Dirpidl);
end;
end;


//現在行われようとしている操作に応じてカーソルを設定できる
function TForm1.GiveFeedback(dwEffect : Longint): HResult;
begin
//デフォルトのカーソルを使う
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;


//ユーザーがドラッグ操作の中止を求めた場合 fEscapePressed や
//マウスの状態に応じてドラッグの継続の可否をOLEに通知
function TForm1.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Integer): HResult;
begin
//ESCが押されたか、両方のボタンが押されている場合は中止する
if fEscapePressed or ((MK_LBUTTON or MK_RBUTTON) = (grfKeyState and (MK_LBUTTON or MK_RBUTTON))) then
Result := DRAGDROP_S_CANCEL

//マウスの左ボタンが離された場合はドロップ処理へ
else if (grfKeyState and MK_LBUTTON) = 0 then begin
Result := DRAGDROP_S_DROP;

//それ以外はD&D継続
end else begin
Result := S_OK;
end;
end;


// マウスダウンによる初期化
procedure TForm1.FileListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
if TFileListBox(Sender).SelCount = 0 then exit;

FDragStartPos := Point(X, Y);
end;


// ファイル/フォルダのドラッグ
procedure TForm1.FileListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
_FLB : TFileListBox;
slst : TStringList;
i,dwEffect : Integer;
s,dpth : String;
DataObject : IDataObject;
begin
//if State <> dsDragLeave then exit; ※コントロールから離れた時のみとすると、メモリアクセスエラーが置きやすい。
if ((Abs(X - FDragStartPos.X) < Mouse.DragThreshold) and (Abs(Y - FDragStartPos.Y) < Mouse.DragThreshold)) then exit;

_FLB := TFileListBox(Sender);
dpth := _FLB.Directory;
try
slst := TStringList.Create;
slst.Capacity := _FLB.SelCount;
for i := 0 to _FLB.Items.Count -1 do begin
if _FLB.Selected[i] then begin
s := _FLB.Items[i];
slst.Add(s);
end;
end;
//ファイル名からIDataObjectを取得
DataObject := GetFileListDataObject(dpth,slst);
finally
slst.Free;
end;

//OLEドラッグ&ドロップ開始
dwEffect := DROPEFFECT_NONE;
DoDragDrop(DataObject, Self, DROPEFFECT_COPY, dwEffect);
end;


// 表示更新
procedure TForm1.FileListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
TFileListBox(Sender).Refresh;
end;


initialization
OleInitialize(nil);


finalization
OleUninitialize;


end.


[PR]
by yozda | 2015-04-29 00:42 | プログラミング | Trackback | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/21171711
トラックバックする(会員専用) [ヘルプ]
<< [Delphi] WM_DRO... [Delphi] TShell... >>