webbrowser的拖拽问题求助
我的系统是win7家庭版，ie8。webbrowser的document的事件中只有ondragstat，而像ondragend,ondragover等都没有（据说是ie9及以上才有）。现在想在document中实现拖拽的功能，参考了一下屏蔽右键和执行外部程序的代码，都是通过绑定idochosthandle接口实现的，想学一下，但是不成功，特来求助。测试代码如下：
程序代码：''Form代码：
Option Explicit
Private MyDrag As clsDrag
Private Sub Command1_Click()
Dim w1 As String '''随便给点文字，做测试用
w1 = "<font>dfslhlsf</font><br>hsfsfifsefs<br>dkgldglsl"
Wb.Document.body.innerHTML = w1
End Sub
Private Sub Form_Load()
Wb.Navigate "about:blank"
End Sub
Private Sub Wb_DownloadComplete()
If MyDrag Is Nothing Then
Set MyDrag = New clsDrag
MyDrag.Init Wb.Document
End If
End Sub
''类clsDrag代码：
Option Explicit
Implements olelib.IDocHostUIHandler
Implements olelib.iDropTarget '''''这个接口怎么绑定？
Private mDOC As olelib.ICustomDoc
''Private oTest As clsDim
Private WithEvents clsDoc As HTMLDocument
Public Sub Init(ByVal bDoc As HTMLDocument)
Set mDOC = bDoc
mDOC.SetUIHandler Me ''绑定IDocHostUIHandler接口
Set clsDoc = bDoc
End Sub
Private Function clsDoc_ondragstart() As Boolean
clsDoc_ondragstart = True
''ie8只有这一个事件。没有：ondragend,ondragover等事件
End Function
Private Sub IDocHostUIHandler_EnableModeless(ByVal fEnable As olelib.BOOL)
' IDocHostUIHandler.EnableModeless fEnable
' Err.Raise E_NOTIMPL
End Sub
Private Function IDocHostUIHandler_FilterDataObject(ByVal pDO As olelib.IDataObject) As olelib.IDataObject
' Set IDocHostUIHandler_FilterDataObject = IDocHostUIHandler.FilterDataObject(pDO)
' Err.Raise E_NOTIMPL
End Function
Private Function IDocHostUIHandler_GetDropTarget(ByVal pDropTarget As olelib.iDropTarget) As olelib.iDropTarget
' Set IDocHostUIHandler_GetDropTarget = IDocHostUIHandler.GetDropTarget(pDropTarget)
'''在这里加断点没有任何反应啊！
Form1.Caption = "GetDropTarget>>" & Timer
End Function
Private Function IDocHostUIHandler_GetExternal() As Object
''Set oTest = New clsDim ''测试成功
''Set IDocHostUIHandler_GetExternal = oTest
End Function
Private Sub IDocHostUIHandler_GetHostInfo(pInfo As olelib.DOCHOSTUIINFO)
' IDocHostUIHandler.GetHostInfo pInfo
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_GetOptionKeyPath(pOLESTRchKey As Long, ByVal dw As Long)
' IDocHostUIHandler.GetOptionKeyPath pOLESTRchKey, dw
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_HideUI()
' IDocHostUIHandler.HideUI
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_OnDocWindowActivate(ByVal fActivate As olelib.BOOL)
' IDocHostUIHandler.OnDocWindowActivate fActivate
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_OnFrameWindowActivate(ByVal fActivate As olelib.BOOL)
' IDocHostUIHandler.OnFrameWindowActivate fActivate
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_ResizeBorder(prcBorder As olelib.RECT, ByVal pUIWindow As , ByVal fRameWindow As olelib.BOOL)
' IDocHostUIHandler.ResizeBorder prcBorder, pUIWindow, fRameWindow
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_ShowContextMenu(ByVal dwContext As olelib.ContextMenuTarget, pPOINT As olelib.POINT, ByVal pCommandTarget As , ByVal HTMLTagElement As Object)
' IDocHostUIHandler.ShowContextMenu dwContext, pPOINT, pCommandTarget, HTMLTagElement
' Err.Raise E_NOTIMPL
''禁止右键菜单===>成功！
End Sub
Private Sub IDocHostUIHandler_ShowUI(ByVal dwID As Long, ByVal pActiveObject As , ByVal pCommandTarget As , ByVal pFrame As , ByVal pDoc As )
' IDocHostUIHandler.ShowUI dwID, pActiveObject, pCommandTarget, pFrame, pDoc
' Err.Raise E_NOTIMPL
End Sub
Private Sub IDocHostUIHandler_TranslateAccelerator(lpMsg As olelib.MSG, pguidCmdGroup As olelib.UUID, ByVal nCmdID As Long)
' IDocHostUIHandler.TranslateAccelerator lpMsg, pguidCmdGroup, nCmdID
' Err.Raise E_NOTIMPL
End Sub
Private Function IDocHostUIHandler_TranslateUrl(ByVal dwTranslate As Long, ByVal pchURLIn As Long) As Long
' IDocHostUIHandler_TranslateUrl = IDocHostUIHandler.TranslateUrl(dwTranslate, pchURLIn)
' Err.Raise E_NOTIMPL
End Function
Private Sub IDocHostUIHandler_UpdateUI()
' IDocHostUIHandler.UpdateUI
' Err.Raise E_NOTIMPL
End Sub
''''''''以下的如何生效？
Private Sub iDropTarget_DragEnter(ByVal pDataObj As olelib.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As olelib.DROPEFFECTS)
Form1.Caption = "iDropTarget_DragEnter>>" & Timer
End Sub
Private Sub iDropTarget_DragLeave()
Form1.Caption = "iDropTarget_DragLeave>>" & Timer
End Sub
Private Sub iDropTarget_DragOver(ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As olelib.DROPEFFECTS)
Form1.Caption = "iDropTarget_DragOver>>" & Timer
End Sub
Private Sub iDropTarget_Drop(ByVal pDataObj As olelib.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As olelib.DROPEFFECTS)
Form1.Caption = "iDropTarget_Drop>>" & Timer
End Sub
