在Delphi XE中,我可以允许我的表单接受文件“拖放”,但无需处理裸机的Windows消息?
解决方法
您不需要处理消息来实现这一点。您只需要实现IDropTarget并调用RegisterDragDrop / RevokeDragDrop。真的很简单您可以在表单代码中实际实现IDropTarget,但我更喜欢在类似于helper的类中执行此操作:
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],i,0)); DragQueryFile(dropHandle,@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 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;
这里我使用一个表单作为放下目标。但您可以使用任何其他窗口控件以类似的方式。