Drag&Drop и TShellListview

@GRIZZLY85 · Регистрация: 04.02.2013

Студворк — интернет-сервис помощи студентам

Всем привет. Есть исходный код drag & drop для TShellListView. Не получается перетащить файлы из проводника в этот компонент, из компонента в проводник получается. Проблема, не могу понять как в коде связать TStringList и TListItems (если так можно сказать). Первый код, это модуль.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
unit DragDropFilesA;
 
interface
 
uses
Windows, Messages, Classes, SysUtils, AppEvnts, Controls, ShellAPI, FileCtrl,
ActiveX, ComObj, ShlObj, ComCtrls, ShellCtrls;
 
type
TDropEffect = (deNone, deCopy, deMove, deLink, deScroll);
TDropFilesFolders = class(TApplicationEvents, IDropSource)
protected
procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); virtual;
 
function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HRESULT; stdcall;
function GiveFeedback(dwEffect: Longint): HRESULT; stdcall;
public
SL: TStringList;
OnDropFilesFolders: TNotifyEvent;
 
DropEffect: TDropEffect;
 
function ListOfFilesFolders(ddDirectory: String; ddFileList: TStrings): Integer; overload;
function ListOfPaths(ddFileList: TStrings): Integer; overload;
 
constructor Create(AOwner: TWinControl);
destructor Destroy; override;
end;
 
implementation
 
{ TDropFilesFolders }
 
procedure TDropFilesFolders.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
i, nCount: UINT;
sFileNm: String;
dwChars: DWORD;
begin
If (Msg.message = WM_DROPFILES) and (Msg.hwnd = TWinControl(self.Owner).Handle) then
begin
If @self.OnDropFilesFolders = nil then
begin
Handled:= True;
Exit;
end;
Handled:= False;
nCount:= DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0);
If nCount = 0 then
Exit;
SL.Clear;
try
for i:= 0 to nCount - 1 do
begin
dwChars:= DragQueryFile(Msg.wParam, i, nil, 0);
Inc(dwChars);
SetLength(sFileNm, dwChars);
dwChars:= DragQueryFile(Msg.wParam, i, PChar(sFileNm), dwChars);
If dwChars > 0 then
begin
SetLength(sFileNm, dwChars);
{****************}
 SL.Add(sFileNm);
{****************}
end;
end;
finally
If @self.OnDropFilesFolders <> nil then
OnDropFilesFolders(self);
end;
end;
end;
 
constructor TDropFilesFolders.Create(AOwner: TWinControl);
begin
TApplicationEvents(self).Create(AOwner);
self.OnMessage:= self.ApplicationEventsMessage;
SL:= TStringList.Create;
DropEffect:= deCopy;
DragAcceptFiles(TWinControl(Owner).Handle, True);
end;
 
destructor TDropFilesFolders.Destroy;
begin
SL.Free;
If Assigned(Owner) then
DragAcceptFiles(TWinControl(Owner).Handle, False);
inherited;
end;
 
function TDropFilesFolders.ListOfPaths(ddFileList: TStrings): Integer;
var
s: String;
i: Integer;
begin
If ddFileList.Count = 0 then
Exit;
SL.Clear;
s:= ExtractFilePath(ddFileList[0]);
i:= 0;
repeat
If (s <> ExtractFilePath(ddFileList[i])) then
Break;
SL.Add(ExtractFileName(ddFileList[i]));
Inc(i);
until
(i = ddFileList.Count);
ListOfFilesFolders(s, SL);
SL.Clear;
end;
 
function TDropFilesFolders.ListOfFilesFolders(ddDirectory: String;
  ddFileList: TStrings): Integer;
