マウス操作の自動化(SendInput 関数使用例)
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
マウス操作の自動化(SendInput 関数使用例)　(139)
     　画面の設定は下図のようにして下さい。(Command2＝実行ボタン)
　　　　　　　　

Option Explicit　 'SampleNo=139　WindowsXP/Vista VB6.0(SP6)　② 2009.12.20
'--------------------------------------------------------------------------
'INPUT 構造体
Private Type INPUT_TYPE
　　　dwType As Long
　　　xi(0 To 23) As Byte
End Type

'MOUSEINPUT 構造体
Private Type MOUSEINPUT
　　　dX As Long
　　　dY As Long
　　　mouseData As Long
　　　dwFlags As Long
　　　time As Long
　　　dwExtraInfo As Long
End Type

'キーストローク、マウスの動き、ボタンのクリックなどを合成します。
Private Declare Function SendInput Lib "user32.dll" ( _
　 ByVal nInputs As Long, pInputs As INPUT_TYPE, _
　 ByVal cbsize As Long) As Long
'--------------------------------------------------------------------------
'メモリブロックをコピーする(P1008)
Private Declare Sub CopyMemory Lib "kernel32.dll" _
　 Alias "RtlMoveMemory" (Destination As Any, Source As Any, _
　 ByVal Length As Long)
Private Const INPUT_MOUSE As Long = 0
Private Const MOUSE_MOVED As Long = &H1　　　　　　　 'マウスを移動する
Private Const MOUSEEVENTF_ABSOLUTE As Long = &H8000&　'移動時、絶対座標を指定
Private Const MOUSEEVENTF_XDOWN As Long = &H100　　　 'X ボタンDown
Private Const MOUSEEVENTF_XUP As Long = &H200　　　　 'X ボタンUP
Private Const MOUSEEVENTF_WHEEL As Long = &H80　　　　'ホイールが回転したことを示す
Private Const MOUSEEVENTF_LEFTUP As Long = &H4　　　　'左ボタンUP
Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2　　　'左ボタンDown
Private Const MOUSEEVENTF_MIDDLEDOWN As Long = &H20　 '中央ボタンDown
Private Const MOUSEEVENTF_MIDDLEUP As Long = &H40　　 '中央ボタンUP
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8　　 '右ボタンDown
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10　　　'右ボタンUP
'マウス操作を設定する為の独自構造体
Private Type MOEVENTS
　 mx　 As Long
　 my　 As Long
　 mFrg As Long
End Type
'マウス位置用の POINTAPI 構造体
Private Type POINTAPI
　 x As Long
　 y As Long
End Type
'--------------------------------------------------------------------------
'コマンドボタン等のスクリーン座標を取得する為の物
'矩形を示す RECT 構造体(P689)
Private Type RECT
　 Left　 As Long
　 Top　　As Long
　 Right　As Long
　 Bottom As Long
End Type
'ウィンドウのサイズを取得する(91)
Private Declare Function GetWindowRect Lib "user32" ( _
　 ByVal hwnd As Long, lpRect As RECT) As Long
'--------------------------------------------------------------------------
'ディスプレイ上のウィンドウアイテムのサイズを取得する(919)
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
　 ByVal nIndex As Integer) As Integer
Private Const SM_CYCAPTION = 4　 'キャプションバーの高さ
Private Const SM_CXFRAME = 32　　'サイズ可変ウィンドウの境界線のX方向の幅
Private Const SM_CYFRAME = 33　　'　 同、Y方向の幅
Private Const SM_CYMENU = 15　　 'メニューバーの行の高さ
Private Const SM_CXSCREEN = 0　　'ディスプレイの幅
Private Const SM_CYSCREEN = 1　　'ディスプレイの高さ
'--------------------------------------------------------------------------

