Option Explicit
'default property settings
Private Const m_def_BackColor As Long = vbHighlightText
Private Const m_def_ForeColor As Long = vbHighlight
Private Const m_def_Min As Currency = 0
Private Const m_def_Max As Currency = 10000
Private Const m_def_Value As Currency = 0
'property variables
Dim m_BackColor As Long
Dim m_ForeColor As Long
Dim m_Min As Currency
Dim m_Max As Currency
Dim m_Value As Currency
'helper variables
Dim i_Max As Currency
Dim i_Value As Currency
Public Property Get BackColor() As OLE_COLOR
BackColor = m_BackColor
End Property
Public Property Let BackColor(ByVal NewColor As OLE_COLOR)
m_BackColor = NewColor
Frame1.BackColor = NewColor
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(ByVal NewColor As OLE_COLOR)
m_ForeColor = NewColor
UserControl.BackColor = NewColor
End Property
Public Property Get Min() As Currency
Min = m_Min
End Property
Public Property Let Min(ByVal NewValue As Currency)
m_Min = NewValue
'Min can't be same as Max
If m_Min = m_Max Then m_Max = m_Min + 1
'make sure we have a valid value
If m_Min < m_Max Then
'Min is smaller than Max
If m_Value < m_Min Then m_Value = m_Min: i_Value = Abs(m_Value - m_Min)
Else
'Min is bigger than Max
If m_Value > m_Min Then m_Value = m_Min: i_Value = Abs(m_Value - m_Max)
End If
'internal helper variable for easing calculating the progress
'internal Min is always zero!
i_Max = Abs(m_Max - m_Min)
'make the changes visible
RefreshProgress
End Property
Public Property Get Max() As Currency
Max = m_Max
End Property
Public Property Let Max(ByVal NewValue As Currency)
m_Max = NewValue
'Max can't be same as Min
If m_Min = m_Max Then m_Min = m_Max - 1
'make sure we have a valid value
If m_Min < m_Max Then
'Max is bigger than Min
If m_Value > m_Max Then m_Value = m_Max: i_Value = Abs(m_Value - m_Min)
Else
'Max is smaller than Min
If m_Value < m_Max Then m_Value = m_Max: i_Value = Abs(m_Value - m_Max)
End If
'internal helper variable for easing calculating the progress
'internal Min is always zero!
i_Max = Abs(m_Max - m_Min)
'make the changes visible
RefreshProgress
End Property
Public Property Get Value() As Currency
Value = m_Value
End Property
Public Property Let Value(ByVal NewValue As Currency)
'error detection: check for a proper value (within current Min and Max)
If m_Min < m_Max Then
'min is smaller than max
Select Case NewValue
Case Is < m_Min
'we are getting a too small value
m_Value = m_Min
Case Is > m_Max
'we are getting a too big value
m_Value = m_Max
Case Else
'we are getting a proper value, update
m_Value = NewValue
End Select
'internal helper variable for easing calculating the progress
i_Value = Abs(m_Value - m_Min)
Else
'min is bigger than max
Select Case NewValue
Case Is > m_Min
'we are getting a too big value
m_Value = m_Min
Case Is < m_Max
'we are getting a too small value
m_Value = m_Max
Case Else
'we are getting a proper value, update
m_Value = NewValue
End Select
'internal helper variable for easing calculating the progress
i_Value = Abs(m_Value - m_Max)
End If
'make the changes visible
RefreshProgress
End Property
Private Sub RefreshProgress()
'thanks to the internal helper variables, counting the position is a piece of a cake
Frame1.Move UserControl.ScaleWidth / i_Max * i_Value, 0, UserControl.ScaleWidth, UserControl.ScaleHeight
End Sub
Private Sub UserControl_InitProperties()
m_BackColor = m_def_BackColor
m_ForeColor = m_def_ForeColor
m_Min = m_def_Min
m_Max = m_def_Max
m_Value = m_def_Value
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
m_Min = PropBag.ReadProperty("Min", m_def_Min)
m_Max = PropBag.ReadProperty("Max", m_def_Max)
m_Value = PropBag.ReadProperty("Value", m_def_Value)
'after getting all the settings, initialize stuff and make them visible
Frame1.BackColor = m_BackColor
UserControl.BackColor = m_ForeColor
'initialize helper variables
i_Max = Abs(i_Max - i_Min)
If m_Min < m_Max Then
'min is smaller than max
i_Value = Abs(m_Value - m_Min)
Else
'max is smaller than min
i_Value = Abs(m_Value - m_Max)
End If
'make the changes visible the first time
RefreshProgress
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "BackColor", m_BackColor, m_def_BackColor
PropBag.WriteProperty "ForeColor", m_ForeColor, m_def_ForeColor
PropBag.WriteProperty "Min", m_Min, m_def_Min
PropBag.WriteProperty "Max", m_Max, m_def_Max
PropBag.WriteProperty "Value", m_Value, m_def_Value
End Sub