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

[sdk111]

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

[rainstormmaster]

子类，具体的你自己搜索吧，代码很多的

[dongge2000]

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

[youyiwuyi]

学习中

[sdk111]

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

[dongge2000]

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

[sdk111]

可是我按照楼上给的代码用在我的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

[nfsxy]

这是我以前问来的，我稍加改动，挺好用的。

Option Explicit

Public Type POINTL

X As Long

Y As Long

End Type

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


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 = -4

Public Const SPI_GETWHEELSCROLLLINES = 104

Public Const WM_MOUSEWHEEL = &H20A

Public WHEEL_SCROLL_LINES As Long

Global lpPrevWndProc As Long

Public 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 If

End Sub


Public Sub UnHook(ByVal hWnd As Long)

Dim lngReturnValue As Long

lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)

Set ScrollFrm = Nothing
End Sub

Function 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 Select

End Function


Public Function HIWORD(LongIn As Long) As Integer

' 取出32位值的高16位

HIWORD = (LongIn And &HFFFF0000) \ &H10000

End Function


Public Function LOWORD(LongIn As Long) As Integer

' 取出32位值的低16位

LOWORD = LongIn And &HFFFF&

End Function

[mylzw]

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

[sdk111]

请问这位大侠，要改哪些地方？谢谢！

[zhujiechang]

将Me.hWnd改为datagrid1.hwnd