Off screen memory

[larrybtoys]

Is there a way to have 2 play screens in a program? One that the player can see and the other that I can place a graphic on to and throughout the game grab small sections of it to replace pieces of the other play screen that the player is seeing? 

[(X)]

Definitely. The Get and Put command will let you Get from one 'hidden' form and Put to another.
There are other ways to deal with Device Contexts. The fastest might be DIBs.

I am not familiar enough with DirectX or D2D, but I bet there is a fast way to do the same.
$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx


Dim a$

OpenW 1 : Win_1.AutoRedraw = 1
OpenW 2 : Win_2.AutoRedraw = 1 : Win_2.Hide

Output = Win_1
Line 0, 0, _X, _Y

Do : Sleep : Until MouseK

Output = Win_2
Line 0, _Y, _X / 2, _Y / 2


Get 0, _Y / 2, _X / 2, _Y, a$

Output = Win_1
Put 0, _Y / 2, a$, SRCAND

Do
 Sleep
Until Win_1 Is Nothing

Set Win_2 = Nothing

End


You can play with the Raster Operation SRCCOPY, SRCPAINT etc... 

[Roger Cabo]

Okay X has answered already. :-)

I use another approach, where you can set as many hidden objects as you like. There are several ways to chive this.

-----

To have two play screens, you can use two memory locations called "buffers" to store the graphics. The first buffer, let's call it "frx1," will hold the graphics that the player sees. The second buffer, "frx2," will hold the additional graphics that you want to use to replace parts of the first screen. frx1 or frx2 are nothing else than a ocx control.

To draw on the first buffer, set it as the "current" buffer by using the command "Set Me = frx1." This means that any graphic commands you use will be drawn on frx1.

To draw on the second buffer, set it as the current buffer by using the command "Set Me = frx2." This means that any graphic commands you use will be drawn on frx2.

To replace a section of the first screen with a section from the second screen, you can use a command called "bitblit." This command lets you copy a rectangular area of graphics from one buffer to another.

So, to replace a section of frx1 with a section of frx2, you can use the bitblit command to copy the rectangular area from frx2 to frx1. You can repeat this process as needed to replace other sections of frx1 with sections from frx2.

BitBlt srcdc%,srcx%,srcy%,srcw%,srch%, dstdc%,dstx%,dsty%,mode%

[(X)]

ChatGPT 3's solution in VB6:  Where the equivalent of VB6 PictureBox in GFA is a frx.

Certainly! Here's an example in Visual Basic 6 using the built-in PictureBox control to create two screens and manipulate the graphics:

Open a new project in Visual Basic 6.

Add two PictureBox controls to the form, named "PlayerScreen" and "HiddenBuffer".

Set the dimensions of both PictureBoxes to the same size (e.g. 800x600).

Set the Visible property of the HiddenBuffer PictureBox to False to hide it from the player.

Add the following code to the form's code module:

Private Sub Form_Load()

   ' Draw a rectangle on the hidden buffer screen
   HiddenBuffer.ScaleMode = vbPixels
   HiddenBuffer.BackColor = vbWhite
   HiddenBuffer.FillStyle = vbSolid
   HiddenBuffer.FillColor = vbRed
   HiddenBuffer.Rectangle (100, 100)-(300, 300)

End Sub

Private Sub PlayerScreen_Paint()
   
   ' Copy the contents of the hidden buffer screen to the player screen
   PlayerScreen.PaintPicture HiddenBuffer.Image, 0, 0
   
End Sub

Private Sub Timer1_Timer()

   ' Animate the contents of the hidden buffer screen
   Dim x As Integer
   Dim y As Integer
   x = Rnd * HiddenBuffer.Width
   y = Rnd * HiddenBuffer.Height
   HiddenBuffer.Circle (x, y), 10, vbBlue, , , , 0.5

   ' Redraw the player screen
   PlayerScreen.Refresh
   
End Sub


Run the program and you should see the PlayerScreen with a red rectangle on it. The HiddenBuffer PictureBox is hidden from the player, but is used to manipulate the graphics. The Timer control is used to animate the contents of the HiddenBuffer PictureBox by drawing semi-transparent blue circles randomly on the surface.

You can modify this example to suit your specific needs, such as adding user input to control the animation, or using different graphics manipulation techniques.

