070101

タイトル	インテリマウスホイールを使う
対象言語	VB5.0以降
動作確認ＯＳ	Windows95,98,NT4.0
使用関数	SetWindowLong CallWindowProc RegisterWindowMessage
改築日	1999/08/11(1999/01/19)
Source Download

インテリマウス　ホイールの回転メッセージを取得します。

サブクラス化でメッセージフックをしますので、VB5.0以降か、OCXを組み込んでください。
Win95,NTでは、インテリマウス用のマウスドライバーが組み込まれている必要があります。
また、NT3.5上での動作テスト、インテリマウス互換のマウスでも使えるかどうかは試していない
ので、宜しければ教えてくださいね。(^^

さて、Win98及び NT4.0(要ドライバー) では標準でインテリマウスがサポートされ、
WM_MOUSEWHEEL メッセージが追加されました。
しかし、95,NT3.5ではユーザー定義メッセージ　”MSWHEEL_ROLLMSG”　を登録して
メッセージIDを取得する必要があります。
しかも、このメッセージIDの値はWindows起動時毎に変わるので、メッセージフックを開始する
までにRegisterWindowMessage API関数を使ってメッセージIDを取得しておく必要があります。

また、Win95と98,NT4.0 とでは、メッセージを受け取った時の wParam値が違うので
要注意です。

Win95,NT3.5の場合、
　　wPalam
　　　　　ホイール回転量(Delta)

Win98,NT4.0の場合、
　　wPalam
　　　　上位16ビット　ホイール回転量(Delta)
　　　　下位16ビット　回転した時に押されている仮想キーコード

　　lParam
　　　　上位16ビット　回転した時のマウスカーソルY座標（Pixcel)
　　　　下位16ビット　回転した時のマウスカーソルX座標（Pixcel)

ホイール回転量
　　値が＋の場合、ユーザーから向かって奥に回転した、
　　逆に－の場合、ユーザーから向かって手前に回転した事になります。
　　値は今の所、120か-120になります。これは、将来、無段階（アナログ）のホイール
　　が出来た時のために予約されているそうです。
　　
仮想キーコード
　　Win98,NT4.0の場合、回転時に押されている仮想キーコードの組み合わせも取得できます。

　　　　MK_LBUTTON 　：マウス左ボタン
　　　　MK_RBUTTON 　：マウス右ボタン
　　　　MK_MBUTTON　：マウス中ボタン
　　　　MK_SHIFT 　　　：SHIFTキー
　　　　MK_CONTROL　：CTRLキー

1. フォームを作成しピクチャボックス(Picture1)内にピクチャボックス(Picture2)を配置し、
　垂直スクロール（VScroll1）を貼り付けてください。

Option Explicit

Private Sub Form_Load()

　　Picture2.Print "インテリマウスホイールのテストです。"
　　Picture2.Print "ホイールを上下に動かしてスクロール"
　　Picture2.Print "するか試してみてください。"
　　Picture2.Print "また、Win98やNT4.0なら、Shiftキーや"
　　Picture2.Print "Ctrlキー、マウスボタンを押しながら"
　　Picture2.Print "ホイールを回してみてください。"
　　Picture2.Print ""
　　Picture2.Print ""
　　Picture2.Print ""
　　Picture2.Print "ちゃんとスクロールしました？ (^_^)v"

　　Me!VScroll1.Max = 200

　　'Win95,NT3.5の場合、ユーザー定義メッセージ "MSWHEEL_ROLLMSG"のメッセージＩＤを取得する。
　　'この値はWindows起動毎に値が変わるので、必ずプログラム起動前にチェックする
　　WM_MOUSEWHEEL95 = RegisterWindowMessage("MSWHEEL_ROLLMSG")

　　Call Y_StartHook(Me.hWnd) 'メッセージフックを開始する

End Sub

Private Sub Form_Unload(Cancel As Integer)

　　Call Y_StopHook 'フックを終了する

End Sub

Private Sub VScroll1_Change()
　　Picture2.Top = -VScroll1.Value * 10

End Sub

2.モジュールウインドウを作成し、下のソースを入力してください。

Option Explicit

'ウインドウに関連する32ビット値を変更する
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = -4 'ウインドウプロシージャのアドレスを変更する

'メッセージパラメータをメッセージ処理関数に渡す
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

'ユーザー定義メッセージをシステムに登録する
Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long

Public Const WM_MOUSEWHEEL = &H20A 'ホイールメッセージ（Win98,NT4.0以降）
Public Const MK_LBUTTON = &H1 'マウス左ボタン
Public Const MK_RBUTTON = &H2 'マウス右ボタン
Public Const MK_MBUTTON = &H10 'マウス中ボタン
Public Const MK_SHIFT = &H4 'SHIFTキー
Public Const MK_CONTROL = &H8 'CTRLキー

