Implementing a countdown timer for the Sudoku project

Why implement a countdown timer

When performing a task that will take some time it is useful to show how long it has taken, and how long to go. In this section we will implement a countdown timer so that Sudokus can be solved 'against the clock'. If you want to implement a more general countdown timer, look here.

Avoiding 'Microsoft time'

I'm sure you have all suffered from that installation problem where it says its 50% complete, suddenly jumps to 97% complete then starts again. This is particularly common with Microsoft applications - hence the term 'Microsoft Time'. In addition, a timer is quite often implemented as part of a loop of a process. However, in this case, since we are going to mainly be waiting for input, we wont have a processing loop to use, so we have to implement an asynchronous approach to updating our timer. 

What's needed?

We are going to need a couple of things
  • A label that will change color and size as the countdown progresses, and a textbox showing how many seconds are left.
  • The capability to schedule an update that resizes and recolors the label and updates the textbox.
  • A couple of controls to pause and restart the timer.
I've chosen to implement a class called cSudProgressBar to take care of these requirements, and to add a few controls to our form. This gives us this result - you can see the progress bar at the bottom, and I change the amount of time allowed depending on the calculated difficulty of the Sudoku. As usual the complete code and project is available in the download section.


Code and explanation

  • For timing, i'm using the cMicroTimer function which I implemented as part of the optimization package. 
  • For scheduling updates, i'm using Application.ontime - this schedules the next time that the progress bar needs updating. There are some quirks about application.ontime
Application.ontime is a method of the global application object. Its function is to schedule an upcoming event in a particular period of time. The application object is provided by Excel as an abbreviation which does not need to be prefixed by the global object to which Application belongs. The problem is that if multiple instances of Excel are running, it can become disconnected ans screw up. Luckily I found this Microsoft explanation that helped me to figure out to fix that problem. This led me to calling application.ontime with a prefix identifying the specific application object , which i have previously initialized in cSudPuzzle as follows. Set pxlApp = GetObject(, "Excel.Application").

Sub ScheduleUpdate()
     ' in case there are any outstanding - we only need one
    CancelScheduledUpdate
     
     'TimeSerial(hours, minutes, seconds)
    pNextUpdate = Now + TimeSerial(0, 0, cUpdateInterval)
    pPuzzle.xlApp.Application.OnTime pNextUpdate, pScheduledUpdateProcess
    
End Sub

One of the arguments for application.ontime is the name of the procedure that should run when the schedule time arrives (in this case the contents of pScheduleUpdateProcess). The strangeness here is that you cannot implement the called procedure as part of a class. It has to be a 'normal procedure'. Since I wanted to encapsulate all this in the cSudProgressBar class, we need a workaround. In this case, I initialize the class, passing to it the name of a 'normal procedure' that will know which class method to call. This name is stored in pScheduleUpdateProcess so it can be passed to application.Ontime. All that progressupdate does is to call the appropriate method. The key is to make sure it is a public procedure of a 'normal module'

           .progress.init 
                cspUzzle, .uForm.lbProgressBar,cspUzzle.Grid.timetoSolve, _
                            .uForm.tbCountDown, "progressupdate", _
                            .uForm.cbTimerStart, .uForm.cbTimerPaus

Public Sub progressUpdate()
' this is an indirect call to a method because application.ontime cannot access within a class
    If Not cspUzzle Is Nothing Then
        cspUzzle.FormGrid.progress.update
    End If
End Sub

  • The progress bar itself is an msforms.Label, whose length is shortened according to the %age of time that has passed. It will also change color as time runs out.
Public Sub update()

    ' mark this one as executed
    pNextUpdate = 0
    
    If pTimeAllowed > 0 And Not pPaused Then

        cBar.Width = 1 + (pLength - complete * pLength)
        pCountDown.Value = Int(pTimeAllowed - (elapsed + pCum))
        
        If complete < 0.34 Then
            pBar.BackColor = vbGreen
        
        ElseIf complete < 0.67 Then
            pBar.BackColor = vbYellow
        
        Else
            pBar.BackColor = vbRed
        
        End If
    End If
    ' update form
    DoEvents
    ' schedule another
    ScheduleUpdate
    
End Sub


The complete code is below, or can be downloaded as part of the Sudoku Project.

cSudProgressBar class

Option Explicit
Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private pStart As Double
Private pTimeAllowed As Double
Private pLength As Long
Private pBar As MSForms.label
Private pCountDown As MSForms.TextBox
Private pScheduledUpdateProcess As String
Private pNextUpdate As Date
Private pCum As Double
Private pbutStart As MSForms.CommandButton
Private pbutPause As MSForms.CommandButton
Private pPaused As Boolean
Private pPuzzle As cSudPuzzle

