VERSION 5.00
Begin VB.UserControl SwiftSlide 
   ClientHeight    =   210
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4005
   DrawWidth       =   48
   ScaleHeight     =   14
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   267
End
Attribute VB_Name = "SwiftSlide"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function FillRect Lib "user32.dll" (ByVal hDC As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'Default Property Values:
Const m_def_BarColor = &H404040
Const m_def_BorderColor = &HC0C0C0
Const m_def_SliderColor = &H404040
Const m_def_SliderWidth = 15
Const m_def_BarWidthFixed = 0
Const m_def_Value = 50
Const m_def_BarWidth = 4
'Property Variables:
Dim m_BarColor As OLE_COLOR
Dim m_BorderColor As OLE_COLOR
Dim m_SliderColor As OLE_COLOR
Dim m_SliderWidth As Variant
Dim m_BarWidthFixed As Boolean
Dim m_Value As Long
Dim m_BarWidth As Long
'Event Declarations:
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Dim OldX As Long, aBarBorder(1) As Long, aBar(2) As Long, aBarRect(1) As Long
Dim BarBrush As Long, BorderBrush As Long, SliderBrush As Long
Dim BorderRect As RECT, BarRect As RECT, SliderRect As RECT

Private Sub ChangeValue(iValue As Integer)
    If iValue > 100 Then iValue = 100
    If iValue < 0 Then iValue = 0
    m_Value = iValue
    If OldX + m_SliderWidth \ 2 > UserControl.ScaleWidth Then
        OldX = UserControl.ScaleWidth - m_SliderWidth \ 2
    End If
    If OldX - m_SliderWidth \ 2 < 0 Then
        OldX = m_SliderWidth \ 2
    End If
    aBarBorder(0) = OldX - m_SliderWidth \ 2
    aBarBorder(1) = OldX + m_SliderWidth \ 2
    aBar(0) = OldX - m_SliderWidth \ 2 + 1
    aBar(1) = OldX + m_SliderWidth \ 2 - 1
    aBar(2) = UserControl.ScaleHeight - 1
End Sub

Private Sub Redraw()
    Cls
    FillRect UserControl.hDC, BarRect, BarBrush
    FillRect UserControl.hDC, BorderRect, BorderBrush
    FillRect UserControl.hDC, SliderRect, SliderBrush
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As Integer
    BackStyle = UserControl.BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As Integer)
    UserControl.BackStyle() = New_BackStyle
    PropertyChanged "BackStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()

End Sub

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
    If Button = vbLeftButton Then
        OldX = X
        ChangeValue X / (UserControl.ScaleWidth / 100)
        With BorderRect
            .Left = aBarBorder(0)
            .Top = 0
            .Right = aBarBorder(1)
            .Bottom = UserControl.ScaleHeight
        End With
        With SliderRect
            .Left = aBar(0)
            .Top = 1
            .Right = aBar(1)
            .Bottom = aBar(2)
        End With
        Redraw
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hDC
Public Property Get hDC() As Long
    hDC = UserControl.hDC
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hWnd
Public Property Get hWnd() As Long
    hWnd = UserControl.hWnd
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get BarColor() As OLE_COLOR
    BarColor = m_BarColor
End Property

Public Property Let BarColor(ByVal New_BarColor As OLE_COLOR)
    m_BarColor = New_BarColor
    PropertyChanged "BarColor"
    BarBrush = CreateSolidBrush(m_BarColor)
    Redraw
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,3092271
Public Property Get BorderColor() As OLE_COLOR
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
    m_BorderColor = New_BorderColor
    PropertyChanged "BorderColor"
    BorderBrush = CreateSolidBrush(m_BorderColor)
    Redraw
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14,0,0,0
Public Property Get SliderColor() As OLE_COLOR
    SliderColor = m_SliderColor
End Property

Public Property Let SliderColor(ByVal New_SliderColor As OLE_COLOR)
    m_SliderColor = New_SliderColor
    PropertyChanged "SliderColor"
    SliderBrush = CreateSolidBrush(m_SliderColor)
    Redraw
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14,0,0,15
Public Property Get SliderWidth() As Variant
    SliderWidth = m_SliderWidth
End Property

Public Property Let SliderWidth(ByVal New_SliderWidth As Variant)
    m_SliderWidth = New_SliderWidth
    PropertyChanged "SliderWidth"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get BarWidthFixed() As Boolean
    BarWidthFixed = m_BarWidthFixed
End Property

Public Property Let BarWidthFixed(ByVal New_BarWidthFixed As Boolean)
    m_BarWidthFixed = New_BarWidthFixed
    PropertyChanged "BarWidthFixed"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14,0,0,0
Public Property Get Value() As Variant
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Variant)
    m_Value = New_Value
    PropertyChanged "Value"
    OldX = m_Value * (UserControl.ScaleWidth / 100)
    Redraw
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,4
Public Property Get BarWidth() As Long
    BarWidth = m_BarWidth
End Property