[(X)]

Just for fun, I asked GPT specifically: "Using GFA-BASIC 32 for Windows?"

Sure, here's an example using GFA-BASIC 32 for Windows to create two screens and manipulate the graphics:

Open a new project in GFA-BASIC 32 for Windows.

Add two Picture controls to the form, named "PlayerScreen" and "HiddenBuffer".

Set the dimensions of both Picture controls to the same size (e.g. 800x600).

Set the Visible property of the HiddenBuffer Picture control to False to hide it from the player.

Add the following code to the form's code module:


' Draw a rectangle on the hidden buffer screen
HiddenBuffer.DrawBox 100, 100, 300, 300, RGB(255, 0, 0)

Do
' Animate the contents of the hidden buffer screen
Randomize Timer
x = Rnd * HiddenBuffer.ScaleWidth
y = Rnd * HiddenBuffer.ScaleHeight
HiddenBuffer.DrawEllipse x - 10, y - 10, x + 10, y + 10, , , , , , , RGB(0, 0, 255), 0.5

' Copy the contents of the hidden buffer screen to the player screen
PlayerScreen.Picture = HiddenBuffer.Picture

' Delay for a short period to control the animation speed
Sleep 10
Loop

Run the program and you should see the PlayerScreen with a red rectangle on it. The HiddenBuffer Picture control is hidden from the player, but is used to manipulate the graphics. The program uses a Do loop to animate the contents of the HiddenBuffer Picture control by drawing semi-transparent blue circles randomly on the surface. The PlayerScreen Picture control is updated with the contents of the HiddenBuffer Picture control on every iteration of the loop to show the animation.

You can modify this example to suit your specific needs, such as adding user input to control the animation, or using different graphics manipulation techniques.

[(X)]

It would be fun it there was a 'wrapper' library that would take care of all of this.

Did you have a specific usage case in mind?

[larrybtoys]

Apr 29, 2023 16:47:19 GMT 1 (X) said:

It would be fun it there was a 'wrapper' library that would take care of all of this.

Did you have a specific usage case in mind?

Yes that would be great....I am writing another game where there was going to be a lot of objects moving around the screen at the same time. The overlapping of objects was causing an issue as I was reading under the object prior to PUTting it there. I thought I could replace the under with images from invisible screen.

[dragonjim]

There have been a lot of responses to this, and here is another one...

Have three forms:

Form1: This holds the static background
Form2: The contents of Form1 are copied to this then the 'moving objects' pasted/put on top
Form3: The form visible to the player to which the contents of Form2 are copied when required/ready.

This saves time having to redraw the static background and prevents flicker when the moving objects are being overlaid.

[Roger Cabo]

Apr 29, 2023 18:46:29 GMT 1 larrybtoys said:

Apr 29, 2023 16:47:19 GMT 1 (X) said:

It would be fun it there was a 'wrapper' library that would take care of all of this.

Did you have a specific usage case in mind?

Yes that would be great....I am writing another game where there was going to be a lot of objects moving around the screen at the same time. The overlapping of objects was causing an issue as I was reading under the object prior to PUTting it there. I thought I could replace the under with images from invisible screen.

Only for info:
If you use D2D, you can draw all the objects of the screen at the same time. Doesn't matter if 1 or 5000 in 64x64 size.


Another Example: If you want to draw 100 moving objects and the rest of your game are any static objects.
This is another solution for pure GFABASIC32:


@Draw_All_Static_Stuff_To(WIN_BACK.hDC)

Do
// From WIN_BACK to WIN_GAME_DRAW.hDC
BitBlt WIN_BACK.hDC, 0, 0, X, Y, WIN_GAME_DRAW.hDC, 0, 0, SRCCOPY

@Draw_Animated_Stuff_To(WIN_GAME_DRAW.hDC)  //Use Get and PUT as X told you

// From WIN_GAME_DRAW.hDC to WIN_GAME.hDC
BitBlt WIN_GAME_DRAW_DRAW.hDC, 0, 0, X, Y, Win_WIN_GAME.hDC, 0, 0, SRCCOPY

Loop until anything happen to make the game over.

Here is another very simple mario test in D2D.

