Creating Stopwatch/Timer on an Access Form

[lpgagirl]

Hi,
I need to create a timer/stopwatch in MS Access. It needs to work the same as a simple kitchen timer. The user inputs the hours/minutes (seconds not required), presses start (button changes to "stop&quot and the timer counts down...hopefully visually. When the timer gets to zero a chime starts and continues until it is acknowledged by the user.
I have basic VB programming knowlege...but I need big time help with this one. Should be rather simple for you REAL Tekkies out there.

I appreciate any help offered.
Thanks in advance.
Jeannie

 

[kraxmo]

Dear Jeannie,

Check out the form's timer event in MS Access Help. It needs the TimerInterval to be set in the Load event, reset in Current event, and then triggered via your start button.

You will need some sort of module-scoped or static variable to keep track of counts, and then you'll need to compare it to a user-entered value (properly converted, of course!) in the form's Timer event.

You will also need text time display and text time entry boxes and a time start/stop button.

Here is some sample code of the conversion part:

Private Sub Form_Timer()
Dim dblTime As Double

mlngTime = mlngTime + 1
dblTime = Now() - DateAdd("s", mlngTime, Now)
Me!txtTimeDisplay = Format(dblTime, "hh:nn:ss&quot
(DateAdd("s", CDbl(Me!txtTimeEdit), Now)), "hh:nn:ss&quot
If Format(dblTime, "hh:nn:ss&quot >= Format(Now - (DateAdd("s", CDbl(Me!txtTimeEdit), Now)), "hh:nn:ss&quot Then
Me.TimerInterval = 0
MsgBox "TIME'S UP!!!"
mlngTime = 0
Me!cmdTime.Caption = "STOP"
End If
End Sub

I'll let you play with the rest.

;-) Jim Kraxberger
Developing Access solutions since 1995

 

[lpgagirl]

Hi Jim,
Thanks for the info. Unfortunately I need a little more help. I have inserted the code and keep getting caught up in errors. The line: (DateAdd("s",Cdbl(Me!txtTimeEdit),Now)),"hh:mm:ss&quot keeps giving me an error. Also I need help in defining, I am not sure what variables you are using for what?

***Sorry, I need the Timer/Stopwatch for "dummies" version. I guess I need it all spelled out for me.***

It's been about 2 years since I did any programming.


Jeannie

 

[scking]

This works by setting two variables from within the code. This is not dependent on a form control like Me!txtTimeEdit. If you place the function call in a form timer it can display the time updated by the second seconds.

Dim Start As Variant
Dim Finish As Variant
Dim ETime As String
' Set at the beginning to start the stopwatch
Start = Timer()

' Set at the end to stop the stopwatch
Finish = Timer()
' Call the function to convert to a full time string
ETime = GetElapsedTime(Start, Finish)

' Or call the function to convert to a short time string
ETime = GetElapsedTime(Start, Finish, False)

Public Function GetElapsedTime(Start, Finish, Optional SetVerbose As Boolean = True) As String

Dim lngTotalElapsedSeconds As Long
Dim lngTotalElapsedTicks As Long
Dim intSecondsElapsed As Integer
Dim intMinutesElapsed As Integer
Dim intHoursElapsed As Integer
Dim strReturn As String
Dim strHours As String
Dim strMinutes As String
Dim strSeconds As String

On Error GoTo HandleErr

'lngTotalElapsedTicks = Finish - Start
'lngTotalElapsedSeconds = lngTotalElapsedTicks / 60000
lngTotalElapsedSeconds = Finish - Start
intHoursElapsed = Fix(lngTotalElapsedSeconds / 3600)
If intHoursElapsed > 0 Then
lngTotalElapsedSeconds = Fix(lngTotalElapsedSeconds - (intHoursElapsed * 3600))
End If

intMinutesElapsed = Fix(lngTotalElapsedSeconds / 60)
If intMinutesElapsed > 0 Then
lngTotalElapsedSeconds = lngTotalElapsedSeconds - (intMinutesElapsed * 60)
End If

intSecondsElapsed = lngTotalElapsedSeconds

If SetVerbose Then
If intHoursElapsed = 1 Then
strHours = intHoursElapsed & " Hour "
Else
strHours = intHoursElapsed & " Hours "
End If
If intMinutesElapsed = 1 Then
strMinutes = Format(intMinutesElapsed, "00&quot & " Minute and "
Else
strMinutes = Format(intMinutesElapsed, "00&quot & " Minutes and "
End If
If intSecondsElapsed = 1 Then
strSeconds = Format(intSecondsElapsed, "00&quot & " Second"
Else
strSeconds = Format(intSecondsElapsed, "00&quot & " Seconds"
End If
Else

strHours = intHoursElapsed & ":"
strMinutes = Format(intMinutesElapsed, "00&quot & ":"
strSeconds = Format(intSecondsElapsed, "00&quot

End If

strReturn = strHours & strMinutes & strSeconds
GetElapsedTime = strReturn

Exit_Proc:
On Error Resume Next
Exit Function

HandleErr:
GoTo Exit_Proc
Resume

End Function
-------------------------------------
scking@arinc.com
Try to resolve problems independently
Then seek help among peers or experts
But TEST recommended solutions
-------------------------------------

 

[kraxmo]

Hi Jeannie,

I'm assuming that you created the following:
1. 2 textboxes (txtTimeDisplay & txtTimeEdit)
a. Format: 00\:00\:00
b. DecimalPlaces: 0
c. InputMask: 99:99:99
d. Default Value: 0
2. Button cmdTime with Click event.

Here is the complete code module:

Option Compare Database
Option Explicit
[tt]
Dim mlngTime As Long

Private Sub cmdTime_Click()
If Me!cmdTime.Caption = "START" Then
Me!cmdTime.Caption = "STOP"
Me.TimerInterval = 1000
Else
Me!cmdTime.Caption = "START"
Me.TimerInterval = 0
End If
End Sub

Private Sub Form_Current()
Me.TimerInterval = 0
mlngTime = 0
End Sub

Private Sub Form_Load()
mlngTime = -1
Me.TimerInterval = mlngTime
End Sub

Private Sub Form_Timer()
Dim dblTime As Double

mlngTime = mlngTime + 1
dblTime = Now() - DateAdd("s", mlngTime, Now)
Me!txtTimeDisplay = Format(dblTime, "hh:nn:ss&quot
Debug.Print Format(dblTime, "hh:nn:ss&quot, Format(Now - (DateAdd("s", CDbl(Me!txtTimeEdit), Now)), "hh:nn:ss&quot
If Format(dblTime, "hh:nn:ss&quot >= Format(Now - (DateAdd("s", CDbl(Me!txtTimeEdit), Now)), "hh:nn:ss&quot Then
Me.TimerInterval = 0
MsgBox "TIME'S UP!!!"
mlngTime = 0
Me!cmdTime.Caption = "STOP"
End If
End Sub[/tt]

Good Luck!!! Jim Kraxberger
Developing Access solutions since 1995

 

[lpgagirl]

YOU GUYS ARE THE BEST!!!!!!!!!!

THANK YOU, THANK YOU, THANK YOU.

One more little thing. How do I have the form continue to "ding" until the user aknowledges by clicking OK in the message box? I am guessing a loop in the click event...but don't know how to create that.

Thanks again.

Jeannie

 

[lpgagirl]

Hi Jim,

I used your code and thought everything was working fine. However, I found that when I enter 00:01:00 (1 min) the elapsed time continues until 01:40 before the message function appears. 2 minutes = 3:20, 3 minutes = 5:00 and 01:00:00 (1 hour) runs for 2:46:40. If I put in 60 sec instead of 1 min it works fine, but I need to be able to enter for example 20:00 min. or 01:00:00 hour. And have the timer stop at the correct time.

Thanks in advance.
Jeannie

 

[scking]

Jeannie,

Careful that you don't get too intrusive on a user session. Looping with a message, which is modal, can be very counterproductive. You could loop with a bell or loop with a message that would allow them to turn it off.

If bTurnOff = False Then
If MsgBox("Alarm." & vbCrLf & "Turn of this msg?&quot = vbYes Then
bTurnOff = True
End If
End If

My first theory is that the function is using decimal arithmetic to get the seconds counted down (100 = 1 Minute and 40 seconds, 200 = 2 minutes and 120 seconds or 3 minutes and 20 seconds). Use MOD arithmetic to determine the number os minutes (base 60) in a decimal number. 60 Mod 60 = 1, 120 mod 60 = 2. This actually needs to be debugged using the immediate window to get the fix determined. Maybe Jim will oblige to correct the form.

-------------------------------------
scking@arinc.com
Try to resolve problems independently
Then seek help among peers or experts
But TEST recommended solutions
-------------------------------------

 

[beetee]

' this is kinda long, but I had it laying around
' it converts just about anything to milliseconds, the
' units of an event timer.

Const c_SecondsInMinute As Integer = 60
Const c_SecondsInHour As Integer = c_SecondsInMinute * 60
Const c_SecondsInDay As Long = c_SecondsInHour * 24&
Const c_SecondsInWeek As Long = c_SecondsInDay * 7
Const c_SecondsInMonth As Double = c_SecondsInDay * 30#
Const c_SecondsInYear As Double = c_SecondsInDay * 365#

Public Function IsComma(CharValue As Integer) As Boolean
IsComma = (CharValue = Asc(",&quot)
End Function

Public Function IsBlank(CharValue As Integer) As Boolean
IsBlank = (CharValue = Asc(" &quot)
End Function

Public Function IsDigit(CharValue As Integer) As Boolean
IsDigit = (CharValue >= Asc(&quot;0&quot And CharValue <= Asc(&quot;9&quot)
End Function

Public Function IsMinus(CharValue As Integer) As Boolean
IsMinus = (CharValue = Asc(&quot;-&quot)
End Function

Public Function IsDot(CharValue As Integer) As Boolean
IsDot = (CharValue = Asc(&quot;.&quot)
End Function


Public Function IsNumeric(CharValue As Integer) As Boolean
IsNumeric = (IsDigit(CharValue) Or IsDot(CharValue) Or IsMinus(CharValue))
End Function


Function ConvertTextToMilliseconds(IntervalValue As String, RetVal As Double, Optional FractionOfDayAllowed As Boolean = True) As Boolean
ConvertTextToMilliseconds = False
Const c_MyName As String = &quot;ConvertTextToMilliseconds&quot;
On Error GoTo ConvertTextToMillisecondsError
IntervalValue = Trim(IntervalValue)
RetVal = 0
Dim Position As Integer
Position = 1
Dim StrLen As Integer
StrLen = Len(IntervalValue)

Dim HadNumber As Boolean
HadNumber = False
Dim NumericText As String
NumericText = &quot;&quot;

Dim HadUnits As Boolean
HadUnits = False
Dim UnitsText As String
UnitsText = &quot;&quot;

ConvertTextToMilliseconds = True
Do While Position <= StrLen
Do While Position <= StrLen
Dim CurChar As String
Dim CharValue As Integer
Do While Position <= StrLen
CurChar = Mid(IntervalValue, Position, 1)
CharValue = Asc(CurChar)
If Not (IsBlank(CharValue) Or IsComma(CharValue)) Then Exit Do
Position = Position + 1
Loop
If IsNumeric(CharValue) Then
Do While Position <= StrLen
CurChar = Mid(IntervalValue, Position, 1)
CharValue = Asc(CurChar)
If Not IsNumeric(CharValue) Then Exit Do
Position = Position + 1
NumericText = NumericText & CurChar
Loop
NumericText = Trim(NumericText)
If Len(UnitsText) > 0 Then Exit Do
Else
Do While Position <= StrLen
CurChar = Mid(IntervalValue, Position, 1)
CharValue = Asc(CurChar)
If IsDigit(CharValue) Or IsMinus(CharValue) Or IsBlank(CharValue) Or IsComma(CharValue) Then Exit Do
Position = Position + 1
UnitsText = UnitsText & CurChar
HadUnits = True
Loop
UnitsText = Trim(UnitsText)
If Len(NumericText) > 0 Then Exit Do
End If
Loop
If Len(NumericText) > 0 Then
If Not FractionOfDayAllowed And Left(UnitsText, 1) = &quot;m&quot; Then UnitsText = &quot;mo&quot;
Dim Multiplier As Double
If Len(UnitsText) = 0 Then
If FractionOfDayAllowed Then
UnitsText = &quot;s&quot;
Else
UnitsText = &quot;d&quot;
End If
End If
Select Case UnitsText
Case &quot;years&quot;, &quot;yrs.&quot;, &quot;yrs&quot;, &quot;yr.&quot;, &quot;yr&quot;, &quot;y&quot;
Multiplier = c_SecondsInYear * 1000#
Case &quot;months&quot;, &quot;month&quot;, &quot;mnths&quot;, &quot;mons.&quot;, &quot;mons&quot;, &quot;mos.&quot;, &quot;mon.&quot;, &quot;mos&quot;, &quot;mon&quot;, &quot;mo.&quot;, &quot;mos.&quot;, &quot;mo&quot;
Multiplier = c_SecondsInMonth * 1000#
Case &quot;days&quot;, &quot;day&quot;, &quot;dys.&quot;, &quot;dys&quot;, &quot;dy.&quot;, &quot;dy&quot;, &quot;d.&quot;, &quot;d&quot;
Multiplier = c_SecondsInDay * 1000#
Case &quot;weeks&quot;, &quot;week&quot;, &quot;wks.&quot;, &quot;wks&quot;, &quot;wk.&quot;, &quot;wk&quot;, &quot;w.&quot;, &quot;w&quot;
Multiplier = c_SecondsInWeek * 1000#
Case &quot;hours&quot;, &quot;hrs.&quot;, &quot;hrs&quot;, &quot;hr.&quot;, &quot;hr&quot;, &quot;h&quot;
If Not FractionOfDayAllowed Then ConvertTextToMilliseconds = False
Multiplier = c_SecondsInHour * 1000#
Case &quot;minutes&quot;, &quot;minute&quot;, &quot;mins.&quot;, &quot;min.&quot;, &quot;mins&quot;, &quot;min&quot;, &quot;m&quot;
If Not FractionOfDayAllowed Then ConvertTextToMilliseconds = False
Multiplier = c_SecondsInMinute * 1000#
Case &quot;seconds&quot;, &quot;second&quot;, &quot;secs.&quot;, &quot;secs&quot;, &quot;sec.&quot;, &quot;sec&quot;, &quot;s&quot;
If Not FractionOfDayAllowed Then ConvertTextToMilliseconds = False
Multiplier = 1000#
Case &quot;milliseconds&quot;, &quot;millisecond&quot;, &quot;msec.&quot;, &quot;msec&quot;, &quot;ms.&quot;, &quot;ms&quot;
If Not FractionOfDayAllowed Then ConvertTextToMilliseconds = False
Multiplier = 1#
Case Else
ConvertTextToMilliseconds = False
End Select
RetVal = RetVal + Multiplier * CDbl(NumericText)
Else
If Len(UnitsText) = 0 Then
ConvertTextToMilliseconds = False
End If
Exit Do
End If
NumericText = &quot;&quot;
UnitsText = &quot;&quot;
Loop

ConvertTextToMillisecondsExit:
Exit Function

ConvertTextToMillisecondsError:
MsgBox &quot;Error in &quot; & c_MyName & &quot;: &quot; & Err.Number & &quot;, &quot; & Err.Description
Resume ConvertTextToMillisecondsExit
End Function

Function ConvertTextToDays(IntervalValue As String, RetVal As Double) As Boolean
Dim CovertedOK As Boolean
CovertedOK = ConvertTextToMilliseconds(IntervalValue, RetVal, False)
If CovertedOK Then
RetVal = RetVal / (c_SecondsInDay * 1000#)
End If
ConvertTextToDays = CovertedOK
End Function

Function TestMe()
Dim RetVal As Double

ConvertTextToMilliseconds &quot;5 m 37 s&quot;, RetVal, False
Debug.Print RetVal
End Function

 

[scking]

Let's be careful what we drop onto someone looking for help. In this case Jeannie would need to integrate this large amount of code into something to make it productive.

Problem Cause: The function did not take into consideration that reading the value of 1 minue from the text box converted to 100 or 1 minute and 40 seconds.

Corrected Function:
Option Compare Database
Option Explicit

Dim mlngTime As Long
Dim lngTimeEdit As Long
Dim strTimeEdit As String

Private Sub cmdTime_Click()
If Me!cmdTime.Caption = &quot;START&quot; Then
Me!cmdTime.Caption = &quot;STOP&quot;
strTimeEdit = Me.txtTimeEdit
Select Case Len(strTimeEdit)
Case 1
strTimeEdit = &quot;00000&quot; & strTimeEdit
Case 2
strTimeEdit = &quot;0000&quot; & strTimeEdit
Case 3
strTimeEdit = &quot;000&quot; & strTimeEdit
Case 4
strTimeEdit = &quot;00&quot; & strTimeEdit
Case 5
strTimeEdit = &quot;0&quot; & strTimeEdit
Case Else
End Select
lngTimeEdit = ((CLng(Mid$(strTimeEdit, 1, 2)) * 3600) + _
(CLng(Mid$(strTimeEdit, 3, 2)) * 60) + _
(CLng(Mid$(strTimeEdit, 5, 2))))
'mlngTime = lngTimeEdit

Me.TimerInterval = 1000
Else
Me!cmdTime.Caption = &quot;START&quot;
Me.TimerInterval = 0
End If
End Sub

Private Sub Form_Current()
Me.TimerInterval = 0
mlngTime = 0
End Sub

Private Sub Form_Load()
mlngTime = -1
Me.TimerInterval = mlngTime
End Sub

Private Sub Form_Timer()
Dim dblTime As Double

mlngTime = mlngTime + 1
dblTime = Now() - DateAdd(&quot;s&quot;, mlngTime, Now)
Me!txtTimeDisplay = Format(dblTime, &quot;hh:nn:ss&quot
Debug.Print Format(dblTime, &quot;hh:nn:ss&quot, Format(Now - (DateAdd(&quot;s&quot;, CDbl(Me!txtTimeEdit), Now)), &quot;hh:nn:ss&quot
If Format(dblTime, &quot;hh:nn:ss&quot >= Format(Now - (DateAdd(&quot;s&quot;, CDbl(lngTimeEdit), Now)), &quot;hh:nn:ss&quot Then
Me.TimerInterval = 0
MsgBox &quot;TIME'S UP!!!&quot;
mlngTime = 0
Me!cmdTime.Caption = &quot;STOP&quot;
End If
End Sub

-------------------------------------
scking@arinc.com
Try to resolve problems independently
Then seek help among peers or experts
But TEST recommended solutions
-------------------------------------

 

[beetee]

1) the code is a generic answer to the problem, rather than a knee-jerk response to a specific question.
2) the code is self contained and easy to integrate, and is production-tested
3) perhaps others can make use of it