Public Property Let BarWidth(ByVal New_BarWidth As Long)
    m_BarWidth = New_BarWidth
    PropertyChanged "BarWidth"
    ChangeValue m_Value
    Redraw
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_BarColor = m_def_BarColor
    m_BorderColor = m_def_BorderColor
    m_SliderColor = m_def_SliderColor
    m_SliderWidth = m_def_SliderWidth
    m_BarWidthFixed = m_def_BarWidthFixed
    m_Value = m_def_Value
    m_BarWidth = m_def_BarWidth
    ChangeValue m_Value
    OldX = m_Value * (UserControl.ScaleWidth / 100)
    BarBrush = CreateSolidBrush(m_BarColor)
    BorderBrush = CreateSolidBrush(m_BorderColor)
    SliderBrush = CreateSolidBrush(m_SliderColor)
    With BarRect
        .Left = 0
        .Top = aBarRect(0)
        .Right = UserControl.ScaleWidth
        .Bottom = aBarRect(1)
    End With
    With BorderRect
        .Left = aBarBorder(0)
        .Top = 0
        .Right = aBarBorder(1)
        .Bottom = UserControl.ScaleHeight
    End With
    With SliderRect
        .Left = aBar(0)
        .Top = 1
        .Right = aBar(1)
        .Bottom = aBar(2)
    End With
    Redraw
End Sub

Private Sub UserControl_Paint()
Redraw
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    m_BarColor = PropBag.ReadProperty("BarColor", m_def_BarColor)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    m_SliderColor = PropBag.ReadProperty("SliderColor", m_def_SliderColor)
    m_SliderWidth = PropBag.ReadProperty("SliderWidth", m_def_SliderWidth)
    m_BarWidthFixed = PropBag.ReadProperty("BarWidthFixed", m_def_BarWidthFixed)
    m_Value = PropBag.ReadProperty("Value", m_def_Value)
    m_BarWidth = PropBag.ReadProperty("BarWidth", m_def_BarWidth)
    aBarRect(0) = UserControl.ScaleHeight / 2 - UserControl.ScaleHeight / 4
    aBarRect(1) = UserControl.ScaleHeight / 2 + UserControl.ScaleHeight / 4
    ChangeValue Val(m_Value)
    OldX = m_Value * (UserControl.ScaleWidth \ 100)
    aBarBorder(0) = OldX - m_SliderWidth \ 2
    aBarBorder(1) = OldX + m_SliderWidth \ 2
    aBar(0) = OldX - m_SliderWidth \ 2 + 1
    aBar(1) = OldX + m_SliderWidth \ 2 - 1
    aBar(2) = UserControl.ScaleHeight - 1
    BarBrush = CreateSolidBrush(m_BarColor)
    BorderBrush = CreateSolidBrush(m_BorderColor)
    SliderBrush = CreateSolidBrush(m_SliderColor)
    With BarRect
        .Left = 0
        .Top = aBarRect(0)
        .Right = UserControl.ScaleWidth
        .Bottom = aBarRect(1)
    End With
    With BorderRect
        .Left = aBarBorder(0)
        .Top = 0
        .Right = aBarBorder(1)
        .Bottom = UserControl.ScaleHeight
    End With
    With SliderRect
        .Left = aBar(0)
        .Top = 1
        .Right = aBar(1)
        .Bottom = aBar(2)
    End With
    Redraw
End Sub

Private Sub UserControl_Resize()
    ChangeValue Val(m_Value)
    aBarRect(0) = UserControl.ScaleHeight / 2 - UserControl.ScaleHeight / 4
    aBarRect(1) = UserControl.ScaleHeight / 2 + UserControl.ScaleHeight / 4
    aBarBorder(0) = OldX - m_SliderWidth \ 2
    aBarBorder(1) = OldX + m_SliderWidth \ 2
    aBar(0) = OldX - m_SliderWidth \ 2 + 1
    aBar(1) = OldX + m_SliderWidth \ 2 - 1
    aBar(2) = UserControl.ScaleHeight - 1
    With BarRect
        .Left = 0
        .Top = aBarRect(0)
        .Right = UserControl.ScaleWidth
        .Bottom = aBarRect(1)
    End With
    With BorderRect
        .Left = aBarBorder(0)
        .Top = 0
        .Right = aBarBorder(1)
        .Bottom = UserControl.ScaleHeight
    End With
    With SliderRect
        .Left = aBar(0)
        .Top = 1
        .Right = aBar(1)
        .Bottom = aBar(2)
    End With
    Redraw
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BarColor", m_BarColor, m_def_BarColor)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("SliderColor", m_SliderColor, m_def_SliderColor)
    Call PropBag.WriteProperty("SliderWidth", m_SliderWidth, m_def_SliderWidth)
    Call PropBag.WriteProperty("BarWidthFixed", m_BarWidthFixed, m_def_BarWidthFixed)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("BarWidth", m_BarWidth, m_def_BarWidth)
End Sub