Part I - Sample VB code for RadarRush™ Game

Here is some sample code for a game. you might like it. Enjoy!

 

radarrush.frm

 

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


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 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

'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
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

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

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

'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 & ")"

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 = 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
        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
End If

'analyze the global counter status

If count_down_timer > 0 Then
            PlaySound App.Path & "\BOOP_V2.wav", 0, 1
            Timer1.Interval = 1000 '1 second
            MainScreen.lblCount_Down_Timer.Visible = True
            MainScreen.lblCount_Down_Timer.Font.Size = 72
            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)

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
    GoTo retry_rand_x
End If

retry_rand_y:
myEnemyShape.Top = Int((MainScreen.Height - MainScreen.Top) * Rnd + MainScreen.Top) + (myEnemyShape.Height * 2)
If myEnemyShape.Top > (MainScreen.Height * 0.5) Then
    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

    ' Iterate through each pair of shapes in the array
    If visible_bullet_count > 0 Then
    
    For i = 1 To bullet_count
    
    DoEvents
    
    If MainScreen.Controls("shpBullet" & CStr(i)).Visible = True Then
    
        If visible_enemy_count > 0 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 = 1 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
                    
                    'collision check
                    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
                        End If
                        MainScreen.Controls("shpBullet" & CStr(i)).Visible = False
                        visible_bullet_count = visible_bullet_count - 1
                        
                    End If
                    
                End If
                
            Next j
            
        End If
    
    End If
    Next i
    
    End If
    
End Sub
Sub clear_the_game_level()

Dim i
For i = 1 To bullet_count
        MainScreen.Controls("shpBullet" & CStr(i)).Visible = False
Next 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
MainScreen.lbl_GameLevel.Caption = "Game Level:" + Str(game_level)
DoEvents
'PlaySound App.Path & "\GREATKILLWARRIOR.WAV", 0, &H11
count_down_timer = 3
'Call start_game(10 * game_level)

End Sub

 

 

'begin mouse wheel scroll functions and constants
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_MOUSELAST = &H20A
Private Const WM_MOUSEHWHEEL = &H20E
'
Private hOldWheelProc As Long
'end mouse wheel scroll functions and constants


Public Sub SubclassMWheel(ParentWnd As Long)
     If hOldWheelProc <> 0 Then Exit Sub
     hOldWheelProc = GetWindowLong(ParentWnd, GWL_WNDPROC)
     SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc
End Sub

Public Sub UnSubclassMWheel(ParentWnd As Long)
     If hOldWheelProc = 0 Then Exit Sub
     SetWindowLong ParentWnd, GWL_WNDPROC, hOldWheelProc
End Sub

Private Function MWheelProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case wMsg
    Case WM_MOUSEWHEEL
        Select Case Sgn(wParam)
        Case 1:    Debug.Print "Scroll Forward"
                    MainScreen.iStrikerJet.Top = MainScreen.iStrikerJet.Top - StepSpeed
                    'MainScreen.Refresh
        Case -1:   Debug.Print "Scroll Reverse"
                    MainScreen.iStrikerJet.Top = MainScreen.iStrikerJet.Top + StepSpeed
                    'MainScreen.Refresh
        End Select
    Case WM_MOUSEHWHEEL
        Select Case Sgn(wParam)
        Case 1:    Debug.Print "Scroll Tilt Right"
        Case -1:   Debug.Print "Scroll Tilt Left"
        End Select
    Case Else
        MWheelProc = CallWindowProc(hOldWheelProc, hWnd, wMsg, wParam, lParam)
    End Select
End Function

 

 

Private Const SND_APPLICATION As Long = &H80
Private Const SND_ALIAS As Long = &H10000
Private Const SND_ALIAS_ID As Long = &H110000
Private Const SND_ASYNC As Long = &H1
Private Const SND_FILENAME As Long = &H20000
Private Const SND_LOOP As Long = &H8
Private Const SND_MEMORY As Long = &H4
Private Const SND_NODEFAULT As Long = &H2
Private Const SND_NOSTOP As Long = &H10
Private Const SND_NOWAIT As Long = &H2000
Private Const SND_PURGE As Long = &H40
Private Const SND_RESOURCE As Long = &H40004
Private Const SND_SYNC As Long = &H0

Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
    (ByVal lpszName As String, _
     ByVal hModule As Long, _
     ByVal dwFlags As Long) As Long
     

'PlaySound "X:\Sounds\trumpet.wav", 0, SND_FILENAME Or SND_ASYNC Or SND_LOOP
'PlaySound "X:\Sounds\trumpet.wav", 0, SND_FILENAME
'PlaySound vbNullString, 0, 0

 

© 2025 RadarRush™ - permission to use by request only. contact #GGPCTU or #MTNCOMP

  REF: https://x.com/GGPCTU/status/1950205243720950174