ひできちの楽天ブログ

 ’----------------------------------------------------------------
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Public Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, _
ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Public Const GWL_WNDPROC As Long = -4
Public Const WM_MOUSEWHEEL As Long = &H20A

Public OldProc As LongPtr
Public UFhWnd As LongPtr

Public Function WindowProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

If uMsg = WM_MOUSEWHEEL Then
If UserForm1.ListBox1.ListIndex < UserForm1.ListBox1.ListCount - 1 And wParam < 0 Then
UserForm1.ListBox1.ListIndex = UserForm1.ListBox1.ListIndex + 1
ElseIf UserForm1.ListBox1.ListIndex > 0 And wParam > 0 Then
UserForm1.ListBox1.ListIndex = UserForm1.ListBox1.ListIndex - 1
End If
End If

WindowProc = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam)
End Function
 

 ’----------------------------------------------------------------
Private Sub UserForm_Initialize()
UFhWnd = FindWindow("ThunderDFrame", Me.Caption)
OldProc = SetWindowLongPtr(UFhWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 

 ’----------------------------------------------------------------
Private Sub UserForm_Terminate()
SetWindowLongPtr UFhWnd, GWL_WNDPROC, OldProc
End Sub