Draws about 1700*2 Marios 95x95 pix at the same time and a tiled background on a 4K screen.. and all on my nvidia 1030 passive noiseless, the slowest card on earth! (only for my music application) :-)

d2dMarioTest.G32 (329.65 KB)

[(X)]

COOL!!!

[Roger Cabo]

This should be an example to draw easily some sprites in D2D.

Load graphics as PNG (also 8bit and 24 bit transparent) , jpg, BMP into an object.
And use d2dput to draw. It's easy like dell. :-)

The next interesting thing is to check, what happen if you stretch/shrink graphics.

Then check animations in object arrays.
Because you to animate per frame.

Then check how many fps are shown. And can I set my game to 30fps? Can I create animations are frame Independent anyhow?
Less then 10fps are poore..or?

[Roger Cabo]

Tested some performance stuff:

The FPS of d2d is limited to 25FPS all the time?

It seems the best way to use paint in a loop is:
Do
paint()
Sleep(1)
DoEvents
Until Me Is Nothing

+ This cause 2% on my CPU with Sleep(of 1ms)
+ PeekEvent instead of DoEvents cause screen flickering and black screen some times if there is no OnMenu.. and Windows messages are not handled.

Sleep(1) cause 1ms wait for any windows messages
DoEvents will handle if there are messages to income.

If you have better experiences plz comment!


New paint() to display FPS

Sub paint() Naked
 
 Type Mario
   x As Double
   y As Double
   Steps As Int
   Dirm As Double
 End Type
 
 Static m(500) As Mario
 
 Dim c%, x%, y%
 For c% = 0 To UBound(m())
   // pass new x,y if mario is outside or the value is 0
   If m(c).x <= 0 || m(c).y <= 0
     m(c).x = Random(Screen.x)
     m(c).y = Random(Screen.y)
   EndIf
 Next c%
 
 Static t#
 Static fCounter% = 0
 Static fps$
 
 D2SetFont "Impact", 32  ' set a base font for TextLayout
 
 D2BeginDraw Win1RT
 
 // draw any easy background grass over the complete screen
 For x% = 0 To Screen.x / 511
   For y% = 0 To Screen.y / 511
     D2Put x% * 511, y% * 512, pnggrass
   Next y%
 Next x%
 
 // draw mario loop
 For c% = 0 To UBound(m()) Step 1
   
   m(c%).x += Cos(m(c%).Dirm) * 5
   m(c%).y += Sin(m(c%).Dirm) * 5
   
   ' count steps of mario to change to direction
   m(c%).Steps += 1
   
   ' change direction simply
   If m(c%).Steps >= Random(2000) Then
     m(c%).Dirm = Rnd * 2 * PI ' random dir
     m(c%).Steps = 0           ' steps to 0
   End If
   
   // draw mario
   D2Put m(c%).x + 5, m(c%).y + 5, pngsh
   D2Put m(c%).x, m(c%).y, png
 Next c%
 
 fCounter++
 
 If Timer - t => 1.0
   t# = Timer
   fps$ = Str$(fCounter)
   fCounter = 0
 EndIf
 
 D2ForeColor = D2C_Black
 D2DrawText 0 + 5, 0 + 5, 100, 100, fps, 0
 D2ForeColor = D2C_Yellow
 D2DrawText 0, 0, 100, 100, fps, 0
 
 D2EndDraw
 
EndSub



[(X)]

I get up to 150 fps with:

Do
paint()
Sleep(0)
DoEvents
Until Me Is Nothing

[Roger Cabo]

May 23, 2023 1:00:01 GMT 1 (X) said:

I get up to 150 fps with:

Do
paint()
Sleep(0)
DoEvents
Until Me Is Nothing

And with sleep(1) ?
Without paint() or 3000 Mario's I got 25 fps anyway. Perhaps there is any cap vsync setting on by default. Strange.. other application running at 60hz 4k. Hmm..

I done some simple animations with object arrays, looks terrible when the frame rate is not fix.

Sure its possible to wait X Ms seconds but then the animation is jerky, while over jumping 1 or 2 frames sometimes.

[(X)]

May 23, 2023 9:44:35 GMT 1 Roger Cabo said:

May 23, 2023 1:00:01 GMT 1 (X) said:

I get up to 150 fps with:

