捕获 WebBrowser 控件的鼠标事件

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

　　程序运行后，在 WebBrowser1 内移动或按下鼠标，注意观察窗口标题栏给出的信息

　　另一种进行鼠标事件捕获的方法是，使用注入脚本的方法，参见另一文章：使用注入脚本的方法捕获 WebBrowser 控件的鼠标事件

'以下代码在 VB6 调试通过
'勾选部件：Microsoft Internet Controls，在窗体放置控件：WebBrowser1
'勾选引用：Microsoft HTML Object Library
Private WithEvents ctDoc As MSHTML.HTMLDocument
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Type PointAPI
     X As Long: Y As Long
End Type

Private Sub Form_Load()
    Me.Caption = "WebBrowser 鼠标事件例子"
    WebBrowser1.Navigate "about:blank" '设置为空白页，否则 ctDoc = WebBrowser1.Document 会无效
    Set ctDoc = WebBrowser1.Document
    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 ctDoc_onmousedown()
    Dim X As Long, Y As Long
    MouseInWeb X, Y
    Me.Caption = "WebBrowser 的 MouseDown 事件：x=" & X & " Y=" & Y
End Sub

Private Sub ctDoc_onmousemove()
    Dim X As Long, Y As Long
    MouseInWeb X, Y
    Me.Caption = "WebBrowser 的 MouseMove： x=" & X & " Y=" & Y
End Sub

Private Sub ctDoc_onmouseup()
    Dim X As Long, Y As Long
    MouseInWeb X, Y
    Me.Caption = "WebBrowser 的 MouseUp 事件：x=" & X & " Y=" & Y
End Sub

Private Sub MouseInWeb(X As Long, Y As Long)
    Dim xy As PointAPI, BarS As Long, ctSW As Long, ctSH As Long
    GetCursorPos xy
    X = xy.X: Y = xy.Y
    ctSW = (Me.Width - Me.ScaleWidth) / Screen.TwipsPerPixelX * 0.5 '窗口边框宽度
    ctSH = (Me.Height - Me.ScaleHeight) / Screen.TwipsPerPixelY     '标题栏及窗口边框
    BarS = 21 '滚动条宽度（像素），判断网页是否有滚动条，是一个难题

    X = X - Me.Left / Screen.TwipsPerPixelX - Me.ScaleX(WebBrowser1.Left, Me.ScaleMode, 3) - ctSW:
    Y = Y - Me.Top / Screen.TwipsPerPixelY - Me.ScaleY(WebBrowser1.Top, Me.ScaleMode, 3) - ctSH + ctSW
   
    If X + BarS > Me.ScaleX(WebBrowser1.Width, Me.ScaleMode, 3) Then X = -1 '扣除滚动条后的宽度
    If Y + BarS > Me.ScaleX(WebBrowser1.Height, Me.ScaleMode, 3) Then Y = -1  '
End Sub

转载请注明来源：http://hi.baidu.com/100bd/blog/item/796918dc5c7204d48c1029f0.html