捕获 WebBrowser 控件的鼠标事件

 捕获 WebBrowser 控件的鼠标事件

　　VB 的网页浏览控件 WebBrowser 没有 MouseDown、MouseMove、MouseUp 等鼠标事件，要在程序中捕获这些事件，必须另想办法。本文使用注入 java 脚本的方法来捕获控件的鼠标事件。

　　另一种捕获鼠标事件的方法，参见另一文章：使用 Document 的事件捕获 WebBrowser 控件的鼠标事件

'以下代码在 VB6 调试通过
'勾选部件：Microsoft Internet Controls，在窗体放置控件：WebBrowser1
'程序运行后，在 WebBrowser1 内移动或按下鼠标，注意观察窗口标题栏给出的信息
'本人原创，转载请注明来源：http://hi.baidu.com/100bd/blog/item/19795a80b2ba61d5bd3e1ee1.html
Private Sub Form_Load()
    Me.Caption = "WebBrowser 鼠标事件例子"
    WebBrowser1.Navigate "about:blank" '设置为空白页或某网页，否则无法进行鼠标捕获
'    WebBrowser1.Navigate "http://www.baidu.com" '显示百度首页
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.Caption = "WebBrowser 鼠标事件例子"
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Dim nStr As String
    nStr = URL
    If Left(nStr, 8) <> "mouse://" Then Exit Sub '让网页正常跳转
       
    Cancel = True '让网页不要跳转
    Dim nMouse As String, x As Long, y As Long, S As Long
    nStr = Mid(nStr, 9)
    S = InStr(nStr, "|")
    nMouse = Left(nStr, S - 1): nStr = Mid(nStr, S + 1)
    S = InStr(nStr, "|")
    x = Val(Left(nStr, S - 1)): y = Val(Mid(nStr, S + 1))
    Me.Caption = nMouse & "：" & x & " " & y '显示鼠标捕获的状态
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
     On Error Resume Next
     Dim js As String
    '脚本：用于捕获 鼠标按下
     js = "document.body.onmousedown=function()" & vbCrLf & _
       "{location.href='mouse://down|'+window.event.x + '|'+window.event.y;}"
     WebBrowser1.Document.parentWindow.execScript js, "javascript"
    '脚本：用于捕获 鼠标移动
     js = "document.body.onmousemove=function()" & vbCrLf & _
     "{location.href='mouse://move|'+window.event.x + '|'+window.event.y;}"
     WebBrowser1.Document.parentWindow.execScript js, "javascript"
    '脚本：用于捕获 鼠标抬起
     js = "document.body.onmouseup=function()" & vbCrLf & _
      "{location.href='mouse://up|'+window.event.x + '|'+window.event.y;}"
     WebBrowser1.Document.parentWindow.execScript js, "javascript"
End Sub
'转载请注明来源：http://hi.baidu.com/100bd/blog/item/19795a80b2ba61d5bd3e1ee1.html