WM_MOUSEWHEEL 윈도우 메세지를 사용한 휠 버튼 사용

vb6에서 메세지를 얻기 위해서는 후킹을 사용해야 한다.
그중 가장 간단한 방법이 서브 클래싱을 사용한다.
서브 클래싱은, 지정된 윈도우에 할당된 원래의 윈도우 프로시저(윈도우에 전달되는 모든 메시지를 처리하는 윈도우에 할당된 프로시저를 말한다)를 사용자가 지정한 프로시저로 바꾸어 주면 된다. 그러면 윈도우에 전달된 메세지는 사용자가 지정한 프로시저로 통과 되므로 윈도우에 전달되는 윈도우 메세지를 확인할수 있다.

윈도우 프로시저 형식은 다음과 같다.
프로시저명 (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
인수는
hWnd ━ 윈도우 핸들
Msg ━ 전달된 윈도우 메세지
wParam ━ 메세지와 같이 전달된 wParam값
lParam ━ 메세지와 같이 전달된 lParam값
이다.

다음은 마우스의 휠 버튼이 움직이게 되면 해당 윈도우에 WM_MOUSEWHEEL 윈도우 메세지가 전달된다.
WM_MOUSEWHEEL와 함께 같이 전달되는 wParam과 lPram값은 다음과 같다.
● 선언
WM_MOUSEWHEEL = &H20A
 
● wparam
상위 워드 : 휠이 얼마나 움직였는지를 나타낸다. 이값은 120으로 나누어 나머지가 0인 값이다. 나누어진 값이 양수면 휠이 앞쪽으로 회전된것이다. 음수이면 뒤쪽으로 회전된것이다.
하위 워드 : 어떤 키가 눌렸는지를 나타낸다.

● lparam
상위 워드는 화면을 상대로한 X좌표
하위 워드는 화면을 상대로한 Y좌표

다음은 소스이다. 폼에 수직이나 수평 스크롤바를 하나 올린다.

폼 모듈
' 서브클래싱을 사용한 휠버튼 후킹
Option Explicit

Private Sub Form_Activate()
    vscFeelTest.SetFocus
End Sub

Private Sub Form_Load()
    vscFeelTest.Max = 100
    Call WheelHook(vscFeelTest.hWnd, ObjPtr(vscFeelTest))
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call WheelUnHook(vscFeelTest.hWnd)
End Sub

Public Sub MouseWheel(ByVal MoveValue As Long)
    Dim lngMove As Long
   
    MoveValue = MoveValue * -1
    With vscFeelTest
        lngMove = .Value + MoveValue
        If lngMove > .Max Then lngMove = .Max
        If lngMove < .Min Then lngMove = .Min
        .Value = lngMove
    End With
End Sub

일반 모듈
Option Explicit

Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const StrPrevWndProc As String = "PrevWndProc"
Private Const StrObj As String = "Obj"
Private Const GWL_WNDPROC = -4
Private Const WHEEL_DELTA = 120
Private Const WM_MOUSEWHEEL = &H20A

Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Rotation As Integer ' 회전 방향과 회전수
    Dim lngObj As Long
    Dim obj As Object

    Select Case Lmsg ' 메세지는
        Case WM_MOUSEWHEEL
            CopyMemory VarPtr(Rotation), VarPtr(wParam) + 2, 2 ' 회전수를 얻는다
            Rotation = Rotation / WHEEL_DELTA
            If Not Rotation = 0 Then ' 휠 버튼이 돌아가다면
                lngObj = GetProp(Lwnd, StrObj)
                CopyMemory VarPtr(obj), VarPtr(lngObj), 4
                obj.Parent.MouseWheel Rotation
                lngObj = 0
                CopyMemory VarPtr(obj), VarPtr(lngObj), 4
            End If
    End Select
    WindowProc = CallWindowProc(GetProp(Lwnd, "PrevWndProc"), Lwnd, Lmsg, wParam, lParam)
End Function

Public Sub WheelHook(ByVal hWnd As Long, ByVal obj As Long) ' 서브 클래싱 시작
    SetProp hWnd, StrPrevWndProc, SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) ' 개체의 윈도우 프로시저 이전 핸들
    SetProp hWnd, StrObj, obj ' 개체 주소
End Sub

Public Sub WheelUnHook(ByVal hWnd As Long) ' 서브 클래싱 이전 상태로
    SetWindowLong hWnd, GWL_WNDPROC, RemoveProp(hWnd, StrPrevWndProc)
    RemoveProp hWnd, StrObj
End Sub