◆ [Delphi] TShellTreeViewやTShellListView間でドラッグ&ドロップする
こんにチワワ。どーもボキです。

TShellTreeViewやTShellListView間でドラッグ&ドロップするサンプル。
サンプルプログラム

[Delphi] TShellListViewからエクスプローラへドラッグ&ドロップするとは、両立出来ない
a0021757_16592497.gif
unit Unit1;

interface

uses
ShellAPI, StrUtils,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ShellCtrls, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
GroupBox1: TGroupBox;
ShellTreeView1: TShellTreeView;
Splitter1: TSplitter;
GroupBox2: TGroupBox;
ShellListView1: TShellListView;
Splitter2: TSplitter;
Panel2: TPanel;
Splitter3: TSplitter;
GroupBox3: TGroupBox;
ShellTreeView2: TShellTreeView;
GroupBox4: TGroupBox;
ShellListView2: TShellListView;
Timer1: TTimer;
procedure ShellListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure ShellListView1EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

var
node0 : TTreeNode = nil;


const
// OperateShell用
osMove = FO_MOVE;
osCopy = FO_COPY;
osDelete = FO_DELETE;
osRename = FO_RENAME;
osMove_Undo = FOF_ALLOWUNDO +FO_MOVE; // ゴミ箱に残す
osCopy_Undo = FOF_ALLOWUNDO +FO_COPY;
osDelete_Undo = FOF_ALLOWUNDO +FO_DELETE;
osRename_Undo = FOF_ALLOWUNDO +FO_RENAME;

// フォルダ一括操作
function OperateShell(OperateMode : Integer; Path_From, Path_To : String): Boolean;
var
rshf : TSHFILEOPSTRUCT;
cmd,mode : Integer;
begin
Result := False;
if Path_From = Path_To then exit;
if not( FileExists(Path_From) or DirectoryExists(Path_From) ) then exit;
if DirectoryExists(Path_From) and FileExists(Path_To) then exit;

cmd := OperateMode mod $10;
mode := OperateMode div $10 * $10; // FOF_ALLOWUNDOのON/OFF
if not (cmd in [FO_MOVE..FO_RENAME]) then exit;

if cmd in [FO_MOVE, FO_COPY] then begin
// 処理先チェック
if RightStr(Path_To, 1) = '\' then begin // \終わりの場合は、フォルダパスとして処理
if not DirectoryExists(Path_To) then
if not ForceDirectories(Path_To) then exit;
end;

if ExtractFilePath(Path_From) = IncludeTrailingPathDelimiter(Path_To) then exit;
end;

Path_From := ExcludeTrailingPathDelimiter(Path_From);
Path_To := ExcludeTrailingPathDelimiter(Path_To);

with rshf do begin
wnd := Application.Handle;
wFunc := cmd;
pFrom := PChar(Path_From +#0);
pTo := PChar(Path_To +#0);
fFlags := FOF_NOCONFIRMATION or mode;
end;

//FOF_NOCONFIRMATIONを指定しない場合ダイアログが表示されるが、それがキャンセルされたかはわからない
Result := SHFileOperation(rshf) = 0; // 成功=0
end;



// ドラッグ中
procedure TForm1.ShellListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
node : TTreeNode;
begin
if Sender is TShellListView then exit;

node := TShellTreeView(Sender).GetNodeAt(X, Y);
if node = nil then exit;

if node0 = nil then begin
node0 := node;
Timer1.Enabled := True;
end else if node0 <> node then begin
Timer1.Enabled := False;
node0 := nil;
end;
end;



// ドラッグ終了時にコピー処理
procedure TForm1.ShellListView1EndDrag(Sender, Target: TObject; X, Y: Integer);
label
_END_;
var
_STV : Array[0..1] of TCustomShellTreeView;
_SLV : Array[0..1] of TCustomShellListView;
i,r,cnt : Integer;
s1 : String;
s0 : TStringList;
item : TListItem;
node : TTreeNode;
//----------------------------------------------------------------------------
function _checkComp(Sender : TObject; Index : Integer) : Integer;
begin
Result := -1;
if Sender is TShellListView then begin
Result := 0;
_SLV[Index] := TCustomShellListView(Sender);
_STV[Index] := _SLV[Index].ShellTreeView;
end else if Sender is TShellTreeView then begin
Result := 1;
_STV[Index] := TCustomShellTreeView(Sender);
_SLV[Index] := _STV[Index].ShellListView;
end;
end;
//----------------------------------------------------------------------------
begin
s0 := TStringList.Create;

// ドロップ先
node := nil;
case _checkComp(Target,1) of
0 : begin
// TShellListView
s1 := _STV[1].Path;
if Sender = Target then begin
for i := 0 to _SLV[1].Items.Count -1 do
if _SLV[1].Items[i].Selected then
s0.Add(_SLV[1].Folders[i].PathName);
end;

for i := 0 to _SLV[1].Items.Count -1 do
_SLV[1].Items[i].Selected := False; // 前回の選択をリセット

item := _SLV[1].GetItemAt(X, Y);
if item <> nil then begin
item.Selected := True;
if _SLV[1].SelectedFolder <> nil then begin
s1 := _SLV[1].SelectedFolder.PathName;
if FileExists(s1) then s1 := ExcludeTrailingPathDelimiter(ExtractFilePath(s1)); // 送信先を選択パスで更新

for i := 0 to _STV[1].Items.Count -1 do begin
if _STV[1].Folders[i].PathName <> s1 then continue;

node := _STV[1].Items[i];
break;
end;
end;
end;
end;

1 : begin
// TShellTreeView
node := _STV[1].GetNodeAt(X, Y);
if node = nil then s1 := _STV[1].Path
else s1 := TShellFolder(node.Data).PathName;
end;

else goto _END_;
end;

// ドロップ元
r := _checkComp(Sender,0);
case r of
0 : begin
if s0.Count = 0 then begin
for i := 0 to _SLV[0].Items.Count -1 do
if _SLV[0].Items[i].Selected then
s0.Add(_SLV[0].Folders[i].PathName);
end;
end;
1 : begin
for i := 0 to _STV[0].Items.Count -1 do
if _STV[0].Items[i].Selected then
s0.Add(_STV[0].Folders[i].PathName);
end;

else goto _END_;
end;

// コピー実行
cnt := 0;
for i := 0 to s0.Count -1 do
cnt := cnt +Ord(OperateShell(osCOPY, s0[i], s1));
if cnt = 0 then goto _END_;

// 表示更新
for i := 0 to 1 do _SLV[i].Refresh;
if node <> nil then node.Selected := True;

_END_:
s0.Free;
end;



procedure TForm1.Timer1Timer(Sender: TObject);
begin
if node0 = nil then exit;

node0.Expanded := True;
node0 := nil;
end;

end.
[Delphi] TShellListViewからエクスプローラへドラッグ&ドロップする

[PR]
by yozda | 2015-05-02 16:58 | プログラミング | Trackback(1) | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/21184597
トラックバックする(会員専用) [ヘルプ]
Tracked from ( … > Z_ ̄∂ at 2015-05-17 17:03
タイトル : [Delphi] TShellTreeViewやTShe..
こんにチワワ。どーもボキです。 unit Unit1; interface uses ShellAPI, StrUtils, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ShellCtrls, ExtCtrls, StdCtrls; type TForm1 = class(TForm) ...... more
<< [Delphi] TShell... LINE6 Mobile In... >>