鼠标消息的捕捉

Question

我们知道用Form_MouseDown,Form_MouseMove可以对鼠标事件进行处理.但它有个不足:当Form失去"焦点"或光标离开窗口范围时,将不起作用.有没有一种方法能让鼠标,无论在何处都能得到它的消息?谢谢大家.

Answer 1

Option ExplicitPrivate Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As LongPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H8Private Type POINTAPI
    x As Long
    y As Long
End TypePrivate Sub Form_Click()
Timer1.Enabled = True
End SubPrivate Sub Form_Load()
Dim retvalue As Long
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOZORDER + SWP_NOMOVE + SWP_NOSIZE
Timer1.Interval = 5
Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
Dim hDC As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint '取得滑鼠座標
Label11.Caption = "x:" & lpPoint.x & "  y:" & lpPoint.yEnd Sub'希望对你有帮助

Answer 2

'下面的的函数是我程序中的一部分,用于运程控件,作用是鼠标键的捕捉和虚拟鼠标键的各种单击,双击,希望对你有参考价值.Option ExplicitPublic Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, ByVal dX As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Function SetCursorPos Lib "USER32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1Public Type POINTAPI
  x As Long
  y As Long
End TypePublic Sub dLeftClick() '左键双击
    LeftDown
    LeftUp
    LeftDown
    LeftUp
End SubPublic Sub LeftClick() '左键单击
    LeftDown
    LeftUp
End SubPublic Sub LeftDown() '左键按下
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End SubPublic Sub LeftUp() '左键弹起
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End SubPublic Sub MiddleClick() '中键单击
    MiddleDown
    MiddleUp
End SubPublic Sub MiddleDown() '中键按下
  mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End SubPublic Sub MiddleUp() '中键弹起
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End SubPublic Sub MoveMouse(xMove As Long, yMove As Long) '移动鼠标
    mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End SubPublic Sub RightClick() '右键单击
    RightDown
    RightUp
End SubPublic Sub RightDown() '右键按下
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End SubPublic Sub RightUp() '右键弹起
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Answer 3

' 捕捉鼠标离开窗体。
' 原理就是这样，什么窗口都行。
' 由于窗体比较特殊（有标题栏），所以我做了点处理。 Option Explicit
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SetCapture Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetCapture Me.hwnd
    If X < 0 Or X > Me.Width Or Y < 0 Or Y > Me.Height - GetSystemMetrics(SM_CYCAPTION) * Screen.TwipsPerPixelY Then
        ReleaseCapture
        Debug.Print "MouseOut"
        
        ' 鼠标离开窗体时的代码
        
    End If
End Sub