vb使用GetCursorPos获取鼠标位置

vb使用GetCursorPos获取鼠标位置,第1张

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 当中。等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/web/9486276.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-04-28
下一篇 2023-04-28

发表评论

登录后才能评论

评论列表(0条)

保存