在 Delphi XE 中,我可以让我的表单接受文件“拖放”但不必处理裸 Windows 消息吗?
5 回答
您不需要处理消息来实现这一点。您只需要实现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;
在这里,我使用表单作为放置目标。但是您可以以类似的方式使用任何其他窗口控件。
如果你不喜欢纯 WinAPI,那么你可以使用组件。拖放组件套件是免费的源。
不,除非您要仔细阅读一些已经内置此功能的自定义 TForm 后代。
我使用 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 论坛上看到有关此问题的讨论。
您必须自己编写代码,或者安装像DropMaster这样的第 3 方产品,它还可以让您在更旧的 Delphi 版本中进行拖放操作。
——杰伦