MSHFlexGrid控件如果使用鼠标滚轮。

Question

RT

Answer 1

'模块:Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A
Public PrevWndProc As Long
Public FmGrid As MSHFlexGrid
Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim t(0 To 1) As IntegerIf uMsg = WM_MOUSEWHEEL Then
    With FmGrid
    If wParam < 0 Then 'backward
        .TopRow = .TopRow + 10
    Else 'forforward
        .TopRow = .TopRow - 10
    End If
    End With
Else
    WndProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam) '让Windows处理其他事件
End If
End Function
'窗体
Private Sub Form_Load()
Set FmGrid = MSHFlexGrid1
PrevWndProc = SetWindowLong(MSHFlexGrid1.hwnd, GWL_WNDPROC, AddressOf WndProc)    '让WndProc来处理该窗体的事件
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim lResult As Long
lResult = SetWindowLong(DtGrid.hwnd, GWL_WNDPROC, PrevWndProc)  '让Windows默认的函数来处理事件
End Sub

Answer 2

另外，建议使用vsflexgrid
vsflexgrid支持鼠标

Answer 3

上面哥们的代码好象没测试吧'模块部分Option ExplicitPublic Cn As New ADODB.ConnectionPublic Const GWL_WNDPROC = (-4)
Public Const WM_COMMAND = &H111
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MOUSEWHEEL = &H20APublic 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 LongPublic Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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
'支持鼠标动作
     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 SubPrivate Sub MSHFlexGrid1_LostFocus()
  SetWindowLong Me.hwnd, GWL_WNDPROC, Oldwinproc
End Sub

Answer 4

to :aohan(景升)  我直接试的这位大哥的。没问题。谢谢了

Answer 5

http://powerbasic.cn/Products/MouseWheelForDataGrid.htm