Public Class Form1
    Private Declare Function SystemParametersInfo _
        Lib "user32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Integer, _
         ByVal uParam As Integer, _
         ByRef lpvParam As Integer, _
         ByVal fuWinIni As Integer) _
        As Integer

    Private WithEvents mTimer As New System.Windows.Forms.Timer
    Private WithEvents DGrid As gsDGrid
    Private WithEvents BtnUp As Button
    Private WithEvents BtnDown As Button
    Private mDT As DataTable
    Private mDV As DataView
    Private mCS(1) As DataGridTextBoxColumn

    Private mBtn As Button
    Private mCntr As Integer


    Private Sub Form1_Load _
            ( _
            ByVal sender As Object, _
            ByVal e As System.EventArgs _
            ) _
            Handles Me.Load

        Me.BackColor = Color.FromArgb(210, 210, 230)


        DGrid = New gsDGrid
        With DGrid
            .Font = New Font("Arial", 11)
            .Left = 10
            .Top = 10
            .Width = Me.ClientSize.Width - 20
            .Height = Me.ClientSize.Height - 60
            .CaptionVisible = False
            .Anchor = AnchorStyles.Left Or _
                      AnchorStyles.Top Or _
                      AnchorStyles.Right Or _
                      AnchorStyles.Bottom
            .RowHeadersVisible = False
        End With
        Me.Controls.Add(DGrid)

        BtnUp = New Button
        With BtnUp
            .Left = Me.ClientSize.Width - (100)
            .Top = DGrid.Bottom + 10
            .Width = 90
            .Height = 30
            .BackColor = Color.BlanchedAlmond
            .Text = "Scroll Up"
            .Anchor = AnchorStyles.Right Or _
                      AnchorStyles.Bottom
        End With
        Me.Controls.Add(BtnUp)
        BtnDown = New Button
        With BtnDown
            .Left = BtnUp.Left - 100
            .Top = BtnUp.Top
            .Size = BtnUp.Size
            .BackColor = Color.BlanchedAlmond
            .Text = "Scroll down"
            .Anchor = BtnUp.Anchor
        End With
        Me.Controls.Add(BtnDown)

        AddHandler BtnDown.MouseDown, AddressOf StartTimer
        AddHandler BtnUp.MouseDown, AddressOf StartTimer
        AddHandler BtnDown.MouseUp, AddressOf StopTimer
        AddHandler BtnUp.MouseUp, AddressOf StopTimer

        MakeData()


        mCS(0) = New DataGridTextBoxColumn
        With mCS(0)
            .Alignment = HorizontalAlignment.Right
            .MappingName = mDT.Columns(0).ColumnName
            .HeaderText = .MappingName
        End With
        mCS(1) = New DataGridTextBoxColumn
        With mCS(1)
            .Alignment = HorizontalAlignment.Center
            .MappingName = mDT.Columns(1).ColumnName
            .HeaderText = .MappingName
        End With

        Dim TS As New DataGridTableStyle
        With TS
            .BackColor = Color.LightSteelBlue
            .AlternatingBackColor = Color.LightSkyBlue
            .GridColumnStyles.Add(mCS(0))
            .GridColumnStyles.Add(mCS(1))
        End With
        DGrid.TableStyles.Add(TS)

        DGrid.AutoSizeColumns()
        DGrid.ScrollToRow(30)

    End Sub

    Private Sub MakeData()
        Dim i As Integer
        Dim k As Integer
        Dim Col As DataColumn
        Dim Row As DataRow
        mDT = New DataTable

        Col = New DataColumn
        With Col
            .ColumnName = "ID"
            .Unique = True
            .AllowDBNull = False
            .DataType = GetType(Integer)
        End With
        With mDT
            .Columns.Add(Col)
            .Columns.Add("Text", GetType(String))

            For k = 0 To 4
                For i = 1 To 12
                    Row = mDT.NewRow
                    Row.Item(0) = i + k * 12

                    Row.Item(1) = _
                        MonthName(i) & _
                        " " & _
                        Year(Now.AddYears(k)).ToString

                    .Rows.Add(Row)
                Next i
            Next k
        End With
        mDV = New DataView(mDT)
        DGrid.DataSource = mDV
    End Sub

    Private Sub BtnUp_MouseLeave _
            ( _
            ByVal sender As Object, _
            ByVal e As System.EventArgs _
            ) _
            Handles BtnUp.MouseLeave
        StopTimer(Nothing, Nothing)
    End Sub

    Private Sub BtnUp_Click _
            ( _
            ByVal sender As Object, _
            ByVal e As System.EventArgs _
            ) _
            Handles BtnUp.Click
        DGrid.VScroll(gsDGrid.ScrollDirection.sdUp)
    End Sub

    Private Sub BtnDown_MouseLeave _
            ( _
            ByVal sender As Object, _
            ByVal e As System.EventArgs _
            ) _
            Handles BtnDown.MouseLeave
        StopTimer(Nothing, Nothing)
    End Sub

    Private Sub BtnDown_Click _
            (ByVal sender As Object, _
            ByVal e As System.EventArgs _
            ) _
            Handles BtnDown.Click
        DGrid.VScroll(gsDGrid.ScrollDirection.sdDown)
    End Sub

    Private Function GetKeyboardSpeed() As Integer
        ' Gibt die Tastaturwiederholrate 
        ' (KeyboardRepeat) in Millisekunden zurück
        Const sngMin As Single = 33.33
        Const sngMax As Single = 400
        Const SPI_GETKEYBOARDSPEED As Integer = 10
        Dim intValue As Integer
        Dim intRet As Integer
        Dim sngStep As Integer

        sngStep = CInt((sngMax - sngMin) / 31)
        intRet = SystemParametersInfo _
                    ( _
                    SPI_GETKEYBOARDSPEED, _
                    0, _
                    intValue, _
                    0 _
                    )

        If intRet <> 0 Then
            GetKeyboardSpeed = _
                400 - (intValue * sngStep)
        End If
    End Function

    Private Sub StartTimer _
        ( _
        ByVal Sender As Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs _
        )

        mCntr = 0
        mBtn = DirectCast(Sender, Button)
        mTimer.Interval = 150
        mTimer.Start()
    End Sub

    Private Sub StopTimer(ByVal Sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        mTimer.Stop()
        mCntr = 0
        mBtn = Nothing
    End Sub

    Private Sub mTimer_Tick _
            (ByVal sender As Object, _
             ByVal e As System.EventArgs _
             ) _
             Handles mTimer.Tick

        Select Case True
            Case mBtn Is BtnDown
                DGrid.VScroll _
                    (gsDGrid.ScrollDirection.sdDown)
            Case mBtn Is BtnUp
                DGrid.VScroll _
                    (gsDGrid.ScrollDirection.sdUp)
            Case Else
                StopTimer(Nothing, Nothing)
                Beep()
                Exit Sub
        End Select

        mCntr = mCntr + 1

        If mCntr > 5 Then
            mTimer.Interval = _
                GetKeyboardSpeed()
        End If
    End Sub

End Class




Public Class gsDGrid
    Inherits DataGrid

    Public Enum ScrollDirection
        sdUp = 0
        sdDown = 1
    End Enum

    Public Sub ScrollToRow _
           (ByVal Row As Integer)

        If Not Me.DataSource Is Nothing Then

            GridVScrolled(Me, New ScrollEventArgs _
              (ScrollEventType.LargeIncrement, Row))

        End If
    End Sub

    Public Sub VScroll _
        (ByVal Direction As ScrollDirection)

        If Direction = ScrollDirection.sdUp Then
            ScrollToRow(FirstVisibleRow() - 1)
        Else
            ScrollToRow(FirstVisibleRow() + 1)
        End If
    End Sub

    Public Sub AutosizeColumn(ByVal ColIndex As Integer)
        GetMethodInfo.Invoke(Me, New Object() {ColIndex})
    End Sub

    Public Sub AutoSizeColumns()
        Dim MI As Reflection.MethodInfo
        Dim i As Integer
        MI = GetMethodInfo()
        For i = MyBase.FirstVisibleColumn To MyBase.VisibleColumnCount - 1
            MI.Invoke(Me, New Object() {i})
        Next
    End Sub

    Private Function GetMethodInfo() As Reflection.MethodInfo
        Dim T As Type = GetType(DataGrid)
        GetMethodInfo = _
            T.GetMethod("ColAutoResize", _
                        Reflection.BindingFlags.NonPublic _
                        Or Reflection.BindingFlags.Instance)
    End Function

    Public Function FirstVisibleRow() As Integer
        Dim HTI As HitTestInfo
        Dim X As Integer
        Dim Y As Integer

        If Me.RowHeadersVisible Then
            X = Me.RowHeaderWidth
        Else
            X = 2
        End If
        Do
            Y = Y + 2
            HTI = Me.HitTest(X, Y)
            If HTI.Row > -1 Then
                Exit Do
            End If
        Loop While Y < Me.ClientSize.Height
        Return HTI.Row
    End Function
End Class