现在很多软件都能够接受从IE里拖放出来的URL,我查过很多资料与站点始终没能找到一个完整的源程序,各位老兄,能否赐与我实现该功能的完整源程序(不使用组件或控件)吗?感激不尽!!!

解决方案 »

  1.   

    unit DragDrop;interfaceuses
      Windows, ActiveX, ComObj,Dialogs,Sysutils;type
      TDropEvent = procedure(Sender:TObject;Msg:Pchar)of object;
      TTMyDrop = class(TComObject, IDropTarget)
      private
        FOnDroped: TDropEvent;
        procedure SetOnDroped(const Value: TDropEvent);
      protected
        {Declare IDropTarget methods here}
        function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
          pt: TPoint; var dwEffect: Longint): 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
        property OnDroped:TDropEvent read FOnDroped write SetOnDroped;
      end;const
      Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1}';implementationuses ComServ,unit1;{ TTMyDrop }function TTMyDrop.DragEnter(const dataObj: IDataObject;
      grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
    var
      enumFormatEtc: IEnumFormatEtc;
      f:TFORMATETC;
      count:Integer;
      Found:boolean;
    begin
      dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
      Found:=false;
      while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
      begin
        if (f.cfFormat=CF_TEXT) then
        begin
          Found:=true;
          Break;
        end;
      end;
      if Found then
        Result:=S_OK
      else
      begin
        result:=E_INVALIDARG;
        dwEffect:=DROPEFFECT_NONE;
      end;
    end;function TTMyDrop.DragLeave: HResult;
    begin
       result := S_OK;
    end;function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint;
      var dwEffect: Integer): HResult;
    begin
       result := S_OK;
    end;function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
      pt: TPoint; var dwEffect: Integer): HResult;
    var
      enumFormatEtc: IEnumFormatEtc;
      f:TFORMATETC;
      count:Integer;
      Found:boolean;
      medium: TStgMedium;
    begin
      dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
      Found:=false;
      while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
      begin
        if (f.cfFormat=CF_TEXT) then
        begin
          Found:=true;
          Break;
        end;
      end;
      if not Found then
      begin
        result:=E_INVALIDARG;
        dwEffect:=DROPEFFECT_NONE;
        Exit;
      end;
      dataObj.GetData(f,medium);
      if medium.tymed =1 then
      begin
        if Assigned(fOnDroped) then
        begin
          fOnDroped(Self,PChar(GlobalLock(medium.hglobal)));
          GlobalUnLock(medium.hglobal);
        end;
        result := S_OK;
      end;end;procedure TTMyDrop.SetOnDroped(const Value: TDropEvent);
    begin
      FOnDroped := Value;
    end;initialization
      TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop,
        'TMyDrop', '', ciMultiInstance{, tmApartment});
    end.在自己的程序中,在FormCreate的时候,加入:  OleInitialize(NIL);
      dd := TTMyDrop.Create;
      dd.OnDroped:=DoDroped;
      res1 := CoLockObjectExternal(dd, true, false);
      res := RegisterDragDrop(Handle, IDropTarget(dd));其中,DoDroped在拖放发生时被调用:
    procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar);
    begin
      ...//此处最好不要有太耗时的工作,因为被拖出的程序(比如说是浏览器)
         //要等待此事件结束
    end;在FormDestroy时:
      RevokeDragDrop(Handle);
      OleUninitialize;
      

  2.   

    哦,对了,你的这段程序在csdn的2001版的delen.chm(英文文档)中好像就是这一段,我以前粗略试过,但不成功...等下子我再去详细调试一次。
      

  3.   

    我依上边的方法做后,编译运行后FORM1窗体并不能接受在拖过来的URL(当将一个URL拖到窗体上时,鼠标的形状变成那个"禁止"的形状),请问要加入什么语句才能让窗体可以接受拖过来的URL呢?===================================================
    {如接受拖放本地的文件,在form1.create中加入DragAcceptFiles(Handle,True);即可,但要接受URL拖放的文件,我就不懂了,期望您的指教
    }