Как перетащить файл из оболочки проводника в элемент управления VirtualTreeView в приложении Delphi?

существует обширная поддержка перетаскивания в VirtualTreeView Майком Лишке, и я использую TVirtualStringTree, который имеет некоторые события перетаскивания, но я не могу понять, как заставить его принять перетаскивание оболочки некоторых файлов из оболочки проводника windows в мое приложение. Я хочу загрузить файлы, когда они перетаскиваются на элемент управления drop.

Я попытался использовать сторонний набор кода от Anders Melander, чтобы обрабатывать перетаскивание, но потому что VirtualTreeView уже регистрирует себя как цель падения, я не могу использовать это.

edit: я нашел простой обходной путь: выключите toAcceptOLEDrop в VT.TreeOptions.MiscOptions. Было бы здорово, если кто-нибудь знает способ использования VirtualTreeView без использования сторонней библиотеки OLE-shell-drag-drop и использования ее обширной поддержки перетаскивания OLE для извлечения списка имен файлов, перетаскиваемых из оболочки.

7
delphi drag-and-drop virtualtreeview windows-shell

2 ответов

моя реализация (очень хорошо работает с Delphi 2010. Необходимо добавить ActiveX, ShellApi для использования для компиляции):

procedure TfMain.vstTreeDragDrop(Sender: TBaseVirtualTree; Source: TObject;
  DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
  Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
  I, j: Integer;
  MyList: TStringList;
  AttachMode: TVTNodeAttachMode;
begin
  if Mode = dmOnNode then
    AttachMode := amInsertBefore
  else if Mode = dmAbove then
    AttachMode := amInsertBefore
  else if Mode = dmBelow then
    AttachMode := amInsertAfter
  else
    AttachMode := amAddChildLast;

  MyList := TStringList.Create;
  try
    for i := 0 to High(formats) - 1 do
    begin
      if (Formats[i] = CF_HDROP) then
      begin
        GetFileListFromObj(DataObject, MyList);

        //here we have all filenames
        for j:=0 to MyList.Count - 1 do
        begin
          Sender.InsertNode(Sender.DropTargetNode, AttachMode);
        end; 
      end;  
    end;
  finally
    MyList.Free;
  end;
end;

procedure TfMain.GetFileListFromObj(const DataObj: IDataObject;
  FileList: TStringList);
var
  FmtEtc: TFormatEtc;                   // specifies required data format
  Medium: TStgMedium;                   // storage medium containing file list
  DroppedFileCount: Integer;            // number of dropped files
  I: Integer;                           // loops thru dropped files
  FileNameLength: Integer;              // length of a dropped file name
  FileName: string;                 // name of a dropped file
begin
  // Get required storage medium from data object
  FmtEtc.cfFormat := CF_HDROP;
  FmtEtc.ptd := nil;
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;
  OleCheck(DataObj.GetData(FmtEtc, Medium));
  try
    try
      // Get count of files dropped
      DroppedFileCount := DragQueryFile(
        Medium.hGlobal, $FFFFFFFF, nil, 0
        );
      // Get name of each file dropped and process it
      for I := 0 to Pred(DroppedFileCount) do
        begin
          // get length of file name, then name itself
          FileNameLength := DragQueryFile(Medium.hGlobal, I, nil, 0);
          SetLength(FileName, FileNameLength);
          DragQueryFileW(
            Medium.hGlobal, I, PWideChar(FileName), FileNameLength + 1
            );
          // add file name to list
          FileList.Append(FileName);
        end;
    finally
      // Tidy up - release the drop handle
      // don't use DropH again after this
      DragFinish(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end;

end;
9

Я использую этот метод для захвата (получения) файлов, перетаскиваемых в TWinControl из explorer.
Вы можете проверить это на своем контроле. В стандартном TTreeView работают нормально.

добавить ShellAPI для использования.

в отдельный раздел: 

  private
    originalEditWindowProc : TWndMethod;
    procedure EditWindowProc(var Msg:TMessage);
    // accept the files dropped
    procedure FilesDrop(var Msg: TWMDROPFILES);

сразу же создайте свою форму:

  // Assign procedures
  originalEditWindowProc := TreeView1.WindowProc;
  TreeView1.WindowProc := EditWindowProc;
  // Aceptar ficheros arrastrados  // Accept the files
  ShellAPI.DragAcceptFiles(TreeView1.Handle, True);

и две процедуры таковы: 

// Al arrastrar ficheros sobre el TV.  On drop files to TV
procedure TForm1.FilesDrop(var Msg: TWMDROPFILES);
var
  i:Integer;
  DroppedFilename:string;
  numFiles : longInt;
  buffer : array[0..MAX_PATH] of char;
begin
  // Número de ficheros arrastrados // Number of files
  numFiles := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0) ;

  // Recorrido por todos los arrastrados // Accept all files
  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);
    except
      on E:Exception do begin
        // catch
      end;
    end;
  end;
end;


procedure TForm1.EditWindowProc(var Msg: TMessage);
begin
  // 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;

Я надеюсь, что это полезно для вас.

С уважением.

3