vb 坐标点击
引用 :http://www.vbgood.com/thread-113934-1-1.html
第一步在窗体的通用栏写如下代码:
Private Type pointapi
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
第二步在窗体上放一个LABEL控件,然后再鼠标按下过程写下列代码:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim wz As pointapi
GetCursorPos wz
Label1.Caption = wz.X & "," & wz.Y
End Sub
新加代码:
在form1窗体load事件中写入
Private Sub Form_Load()
WebBrowser1.Navigate "www.baidu.com"
End Sub
也可以不是百度,自己写
在WebBrowser1_BeforeNavigate2事件中写入
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)
'判断将要打开的网页的url,如果是我们自定义的mouse://协议,就进行处理
If Left(URL, 8) = "mouse://" Then
'让网页不要跳转
Cancel = True
Dim tmp, x, y
'过滤url
tmp = Replace(URL, "mouse://", "")
tmp = Replace(tmp, "/", "")
tmp = Split(tmp, "|")
'提取x,y坐标
x = tmp(0)
y = tmp(1)
Debug.Print x
Debug.Print y
Dim wz As pointapi
GetCursorPos wz
Label1.Caption = wz.x & "," & wz.y
End If
End Sub
然后在WebBrowser1_DocumentComplete事件中写入
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
On Error GoTo ToExit
'------------------------------------------------
'这里是在WebBrowser1加载网页完成后,在WebBrowser1中执行一段js脚本,用来绑定鼠标按下事件
'当鼠标按下以后,js会控制网页跳转到 mouse://x|y 的页面,上面的代码可以截获这个协议
Dim js As String
js = "document.body.onclick=function()" & vbCrLf & _
"{location.href='mouse://'+window.event.x+ '|'+window.event.y;}"
WebBrowser1.Document.parentWindow.execScript js, "javascript"
'------------------------------------------------
Exit Sub
'----------------
ToExit:
Resume Next
End Sub