datagrid控件如何支持鼠标滚轮？

Question

请问各位高手，datagrid控件如何支持鼠标滚轮？谢谢

Answer 1

http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=196624

Answer 2

可是我按照楼上给的代码用在我的DATAGRID中怎么会没有反应？代码如下：
以下代码写在模块里面  
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  DATAGRID1_GotFocus()  
         
       Oldwinproc  =  GetWindowLong(Me.hWnd,  GWL_WNDPROC)  
         SetWindowLong  Me.hWnd,  GWL_WNDPROC,  AddressOf  FlexScroll  
End  Sub  
 
Private  Sub  DATAGRID1_LostFocus()  
       SetWindowLong  Me.hWnd,  GWL_WNDPROC,  Oldwinproc  
 
End  Sub

Answer 3

想简单点就下载个第三方控件
http://penchen.go.2288.org

Answer 4

http://penchen.go.2288.org网页打不开，还有其他网站可以下载吗？

Answer 5

Private  Sub  Form_Load()  
       Me.Show  
       Oldwinproc  =  GetWindowLong(Me.hWnd,  GWL_WNDPROC)  
         SetWindowLong  Me.hWnd,  GWL_WNDPROC,  AddressOf  FlexScroll  
End  Sub  
 
Private  Sub  Form_Unload()  
       SetWindowLong  Me.hWnd,  GWL_WNDPROC,  Oldwinproc  
 
End  Sub

Answer 6

这是我以前问来的，我稍加改动，挺好用的。Option ExplicitPublic Type POINTLX As LongY As LongEnd TypeDeclare 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
Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo _
Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "user32" _
(ByVal hWnd As Long, xyPoint As POINTL) As Long
Public Const GWL_WNDPROC = -4Public Const SPI_GETWHEELSCROLLLINES = 104Public Const WM_MOUSEWHEEL = &H20APublic WHEEL_SCROLL_LINES As LongGlobal lpPrevWndProc As LongPublic ScrollFrm As Form
Public Sub Hook(ByVal hWnd As Long, ByVal frm As Form)
    
    Set ScrollFrm = frm
    
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    
    '获取"控制面板"中的滚动行数值
    
    Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
        
    If WHEEL_SCROLL_LINES > ScrollFrm.grdDataGrid.VisibleRows Then
        WHEEL_SCROLL_LINES = ScrollFrm.grdDataGrid.VisibleRows
    End IfEnd Sub
Public Sub UnHook(ByVal hWnd As Long)
    
    Dim lngReturnValue As Long
    
    lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
    
    Set ScrollFrm = Nothing
End SubFunction WindowProc(ByVal hw As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
    Dim pt As POINTL
    
    On Error Resume Next
    
    Select Case uMsg
    
    Case WM_MOUSEWHEEL
        If Not (ScrollFrm Is Nothing) Then            Dim wzDelta, wKeys As Integer
            
            wzDelta = HIWORD(wParam)
            wKeys = LOWORD(wParam)
            pt.X = LOWORD(lParam)
            pt.Y = HIWORD(lParam)
            
            '将屏幕坐标转换为Form1.窗口坐标
            ScreenToClient ScrollFrm.hWnd, pt
            With ScrollFrm.grdDataGrid
                '判断坐标是否在Form1.grdDataGrid窗口内
                If pt.X > .Left / Screen.TwipsPerPixelX And _
                    pt.X < (.Left + .Width) / Screen.TwipsPerPixelX And _
                    pt.Y > .Top / Screen.TwipsPerPixelY And _
                    pt.Y < (.Top + .Height) / Screen.TwipsPerPixelY Then
                    '滚动明细数据库
                    If wKeys = 16 Then
                        '滚动键按下，水平滚动grdDataGrid
                        If Sgn(wzDelta) = 1 Then
                            ScrollFrm.grdDataGrid.Scroll -1, 0
                        Else
                            ScrollFrm.grdDataGrid.Scroll 1, 0
                        End If
                    Else
                        If Sgn(wzDelta) = 1 Then
                            .Row = .Row - 1
                        Else
                            .Row = .Row + 1
                        End If
                    End If
                Else
                    '鼠标不在grdDataGrid区域，滚动主数据库
                    With ScrollFrm.datPrimaryRS.Recordset
                        If Sgn(wzDelta) = 1 Then
                            If .BOF = False Then
                                .MovePrevious
                                If .BOF = True Then .MoveFirst
                            End If
                        Else
                            If .EOF = False Then
                                .MoveNext
                                If .EOF = True Then .MoveLast
                            End If
                        End If
                    End With
                End If
            End With
        Else
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        End If
    Case Else
        WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End SelectEnd Function
Public Function HIWORD(LongIn As Long) As Integer
    
    ' 取出32位值的高16位
    
    HIWORD = (LongIn And &HFFFF0000) \ &H10000End Function
Public Function LOWORD(LongIn As Long) As Integer
    
    ' 取出32位值的低16位
    
    LOWORD = LongIn And &HFFFF&
    
End Function