var
dataObj: IDataObject;
Root: IShellFolder;
pchEaten, dwAttributes: ULONG;
DirectoryItemIDList: PItemIDList;
Folder: IShellFolder;
i: Integer;
ItemIDLists: array of PItemIDList;
dwOKEffects: Longint;
begin
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(ddDirectory)),
pchEaten, DirectoryItemIDList, dwAttributes));
try
OleCheck(Root.BindToObject(DirectoryItemIDList, nil, IShellFolder, Folder));
SetLength(ItemIDLists, ddFileList.Count);
for i:= 0 to ddFileList.Count - 1 do
OleCheck(Folder.ParseDisplayName(0, nil, PWideChar(WideString(ddFileList[i])),
pchEaten, ItemIDLists[i], dwAttributes));
try
OleCheck(Folder.GetUIObjectOf(0, ddFileList.Count, ItemIDLists[0], IDataObject,
nil, dataObj));
finally
for i:= 0 to ddFileList.Count - 1 do
CoTaskMemFree(ItemIDLists[i]);
end;
dwOKEffects:= 0;
If deNone = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_NONE;
If deCopy = DropEffect then
dwOKEffects:=dwOKEffects or DROPEFFECT_COPY;
If deMove = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_MOVE;
If deLink = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_LINK;
DoDragDrop(dataObj, Self, dwOKEffects, Result);
finally
CoTaskMemFree(DirectoryItemIDList);
end;
end;
 
function TDropFilesFolders.GiveFeedback(dwEffect: Integer): HRESULT;
begin
Result:= DRAGDROP_S_USEDEFAULTCURSORS;
end;
 
function TDropFilesFolders.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Integer): HRESULT;
begin
If fEscapePressed then
Result:= DRAGDROP_S_CANCEL
else
If (grfKeyState and MK_LBUTTON) = 0 then
Result:= DRAGDROP_S_DROP
else
Result:= S_OK;
end;
 
initialization
OleInitialize(nil);
 
finalization
OleUninitialize;
 
end.

Второй, форма

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DragDropFilesA, FileCtrl, ComCtrls, ShellCtrls, ShellAPI,
  ActiveX, ShlObj, ComObj, Menus;
 
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    FileListBox1: TFileListBox;
    slv1: TShellListView;
    Button1: TButton;
    exit1: TButton;
    Del: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure slv1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure slv1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    DragPoint: TPoint;
    DFF: TDropFilesFolders;
    procedure FromDropFiles(Sender: TObject);
    procedure FromDropFiles2(Sender: TObject);
  public
    { Public declarations }
  FilesFolders: TStringList;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TForm1 }
 
procedure TForm1.FromDropFiles(Sender: TObject);
begin
ListBox1.Clear;
ListBox1.Items.AddStrings(dff.SL);
end;
 
procedure TForm1.FromDropFiles2(Sender: TObject);
begin
{*******************************************************}
//slv1.Items...как тут быть, чтобы вставить (dff.SL);???
{*******************************************************}
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
FilesFolders:= TStringList.Create;
FilesFolders.Duplicates:= dupIgnore;
FilesFolders.Sorted:= True;
DFF:= TDropFilesFolders.Create(slv1);
DFF.OnDropFilesFolders:= self.FromDropFiles2;
DFF:= TDropFilesFolders.Create(ListBox1);
DFF.OnDropFilesFolders:= self.FromDropFiles;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
slv1.Back;
end;
 
procedure TForm1.slv1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DragPoint:= Point(X, Y);
end;
 
procedure TForm1.slv1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
i: Integer;
begin
If (DragPoint.X = - 1) or ((Shift <> [ssLeft]) and (Shift <> [ssRight])) or
((Abs(DragPoint.X - X) < 10) and (Abs(DragPoint.Y - Y) < 10)) then
Exit;
If slv1.SelCount = 0 then
Exit;
FilesFolders.Clear;
for i:= 0 to slv1.Items.Count - 1 do
If slv1.Items[i].Selected then
FilesFolders.Add(slv1.Folders[i].PathName);
DFF.ListOfPaths(FilesFolders);
end;
 
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
i: integer;
begin
If (DragPoint.X = - 1) or ((Shift <> [ssLeft]) and (Shift <> [ssRight])) or
((Abs(DragPoint.X - X) < 10) and (Abs(DragPoint.Y - Y) < 10)) then
Exit;
If ListBox1.SelCount = 0 then
Exit;
 
