Attribute VB_Name = "LongScrollBar"
'Long_ScrollBar.bas
'
'  2-02-01 by Robert Clemenzi
'
'  The maximum value that a VB ScrollBar can handle
'  is about 32,000 (integer)
'  These routines allows ScrollBars to handle about
'  2,000,000,000 units (long)
'
'  When the maximum Scrollbar value is less than 32,000,
'  then Max_value is set to -1 and the scroll bar works normally.
'  Otherwise, these routines fake a much longer ScrollBar
'  and display the slider in an appropiate place.
'
'  The implementation is a little jerky, but it does the job.
'
'
'  Set_Long_ScrollBar_Max(sb As VScrollBar, Max As Long)
'    Set the maximum value
'
'  Long_ScrollBar(sb As VScrollBar) As Long
'    Returns the current value
'
'  Set_Long_ScrollBar_Value(sb As VScrollBar, x As Long) As Long
'    Set the current value
'
'  The minimum value must be between 0 and 32,000
'  and must be less than the maximum value.
'  There is no checking.
'

Option Explicit

'
' Long_ScrollBar parameters
Private Max_value        As Long
Private Min_Value        As Long
Private current_Pointer  As Long
Global Last_sb_Value     As Integer ' Supposed to be the last
                                    ' value of the windows scrollbar
                                    ' used to determine how far to scroll
Private sb_Value_Flag    As Integer


Sub Set_Long_ScrollBar_Max(sb As VScrollBar, Max As Long)

 Min_Value = sb.Min
 current_Pointer = sb.Min
 Last_sb_Value = sb.Min
 sb_Value_Flag = 0
 
 If Max <= 32000 Then
   sb.Max = Max
   Max_value = -1
 Else
   sb.Max = 32000
   Max_value = Max
 End If

End Sub

Function Long_ScrollBar(sb As VScrollBar) As Long
Dim temp As Long, t

    ' This keeps down unnecessary recursion
  If sb_Value_Flag <> 0 Then
    Long_ScrollBar = current_Pointer
    Exit Function
  End If
  
  If Max_value = -1 Then
    Long_ScrollBar = sb.Value
    current_Pointer = sb.Value
    Last_sb_Value = sb.Value
    Exit Function
  End If
  
  sb_Value_Flag = 1


  temp = sb.Value - Last_sb_Value
  current_Pointer = current_Pointer + temp
  If sb.Value = sb.Max Then
    current_Pointer = Max_value
  End If
  If sb.Value = sb.Min Then
    current_Pointer = Min_Value
  End If
  
  Call Adjust_Long_ScrollBar_Value(sb)
  
  sb_Value_Flag = 0
  Long_ScrollBar = current_Pointer
End Function

Function Set_Long_ScrollBar_Value(sb As VScrollBar, x As Long) As Long
  current_Pointer = x
  Call Adjust_Long_ScrollBar_Value(sb)
End Function

Private Sub Adjust_Long_ScrollBar_Value(sb As VScrollBar)
Dim temp As Long, t


  If Max_value = -1 Then
    temp = current_Pointer
    
    If temp > sb.Max Then
      temp = sb.Max
    End If
    If temp < sb.Min Then
      temp = sb.Min
    End If
    
    sb.Value = temp
    Exit Sub
  End If
  
  If current_Pointer > Max_value Then
    current_Pointer = Max_value
  End If
  If current_Pointer < Min_Value Then
    current_Pointer = Min_Value
  End If
  
  t = (current_Pointer / Max_value) * sb.Max
  temp = Int(t)
  
    ' This is just in case when temp gets close to 1
  If temp = 0 And current_Pointer > temp Then
    temp = current_Pointer
  End If
  
  Last_sb_Value = temp
  sb.Value = temp
  Last_sb_Value = sb.Value ' This was for debug

End Sub

'-----------------------------------------------------------

' Example code to call these routines
'
' The "Display_Text" subroutine uses "FirstLine"
' to determine what to display
'

'     Used to initialize the long ScrollBar
'  Set_Long_ScrollBar_Max MainForm.UIVertScrollBar, i


'     Called from Form_Resize()
'  Call Set_Long_ScrollBar_Value(UIVertScrollBar, FirstLine)

'------------------

' UIVertScrollBar_Change() is called when you
' click on the scroll bar or its arrows.
' When scrolling a "large" scrollbar, this is also called
' when you release the scroll tab (stop dragging it).
'
' The simple state machine is required in the last case
'

'Private Sub UIVertScrollBar_Change()
'
'     ' This is called frequently, try to save some time.
'  If FirstLine = UIVertScrollBar.Value Then Exit Sub
'
'    ' The Scroll_Flag fixes a problem scrolling files
'    ' larger than 32,000 lines long
'  If UBound(CompareResults) < 32000 Then Scroll_Flag = 0
'  Select Case Scroll_Flag
'    Case 0    ' Normal, click arrows and PgUp/PgDn
'      FirstLine = Long_ScrollBar(UIVertScrollBar)
'      Call Display_Text
'    Case 1    ' Dragging the tab with max value > 32,000
'      Scroll_Flag = 2
'    Case 2    ' When you stop dragging, this is called
'              ' VB has unexpectedly changed sb.Value
'              ' Set Last_sb_Value to sb.Value to
'              ' fix this VB design problem
'      Last_sb_Value = UIVertScrollBar.Value
'      Scroll_Flag = 0
'    Case Else
'      Scroll_Flag = 0  ' Just in case
'  End Select
'
'End Sub

'------------------

' This routine is called when the scroll tab is dragged
'  ' This routine is very slow, the display jerks
'Private Sub UIVertScrollBar_Scroll()
'  If FirstLine = UIVertScrollBar.Value Then Exit Sub
'  Scroll_Flag = 1
'
'  FirstLine = Long_ScrollBar(UIVertScrollBar)
'    If Last_sb_Value <> UIVertScrollBar.Value Then
'      Last_sb_Value = Last_sb_Value ' debug breakpoint, never reached
'    End If
'
'  Call Display_Text
'
'End Sub