不看会后悔的Windows XP之经验谈	简单快捷DIY实用家庭影院

【求助】如何能使MSFlexGrid控件支持鼠标滚轮？

楼主nevsong（绿水青山--VB/VBA编程开发技术群:4218983）2006-07-04 18:41:17 在 VB / 控件提问

在VB6.0，使用MSFlexGrid控件不支持鼠标滚轮滚动，有没有办法使MSFlexGrid控件支持鼠标滚轮？问题点数：20、回复次数：9Top

1 楼pweixing（幸运星）回复于 2006-07-04 18:49:56 得分 0

找罗技鼠标的驱动，安装上就实现了，这是最简单的办法Top

2 楼faysky2（出来混，迟早是要还嘀）回复于 2006-07-04 18:59:01 得分 5

用子类处理WM_MOUSEWHEEL消息：
http://www.vbzx.net/ArticleView/vbzx_Article_View_519.aspTop

3 楼nevsong（绿水青山--VB/VBA编程开发技术群:4218983）回复于 2006-07-04 19:01:42 得分 0

我的鼠标不是罗技，那样也可以？
Top

4 楼faysky2（出来混，迟早是要还嘀）回复于 2006-07-04 20:12:23 得分 5

自己试试:

在模块中:
Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
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 MSHFlexGrid1_GotFocus()
Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
End Sub

Private Sub MSHFlexGrid1_LostFocus()
SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
End SubTop

5 楼nevsong（绿水青山--VB/VBA编程开发技术群:4218983）回复于 2006-07-05 10:32:14 得分 0

上面的代码,点击 MSHFlexGrid1 之后VB编辑器就结束了!Top

6 楼tripman（牛愤︱9# dream）回复于 2006-07-05 10:39:20 得分 0

http://www.bjjr.com.cn/yefan/sourcecode/mmouse.rarTop

7 楼tomkai（我不是苹果）回复于 2006-07-05 16:36:22 得分 5

在模块中添加:

---------------------------------------------------------------
Option Explicit

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

Public Const WM_MOUSEWHEEL = &H20A
Public Const GWL_WNDPROCB = -4

Global lpPrevWndProc As Long

Global gHW As Long

Public Sub Hook()
'lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROCB, AddressOf WindowProc)
End Sub

Public Sub Unhook()
Dim temp As Long
'temp = SetWindowLong(gHW, GWL_WNDPROCB, lpPrevWndProc)
End Sub

Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next

If uMsg = WM_MOUSEWHEEL Then
ProcMouseWheel wParam, lParam
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function

Public Sub ProcMouseWheel(wParam As Long, lParam As Long)
On Error Resume Next

Dim fwKeys As Long
Dim zDelta As Long
Dim xPos As Long
Dim yPos As Long
Dim Shift16 As Long
Shift16 = 65536

If wParam < 0 Then
zDelta = ((CLng(wParam) And &HFFFF0000) \ Shift16) And &HFFFF&
zDelta = zDelta - Shift16
Else
zDelta = ((CLng(wParam) And &HFFFF0000) \ Shift16) And &HFFFF&
End If

fwKeys = (CLng(wParam) And &HFFFF&)

yPos = ((CLng(lParam) And &HFFFF0000) \ Shift16) And &HFFFF&

xPos = (CLng(lParam) And &HFFFF&)

If TypeOf Screen.ActiveControl Is MSFlexGrid Then
Screen.ActiveControl.TopRow = Screen.ActiveControl.TopRow - 1 * zDelta \ 120
End If
End Sub

在窗体中添加:

---------------------------------------------------------------------------
Form_Load中添加:

If gHW <> Me.hWnd Then
gHW = Me.hWnd
Hook
End If

添加

Private Sub Form_Unload(Cancel As Integer)
Unhook
'注:调试时请将该句屏蔽,否则编译后VB会死掉,当程序编写完毕编译为EXE文件时将其打开
End Sub

==========================================
苹果~~~

Top

8 楼nevsong（绿水青山--VB/VBA编程开发技术群:4218983）回复于 2006-07-08 09:16:08 得分 0

好试试Top

9 楼dxqylzg（VB我学你）回复于 2006-07-10 00:55:53 得分 5

'模块
Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Public Const WM_MOUSEWHEEL = &H20A
Public Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public GridObject As MSFlexGrid
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public prevWndProc As Long
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_MOUSEWHEEL Then
With GridObject
If wParam = -7864320 Then
.TopRow = .TopRow + 1 '向下滚动
ElseIf wParam = 7864320 Then
If .TopRow > 1 Then
.TopRow = .TopRow - 1 '向上滚动
End If
End If
End With
Else
WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
End If
End Function

'窗口
Private Sub Form_Load()
'表格窗口消息
Set GridObject = FrmYLJF.G
prevWndProc = GetWindowLong(GridObject.hwnd, GWL_WNDPROC)
Call SetWindowLong(GridObject.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'恢复窗口程序
Call SetWindowLong(GridObject.hwnd, GWL_WNDPROC, prevWndProc)
End Sub
Top