Option Strict Off
Option Explicit On
Friend Class frmMouseScan
Inherits System.Windows.Forms.Form
'位置座標を受け取る構造体
Public Structure POINTAPI
Dim X As Integer
Dim Y As Integer
End Structure
Public Structure Msg
Dim hWnd As Integer
Dim message As Integer
Dim wParam As Integer
Dim lParam As Integer
Dim time As Integer
Dim pt As POINTAPI
End Structure
'------------------------------------------------------------------
' キー/マウスの状態取得
'------------------------------------------------------------------
Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Integer) As Integer
'関数呼び出し時にマウス／キーが押されているかどうか、また、
' 前回の GetAsyncKeyState 関数呼び出し以降にマウス／キーが押されたかどうかを判定。
'
'入力パラメータ
' vKey最大 256 とおりの仮想キーコードのいずれかを指定
'
'戻り値
' 関数が成功すると、前回の GetAsyncKeyState 関数呼び出し以降にマウス／キーが押されたかどうか、
' およびマウス／キーが現在押されているかどうかを示す値が返る。
' 最上位ビットがセットされた時
' 現在そのマウス／キーが押されていることを示し、
' 最下位ビットがセットされた時
' 前回の GetAsyncKeyState 関数呼び出し以降にそのマウス／キーが押されたことを示す。
Dim MyMode As String
Const KEY_CNT As Short = &H10s 'スキャンイベント個数
Const MOVE_INTERVAL As Short = 20 'マウス取得最小時間
Dim KeyList(KEY_CNT) As String 'キー名称一覧
Dim KeyState(KEY_CNT, 2) As Integer 'キー状態 0:前回 1:今回 2:変化
Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles 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 Integer '前回のイベント発生時刻
Dim Pt_Old As POINTAPI '前回のマウス位置
Dim Rc As Integer
MyMode = "Go"
Command1.Enabled = False
Command2.Enabled = True
List1.Items.Clear()
Call EventsAnlyz(tMsg, True) '初期状態読み込み
Time_Old = System.Environment.TickCount() '時間記憶
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 = VB6.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 = VB6.Format(tMsg.time - Time_Old, "@@@@@") '時間5桁
MousePos = VB6.Format(tMsg.pt.X, "@@@@") & "," & VB6.Format(tMsg.pt.Y, "@@@") 'マウス座標 4桁,3桁
With List1
.Items.Add(EventTime & vbTab & MousePos & vbTab & EventName & vbTab & UpDown & vbTab & KeyCode & vbTab & KeyStr)
.SelectedIndex = .Items.Count - 1 '最終行を選択
End With
Time_Old = tMsg.time '時間記憶
Pt_Old.X = tMsg.pt.X 'マウス位置記憶
Pt_Old.Y = tMsg.pt.Y
End If
System.Threading.Thread.Sleep(1)
System.Windows.Forms.Application.DoEvents()
Loop While (MyMode = "Go")
End Sub
Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
MyMode = "" '中止
Command2.Enabled = False
Command1.Enabled = True
End Sub
Private Function EventsAnlyz(ByRef tMsg As Msg, Optional ByRef AllScan As Boolean = False) As Integer
'
' イベントスキャン
' 変化を検知したらスキャンを中止
'
Dim Code As Integer 'キー（or ボタン）コード
Dim Rc As Integer
For Code = 1 To KEY_CNT
If KeyList(Code) <> "" Then 'スキャン対象？
Rc = GetAsyncKeyState(Code)
If (Rc And &H8001s) <> 0 Then
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
tMsg.pt.X = System.Windows.Forms.Cursor.Position.X
tMsg.pt.Y = System.Windows.Forms.Cursor.Position.X
tMsg.time = System.Environment.TickCount '時間
End Function
Private Sub frmMouseScan_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Command1.Text = "Go"
Command2.Text = "Stop"
Label1.Text = "マウスの動きとクリックをスキャンします。右の Go をクリック後、適当にマウスを動かし、クリックして見て下さい。"
List1.Font = VB6.FontChangeName(List1.Font, "ＭＳ ゴシック")
List1.Font = VB6.FontChangeSize(List1.Font, 12)
Me.TopMost = True '最前面表示
KeyList(&H1s) = "LeftButton"
KeyList(&H2s) = "RightButton"
KeyList(&H4s) = "MiddleButton"
End Sub
Private Sub frmMouseScan_FormClosed(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
End
End Sub
End Class