让VB应用程序的控件支持鼠标滚轮滚屏

  以下代码写在模块里面  
  Public   Const   GWL_WNDPROC   =   (-4)  
  Public   Const   WM_COMMAND   =   &H111  
  Public   Const   WM_MBUTTONDOWN   =   &H207  
  Public   Const   WM_MBUTTONUP   =   &H208  
  Public   Const   WM_MOUSEWHEEL   =   &H20A  
   
  Public   Oldwinproc   As   Long  
  Public   Declare   Function   SetWindowLong   Lib   "user32"   Alias   "SetWindowLongA"   (ByVal   hWnd   As   Long,   _  
    ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long  
   
  Public   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  
   
  Public   Declare   Function   GetWindowLong   Lib   "user32"   Alias   "GetWindowLongA"   (ByVal   hWnd   As   Long,   _  
    ByVal   nIndex   As   Long)   As   Long  
   
  Public   Function   FlexScroll(ByVal   hWnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long  
  '支持滚轮的滚动   Yu   2004-5-10   15:33  
                    Select   Case   wMsg  
                                       
                                  Case   WM_MOUSEWHEEL  
                                             
                                          Select   Case   wParam  
   
                                                        Case   -7864320     '向下滚  
                                                                  SendKeys   "{PGDN}"  
   
                                                        Case   7864320       '向上滚  
                                                                  SendKeys   "{PGUP}"  
   
                                          End   Select  
                                             
                    End   Select  
                     
                    FlexScroll   =   CallWindowProc(Oldwinproc,   hWnd,   wMsg,   wParam,   lParam)  
                     
  End   Function  
   
   
  以下代码写在窗体里面  
   
  Private   Sub   MfgMonth_GotFocus()  
           
          Oldwinproc   =   GetWindowLong(Me.hWnd,   GWL_WNDPROC)  
            SetWindowLong   Me.hWnd,   GWL_WNDPROC,   AddressOf   FlexScroll  
  End   Sub  
   
  Private   Sub   MfgMonth_LostFocus()  
          SetWindowLong   Me.hWnd,   GWL_WNDPROC,   Oldwinproc  
   
  End   Sub