for i:= 0 to ListBox1.Items.Count - 1 do
if ListBox1.Selected[i] then
dff.ListOfPaths(ListBox1.Items);
end;
 
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
DragPoint:= Point(X, Y);
end;
 
end.

Проблема выделена звёздочками. Буду признателен за помощь.

@dondublon · 12.02.2014, 15:00

AddStrings?

@GRIZZLY85 · 12.02.2014, 16:02 **[ТС]**

Это если использовать ListBox, то добавляется список строк(полных путей). А как в ShellListView добавить? Как на этот список сослаться не знаю. Или тут как то по другому.

@dondublon · 12.02.2014, 16:14

А, понятно.
Ну тогда вряд ли, там же показывается содержимое каталога, вы не можете менять содержимое списка произвольно.

@GRIZZLY85 · 12.02.2014, 16:53 **[ТС]**

Почему, я же к примеру кидаю файлы с рабочего стола в listbox и туда добавляются пути, т.е. список же меняется. А когда кидаю эти пути обратно в проводник то получаю копию этого файла. вот мне и нужно чтобы кидая файлы в shelllistview (он тот же проводник), получить копию этих же файлов. Может так понятней будет.

@northener · 12.02.2014, 17:20

Сообщение от GRIZZLY85

вот мне и нужно чтобы кидая файлы в shelllistview (он тот же проводник), получить копию этих же файлов

Ну так за чем дело стало? Пути к файлам и их имена тебе известны. Папка куда их нужно скопировать тоже. Вот и копируй. Не думаешь же ты что shelllistview сам это будет делать?

@GRIZZLY85 · 12.02.2014, 19:26 **[ТС]**

Так вот что то понять не могу как это сделать. Переработал что ли.

. Покажите как.

@GRIZZLY85 · 04.03.2014, 18:53 **[ТС]**

Всем привет. Уважаемые программисты нужна ваша помощь. Я реализую копирование двух и более папок путём перетаскивания из проводника в shelllistview (в папку). Проблема в том, что не получается копировать больше одной папки из проводника в открытую папку в shelllisview, не получается указать правильный путь с именами. Вот часть кода.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
StringList.Add(FileName); //FileName - выделенная память под строки(пути и имена перетаскиваемых папок)
for i:= 0 to StringList.Count - 1 do
s:= StringList[i];// пробывал так,  s:= s + StringList[i] + #0; ерунда получается
s2:= IncludeTrailingPathDelimiter(ShellListView1.RootFolder.PathName) + ExtractFileName(s);
CopyFilesFolders(s, s2);
end;
 
procedure TForm1.CopyFilesFolders(const sFrom, sTo: String);
var
FOS: TSHFileOpStruct;
begin
FOS.Wnd:= 0;
FOS.wFunc:= FO_COPY;
FOS.pFrom:= PChar(sFrom);
FOS.pTo:= PChar(sTo);
FOS.fFlags:= FOF_RENAMEONCOLLISION or FOF_MULTIDESTFILES;
FOS.fAnyOperationsAborted:= False;
FOS.hNameMappings:= 0;
FOS.lpszProgressTitle:= 0;
SHFileOperation(FOS);
end;

Ошибка где то или что, не могу понять.

Буду благодарен за помощь.

@GRIZZLY85 · 12.03.2014, 14:54 **[ТС]**

Всем привет. Разобрался я со всем этим, всё было правильно, только если можно так сказать "не дописал" немного. Вот теперь кому надо выкладываю готовый модуль Drag&Drop из проводника в программу и из программы в проводник, с использованием ShellListView. По крайней мере, я в интернете не нашёл ни одного примера с этим компонентом.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
unit DragDropFilesFoldersA;
 
