'自前のウィンドウプロシージャ
Public Function MainFormWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hWndClient As Long
Dim nKeys As Long
Dim nDelta As Long
Dim nX As Long
Dim nY As Long
Dim sbiInfo As SCROLLINFO
'Debug.Print Hex(hwnd), Hex(uMsg), Hex(wParam), Hex(lParam) 'すべてのメッセージを表示(結構楽しい(^_^))
On Error GoTo ErrorHandle
Select Case uMsg
Case WM_MOUSEWHEEL
Debug.Print "WM_MOUSEWHEEL"
nKeys = LOWORD(wParam)
nDelta = HIWORD(wParam)
nX = LOWORD(lParam)
nY = HIWORD(lParam)
hWndClient = FindWindowEx(hWnd, 0, "MDIClient", vbNullString)
If hWndClient <> 0 Then
sbiInfo.cbSize = LenB(sbiInfo)
sbiInfo.fMask = SIF_ALL
If 0 <> GetScrollInfo(hWndClient, SB_VERT, sbiInfo) Then
Call SendMessageByNum(hWndClient, WM_VSCROLL, IIf(nDelta > 0, SB_LINEUP, SB_LINEDOWN), 0)
End If
Else
Debug.Print "hWndClient Is NULL"
End If
End Select
'デフォルトのウィンドウプロシージャを呼び出す
MainFormWindowProc = CallWindowProc(lngDefaultProc, hWnd, uMsg, wParam, lParam)
Exit Function
ErrorHandle:
Debug.Print Err.Number & " : " & Err.Description
Resume Next
End Function
|