MSFlexGrid MouseWheel Supported

最新推荐文章于 2020-12-29 07:16:19 发布

yinweihong

最新推荐文章于 2020-12-29 07:16:19 发布

阅读量2.4k

点赞数

本文链接：https://blog.csdn.net/yinweihong/article/details/116638

版权

VB6 Grid 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

modMouseWheel.bas
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
                          ByVal lpPrevWndFunc As Long, _
                          ByVal hWnd As Long, _
                          ByVal Msg As Long, _
                          ByVal Wparam As Long, _
                          ByVal Lparam As Long) As Long

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
                          ByVal hWnd As Long, _
                          ByVal nIndex As Long, _
                          ByVal dwNewLong As Long) As Long

Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyForm As Form

Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal Wparam As Long, ByVal Lparam As Long) As Long

    Dim MouseKeys As Long
    Dim Rotation As Long
    Dim Xpos As Long
    Dim Ypos As Long

    If Lmsg = WM_MOUSEWHEEL Then
        MouseKeys = Wparam And 65535
        Rotation = Wparam / 65536
        Xpos = Lparam And 65535
        Ypos = Lparam / 65536
        MyForm.MouseWheel MouseKeys, Rotation, Xpos, Ypos
    End If
    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function
Public Sub WheelHook(PassedForm As Form)

On Error Resume Next

    Set MyForm = PassedForm
    LocalHwnd = PassedForm.hWnd
    LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
    Dim WorkFlag As Long

    On Error Resume Next
    WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
    Set MyForm = Nothing
End Sub
Add MsFlexGrid1 to Form1 and code below
Private Sub Form_Load()
    Call WheelHook(Form1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call WheelUnHook
End Sub
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
    Dim NewValue As Long
    Dim Lstep As Single

On Error Resume Next

    With MSFlexGrid1
        Lstep = .Height / .RowHeight(0)
        Lstep = Int(Lstep)
        If Lstep < 10 Then
            Lstep = 10
        End If
        If Rotation > 0 Then
            NewValue = .TopRow - Lstep
            If NewValue < 1 Then
                NewValue = 1
            End If
        Else
            NewValue = .TopRow + Lstep
            If NewValue > .Rows - 1 Then
                NewValue = .Rows - 1
            End If
        End If
        .TopRow = NewValue
    End With
End Sub
'For a VScrollBar Version
'Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
'    Dim NewValue As Long
'
'    On Error Resume Next
'
'    With VScroll
'        If Rotation > 0 Then
'            NewValue = .Value - .LargeChange
'            If NewValue < .Min Then
'                NewValue = .Min
'            End If
'        Else
'           NewValue = .Value + .LargeChange
'           If NewValue > .Max Then
'               NewValue = .Max
'            End If
'        End If
'.Value = NewValue
'    End With
'End Sub

'Winxp+sp2+VB6+sp6
Refer to:http://www.adit.co.uk/html/mousewheelsupport.html