ftimertest.frm

一个很好用的增强的Timer库（可以取代VB的Timer控件）.

   Begin VB.Label lblRes 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblRes"
      Height          =   315
      Left            =   1800
      TabIndex        =   26
      Top             =   4620
      Width           =   975
   End
   Begin VB.Label lblResCap 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "System Resolution:"
      Height          =   195
      Left            =   345
      TabIndex        =   25
      Top             =   4680
      Width           =   1350
   End
   Begin VB.Label lblMinCap 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "Minimum Resolution:"
      Height          =   195
      Left            =   240
      TabIndex        =   27
      Top             =   5100
      Width           =   1455
   End
   Begin VB.Label lblMaxCap 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "Maximum Resolution:"
      Height          =   195
      Left            =   195
      TabIndex        =   29
      Top             =   5520
      Width           =   1500
   End
   Begin VB.Label lblMax 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblMax"
      Height          =   315
      Left            =   1800
      TabIndex        =   30
      Top             =   5460
      Width           =   975
   End
   Begin VB.Label lblMin 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblMin"
      Height          =   315
      Left            =   1800
      TabIndex        =   28
      Top             =   5040
      Width           =   975
   End
End
Attribute VB_Name = "frmTimerTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private WithEvents Timer1 As ccrpTimer
Attribute Timer1.VB_VarHelpID = -1
Private WithEvents Timer2 As ccrpTimer
Attribute Timer2.VB_VarHelpID = -1
Private WithEvents Timer3 As ccrpTimer
Attribute Timer3.VB_VarHelpID = -1
Private WithEvents Countdown1 As ccrpCountdown
Attribute Countdown1.VB_VarHelpID = -1
Private StopWatch1 As ccrpStopWatch

Private Sub chkEnabled_Click(Index As Integer)
   Select Case Index
      Case 0
         Timer1.Enabled = CBool(chkEnabled(Index))
      Case 1
         Timer2.Enabled = CBool(chkEnabled(Index))
      Case 2
         Timer3.Interval = Val(txtTimer3.Text)
         Timer3.Enabled = CBool(chkEnabled(Index))
         If CBool(chkEnabled(Index)) Then
            lblTimer3.Caption = " Waiting"
         Else
            lblTimer3.Caption = ""
         End If
      Case 3
         Countdown1.Enabled = CBool(chkEnabled(Index).Value)
   End Select
End Sub

Private Sub cmdAbout_Click()
   Timer1.About
End Sub

Private Sub cmdCountdown1_Click()
   Countdown1.Duration = txtCountdown1.Text
End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub

Private Sub cmdReset_Click()
   StopWatch1.Reset
   lblStopWatch.Caption = " " & Format(StopWatch1.Elapsed, "#,##0") & " ms"
End Sub

Private Sub cmdFrequency_Click()
   With Timer1.Stats
      .Frequency = Val(txtFrequency.Text)
      lblRes.Caption = " " & Format(.Resolution, "#,##0") & " ms"
      lblMin.Caption = " " & Format(.MinimumResolution, "#,##0") & " ms"
      lblMax.Caption = " " & Format(.MaximumResolution, "#,##0") & " ms"
      lblFreq.Caption = " " & Format(.Frequency, "#,##0") & " ms"
   End With
End Sub

Private Sub cmdStopWatch1_Click(Index As Integer)
   If Index = 1 Then ' Reset before displaying elapsed time
      StopWatch1.Reset
   End If
   lblStopWatch.Caption = " " & Format(StopWatch1.Elapsed, "#,##0") & " ms"
End Sub

Private Sub cmdTimer1_Click()
   Timer1.Interval = Val(txtTimer1.Text)
End Sub

Private Sub cmdTimer2_Click()
   Timer2.Interval = Val(txtTimer2.Text)
End Sub

Private Sub Countdown1_Tick(ByVal TimeRemaining As Long)
   lblCountdown1.Caption = " " & Format(TimeRemaining / 1000, "0.0") & " sec"
End Sub

Private Sub Countdown1_Timer()
   chkEnabled(3).Value = Abs(Countdown1.Enabled)
End Sub