Const cUpdateInterval = 2
Private Property Get cBar() As Control
    Set cBar = pBar
End Property
Private Property Get cTb() As Control
    Set cTb = pCountDown
End Property
Private Property Get cStart() As Control
    Set cStart = pbutStart
End Property
Private Property Get cPause() As Control
    Set cPause = pbutPause
End Property
Public Sub init(csp As cSudPuzzle, p As MSForms.label, secs As Long, ptb As MSForms.TextBox, what As String, _
                pcbStart As MSForms.CommandButton, pbPause As MSForms.CommandButton)
    Set pBar = p
    Set pPuzzle = csp
    pTimeAllowed = secs
    pLength = cBar.Width
    Set pCountDown = ptb
    ptb.Value = secs
    pScheduledUpdateProcess = what
    Set pbutStart = pcbStart
    Set pbutPause = pbPause

End Sub
Public Sub start()
    pStart = cMicroTimer
    cBar.Visible = True
    cTb.Visible = True
    pbutStart.Visible = True
    pbutPause.Visible = True
    pbutStart.Enabled = True
    pbutPause.Enabled = True
    pCountDown.BackColor = vbWhite
    pCum = 0
    pPaused = False
    ScheduleUpdate
    
End Sub
Public Sub pause()
    pCum = elapsed + pCum
    pCountDown.BackColor = vbRed
    pPaused = True

End Sub
Public Sub reStart()
    pStart = microtimer
    pCountDown.BackColor = vbWhite
    pPaused = False
    update
    
End Sub

Public Sub CancelScheduledUpdate()
    'dont worry if one wasnt scheduled
    If pNextUpdate <> 0 Then
        
        pPuzzle.xlApp.Application.OnTime pNextUpdate, pScheduledUpdateProcess, , False
        Debug.Print "__Cancelling for " & pNextUpdate
        pNextUpdate = 0

    End If

End Sub
Sub ScheduleUpdate()
     ' in case there are any outstanding - we only need one
    CancelScheduledUpdate
     
     'TimeSerial(hours, minutes, seconds)
    pNextUpdate = Now + TimeSerial(0, 0, cUpdateInterval)
    pPuzzle.xlApp.Application.OnTime pNextUpdate, pScheduledUpdateProcess
    
End Sub
Public Sub destroy()
    If Not pBar Is Nothing Then
       CancelScheduledUpdate
        pBar.Visible = False
        cBar.Width = pLength
        cTb.Visible = False
        cTb.Value = Empty
        pTimeAllowed = 0
        pStart = 0
        pbutStart.Visible = False
        pbutPause.Visible = False
        pbutStart.Enabled = False
        pbutPause.Enabled = False
    End If
   
End Sub
Private Property Get complete() As Double
    Dim x As Double
    x = (elapsed + pCum) / pTimeAllowed
    If x > 1 Then
        complete = 1
    Else
        complete = x
    End If
End Property
Private Property Get elapsed() As Double
    elapsed = cMicroTimer() - pStart
End Property
Public Sub update()

    ' mark this one as executed
    pNextUpdate = 0
    
    If pTimeAllowed > 0 And Not pPaused Then

        cBar.Width = 1 + (pLength - complete * pLength)
        pCountDown.Value = Int(pTimeAllowed - (elapsed + pCum))
        
        If complete < 0.34 Then
            pBar.BackColor = vbGreen
        
        ElseIf complete < 0.67 Then
            pBar.BackColor = vbYellow
        
        Else
            pBar.BackColor = vbRed
        
        End If
    End If
    ' update form
    DoEvents
    ' schedule another
    ScheduleUpdate
    
End Sub
Private Function cMicroTimer() As Double
' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    cMicroTimer = 0
' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
    getTickCount cyTicks1
' Seconds
    If cyFrequency Then cMicroTimer = cyTicks1 / cyFrequency
End Function
For help and more information join our forumfollow the blogfollow me on twitter

You want to learn Google Apps Script?

Learning Apps Script, (and transitioning from VBA) are covered comprehensively in my my book, Going Gas - from VBA to Apps script, available All formats are available now from O'Reilly,Amazon and all good bookshops. You can also read a preview on O'Reilly

If you prefer Video style learning I also have two courses available. also published by O'Reilly.
Google Apps Script for Developers and Google Apps Script for Beginners.