Radar Rush game update for speed optimization on Microsoft Windows 11 24H2

I had to lean to spatial hash to speed up enemy and bullet collision detection. Here is the version of the code before I switch to the newer scripting.dictionary reference c/o an epiphany of sorts.

 

more to come...

 

Rem Radar Rush - The Game
Rem The goal is find items to raid using your radar scanner and avoid traps and kill targets
Rem

'****************************************
'   RadarRush™
'   developed at Mountain Computers Inc.
'   invented by Andrew R Flagg
'   copyright © 2025 Andrew R Flagg
'   all rights reserved to Andrew R Flagg
'****************************************
'   concept and development start date January 4, 2025
'   first deployment date
'   silver deployment date
'   gold deployment date
'   beta deployment startdate
'   beta deployment enddate
'   release date
'   buyout date 2025 or sooner....
'****************************************

Option Explicit                                 'write code syntactically correct
Dim game_window_width  As Integer               'game window width
Dim game_window_height As Integer               'game window height
Dim StepSpeed As Integer                        'knots, starting speed 200, 03/18/2025 changed to 600 knots real striker speeds
Dim MouseTracking As Boolean                    'StrikerJet tracks with mouse position
Dim bullet_count As Integer                     'starting bullets used
Dim max_bullet_count As Integer                 'maximum bullet count at game start and level
Dim visible_bullet_count As Integer             'number of visible bullets
Dim enemy_count As Integer                      'enemy count
Dim max_enemy_count As Integer                  'maximum enemy count at game start and level
Dim visible_enemy_count As Integer              'number of visible enemies
Dim hit As Boolean                              'bullet hit enemy target
Dim clear_bullets_on_screen As Boolean          'if the enemy targets go to zero set this to true and verify all bullets are no longer visible
Dim bullets_in_clip As Integer                  'bullets in striker jet clip
Dim game_level As Integer                       'game level is staggered by random level of enemy targets generated
Dim count_down_timer As Integer                 'global game count down and count up timer
Dim last_enemy_index_count                      'used to collapse the collision detection array
Dim last_bullet_index_count                     'used to collapse the collision detection array
Dim Grid As Scripting.Dictionary                'used to create a spatial hash grid/table for collision detection of bullets vs enemies

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'Debug.Print "Form_KeyDown() - Keycode: " & KeyCode & " Shift:" & Shift
DoEvents

Select Case KeyCode

 Case 27    'esc key - exit game
    'Debug.Print "esc - quit game"
    Me.KeyPreview = True
    Call ShutdownRadarRush

 Case 32    'spacebar - fire bullet
    'Debug.Print "spacebar - fire bullet"
    DoEvents
    If count_down_timer > 0 And game_level > -1 Then
    Else
        Call fire_bullet
    End If
    
 Case 37    'left arrow
    'Debug.Print "Left Arrow"
    DoEvents
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left - StepSpeed
    
 Case 38    'up arrow
    'Debug.Print "Up Arrow"
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top - StepSpeed

 Case 39    'right arrow
    'Debug.Print "Right Arrow"
    DoEvents
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left + StepSpeed

 Case 40    'down arrow
    'Debug.Print "Down Arrow"
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top + StepSpeed
 
 Case 70    'f - faster
    'Debug.Print "f - go faster"
    StepSpeed = StepSpeed + 50
    MainScreen.lbl_StepSpeed = "Speed = " & StepSpeed & " knots"
        
 Case 77    'm - toggle mouse tracking
    'Debug.Print "m - toggle MouseTracking: " & MouseTracking
    MouseTracking = Not MouseTracking
    If MouseTracking Then
        MainScreen.MousePointer = 10
    Else
        MainScreen.MousePointer = 0
    End If
    
 Case 81    'q - quit game
    'Debug.Print "q - quit game"
    Call ShutdownRadarRush
    
 Case 83    's - slower
    'Debug.Print "s - go slower"
    StepSpeed = StepSpeed - 50
    MainScreen.lbl_StepSpeed = "Speed = " & StepSpeed & " knots"

Case 87     'w - play wave file
    'Debug.Print "w - play wave file"
    PlaySound App.Path & "\SOUND29.WAV", 0, 1

'case 97-105 numeric keypad
 Case 97     '1 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left - StepSpeed
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top + StepSpeed
 Case 98     '2 key
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top + StepSpeed
 Case 99     '3 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left + StepSpeed
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top + StepSpeed
 Case 100    '4 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left - StepSpeed
 Case 101    '5 key
    Call fire_bullet
 Case 102    '6 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left + StepSpeed
 Case 103    '7 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left - StepSpeed
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top - StepSpeed
 Case 104    '8 key
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top - StepSpeed
 Case 105    '9 key
    MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left + StepSpeed
    MainScreen.iStrikerJet.Top = Me.iStrikerJet.Top - StepSpeed

 Case 112   'F1 - start game
    'Debug.Print "F1 - start game"
    'count_down_timer = 5
    count_down_timer = 3
   
 Case 113   'F2 - enable radar
    'Debug.Print "F2 - enable radar"
    
 Case 114   'F3 - enable cloak/shield"
    'debug.print "F3 - enable cloak/shield"
    
 
 Case 115   'F4 - toggle screen
    'debug.print "F4 - toggle screen"
    If MainScreen.WindowState = 2 Then
        MainScreen.WindowState = 0
    Else
        MainScreen.WindowState = 2
    End If
    reset_fighter
    
 Case 116   'F5 - reset fighter
    'Debug.Print "F5 - reset righter"
    Call reset_fighter

 Case 117   'show enemy array
        'Call show_enemy_array
        
 Case 118   'show bullet array
        'Call show_bullet_array
 
 Case 122   'F11 - load random enemy target
    'Debug.print "F11 - load random enemy target"
    Call create_enemy_target
 Case 123
    'Debug.Print "F12 - display variables"
    Call display_variables
    
 Case Else
 
 End Select

End Sub
Private Sub Form_Load()
'Debug.Print "Startup Game - Maximum screen size"
'2 maximized, 0 normal
MainScreen.WindowState = 0
MainScreen.Refresh

'optimum screen size for speed is 1150 x 750 pixels, 17250 x 11250 twips
'c/o https://www.unitconverters.net/typography/twip-to-pixel-x.htm
'fits most 14 inch laptops at 1920 x 1080 dpi

Me.Width = 17250
Me.Height = 11250

'get environment values
game_window_width = Me.Width
game_window_height = Me.Height

'Debug.Print "Screen Width: " & game_window_width
'Debug.Print "Screen Height: " & game_window_height

'load game settings and previous state
'Debug.Print "load game settings and previous state"

'configure background
'Debug.Print "configure background"
Me.BackColor = RGB(170, 173, 178)
'#AAADB2
'r  170
'g  173
'b  178

'load navigation toolbar
'Debug.Print "load navigation toolbar"
Call reset_navigation_toolbar

'load radar rush raider vehicle and set starting location
'Debug.Print "load radar rush raider vehicle"
StepSpeed = 600
enemy_count = 0
Call reset_fighter

'enable keyboard action
Me.KeyPreview = True

'enable mouse
MainScreen.MousePointer = 10
MouseTracking = True

'load raid items
'Debug.Print "load raid items"

'load game standings
'Debug.Print "load game standings"

'load radar scanner timer and visual effects
'Debug.Print "load radar scanner timer and visual effects"

'configure Striker Jet
MainScreen.iStrikerJet.Visible = True
max_bullet_count = 1000
bullet_count = 0
max_enemy_count = 50
enemy_count = 0
bullets_in_clip = 10000
count_down_timer = -1
last_enemy_index_count = 1
last_bullet_index_count = 1

'start game loop
'Debug.Print "start game loop"
Timer1.Interval = 1

PlaySound App.Path & "\WELCOME.WAV", 0, 1

'enable the project reference for the spatial hash grid for collision detection
Set Grid = New Scripting.Dictionary

'configure mouses scroll
'SubclassMWheel MainScreen.hWnd


End Sub
Sub reset_fighter()
'Debug.Print "reset_fighter()"

game_window_width = Me.Width
game_window_height = Me.Height

MainScreen.iStrikerJet.Left = game_window_width / 2
MainScreen.iStrikerJet.Top = game_window_height - (iStrikerJet.Height * 2)
'Me.Refresh

