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