VERSION 5.00
Begin VB.UserControl Rm2kScroll 
   ClientHeight    =   510
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1440
   ScaleHeight     =   34
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   96
   Begin VB.Frame FrameWidth 
      BorderStyle     =   0  'None
      Caption         =   "Animation  Width"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2295
      Begin VB.PictureBox picContainer1 
         BackColor       =   &H00E0E0E0&
         ForeColor       =   &H8000000D&
         Height          =   300
         Left            =   0
         ScaleHeight     =   16
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   81
         TabIndex        =   1
         Top             =   0
         Width           =   1275
         Begin VB.VScrollBar vScroll 
            Height          =   195
            Left            =   960
            Max             =   1
            Min             =   128
            TabIndex        =   2
            Top             =   0
            Value           =   1
            Width           =   255
         End
         Begin VB.TextBox txtA 
            BorderStyle     =   0  'None
            BeginProperty Font 
               Name            =   "Verdana"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   195
            Left            =   0
            TabIndex        =   3
            Text            =   "1"
            Top             =   0
            Width           =   975
         End
      End
   End
End
Attribute VB_Name = "Rm2kScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private AChange As Boolean
Private lX As Integer

Public Event Change()

Private Minimum As Integer
Private Maximum As Integer
Private StepValue As Integer

Public Property Get Value() As Integer
    Value = vScroll.Value
End Property

Public Property Let Value(ByVal vNew As Integer)
    vScroll.Value = vNew
    PropertyChanged "Value"
End Property

Public Property Get Step() As Integer
    Step = StepValue
End Property

Public Property Let Step(ByVal vNew As Integer)
    StepValue = vNew
    PropertyChanged "Step"
    vScroll.SmallChange = StepValue
End Property

Public Property Get Min() As Integer
    Min = Minimum
End Property

Public Property Let Min(ByVal vNew As Integer)
    Minimum = vNew
    PropertyChanged "Min"
    vScroll.Max = Minimum
End Property

Public Property Get Max() As Integer
    Max = Maximum
End Property

Public Property Let Max(ByVal vNew As Integer)
    Maximum = vNew
    PropertyChanged "Max"
    vScroll.Min = Maximum
End Property







Private Sub picContainer1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
AChange = True
picContainer1_MouseMove Button, Shift, x, y

End Sub

Private Sub picContainer1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If AChange = True Then
Dim NewValue As Integer
NewValue = ((x / (picContainer1.ScaleWidth)) * (Maximum - Minimum)) + Minimum


If NewValue < Minimum Then NewValue = Minimum
If NewValue > Maximum Then NewValue = Maximum
txtA.Text = Snap(NewValue, StepValue)
vScroll.Value = Snap(NewValue, StepValue)
UpdateScroller
RaiseEvent Change
End If
End Sub

Private Sub picContainer1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
AChange = False
End Sub



Private Sub picContainer1_Paint()
UpdateScroller
End Sub

Private Sub txtA_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then txtA_lostfocus



End Sub

Private Sub txtA_KeyPress(KeyAscii As Integer)
Dim valid As String
valid = "0123456789"

If InStr(1, valid, Chr(KeyAscii)) = 0 And Not KeyAscii = 8 Then KeyAscii = 0
End Sub

Private Sub txtA_lostfocus()
On Error Resume Next
Dim NewValue As Long
NewValue = Val(txtA.Text)
If NewValue < Minimum Then NewValue = Minimum
If NewValue > Maximum Then NewValue = Maximum
vScroll.Value = Snap(NewValue, StepValue)
txtA.Text = Snap(NewValue, StepValue)
RaiseEvent Change

End Sub

Private Sub UserControl_Initialize()
Minimum = 1
Maximum = 128

vScroll.Min = Maximum
vScroll.Max = Minimum

StepValue = 1

UserControl_Resize
End Sub

Private Sub UserControl_InitProperties()
UserControl_Resize
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

Minimum = PropBag.ReadProperty("Min", 1)
Maximum = PropBag.ReadProperty("Max", 128)
Step = PropBag.ReadProperty("Step", 1)
vScroll.Min = Maximum
vScroll.Max = Minimum
vScroll.Value = PropBag.ReadProperty("Value", 1)
    
End Sub

Private Sub UserControl_Resize()
    On Error Resume Next
    UserControl.Height = picContainer1.Height
    
    FrameWidth.Width = UserControl.Width
    
    picContainer1.Width = UserControl.Width
    vScroll.Move picContainer1.ScaleWidth - vScroll.Width
    txtA.Move 0, 0, picContainer1.ScaleWidth - vScroll.Width
    
End Sub

Private Sub UserControl_Show()
UserControl_Resize
End Sub

Public Sub UpdateScroller()
picContainer1.Cls
picContainer1.Line (0, 0)-(picContainer1.ScaleWidth * ((Value - Minimum) / (Maximum - Minimum)), picContainer1.ScaleHeight), , BF

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Min", Minimum, 1)
    Call PropBag.WriteProperty("Max", Maximum, 128)
    Call PropBag.WriteProperty("Step", StepValue, 1)
    Call PropBag.WriteProperty("Value", vScroll.Value, 1)

End Sub

Private Sub vScroll_Change()
    txtA.Text = vScroll.Value
    UpdateScroller
    RaiseEvent Change
End Sub