interface
 
uses
Windows, Messages, Classes, SysUtils, AppEvnts, Controls, ShellAPI, FileCtrl,
ActiveX, ComObj, ShlObj, ComCtrls, ShellCtrls;
 
type
TDropEffect = (deNone, deCopy, deMove, deLink);
TDropFilesFolders = class(TApplicationEvents, IDropSource)
protected
procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); virtual;
function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HRESULT; stdcall;
function GiveFeedback(dwEffect: Longint): HRESULT; stdcall;
public
SL: TStringList;
OnDropFilesFolders: TNotifyEvent;
DropEffect: TDropEffect;
procedure CopyFilesFolders(const sFrom, sTo: String); overload;
function ListOfFilesFolders(ddDirectory: String; ddFileList: TStrings): Integer; overload;
function ListOfPaths(ddFileList: TStrings): Integer; overload;
constructor Create(AOwner: TWinControl);
destructor Destroy; override;
end;
 
implementation
 
{ TDropFilesFolders }
 
procedure TDropFilesFolders.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
i, nCount, PathLength: integer;
FileName: String;
begin
If (Msg.message = WM_DROPFILES) and (Msg.hwnd = TWinControl(self.Owner).Handle) then
begin
If @self.OnDropFilesFolders = nil then
begin
Handled:= True;
Exit;
end;
Handled:= False;
nCount:= DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0);
If nCount = 0 then
Exit;
SL.Clear;
try
for i:= 0 to nCount - 1 do
begin
PathLength:= DragQueryFile(Msg.wParam, i, nil, 0);
Inc(PathLength);
SetLength(FileName, PathLength);
PathLength:= DragQueryFile(Msg.wParam, i, PChar(FileName), PathLength);
If PathLength > 0 then
begin
SetLength(FileName, PathLength);
SL.Add(FileName);
end;
end;
finally
If @self.OnDropFilesFolders <> nil then
OnDropFilesFolders(self);
end;
end;
end;
 
constructor TDropFilesFolders.Create(AOwner: TWinControl);
begin
TApplicationEvents(self).Create(AOwner);
self.OnMessage:= self.ApplicationEventsMessage;
SL:= TStringList.Create;
SL.Duplicates:= dupIgnore;
SL.Sorted:= True;
DropEffect:= deCopy;
DragAcceptFiles(TWinControl(Owner).Handle, True);
end;
 
destructor TDropFilesFolders.Destroy;
begin
SL.Free;
If Assigned(Owner) then
DragAcceptFiles(TWinControl(Owner).Handle, False);
inherited;
end;
 
procedure TDropFilesFolders.CopyFilesFolders(const sFrom, sTo: String);
var
FOS: TSHFileOpStruct;
begin
FOS.Wnd:= 0;
FOS.wFunc:= FO_COPY;
FOS.pFrom:= PChar(sFrom);
FOS.pTo:= PChar(sTo);
FOS.fFlags:= FOF_RENAMEONCOLLISION or FOF_MULTIDESTFILES;
FOS.fAnyOperationsAborted:= False;
FOS.hNameMappings:= 0;
FOS.lpszProgressTitle:= 0;
SHFileOperation(FOS);
end;
 
function TDropFilesFolders.ListOfPaths(ddFileList: TStrings): Integer;
var
s: String;
i: Integer;
begin
If ddFileList.Count = 0 then
Exit;
SL.Clear;
s:= ExtractFilePath(ddFileList[0]);
i:= 0;
repeat
If (s <> ExtractFilePath(ddFileList[i])) then
Break;
SL.Add(ExtractFileName(ddFileList[i]));
Inc(i);
until
(i = ddFileList.Count);
ListOfFilesFolders(s, SL);
SL.Clear;
end;
 
function TDropFilesFolders.ListOfFilesFolders(ddDirectory: String;
  ddFileList: TStrings): Integer;
