Real 1ms Timer with Callback.

[Roger Cabo]

Against all tests the only real 1ms timer is coded below by the multimedia timer.
# Sleep(1) needs about 15ms to come back. Sleep(0) does not do anything useful.
# The Ocx Timer from GB32 also need about 15ms at highest speed.
# as well HighPerformanceQueryTimer


OpenW # 1

// Array to save the first 100 timer calls and display them.
Dim ts#(100)
Dim t# = Timer

// You need a Callback Procedure. The Procedure will called from Windows and prepared in TimerLoad()
TimerLoad()

Do
 Print AT(1, 1);  TimerCounterMs%
 DoEvents
Loop Until Me Is Nothing || TimerCounterMs% > 100

Dim i%
For i% = 000 To 100
 Debug ts#(i%)
Next i%
Debug.Show
Debug.Top

TimerUnload()

Proc TimerCallback(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
 Static self%
 Static c%
 If self% = 0
   self% = True

   TimerCounterMs%++
   
   If c% => 100
     c% = 0
   EndIf
   
   // Is required to restart the timer
   If TimerOn%
     ~timeSetEvent(1, 0, ProcAddr(TimerCallback), 0, 0)
   EndIf

   ts#(c) = Timer - t#
   t = Timer
   c++

   self% = False
 EndIf
EndProc

Proc TimerLoad()
 Declare Function timeGetTime Lib "winmm.dll" () As Long
 Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpTimeProc As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
 Declare Function timeKillEvent Lib "winmm.dll" (ByVal uTimerID As Long) As Long
 
 Global Const TIME_PERIODIC As Long = &H1
 Global Const TIME_CALLBACK_FUNCTION As Long = &H0
 Global TimerID%
 Global TimerOn%
 Global TimerCounterMs% = 0
 
 TimerOn% = True
 TimerID = timeSetEvent(1, 0, ProcAddr(TimerCallback), 0, 0)
EndProc

Proc TimerUnload()
 TimerOn% = False
 Pause 1
 ~timeKillEvent(TimerID)
EndProc

[(X)]

Sjouke posted this a while back: 18 January 2020:

High resolution timer wrapped in a COM object

gfabasic32.blogspot.com/2020/01/?m=0

[Roger Cabo]

May 25, 2023 18:37:53 GMT 1 (X) said:

Sjouke posted this a while back: 18 January 2020:

High resolution timer wrapped in a COM object

gfabasic32.blogspot.com/2020/01/?m=0

Yes, but this is different API and does not work with 1ms, additionally, it is unfortunately prone to errors and lite complex.
Try using 1ms and 50ms for timer 1 and 2.. then it terminates for any reason?

[dragonjim]

The TimerQ command is said to work with intervals of 1ms. Have you tried it?

PS. Despite the help file saying otherwise (the next release has the corrected page), it no longer uses the CreateTimerQueueTimer resource.

[Roger Cabo]

May 28, 2023 14:27:51 GMT 1 dragonjim said:

The TimerQ command is said to work with intervals of 1ms. Have you tried it?

PS. Despite the help file saying otherwise (the next release has the corrected page), it no longer uses the CreateTimerQueueTimer resource.

I think so. I have tried all posibilities and asked chat gpt4 for every possible interupt timer using with the windows system api and declare for 32bit. All worked with 15ms at lowest ratio but not the mm. Delay double in Gb32 works different then Pause but blocks the Gb32 thread anyway. With .net timers micro seconds interrupt timers are possible. Music DAWs using these timers to simulate hardware synth but on .net only. Asio, steinberg vst instruments, Juce etc..

There is also a trick to get 0.5ms from the mm timer, but does not work on win 10,11.

[(X)]

I tried to find TimerQ demo. ie: CreateTimerQueueTimer.

From what I have noticed, there appears to be a major differences between:{"user32", "kernel32", "ntdll", "winmm"} DLLs.

The "winmm" functions seems to be capable of 1ms resolution whereas timers using the other DLLs seem to be capped at 15ms.

Here is a demo that I hacked out with ChatGPT trying to get me to use the inferior DLLs only to agree later that "winmm" seems to work.
$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx
$Library "mmsystem.inc.lg32"

°Declare Function SetTimer Lib "user32" ( _
 ByVal hWnd As Long, _
 ByVal nIDEvent As Long, _
 ByVal uElapse As Long, _
 ByVal lpTimerFunc As Long) As Long
°
°Declare Function KillTimer Lib "user32" ( _
 ByVal hWnd As Long, _
 ByVal nIDEvent As Long) As Long
Declare Function timeSetEvent    Lib "winmm.dll" ( _
 ByVal uDelay%, _
 ByVal uResolution%, _
 ByVal lpCallback_Procedure As Handle, _
 ByVal user%, _
 ByVal fEvent%) As Long
Declare Function timeKillEvent   Lib "winmm.dll" (ByVal id%) As Long
Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long

Const WM_TIMER As Long = &H113
Global TimerID As Long, i%, dt#
Const TimerResolution As Long = 1 ' Desired timer resolution in milliseconds

LoadForm frm1
Do : Sleep 1 : DoEvents : Until Me Is Nothing

'Sub TimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTime As Long)
Proc TimerCallback(uID%, uMsg%, dwUser%, dw1%, dw2%)
 ' This procedure is called every 1 millisecond
 ' Do something here...
 i++
 'Debug.Print "Timer tick at " & dwTime
 
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' Set dt to reveal how much time has passed between callback procedure calls
 '
 Dim t_new# = Timer
 Static t_old# = t_new
 dt = t_new - t_old
 t_old = t_new
 
End Proc

Sub frm1_Close(Cancel?)
 ' Kill the timer when the form is unloaded
 Trace timeKillEvent(TimerID)
 
 ' Reset the system timer resolution
 Trace timeEndPeriod(TimerResolution)
End Sub

Sub frm1_Load
 ' Set the system timer resolution to the desired resolution
 Trace timeBeginPeriod(TimerResolution)
 
 ' Set the timer interval to 1 millisecond (1000 microseconds)
 ° ByVal uDelay%, _
   ByVal uResolution%, _
   ByVal lpCallback_Procedure As Handle, _
   ByVal user%, _
   ByVal fEvent%) As Long
 TimerID = timeSetEvent(1, 1, ProcAddr(TimerCallback), 0, TIME_PERIODIC)