End Sub
Sub reset_navigation_toolbar()
'Debug.Print "reset_navigation_toolbar"

MainScreen.fNavigationToolbar.Left = 0
MainScreen.fNavigationToolbar.Top = 0

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Debug.Print "MainScreen MouseDown() Button:" & Button & " (" & X & "," & Y & ")"
Select Case Button
    Case 1
        'MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left - StepSpeed
    Case 2
        'MainScreen.iStrikerJet.Left = Me.iStrikerJet.Left + StepSpeed
    Case Else
    End Select

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Debug.Print "MainScreen MouseMove() Button:" & Button & " (" & X & "," & Y & ")"

'MainScreen.lbl_JetPosition.Caption = "Position: [" & MainScreen.iStrikerJet.Left & "," & MainScreen.iStrikerJet.Top & "]"

If MouseTracking Then
    MainScreen.iStrikerJet.Left = X - MainScreen.iStrikerJet.Width / 2
    MainScreen.iStrikerJet.Top = Y - MainScreen.iStrikerJet.Height - 100
    
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Debug.Print "MainScreen Unload()"
'UnSubclassMWheel MainScreen.hWnd
End Sub
Private Sub iStrikerJet_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Debug.Print "iStrikerJet_MouseDown Button:" & Button & " (" & X & "," & Y & ")"
End Sub
Private Sub iStrikerJet_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Debug.Print "iStrikerJet_MouseMove Button:" & Button & " (" & X & "," & Y & ")"
End Sub
Sub fire_bullet()
'PlaySound App.Path & "\bullet_sound.wav", 0, 0
Dim myShp As Shape            'bullet shape object
bullet_count = bullet_count + 1
Set myShp = MainScreen.Controls.Add("VB.Shape", "shpBullet" & CStr(bullet_count))
myShp.Left = MainScreen.iStrikerJet.Left + MainScreen.iStrikerJet.Width / 2
myShp.Top = MainScreen.iStrikerJet.Top - MainScreen.iStrikerJet.Height / 2
myShp.Width = 75
myShp.Shape = 3
myShp.FillColor = vbRed
myShp.FillStyle = vbSolid
myShp.Visible = True
visible_bullet_count = visible_bullet_count + 1
MainScreen.lbl_lBulletsFired.Caption = "Bullets Fired: " & CStr(bullet_count)
MainScreen.lbl_bullets_in_clip.Caption = "Bullets In Clip: " & CStr(bullets_in_clip - bullet_count)
'PlaySound App.Path & "\bullet_zip.wav", 0, &H11
'PlaySound App.Path & "\bullet_sound.wav", 0, &H11
'Debug.Print "bullet_count: " & bullet_count

End Sub
Private Sub Timer1_Timer()
'Debug.Print "Timer1() " & Now()

'keep track of the bullets and locations
Dim i As Integer
If visible_bullet_count > 0 Then
    'Debug.Print CStr(bullet_count) + " bullets have been fired, keep track of them"
    'For i = last_bullet_index_count To bullet_count
    For i = 1 To bullet_count
    'DoEvents
    'MainScreen.Controls("shpBullet" & CStr(i)).Left
    If MainScreen.Controls("shpBullet" & CStr(i)).Visible = True Then
        MainScreen.Controls("shpBullet" & CStr(i)).Top = MainScreen.Controls("shpBullet" & CStr(i)).Top - 150
        If MainScreen.Controls("shpBullet" & CStr(i)).Top < 1 Then
            MainScreen.Controls("shpBullet" & CStr(i)).Visible = False
            visible_bullet_count = visible_bullet_count - 1
            last_bullet_index_count = last_bullet_index_count + 1
            Exit Sub
        End If
    End If
    Next
End If

If visible_enemy_count = 0 And clear_bullets_on_screen = True Then
    Call clear_the_game_level
    Call next_game_level
    Exit Sub
End If

'analyze the global counter status

