PC Review


Reply
Thread Tools Rate Thread

Custom Scroll

 
 
Nathan Carroll
Guest
Posts: n/a
 
      2nd Sep 2003
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


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Custom TreeView Scroll Problem Matt Microsoft C# .NET 0 6th Feb 2007 10:42 PM
Data Validation - Scroll in the formula bar for a custom criteria =?Utf-8?B?SGFubm8gU2Nob2x0eg==?= Microsoft Excel Worksheet Functions 3 22nd Sep 2005 02:11 PM
Custom Scroll Bar =?Utf-8?B?U2t5IFdhcnJlbg==?= Microsoft Access Form Coding 0 21st May 2005 06:15 PM
Custom scroll bars skipping values =?Utf-8?B?aG9kZXdhcmU=?= Microsoft Excel Misc 0 29th Mar 2005 08:31 PM
How do I create a custom scroll bar on a 3D Pivot Chart? =?Utf-8?B?SlJXIGluIElkYWhv?= Microsoft Excel Charting 1 1st Dec 2004 08:55 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 12:38 AM.