End Sub

Sub tmr1_Timer
 Debug "counter"; i, "dt:";dt
 


[dragonjim]

May 30, 2023 12:55:43 GMT 1 (X) said:

I tried to find TimerQ demo.

Try the example on the help page. It seems to perform well enough (just over 1ms on trial but I haven't used it in a full program so don't know how much it will slow down with other code operating at the same time).

[Roger Cabo]

To directly answer your question: Yes, there are differences in priority between timeSetEvent and CreateTimerQueueTimer.
The callbacks executed by timeSetEvent run on a separate thread that is created by the multimedia timer system, which typically has a higher priority.
CreateTimerQueueTimer creates a timer that executes on a thread from the timer queue, whose priority is managed by the operating system's scheduling.
So typically, timeSetEvent would have a higher priority.

Yes this one works on 1ms using a callback Proc or Win_1_Message(hWnd%, Mess%, wParam%, lParam%)
But I can't recommended the use of Win_1_Message(hWnd%, Mess%, wParam%, lParam%), because it's used for all other incoming events from WIN_1() and keyboard, mouse as well and see above.
(For sure if you require a steady timing.. eg for D2D frame rate)

TimerQ function

Requires: GfaWinx.lg32

Purpose
Creates a high-resolution multi-media-timer wrapped in a COM object.

Syntax
Set tmrQ = TimerQ([Form | hWnd], [TimerID], [Interval], [Resolution], [TimerProc])

