Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC = - 4 
Private Const WM_USER = &H400
Private Const WM_SETPREVPTR = WM_USER +  1 
Private Const WM_SETGRID = WM_USER +  2 
Private Const WM_RESTORE = WM_USER +  3 

Public Sub AddScroll(Grid As DataGrid)
Dim p As Long
    p = SetWindowLong(Grid.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    SendMessage Grid.hwnd, WM_SETPREVPTR, p,  0 
    SendMessage Grid.hwnd, WM_SETGRID, ObjPtr(Grid),  0 
End Sub

Public Sub RemoveScroll(Grid As DataGrid)
    SendMessage Grid.hwnd, WM_RESTORE,  0 ,  0 
End Sub

Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static lpPrevWndProc As Long
Static GridPtr As Long
Dim gList As Object
    If lpPrevWndProc =  0  And uMsg < WM_USER Then Exit Function
    Select Case uMsg
        Case  522 
            If GridPtr <>  0  Then
                Set gList = ObjFromPtr(GridPtr)
                If Abs(wParam) =  7864320  Then
                    gList.Scroll  0 , -(wParam / Abs(wParam))
                Else
                    gList.Scroll  0 , -(wParam / Abs(wParam)) *  10 
                End If
            End If
        Case WM_SETPREVPTR
            lpPrevWndProc = wParam
        Case WM_SETGRID
            GridPtr = wParam
        Case WM_RESTORE
            SetWindowLong hw, GWL_WNDPROC, lpPrevWndProc
    End Select
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Private Function ObjFromPtr(lObjPtr As Long) As Object
Dim LoTmp As Object
    If lObjPtr <>  0  Then
        CopyMemory LoTmp, lObjPtr,  4 
        Set ObjFromPtr = LoTmp
        CopyMemory LoTmp,  0 &,  4 
    End If
End Function