Arrastrar y soltar "fuera" de delphi.

[jplj]

Hola:

Lo que pretendo es arrastrar y soltar un fichero fuera -Escritorio, editor de texto, programa de correo, ...- de la aplicación.

En concreto: en la aplicación tengo un TListBox con el nombre de algunos de los fichero que están almacenados en una carpeta. Quiero que el usuario pueda arrastrar desde el TListBox al Escritorio, editor de texto, ... el fichero que está representado por su nombre en el TListBox. Igual que cuando, por ejemplo, desde Lotus Notes arrastramos y soltamos en el Escritorio un fichero que lleva anexado el correo.

Muchas gracias de antemano.
Y Felices Fiestas.

[[newtron]]

Hola.

Imagino que dependiendo lo que quieras hacer con el archivo, si abrirlo, copiarlo al escritorio, etc. tendrás que ejecutar una acción u otra. Si es abrirlo puedes usar el comando "ShellExecute" para abrirlo el archivo con el programa que tenga predeterminado windows para ello. Para copiarlo al escritorio imagino que lo más simple es copiarlo desde su ubicación original a la carpeta de windows donde se ubica lo que hay en el escritorio (que ahora mismo no recuerdo cual es) y te aparecerá directamente.

Espero haberte dado alguna idea.

Saludos

[jplj]

Hola newtron.

Imagino que dependiendo lo que quieras hacer con el archivo, si abrirlo, copiarlo al escritorio, etc. tendrás que ejecutar una acción u otra.

He ahí la cuestión, que no sé de antemano lo que quiere hacer el usuario. Dependerá de dónde suelte el "archivo", si es en el Escritorio sería copiarlo, pero si lo hace sobre un editor de texto sería editarlo con ese programa. Por lo tanto, lo que debería poder obtener es el "lugar" donde ha soltado el archivo para realizar la acción adecuada.
En principio me conformaría con saber si han soltado el "archivo" sobre una carpeta/escritorio para copiarlo allí.

[jplj]

He encontrado la solución en swissdelphicenter en concreto en este tip de R.Kleinpeter ...Drag and Drop files from your application to Windows Explorer?

Decir que a pesar del título no sólo las carpetas de windows aceptan los ficheros que se arrastran, también he comprobado que lo hace Paint y el Bloc de notas.

Tan sólo he tenido que modificar el tipo de Effect a LongInt en el procedimiento FileListBox1MouseMove.

Código Delphi [-]
procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:
  TShiftState;
  X, Y: Integer);
const
  Threshold = 5;
var
  SelFileList: TStrings;
  i: Integer;
  DataObject: IDataObject;
//  Effect: DWORD;
  Effect: LongInt;
begin

Nota: Trabajo con Wndows XP y Delphi 7.


Por último dejo a continuación el código completo:

Código Delphi [-]
...Drag and Drop files from your application to Windows Explorer?
Author: R.Kleinpeter

Category: Files

{This example will show you how your application
will be able to copy files from your application to
Windows Explorer using Drag'n Drop.
Exactly the way it is done by the OS itself!

Create a new application containing just one unit,
called 'Unit1'. Drop a FileListBox and a DirectoryListBox on to the form,
leave their names the way they are.
Connect FileListBox1 with DirectoryListBox1 by setting the FileList-property of
DirectoryListBox1. Make sure that the MultiSelect-property of FileListBox1 is set to 'True'!

The best thing you can do now is to replace all text with the code below:}

//---------------------------------------------

unit Unit1;

interface

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

type
  TForm1 = class(TForm, IDropSource)
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    procedure FileListBox1MouseDown(Sender: TObject; Button:
      TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
      X,
      Y: Integer);
  private
    FDragStartPos: TPoint;
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetFileListDataObject(const Directory: string; Files:
  TStrings):
  IDataObject;
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Malloc: IMalloc;
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
begin
  Result := nil;
  if Files.Count = 0 then
    Exit;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil,
    PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for i := 0 to FileCount - 1 do
      begin
        OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i],
          dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
        nil,
        Pointer(Result)));
    finally
      for i := 0 to FileCount - 1 do begin
        if p^[i] <> nil then Malloc.Free(p^[i]);
      end;
      FreeMem(p);
    end;
  finally
    Malloc.Free(FolderPidl);
  end;
end;

function TForm1.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Longint): HResult; stdcall;
begin
  if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then
  begin
    Result := DRAGDROP_S_CANCEL
  end else if grfKeyState and MK_LBUTTON = 0 then
  begin
    Result := DRAGDROP_S_DROP
  end else
  begin
    Result := S_OK;
  end;
end;

function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

procedure TForm1.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FDragStartPos.x := X;
    FDragStartPos.y := Y;
  end;
end;

procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:
  TShiftState;
  X, Y: Integer);
const
  Threshold = 5;
var
  SelFileList: TStrings;
  i: Integer;
  DataObject: IDataObject;
  Effect: DWORD;
begin
  with Sender as TFileListBox do
  begin
    if (SelCount > 0) and (csLButtonDown in ControlState)
      and ((Abs(X - FDragStartPos.x) >= Threshold)
      or (Abs(Y - FDragStartPos.y) >= Threshold)) then
      begin
      Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
      SelFileList := TStringList.Create;
      try
        SelFileList.Capacity := SelCount;
        for i := 0 to Items.Count - 1 do
          if Selected[i] then SelFileList.Add(Items[i]);
        DataObject := GetFileListDataObject(Directory, SelFileList);
      finally
        SelFileList.Free;
      end;
      Effect := DROPEFFECT_NONE;
      DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
    end;
  end;
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
{
As you might have seen, TForm1 is not only a member of class TForm,
but also of class IDropSource!

Now make sure that the two FileListBox events
'OnMouseMove' and 'OnMouseDown' are set correctly.

Run your application and try out the Drag and Drop feature!
You can select multiple items to drag and press escape to cancel.
The cursor will show you what action will take place.
}

[jplj]

Un "pequeño" detalle a la hora realizar nuestra aplicación:

Código Delphi [-]
type
  TForm1 = class(TForm, IDropSource)

No olvidar incluir IDropSource en la definición de nuestro formulario.