Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p As POINTAPI
Cls
GetCursorPos p
Print "x=" & pX & ", y=" & pY
End Sub
模块里加入:
Option Explicit
Type POINTAPI '定义一个坐标变量
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
窗体代码:
Option Explicit
Dim z As POINTAPI
Private Sub Timer1_Timer()
GetCursorPos z '得到坐标
Text1Text = zx & "," & zy
End Sub
这样就可以获取坐标点的x,y值。
至于你说的象棋程序我没写过,建议你可以去下载个象棋源码参考一下。 >
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1Text = X
Text2Text = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MeCaption = X & "," & Y
End Sub
新出炉的底层鼠标钩子(Low
Level
Mouse
Hook)
'==================窗体代码=================
Private
Sub
Form_Load()
hHook
=
SetWindowsHookEx(WH_MOUSE_LL,
AddressOf
MouseHookProc,
ApphInstance,
0)
If
hHook
<>
0
Then
MsgBox
"已钩住鼠标事件,请按本窗体右上方的X按钮关闭窗体,不要使用VB调试工具栏的“结束”按钮,以免VB崩溃"
End
If
End
Sub
Private
Sub
Form_Unload(Cancel
As
Integer)
UnhookWindowsHookEx
hHook
End
Sub
'=============模块代码==================
Public
Const
WH_MOUSE
=
7
'本地钩子
Public
Const
WH_MOUSE_LL
=
14
'全局钩子
Public
Declare
Function
SetWindowsHookEx
Lib
"user32"
Alias
"SetWindowsHookExA"
(ByVal
idHook
As
Long,
ByVal
lpfn
As
Long,
ByVal
hmod
As
Long,
ByVal
dwThreadId
As
Long)
As
Long
Public
Declare
Function
CallNextHookEx
Lib
"user32"
(ByVal
hHook
As
Long,
ByVal
nCode
As
Long,
ByVal
wParam
As
Long,
lParam
As
Any)
As
Long
Public
Declare
Function
UnhookWindowsHookEx
Lib
"user32"
(ByVal
hHook
As
Long)
As
Long
Public
Declare
Sub
CopyMemory
Lib
"kernel32"
Alias
"RtlMoveMemory"
(Destination
As
Any,
Source
As
Any,
ByVal
Length
As
Long)
Public
Const
WM_LBUTTONDOWN
=
&H201
'窗口中按下鼠标左键
Public
Const
WM_LBUTTONUP
=
&H202
'窗口中松开鼠标左键
Public
Const
WM_MOUSEMOVE
=
&H200
'窗口中移动鼠标
Public
Const
WM_RBUTTONDOWN
=
&H204
'窗口中按下鼠标右键
Public
Const
WM_RBUTTONUP
=
&H205
'窗口中松开鼠标右键
Public
Const
WM_MOUSEWHEEL
=
&H20A
'鼠标滚轮
Public
Const
WM_NCLBUTTONDOWN
=
&HA1
'窗口标题栏中按下鼠标左键
Public
Const
WM_NCLBUTTONUP
=
&HA2
'窗口标题栏中左开鼠标左键
Public
Const
WM_NCMOUSEMOVE
=
&HA0
'窗口标题栏中移动鼠标
Public
Const
WM_NCRBUTTONDOWN
=
&HA4
'窗口标题栏中按下鼠标右键
Public
Const
WM_NCRBUTTONUP
=
&HA5
'窗口标题栏中松开鼠标右键
Public
hHook
As
Long
Public
Type
POINTAPI
x
As
Long
y
As
Long
End
Type
Type
MSLLHOOKSTRUCT
pt
As
POINTAPI
'相对于屏幕左上角的坐标x,y
mouseData
As
Long
'鼠标数据
flags
As
Long
'标记
time
As
Long
'时间戳
dwExtraInfo
As
Long
'其他信息
End
Type
Type
MOUSEHOOKSTRUCT
pt
As
POINTAPI
'相对于屏幕左上角的坐标x,y
hwnd
As
Long
'鼠标光标下窗口的句柄
wHitTestCode
As
Long
'鼠标光标在窗口中的位置,标题栏、左边框、右边框,下边框。。。
dwExtraInfo
As
Long
'其他信息,通常为0
End
Type
Dim
oMouseHookStruct
As
MSLLHOOKSTRUCT
Public
Function
MouseHookProc(ByVal
idHook
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
CopyMemory
oMouseHookStruct,
ByVal
lParam,
Len(oMouseHookStruct)
DebugPrint
"当前鼠标位置-x:"
&
oMouseHookStructptx
&
";
y:"
&
oMouseHookStructpty
Select
Case
wParam
Case
WM_LBUTTONDOWN,
WM_NCLBUTTONDOWN
DebugPrint
"左键按下"
Case
WM_LBUTTONUP,
WM_NCLBUTTONUP
DebugPrint
"左键d起"
Case
WM_RBUTTONDOWN,
WM_NCRBUTTONDOWN
DebugPrint
"右键按下"
Case
WM_RBUTTONUP,
WM_NCRBUTTONUP
DebugPrint
"右键d起"
Case
WM_MOUSEMOVE,
WM_NCMOUSEMOVE
DebugPrint
"鼠标移动"
Case
WM_MOUSEWHEEL
DebugPrint
"鼠标滚轮"
End
Select
MouseHookProc
=
CallNextHookEx(hHook,
idHook,
wParam,
ByVal
lParam)
End
Function
控件中keyup属性记录键盘 *** 作
比如:
Private Sub from1_KeyUp(ByVal sender As SystemObject, ByVal e As SystemWindowsFormsKeyEventArgs) Handles MyBaseKeyUp
if ekeycode = keysEnter then
lable1text =CursorPositionX
lable2text = CursorPositionY
end if
end sub
你好 那因为你放在了Label1控件的移动事件了 。
说明:
当前你的代码是在当鼠标经过Label1的MouseMove事件才被激活,其他事件不备激活的。
建议应用函数调用具体方法网上应该有
Private Sub Timer1_Tick(ByVal sender As SystemObject, ByVal e As SystemEventArgs) Handles Timer1Tick
TextBox1Text = SystemWindowsFormsCursorPositionXToString & "," & SystemWindowsFormsCursorPositionYToString
End Sub
上面代码我是做过测试才发的,完全能实现你的要求!!!!!!
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI '定义点(Point)结构
X As Long '点在X坐标(横坐标)上的坐标值
Y As Long '点在Y坐标(纵坐标)上的坐标值
End Type
Sub PrintCursorPos()
Dim dl As Long
Dim MyPoint As POINTAPI
dl& = GetCursorPos(MyPoint) '调用函数,获取屏幕鼠标坐标
'DebugPrint "X=" & Str(MyPointX) & " and " & "Y=" & Str(MyPointY)
Label1Caption = "当前横坐标:" & Str(MyPointX)
Label2Caption = "当前纵坐标:" & Str(MyPointY)
End Sub
Private Sub Command1_Click()
Timer1Enabled = True
End Sub
Private Sub Timer1_Timer()
PrintCursorPos
End Sub
以上就是关于vb使用GetCursorPos获取鼠标位置全部的内容,包括:vb使用GetCursorPos获取鼠标位置、VB提取里面怎么赋值鼠标坐标及提取鼠标坐标、VB 如何实时获取鼠标坐标呢,然后点击一下坐标就输入到TEXT1 和 TEXT2 当中。等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)