¿Cómo puedo permitir que un formulario acepte la eliminación de archivos sin manejar los mensajes de Windows?

Question

En Delphi XE, ¿puedo permitir que mi formulario acepte el archivo 'arrastrar y soltar' pero sin tener que manejar los mensajes de Windows?

Answer 1

No es necesario para controlar los mensajes para implementar esto. Solo necesita implementar y llamar al RegisterDragDrop/RevokeDragDrop. Es realmente muy muy simple. En realidad se puede aplicar IDropTarget en su código de forma, pero yo prefiero hacerlo en una clase de ayuda que tiene este aspecto:

uses 
    Winapi.Windows, 
    Winapi.ActiveX, 
    Winapi.ShellAPI, 
    System.StrUtils, 
    Vcl.Forms; 

type 
    IDragDrop = interface 
    function DropAllowed(const FileNames: array of string): Boolean; 
    procedure Drop(const FileNames: array of string); 
    end; 

    TDropTarget = class(TObject, IInterface, IDropTarget) 
    private 
    // IInterface 
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 
    function _AddRef: Integer; stdcall; 
    function _Release: Integer; stdcall; 
    private 
    // IDropTarget 
    FHandle: HWND; 
    FDragDrop: IDragDrop; 
    FDropAllowed: Boolean; 
    procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>); 
    procedure SetEffect(var dwEffect: Integer); 
    function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; stdcall; 
    function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; 
    function DragLeave: HResult; stdcall; 
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; 
    public 
    constructor Create(AHandle: HWND; const ADragDrop: IDragDrop); 
    destructor Destroy; override; 
    end; 

{ TDropTarget } 

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop); 
begin 
    inherited Create; 
    FHandle := AHandle; 
    FDragDrop := ADragDrop; 
    RegisterDragDrop(FHandle, Self) 
end; 

destructor TDropTarget.Destroy; 
begin 
    RevokeDragDrop(FHandle); 
    inherited; 
end; 

function TDropTarget.QueryInterface(const IID: TGUID; out Obj): HResult; 
begin 
    if GetInterface(IID, Obj) then begin 
    Result := S_OK; 
    end else begin 
    Result := E_NOINTERFACE; 
    end; 
end; 

function TDropTarget._AddRef: Integer; 
begin 
    Result := -1; 
end; 

function TDropTarget._Release: Integer; 
begin 
    Result := -1; 
end; 

procedure TDropTarget.GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>); 
var 
    i: Integer; 
    formatetcIn: TFormatEtc; 
    medium: TStgMedium; 
    dropHandle: HDROP; 
begin 
    FileNames := nil; 
    formatetcIn.cfFormat := CF_HDROP; 
    formatetcIn.ptd := nil; 
    formatetcIn.dwAspect := DVASPECT_CONTENT; 
    formatetcIn.lindex := -1; 
    formatetcIn.tymed := TYMED_HGLOBAL; 
    if dataObj.GetData(formatetcIn, medium)=S_OK then begin 
    (* This cast needed because HDROP is incorrectly declared as Longint in ShellAPI.pas. It should be declared as THandle 
     which is an unsigned integer. Without this fix the routine fails in top-down memory allocation scenarios. *) 
    dropHandle := HDROP(medium.hGlobal); 
    SetLength(FileNames, DragQueryFile(dropHandle, $FFFFFFFF, nil, 0)); 
    for i := 0 to high(FileNames) do begin 
     SetLength(FileNames[i], DragQueryFile(dropHandle, i, nil, 0)); 
     DragQueryFile(dropHandle, i, @FileNames[i][1], Length(FileNames[i])+1); 
    end; 
    end; 
end; 

procedure TDropTarget.SetEffect(var dwEffect: Integer); 
begin 
    if FDropAllowed then begin 
    dwEffect := DROPEFFECT_COPY; 
    end else begin 
    dwEffect := DROPEFFECT_NONE; 
    end; 
end; 

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
var 
    FileNames: TArray<string>; 
begin 
    Result := S_OK; 
    Try 
    GetFileNames(dataObj, FileNames); 
    FDropAllowed := (Length(FileNames)>0) and FDragDrop.DropAllowed(FileNames); 
    SetEffect(dwEffect); 
    Except 
    Result := E_UNEXPECTED; 
    End; 
end; 

function TDropTarget.DragLeave: HResult; 
begin 
    Result := S_OK; 
end; 

function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
begin 
    Result := S_OK; 
    Try 
    SetEffect(dwEffect); 
    Except 
    Result := E_UNEXPECTED; 
    End; 
end; 

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
var 
    FileNames: TArray<string>; 
begin 
    Result := S_OK; 
    Try 
    GetFileNames(dataObj, FileNames); 
    if Length(FileNames)>0 then begin 
     FDragDrop.Drop(FileNames); 
    end; 
    Except 
    Application.HandleException(Self); 
    End; 
end; 

La idea aquí es para envolver la complejidad de las ventanas IDropTarget en TDropTarget. Todo lo que necesita hacer es implementar IDragDrop que es mucho más simple. De todos modos, creo que esto debería ayudarte.

Crea el objeto de destino de caída desde tu control CreateWnd. Destrúyalo en el método DestroyWnd. Ese punto es importante porque la recreación de la ventana VCL significa que un control puede tener su manejador de ventana destruido y recreado durante su vida útil.

Tenga en cuenta que el conteo de referencias en TDropTarget se suprime. Esto se debe a que cuando se llama a RegisterDragDrop, aumenta el recuento de referencias. Esto crea una referencia circular y este código para suprimir el conteo de referencias se rompe. Esto significa que usaría esta clase a través de una variable de clase en lugar de una variable de interfaz, para evitar fugas.

El uso sería algo como esto:

type 
    TMainForm = class(TForm, IDragDrop) 
    .... 
    private 
    FDropTarget: TDropTarget; 

    // implement IDragDrop 
    function DropAllowed(const FileNames: array of string): Boolean; 
    procedure Drop(const FileNames: array of string); 
    protected 
    procedure CreateWnd; override; 
    procedure DestroyWnd; override; 
    end; 

.... 

procedure TMainForm.CreateWnd; 
begin 
    inherited; 
    FDropTarget := TDropTarget.Create(WindowHandle, Self); 
end; 

procedure TMainForm.DestroyWnd; 
begin 
    FreeAndNil(FDropTarget); 
    inherited; 
end; 

function TMainForm.DropAllowed(const FileNames: array of string): Boolean; 
begin 
    Result := True; 
end; 

procedure TMainForm.Drop(const FileNames: array of string); 
begin 
    ; // do something with the file names 
end; 

Aquí estoy usando un formulario como el destino de colocación. Pero podría usar cualquier otro control de ventana de forma similar.

Answer 2

No, a menos que esté a punto de leer algunos descendientes TForm personalizados que ya tienen esta funcionalidad incorporada.

Answer 3

Usted tiene que escribir el código usted mismo, o instalar un producto de terceros como DropMaster, que le permite arrastrar y soltar en versiones mucho más antiguas de Delphi también.

--jeroen

Answer 4

Si no te gusta el WinAPI puro, entonces puedes usar componentes. Drag and Drop Component Suite es gratis con las fuentes.

Answer 5

Utilicé la solución de David Heffernan como base para mi aplicación de prueba y obtuve 'Operación de puntero inválido' al cerrar la aplicación. La solución para ese problema fue cambiar TDropTarget.Create agregando '_Release;'

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop); 
begin 
    inherited Create; 
    FHandle := AHandle; 
    FDragDrop := ADragDrop; 
    RegisterDragDrop(FHandle, Self); 
    _Release; 
end; 

Una discusión sobre este problema se puede ver en Embarcadero forum.