var
dataObj: IDataObject;
Root: IShellFolder;
pchEaten, dwAttributes: ULONG;
DirectoryItemIDList: PItemIDList;
Folder: IShellFolder;
i: Integer;
ItemIDLists: array of PItemIDList;
dwOKEffects: Longint;
begin
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(ddDirectory)),
pchEaten, DirectoryItemIDList, dwAttributes));
try
OleCheck(Root.BindToObject(DirectoryItemIDList, nil, IShellFolder, Folder));
SetLength(ItemIDLists, ddFileList.Count);
for i:= 0 to ddFileList.Count - 1 do
OleCheck(Folder.ParseDisplayName(0, nil, PWideChar(WideString(ddFileList[i])),
pchEaten, ItemIDLists[i], dwAttributes));
try
OleCheck(Folder.GetUIObjectOf(0, ddFileList.Count, ItemIDLists[0], IDataObject,
nil, dataObj));
finally
for i:= 0 to ddFileList.Count - 1 do
CoTaskMemFree(ItemIDLists[i]);
end;
dwOKEffects:= 0;
If deNone = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_NONE;
If deCopy = DropEffect then
dwOKEffects:=dwOKEffects or DROPEFFECT_COPY;
If deMove = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_MOVE;
If deLink = DropEffect then
dwOKEffects:= dwOKEffects or DROPEFFECT_LINK;
DoDragDrop(dataObj, Self, dwOKEffects, Result);
finally
CoTaskMemFree(DirectoryItemIDList);
end;
end;
 
function TDropFilesFolders.GiveFeedback(dwEffect: Integer): HRESULT;
begin
Result:= DRAGDROP_S_USEDEFAULTCURSORS;
end;
 
function TDropFilesFolders.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Integer): HRESULT;
begin
If fEscapePressed then
Result:= DRAGDROP_S_CANCEL
else
If (grfKeyState and MK_LBUTTON) = 0 then
Result:= DRAGDROP_S_DROP
else
Result:= S_OK;
end;
 
initialization
OleInitialize(nil);
 
finalization
OleUninitialize;
 
end.

Использование

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DragDropFilesFoldersA, FileCtrl, ComCtrls, ShellCtrls, ShellAPI,
  ActiveX, ShlObj, ComObj, Menus;
 
type
  TForm1 = class(TForm)
    slv1: TShellListView;
    procedure FormCreate(Sender: TObject);
    procedure slv1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure slv1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    DragPoint: TPoint;
    DFF: TDropFilesFolders;
    procedure FromDropFilesFolders(Sender: TObject);
  public
    { Public declarations }
  SL2: TStringList;
  end;
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TForm1 }
 
procedure TForm1.FromDropFilesFolders(Sender: TObject);
var
i: Integer;
FromPath, ToPath: String;
begin
i:= 0;
try
for i:= 0 to DFF.SL.Count - 1 do
begin
FromPath:= DFF.SL[i];
ToPath:= IncludeTrailingPathDelimiter(SLV1.RootFolder.PathName)
+ ExtractFileName(FromPath);
DFF.CopyFilesFolders(FromPath, ToPath);
end;
finally
end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
SL2:= TStringList.Create;
SL2.Duplicates:= dupIgnore;
SL2.Sorted:= True;
DFF:= TDropFilesFolders.Create(slv1);
DFF.OnDropFilesFolders:= self.FromDropFilesFolders;
end;
 
procedure TForm1.slv1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DragPoint:= Point(X, Y);
end;
 
procedure TForm1.slv1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
i: Integer;
begin
If (DragPoint.X = - 1) or ((Shift <> [ssLeft]) and (Shift <> [ssRight])) or
((Abs(DragPoint.X - X) < 10) and (Abs(DragPoint.Y - Y) < 10)) then
Exit;
If slv1.SelCount = 0 then
Exit;
SL2.Clear;
for i:= 0 to slv1.Items.Count - 1 do
If slv1.Items[i].Selected then
SL2.Add(slv1.Folders[i].PathName);
DFF.ListOfPaths(SL2);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
SL2.Free;
end;
 
