讓VB6的MSFlexGrid表格控制項支持鼠標滾輪的代碼

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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

Private Const GWL_WNDPROC   As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A

Public LineNum As Integer

Private m_OldWindowProc As Long

Public CtlWheel As Object

Public Sub HookWheel(ByVal frmHwnd)

    m_OldWindowProc = SetWindowLong(frmHwnd, GWL_WNDPROC, AddressOf pvWindowProc)
End Sub

Public Sub UnHookWheel(ByVal hwnd As Long)
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(hwnd, GWL_WNDPROC, m_OldWindowProc)
  
End Sub

Private Function pvWindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo errH
  
    Select Case wMsg
  
        Case WM_MOUSEWHEEL
            If Not CtlWheel Is Nothing Then
                 If TypeOf CtlWheel Is MSFlexGrid Then
                     With CtlWheel
                  
                             Select Case wParam
                             Case Is > 0
      
                                If CtlWheel.TopRow > 0 Then
                                    CtlWheel.TopRow = CtlWheel.TopRow - LineNum
                                End If
                              
                             Case Else
                             
                                CtlWheel.TopRow = CtlWheel.TopRow + LineNum
                              
                             End Select
                      End With
                  End If
                
           End If
    End Select
  
errH:
  
    pvWindowProc = CallWindowProc(m_OldWindowProc, hwnd, wMsg, wParam, lParam)
End Function

''''''''''''''以下是在窗口中需要調用的語句及函數說明等（也就是用法）'''''''''''''''''''''''''''''''''''''''''''

'Private Sub MSFlexGrid1_GotFocus()

'Set CtlWheel = MSFlexGrid1 '用於設定支持滑鼠滾輪

'End Sub

'Private Sub MSFlexGrid1_LostFocus()

'Set CtlWheel = Nothing '用於設定取消滑鼠滾輪的支持

'End Sub
'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

'UnHookWheel Me.hwnd '卸載滑鼠滾輪的支持

'End Sub

'Private Sub Form_Load()

'HookWheel Me.hwnd '用於支持滑鼠滾輪

'End Sub

但是用這個方法之後，當在vb的環境下運行時，會出現vb意外退出的情況，這個情況是由於主窗體在unload事件中使用了end這個語句來退出程序，因此不應該使用END語句，而應該遍歷所有窗體，逐個卸載，這樣就安全了。