TimerQ creates a high-resolution multi-media timer with a minimal interval of 1 msec. (The Ocx Timer's shortest interval is approximately 55 msec.) The Form or hWnd parameter specifies the form or window that receives the WM_TIMER message after the time period (Interval) has expired. The TimerID must specify a value to identify the timer, it is passed in the wParam of the WM_TIMER message.


$Library "gfawinx"
OpenW 1, 0, 0, 600, 500, ~15
Global Object tmrQ1, tmrQ2
Set tmrQ1 = TimerQ(Me, 1, 1)   ' create & start timer
Global Int tps
Do
 Print AT(1, 1); tps
 Sleep
Until Me Is Nothing

Sub Win_1_Message(hWnd%, Mess%, wParam%, lParam%)
 If Mess% == WM_TIMER
   If wParam% == 1 // 10 msec timer
     tps++         // increment ticks every 10 msec
   EndIf
 EndIf
EndSub



Yes it does also the correct offset by 1ms
$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

OpenW 1, 0, 0, 700, 600, ~15
OcxOcx Win_1 RichEdit rtf1 = "", 200, 10, 450, 500
rtf1.BorderStyle = 1
rtf1.ScrollBars = 2
rtf1.MultiLine = True
rtf1.FontName = "Consolas"
rtf1.FontSize = 9
DoEvents

Global Object tmrQ2
Set tmrQ2 = TimerQ()            ' create timer
tmrQ2.InterVal = 1              ' 1 sec
tmrQ2.Resolution = 1           ' +/- 1% of Interval = +/-10 ms
tmrQ2.TimerProc = ProcAddr(TmrQProc)
tmrQ2.Enabled = True            ' start timer
Global Int tps

Dim ti#(1000)
Dim TStart# = Timer

Do
 Print AT(1, 1); tps
 Sleep(1)
 DoEvents
Until tps => 999
tmrQ2.Enabled = False
Dim a$
Dim i%
For i = 0 To 1000 - 1
 a$ = a$ & Str$(ti#(i), 6, 5) & "  Offset: " & ti#(i + 1) - ti#(i) &  #13#10
Next i
rtf1.Text = a$
Do
 Print AT(1, 1); tps
 Sleep(1)
 DoEvents
Until Me Is Nothing


Proc TmrQProc(uID%, uMsg%, dwUser%, dw1%, dw2%)
 ti#(tps) = Timer - TStart#
 tps++
EndProc

The demo X posted with in the other thread using declare and the win API does not. It's also set to 1ms but does only 15ms on my system as well.

Same API different results?  Any reason why this happen?

0.00826219999999012
0.0160175000000891
0.0160074999998869
0.0160252000000582
0.0160092999999506
0.0162470000000212
0.015782400000262
0.0162402999999358
0.0160184999999728
0.0160292000000481
0.0160043000000769
0.0160153000001628
0.0160236000001532
0.0160061999999925
0.0160166000000572
0.015522200000305
0.0150146999999379
0.0155150999999023
0.0160192000003008
0.0157994999999573
0.0162360999997873
0.0157899999999245


$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime ' Patches GfaWin23.Ocx
Debug.Show
Debug.OnTop = True

Declare Function CreateTimerQueueTimer Lib "kernel32.dll" ( _
 ByRef phNewTimer As Long, _
 ByVal TimerQueue As Long, _
 ByVal Callback As Long, _
 ByVal Parameter As Long, _
 ByVal DueTime As Long, _
 ByVal Period As Long, _
 ByVal Flags As Long) As Long

Declare Function DeleteTimerQueueTimer Lib "kernel32.dll" ( _
 ByVal TimerQueue As Long, _
 ByVal Timer As Long, _
 ByVal CompletionEvent As Long) As Long

Declare Function GetLastError Lib "kernel32.dll" () As Long

Global TimerHandle As Long // Changed from Int32 to Long
Global counter%, t# = Timer, T_log(100) As Double

Const WT_EXECUTEDEFAULT As Long = 0x00
Const WT_EXECUTEINTIMERTHREAD As Long = 0x20
Const WT_EXECUTEINIOTHREAD As Long = 0x10

OpenW # 1 : FontSize = 20

Dim DueTime As Long
DueTime = 1
Dim Period As Long
Period = 1

Dim result As Long = CreateTimerQueueTimer( _
 TimerHandle, _
 0, _
 ProcAddr(TimerCallback), _
 0, _
 DueTime, _
 Period, _
 WT_EXECUTEINTIMERTHREAD)
Do
 Sleep
Loop Until counter > 50 || Me Is Nothing

' Stop the timer
result = DeleteTimerQueueTimer(0, TimerHandle, 0)

Trace result
Trace counter%
Sleep
Dim i
For i = 1 To 50
 Debug T_log(i)
Next i

Do : Sleep : Until Me Is Nothing
Trace counter

Proc TimerCallback( _
 ByVal uID As Long, _
 ByVal uMsg As Long, _
 ByVal dwUser As Long, _
 ByVal dw1 As Long, _
 ByVal dw2 As Long)
 Static self As Long = 0
 If (self == 0)
   self = 1
   counter++
   T_log(counter) = Timer - t
   t = Timer
   self = 0
 EndIf
EndProc


[(X)]

Well I'll be hornswoggled!

TimerQ was right there, where I wasn't lookin' !

And of course, it works fine!

From: GFA Help file:

TimerQ function

Requires: GfaWinx.lg32

Purpose
Creates a high-resolution multi-media-timer wrapped in a COM object.

Syntax
Set tmrQ = TimerQ([Form | hWnd], [TimerID], [Interval], [Resolution], [TimerProc])

tmrQ : Object variable
Form : Form object
TimerID, Interval
Resolution, ProcAddr : integer expression

Description
TimerQ creates a high-resolution multi-media timer with a minimal interval of 1 msec. (The Ocx Timer's shortest interval is approximately 55 msec.) The Form or hWnd parameter specifies the form or window that receives the WM_TIMER message after the time period (Interval) has expired. The TimerID must specify a value to identify the timer, it is passed in the wParam of the WM_TIMER message. The Interval parameter can specify the period of timer in milliseconds with a minimum of 1 msec. TimerQ posts a WM_TIMER to the message queue of the specified Form/window and it could be handled in the Form_Message() event sub. The Resolution parameter determines the accuracy of the timer. A value of 0 will provide the highest accuracy, but might also have a negative influence of the performance of the system. By specifying -5 (default) for Resolution the accuracy is set to 5% of the Interval. By specifying the ProcAddr() of a TimerProc the timer's events can be directed to a user supplied procedure instead of being processed using the WM_TIMER message. The signature of the procedure must be:

Proc TmrQProc(uID%, uMsg%, dwUser%, dw1%, dw2%)

The timer is wrapped in an IDispatch COM object and the TimerQ's return value must be stored in an Object variable.

The timer is immediately started if the Interval parameter specifies a valid time and either the Form/hWnd is provided or a procedure address is provided.

Rather than specifying all parameters in the TimerQ() function, the timer's values can be set after creating the object using properties. The object has the following properties:

Enabled R/W Bool Returns or sets the running state of the timer. Set to False to stop a running timer or set to True to start a stopped timer.
Interval R/W Integer Returns or sets the time interval of the timer. The minimum value is 1 ms. Setting the Interval does not change the Resolution.
Resolution R/W Integer Returns or sets the accuracy time of the timer. The minimum value is 0 ms. By setting the Resolution to a negative value the accuracy is specified in a percentage of the Interval setting. E.g. setting Resolution to -5 will set the timer's accuracy to +/- 5% of the Interval. If Interval ia 100 ms, the tick's event will arrive between 95 ms and 105 ms.
TimerProc R/W Integer Returns or sets the current TimerProc for the timer. Either set it to an application defined callback procedure or to 0, which resets the TimerProc to the internal procedure that posts WM_TIMER messages to the target Form/window set with hWndTarget.
hWndTarget R/W Integer Returns the target window's handle or sets the target window from a Form or window-handle. The target window receives the WM_TIMER messages if ProcAddr == 0, otherwise the TimerProc is executed.
TimerID R/W Integer Returns or sets the timer's identifier, the value that is passed in the wParam of the WM_TIMER message.

$Library "gfawinx"

OpenW 1, 0, 0, 600, 500, ~15
PrintScroll = 1 : PrintWrap = 1
Global Object tmrQ1, tmrQ2
Set tmrQ1 = TimerQ(Me, 1, 10)   ' create & start timer
Set tmrQ2 = TimerQ()            ' create timer
tmrQ2.InterVal = 1000           ' 1 sec
tmrQ2.Resolution = -1           ' +/- 1% of Interval = +/-10 ms
tmrQ2.TimerProc = ProcAddr(TmrQProc)
tmrQ2.Enabled = True            ' start timer
Global Int tps
Do
Sleep
Until Me Is Nothing

Sub Win_1_Message(hWnd%, Mess%, wParam%, lParam%)
If Mess% == WM_TIMER
If wParam% == 1 // 10 msec timer
tps++         // increment ticks every 10 msec
Print ".";    // do something
EndIf
EndIf
EndSub

Proc TmrQProc(uID%, uMsg%, dwUser%, dw1%, dw2%)
TitleW 1, "Ticks per second:" + Dec(tps)
tps = 0
EndProc


[Roger Cabo]

In was under the impression that TimerQ is the same API like the CreateTimerQueueTimer :-)

[dragonjim]

May 30, 2023 19:23:48 GMT 1 Roger Cabo said:

In was under the impression that TimerQ is the same API like the CreateTimerQueueTimer :-)

..it was, but not anymore. 😁