怎样得到鼠标的XY坐标!(不是Form,而是屏幕的坐标)
解决方案 »
- 求助关于abab,aabb算法问题
- 在combox添加项目时,如果不用index的话,如何在additem时能够指定itemdata
- 关于获取 文件/文件夹 名称
- 关于使用implements设计接口
- 求教datagrid 的用法,我想使用它的节点,但不知怎样操作。
- 关于登陆局域网上的机器的方法?
- 如何获取程序内控件的内容,类名为“#32770”??
- 请问:在VB中如何直接调用输入法
- 关于打印前选择打印机和纸张的问题
- 如何让程序产生一个"PRINT SCREEN"动作
- 急呀!各位帮忙!TreeView+MSHFlexGrid拖拽,如何获得MSHFlexGrid中cell的位置!!!!!
- 如何修改HTML文件?
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As LongDim Pt As POINTAPIPrivate Sub Form_Load()
Dim xnow As Single
Dim ynow As Single
GetCursorPos Pt
xnow = Pt.X
ynow = Pt.Y
End Sub偶知道获得鼠标位置,不过不知道怎么获得鼠标按键,有人知道怎么用api获得鼠标按的是左键还是右键吗?
Call GetCursorPos(pt)这样 鼠标的坐标值在pt数据结构里了
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
dim Cur as POINTAPI
'新建一个timer控件
private sub Form_Load()
me.timer1.Interval=1
end sub
private Timer1_Timer()
getCursorpos(Cur)
me.caption="X=" & str(Cur.x) & "Y=" & Str(Cur.y)
end sub
'**模 块 名:basMouse
'**创 建 人:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**描 述:鼠标钩子
'**版 本:版本1.0
'*************************************************************************
Option Explicit
Public Type POINTL
X As Long
Y As Long
End Type
Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, xyPoint As POINTL) As LongPublic Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As LongGlobal lpPrevWndProc As LongPublic sngX As Single, sngY As Single '鼠标坐标
Public intShift As Integer '鼠标按键
Public bWay As Boolean '鼠标方向
Public bMouseFlag As Boolean '鼠标事件激活标志'*************************************************************************
'**函 数 名:Hook
'**输 入:ByVal hWnd(Long) - 窗口句柄
'**输 出:无
'**功能描述:安装鼠标钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
'获取"控制面板"中的滚动行数值
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
End Sub'*************************************************************************
'**函 数 名:UnHook
'**输 入:ByVal hWnd(Long) - 窗口句柄
'**输 出:无
'**功能描述:卸载鼠标钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub'*************************************************************************
'**函 数 名:WindowProc
'**输 入:ByVal hw(Long) - 窗口句柄
'** :ByVal uMsg(Long) - 消息类型
'** :ByVal wParam(Long) -
'** :ByVal lParam(Long) -
'**输 出:(Long) -
'**功能描述:窗口函数
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTL
Select Case uMsg
Case WM_MOUSEWHEEL '滚动
Dim wzDelta, wKeys As Integer
'wzDelta传递滚轮滚动的快慢,该值小于零表示滚轮向后滚动(朝用户方向),
'大于零表示滚轮向前滚动(朝显示器方向)
wzDelta = HIWORD(wParam)
'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下,允许复合
wKeys = LOWORD(wParam)
'pt鼠标的坐标
pt.X = LOWORD(lParam)
pt.Y = HIWORD(lParam)
'--------------------------------------------------
If wzDelta < 0 Then '朝用户方向
bWay = True
Else '朝显示器方向
bWay = False
End If
'--------------------------------------------------
'将屏幕坐标转换为Form1.窗口坐标
ScreenToClient hw, pt
sngX = pt.X
sngY = pt.Y
intShift = wKeys
bMouseFlag = True '置滚动标志
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function'*************************************************************************
'**函 数 名:HIWORD
'**输 入:LongIn(Long) - 32位值
'**输 出:(Integer) - 32位值的低16位
'**功能描述:取出32位值的高16位
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Public Function HIWORD(LongIn As Long) As Integer
' 取出32位值的高16位
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function'*************************************************************************
'**函 数 名:LOWORD
'**输 入:LongIn(Long) - 32位值
'**输 出:(Integer) - 32位值的低16位
'**功能描述:取出32位值的低16位
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2002年12月31日
'**修 改 人:
'**日 期:
'**版 本:版本1.0
'*************************************************************************
Public Function LOWORD(LongIn As Long) As Integer
' 取出32位值的低16位
LOWORD = LongIn And &HFFFF&
End Function
X As Long
Y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim Pt As POINTAPI
Private Sub Form_Load()
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'得到鼠标的XY
GetCursorPos Pt
Me.CurrentX = 0
Me.CurrentY = 0
Me.Cls
Me.Print "Cursor position:"
Me.Print "X:" + Str$(Pt.X) + " Y:" + Str$(Pt.Y)
Me.Print " (Press ALT-F4 to unload this form)"
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SetCapture Me.hwnd
End Sub