APIでマウスボタンの状態を取得するには？ (ID：73964)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

フックとはメッセージを捕まえることです。
下記にコードを書きましたので参考にして下さい

>AddressOf演算子を使っているのでVB5.0以上出ないと実行できません
>サンプルではForm1のメッセージだけをフックしています。
>終了する時は■ボタンで終了しないで×ボタンで終了して下さい。

>Form1のコード

Private Sub Form_Load()
'Widowsメッセージをフックします
  Address = SetWindowLong(Form1.hWnd, GWL_WNDPROC, AddressOf MsgProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Call SetWindowLong(hWnd, GWL_WNDPROC, Address)
End Sub

>標準モジュール

'-------------------------------------
'ウインドウに関する情報を設定するAPI関数
'-------------------------------------

'hWnd：ウインドウのハンドル
 'nIndex：定数（GWL_××参照）
 'dwNewLong：設定する32ビット値
 
 '戻り値：直前のウインドウプロシージャのアドレス

Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'---------------------------------------------
'Windowsメッセージをウインドウプロシージャに渡す
'---------------------------------------------
 
 'lpPrevWndFunc：ウインドウ関数へのポインタ
 'hWnd：ウインドウのハンドル
 'Msg：メッセージ
 'wParam：パラメータ
 'lParam：パラメータ

Public Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'----
'定数
'----

Public Const WM_MOUSEMOVE = &H200      'マウスが移動した
Public Const WM_LBUTTONDOWN = &H201    'マウス左ボタンを押した
Public Const WM_LBUTTONUP = &H202      'マウス左ボタンが解放された
Public Const WM_LBUTTONDBLCLK = &H203   'マウス左ボタンがダブルクリックされた
Public Const WM_RBUTTONDOWN = &H204     'マウス右ボタンを押した
Public Const WM_RBUTTONUP = &H205       'マウス右ボタンが解放された
Public Const WM_RBUTTONDBLCLK = &H206   'マウス右ボタンがダブルクリックされた
Public Const WM_MBUTTONDOWN = &H207     'マウス中央ボタンを押した
Public Const WM_MBUTTONUP = &H208       'マウス中央ボタンが解放された
Public Const WM_MBUTTONDBLCLK = &H209   'マウス中央ボタンがダブルクリックされた
Public Const GWL_WNDPROC = (-4)         'ウインドウ関数

'-----
'変数
'-----

Public Address As Long    'ウインドウプロシージャのアドレス

'---------------------------------------------------------
'■関数名  MsgProc
'■用途    メッセージをフックする
'■引数    nHandle： フック対象のウインドウハンドル
'          nMsg：     Windowsのメッセージ
'          wParam：   メニューID
'          lParam：  パラメータ
'----------------------------------------------------------

Public Function MsgProc(ByVal nHandle As Long, ByVal nMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Select Case nMsg
  
    Case WM_LBUTTONDOWN
       MsgBox ("マウス左ボタンを押しました")
 
    Case WM_RBUTTONDOWN
       MsgBox ("マウス右ボタンを押しました")
       
  End Select
  
  MsgProc = CallWindowProc(Address, nHandle, nMsg, wParam, lParam)

End Function

←解決時は質問者本人がここをチェックしてください。

戻る