４．マウス操作の自動化(SendInput 関数使用例)

１．マウス操作の自動化(SendInput 関数使用例) ２．　 ３．　 ４．　 ５．　 ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6) Option　：[Option Explicit] 参照設定：追加なし 使用 API：SendInput / CopyMemory / GetWindowRect / GetSystemMetrics / その他　：このサンプルは、Win32 API を使用しておりますので、ある程度 Win32 API が理解できる方がお使い下さい。 　　　　：

１．マウス操作の自動化(SendInput 関数使用例)

画面の設定は下図のようにして下さい。(Command2=実行ボタン) 　図１．サンプル実行図及びコントロール配置図 　 Option Explicit　 'SampleNo=139　　�A 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)　　　　　　　'マウスの移動量を計算(絶対位置) 　 '下記の2行をコメントにすると戻ってきません。 　 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

２．

３．

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

マウスイベントをシミュレートする　　コントロールの中央のスクリーン座標を求める　　解像度を取得して、マウスの移動量の補正値を計算