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