Private Sub Command2_Click()
'Button1 の中央に移動し、クリックし、元の位置に戻る
　 Dim mPos As POINTAPI, MEs() As MOEVENTS
　 '--------------- 基本操作部分 ---------------
　 mPos = GetMiddleCenter(Command1)　　'コマンドボタンのスクリーン座標を取得
　 Call MouMovedPos(mPos)　　　　　　　'マウスの移動量を計算(絶対位置)
　 ReDim Preserve MEs(2) As MOEVENTS　 'マウス操作を設定する為の構造体
　 MEs(0).mx = mPos.x: MEs(0).my = mPos.y　　　　　　 'マウスカーソルの移動先
　 MEs(0).mFrg = MOUSE_MOVED Or MOUSEEVENTF_ABSOLUTE　'マウスを指定位置へ移動
　 MEs(1).mFrg = MOUSEEVENTF_LEFTDOWN　　　　　　　　 'マウスの左ボタンを押す
　 MEs(2).mFrg = MOUSEEVENTF_LEFTUP　　　　　　　　　 'マウスの左ボタンを離す
　 '--------------- 追加操作部分 ---------------
　 mPos = GetMiddleCenter(Command2)　　'コマンドボタンのスクリーン座標を取得
　 Call MouMovedPos(mPos)　　　　　　　'マウスの移動量を計算(絶対位置)
　 '下記の２行をコメントにすると戻ってきません。
　 ReDim Preserve MEs(3)　　　　　　　 'コードの使い回しを容易にする為
　 MEs(3).mx = mPos.x: MEs(3).my = mPos.y　　　　　　 'マウスカーソルの移動先
　 MEs(3).mFrg = MOUSE_MOVED Or MOUSEEVENTF_ABSOLUTE　'マウスを指定位置へ移動
　 '--------------------------------------------
　 Call SedMouseInput(MEs)　　　　　'関数の実行
End Sub

Private Function SedMouseInput(ByRef MEs() As MOEVENTS) As Integer
'自作関数(SedMouseInput)の実行部分
　 Dim nInput As Integer
　 Dim inputevents() As INPUT_TYPE
　 Dim mouseevent As MOUSEINPUT
　 nInput = UBound(MEs)
　 Dim i As Integer
　 ReDim inputevents(nInput) As INPUT_TYPE
　 For i = 0 To nInput
　　　With mouseevent
　　　　 mouseevent.dX = MEs(i).mx　　　　　 '水平方向の移動量
　　　　 mouseevent.dY = MEs(i).my　　　　　 '垂直方向の移動量
　　　　 mouseevent.mouseData = 0　　　　　　'必要としません
　　　　 mouseevent.dwFlags = MEs(i).mFrg　　'マウスイベント
　　　　 mouseevent.time = 0　　　　　　　　 'デフォルトの設定
　　　　 mouseevent.dwExtraInfo = 0　　　　　'必要としません
　　　End With
　　　inputevents(i).dwType = INPUT_MOUSE
　　　CopyMemory inputevents(i).xi(0), mouseevent, Len(mouseevent)
　 Next i
　 '関数の実行(連続でマウスの操作を実施）個々のマウスの操作の間に割り込みが入らない。
　 SedMouseInput = SendInput(nInput + 1, inputevents(0), Len(inputevents(0)))
End Function

Private Function GetMiddleCenter(ByVal ctl As Control) As POINTAPI
'コントロールの中央の絶対座標(スクリーン座標)を求める
　 Dim udtRect As RECT
　 'コマンドボタンのスクリーン座標を取得
　 GetWindowRect ctl.hwnd, udtRect
　 GetMiddleCenter.x = udtRect.Left + ((udtRect.Right - udtRect.Left) \ 2)
　 GetMiddleCenter.y = udtRect.Top + ((udtRect.Bottom - udtRect.Top) \ 2)
End Function

Private Sub MouMovedPos(ByRef pos As POINTAPI)
'実際にマウスを移動させる為の補正値を求める
　 '画面の解像度を取得
　 Dim smx As Integer
　 Dim smy As Integer
　 '画面解像度の取得
　 smx = GetSystemMetrics(SM_CXSCREEN)
　 smy = GetSystemMetrics(SM_CYSCREEN)
　 'マウスの移動量を計算(絶対位置)
　 pos.x = pos.x * (65535 / smx)
　 pos.y = pos.y * (65535 / smy)
End Sub

Private Sub Command1_Click()
　 MsgBox "Commandボタンがクリックされました"
End Sub
マウスのクリックをプログラム上から実施したい場合等に使って下さい。
mouse_event 関数を使った方法より、少し複雑ですが、動作の途中で割り込まれないのでこちらの方が、より安全かと思います。別途　[キーストロークをシミュレートする]　も参考にして下さい。　
又、別途　mouse_event 関数　を使った方法も紹介しております。

※ ここでは、マウスの位置設定やCommand ボタンのクリック等が目的ではないので簡易的に設定しておりますので、実使用では目的に合った設定・使い方をして下さい。



2009/09/20 修正