MOUSEWHEEL NO FLEXGRID

  
Option Explicit
[ô][ô]// Inseri Mouse Whell Scroll no componente MSFlexGrid
[ô][ô]   Através do Uso os métodos:
[ô][ô]   -- WheelHook (dentro do GotFocus)
[ô][ô]   -- WheelUnHook (dentro do LostFocus)

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
Dim mGrid As MSFlexGrid

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
        MouseWheel2 MouseKeys, Rotation, Xpos, Ypos
    End If
    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function

Public Sub WheelHook(PassedForm As Form, lGrid As MSFlexGrid)
    
    On Error Resume Next
    
    Set mGrid = lGrid
    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

Private Sub MouseWheel2(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
    
    Dim lGrid As Control

    For Each lGrid In MyForm.Controls
        If TypeOf lGrid Is MSFlexGrid Then
            If lGrid.Name = mGrid.Name Then
                Exit For
            End If
        End If
    Next
    
    With lGrid
[ô]        Lstep = .height / .RowHeight(0) / 4
[ô]        Lstep = Int(Lstep)
[ô]        If Lstep < 5 Then
[ô]            Lstep = 5
[ô]        End If
        Lstep = 1
        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
 

  
Private Sub grid_GotFocus()
    Call WheelHook(Me, grid)
End Sub

Private Sub grid_LostFocus()
    Call WheelUnHook
End Sub