Public WM_MOUSEWHEEL95 As Long 'Win95,NT3.5の場合、ユーザー定義"MSWHEEL_ROLLMSG"のメッセージID
Public OldWndProc As Long '元のウィンドウプロシージャのアドレス
Public HookWnd As Long 'フックするフォームのウインドウハンドル

Public Sub Y_StartHook(hWnd As Long)
'***********************************************************
'機能 : フォームをサブクラス化し、フックを開始する
'***********************************************************

　　If OldWndProc = 0 Then
　　　　OldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Y_WindowProc)
　　　　If OldWndProc <> 0 Then
　　　　　　HookWnd = hWnd
　　　　End If
　　End If

End Sub

Public Sub Y_StopHook()
'***********************************************************
'機能 : フォームのウィンドウ・プロシージャを元に戻し、
'　　　　フックを終了する
'備考　: サブクラス化している状態でフォームを閉じる場合は、
'　　　　必ずこの処理を実行して下さい。
'***********************************************************

　　If OldWndProc <> 0 Then
　　　　Call SetWindowLong(HookWnd, GWL_WNDPROC, OldWndProc)
　　　　OldWndProc = 0
　　End If

End Sub

Public Function Y_WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'***********************************************************
'機能 : 自作コールバックウインドウプロシージャ
'引数　: hwnd =取得したウインドウハンドル
'　　　　uMsg = 取得したメッセージ
'　　　　wParam =取得したメッセージの wPalam
'　　　　lParam =取得したメッセージの lPalam
'戻り値: メッセージ処理の戻り値
'備考　: 本来受け取るウインドウプロシージャにメッセージを渡す
'　　　　前にメッセージを横取りして先に必要な処理します。
'***********************************************************

　　Dim i As Integer
　　Dim xPos As Integer
　　Dim yPos As Integer
　　Dim zDelta As Integer
　　Dim fwKeys As Integer

　　If uMsg = WM_MOUSEWHEEL Or uMsg = WM_MOUSEWHEEL95 Then 'ホイールのメッセージ

　　　　If uMsg = WM_MOUSEWHEEL Then 'Win98,NT4.0の場合
　　　　　　zDelta = CInt(wParam / 2 ^ 16) 'wParamのHIWORDは移動方向＆移動量
　　　　　　fwKeys = Val("&H" + Right$(Hex$(wParam), 4)) 'wParamのLOWORDは同時に押された仮想キー
　　　　Else 'Win95,NT3.5の場合
　　　　　　zDelta = wParam 'wParamは移動方向＆移動量
　　　　　　fwKeys = 0 'Win95,NT3.5は仮想キーコードは入ってきません
　　　　End If

　　　　yPos = CInt(lParam / 2 ^ 16) 'lParamのHIWORDはマウス座標Y
　　　　xPos = Val("&H" + Right$(Hex$(lParam), 4)) 'lParamのLOWORDはマウス座標X

　　　　'ホイール回転時の処理
　　　　i = Form1!VScroll1.Value
　　　　If zDelta > 0 Then 'zDeltaの値が＋の場合奥に回転した
　　　　　　i = i - 20
　　　　Else 'zDeltaの値が－の場合手前に回転した
　　　　　　i = i + 20
　　　　End If
　　　　If i < Form1!VScroll1.Min Then
　　　　　　i = Form1!VScroll1.Min
　　　　End If
　　　　If i > Form1!VScroll1.Max Then
　　　　　　i = Form1!VScroll1.Max
　　　　End If
　　　　'スクロールバーを動かす
　　　　Form1!VScroll1.Value = i

　　　　Form1!Label1 = vbNullString

　　　　'Win98,NT4.0の場合、同時に押されたキーを判定する。
　　　　If (fwKeys And MK_LBUTTON) <> 0 Then
　　　　　　Form1!Label1 = Form1!Label1 & "LeftButton "
　　　　End If
　　　　If (fwKeys And MK_RBUTTON) <> 0 Then
　　　　　　Form1!Label1 = Form1!Label1 & "RightButton "
　　　　End If
　　　　If (fwKeys And MK_MBUTTON) <> 0 Then
　　　　　　Form1!Label1 = Form1!Label1 & "MiddleButton "
　　　　End If
　　　　If (fwKeys And MK_SHIFT) <> 0 Then
　　　　　　Form1!Label1 = Form1!Label1 & "ShiftKey "
　　　　End If
　　　　If (fwKeys And MK_CONTROL) <> 0 Then
　　　　　　Form1!Label1 = Form1!Label1 & "CtrlKey "
　　　　End If
'マウスポインタの位置
　　　　Form1!Label1 = Form1!Label1 & "Pos = " & xPos & " , " & yPos

　　End If

'本来のウィンドウ・プロシージャを呼び出す
　　Y_WindowProc = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)

End Function