enhancedtimer.ctl

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.UserControl ctlEnhancedTimer 
   ClientHeight    =   465
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   465
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   465
   ScaleWidth      =   465
   Begin VB.Timer tmrCheckIt 
      Left            =   0
      Top             =   0
   End
End
Attribute VB_Name = "ctlEnhancedTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'Default Property Values:
Const m_def_TimeToTrigger = 0
'Property Variables:
Dim m_TimeToTrigger As Date
'Event Declarations:
Event ExtendedTimerPop()

' Private control variables
Private m_bLastInternalTimer As Boolean


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=tmrCheckIt,tmrCheckIt,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = tmrCheckIt.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    If Ambient.UserMode = True Then
        tmrCheckIt.Interval = SetTimer()
    End If
    tmrCheckIt.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

Public Property Get TimeToTrigger() As Date
    TimeToTrigger = m_TimeToTrigger
End Property

Public Property Let TimeToTrigger(ByVal New_TimeToTrigger As Date)
    
    ' Check that the new value is a valid date.
    If Not IsDate(New_TimeToTrigger) Then
        Err.Raise 380
        Err.Clear
        Exit Property
    End If
    
    m_TimeToTrigger = New_TimeToTrigger
    PropertyChanged "TimeToTrigger"
End Property

Private Function SetTimer() As Integer
' Determine if this is should be the last internal
' timer call
    Dim lDifference As Long
    
    lDifference = DateDiff("s", TimeValue(Now()), _
                    TimeValue(TimeToTrigger))
    If lDifference < 30 And lDifference > 0 Then
        ' This is the last timer to use
        m_bLastInternalTimer = True
        SetTimer = CInt(lDifference) * 1000
    Else
        ' Set timer for 30 more seconds
        m_bLastInternalTimer = False
        SetTimer = 30000
    End If

End Function

Private Sub tmrCheckIt_Timer()
' Handle the internal timer pop
    
    If m_bLastInternalTimer Then
        ' Notify the container
        tmrCheckIt.Enabled = False
        RaiseEvent ExtendedTimerPop
    Else
        ' Wait a while longer
        tmrCheckIt.Interval = SetTimer()
        tmrCheckIt.Enabled = True
    End If
    
End Sub

Private Sub UserControl_InitProperties()
' Set up the timer variables
    
    ' Set the timer
    If Ambient.UserMode = True Then
        tmrCheckIt.Interval = SetTimer()
    End If
        
    m_TimeToTrigger = m_def_TimeToTrigger
    
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    tmrCheckIt.Enabled = PropBag.ReadProperty("Enabled", True)
    m_TimeToTrigger = PropBag.ReadProperty("TimeToTrigger", m_def_TimeToTrigger)
End Sub

Private Sub UserControl_Resize()
' Resize the user control to a fixed size
    
    Size 420, 420
    
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Enabled", tmrCheckIt.Enabled, True)
    Call PropBag.WriteProperty("TimeToTrigger", m_TimeToTrigger, m_def_TimeToTrigger)
End Sub