If count_down_timer > 0 Then
            PlaySound App.Path & "\BOOP_V2.wav", 0, 1
            Timer1.Interval = 500 '.5 second
            MainScreen.lblCount_Down_Timer.Visible = True
            MainScreen.lblCount_Down_Timer.Font.Size = 26
            MainScreen.lblCount_Down_Timer.Alignment = vbCenter
            MainScreen.lblCount_Down_Timer.Top = (Me.ScaleHeight - lblCount_Down_Timer.Height) / 2
            MainScreen.lblCount_Down_Timer.Left = (Me.ScaleWidth - lblCount_Down_Timer.Width) / 2
            PlaySound App.Path & "\BOOP.wav", 0, 1
            MainScreen.lblCount_Down_Timer.Caption = count_down_timer
            count_down_timer = count_down_timer - 1
            If count_down_timer = 0 Then
                MainScreen.lblCount_Down_Timer.Visible = False
                Timer1.Interval = 1 'put timer back to 1 and run fast as possible by testing.
                Call start_game(10 * game_level)
            End If
Else
'placeholder
Timer1.Interval = 1
End If


'Debug.Print "visible bullet count " & CStr(visible_bullet_count)
'keep track of bullets hitting enemy
If visible_enemy_count > 0 Then
    Call DoShapesCollide
End If

End Sub
Sub ShutdownRadarRush()

'// Unloads all forms and closes the connection.
   Dim i As Integer
   
   DoEvents
   'g_bolShutDown = True
   MainScreen.MousePointer = vbHourglass
  
   'Close_Connection
   '// Unload all loaded forms.
   For i = Forms.Count - 1 To 0 Step -1
      Unload Forms(i)
   Next i
   MainScreen.MousePointer = vbNormal
   '// Ends the program.
   End

End Sub
Sub display_variables()
'F12
'Debug.Print "*********** Variables **************"
'Debug.Print "bullet count " & CStr(bullet_count)
Dim i
If bullet_count > 0 Then
    For i = 0 To bullet_count - 1
        Debug.Print "Bullet: " & CStr(i) & " (x,y):(" & MainScreen.Controls("shpBullet" & CStr(i)).Left & "," & MainScreen.Controls("shpBullet" & CStr(i)).Top & ")" & " Visible:" & MainScreen.Controls("shpBullet" & CStr(i)).Visible
    Next
End If

If enemy_count > 0 Then
    For i = 0 To enemy_count - 1
        Debug.Print "Enemy Target: " & CStr(i) & " (x,y):(" & MainScreen.Controls("shpEnemyTarget" & CStr(i)).Left & "," & MainScreen.Controls("shpEnemyTarget" & CStr(i)).Top & ")" & " Visible:" & MainScreen.Controls("shpEnemyTarget" & CStr(i)).Visible
    Next
End If

End Sub
Sub create_enemy_target()
'Debug.Print "create_enemy_target()"
'PlaySound App.Path & "\bullet_sound.wav", 0, 0
Dim myEnemyShape As Shape            'enemy target shape object
enemy_count = enemy_count + 1
Set myEnemyShape = MainScreen.Controls.Add("VB.Shape", "shpEnemyTarget" & CStr(enemy_count))


'VB6 Random range formula
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

'02-01-2026 remark out the following based on the hardcoded grid or enemy field in twips [15900-2000, 6000 - 200]
'tweaked width from 2000 to 2200 to avoid the menu

myEnemyShape.Left = Int(15900 - 2300 + 1) * Rnd + 2300
myEnemyShape.Top = Int(6000 - 200 + 1) * Rnd + 200

'retry_rand_x:
'myEnemyShape.Left = Int((MainScreen.Width - MainScreen.Left + 1) * Rnd + MainScreen.Left)
'If myEnemyShape.Left < fNavigationToolbar.Width Or myEnemyShape.Left > (MainScreen.Width * 0.9) Then
'    DoEvents
'    GoTo retry_rand_x
'End If

'retry_rand_y:
'myEnemyShape.Top = Int((MainScreen.Height - MainScreen.Top) * Rnd + MainScreen.Top) + (myEnemyShape.Height * 2)
'Debug.Print "myEnemyShape (x, y): " & myEnemyShape.Left & "," & myEnemyShape.Top
'If myEnemyShape.Top > (MainScreen.Height * 0.5) Then
'    DoEvents
'    GoTo retry_rand_y
'End If

