Этот способ работал для обычных компонентов, например в обычном TreeView.
Пример, никаких ShowMessage не появляется при переносе файлов на VirtualStringTree:
Код:
type
TForm1 = class(TForm)
// ..........
VST1: TVirtualStringTree;
FLst :TStrings; // файлы
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
protected
procedure WMDROPFILES(var Msg: TMessage); message WM_DropFiles;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FLst := TStringList.Create;
DragAcceptFiles(VST1.Handle, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FLst.Free;
end;
procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
i, Amount, Size :Integer;
Filename :PChar;
Buf :string;
begin
inherited;
FileName := '';
Amount := DragQueryFile(Msg.WParam, $FFFFFFFF, Filename, 255);
FLst.Clear;
try
if Amount>0 then
For I:=0 To Amount-1 Do
begin
Size := DragQueryFile(Msg.WParam, i, nil, 0)+1;
Filename := StrAlloc(size);
Try
DragQueryFile(Msg.WParam, I, Filename, size);
Buf := string(Filename);
FLst.Add(Buf);
Finally
StrDispose(Filename);
end;
end;
if Amount>0 then
begin
ShowMessage(FLst.Text);
end
else
begin
MessageBox(Handle, 'Добавлять нечего', 'Информация', MB_OK+MB_ICONINFORMATION);
end;
finally
DragFinish(Msg.WParam);
end;
end;
Как можно заставить VirtualStringTree принять список файлов/папок которые мышкой перенесли на него? И чтобы была возможность получать узел назначения или nil если курсор на пустом месте остановился.
С перемещением вручную созданных узлов куда угодно в дереве проблем нет.
Пробовал так, список файлов приходит. Но не узнать узел/nil назначения куда перенесли файлы.
Код:
uses
SysUtils, Messages, Classes, Activex, ShellAPI, ComObj;
type
TForm1 = class(TForm)
VST1: TVirtualStringTree;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
originalEditWindowProc :TWndMethod;
procedure EditWindowProc(var Msg:TMessage);
procedure FilesDrop(var Msg: TWMDROPFILES);
{ Private declarations }
public
fDragDropFileList :TStringList;
{ Public declarations }
protected
{ Protected declarations }
end;
var
Form1: TFormTray;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
fDragDropFileList := TStringList.Create;
originalEditWindowProc := VST1.WindowProc;
VST1.WindowProc := EditWindowProc;
DragAcceptFiles(VST1.Handle, True);
//
VST1.TreeOptions.MiscOptions := VST1.TreeOptions.MiscOptions + [toCheckSupport];
VST1.TreeOptions.SelectionOptions := VST1.TreeOptions.SelectionOptions + [toMultiSelect];
VST1.TreeOptions.AutoOptions := VST1.TreeOptions.AutoOptions - [toAutoDeleteMovedNodes];
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
VST1.Clear;
FreeAndNil(fDragDropFileList);
end;
procedure TForm1.EditWindowProc(var Msg: TMessage);
begin // DragDrop files
// if correct message, execute the procedure
if Msg.Msg = WM_DROPFILES then
begin
FilesDrop(TWMDROPFILES(Msg))
end
else
begin
// in other case do default...
originalEditWindowProc(Msg) ;
end;
end;
procedure TForm1.FilesDrop(var Msg: TWMDROPFILES);
var
i :Integer;
DroppedFilename :string;
numFiles :LongInt;
buffer :array[0..MAX_PATH]of Char;
begin // DragDrop files
// Number of files
numFiles := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0) ;
// Accept all files
fDragDropFileList.Clear;
for i := 0 to (numFiles - 1) do
begin
DragQueryFile(Msg.Drop, i, @buffer, sizeof(buffer));
// Proteccion
try
DroppedFilename := buffer;
// HERE you can do something with the file...
// TreeView1.Items.AddChild(nil, DroppedFilename);
fDragDropFileList.Add(DroppedFilename);
except
on E:Exception do
begin
// catch
end;
end;
end;
ShowMessage(fDragDropFileList.Text);
end;
end.