Custom Scroll

[Nathan Carroll]

I have the code below working fairly well. It is a little jumpy on movement
at times. When repositioning scroll and navigating records. Any guidance
on this?

Enum ScrollAction As Integer
Down = 1
Up = 2
Add = 3
Delete = 4
NewRec = 5
End Enum

Const OriginalHeight As Integer = 182
Const NumRowsVis As Integer = 3
Const OriginalTop As Integer = 65
Dim ScrollValue As Integer

Sub ScrollAdjust(ByVal action As ScrollAction)
Dim TopRow As Integer = Row0.Position
With Me.ScrollThumb
Select Case action
'Case ScrollAction.Delete
' If TopRow > 0 Then
' .Top = OriginalTop + (TopRow * ScrollValue)
' Else
' Me.ScrollThumb.Top = OriginalTop
' End If
' Me.CalculateScrollHeight()
Case ScrollAction.Up, ScrollAction.Delete
If TopRow = 0 Then
Me.ScrollThumb.Top = OriginalTop
Else
.Top = OriginalTop + (TopRow * ScrollValue)
End If
Case Else
.Top = OriginalTop + (TopRow * ScrollValue)
End Select
End With
End Sub

Dim AllowScroll As Boolean
Dim PrevMousePos As Integer
Dim LowerBound As Integer
Dim PrevPosition As Integer
Private Sub ScrollThumb_MouseMove(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles ScrollThumb.MouseMove
Dim BoundTest As Integer
Dim yNow As Integer
Dim ThumbChange As Integer
If Not AllowScroll Then Exit Sub
If PreventError Then Exit Sub
PreventError = True
Dim CurStart As Integer = Row0.Position
yNow = Me.MousePosition.Y
BoundTest = Me.ScrollThumb.Top + (yNow - PrevMousePos)
'used when placeing records
ThumbChange = Me.ScrollThumb.Top - PrevPosition
Select Case BoundTest
Case Is > LowerBound 'top to much put to max
Me.ScrollThumb.Top = LowerBound
Row2.NewRecord()
Row1.MoveTo(bView.Count - 2)
Row0.MoveTo(bView.Count - 3)
Me.PositionChanged()
PrevPosition = Me.ScrollThumb.Top
Case Is < OriginalTop
Me.ScrollThumb.Top = OriginalTop
Row0.MoveTo(0)
Row1.MoveTo(1)
Row2.MoveTo(2)
Me.PositionChanged()
PrevPosition = Me.ScrollThumb.Top
Case Else
'position scroll
Me.ScrollThumb.Top += (yNow - PrevMousePos)
Select Case ThumbChange
Case Is > ScrollValue 'move down up records
Row0.NextRec()
Row1.NextRec()
Row2.NextRec()
Me.PositionChanged()
PrevPosition = Me.ScrollThumb.Top
Case Is < -ScrollValue 'move up records
Row0.MoveTo(CurStart - 1)
Row1.MoveTo(CurStart)
Row2.MoveTo(CurStart + 1)
Me.PositionChanged()
PrevPosition = Me.ScrollThumb.Top
Case Else
'do nothing
End Select
End Select
PrevMousePos = yNow
PreventError = False
End Sub

Private Sub ScrollThumb_MouseUp(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles ScrollThumb.MouseUp
'snap into position
If AllowScroll Then
'snap into position
Me.ScrollAdjust(ScrollAction.Up)
End If
AllowScroll = False
End Sub

Private Sub ScrollThumb_MouseDown(ByVal sender As Object, ByVal e As
System.Windows.Forms.MouseEventArgs) Handles ScrollThumb.MouseDown
If Me.ScrollThumb.MouseButtons = MouseButtons.Left Then
'end current edit?
AllowScroll = True
PrevPosition = Me.ScrollThumb.Top
LowerBound = OriginalTop + (OriginalHeight - Me.ScrollThumb.Height)
PrevMousePos = Me.MousePosition.Y
End If
End Sub