Option Explicit

Dim MyMode As String

Const KEY_CNT = &H10        'スキャンイベント個数
Const MOVE_INTERVAL = 20    'マウス取得最小時間

Dim KeyList(KEY_CNT) As String      'キー名称一覧
Dim KeyState(KEY_CNT, 2) As Long    'キー状態　0:前回　1:今回　2:変化




Private Sub Command1_Click()

    Dim tMsg As Msg         'メッセージパラメータ
    
    '表示文字
    Dim EventName As String 'イベント名
    Dim EventTime As String '前回のイベント発生からの時間
    Dim MousePos As String  'マウス座標
    Dim UpDown As String    'Up　Down
    Dim KeyCode As String   'キーコード16進
    Dim KeyStr As String    'キー文字
    
    Dim Time_Old As Long    '前回のイベント発生時刻
    Dim Pt_Old As POINTAPI  '前回のマウス位置

    Dim Rc As Long

    MyMode = "Go"
    Command1.Enabled = False
    Command2.Enabled = True
    
    List1.Clear
    
    Call EventsAnlyz(tMsg, True) '初期状態読み込み
    Time_Old = GetTickCount()    '時間記憶
    Pt_Old.X = tMsg.pt.X         'マウス位置記憶
    Pt_Old.Y = tMsg.pt.Y
    
    Do
        
        '------------------------------------------------
        Rc = EventsAnlyz(tMsg)   'イベントスキャン
        '------------------------------------------------            
        UpDown = ""
        KeyCode = ""
        KeyStr = ""

        If Rc = 0 Then  'クリック無し≒マウス移動

            '最小取得時間以上かつ移動が有った場合のみ取得
            If (tMsg.time - Time_Old) >= MOVE_INTERVAL And _
                Pt_Old.X <> tMsg.pt.X And Pt_Old.Y <> tMsg.pt.Y Then
                EventName = "Move"
            Else
                EventName = ""
            End If

        Else    'クリック　Down or Up
            
            EventName = "Click"
            KeyCode = Format(Hex(tMsg.message), "00")            'ボタン　16進
            KeyStr = KeyList(tMsg.message)                       'ボタン名
            If Rc = -1 Then 'Down
                UpDown = "Down"
            ElseIf Rc = 1 Then 'Up
                UpDown = "Up  "
            End If
        
        End If
        
        If EventName <> "" Then
            EventTime = Format(tMsg.time - Time_Old, "@@@@@")   '時間5桁
            MousePos = Format(tMsg.pt.X, "@@@@") & "," & Format(tMsg.pt.Y, "@@@")   'マウス座標　4桁,3桁
            With List1
                .AddItem EventTime & vbTab & _
                        MousePos & vbTab & _
                        EventName & vbTab & _
                        UpDown & vbTab & _
                        KeyCode & vbTab & _
                        KeyStr
                .ListIndex = .ListCount - 1 '最終行を選択
            End With
            
            Time_Old = tMsg.time    '時間記憶
            Pt_Old.X = tMsg.pt.X    'マウス位置記憶
            Pt_Old.Y = tMsg.pt.Y
        
        End If
        Sleep 1
        DoEvents
        
    Loop While (MyMode = "Go")

End Sub

Private Sub Command2_Click()
    MyMode = "" '中止
    Command2.Enabled = False
    Command1.Enabled = True
End Sub


Private Function EventsAnlyz(ByRef tMsg As Msg, Optional AllScan As Boolean) As Long
'
' イベントスキャン
'　変化を検知したらスキャンを中止
'
    Dim pt As POINTAPI  'マウスポインタ座標
    Dim Code As Long    'キー（or ボタン）コード

    Dim Rc As Long
    
    For Code = 1 To KEY_CNT
    
        If KeyList(Code) <> "" Then    'スキャン対象？
            Rc = GetAsyncKeyState(Code)
            If (Rc And &H8001) <> 0 Then　'下位2バイトの最上位ビット
                KeyState(Code, 1) = 1  '今回、押されている
            Else
                KeyState(Code, 1) = 0  '今回、押されていない
            End If
            
            '--------------------
            ' 前回の状態と比較
            '--------------------
            KeyState(Code, 2) = KeyState(Code, 0) - KeyState(Code, 1)   '変化
            KeyState(Code, 0) = KeyState(Code, 1) '現在の状態を保存
            
            If KeyState(Code, 2) <> 0 Then
                EventsAnlyz = KeyState(Code, 2)
                tMsg.message = Code
                If AllScan = False Then Exit For  'スキャン中止
            End If
        End If
    
    Next Code
    
    Call GetCursorPos(pt)
    tMsg.pt.X = pt.X
    tMsg.pt.Y = pt.Y
    tMsg.time = GetTickCount()  '時間


    
End Function




Private Sub Form_Load()

    Command1.Caption = "Go"
    Command2.Caption = "Stop"
    Label1.Caption = "マウスの動きとクリックをスキャンします。右の Go をクリック後、適当にマウスを動かし、クリックして見て下さい。"
    List1.FontName = "ＭＳ ゴシック"
    List1.FontSize = 12

    Call DispTop(Me.hWnd, HWND_TOPMOST) '最前面表示


    KeyList(&H1) = "LeftButton"
    KeyList(&H2) = "RightButton"
    KeyList(&H4) = "MiddleButton"


End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Public Function DispTop(hWnd As Long, Sw As Long) As Long
    '最前面に表示
    DispTop = SetWindowPos(hWnd, _
                         Sw, _
                         0, _
                         0, _
                         0, _
                         0, _
                         SWP_NOMOVE Or SWP_NOSIZE)
End Function