tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： Re: SendInput関数が Vistaで動作しないのですが？
投稿日： 2009/09/18(Fri) 15:50
投稿者： YK
> SendInput関数が Vistaで動作しないのですが？
> （サンプル　139　マウスを指定場所に移動しクリックする。）
> 上記をサンプルで　exeを作成したのですが、Vistaで実行できません。
> XP搭載のＰＣでは、問題なく動作するのですが、
> Vistaではクリックの動作をしないようです。
> 解決方法があるのでしょうか？

こんにちは。
とりあえずVistaで動いたコードです。139を利用しています。
Option Explicit

'マウスを指定場所に移動しクリックする (139)
'         Option Explicit     'SampleNo=139　WindowsXP VB6.0(SP5) 2002.05.11
'マウスカーソルの位置を設定する（P389)
Private Declare Function SetCursorPos Lib "user32" _
    (ByVal x As Long, ByVal y As Long) As Long
'現在のマウスカーソルの位置座標を取得する（P387)
Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long
'位置座標を受け取る構造体
Private Type POINTAPI
        x As Long
        y As Long
End Type
'===============================================================
Private Type KEYBDINPUT
      wVk As Integer
      wScan As Integer
      dwFlags As Long
      time As Long
      dwExtraInfo As Long
End Type

Private Type INPUT_TYPE
      dwType As Long
      xi(0 To 23) As Byte
End Type

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_KEYBOARD = 1
Private Const INPUT_MOUSE = 0

