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

Posted 2023-05-08

【中文标题】如何允许表单在不处理 Windows 消息的情况下接受文件删除？

【英文标题】：How can I allow a form to accept file dropping without handling Windows messages?

【发布时间】：2011-05-20 05:42:50

【问题描述】：

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

【问题讨论】：

处理消息有什么问题？如果消息技术适合您的需要，它比 IDropTarget 技术很多容易。

+1 我的印象是 WM_DROPFILES 不允许您发出是否接受丢弃的信号。否则我同意它比 IDropTarget 更容易。

我只是不喜欢在可以避免的情况下使用 winapi。技术消息和 IDropTarget 都使用 winapi。我印象深刻的是delphi仍然不支持文件删除...

我同意最好使用基于 VCL 的解决方案而不是 Windows API 解决方案，但如果肯定没有基于 VCL 的解决方案，那么有任何解决方案总比没有解决方案好。如果您不喜欢 IDropTarget，您是否准备好接受“不，您想要的东西是不可能的”的回答？

有一个基于 VCL 的解决方案 - 使用 Anders Melander's Drag&Drop components 而不是手动实现 IDropTarget。例如，他提供了一个TDropFileTarget 组件，用于接受拖动文件。

【参考方案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;

这里的想法是将Windows IDropTarget 的复杂性封装在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 CreateWindowHandle; override;
    procedure DestroyWindowHandle; override;
  end;

....

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

procedure TMainForm.DestroyWindowHandle;
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;

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

【讨论】：

有人可以为我解释更多吗？我可以运行代码，但它什么也不做！！我如何在项目中使用它？比如如何设置一个TPanel来抓取文件？

@peiman 我会在答案中添加一些用法。那是缺失的。对不起。基本上你在你的一个类中实现IDragDrop。并将其传递给TDropTarget 的构造函数。通常，您在重写的 CreateWnd 中执行此操作。

因为在窗体的生命周期中可以重新创建窗口@robert

@MarusNebunu 你需要创建一个实现IDragDrop接口的对象

一个简单的用法示例会很好。

【参考方案2】：

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

【参考方案3】：

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

【参考方案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 上看到有关此问题的讨论。

【讨论】：

无论代码中的问题是什么，这都不是解决方案。你的代码大概把引用计数弄错了。我写这篇文章是为了未来的读者，这样他们就不会从表面上接受这个答案。

这确实是错误的修复，但你是正确的，有问题。最新版本的答案解决了这个问题。

【参考方案5】：

您必须自己编写代码，或者安装像 DropMaster 这样的第三方产品，这样您也可以在更旧的 Delphi 版本中进行拖放操作。

--杰罗恩

【讨论】：

这完全取决于您编写 30 行经过良好测试的代码的速度，这些代码可以在许多不同版本的 Windows 和其他类似于 Windows 资源管理器的工具中运行。

嗯，我不知道...鉴于旧的 API (DragXXX) 它稳定，与任何 Windows 版本兼容并且有很好的文档记录...可能真的很快。我不知道第三方工具及其错误和怪癖，虽然...

18 分钟 :)（没有将该行为隔离到不同的组件中）

其实我完全被那个隔离概念卡住了（因为从shell接受文件只是一种窗口风格，消息处理程序也属于窗口......）