Question

在Delphi XE中，我可以允许我的表单接受文件“拖放”但不必处理裸窗口消息吗？

Answer 1

您无需处理消息即可实现此目的。您只需要实施IDropTarget并致电RegisterDragDrop / RevokeDragDrop。这真的非常简单。您实际上可以在表单代码中实现IDropTarget，但我更喜欢在类似这样的帮助程序类中执行此操作：

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;

这里的想法是在IDropTarget中结束Windows TDropTarget的复杂性。您需要做的就是实现更简单的IDragDrop。无论如何，我认为这应该让你去。

从控件的CreateWnd创建放置目标对象。在DestroyWnd方法中销毁它。这一点很重要，因为VCL窗口重新创建意味着控件可以在其生命周期内销毁并重新创建窗口句柄。

请注意，TDropTarget上的引用计数被抑制。这是因为当调用RegisterDragDrop时，它会增加引用计数。这会创建一个循环引用，这个代码可以抑制引用计数。这意味着您将通过类变量而不是接口变量来使用此类，以避免泄漏。

用法看起来像这样：

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;

这里我使用表单作为放置目标。但是你可以以类似的方式使用任何其他窗口控件。

Answer 2

如果您不喜欢纯WinAPI，那么您可以使用组件。 Drag and Drop Component Suite免费提供资源。

Answer 3

不，除非您要阅读一些已经内置此功能的自定义TForm后代。

Answer 4

我使用David Heffernan的解决方案作为我的测试应用程序的基础，并在应用程序关闭时获得“无效指针操作”。该问题的解决方案是通过添加'_Release;'来更改TDropTarget.Create。

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

您可以在Embarcadero forum上看到有关此问题的讨论。

Answer 5

您必须自己编写代码，或者安装第三方产品，例如DropMaster，这样您就可以拖放更旧的Delphi版本。

- 的Jeroen

如何在不处理Windows消息的情况下允许表单接受文件丢弃？

5 个答案: