unit dragdrop;<br><br>interface<br><br>uses<br> Windows, ActiveX, Dialogs,Sysutils;<br><br>type<br> TDropEvent = procedure(Sender:TObject;Msg
char)of object;<br>TTMyDrop = class(TInterfacedObject, IDropTarget)<br> private<br> FOnDroped: TDropEvent;<br> procedure SetOnDroped(const Value: TDropEvent);<br> protected<br> {Declare IDropTarget methods here}<br> function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;<br> pt: TPoint; var dwEffect: Longint): HResult; stdcall;<br> function DragOver(grfKeyState: Longint; pt: TPoint;<br> var dwEffect: Longint): HResult; stdcall;<br> function DragLeave: HResult; stdcall;<br> function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;<br> var dwEffect: Longint): HResult; stdcall;<br> public<br> property OnDroped:TDropEvent read FOnDroped write SetOnDroped;<br> end;<br><br>{const<br> Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1'; }<br><br>implementation<br><br>uses ComServ;<br><br>{ TTMyDrop }<br><br>function TTMyDrop.DragEnter(const dataObj: IDataObject;<br> grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;<br>var<br> enumFormatEtc: IEnumFormatEtc;<br> f:TFORMATETC;<br> count:Integer;<br> Found:boolean;<br>begin<br> dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);<br> Found:=false;<br> while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do<br> begin<br> if (f.cfFormat=CF_TEXT) then<br> begin<br> Found:=true;<br> Break;<br> end;<br> end;<br> if Found then<br> Result:=S_OK<br> else<br> begin<br> result:=E_INVALIDARG;<br> dwEffect:=DROPEFFECT_NONE;<br> end;<br>end;<br><br>function TTMyDrop.DragLeave: HResult;<br>begin<br> result := S_OK;<br>end;<br><br>function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint;<br> var dwEffect: Integer): HResult;<br>begin<br> result := S_OK;<br>end;<br><br>function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;<br> pt: TPoint; var dwEffect: Integer): HResult;<br>var<br> enumFormatEtc: IEnumFormatEtc;<br> f:TFORMATETC;<br> count:Integer;<br> Found:boolean;<br> medium: TStgMedium;<br>begin<br> dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);<br> Found:=false;<br> while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do<br> begin<br> if (f.cfFormat=CF_TEXT) then<br> begin<br> Found:=true;<br> Break;<br> end;<br> end;<br> if not Found then<br> begin<br> // result:=E_INVALIDARG;<br> dwEffect:=DROPEFFECT_NONE;<br> Exit;<br> end;<br> dataObj.GetData(f,medium);<br> if medium.tymed =1 then<br> begin<br> if Assigned(fOnDroped) then<br> begin<br> fOnDroped(Self,PChar(GlobalLock(medium.hglobal)));<br> GlobalUnLock(medium.hglobal);<br> end;<br> // result := S_OK;<br> end;<br><br>end;<br><br>procedure TTMyDrop.SetOnDroped(const Value: TDropEvent);<br>begin<br> FOnDroped := Value;<br>end;<br><br>initialization<br> {TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop,<br> 'TMyDrop', '', ciMultiInstance, tmApartment); }<br>end.<br><br>--------------------------------<br>procedure FileIsDropped(var Msg: TMessage);<br>var hDrop : THandle;<br> fName : array[0..254] of char ;<br> ct,FileNum : integer;<br> dir: string;<br>begin<br> hDrop := Msg.WParam;<br> FileNum := DragQueryFile(hDrop,cardinal(-1),fName,254);<br> for ct := 0 to FileNum - 1 do<br> begin<br> DragQueryFile(hDrop,ct,fName,254);<br> if (FileGetAttr(fname) and faDirectory)<>0 then<br> begin<br> dir:=string(fname);//这大概就是你想要的.你应该可以列出这个文件夹里的文件了.<br> end else<br> begin<br> //fname在这里是文件<br> end;<br> end;<br> DragFinish(hDrop);<br>end;