Comments

This is a very simple Alarm Class. You set the alarm to go off in so many milliseconds and it will fire the Alarm event when the inverval is reached. The API callback function TimerProc is used, hence the need for the Alarm Module.

The code is undocumented, but should be easy enough to follow.

Reference

AlarmClass Properties

IsSet

Read-Only. Indicates whether the Alram is currently set.

Return Type is a Boolean

AlarmClass Methods

CancelAlarm

Cancels the Alarm if it is set.

Return Type is a Boolean Value

SetAlarm (Wait)

Sets the alarm to go off after the given duration. If the alarm is currently set calling SetAlarm will cancel the previous alarm.

Return Type is a Boolean Value

Usage

Add AlarmClass.cls and AlarmModule.bas to your project

Option Explicit

Dim WithEvents Alarm As AlarmClass

Private Sub Alarm_Alarm()

   MsgBox "Alarm!"

End Sub

Private Sub cmdSetAlarm_Click()

   Alarm.SetAlarm 5000

End Sub

Private Sub cmdCancelAlarm_Click()

   Alarm.CancelAlarm

End Sub

Private Sub Form_Load()

   Set Alarm = New AlarmClass

End Sub

Private Sub Form_Unload(Cancel As Integer)

   Set Alarm = Nothing

End Sub

The Code

AlarmClass.cls

Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal _
nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal _
nIDEvent As Long) As Long

Public Event Alarm()

Private AlarmID As Long

Public Property Get IsSet() As Boolean

   IsSet = AlarmID <> 0

End Property

Public Function SetAlarm(Wait As Long) As Boolean

   CancelAlarm
   AlarmID = SetTimer(0, 0, Wait, AddressOf TimerProc)
   SetAlarm = AlarmID <> 0

End Function

Public Function CancelAlarm() As Boolean

   If AlarmID <> 0 Then
      If KillTimer(0, AlarmID) <> 0 Then
         AlarmID = 0
         CancelAlarm = True
      End If
   End If

End Function

Friend Sub RaiseAlarm()

   CancelAlarm
   RaiseEvent Alarm

End Sub

Private Sub Class_Initialize()

   Set mAlarm = Me

End Sub

Private Sub Class_Terminate()

   CancelAlarm
   Set mAlarm = Nothing

End Sub

AlarmModule.bas

Option Explicit

Public mAlarm As AlarmClass

Public Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent _
As Long, ByVal dwTime As Long) As Long

   mAlarm.RaiseAlarm

End Function

Downloads

  AlarmClass.zip - contains: AlarmClass.cls, AlarmModule.bas (0.9 kb)

© Copyright Notice

Unless otherwise stated, the code on this site is Copyright to Andrew McMillan. You may use this code in your projects (both commercial and non-commercial) but you are not permitted to republish this code in any form without the Author's prior consent.

The code on this site is supplied "as is" and no claims are made as to its soundness. The Author claims no responsibility for or liability from use of said source code.