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.οnclick=function()" & vbCrLf & _
? ?? ?? ?"{location.href='mouse://'+window.event.x+ '|'+window.event.y;}"
? ???
? ?? ???WebBrowser1.Document.parentWindow.execScript js, "javascript"
? ? '------------------------------------------------
? ? Exit Sub
? ? '----------------
ToExit:
? ? Resume Next
End Sub
轉載于:https://www.cnblogs.com/sode/archive/2012/09/19/2694494.html
總結
- 上一篇: Hdu 4293 DP
- 下一篇: 敏捷结果30天之第十二天:效率角色-你是