Do
paint()
Sleep(0)
DoEvents
Until Me Is Nothing

And with sleep(1) ?

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx


$Library "direct2d"
Global Object Win1RT
'OpenW 1, 0, 0, Screen.x, Screen.y, -15
LoadForm frm1
frm1.BackColor = 0

' DC Rendertarget same size as clientarea
Set Win1RT = D2GetRT()

Global Object png
Set png = D2Bitmap(":mario")            // mario

Global Object pngsh
Set pngsh = D2Bitmap(":mario_sh")       // shadow

Global Object pnggrass
Set pnggrass = D2Bitmap(":mariograss")       // grass

Global G_ms_delay%
Global G_fps!

Do
 paint()
 Sleep G_ms_delay
 DoEvents
Until frm1 Is Nothing

Sub paint()
 
 G_fps++
 
 Dim x%, y%, i%
 Static offsx#((Screen.x / 45) * (Screen.y / 45))
 Static offsy#((Screen.x / 45) * (Screen.y / 45))
 
 // calculate and quick random movement..
 For i% = 0 To (Screen.x / 45) * (Screen.y / 45)
   offsx#(i) += (Rnd * 5) - 2.5 * Sin(Rnd(0.5))
   offsy#(i) += (Rnd * 5) - 2.5 * Cos(Rnd(0.5))
 Next i%
 
 D2BeginDraw Win1RT
 
 // draw any easy background grass over the complete screen
 For x% = 0 To Screen.x / 512
   For y% = 0 To Screen.y / 512
     D2Put x% * 511, y% * 511, pnggrass
   Next y%
 Next x%
 
 // draw any marios
 i% = 0
 For x% = 0 To Screen.x Step 46
   For y% = 0 To Screen.y Step 46
     
     D2Put x% + offsx#(i) - 10, y% + offsy#(i) + 10, pngsh
     D2Put x% + offsx#(i), y% + offsy#(i), png
     
     i++
   Next y%
 Next x%
 
 D2EndDraw
 
EndSub

Sub tmr1_Timer
 // 1000 ms Timer: tmr1
 Debug "Delay ms:";G_ms_delay,  ", Frames per second:";G_fps :  G_fps = 0
 G_ms_delay++
 


Debug Window Output...

