Game in vb6

[germano.barbosa]

Guys, my son (He is 15 years old) made a game in vb6, would trigger your opinion of whether it was good or not. I've been working with vb6 for a long time and I don't think I could do that.

[Ordinary Guy]

Upon watching the graphical user interface and the animation I say it has professional quality. Not knowing how it works, meaning not knowing what the player needs to do, I can't comment on the playability or the levels of difficulties. If you could allow us to download the exe (from a valid website; not this one however) we could run the game and get a better overall insight of the game. Anyway , I'm impressed with the graphics.

[germano.barbosa]

Upon watching the graphical user interface and the animation I say it has professional quality. Not knowing how it works, meaning not knowing what the player needs to do, I can't comment on the playability or the levels of difficulties but anyway it looks very nice. If you could allow us to download the exe (from a valid website; not this one however) we could run the game and get a better overall insight of the game.

It is actually a game maker, that is, it has a phase editor too

[baka]

impressive.
I remember when I was around 15, at that time I used amos for amiga500 to do programs,
it was many years later I started to use VB6, but mostly for educational purpose.
Im doing a game right now, using Direct2D, a 2D platform, rpg, visual novel, clicker games.
So are the game maker based on GDI, DirectX, Direct2D, Cairo or something else?

[SamOscarBrown]

When "I" was around 15....oh wait, I can't remember that long ago! But what does come to mind is, 'there were NO computers around at that time'. Well, there were, but not personal ones...this is what was probably around at that time:

Attachment 175905


If what you say is true...I'm thoroughly impressed with that 15-year old.

[DirectY]

Hi, i am the 15 year old,

The Game: Super Mario World Maker

It has lots of interesting optimizations running under the hood.

BTW, i would love some help regarding frame locking, currently its on a loop waiting for the expected time to come, eating up 100% CPU, if i call the sleep api at any point (before the loop, in the loop or both) the program starts to have fps inconsistency. Its like it waits a lot and then for some time rushes to catch up, only to get delayed massively again.

Also i read somewhere that sleep has a 55ms minimum delay, is that true?

[germano.barbosa]

https://github.com/DirectY1996/SuperMarioWorldMaker


Here is the project link

[DataMiser]

When "I" was around 15....oh wait, I can't remember that long ago! But what does come to mind is, 'there were NO computers around at that time'. Well, there were, but not personal ones...this is what was probably around at that time:

Attachment 175905


If what you say is true...I'm thoroughly impressed with that 15-year old.

Yep when I was 15, never saw a PC. For me it was all about cars, motorcycles and girls.

[baka]

I recommend to use Direct2D. it has its own monitor sync, that way you dont need any sleep/wait function at all.
in my project I have both Software and Hardware rendering, in Software theres no monitor sync, I use this:

Private Type TimerTypeData
    OneSec      As Long
    OneTick     As Long
    Cap()       As Integer
    Caps        As Long
End Type

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Dim Tm As TimerTypeData

Sub StartSync(hDC&)
    Dim i&, ex!, Cn!

    Tm.Caps = GetDeviceCaps(hDC, 116)
    ReDim Tm.Cap(1 To Tm.Caps)
    ex = 1000 / Tm.Caps
    For i = 1 To Tm.Caps
        Cn = Cn + ex
        Tm.Cap(i) = CInt(Cn)
    Next i
    timeBeginPeriod 1
    Tm.OneSec = timeGetTime
    Tm.OneTick = 1
End Sub

Sub EndSync()
    If Tm.OneSec > 0 Then timeEndPeriod 1
End Sub

Sub WaitSync()
    Dim DEX&
    
    With Tm
        DEX = .Cap(.OneTick) + .OneSec
        Do
            Sleep 1
        Loop Until timeGetTime >= DEX
        .OneTick = .OneTick + 1
        If .OneTick > .Caps Then .OneTick = 1: .OneSec = .OneSec + 1000
    End With
End Sub

Before the loop, I call StartSync, to initialize it,
after each "render" I call WaitSync and after that I call a PeekMessage (DoEvents alternative)

[vb6forever]

help regarding frame locking, currently its on a loop waiting for the expected time to come

This is one of the big issues with a Single Apartment Model -- dealing with User Interaction and Trying to get graphics on the screen.
One way you might try is to set a toggle variable in the Paint or whatever event, rather than using Sleep.
Toggle it on when you enter your routine and Off when exit.

[DirectY]

Gonna put direct2d in the todo list

[DirectY]

Who knew Direct2D would be the solution for both of those problems
Thanks for the monitor sync too

[qvb6]

Tm.Caps = GetDeviceCaps(hDC, 116)

For those who are curious about "116" in the call to GetDeviceCaps, it's for VREFRESH:

Const VREFRESH 116 ' Current vertical refresh rate of the display device (for displays only) in Hz.

[baka]

