fnotify.frm

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

VERSION 5.00
Begin VB.Form FNotify 
   Caption         =   "Form1"
   ClientHeight    =   4425
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5175
   Icon            =   "FNotify.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4425
   ScaleWidth      =   5175
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame3 
      Caption         =   "Intrinsic Timer:"
      Height          =   795
      Left            =   120
      TabIndex        =   17
      Top             =   3000
      Width           =   4935
      Begin VB.Timer tmrClassic 
         Left            =   4440
         Top             =   240
      End
      Begin VB.CheckBox chkEvent 
         Caption         =   "Enabled"
         Height          =   255
         Index           =   2
         Left            =   3360
         TabIndex        =   18
         Top             =   360
         Width           =   1395
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "Classic Event Method:"
         Height          =   195
         Index           =   4
         Left            =   180
         TabIndex        =   20
         Top             =   360
         Width           =   1590
      End
      Begin VB.Label lblEvent 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblEvent"
         Height          =   315
         Index           =   2
         Left            =   1920
         TabIndex        =   19
         Top             =   300
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdAbout 
      Cancel          =   -1  'True
      Caption         =   "&About"
      Height          =   375
      Left            =   1860
      TabIndex        =   16
      Top             =   3960
      Width           =   1455
   End
   Begin VB.Frame Frame2 
      Caption         =   "Implements ICcrpCountdownNotify:"
      Height          =   1275
      Left            =   120
      TabIndex        =   9
      Top             =   1560
      Width           =   4935
      Begin VB.CheckBox chkNotify 
         Caption         =   "Enabled"
         Height          =   255
         Index           =   1
         Left            =   3360
         TabIndex        =   11
         Top             =   780
         Width           =   1395
      End
      Begin VB.CheckBox chkEvent 
         Caption         =   "Enabled"
         Height          =   255
         Index           =   1
         Left            =   3360
         TabIndex        =   10
         Top             =   420
         Width           =   1395
      End
      Begin VB.Label lblNotify 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblNotify"
         Height          =   315
         Index           =   1
         Left            =   1920
         TabIndex        =   15
         Top             =   780
         Width           =   1215
      End
      Begin VB.Label lblEvent 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblEvent"
         Height          =   315
         Index           =   1
         Left            =   1920
         TabIndex        =   14
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "Notification Method:"
         Height          =   195
         Index           =   3
         Left            =   345
         TabIndex        =   13
         Top             =   840
         Width           =   1425
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "Classic Event Method:"
         Height          =   195
         Index           =   2
         Left            =   180
         TabIndex        =   12
         Top             =   420
         Width           =   1590
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Implements ICcrpTimerNotify:"
      Height          =   1275
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4935
      Begin VB.CheckBox chkEvent 
         Caption         =   "Enabled"
         Height          =   255
         Index           =   0
         Left            =   3360
         TabIndex        =   3
         Top             =   420
         Width           =   1395
      End
      Begin VB.CheckBox chkNotify 
         Caption         =   "Enabled"
         Height          =   255
         Index           =   0
         Left            =   3360
         TabIndex        =   6
         Top             =   780
         Width           =   1395
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "Classic Event Method:"
         Height          =   195
         Index           =   0
         Left            =   180
         TabIndex        =   1
         Top             =   420
         Width           =   1590
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "Notification Method:"
         Height          =   195
         Index           =   1
         Left            =   345
         TabIndex        =   4
         Top             =   840
         Width           =   1425
      End
      Begin VB.Label lblEvent 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblEvent"
         Height          =   315
         Index           =   0
         Left            =   1920
         TabIndex        =   2
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label lblNotify 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblNotify"
         Height          =   315
         Index           =   0
         Left            =   1920
         TabIndex        =   5
         Top             =   780
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "E&xit"
      Height          =   375
      Left            =   3480
      TabIndex        =   8
      Top             =   3960
      Width           =   1455
   End
   Begin VB.CommandButton cmdBlock 
      Caption         =   "Test &Blocking"
      Height          =   375
      Left            =   240
      TabIndex        =   7
      Top             =   3960
      Width           =   1455
   End