Private Const MOUSE_MOVED = &H1
Private Const MOUSEEVENTF_ABSOLUTE = &H8000& '　absolute move
Private Const MOUSEEVENTF_XDOWN = &H100
Private Const MOUSEEVENTF_XUP = &H200
Private Const MOUSEEVENTF_WHEEL = &H80
Private Const MOUSEEVENTF_LEFTUP = &H4      '左ボタンUP
Private Const MOUSEEVENTF_LEFTDOWN = &H2    '左ボタンDown
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '中央ボタンDown
Private Const MOUSEEVENTF_MIDDLEUP = &H40   '中央ボタンUP
Private Const MOUSEEVENTF_RIGHTDOWN = &H8   '右ボタンDown
Private Const MOUSEEVENTF_RIGHTUP = &H10    '右ボタンUP
'システムを立ち上げてからの経過時間を高精度に取得する(P1002)
Private Declare Function GetSystemMetrics Lib "user32" _
                           (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4       'TitleBar Height
Private Const SM_CXFRAME = 32
Private Const SM_CXSIZEFRAME = SM_CXFRAME
Private Const SM_CYFRAME = 33
Private Const SM_CYSIZEFRAME = SM_CYFRAME

Private Declare Function timeGetTime Lib "winmm.dll" () As Long


Private Sub Command1_Click()
    MsgBox "Commandボタンがクリックされました"
End Sub


Private Sub Command2_Click()
'Command1ボタンをクリック
    Dim x As Long
    Dim y As Long
    
    'Command1のボタンの真ん中の位置を求める
    '横方向
    x = Form1.Left + Command1.Left + (Command1.Width \ 2)
    'フォームの枠の寸法を求める　　　　　　↓
    x = (x \ Screen.TwipsPerPixelX) + GetSystemMetrics(32)
    
    '縦方向
    y = Form1.Top + Command1.Top + (Command1.Height \ 2)
    'タイトルバーの寸法を求める       ↓
    y = y \ Screen.TwipsPerPixelY + GetSystemMetrics(4)
    'Command1の真ん中にマウスポインタを移動
    Call SetCursorPos(x, y)

    Dim MoEvents(1) As Integer
    Dim Xpos(1)     As Long     '0 だから設定は必要ないが宣言は必要
    Dim Ypos(1)     As Long     '0 だから設定は必要ないが宣言は必要
    MoEvents(0) = MOUSEEVENTF_LEFTDOWN              'マウスの左ボタンを押す
    MoEvents(1) = MOUSEEVENTF_LEFTUP                'マウスの左ボタンを離す
    Call sMouseEventSet(2, MoEvents, Xpos, Ypos)    'マウスイベントの実行
End Sub


Private Sub Command3_Click()
'フォームのドラッグの自動化
    Dim x As Long
    Dim y As Long
    y = (Form1.Top \ Screen.TwipsPerPixelY) + GetSystemMetrics(4) / 2
    x = (Form1.Left + Form1.Width / 2) \ Screen.TwipsPerPixelX
    Call SetCursorPos(x, y)

    Dim MoEvents(2) As Integer
    Dim Xpos(2)     As Long
    Dim Ypos(2)     As Long
    MoEvents(0) = MOUSEEVENTF_LEFTDOWN              'マウスの左ボタンを押す
    Xpos(1) = 100: Ypos(1) = 100                    'マウスの移動量
    MoEvents(1) = MOUSE_MOVED                       'マウスの移動
    MoEvents(2) = MOUSEEVENTF_LEFTUP                'マウスの左ボタンを離す
    Call sMouseEventSet(3, MoEvents, Xpos, Ypos)    'マウスイベントの実行
End Sub


Private Sub Command4_Click()
'タイトルバーをダブルクリック
    Dim x As Long
    Dim y As Long
'    y = (Form1.Top + 100) \ Screen.TwipsPerPixelX
    y = (Form1.Top \ Screen.TwipsPerPixelY) + GetSystemMetrics(4) / 2
    x = (Form1.Left + Form1.Width / 2) \ Screen.TwipsPerPixelX
    Debug.Print x, y
    Call SetCursorPos(x, y)
    
    Dim MoEvents(3) As Integer
    Dim Xpos(3)     As Long     '0 だから設定は必要ないが宣言は必要
    Dim Ypos(3)     As Long     '0 だから設定は必要ないが宣言は必要
    MoEvents(0) = MOUSEEVENTF_LEFTDOWN              'マウスの左ボタンを押す
    MoEvents(1) = MOUSEEVENTF_LEFTUP                'マウスの左ボタンを離す
    MoEvents(2) = MOUSEEVENTF_LEFTDOWN              'マウスの左ボタンを押す
    MoEvents(3) = MOUSEEVENTF_LEFTUP                'マウスの左ボタンを離す
    Call sMouseEventSet(4, MoEvents, Xpos, Ypos)    'マウスイベントの実行
End Sub


Private Sub Command5_Click()
'タイトルバーを右クリック
    Dim x As Long
    Dim y As Long
    y = (Form1.Top \ Screen.TwipsPerPixelY) + GetSystemMetrics(4) / 2
    x = (Form1.Left + Form1.Width / 2) \ Screen.TwipsPerPixelX
    Call SetCursorPos(x, y)

    Dim MoEvents(1) As Integer
    Dim Xpos(1)     As Long     '0 だから設定は必要ないが宣言は必要
    Dim Ypos(1)     As Long     '0 だから設定は必要ないが宣言は必要
    Exit Sub
    MoEvents(0) = MOUSEEVENTF_RIGHTDOWN             'マウスの右ボタンを押す
    MoEvents(1) = MOUSEEVENTF_RIGHTUP               'マウスの右ボタンを離す
    Call sMouseEventSet(2, MoEvents, Xpos, Ypos)    'マウスイベントの実行
End Sub


Private Sub Form_Load()
    Form1.Move 0, 0
End Sub


Private Sub Timer1_Timer()
'現在のマウスポインタの座標を取得
    Dim MoP As POINTAPI        '現在のマウスポインタの位置座標
    Call GetCursorPos(MoP)
    Label1.Caption = "現在のマウス座標 X=" & MoP.x & "　Y=" & MoP.y
End Sub


Private Sub sMouseEventSet(nInput As Long, MoEvents() As Integer, _
                                        Xpos() As Long, Ypos() As Long)
    Dim inputevents() As INPUT_TYPE
    Dim mouseevent As MOUSEINPUT
    Dim Count As Integer
    ReDim inputevents(nInput - 1) As INPUT_TYPE
    For Count = 0 To nInput - 1
        With mouseevent
            mouseevent.dx = Xpos(Count)             '水平方向の移動量
            mouseevent.dy = Ypos(Count)             '垂直方向の移動量
            mouseevent.mouseData = 0                '必要としません
            mouseevent.dwFlags = MoEvents(Count)    'マウスイベント
            mouseevent.time = 0                     'デフォルトの設定
            mouseevent.dwExtraInfo = 0              '必要としません
        End With
        inputevents(Count).dwType = INPUT_MOUSE
        CopyMemory inputevents(Count).xi(0), mouseevent, Len(mouseevent)
    Next Count
    Call SendInput(nInput, inputevents(0), Len(inputevents(0)))
End Sub
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。