Monday, 27 May 2019

VBA - Make the Windows Timer a library feature

In a StackOverflow bounty the issue of using the Windows timer api arose. Obviously VBA users have the Application.OnTime but this only have resolution to one second; if you want resolution to the millisecond then you need to use the Windows API. My solution is given below.

The Window SetTimer function behaves differently from Application.OnTime in that it will repeatedly fire unless you stop it; Application.OnTime fires only once (IIRC). Luckily, in the callback procedure that is called when the timer is fired the associated event id is passed as a parameter. So it is trivial to use that event id to call KillTimer and stop further firing.

The SO questioner wanted client code to be able to utilise this as a library feature for calling clients. In the version below we do not accept calling code's function pointers (i.e. using AddressOf) because this is unsafe. Instead, the user must pass in a string that can be passed to Application.Run.

Application.Run can takes the simple name of a procedure such as "UserCallBack" which will be resolved in the scope of ThisWorkbook. If client code is in a separate workbook then the client workbook name needs also to be prepended and separated with an exclamation mark e.g. "Book1.xlsm!UserCallBack"

We stash the callbacks in a dictionary to maintain state and when the timer fires we can select the right callback function and invoke it using Application.Run

Option Explicit
Option Private Module

'* Brought to you by the Excel Development Platform blog
'* exceldevelopmentplatform.blogspot.com

Private Declare Function ApiSetTimer Lib "user32.dll" Alias "SetTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function ApiKillTimer Lib "user32.dll" Alias "KillTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private mdicCallbacks As New Scripting.Dictionary

Private Sub SetTimer(ByVal sUserCallback As String, lMilliseconds As Long)
    Dim retval As Long  ' return value
    
    Dim lUniqueId As Long
    lUniqueId = mdicCallbacks.HashVal(sUserCallback) 'should be unique enough
    
    mdicCallbacks.Add lUniqueId, sUserCallback
    
    retval = ApiSetTimer(Application.hWnd, lUniqueId, lMilliseconds, AddressOf TimerProc)
End Sub

Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
        ByVal dwTime As Long)
        
    ApiKillTimer Application.hWnd, idEvent
    
    Dim sUserCallback As String
    sUserCallback = mdicCallbacks.Item(idEvent)
    mdicCallbacks.Remove idEvent
    
    
    Application.Run sUserCallback
End Sub

'****************************************************************************************************************************************
' User code below
'****************************************************************************************************************************************

Private Sub TestSetTimer()
    SetTimer "UserCallBack", 500
End Sub

Private Function UserCallBack()
    Debug.Print "hello from UserCallBack"
End Function

Alternatives to Application.Run

In the above code, Application.Run is used as the mechanism to route off and callback to calling client. However, Application.Run cannot call into a class instance's method so if you really like object-orientated code then you might want to choose a different mechanism. Code is not given for these but they are not difficult and I outline them below.

Alternative to Application.Run - ThisWorkbook and CallByName

Placing a method in the ThisWorkbook module will allow it to be called from a Workbook variable. Thus you are extending the interface of the Workbook class but if the variable is declared to be of type Excel.Workbook then it won't appear in the Intellisense dropdown menu. Despite this, it's still there and still callable.

So a variant of the above timer code could store both a Workbook variable and the method (as a string) to be invoked and then use CallByName to make the call.

Alternative to Application.Run - Custom Callback Interface

The other OO friendly way to callback is to insist that calling code implement a custom callback interface. The interface would probably have just one callback method suitable for all clients. The callback interface is defined in the server code and implemented in the client code. Then the client code passes a variable typed to the custom callback interface to the server. Upon firing, the server invokes the callback method on the interface variable to make the callback.

Actually, one of the answers has some sample code for this.

No comments:

Post a Comment