摘自一本杂志:<br><br>呵呵，这个问题我刚刚遇到过（我写的FreeIP就支持拖放URL)。就是让自己的程序<br>可以接受OLE拖放。这需要申明一个COM对象，并支持IDropTarget接口。<br>下面DragDrop.pas不是我写的:<br>unit DragDrop;<br><br>interface<br><br>uses<br> Windows, ActiveX, ComObj,Dialogs,Sysutils;<br><br>type<br> TDropEvent = procedure(Sender:TObject;Msg
char)of object;<br> TTMyDrop = class(TComObject, 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,unit1;<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>在自己的程序中，在FormCreate的时候,加入：<br><br> OleInitialize(NIL);<br> dd := TTMyDrop.Create;<br> dd.OnDroped:=DoDroped;<br> res1 := CoLockObjectExternal(dd, true, false);<br> res := RegisterDragDrop(Handle, IDropTarget(dd));<br><br>其中，DoDroped在拖放发生时被调用：<br>procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar);<br>begin<br> ...//此处最好不要有太耗时的工作，因为被拖出的程序（比如说是浏览器）<br> //要等待此事件结束<br>end;<br><br>在FormDestroy时：<br> RevokeDragDrop(Handle);<br> OleUninitialize;<br><br>一定要用COM对象吗？<br>用OLE2 接口就行了吧!<br>TTMyDrop = class(TInterfacedObject, IDropTarget)<br>这样用的资源更少，也不用包含与com有关的unit了，只用<br>包含activex就行了。<br>也不用产生TComObjectFactory。<br><br>希望对你有帮助!<br>
