by Deepa Varghese (1 Submission)
Category: OLE/COM/DCOM/Active-X
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 17th October 2003
Date Added: Mon 8th February 2021
Rating: (1 Votes)
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
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
No comments have been posted about This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The t. Why not be the first to post a comment about This is a timer control which can accept the interval and interval type(Hour,Minute,Seconds). The t.