myEnemyShape.Width = 300
myEnemyShape.Shape = 3
myEnemyShape.FillColor = vbRed
myEnemyShape.FillStyle = vbSolid
myEnemyShape.Visible = True
visible_enemy_count = visible_enemy_count + 1
'MainScreen.lbl_EnemyCount.Caption = "Enemy Count: " & CStr(enemy_count)
MainScreen.lbl_EnemyCount.Caption = "Enemy Count: " & CStr(visible_enemy_count)
'Debug.Print "enemy_count: " & enemy_count

End Sub

Sub DoShapesCollide()
Dim i As Integer, j As Integer
Dim Bx As Integer, By As Integer, Bh As Integer, Bw As Integer, Bxc As Integer
Dim ETx As Integer, ETy As Integer, ETh As Integer, ETw As Integer

'MainScreen.lbl_Enemy_Count.Caption = "Active Enemies: " & enemy_count
'MainScreen.lbl_Bullet_Count.Caption = "Bullets in the Air: " & bullet_count

If visible_enemy_count > 0 Then
        For i = last_bullet_index_count To bullet_count
        DoEvents
        If MainScreen.Controls("shpBullet" & CStr(i)).Visible = True Then
                Bx = MainScreen.Controls("shpBullet" & CStr(i)).Left
                By = MainScreen.Controls("shpBullet" & CStr(i)).Top
                Bh = MainScreen.Controls("shpBullet" & CStr(i)).Height
                Bw = MainScreen.Controls("shpBullet" & CStr(i)).Width
                Bxc = Bx + (Bw / 2)
                
                For j = last_enemy_index_count To enemy_count
                    DoEvents
                    If MainScreen.Controls("shpEnemyTarget" & CStr(j)).Visible = True Then
                    
                        ETx = MainScreen.Controls("shpEnemyTarget" & CStr(j)).Left
                        ETy = MainScreen.Controls("shpEnemyTarget" & CStr(j)).Top
                        ETh = MainScreen.Controls("shpEnemyTarget" & CStr(j)).Height
                        ETw = MainScreen.Controls("shpEnemyTarget" & CStr(j)).Width
                        
                        'test collision between bullet and enemy
                        If ((By + Bh) <= (ETy + ETh) And ((Bx >= ETx) And (Bx) <= (ETx + ETw))) Then
                            'PlaySound App.Path & "\bullet_sound.wav", 0, &H1
                            MainScreen.Controls("shpEnemyTarget" & CStr(j)).Visible = False
                            visible_enemy_count = visible_enemy_count - 1
                            MainScreen.lbl_EnemyCount.Caption = "Enemy Count: " & CStr(visible_enemy_count)
                            MainScreen.lbl_EnemyKills.Caption = "Enemy Kills: " & CStr(enemy_count - visible_enemy_count)
                            If visible_enemy_count = 0 Then
                                clear_bullets_on_screen = True
                                Exit Sub
                            End If
                            MainScreen.Controls("shpBullet" & CStr(i)).Visible = False
                            visible_bullet_count = visible_bullet_count - 1
                            Exit Sub
                        End If
                    End If
                Next j
                
        End If
        Next i
End If
End Sub
Sub clear_the_game_level()

Dim i
For i = last_bullet_index_count To bullet_count
        MainScreen.Controls("shpBullet" & CStr(i)).Visible = False
Next i
visible_bullet_count = 0
last_bullet_index_count = i

'if there are any straggler bullets clear them off the screen due to caching ambiguity

clear_bullets_on_screen = False

End Sub

Sub start_game(level As Integer)
Dim i As Integer, random_number_enemy_targets As Integer
'VB6 Random range formula
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
random_number_enemy_targets = Int((level - 1 + 1) * Rnd + 1)
For i = 1 To random_number_enemy_targets
    create_enemy_target
Next

MainScreen.lbl_GameLevelDifficulty.Caption = "Game Level Difficulty:" + Str(random_number_enemy_targets)
End Sub

Sub next_game_level()
'level up
game_level = game_level + 1
last_bullet_index_count = bullet_count
last_enemy_index_count = enemy_count
visible_enemy_count = 0
MainScreen.lbl_GameLevel.Caption = "Game Level:" + Str(game_level)
DoEvents
'PlaySound App.Path & "\GREATKILLWARRIOR.WAV", 0, &H11
count_down_timer = 1
'Call start_game(10 * game_level)

End Sub