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

posted @ 2012-09-19 23:24  镇水古月  阅读(342)  评论(0编辑  收藏  举报