Delay ms: 0 , Frames per second: 49
Delay ms: 1 , Frames per second: 56
Delay ms: 2 , Frames per second: 59
Delay ms: 3 , Frames per second: 58
Delay ms: 4 , Frames per second: 59
Delay ms: 5 , Frames per second: 47
Delay ms: 6 , Frames per second: 41
Delay ms: 7 , Frames per second: 38
Delay ms: 8 , Frames per second: 32
Delay ms: 9 , Frames per second: 29
Delay ms: 10 , Frames per second: 29
Delay ms: 11 , Frames per second: 30
Delay ms: 12 , Frames per second: 29
Delay ms: 13 , Frames per second: 29
Delay ms: 14 , Frames per second: 29
Delay ms: 15 , Frames per second: 29
Delay ms: 16 , Frames per second: 28
Delay ms: 17 , Frames per second: 29
Delay ms: 18 , Frames per second: 29
Delay ms: 19 , Frames per second: 28
Delay ms: 20 , Frames per second: 27
Delay ms: 21 , Frames per second: 25
Delay ms: 22 , Frames per second: 23
Delay ms: 23 , Frames per second: 21
Delay ms: 24 , Frames per second: 21
Delay ms: 25 , Frames per second: 19
Delay ms: 26 , Frames per second: 21
Delay ms: 27 , Frames per second: 21
Delay ms: 28 , Frames per second: 19
Delay ms: 29 , Frames per second: 20
Delay ms: 30 , Frames per second: 18
Delay ms: 31 , Frames per second: 18
Delay ms: 32 , Frames per second: 18
Delay ms: 33 , Frames per second: 18
Delay ms: 34 , Frames per second: 18
Delay ms: 35 , Frames per second: 18
Delay ms: 36 , Frames per second: 18
Delay ms: 37 , Frames per second: 17
Delay ms: 38 , Frames per second: 17
Delay ms: 39 , Frames per second: 17
Delay ms: 40 , Frames per second: 15
Delay ms: 41 , Frames per second: 16
Delay ms: 42 , Frames per second: 15
Delay ms: 43 , Frames per second: 16
Delay ms: 44 , Frames per second: 15
Delay ms: 45 , Frames per second: 15
Delay ms: 46 , Frames per second: 14
Delay ms: 47 , Frames per second: 14
Delay ms: 48 , Frames per second: 13
Delay ms: 49 , Frames per second: 14
Delay ms: 50 , Frames per second: 13
Delay ms: 51 , Frames per second: 14
Delay ms: 52 , Frames per second: 13
Delay ms: 53 , Frames per second: 13
Delay ms: 54 , Frames per second: 13
Delay ms: 55 , Frames per second: 13
Delay ms: 56 , Frames per second: 12
Delay ms: 57 , Frames per second: 12
Delay ms: 58 , Frames per second: 12
Delay ms: 59 , Frames per second: 12
Delay ms: 60 , Frames per second: 12
Delay ms: 61 , Frames per second: 13
Delay ms: 62 , Frames per second: 11
Delay ms: 63 , Frames per second: 11
Delay ms: 64 , Frames per second: 11
Delay ms: 65 , Frames per second: 11
Delay ms: 66 , Frames per second: 11
Delay ms: 67 , Frames per second: 12
Delay ms: 68 , Frames per second: 10
Delay ms: 69 , Frames per second: 11
Delay ms: 70 , Frames per second: 11
Delay ms: 71 , Frames per second: 10
Delay ms: 72 , Frames per second: 11
Delay ms: 73 , Frames per second: 10
Delay ms: 74 , Frames per second: 11
Delay ms: 75 , Frames per second: 9
Delay ms: 76 , Frames per second: 10
Delay ms: 77 , Frames per second: 10
Delay ms: 78 , Frames per second: 10
Delay ms: 79 , Frames per second: 9
Delay ms: 80 , Frames per second: 9
Delay ms: 81 , Frames per second: 9
Delay ms: 82 , Frames per second: 9
Delay ms: 83 , Frames per second: 9
Delay ms: 84 , Frames per second: 9
Delay ms: 85 , Frames per second: 9
Delay ms: 86 , Frames per second: 10
Delay ms: 87 , Frames per second: 9
Delay ms: 88 , Frames per second: 9
Delay ms: 89 , Frames per second: 9
Delay ms: 90 , Frames per second: 9
Delay ms: 91 , Frames per second: 9
Delay ms: 92 , Frames per second: 9
Delay ms: 93 , Frames per second: 7
Delay ms: 94 , Frames per second: 8
Delay ms: 95 , Frames per second: 8
Delay ms: 96 , Frames per second: 8
Delay ms: 97 , Frames per second: 8
Delay ms: 98 , Frames per second: 8
Delay ms: 99 , Frames per second: 8
Delay ms: 100 , Frames per second: 8
Delay ms: 101 , Frames per second: 8
Delay ms: 102 , Frames per second: 8
Delay ms: 103 , Frames per second: 8
Delay ms: 104 , Frames per second: 8
Delay ms: 105 , Frames per second: 7
Delay ms: 106 , Frames per second: 8
Delay ms: 107 , Frames per second: 7

[Roger Cabo]

Thank u!

Seems sleep 0 cooks the CPU. The GPU is not affected.

What GPU u own and u use HD 1080 resolution?

Not sure if there is a way to fix the frame rate in D2D to about 20fps to get steady animations.

[(X)]

I've dug up  a fairly recent (2020) library Lib_Timer_ms.lg32 that I would like to whittle down to a usable form that a 5 year old could 'take to' like a duck to water.

Demo Lib_Timer_ms.g32 (5.28 KB)

Lib_Timer_ms.g32 (9.07 KB)

This demonstrates the use of the timeSetEvent related API functions that can be used for down to millisecond timing events.

The usage is still too technical and open to mis-interpretation for my taste.

I'd like a user to be able plop (drag ' n drop) a graphic on the running GFA App/Game Maker* and right click on it to select, for example, how fast it will spin(fast..slow) when clicked and when it will stop(slowly.. quickly).  Another action based on ms timing: when user left clicks image, a flash of light is followed by a dimming and disappearance of the graphic.  Again, simple choices for timing: fast..slow.