I just looked at the code and I thought, why did I use Do/Loop,

While timeGetTime < DEX
   Sleep 1
Wend

this one is better!

also, I wonder why Olaf has not replied and commented on my code, he usually asks for me to share code, so that he can analyze it and find errors.

[Arnoutdv]

I just looked at the code and I thought, why did I use Do/Loop,

While timeGetTime < DEX
   Sleep 1
Wend

this one is better!

I don't like While Wend ;-)

Do While timeGetTime < DEX
   Sleep 1
Loop

[baka]

theres no exit do needs, but they are equal in speed so you can use either.

[The trick]

This code synchronize the loop with monitor FPS:

' //
' // VSync
' // Vista and later
' // By The trick
' //

Option Explicit

Private Type LUID
    LowPart         As Long
    HighPart        As Long
End Type

Private Type D3DKMT_OPENADAPTERFROMHDC
    hDC             As Long
    hAdapter        As Long
    AdapterLuid     As LUID
    VidPnSourceId   As Long
End Type

Private Type D3DKMT_WAITFORVERTICALBLANKEVENT
    hAdapter        As Long
    hDevice         As Long
    VidPnSourceId   As Long
End Type

Private Type D3DKMT_CLOSEADAPTER
    hAdapter        As Long
End Type

Private Declare Function D3DKMTOpenAdapterFromHdc Lib "gdi32" ( _
                         ByRef tAdapter As D3DKMT_OPENADAPTERFROMHDC) As Long
Private Declare Function D3DKMTWaitForVerticalBlankEvent Lib "gdi32" ( _
                         ByRef tEvt As D3DKMT_WAITFORVERTICALBLANKEVENT) As Long
Private Declare Function D3DKMTCloseAdapter Lib "gdi32" ( _
                         ByRef tAdapter As D3DKMT_CLOSEADAPTER) As Long

Private m_bIsRunning    As Boolean
Private m_lFPSCounter   As Long

Private Sub cmdStop_Click()
    m_bIsRunning = False
End Sub

Private Sub Form_Load()
    Dim tAdapterOpen    As D3DKMT_OPENADAPTERFROMHDC
    Dim tWaitVSync      As D3DKMT_WAITFORVERTICALBLANKEVENT
    Dim tAdapterClose   As D3DKMT_CLOSEADAPTER
    Dim lCounter        As Long
    
    Me.Show
    
    ' // Open adapter from HDC
    tAdapterOpen.hDC = Me.hDC
    
    If D3DKMTOpenAdapterFromHdc(tAdapterOpen) < 0 Then
        MsgBox "Unable to open adapter", vbCritical
        Exit Sub
    End If
    
    m_bIsRunning = True
    
    ' // Set wait event param
    tWaitVSync.hAdapter = tAdapterOpen.hAdapter
    tWaitVSync.VidPnSourceId = tAdapterOpen.VidPnSourceId
    
    Do While m_bIsRunning
        
        ' // Wait until vsync
        If D3DKMTWaitForVerticalBlankEvent(tWaitVSync) < 0 Then
            MsgBox "Unable to ait vsync", vbCritical
            Exit Do
        End If
        
        m_lFPSCounter = m_lFPSCounter + 1
        
        ' // To update timer
        DoEvents
        
    Loop
    
    ' // Close adapter
    tAdapterClose.hAdapter = tAdapterOpen.hAdapter
    
    D3DKMTCloseAdapter tAdapterClose
    
End Sub

' // Timer interval = 1000 ms
Private Sub tmrFPS_Timer()
    Me.Caption = "FPS: " & m_lFPSCounter
    m_lFPSCounter = 0
End Sub

[baka]

that is much better The Trick.
now, I add this:
If SoftWare Then D3DKMTWaitForVerticalBlankEvent tWaitVSync
after the EndDraw.
now, when I switch to Software rendering, it will be as smooth as Hardware rendering,
it will still be sluggish if the color scheme is basic in windows 7, so in that mode Hardware is better, otherwise its perfect.
this method removes the need of any sleep and timer apis!

that WaitForVerticalBlankEvent code should definitely go codebank
could be used for other things as well.

[georgekar]

I run it in Windows 10 Pro (I have 2 monitors) and return: Unable to open adapter

[baka]

what u mean. your game? d2d? D3DKMTWaitForVerticalBlankEvent?

[georgekar]

The code from Trick not working, because return Invalid_Parameter
Not pass from here: If D3DKMTOpenAdapterFromHdc(tAdapterOpen) < 0 Then

[baka]

yeah. I did have issue with it, some user reported it didnt work. could be windows 10+ update thing?
so I use my old method and its working good.

[xiaoyao]

Interest-based products with unlimited potential can be developed.
If it's all about money, the product may have no soul.
Many people are controlled by their bosses every day after working and lose their ability to invent.
For the sake of living expenses, where dare to have their own ideas.

