_Visual Basic 5 and ActiveX Controls_ 
by Al Williams

Listing One
VERSION 5.00
Begin VB.UserControl LedBar 
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   432
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4788
   FillColor       =   &H00FFFFFF&
   PropertyPages   =   "ledbar.ctx":0000
   ScaleHeight     =   432
   ScaleWidth      =   4788
   ToolboxBitmap   =   "ledbar.ctx":001A
   Begin VB.Timer Timer1 
      Interval        =   125
      Left            =   4212
      Top             =   0
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   19
      Left            =   4560
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   18
      Left            =   4320
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   17
      Left            =   4080
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   16
      Left            =   3840
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   15
      Left            =   3600
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   14
      Left            =   3360
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   13
      Left            =   3120
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   12
      Left            =   2880
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   11
      Left            =   2640
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   10
      Left            =   2400
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   9
      Left            =   2160
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   8
      Left            =   1920
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   7
      Left            =   1680
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   6
      Left            =   1440
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   5
      Left            =   1200
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   4
      Left            =   960
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   3
      Left            =   720
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   2
      Left            =   480
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   1
      Left            =   240
      Top             =   0
      Width           =   252
   End
   Begin VB.Shape LED0 
      BackColor       =   &H000000FF&
      FillColor       =   &H000000FF&
      FillStyle       =   0  'Solid
      Height          =   492
      Index           =   0
      Left            =   0
      Top             =   0
      Width           =   252
   End
End
Attribute VB_Name = "LedBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"

Dim n As Integer
'Default Property Values:
Const m_def_Direction = True
Const m_def_Hold = False
'Const m_def_ForeColor = 255
'Property Variables:
Dim m_Direction As Boolean
Dim m_Hold As Boolean
'Dim m_ForeColor As OLE_COLOR
'Event Declarations:
Event Tick()
'Event Timer() 'MappingInfo=Timer1,Timer1,-1,Timer

Private Sub Timer1_Timer()
If m_Hold = True Then Exit Sub
LED0(n).FillColor = vbBlack
If m_Direction Then
  If n = 19 Then n = 0 Else n = n + 1
Else
  If n = 0 Then n = 19 Else n = n - 1
End If
LED0(n).FillColor = UserControl.ForeColor
RaiseEvent Tick
End Sub

Private Sub UserControl_Initialize()
n = 0
LED0(0).FillColor = UserControl.ForeColor
Hold = False
End Sub

Private Sub UserControl_Resize()
For i = 0 To 19
  LED0(i).Width = (ScaleWidth \ 20) * 20 / 20!
  LED0(i).Height = ScaleHeight
  LED0(i).Top = 0
  LED0(i).Left = i * (ScaleWidth \ 20) * 20 / 20!
Next i
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
'Public Property Get ForeColor() As OLE_COLOR
'    ForeColor = m_ForeColor
'End Property
'Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
'    m_ForeColor = New_ForeColor
'    PropertyChanged "ForeColor"
'End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Timer1,Timer1,-1,Interval
Public Property Get Delay() As Long
Attribute Delay.VB_Description = "Returns/sets number of milliseconds between 
                                      calls to a Timer control's Timer event."
    Delay = Timer1.Interval
End Property

Public Property Let Delay(ByVal New_Delay As Long)
    Timer1.Interval() = New_Delay
    PropertyChanged "Delay"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
'    m_ForeColor = m_def_ForeColor
    m_Hold = m_def_Hold
    m_Direction = m_def_Direction
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

'    UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
'    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    Timer1.Interval = PropBag.ReadProperty("Delay", 125)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    m_Hold = PropBag.ReadProperty("Hold", m_def_Hold)
    m_Direction = PropBag.ReadProperty("Direction", m_def_Direction)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

'    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFFFFFF)
'    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Delay", Timer1.Interval, 125)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Hold", m_Hold, m_def_Hold)
    Call PropBag.WriteProperty("Direction", m_Direction, m_def_Direction)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets foreground color used to 
                                      display text and graphics in an object."
    ForeColor = UserControl.ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    UserControl.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property
Public Property Get Hold() As Boolean
Attribute Hold.VB_Description = "Set to TRUE to freeze LEDs"
    Hold = m_Hold
End Property
Public Property Let Hold(ByVal New_Hold As Boolean)
    m_Hold = New_Hold
    PropertyChanged "Hold"
End Property
Public Property Get Direction() As Boolean
Attribute Direction.VB_Description = "True for left to right, False right to left"
    Direction = m_Direction
End Property
Public Property Let Direction(ByVal New_Direction As Boolean)
    m_Direction = New_Direction
    PropertyChanged "Direction"
End Property