*Other possibilities:
GameForge
AppMaster
CodeCraft
GameWizard
AppGenius
CodeHaven
GameCraft
AppMuse
CodeGenie
GameBuilder
AppSculptor
CodeVerse
GameLab
AppAssembler
CodeGuru

[Roger Cabo]

Okay.. after some tests.. sleep(1) required 15ms to come back.. too much to keep a stable frame timing.
Means you're wasting 15ms to calculate any GB32 cpu stuff.

Do
 Dim t# = Timer
 Sleep(1)
 Print AT(1, 1); (Timer - t#)
Loop Until MouseK

Then I tired CreateTimerQueueTimer but doesnt work in gb32 for any reason.
The MS doku says, runs in 32 and 64bit and in vb4.0 as well.



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

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

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

Global TimerHandle As Int
Global counter%

Private Const WT_EXECUTEDEFAULT As Long = &H0
Private Const WT_EXECUTEINTIMERTHREAD As Long = &H20
Private Const WT_EXECUTEINIOTHREAD As Long = &H10

OpenW # 1

Dim DueTime As Long
// We need microseconds
DueTime = 1 // 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
DueTime = DueTime * -1 ' Negative values are used to indicate relative delay

Dim Period As Long
Period = 1 // 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds

' Create the initial timer
Dim result As Long = CreateTimerQueueTimer(TimerHandle, 0, ProcAddr(TimerCallback), 0, DueTime, Period, WT_EXECUTEINTIMERTHREAD)
MsgBox "Error code from CreateTimerQueueTimer: " + Str$(result)
Dim errorCode As Long = GetLastError()
MsgBox "Error code from GetLastError(): " + Str$(errorCode)

Do
 Print AT(1, 1); counter%
 Sleep
Loop Until Me Is Nothing

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

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 Int
 If self = 0
   self = 1
   counter%++
   
   self = 0
 EndIf
EndProc

This is a bit frustrating.. Does anyone know why the CreateTimerQueueTimer didn't work perhaps?

[Roger Cabo]

May 23, 2023 16:49:22 GMT 1 (X) said:

I've dug up  a fairly recent (2020) library Lib_Timer_ms.lg32 that I would like to whittle down to a usable form that a 5 year old could 'take to' like a duck to water.

View Attachment

View Attachment

View Attachment

This demonstrates the use of the timeSetEvent related API functions that can be used for down to millisecond timing events.

The usage is still too technical and open to mis-interpretation for my taste.

I'd like a user to be able plop (drag ' n drop) a graphic on the running GFA App/Game Maker* and right click on it to select, for example, how fast it will spin(fast..slow) when clicked and when it will stop(slowly.. quickly).  Another action based on ms timing: when user left clicks image, a flash of light is followed by a dimming and disappearance of the graphic.  Again, simple choices for timing: fast..slow.

*Other possibilities:
GameForge
AppMaster
CodeCraft
GameWizard
AppGenius
CodeHaven
GameCraft
AppMuse
CodeGenie
GameBuilder
AppSculptor
CodeVerse
GameLab
AppAssembler
CodeGuru

Yes cool.. I have optimized a ChatGPT version for a 1ms timer as well.

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

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

Private Const TIME_PERIODIC As Long = &H1
Private Const TIME_CALLBACK_FUNCTION As Long = &H0

OpenW # 1
Dim Counter% = 0
Dim TimerID%
Dim TimerOn%

LoadTimer()

Do
 Print AT(1, 1);  Counter%
 DoEvents
Loop Until Me Is Nothing

Form_Unload()