end.

Кому надо может по своему преобразовать.

@kuzduk · 13.03.2014, 17:03

Возможно вам поможет это: https://www.cyberforum.ru/delphi/thread749391.html

@GRIZZLY85 · 14.03.2014, 09:53 **[ТС]**

Добавлено через 6 минут
Ваше видел и не раз, оно мне не подходит, по этому сделал своё.

@MorpheyZ · 10.08.2017, 16:56

А не подскажете как последний код GRIZZLY85 адаптировать под ListBox1 и FileListBox (У меня ХЕ4)?

@D1973 · 11.08.2017, 17:38

MorpheyZ, а почему бы не создать свою тему со своим вопросом, где подробненько описать проблему, свои варианты действий и свои попытки решения, вместо того, чтобы лезть со своей проблемой в чужую тему трехгодичной давности???

Новые блоги и статьи Все статьи Все блоги /
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .

@dondublon 4648 / 2068 / 366 Регистрация: 17.03.2012 Сообщений: 10,168 Записей в блоге: 6
	12.02.2014, 15:00
	AddStrings? 0

@GRIZZLY85 0 / 0 / 1 Регистрация: 04.02.2013 Сообщений: 57
	12.02.2014, 16:02 [ТС]
	Это если использовать ListBox, то добавляется список строк(полных путей). А как в ShellListView добавить? Как на этот список сослаться не знаю. Или тут как то по другому. 0

@dondublon 4648 / 2068 / 366 Регистрация: 17.03.2012 Сообщений: 10,168 Записей в блоге: 6
	12.02.2014, 16:14
	А, понятно. Ну тогда вряд ли, там же показывается содержимое каталога, вы не можете менять содержимое списка произвольно. 0

@GRIZZLY85 0 / 0 / 1 Регистрация: 04.02.2013 Сообщений: 57
	12.02.2014, 16:53 [ТС]
	Почему, я же к примеру кидаю файлы с рабочего стола в listbox и туда добавляются пути, т.е. список же меняется. А когда кидаю эти пути обратно в проводник то получаю копию этого файла. вот мне и нужно чтобы кидая файлы в shelllistview (он тот же проводник), получить копию этих же файлов. Может так понятней будет. 0

@GRIZZLY85 0 / 0 / 1 Регистрация: 04.02.2013 Сообщений: 57
	12.02.2014, 19:26 [ТС]
	Так вот что то понять не могу как это сделать. Переработал что ли. . Покажите как. 0

@kuzduk 79 / 10 / 0 Регистрация: 21.09.2011 Сообщений: 90
	13.03.2014, 17:03
	Возможно вам поможет это: https://www.cyberforum.ru/delphi/thread749391.html 0

@GRIZZLY85 0 / 0 / 1 Регистрация: 04.02.2013 Сообщений: 57
	14.03.2014, 09:53 [ТС]
	Добавлено через 6 минут Ваше видел и не раз, оно мне не подходит, по этому сделал своё. 0

@MorpheyZ 0 / -1 / 0 Регистрация: 30.03.2016 Сообщений: 27
	10.08.2017, 16:56
	А не подскажете как последний код GRIZZLY85 адаптировать под ListBox1 и FileListBox (У меня ХЕ4)? -0.50

@D1973 Модератор 9902 / 6440 / 2454 Регистрация: 21.01.2014 Сообщений: 27,337 Записей в блоге: 3
	11.08.2017, 17:38
	MorpheyZ, а почему бы не создать свою тему со своим вопросом, где подробненько описать проблему, свои варианты действий и свои попытки решения, вместо того, чтобы лезть со своей проблемой в чужую тему трехгодичной давности??? 0