Private Sub Form_Load()
   Set Timer1 = New ccrpTimer
   Set Timer2 = New ccrpTimer
   Set Timer3 = New ccrpTimer
   Set StopWatch1 = New ccrpStopWatch
   Set Countdown1 = New ccrpCountdown
   With Timer1
      .EventType = TimerPeriodic
      .Interval = 1000
      .Stats.Frequency = 20
      .Enabled = True
      txtTimer1.Text = .Interval
      lblTimer1.Caption = " 0"
   End With
   With Timer2
      .EventType = TimerPeriodic
      .Interval = 250
      .Enabled = True
      txtTimer2.Text = .Interval
      lblTimer2.Caption = " 0"
   End With
   With Timer3
      .EventType = TimerOneShot
      .Interval = 2000       ' 2 seconds
      .Enabled = False
      txtTimer3.Text = .Interval
      lblTimer3.Caption = ""
   End With
   With Countdown1
      .Duration = 5000       ' 5 seconds
      .Interval = 100        ' 0.1 seconds
      .Enabled = False
      lblCountdown1.Caption = ""
      txtCountdown1.Text = .Duration
   End With
   Me.Icon = Nothing
   With Timer1.Stats
      lblRes.Caption = " " & Format(.Resolution, "#,##0") & " ms"
      lblMin.Caption = " " & Format(.MinimumResolution, "#,##0") & " ms"
      lblMax.Caption = " " & Format(.MaximumResolution, "#,##0") & " ms"
      lblFreq.Caption = " " & Format(.Frequency, "#,##0") & " ms"
      txtFrequency.Text = .Frequency
   End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
   '
   ' Nice stable shutdown. Shouldn't be necessary, but
   ' is good form. Can prevent needless debugging.
   '
   Timer1.Enabled = False
   Set Timer1 = Nothing
   Timer2.Enabled = False
   Set Timer2 = Nothing
   Timer3.Enabled = False
   Set Timer3 = Nothing
   Set StopWatch1 = Nothing
   Countdown1.Enabled = False
   Set Countdown1 = Nothing
End Sub

Private Sub Timer1_Timer(ByVal Milliseconds As Long)
   Static Ticks As Long
   '
   ' Updating the display more often than every 10ms can blow
   ' Win95's 16-bit GDI to shreds -- hardlock or system reset.
   '
   Ticks = Ticks + Milliseconds
   If Timer1.Interval >= 10 Then
      lblTimer1.Caption = " " & Format(Ticks, "#,##0")
   ElseIf (Ticks Mod 10) = 0 Then
      lblTimer1.Caption = " " & Format(Ticks, "#,##0")
   End If
End Sub

Private Sub Timer2_Timer(ByVal Milliseconds As Long)
   Static Ticks As Long
   '
   ' Updating the display more often than every 10ms can blow
   ' Win95's 16-bit GDI to shreds -- hardlock or system reset.
   '
   Ticks = Ticks + Milliseconds
   If Timer2.Interval >= 10 Then
      lblTimer2.Caption = " " & Format(Ticks, "#,##0")
   ElseIf (Ticks Mod 10) = 0 Then
      lblTimer2.Caption = " " & Format(Ticks, "#,##0")
   End If
End Sub

Private Sub Timer3_Timer(ByVal Milliseconds As Long)
   Dim sw As ccrpStopWatch
   Dim bc As Long
   Dim i As Long

   chkEnabled(2).Value = Abs(Timer3.Enabled)
   lblTimer3.Caption = Format(Milliseconds, "#,##0") & " ms"
   Set sw = New ccrpStopWatch
   With txtTimer3
      bc = .BackColor
      For i = 1 To 8 Step 2
         .BackColor = vbRed
         Do Until sw.Elapsed > (i * 250): DoEvents: Loop
         .BackColor = bc
         Do Until sw.Elapsed > ((i + 1) * 250): DoEvents: Loop
      Next i
   End With
   lblTimer3.Caption = ""
End Sub

Private Sub Highlight(txt As TextBox)
   txt.SelStart = 0
   txt.SelLength = Len(txt.Text)
End Sub

Private Sub txtCountdown1_GotFocus()
   Call Highlight(txtCountdown1)
End Sub

Private Sub txtFrequency_gotfocus()
   Call Highlight(txtFrequency)
End Sub

Private Sub txtTimer1_GotFocus()
   Call Highlight(txtTimer1)
End Sub

Private Sub txtTimer2_GotFocus()
   Call Highlight(txtTimer2)
End Sub

Private Sub txtTimer3_GotFocus()
   Call Highlight(txtTimer3)
End Sub