• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The t

This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The t

This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The timer event of the control will be executed

Rate This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The t

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Const m_def_Interval = 1
Const m_def_FontTransparent = 0
Const m_def_CurrentX = 0
Const m_def_CurrentY = 0
Const m_def_FillColor = 0
Const m_def_Appearance = "1 - 3D"
Const m_def_BackColor = &H808080
Const m_def_BackStyle = 1
Const m_def_Caption = ""
Const m_def_Enabled = 0
Const m_def_FillStyle = 1
Const m_def_ForeColor = &H80&
'Property Variables:
Dim m_StartTime As Integer
Dim m_IntervalType1 As String
Dim m_Interval As Long
Dim m_CurrentX As Single
Dim m_CurrentY As Single
Dim m_FillColor As OLE_COLOR
Dim m_Appearance As String
Dim m_BackColor As OLE_COLOR
Dim m_BackStyle As Integer
Dim m_Caption As String
Dim m_Enabled As Boolean
Dim m_FillStyle As Integer
Dim m_Font As Font
Dim m_ForeColor As OLE_COLOR

Public Enum eIntervalType
  Hours
  Minutes
  Seconds
End Enum
Dim m_IntervalType As eIntervalType

'Event Declarations:
Public Event ctrlTimer()

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

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get BackStyle() As Integer
  BackStyle = lblTimer.BackStyle
End Property

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get Caption() As String
  Caption = lblTimer.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
  lblTimer.Caption() = New_Caption
  PropertyChanged "Caption"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,0
Public Property Get Enabled() As Boolean
  Enabled = Timer1.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  Timer1.Enabled() = New_Enabled
  PropertyChanged "Enabled"
  Timer1.Enabled = True
  lblTimer = Now
  If Enabled = True Then
    If m_IntervalType = Hours Then
      m_StartTime = Hour(Now)
    ElseIf m_IntervalType = Minutes Then
      m_StartTime = Minute(Now)
    Else
      m_StartTime = Second(Now)
    End If
  Else
    m_StartTime = 0
  End If
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=6,0,0,0
Public Property Get Font() As Font
  Set Font = lblTimer.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
  Set lblTimer.Font() = New_Font
  PropertyChanged "Font"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get ForeColor() As OLE_COLOR
  ForeColor = lblTimer.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  lblTimer.ForeColor() = New_ForeColor
  PropertyChanged "ForeColor"
End Property

Private Sub Timer1_Timer()
    lblTimer.Caption = Now
    If m_IntervalType = Hours Then
      m_IntervalType1 = Hour(Now)
    ElseIf m_IntervalType = Minutes Then
      m_IntervalType1 = Minute(Now)
    Else
      m_IntervalType1 = Second(Now)
    End If
    
    If (m_StartTime + m_Interval) = 12 Then
        If m_IntervalType1 = 1 Then
          RaiseEvent ctrlTimer
        End If
    Else
        If m_IntervalType1 = m_StartTime + m_Interval Then
          RaiseEvent ctrlTimer
        End If
    End If
    m_StartTime = m_IntervalType1
End Sub

Private Sub UserControl_Initialize()
    Timer1.Enabled = False
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
  m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  m_FillStyle = PropBag.ReadProperty("FillStyle", m_def_FillStyle)
  Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
  m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  m_Appearance = PropBag.ReadProperty("Appearance", m_def_Appearance)
  m_CurrentX = PropBag.ReadProperty("CurrentX", m_def_CurrentX)
  m_CurrentY = PropBag.ReadProperty("CurrentY", m_def_CurrentY)
  m_FillColor = PropBag.ReadProperty("FillColor", m_def_FillColor)
  m_FontTransparent = PropBag.ReadProperty("FontTransparent", m_def_FontTransparent)
  m_Interval = PropBag.ReadProperty("Interval", m_def_Interval)
  m_IntervalType = PropBag.ReadProperty("IntervalType", m_def_IntervalType)
End Sub

Private Sub UserControl_Resize()
    With lblTimer
        .Height = UserControl.ScaleHeight
        .Top = UserControl.ScaleTop
        .Left = UserControl.ScaleLeft
        .Width = UserControl.ScaleWidth
    End With
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("BackColor", lblTimer.BackColor, m_def_BackColor)
  Call PropBag.WriteProperty("BackStyle", lblTimer.BackStyle, m_def_BackStyle)
  Call PropBag.WriteProperty("Caption", lblTimer.Caption, m_def_Caption)
  Call PropBag.WriteProperty("Enabled", lblTimer.Enabled, m_def_Enabled)
  Call PropBag.WriteProperty("Font", lblTimer.Font, Ambient.Font)
  Call PropBag.WriteProperty("FontBold", lblTimer.FontBold, m_def_FontBold)
  Call PropBag.WriteProperty("FontItalic", lblTimer.FontItalic, m_def_FontItalic)
  Call PropBag.WriteProperty("FontName", lblTimer.FontName, m_def_FontName)
  Call PropBag.WriteProperty("FontSize", lblTimer.FontSize, m_def_FontSize)
  Call PropBag.WriteProperty("ForeColor", lblTimer.ForeColor, m_def_ForeColor)
  Call PropBag.WriteProperty("Interval", m_Interval, m_def_Interval)
  Call PropBag.WriteProperty("Appearance", lblTimer.Appearance, m_def_Appearance)
  Call PropBag.WriteProperty("IntervalType", m_IntervalType, m_def_IntervalType)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,1 - 3D
Public Property Get Appearance() As String
  Appearance = lblTimer.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As String)
  lblTimer.Appearance = New_Appearance
  PropertyChanged "Appearance"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=12,0,0,0
Public Property Get CurrentX() As Single
  CurrentX = m_CurrentX
End Property

Public Property Let CurrentX(ByVal New_CurrentX As Single)
  m_CurrentX = New_CurrentX
  PropertyChanged "CurrentX"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=12,0,0,0
Public Property Get CurrentY() As Single
  CurrentY = m_CurrentY
End Property

Public Property Let CurrentY(ByVal New_CurrentY As Single)
  m_CurrentY = New_CurrentY
  PropertyChanged "CurrentY"
End Property

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

Public Property Let FillColor(ByVal New_FillColor As OLE_COLOR)
  m_FillColor = New_FillColor
  PropertyChanged "FillColor"
End Property
'
''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MemberInfo=13,0,0,Hours
Public Property Get IntervalType() As eIntervalType
  IntervalType = m_IntervalType
End Property

Public Property Let IntervalType(ByVal New_IntervalType As eIntervalType)
  m_IntervalType = New_IntervalType
  PropertyChanged "IntervalType"
  RaiseEvent ctrlTimer
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
  m_CurrentX = m_def_CurrentX
  m_CurrentY = m_def_CurrentY
  m_FillColor = m_def_FillColor
  m_FontTransparent = m_def_FontTransparent
  m_Interval = m_def_Interval
  m_IntervalType = m_def_IntervalType
  
End Sub

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

Public Property Let FontTransparent(ByVal New_FontTransparent As Boolean)
  m_FontTransparent = New_FontTransparent
  PropertyChanged "FontTransparent"
End Property

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

Public Property Let Interval(ByVal New_Interval As Long)
  m_Interval = New_Interval
  PropertyChanged "Interval"
End Property