Therefore, many young people start a business, dare to think and dare to do, there is no pressure, all the money is spent and bankruptcy will not be distressed.

[xiaoyao]

This is a delay that does not occupy the CPU, and it can also be changed to waitansy
pause 1000

I just looked at the code and I thought, why did I use Do/Loop,

While timeGetTime < DEX
   Sleep 1
Wend

this one is better!

also, I wonder why Olaf has not replied and commented on my code, he usually asks for me to share code, so that he can analyze it and find errors.

Public Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Public Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As Long) As Long
Public Declare Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
Public Declare Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As Long) As Long
Public JshTimer As Long
Public Const FAL_SE As Long = 0&, INFINITE As Long = -1&, QS_ALLINPUT As Long = &H4FF&, WAIT_OBJECT_0  As Long = &H0&

Sub NewTimer()
    If JshTimer = 0 Then
        timeBeginPeriod 1
        JshTimer = CreateWaitableTimerW                               'Create a one-shot waitable timer object
    End If
End Sub
Sub CloseTimer()
    timeEndPeriod 1
    If JshTimer <> 0 Then CloseHandle JshTimer: JshTimer = 0
 End Sub
 Sub Main()
   NewTimer
   
    Dim T1 As Long
    T1 = timeGetTime
    Pause 1300
    Debug.Print "Used Time :" & timeGetTime - T1 & " MS"
 End Sub
Sub Pause(ByVal Milliseconds As Currency) 'PauseWtimer
      If SetWaitableTimer(JshTimer, CCur(-Milliseconds)) Then   '原来的
          Do While MsgWaitForMultipleObjects(1&, JshTimer, FAL_SE, INFINITE, QS_ALLINPUT) '从1变成0就结束了
          DoEvents
          Loop
      End If
End Sub

[xiaoyao]

vb6 pause,WaitSync,Delay function that does not occupy CPU-VBForums
https://www.vbforums.com/showthread....32#post5609132

WaitVSync DoOk, 4000

Dim DoOk As Boolean, T1 As Long
Private Sub Command1_Click()
    Command1.Enabled = False
    DoOk = False
    T1 = timeGetTime
    
    WaitVSync DoOk, 4000
    
    MsgBox "Used Time:" & timeGetTime - T1
    Command1.Enabled = True
End Sub

Private Sub Command2_Click()
    DoOk = True
End Sub

Sub WaitVSync(IsDone As Boolean, Optional TimeOutMs As Long = 5000)
'WaitVSync,WaitForTrue
      If SetWaitableTimer(JshTimer, CCur(-TimeOutMs)) Then   '原来的
           Do While MsgWaitForMultipleObjects(1&, JshTimer, FAL_SE, INFINITE, QS_ALLINPUT) And Not IsDone
                DoEvents
          Loop
     End If
End Sub

[baka]

xiaoyao the sleep 1 works great in my application.
I don't see any CPU spikes.

running using hardware (vsync): CPU 1-3% in a (intensive map)
running using software (sleep): CPU 8-10% (same map)

running using hardware (vsync): CPU 0-1% (small map)
running using software (sleep): CPU 2-5% (-"-)

but, the CPU is not just sleep is also rendering the graphic. its 60 frame per second with many animations moving backgrounds etc.
that u can notice in a intensive map. the small map is just a static room. so only mouse and the "door" is animated.

don't think I need to worry about sleep.
the function is mostly to "adjust" the frame per second.

but for curiosity I can do some tests.

edit:
using "pause" will not work. the game start to stuttering. even if I use "1" instead of INFINITE, so it should only wait 1 millisecond.
also, since I need to apply "Doevents" it will not work. if I don't include anything it will freeze.
not a good approach for me.

[xiaoyao]

Set to display 60 frames of game screen per second

Sub ShowGameForFrame()
Dim TimeJg As Currency
TimeJg = 1000 / 60 '60 FRAME/S
TimeJg = 1000

Dim ID As Long
Dim StartTime As Long, WaitTime As Long
StartTime = timeGetTime
While True
    ID = ID + 1
    ShowGame 'DRAW images in dx 'for test :ShowGame2
    WaitTime = (ID * TimeJg) + StartTime - timeGetTime
    Pause WaitTime
    Debug.Print "ID=" & ID & "," & timeGetTime - StartTime & ",PausedTime=" & WaitTime & " MS"
Wend
End Sub
Sub ShowGame()
    VBA.Randomize Timer
    Pause 900 * Rnd
End Sub

ID=1,1001,PausedTime=417 MS
ID=2,2001,PausedTime=957 MS
ID=3,3000,PausedTime=705 MS
ID=4,4000,PausedTime=799 MS
ID=5,5000,PausedTime=516 MS
ID=6,6001,PausedTime=225 MS
ID=7,7000,PausedTime=432 MS