如何在不处理Windows消息的情况下允许表单接受文件丢弃？ [英] How can I allow a form to accept file dropping without handling Windows messages?

问题描述

解决方案

在Delphi XE中，我可以允许我的表单接受文件'拖放'

您不需要处理消息来实现这一点。您只需要实现 IDropTarget 并调用 RegisterDragDrop / RevokeDragDrop 。真的很简单您可以在表单代码中实际实现 IDropTarget ，但我更愿意在类似于此的帮助类中执行此操作：

 使用
 Winapi.Windows，
 Winapi.ActiveX，
 Winapi.ShellAPI，
 System.StrUtils，
 Vcl。形式; 
 
 type 
 IDragDrop = interface 
函数DropAllowed（const FileNames：数组的字符串）：Boolean; 
 procedure drop（const FileNames：array of string）; 
结束
 
 TDropTarget = class（TObject，IInterface，IDropTarget）
 private 
 // IInterface 
函数QueryInterface（const IID：TGUID; out Obj）：HResult;标准
 function _AddRef：Integer;标准
函数_Release：整数;标准
 private 
 // IDropTarget 
 FHandle：HWND; 
 FDragDrop：IDragDrop; 
 FDropAllowed：Boolean; 
 procedure GetFileNames（const dataObj：IDataObject; var FileNames：TArray< string>）; 
程序SetEffect（var dwEffect：Integer）; 
函数DragEnter（const dataObj：IDataObject; grfKeyState：Integer; pt：TPoint; var dwEffect：Integer）：HResult;标准
函数DragOver（grfKeyState：Longint; pt：TPoint; var dwEffect：Longint）：HResult;标准
函数DragLeave：HResult;标准
函数Drop（const dataObj：IDataObject; grfKeyState：Longint; pt：TPoint; var dwEffect：Longint）：HResult;标准
 public 
构造函数Create（AHandle：HWND; const ADragDrop：IDragDrop）; 
析构函数覆盖
结束
 
 {TDropTarget} 
 
构造函数TDropTarget.Create（AHandle：HWND; const ADragDrop：IDragDrop）; 
开始
继承创建; 
 FHandle：= AHandle; 
 FDragDrop：= ADragDrop; 
 RegisterDragDrop（FHandle，Self）
 end; 
 
析构函数TDropTarget.Destroy; 
 begin 
 RevokeDragDrop（FHandle）; 
继承; 
结束
 
函数TDropTarget.QueryInterface（const IID：TGUID; out Obj）：HResult; 
 begin 
如果GetInterface（IID，Obj）然后开始
结果：= S_OK; 
 end else begin 
结果：= E_NOINTERFACE; 
结束
结束
 
函数TDropTarget._AddRef：Integer; 
 begin 
结果：= -1; 
结束
 
函数TDropTarget._Release：Integer; 
 begin 
结果：= -1; 
结束
 
程序TDropTarget.GetFileNames（const dataObj：IDataObject; var FileNames：TArray< string>）; 
 var 
 i：整数; 
 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; 
如果dataObj.GetData（formatetcIn，medium）= S_OK然后开始
（*需要这个转换，因为HDROP在ShellAPI.pas中被错误地声明为Longint，应该被声明为THandle 
一个无符号整数，没有这个修复，例程在自上而下的内存分配情况下失败。*）
 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）; 
结束
结束
结束
 
程序TDropTarget.SetEffect（var dwEffect：Integer）; 
 begin 
如果FDropAllowed然后开始
 dwEffect：= DROPEFFECT_COPY; 
 end else begin 
 dwEffect：= DROPEFFECT_NONE; 
结束
结束
 
函数TDropTarget.DragEnter（const dataObj：IDataObject; grfKeyState：Integer; pt：TPoint; var dwEffect：Integer）：HResult; 
 var 
文件名：TArray< string> ;; 
 begin 
结果：= S_OK; 
尝试
 GetFileNames（dataObj，FileNames）; 
 FDropAllowed：=（Length（FileNames）> 0）和FDragDrop.DropAllowed（FileNames）; 
 SetEffect（dwEffect）; 
除了
结果：= E_UNEXPECTED; 
结束; 
结束
 
函数TDropTarget.DragLeave：HResult; 
 begin 
结果：= S_OK; 
结束
 
函数TDropTarget.DragOver（grfKeyState：Integer; pt：TPoint; var dwEffect：Integer）：HResult; 
 begin 
结果：= S_OK; 
尝试
 SetEffect（dwEffect）; 
除了
结果：= E_UNEXPECTED; 
结束; 
结束
 
函数TDropTarget.Drop（const dataObj：IDataObject; grfKeyState：Integer; pt：TPoint; var dwEffect：Integer）：HResult; 
 var 
文件名：TArray< string> ;; 
 begin 
结果：= S_OK; 
尝试
 GetFileNames（dataObj，FileNames）; 
如果Length（FileNames）> 0则开始
 FDragDrop.Drop（FileNames）; 
结束
除了
 Application.HandleException（Self）; 
结束; 
结束
  

这里的想法是整理Windows IDropTarget 在 TDropTarget 。所有你需要做的是实现 IDragDrop ，这更简单。无论如何，我认为这应该让你走。

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

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

使用情况如下所示：

 键入
 TMainForm = class（TForm，IDragDrop）
 .... 
 private 
 FDropTarget：TDropTarget; 
 
 //实现IDragDrop 
函数DropAllowed（const FileNames：数组的字符串）：Boolean; 
 procedure drop（const FileNames：array of string）; 
 protected 
 procedure CreateWnd;覆盖
程序DestroyWnd;覆盖
结束
 
 .... 
 
程序TMainForm.CreateWnd; 
开始
继承; 
 FDropTarget：= TDropTarget.Create（WindowHandle，Self）; 
结束
 
程序TMainForm.DestroyWnd; 
 begin 
 FreeAndNil（FDropTarget）; 
继承; 
结束
 
函数TMainForm.DropAllowed（const FileNames：数组的字符串）：Boolean; 
 begin 
结果：= True; 
结束
 
程序TMainForm.Drop（const FileNames：数组的字符串）; 
 begin 
; //做一些文件名
 end; 
  

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

In Delphi XE can I allow my form to accept file 'drag and drop' but without having to handle bare windows messages?

解决方案

You don't need to handle messages to implement this. You just need to implement IDropTarget and call RegisterDragDrop/RevokeDragDrop. It's really very very simple. You can actually implement IDropTarget in your form code but I prefer to do it in a helper class that looks like this:

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;

The idea here is to wrap up the complexity of the Windows IDropTarget in TDropTarget. All you need to do is to implement IDragDrop which is much simpler. Anyway, I think this should get you going.

Create the drop target object from your control's CreateWnd. Destroy it in the DestroyWnd method. That point is important because VCL window re-creation means that a control can have its window handle destroyed and re-created during its lifetime.

Note that reference counting on TDropTarget is suppressed. That is because when RegisterDragDrop is called it increments the reference count. This creates a circular reference and this code to suppress reference counting breaks that. This means that you would use this class through a class variable rather than an interface variable, in order to avoid leaking.

The usage would look something like this:

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;

Here I am using a form as the drop target. But you could use any other windowed control in a similar fashion.

这篇关于如何在不处理Windows消息的情况下允许表单接受文件丢弃？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！