End
Attribute VB_Name = "FNotify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Implements ICcrpTimerNotify
Private tmrNotify As ccrpTimer
Private WithEvents tmrEvent As ccrpTimer
Attribute tmrEvent.VB_VarHelpID = -1

Implements ICcrpCountdownNotify
Private cntNotify As ccrpCountdown
Private WithEvents cntEvent As ccrpCountdown
Attribute cntEvent.VB_VarHelpID = -1

Private tmrStopWatch As ccrpStopWatch

Const nTmr = 0
Const nCnt = 1
Const nVb = 2

Private Sub chkEvent_Click(Index As Integer)
   If Index = nTmr Then
      tmrEvent.Enabled = CBool(chkEvent(Index).Value)
   ElseIf Index = nCnt Then
      cntEvent.Enabled = CBool(chkEvent(Index).Value)
   ElseIf Index = nVb Then
      tmrClassic.Enabled = CBool(chkEvent(Index).Value)
   End If
End Sub

Private Sub chkNotify_Click(Index As Integer)
   If Index = nTmr Then
      tmrNotify.Enabled = CBool(chkNotify(Index).Value)
   Else
      cntNotify.Enabled = CBool(chkNotify(Index).Value)
   End If
End Sub

Private Sub cmdAbout_Click()
   tmrNotify.About
End Sub

Private Sub cmdBlock_Click()
   MsgBox "This MsgBox should block the Event driven timers, " & vbCrLf & _
          "but only within the IDE."
End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub

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

Private Sub cntEvent_Timer()
   chkEvent(nCnt).Value = vbUnchecked
   lblEvent(nCnt).Caption = " Done!"
End Sub

Private Sub Form_Load()
   Set tmrNotify = New ccrpTimer
   With tmrNotify
      .EventType = TimerPeriodic
      .Interval = 100
      Set .Notify = Me
      .Stats.Frequency = 10
   End With
   
   Set tmrEvent = New ccrpTimer
   With tmrEvent
      .EventType = TimerPeriodic
      .Interval = 100
   End With
   
   Set cntNotify = New ccrpCountdown
   With cntNotify
      .Duration = 20000
      .Interval = 100
      Set .Notify = Me
   End With
   
   Set cntEvent = New ccrpCountdown
   With cntEvent
      .Duration = 20000
      .Interval = 100
   End With
   
   With tmrClassic
      .Interval = 100
   End With
   
   Set tmrStopWatch = New ccrpStopWatch
   
   Me.Caption = "Implemented Timer Notification Demo"
   lblEvent(nCnt).Caption = ""
   lblNotify(nCnt).Caption = ""
   
   chkEvent(nTmr).Value = vbChecked
   chkNotify(nTmr).Value = vbChecked
   chkEvent(nVb).Value = vbChecked
End Sub

Private Sub Form_Unload(Cancel As Integer)
   tmrEvent.Enabled = False
   Set tmrEvent = Nothing
   
   tmrNotify.Enabled = False
   Set tmrNotify = Nothing
   
   cntEvent.Enabled = False
   Set cntEvent = Nothing
   
   cntNotify.Enabled = False
   Set cntNotify = Nothing
End Sub

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

Private Sub ICcrpCountdownNotify_Timer()
   chkNotify(nCnt).Value = vbUnchecked
   lblNotify(nCnt).Caption = " Done!"
End Sub

Private Sub ICcrpTimerNotify_Timer(ByVal Milliseconds As Long)
   Static Ticks As Long
   Ticks = Ticks + Milliseconds
   lblNotify(nTmr).Caption = " " & Format(Ticks, "#,##0")
End Sub

Private Sub tmrClassic_Timer()
   lblEvent(nVb).Caption = " " & Format(tmrStopWatch.Elapsed, "#,##0")
End Sub

Private Sub tmrEvent_Timer(ByVal Milliseconds As Long)
   Static Ticks As Long
   Ticks = Ticks + Milliseconds
   lblEvent(nTmr).Caption = " " & Format(Ticks, "#,##0")
End Sub