Proc TimerCallback(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
 Static self%
 If self% = 0
   self% = True
   If timeron%
     ~timeSetEvent(1, 0, ProcAddr(TimerCallback), 0, 0)
   EndIf
   
   counter%++
   
   self% = False
 EndIf
EndProc

Proc LoadTimer()
 timeron% = True
 TimerID = timeSetEvent(1, 0, ProcAddr(TimerCallback), 0, 0)
EndProc

Proc Form_Unload()
 timeron% = False
 Pause 1
 ~timeKillEvent(TimerID)
EndProc


I like to have the highresolution CreateTimerQueueTimer can call periodic in microseconds. But this does not in Gb32.

[(X)]

I got CreateTimerQueueTimer working like this.

(I don't think the resolution is better than a few milliseconds, not microseconds)

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

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 Int to Long
Global counter%, t# = Timer

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
// We need microseconds
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
DueTime = 1000
'DueTime = DueTime * -1000 ' Negative values are used to indicate relative delay

Dim Period As Long
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
Period = 10

' Create the initial timer
Dim result As Long = CreateTimerQueueTimer( _
 TimerHandle, _
 0, _
 ProcAddr(TimerCallback), _
 0, _
 DueTime, _
 Period, _
 WT_EXECUTEINTIMERTHREAD)

Debug "Error code from CreateTimerQueueTimer: " + Str$(result)
Dim errorCode As Long = GetLastError()
Debug "Error code from GetLastError(): " + Str$(errorCode)

Do
 Sleep 0
 DoEvents
Loop Until Me Is Nothing || counter > 10

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

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++
   Text 1, counter * 30, Str(counter%) & "," & Str(Timer - t)
   t = Timer
   self = 0
 EndIf
EndProc


[Roger Cabo]

May 24, 2023 1:12:27 GMT 1 (X) said:

I got CreateTimerQueueTimer working like this.
(I don't think the resolution is better than a few milliseconds, not microseconds)

The MS 32/64 bit documentation says up to nano seconds by multiplying timer * 1000 or more.

[Roger Cabo]

May 24, 2023 1:12:27 GMT 1 (X) said:

I got CreateTimerQueueTimer working like this.

(I don't think the resolution is better than a few milliseconds, not microseconds)

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

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 Int to Long
Global counter%, t# = Timer

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
// We need microseconds
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
DueTime = 1000
'DueTime = DueTime * -1000 ' Negative values are used to indicate relative delay

Dim Period As Long
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
Period = 10

' Create the initial timer
Dim result As Long = CreateTimerQueueTimer( _
 TimerHandle, _
 0, _
 ProcAddr(TimerCallback), _
 0, _
 DueTime, _
 Period, _
 WT_EXECUTEINTIMERTHREAD)

Debug "Error code from CreateTimerQueueTimer: " + Str$(result)
Dim errorCode As Long = GetLastError()
Debug "Error code from GetLastError(): " + Str$(errorCode)

Do
 Sleep 0
 DoEvents
Loop Until Me Is Nothing || counter > 10

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

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++
   Text 1, counter * 30, Str(counter%) & "," & Str(Timer - t)
   t = Timer
   self = 0
 EndIf
EndProc


hmm crash on my system and returns error 1

Error code from CreateTimerQueueTimer: 1
Error code from GetLastError(): 0
TRACE:(1):result = 1

[(X)]

Even this code, with a specified period of 1 (ms), that triggers a procedure that stores the delta-t value in an array can only do so at ~0.015 sec or ~15 ms intervals.

Chatgpt states:
DueTime (Long): The amount of time, in milliseconds, before the timer elapses for the first time.
Period (Long): The period of the timer, in milliseconds. If set to zero, the timer is only signaled once.

$Library "gfawinx"

$Library "UpdateRT"
UpdateRuntime ' Patches GfaWin23.Ocx
Debug.Show

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
// We need microseconds
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
DueTime = 10
'DueTime = DueTime * -1000 ' Negative values are used to indicate relative delay

Dim Period As Long
// 2604 * 10 ' 2604 microseconds = 2604 * 1000 nanoseconds = 2604000 nanoseconds
Period = 1

' Create the initial timer
Dim result As Long = CreateTimerQueueTimer( _
TimerHandle, _
0, _
ProcAddr(TimerCallback), _
0, _
DueTime, _
Period, _
WT_EXECUTEINTIMERTHREAD)

Debug "Error code from CreateTimerQueueTimer: " + Str$(result)
Dim errorCode As Long = GetLastError()
Debug "Error code from GetLastError(): " + Str$(errorCode)

Do
Sleep
Loop Until counter > 20

' Stop the timer
result = DeleteTimerQueueTimer(0, TimerHandle, 0)
Trace result
Trace counter%
Sleep
Dim i
For i = 1 To 20
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

[Roger Cabo]

Thank you!

This is the only perfect 1ms timer!


OpenW # 1
Dim ts#(100)
Dim t# = Timer
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
   
   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