社区

京东店铺
淘宝店铺
当当店铺
拼多多店铺

APP下载

扫描下载官方APP

VIP会员

VB答疑区

+关注

已有23人关注

+发表新帖

所属版块： VB答疑区

panzhilei

学分:0

+关注

私信

立即签到

版块推荐

DataGrid控件如何支持鼠标滚轮

发表在VB答疑区 2010-04-30

是否精华是否

版块置顶: 是否

用VB6.0开发软件，其中引用DataGrid控件，显示大量数据，只能用边上滑杆，鼠标滚轮不起作用，使用不是很方便，请教专家们，用什么办法可以解决使用鼠标滚轮，数据跟着滚轮向下移动。如能帮助解决，特表示万分感谢！
                                                 上海读者：潘志磊
                                                    2010－4－30
   电子信箱：pan_zhilei@163.com

分享到：

关注

支持(0)

反对(0)

精彩评论 3

vbsoldier

学分：0 LV1

+关注

私信

2010-05-04

沙发

您好，请参考以下代码。

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 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 Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A

Public lpWndProc As Long

Public Sub Hook(hwnd As Long)
lpWndProc = GetWindowLong(hwnd, GWL_WNDPROC) '获得原始窗口函数句柄
SetWindowLong hwnd, GWL_WNDPROC, AddressOf WindowProc '装载WM_MOUSEWHEEL消息的处理过程到窗口函数
End Sub

Public Sub UnHook(hwnd As Long)

SetWindowLong hwnd, GWL_WNDPROC, lpWndProc '御掉Hook，还原原始窗口函数

End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'处理WM_MOUSEWHEEL消息的窗口函数

If uMsg = WM_MOUSEWHEEL Then
Dim wzDelta As Integer
wzDelta = HIWORD(wParam)

If Sgn(wzDelta) = 1 Then
DatabaseForm.DataGrid.Scroll 0, -1
Else
DatabaseForm.DataGrid.Scroll 0, 1
End If

End If

WindowProc = CallWindowProc(lpWndProc, hwnd, uMsg, wParam, lParam)

End Function

Public Function HIWORD(MsgParam As Long) As Integer
'取出32位值的高16位
HIWORD = (MsgParam And &HFFFF0000) \ &H10000
End Function

Form里的代码：

Private Sub Form_Load()
Hook DataGrid.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnHook DataGrid.hwnd
End Sub

支持(0)

反对(0)

panzhilei

学分：0 LV1

+关注

私信

TA的每日心情

伤心

2023-11-16 20:51:59

2010-05-07

板凳

[FIELDSET][LEGEND]引自：1楼[/LEGEND]
您好，请参考以下代码。

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 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 Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A

Public lpWndProc As Long

Public Sub Hook(hwnd As Long)
lpWndProc = GetWindowLong(hwnd, GWL_WNDPROC) '获得原始窗口函数句柄
SetWindowLong hwnd, GWL_WNDPROC, AddressOf WindowProc '装载WM_MOUSEWHEEL消息的处理过程到窗口函数
End Sub

Public Sub UnHook(hwnd As Long)

SetWindowLong hwnd, GWL_WNDPROC, lpWndProc '御掉Hook，还原原始窗口函数

End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'处理WM_MOUSEWHEEL消息的窗口函数

If uMsg = WM_MOUSEWHEEL Then
Dim wzDelta As Integer
wzDelta = HIWORD(wParam)

If Sgn(wzDelta) = 1 Then
DatabaseForm.DataGrid.Scroll 0, -1
Else
DatabaseForm.DataGrid.Scroll 0, 1
End If

End If

WindowProc = CallWindowProc(lpWndProc, hwnd, uMsg, wParam, lParam)

End Function

Public Function HIWORD(MsgParam As Long) As Integer
'取出32位值的高16位
HIWORD = (MsgParam And &HFFFF0000) \ &H10000
End Function

Form里的代码：

Private Sub Form_Load()
Hook DataGrid.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnHook DataGrid.hwnd
End Sub

[/FIELDSET]

回复：
我虽然学习研究了几年,但绝对不是高手,上面代码,我放到系统中,这要点击这个窗口,系统就立即关闭.不知是何原因.特请教.

支持(0)

反对(0)

caocaocao

学分：0 LV1

+关注

私信