VB5 HiResTimer Full Source Code (26K)
VB6 HiResTimer Full Source Code (29K)
21 Nov 2002
Added a VB6 version of the timer. Note that in the VB6 version, we need to use a Type Library to call the PostMessage Win32 call. This is because the multimedia timer fires on another thread to the VB application, and, as described in Matt Curland's excellent book "Advanced Visual Basic" VB6 uses Thread Local Storage which isn't initialised on receipt of an event from another Thread. As a consequence you can only make calls to methods described in a type library.
vbAccelerator - Contents of code file: frmTest.frm
VERSION 5.00
Begin VB.Form frmHiResTimerTest
Caption = "vbAccelerator MultiMedia Timer Test"
ClientHeight = 3375
ClientLeft = 3720
ClientTop = 2190
ClientWidth = 5760
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3375
ScaleWidth = 5760
Begin VB.CommandButton cmdDisableAll
Caption = "&Disable All"
Height = 315
Left = 1380
TabIndex = 9
Top = 60
Width = 1155
End
Begin VB.CommandButton cmdEnableAll
Caption = "&Enable All"
Height = 315
Left = 180
TabIndex = 8
Top = 60
Width = 1155
End
Begin VB.CheckBox chkEnabled
Caption = "Hi-Res Timer &2 Enabled"
Height = 195
Index = 2
Left = 3420
TabIndex = 7
Top = 2400
Width = 2295
End
Begin VB.CheckBox chkEnabled
Caption = "Hi-Res Timer &1 Enabled"
Height = 195
Index = 1
Left = 3420
TabIndex = 6
Top = 1980
Width = 2295
End
Begin VB.CheckBox chkEnabled
Caption = "&Standard Timer Enabled"
Height = 195
Index = 0
Left = 3420
TabIndex = 5
Top = 660
Width = 2295
End
Begin VB.Timer tmrCompare
Enabled = 0 'False
Interval = 1
Left = 1260
Top = 360
End
Begin VB.Label lblHiRes
Caption = "High-Res Timer:"
Height = 195
Left = 180
TabIndex = 4
Top = 1680
Width = 2535
End
Begin VB.Label lblStandard
Caption = "Standard Timer:"
Height = 195
Left = 180
TabIndex = 3
Top = 420
Width = 2535
End
Begin VB.Label Label3
Height = 315
Left = 240
TabIndex = 2
Top = 720
Width = 3495
End
Begin VB.Label Label2
Height = 315
Left = 180
TabIndex = 1
Top = 2340
Width = 3555
End
Begin VB.Label Label1
Height = 255
Left = 180
TabIndex = 0
Top = 1980
Width = 3075
End
End
Attribute VB_Name = "frmHiResTimerTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents cTmr As cHiResTimer
Attribute cTmr.VB_VarHelpID = -1
Implements ITimer
Private Sub chkEnabled_Click(Index As Integer)
tmrCompare.Enabled = (chkEnabled(0).Value = Checked)
cTmr.Enabled("Label1Timer") = (chkEnabled(1).Value = Checked)
cTmr.Enabled("Label2Timer") = (chkEnabled(2).Value = Checked)
End Sub
Private Sub cmdDisableAll_Click()
Dim i As Long
For i = 0 To 2
chkEnabled(i).Value = Unchecked
Next i
End Sub
Private Sub cmdEnableAll_Click()
Dim i As Long
For i = 0 To 2
chkEnabled(i).Value = Checked
Next i
End Sub
Private Sub cTmr_Timer(ByVal sKey As String)
Static s_l1 As Long
Static s_l2 As Long
If (sKey = "Label1Timer") Then
s_l1 = s_l1 + 1
If s_l1 Mod 100 = 0 Then
Label1.Caption = s_l1
End If
End If
If (sKey = "Label2Timer") Then
s_l2 = s_l2 + 1
If s_l2 Mod 100 = 0 Then
Label2.Caption = s_l2
End If
End If
End Sub
Private Sub Form_Load()
Set cTmr = New cHiResTimer
tmrCompare.Enabled = True
cTmr.Add "Label1Timer", 1, False
cTmr.Add "Label2Timer", 1, False
End Sub
Private Sub ITimer_Timer(ByVal sKey As String)
Static s_l1 As Long
Static s_l2 As Long
If (sKey = "Label1Timer") Then
s_l1 = s_l1 + 1
Label1.Caption = s_l1
End If
If (sKey = "Label2Timer") Then
s_l2 = s_l2 + 1
Label2.Caption = s_l2
End If
End Sub
Private Sub tmrCompare_Timer()
Static s_l1 As Long
s_l1 = s_l1 + 1
If s_l1 Mod 100 = 0 Then
Label3.Caption = s_l1
End If
End Sub