| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2319 人关注过本帖
标题:webbrowser的拖拽问题求助
只看楼主 加入收藏
def0011
Rank: 2
等 级:论坛游民
威 望:1
帖 子:6
专家分:18
注 册:2015-1-11
收藏
 问题点数:0 回复次数:2 
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


搜索更多相关主题的帖子: document color 接口 想学 
2016-04-17 09:45
def0011
Rank: 2
等 级:论坛游民
威 望:1
帖 子:6
专家分:18
注 册:2015-1-11
收藏
得分:0 
有大侠能指点一二不?
IDocHostUIHandler_GetExternal,IDocHostUIHandler_ShowContextMenu这2个过程都ok。
现在主要问题有2个,先来第一个吧 IDocHostUIHandler_GetDropTarget这个过程没有反应!
2016-04-18 11:07
def0011
Rank: 2
等 级:论坛游民
威 望:1
帖 子:6
专家分:18
注 册:2015-1-11
收藏
得分:0 
难道大侠们都改.net啦?咋没人回音呢?
2016-04-22 08:44
快速回复:webbrowser的拖拽问题求助
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.069850 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved