This started as an old VB6 Asteroids type game by someone named Tassadar that I downloaded from planetsourcecode.com years ago, and converted to QB64.
It's very easy to understand and modify to make something more interesting.
The next thing I would like to figure out is how to change how it handles x/y velocity for smoother more natural acceleration / momentum.
Enjoy
It's very easy to understand and modify to make something more interesting.
The next thing I would like to figure out is how to change how it handles x/y velocity for smoother more natural acceleration / momentum.
Enjoy
Code: (Select All)
_Title "Collisions"
' Original VB6 code for "Collisions" by Tassadar,
' found on PlanetSourceCode.com in 2001.
' Converted to QB64 by madscijr.
' DATE WHO-DONE-IT DID-WHAT
' 2001-06-10 Tassadar created program
' 2022-11-01 madscijr v0.19, got it working in QB64, added some tweaks
' DONE:
' * get it working in QB64 + tweak various calculations
' * random enemy radius (wider range with each level)
' * added variables for bullet lifespan, bullet radius
' * bullets can wrap around screen
' * bullet-bullet collisions
' * bonus shields at end of round
' * are you lookin' at me??
' TODO:
' * track x/y velocity differently (movement is jerky)
' * option: enemies can shoot each other
' * option: fire button auto-repeat
' * support simple polygon shapes
' * improve collisions
' * support higher resolution upto 4k to fit lots of stuff on screen
' * local multiplayer Spacewar! (upto 16 players)
' * sound effects
' * explosions and stuff
' * menu + customize input + options
' * sun and gravity
' * asteroids
' * enemies can move + enemy AI
' * vary difficulty + scoring based on difficulty
' * limited fuel/ammo
' * player must dock with space station for more fuel/ammo/repair
' * gravity for large asteroids/moons
' * lunar lander mode, players land moons/asteroids to refuel, etc.
' * attack opponents' bases, etc.
' * etc.
' ORIGINAL CREDITS:
'********************************************************************************
'* This is My Program, I made it to show some trig stuff *
'* and got a little carried away, but it shows how to do trigonometry anyways *
'* *
'* You are permitted to do whatever you want with this code *
'* eg. Feel free to modify this code, steal it, etc. *
'* I don't really give a crap! *
'* *
'* Programmed by Tassadar *
'********************************************************************************
' USEFUL CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
'Const Pi = 3.14159 ' Pi , bit obvious
Const iFPS = 60 ' Delay between frames (frames per second)
Const SHIP_RADIUS = 10 ' What is the radius of the players ship
Const BULLET_RADIUS = 2 ' What is the radius of the bullets
Const SHIP_ACCEL = 0.05 ' 0.1 ' how fast does it accelerate
Const MAX_SPEED = 12 ' 6 ' what is the ships max speed
Const SHOOT_DELAY = 200 ' Delay between shots for the ship
Const BULLET_SPEED = 9 ' 6 ' Bullet speed - Ship speed + bullet speed = overall bulletspeed
Const BULLET_LIFESPAN = 1 ' # seconds bullet is alive
Const BULLETS_STOP_BULLETS = TRUE
Const TURN_SPEED = 72 ' 36=faster 18=superfast
Const MIN_ENEMY_RADIUS = 6 ' What is the initial minimum radius of the enemy ships
Const MAX_ENEMY_RADIUS = 99 ' What is the initial maximum radius of the enemy ships
Const iMinX = 1
Const iMaxX = 800
Const iMinY = 1
Const iMaxY = 640
Const BULLET_DAMAGE = 5
Const WRAP_BULLET = TRUE
Const BONUS_SHIELDS = 50
Type ShipType
xPos As Integer ' X co-ordinate of the ship
yPos As Integer ' Y co-ordinate of the ship
heading As Single ' which direction is the ship heading
facing As Single ' which direction is the ship facing
shields As Integer ' how much shields does the ship have
speed As Single ' how fast is the ship going
ShootTime As Long
ShootCount As Long
End Type ' ShipType
Type EnemyType
xPos As Integer ' X position of this enemy
yPos As Integer ' Y position of this enemy
life As Integer ' How much life does this enemy have
alive As Integer ' Is this enemy alive
radius As Integer ' size of enemy ship
End Type ' EnemyType
Type BulletType
xPos As Integer ' X co-ordinate of this bullet
yPos As Integer ' Y co-ordinate of this bullet
heading As Single ' Direction this bullet is heading
speed As Single ' Speed of this bullet
alive As Integer ' Is this bullet alive
kind As String ' What type of bullet is this (Players or enemies)
lifespan As Long
lifetime As Long
End Type ' BulletType
'' ENABLE / DISABLE DEBUG CONSOLE
'Dim Shared m_bDebug As Integer: m_bDebug = TRUE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' OTHER USEFUL VARIABLES
Dim Shared PI As Single: PI = 4 * Atn(1)
Dim Shared ENGINE_RADIUS As Integer: ENGINE_RADIUS = SHIP_RADIUS * 0.6
Dim Shared FLAME_RADIUS As Integer: FLAME_RADIUS = SHIP_RADIUS * 2
' GAME STATE
Dim Shared m_bGameOver As Integer ' Is the game over
Dim Shared m_bAllDead As Integer ' Are all the enemies dead
Dim Shared m_iLevel As Integer ' Track the level
Dim Shared m_iScore As Integer ' Keeps track of player score
Dim Shared m_iMinEnemyRadius As Integer ' current minimum enemy radius
Dim Shared m_iMaxEnemyRadius As Integer ' current maximum enemy radius
' INPUT VARIABLES
Dim Shared m_bLeftKey As Integer ' Is the LeftKey depressed
Dim Shared m_bRightKey As Integer ' Is the RightKey depressed
Dim Shared m_bUpKey As Integer ' Is the UpKey depressed
Dim Shared m_bDownKey As Integer ' Is the DownKey depressed
Dim Shared m_bShootKey As Integer ' Is the ShootKey depressed
Dim Shared m_bCheatKey As Integer
Dim Shared m_bEscKey As Integer
' GAME OBJECTS
Dim Shared m_Ship As ShipType ' The Players Ship
ReDim Shared m_arrEnemy(-1) As EnemyType ' A nice array of enemies
ReDim Shared m_arrBullet(-1) As BulletType ' A nice array of Bullets
'' ****************************************************************************************************************************************************************
'' ACTIVATE DEBUGGING WINDOW
'If m_bDebug = TRUE Then
' $Console
' _Delay 4
' _Console On
' _Echo "Started " + m_ProgramName$
' _Echo "Debugging on..."
'End If
'' ****************************************************************************************************************************************************************
' START THE GAME
main
' FINISHED
System ' return control to the operating system
'' ****************************************************************************************************************************************************************
'' DEACTIVATE DEBUGGING WINDOW
'If m_bDebug = TRUE Then
' _Console Off
'End If
' ****************************************************************************************************************************************************************
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GAME CODE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
Sub main ()
Dim RoutineName As String: RoutineName = "main"
Screen _NewImage(iMaxX, iMaxY, 32) ' 100 text columns x 40 text rows
_KeyClear
InitVariables ' Initialize variables
Do ' main game loop
Cls ' Clear the form
GetInput
If m_bEscKey = FALSE Then
MoveBullets ' Activates the MoveBullets sub
MoveShip ' Activates the MoveShip sub
MoveEnemy ' (doesn't do much yet)
Collisions ' Activates the Collisions sub
Else
m_bGameOver = TRUE
End If
If m_bGameOver = FALSE Then
Shooting ' Activates the Shooting sub
DrawEnemy ' Activates the DrawEnemy sub
DrawBullets ' Activates the DrawBullets sub
ShowScore ' Display the score, etc.
DrawShip ' Activates the DrawShip sub
Respawn ' Activates the Respawn sub
Else
If AskPlayAgain% = TRUE Then
InitVariables
Else
Exit Do
End If
End If
' UPDATE THE SCREEN
_Display
' CONTROL GAME SPEED
_Limit iFPS
Loop
' RETURN TO AUTODISPLAY
_AutoDisplay
End Sub ' main
' /////////////////////////////////////////////////////////////////////////////
Function AskPlayAgain%
Dim bResult As Integer
Dim in$
Cls
Print "GAME OVER"
Print
Print "Level: " + cstr$(m_iLevel)
Print "Score: " + cstr$(m_iScore)
Print
Do
Input "Do you wish to try again (y/n) "; in$
If LCase$(_Trim$(in$)) = "y" Then
bResult = TRUE
Exit Do
ElseIf LCase$(_Trim$(in$)) = "n" Then
bResult = FALSE
Exit Do
Else
Print
Print "Please type 'y' or 'n'"
Print
End If
Loop
AskPlayAgain% = bResult
End Function ' AskPlayAgain%
' /////////////////////////////////////////////////////////////////////////////
' Set the initial state for variables
Sub InitVariables ()
Dim iLoop1 As Integer ' Used for variables
Dim iSpread As Integer
Dim iHalf As Integer
Dim iDivisor As Integer
' Msgbox telling you how to play
'MsgBox "Use the arrow keys to fly around" + vbCrLf + "Control to shoot", vbOKOnly, "How To Play"
' Score
m_iLevel = 1
m_iScore = 0
' Game status
m_bGameOver = FALSE
' Enemy min/max radius
iSpread = MAX_ENEMY_RADIUS - MIN_ENEMY_RADIUS
iHalf = iSpread / 2
iDivisor = iSpread / 10
m_iMinEnemyRadius = iHalf - iDivisor
If m_iMinEnemyRadius < MIN_ENEMY_RADIUS Then m_iMinEnemyRadius = MIN_ENEMY_RADIUS
m_iMaxEnemyRadius = iHalf + iDivisor
If m_iMaxEnemyRadius > MAX_ENEMY_RADIUS Then m_iMaxEnemyRadius = MAX_ENEMY_RADIUS
' Clear input flags
m_bLeftKey = FALSE
m_bRightKey = FALSE
m_bUpKey = FALSE
m_bDownKey = FALSE
m_bShootKey = FALSE
' Set the starting positions of the ship
m_Ship.heading = 0
m_Ship.facing = 0
m_Ship.shields = 100
m_Ship.speed = 0
m_Ship.xPos = RandomNumber%(iMinX, iMaxX) 'Int(Rnd * ScaleWidth + 1)
m_Ship.yPos = RandomNumber%(iMinY, iMaxY) 'Int(Rnd * ScaleHeight + 1)
m_Ship.ShootTime = iFPS \ 4
m_Ship.ShootCount = m_Ship.ShootTime + 1
' Spawn enemy
ReDim _Preserve m_arrEnemy(0) As EnemyType
For iLoop1 = 0 To UBound(m_arrEnemy)
' Set the starting position of the enemies
m_arrEnemy(iLoop1).alive = TRUE
m_arrEnemy(iLoop1).life = 30
m_arrEnemy(iLoop1).xPos = m_Ship.xPos
m_arrEnemy(iLoop1).yPos = m_Ship.yPos
' choose a random size
m_arrEnemy(iLoop1).radius = RandomNumber%(m_iMinEnemyRadius, m_iMaxEnemyRadius)
' Stops the enemy starting on top of the ship
Do Until GetDist(m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos, m_Ship.xPos, m_Ship.yPos) > SHIP_RADIUS * 10
m_arrEnemy(iLoop1).xPos = RandomNumber%(iMinX, iMaxX) 'Int(Rnd * ScaleWidth + 1)
m_arrEnemy(iLoop1).yPos = RandomNumber%(iMinY, iMaxY) 'Int(Rnd * ScaleHeight + 1)
Loop
Next iLoop1
' RESET BULLETS
ReDim _Preserve m_arrBullet(-1) As BulletType
End Sub ' InitVariables
' /////////////////////////////////////////////////////////////////////////////
' Detect which keys are pressed
Sub GetInput ()
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
If _Button(KeyCode_Left%) Then
m_bLeftKey = TRUE
m_bRightKey = FALSE
ElseIf _Button(KeyCode_Right%) Then
m_bLeftKey = FALSE
m_bRightKey = TRUE
Else
m_bLeftKey = FALSE
m_bRightKey = FALSE
End If
If _Button(KeyCode_Up%) Then
m_bUpKey = TRUE
m_bDownKey = FALSE
ElseIf _Button(KeyCode_Down%) Then
m_bUpKey = FALSE
m_bDownKey = TRUE
Else
m_bUpKey = FALSE
m_bDownKey = FALSE
End If
If _Button(KeyCode_CtrlLeft%) Then
m_bShootKey = TRUE
ElseIf _Button(KeyCode_CtrlRight%) Then
m_bShootKey = TRUE
Else
m_bShootKey = FALSE
End If
If _Button(KeyCode_1%) Then
m_bCheatKey = TRUE
Else
m_bCheatKey = FALSE
End If
If _Button(KeyCode_Escape%) Then
m_bEscKey = TRUE
Else
m_bEscKey = FALSE
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
End Sub ' GetInput
' /////////////////////////////////////////////////////////////////////////////
' Check for collisions
' TODO: improve collision checking to handle different shape polygons, etc.
Sub Collisions ()
Dim iLoop1 As Integer
Dim iLoop2 As Integer
Dim in$
' Check for bullet collisions
For iLoop1 = 0 To UBound(m_arrBullet)
' IS THIS BULLET ALIVE?
If m_arrBullet(iLoop1).alive = TRUE Then
' CHECK FOR BULLET HIT BULLET
For iLoop2 = 0 To UBound(m_arrBullet)
If iLoop2 <> iLoop1 Then
If BULLETS_STOP_BULLETS = TRUE Then
If GetDist(m_arrBullet(iLoop2).xPos, m_arrBullet(iLoop2).yPos, m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos) <= BULLET_RADIUS Then
' BOTH SHOTS DESTROYED
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
m_arrBullet(iLoop2).alive = FALSE ' Destroy the other bullet
End If
End If
End If
Next iLoop2
End If
' IS THIS BULLET STILL ALIVE?
If m_arrBullet(iLoop1).alive = TRUE Then
' CHECK ENEMY BULLET
If m_arrBullet(iLoop1).kind = "ENEMY" Then
' Check for collision between bullet and ship
If GetDist(m_Ship.xPos, m_Ship.yPos, m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos) <= SHIP_RADIUS Then
m_Ship.shields = m_Ship.shields - BULLET_DAMAGE ' Take Damage
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
Else
' CHECK FOR PLAYER'S BULLET
If m_arrBullet(iLoop1).kind = "SHIP" Then
For iLoop2 = 0 To UBound(m_arrEnemy)
' If the enemy is alive then
If m_arrEnemy(iLoop2).alive = TRUE Then
' Check for collision between bullet and enemy
If GetDist(m_arrEnemy(iLoop2).xPos, m_arrEnemy(iLoop2).yPos, m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos) <= m_arrEnemy(iLoop2).radius Then
m_arrEnemy(iLoop2).life = m_arrEnemy(iLoop2).life - BULLET_DAMAGE ' Enemy take damage
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
End If
Next iLoop2
End If
End If
End If
Next iLoop1
' CHECK FOR SHIP COLLIDING WITH ENEMY
For iLoop1 = 0 To UBound(m_arrEnemy)
' If the enemy is alive then
If m_arrEnemy(iLoop1).alive = TRUE Then
' Check for collision between ship and enemy
If GetDist(m_Ship.xPos, m_Ship.yPos, m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos) <= m_arrEnemy(iLoop1).radius Then
m_arrEnemy(iLoop1).life = 0 ' The enemy has no life/Dead
m_Ship.shields = 0 ' The ship has no shields/Dead
End If
' if the enemy is dead then destroy it, add to score
If m_arrEnemy(iLoop1).life <= 0 Then
m_arrEnemy(iLoop1).alive = FALSE
m_iScore = m_iScore + 10
End If
End If
Next iLoop1
' IS SHIP DEAD?
If m_Ship.shields <= 0 Then
'' Display the message box
'iLoop1 = MsgBox("You have a score of " & m_iScore & vbCrLf & vbCrLf & "Do you wish to try again?", vbYesNo, "Try Again")
'Select Case iLoop1
' Case vbYes
' ' Restart if yes is clicked
' InitVariables
' Case vbNo
' ' End if no clicked
' End
'End Select
m_bGameOver = TRUE
End If
End Sub ' Collisions
' /////////////////////////////////////////////////////////////////////////////
Sub Shooting ()
Dim iLoop1 As Integer ' Used for variables
Dim iLoop2 As Integer ' Used for variables
Dim iFreeSpot As Integer
Dim sngXComp As Single
Dim sngYComp As Single
' DID PLAYER SHOOT?
If m_bShootKey = TRUE Then
' Has the gun cooled down yet (prevent bullet being created every 25 milliseconds)
If m_Ship.ShootCount > m_Ship.ShootTime Then
m_Ship.ShootCount = 0
iFreeSpot = -1
For iLoop1 = 0 To UBound(m_arrBullet)
' Check whether it can use another bullet or not
If m_arrBullet(iLoop1).alive = FALSE Then
' if so use the dead bullet
iFreeSpot = iLoop1
Exit For
End If
Next iLoop1
' if there were no already dead bullets
If iFreeSpot = -1 Then
' create another one
ReDim _Preserve m_arrBullet(UBound(m_arrBullet) + 1) As BulletType
' iFreeSpot is this new bullet
iFreeSpot = UBound(m_arrBullet)
End If
' Set the properties of this bullet
m_arrBullet(iFreeSpot).alive = TRUE ' The bullet is alive
m_arrBullet(iFreeSpot).xPos = m_Ship.xPos ' the bullet is created where the ship is
m_arrBullet(iFreeSpot).yPos = m_Ship.yPos ' the bullet is created where the ship is
m_arrBullet(iFreeSpot).kind = "SHIP" ' This is a Ship Bullet
m_arrBullet(iFreeSpot).lifespan = BULLET_LIFESPAN * iFPS ' # seconds bullet is alive
m_arrBullet(iFreeSpot).lifetime = 0 ' bullet is brand new
' Determine the X and Y components of the resultant vector
sngXComp = m_Ship.speed * Sin(m_Ship.heading) + BULLET_SPEED * Sin(m_Ship.facing)
sngYComp = m_Ship.speed * Cos(m_Ship.heading) + BULLET_SPEED * Cos(m_Ship.facing)
' Determine the resultant speed
m_arrBullet(iFreeSpot).speed = Sqr(sngXComp ^ 2 + sngYComp ^ 2)
'Calculate the resultant heading, and adjust for arctangent by adding Pi if necessary
If Sgn(sngYComp) > 0 Then
m_arrBullet(iFreeSpot).heading = Atn(sngXComp / sngYComp)
End If
If Sgn(sngYComp) < 0 Then
m_arrBullet(iFreeSpot).heading = Atn(sngXComp / sngYComp) + PI
End If
End If
End If
' ENEMIES SHOOT
For iLoop1 = 0 To UBound(m_arrEnemy)
' Check whether the enemy is alive
If m_arrEnemy(iLoop1).alive = TRUE Then
' Check whether the enemy will fire or not
If Int(Rnd * 100 + 1) = 1 Then
iFreeSpot = -1
For iLoop2 = 0 To UBound(m_arrBullet)
' Check whether the enemy will use an old bullet
If m_arrBullet(iLoop2).alive = FALSE Then
' If so iFreeSpot is the old bullet
iFreeSpot = iLoop2
Exit For
End If
Next iLoop2
' If there were no free spots then create another bullet
If iFreeSpot = -1 Then
' Create the new bullet
ReDim _Preserve m_arrBullet(UBound(m_arrBullet) + 1) As BulletType
' iFreeSpot is this new bullet
iFreeSpot = UBound(m_arrBullet)
End If
' Set the properties for this bullet
m_arrBullet(iFreeSpot).alive = TRUE ' It is Alive!!!
' Set it so the bullet shoots at the ship
m_arrBullet(iFreeSpot).heading = GetAngle(m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos, m_Ship.xPos, m_Ship.yPos)
m_arrBullet(iFreeSpot).xPos = m_arrEnemy(iLoop1).xPos ' Create the bullet where the enemy is
m_arrBullet(iFreeSpot).yPos = m_arrEnemy(iLoop1).yPos ' Create the bullet where the enemy is
m_arrBullet(iFreeSpot).speed = 6 ' Set the bullet speed
m_arrBullet(iFreeSpot).kind = "ENEMY" ' This is an enemy bullet
m_arrBullet(iFreeSpot).lifespan = BULLET_LIFESPAN * iFPS ' # seconds bullet is alive
m_arrBullet(iFreeSpot).lifetime = 0 ' bullet is brand new
' Move bullet outside of enemy
m_arrBullet(iFreeSpot).xPos = m_arrBullet(iFreeSpot).xPos + ((m_arrEnemy(iLoop1).radius + 1) * Sin(m_arrBullet(iFreeSpot).heading))
m_arrBullet(iFreeSpot).yPos = m_arrBullet(iFreeSpot).yPos - ((m_arrEnemy(iLoop1).radius + 1) * Cos(m_arrBullet(iFreeSpot).heading))
End If
End If
Next iLoop1
End Sub ' Shooting
' /////////////////////////////////////////////////////////////////////////////
' Draw the enemies
Sub DrawEnemy ()
Dim iLoop1 As Integer ' Used for variables
Dim iLoop2 As Integer ' Used for variables
Dim iColor As _Unsigned Long
Dim iX As Integer
Dim iY As Integer
Dim sngHeading As Single
Dim iRadius As Integer
For iLoop1 = 0 To UBound(m_arrEnemy)
' Is this enemy alive
If m_arrEnemy(iLoop1).alive = TRUE Then
' Color based on damage
If m_arrEnemy(iLoop1).life >= 30 Then
iColor = cWhite
ElseIf m_arrEnemy(iLoop1).life > 25 Then
iColor = cYellow
ElseIf m_arrEnemy(iLoop1).life > 20 Then
iColor = cGold
ElseIf m_arrEnemy(iLoop1).life > 15 Then
iColor = cOrange
ElseIf m_arrEnemy(iLoop1).life > 10 Then
iColor = cDarkOrange
ElseIf m_arrEnemy(iLoop1).life > 5 Then
iColor = cOrangeRed
Else
iColor = cRed
End If
' Draw body
' CIRCLE (x, y), radius, color
'DrawCircleSolid iX, iY, 8, cRed
Circle (m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos), m_arrEnemy(iLoop1).radius, iColor
' Draw "eye"
sngHeading = GetAngle(m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos, m_Ship.xPos, m_Ship.yPos)
iX = m_arrEnemy(iLoop1).xPos
iY = m_arrEnemy(iLoop1).yPos
iRadius = m_arrEnemy(iLoop1).radius / 3
iX = iX + (m_arrEnemy(iLoop1).radius - iRadius) * Sin(sngHeading)
iY = iY - (m_arrEnemy(iLoop1).radius - iRadius) * Cos(sngHeading)
Circle (iX, iY), iRadius, iColor
End If
Next iLoop1
End Sub ' DrawEnemy
' /////////////////////////////////////////////////////////////////////////////
' Move Bullets
Sub MoveBullets ()
Dim iLoop1 As Integer ' Used for variables
If m_Ship.ShootCount <= m_Ship.ShootTime Then
m_Ship.ShootCount = m_Ship.ShootCount + 1
End If
For iLoop1 = 0 To UBound(m_arrBullet)
' Is the bullet alive
If m_arrBullet(iLoop1).alive = TRUE Then
' Move the bullets
m_arrBullet(iLoop1).xPos = m_arrBullet(iLoop1).xPos + (m_arrBullet(iLoop1).speed * Sin(m_arrBullet(iLoop1).heading))
m_arrBullet(iLoop1).yPos = m_arrBullet(iLoop1).yPos - (m_arrBullet(iLoop1).speed * Cos(m_arrBullet(iLoop1).heading))
' Did the bullet move off screen horizontally?
If m_arrBullet(iLoop1).xPos < iMinX Then
If WRAP_BULLET = TRUE Then
m_arrBullet(iLoop1).xPos = iMaxX
Else
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
ElseIf m_arrBullet(iLoop1).xPos > iMaxX Then
If WRAP_BULLET = TRUE Then
m_arrBullet(iLoop1).xPos = iMinX
Else
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
End If
' Did the bullet move off screen vertically?
If m_arrBullet(iLoop1).yPos < iMinY Then
If WRAP_BULLET = TRUE Then
m_arrBullet(iLoop1).yPos = iMaxY
Else
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
ElseIf m_arrBullet(iLoop1).yPos > iMaxY Then
If WRAP_BULLET = TRUE Then
m_arrBullet(iLoop1).yPos = iMinY
Else
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
End If
' Time how long bullet stays active
m_arrBullet(iLoop1).lifetime = m_arrBullet(iLoop1).lifetime + 1
If m_arrBullet(iLoop1).lifetime > m_arrBullet(iLoop1).lifespan Then
m_arrBullet(iLoop1).alive = FALSE ' Destroy the bullet
End If
End If
Next iLoop1
End Sub ' MoveBullets
' /////////////////////////////////////////////////////////////////////////////
' Draw the bullets
Sub DrawBullets ()
Dim iLoop1 As Integer ' Used for variables
For iLoop1 = 0 To UBound(m_arrBullet)
' Is the bullet alive
If m_arrBullet(iLoop1).alive = TRUE Then
If m_arrBullet(iLoop1).kind = "SHIP" Then
' Is this a ship bullet, draw a white bullet
'Circle (m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos), 3, cWhite
DrawCircleSolid m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos, BULLET_RADIUS, cWhite
ElseIf m_arrBullet(iLoop1).kind = "ENEMY" Then
' if this is enemy bullet, draw a red bullet
'Circle (m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos), 3, cOrangeRed
DrawCircleSolid m_arrBullet(iLoop1).xPos, m_arrBullet(iLoop1).yPos, BULLET_RADIUS, cOrangeRed
End If
End If
Next iLoop1
End Sub ' DrawBullets
' /////////////////////////////////////////////////////////////////////////////
' Move the ship
Sub MoveShip ()
Dim sngXComp As Single
Dim sngYComp As Single
' If the left key is pressed then rotate the ship left
If m_bLeftKey = TRUE Then
m_Ship.facing = m_Ship.facing - PI / TURN_SPEED
End If
' If the Right key is pressed then rotate the ship right
If m_bRightKey = TRUE Then
m_Ship.facing = m_Ship.facing + PI / TURN_SPEED
End If
' If the up key is pressed then and accelerate it in the direction the ship is facing
If m_bUpKey = TRUE Then
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' TODO: fix this to make the movement more natural...
' Determine the X and Y components of the resultant vector
sngXComp = m_Ship.speed * Sin(m_Ship.heading) + SHIP_ACCEL * Sin(m_Ship.facing)
sngYComp = m_Ship.speed * Cos(m_Ship.heading) + SHIP_ACCEL * Cos(m_Ship.facing)
' Determine the resultant speed
m_Ship.speed = Sqr(sngXComp ^ 2 + sngYComp ^ 2)
' Calculate the resultant heading, and adjust for arctangent by adding Pi if necessary
If Sgn(sngYComp) > 0 Then
m_Ship.heading = Atn(sngXComp / sngYComp)
End If
If Sgn(sngYComp) < 0 Then
m_Ship.heading = Atn(sngXComp / sngYComp) + PI
End If
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
End If
' If the down key is pressed then and accelerate the ship in the opposite direction it is facing
If m_bDownKey = TRUE And m_Ship.speed > -MAX_SPEED Then
' Determine the X and Y components of the resultant vector
sngXComp = m_Ship.speed * Sin(m_Ship.heading) - SHIP_ACCEL * Sin(m_Ship.facing)
sngYComp = m_Ship.speed * Cos(m_Ship.heading) - SHIP_ACCEL * Cos(m_Ship.facing)
' Determine the resultant speed
m_Ship.speed = Sqr(sngXComp ^ 2 + sngYComp ^ 2)
' Calculate the resultant heading, and adjust for actangent by adding Pi if necessary
If Sgn(sngYComp) > 0 Then
m_Ship.heading = Atn(sngXComp / sngYComp)
End If
If Sgn(sngYComp) < 0 Then
m_Ship.heading = Atn(sngXComp / sngYComp) + PI
End If
End If
' Did player hit cheat key?
If m_bCheatKey = TRUE Then
m_Ship.shields = m_Ship.shields + 10
End If
' Don't let the ship go faster then the max speed
If m_Ship.speed > MAX_SPEED Then
m_Ship.speed = MAX_SPEED
End If
' Move the ship
m_Ship.xPos = m_Ship.xPos + m_Ship.speed * Sin(m_Ship.heading)
m_Ship.yPos = m_Ship.yPos - m_Ship.speed * Cos(m_Ship.heading)
' Keep the ship inside the form
If m_Ship.xPos < iMinX Then
m_Ship.xPos = iMaxX
End If
If m_Ship.xPos > iMaxX Then
m_Ship.xPos = iMinX
End If
If m_Ship.yPos < iMinY Then
m_Ship.yPos = iMaxY
End If
If m_Ship.yPos > iMaxY Then
m_Ship.yPos = iMinY
End If
End Sub ' MoveShip
' /////////////////////////////////////////////////////////////////////////////
' Placeholder
Sub MoveEnemy ()
Dim iLoop1 As Integer
'For iLoop1 = 0 To UBound(m_arrEnemy)
' ' Check whether the enemy is alive
' If m_arrEnemy(iLoop1).alive = TRUE Then
' End If
'Next iLoop1
End Sub ' MoveEnemy
' /////////////////////////////////////////////////////////////////////////////
Sub ShowScore
' Draw background
Color cBlue, cBlue
PrintAt 0, 0, String$(120, " ")
' Place the text on the form
Color cLime, cEmpty
PrintAt 0, 10, "Shields: " + cstr$(m_Ship.shields) ' LeftPadString$(cstr$(m_Ship.shields), 5, " ")
' Title displays the players score
'frmCollision.Caption = "Score: " & m_iScore
Color cCyan, cEmpty
PrintAt 0, 40, "Score: " + cstr$(m_iScore) ' LeftPadString$(cstr$(m_iScore), 10, " ")
' Display the level
Color cWhite, cEmpty
PrintAt 0, 70, "Level: " + cstr$(m_iLevel) ' LeftPadString$(cstr$(m_iScore), 10, " ")
' Show instructions
Color cRed, cRed
PrintAt 39, 0, String$(120, " ")
Color cWhite, cEmpty
PrintAt 39, 0, "CONTROLS: LEFT/RIGHT = TURN UP/DOWN = FORWARD/BACK CTRL=FIRE 1=ADD SHIELD (CHEAT)"
End Sub ' ShowScore
' /////////////////////////////////////////////////////////////////////////////
' Draw the ship
Sub DrawShip ()
Dim intX1 As Integer
Dim intY1 As Integer
Dim intX2 As Integer
Dim intY2 As Integer
Dim intX3 As Integer
Dim intY3 As Integer
Dim intX1b As Integer ' engine flame ends here
Dim intY1b As Integer ' engine flame ends here
Dim intX2b As Integer ' back wall starts here on left
Dim intY2b As Integer ' back wall starts here on left
Dim intX3b As Integer ' back wall starts here on right
Dim intY3b As Integer ' back wall starts here on right
' -----------------------------------------------------------------------------
' Set the coordinates of the ship
' front
intX1 = m_Ship.xPos + SHIP_RADIUS * Sin(m_Ship.facing)
intY1 = m_Ship.yPos - SHIP_RADIUS * Cos(m_Ship.facing)
' left rear
intX2 = m_Ship.xPos + SHIP_RADIUS * Sin(m_Ship.facing + 2 * PI / 3)
intY2 = m_Ship.yPos - SHIP_RADIUS * Cos(m_Ship.facing + 2 * PI / 3)
' left rear (3/4 of the way down)
intX2b = m_Ship.xPos + ENGINE_RADIUS * Sin(m_Ship.facing + 2 * PI / 3)
intY2b = m_Ship.yPos - ENGINE_RADIUS * Cos(m_Ship.facing + 2 * PI / 3)
' right rear
intX3 = m_Ship.xPos + SHIP_RADIUS * Sin(m_Ship.facing + 4 * PI / 3)
intY3 = m_Ship.yPos - SHIP_RADIUS * Cos(m_Ship.facing + 4 * PI / 3)
' right rear (3/4 of the way down)
intX3b = m_Ship.xPos + ENGINE_RADIUS * Sin(m_Ship.facing + 4 * PI / 3)
intY3b = m_Ship.yPos - ENGINE_RADIUS * Cos(m_Ship.facing + 4 * PI / 3)
' rear where engine flames end
intX1b = m_Ship.xPos - FLAME_RADIUS * Sin(m_Ship.facing)
intY1b = m_Ship.yPos + FLAME_RADIUS * Cos(m_Ship.facing)
'm_Ship.facing = m_Ship.facing - Pi / 36
' -----------------------------------------------------------------------------
' Draw the ship
' Draw the left side
Line (intX1, intY1)-(intX2, intY2), cWhite
' Draw the right side
Line (intX1, intY1)-(intX3, intY3), cWhite
' Draw the rear / aft side
If m_bUpKey Then
' Draw rear side
Line (intX2b, intY2b)-(intX3b, intY3b), cSilver
' Engine is firing
'Line (intX2b, intY2b)-(intX3b, intY3b), cOrangeRed
' Draw the flame left side
Line (intX1b, intY1b)-(intX2b, intY2b), cOrangeRed
' Draw the flame right side
Line (intX1b, intY1b)-(intX3b, intY3b), cOrangeRed
Else
' Draw rear side
Line (intX2b, intY2b)-(intX3b, intY3b), cSilver
End If
End Sub ' DrawShip
' /////////////////////////////////////////////////////////////////////////////
' Respawn the enemies if there all dead
Sub Respawn ()
Dim iLoop1 As Integer ' Used for variables
' Check if all enemies are dead
m_bAllDead = TRUE
For iLoop1 = 0 To UBound(m_arrEnemy)
' If an enemy is alive then
If m_arrEnemy(iLoop1).alive = TRUE Then
' enemies aren't all dead
m_bAllDead = FALSE
Exit For
End If
Next iLoop1
' if all dead, respawn and create one more enemy
' advance to next level
If m_bAllDead = TRUE Then
' INCREASE LEVEL
m_iLevel = m_iLevel + 1
' GIVE PLAYER SOME BONUS SHIELDS
m_Ship.shields = m_Ship.shields + BONUS_SHIELDS
' INCREASE THE NUMBER OF ENEMIES
ReDim _Preserve m_arrEnemy(UBound(m_arrEnemy) + 1) As EnemyType
' INCREASE VARIETY OF ENEMY SIZES
If m_iMinEnemyRadius > MIN_ENEMY_RADIUS Then
m_iMinEnemyRadius = m_iMinEnemyRadius - 1
End If
If m_iMaxEnemyRadius < MAX_ENEMY_RADIUS Then
m_iMaxEnemyRadius = m_iMaxEnemyRadius + 1
End If
' SPAWN NEW WAVE OF ENEMIES
For iLoop1 = 0 To UBound(m_arrEnemy)
' Set the starting positions
m_arrEnemy(iLoop1).alive = TRUE
m_arrEnemy(iLoop1).life = 30
m_arrEnemy(iLoop1).xPos = m_Ship.xPos
m_arrEnemy(iLoop1).yPos = m_Ship.yPos
' choose a random size
m_arrEnemy(iLoop1).radius = RandomNumber%(m_iMinEnemyRadius, m_iMaxEnemyRadius)
' make sure the enemies don't start on the ship
Do Until GetDist(m_arrEnemy(iLoop1).xPos, m_arrEnemy(iLoop1).yPos, m_Ship.xPos, m_Ship.yPos) > SHIP_RADIUS * 10
m_arrEnemy(iLoop1).xPos = RandomNumber%(iMinX, iMaxX) 'Int(Rnd * ScaleWidth + 1)
m_arrEnemy(iLoop1).yPos = RandomNumber%(iMinY, iMaxY) 'Int(Rnd * ScaleHeight + 1)
Loop
Next iLoop1
End If
End Sub ' Respawn
' /////////////////////////////////////////////////////////////////////////////
Function GetDist! (sngX1 As Single, sngY1 As Single, sngX2 As Single, sngY2 As Single) ' As Single
Dim sngXComp As Single
Dim sngYComp As Single
' Set the X componate
sngXComp = sngX2 - sngX1
' Set the Y Componate
sngYComp = sngY1 - sngY2
' Get the distance between the two objects
GetDist = Sqr(sngXComp ^ 2 + sngYComp ^ 2)
End Function ' GetDist
' /////////////////////////////////////////////////////////////////////////////
Function GetAngle (sngX1 As Single, sngY1 As Single, sngX2 As Single, sngY2 As Single)
Dim sngXComp As Single
Dim sngYComp As Single
' Set the X componate
sngXComp = sngX2 - sngX1
' Set the Y componate
sngYComp = sngY1 - sngY2
' Calculate the resultant angle, and adjust for actangent by adding Pi if necessary
If Sgn(sngYComp) > 0 Then
GetAngle = Atn(sngXComp / sngYComp)
End If
If Sgn(sngYComp) < 0 Then
GetAngle = Atn(sngXComp / sngYComp) + PI
End If
End Function ' GetAngle
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GAME CODE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TRIG FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' use angles in degrees units instead of radians (converted inside sub)
' Note this function uses whatever the default type is, better not be some Integer Type.
Function CosD (degrees)
CosD = Cos(_D2R(degrees))
End Function ' CosD
' /////////////////////////////////////////////////////////////////////////////
' use angles in degrees units instead of radians (converted inside sub)
' Note this function uses whatever the default type is, better not be some Integer Type.
Function SinD (degrees)
SinD = Sin(_D2R(degrees))
End Function ' SinD
' /////////////////////////////////////////////////////////////////////////////
' use angles in degrees units instead of radians (converted inside sub)
' Note this function uses whatever the default type is, better not be some Integer Type.
Function DAtan2 (x1, y1, x2, y2) ' The angle in degrees a 2nd point (x2, y2) makes to a first point (x1, y1)
' Delta means change between 1 measure and another for example x2 - x1
deltaX = x2 - x1
deltaY = y2 - y1
' To find the angle point(x2, y2) makes to (x1, y1) in Degrees
' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
rtn = _R2D(_Atan2(deltaY, deltaX))
If rtn < 0 Then
DAtan2 = rtn + 360
Else
DAtan2 = rtn
End If
End Function ' DAtan2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TRIG FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Integer to string
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function DblToInt% (dblOld As Double)
Dim dblNew As Double
Dim sValue As String
Dim iPos As Integer
dblNew = RoundDouble#(dblOld, 0)
'sValue = _Trim$(Str$(dblNew))
sValue = DblToStr$(dblNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' DblToInt% = Val(Left$(sValue, iPos - 1))
'Else
' DblToInt% = Val(sValue)
'End If
DblToInt% = Val(sValue)
End Function ' DblToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function DblToStr$ (n#)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n#)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
DblToStr$ = result$
End Function ' DblToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)
Dim dblNew As Double
dblNew = RoundDouble#(dblValue, intNumPlaces)
DblRoundedToStr$ = DblToStr$(dblNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DoubleABS# (dblValue As Double)
If Sgn(dblValue) = -1 Then
DoubleABS# = 0 - dblValue
Else
DoubleABS# = dblValue
End If
End Function ' DoubleABS#
' /////////////////////////////////////////////////////////////////////////////
' bplus: The Gold Standard is even better than THE QB64 CIRCLE sub in this respect!
' https://forum.qb64.org/index.php?topic=1044.135
' from Steve Gold standard
' Renamed fcirc to DrawCircleSolid
' Not as fast as DrawCircleTopLeft but pretty fast.
' Example:
' Screen _NewImage(800, 600, 32)
' _ScreenMove 250, 60
' For r = 250 To 0 Step -60
' DrawCircleSolid 400, 300, r, _RGBA(255, 255, 255, 100)
' Next r
Sub DrawCircleSolid (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub ' DrawCircleSolid
' /////////////////////////////////////////////////////////////////////////////
Function FloatRoundedToStr$ (fValue As _Float, intNumPlaces As Integer)
Dim fNew As _Float
fNew = Round##(fValue, intNumPlaces)
FloatRoundedToStr$ = FloatToStr$(fNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function FloatToStr$ (n##)
value$ = UCase$(LTrim$(Str$(n##)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n = 1 To L%
If Mid$(valu$, n, 1) <> "." Then
num$ = num$ + Mid$(valu$, n, 1)
End If
Next n
Else
FloatToStr$ = value$
Exit Function
End If
FloatToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' FloatToStr$
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
Function IsNum% (text$)
Dim a$
Dim b$
a$ = _Trim$(text$)
b$ = _Trim$(Str$(Val(text$)))
If a$ = b$ Then
IsNum% = TRUE
Else
IsNum% = FALSE
End If
End Function ' IsNum%
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
Dim result$
Dim i As Long
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
Function LeftPadString$ (myString$, toWidth%, padChar$)
LeftPadString$ = Right$(String$(toWidth%, padChar$) + myString$, toWidth%)
End Function ' LeftPadString$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
Function LongABS& (lngValue As Long)
If Sgn(lngValue) = -1 Then
LongABS& = 0 - lngValue
Else
LongABS& = lngValue
End If
End Function ' LongABS&
' /////////////////////////////////////////////////////////////////////////////
' iRow% and iCol% are 0-based in this version
Sub PrintAt (iRow%, iCol%, sText$)
'_PrintString (iCol% * 8, iRow% * 16), sText$
_PrintString (iCol% * 8, iRow% * 16), sText$
'_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function RightPadString$ (myString$, toWidth%, padChar$)
RightPadString$ = Left$(myString$ + String$(toWidth%, padChar$), toWidth%)
End Function ' RightPadString$
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too complicated.
' There ya go! Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT: Modified to add another option to round scientific,
' since you had it's description included in your example.
' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT
Function Round## (num##, digits%)
Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUp## (num##, digits%)
RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDown## (num##, digits%)
RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientific## (num##, digits%)
RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE
Function RoundDouble# (num#, digits%)
RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUpDouble# (num#, digits%)
RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownDouble# (num#, digits%)
RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificDouble# (num#, digits%)
RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE SINGLE
Function RoundSingle! (num!, digits%)
RoundSingle! = Int(num! * 10 ^ digits% + .5) / 10 ^ digits%
End Function
' NOTE: not sure this one works: when digits%=3, it rounds .31 to .32
Function RoundUpSingle! (num!, digits%)
RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownSingle! (num!, digits%)
RoundDownSingle! = Int(num! * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificSingle! (num!, digits%)
RoundScientificSingle! = _Round(num! * 10 ^ digits%) / 10 ^ digits%
End Function
' /////////////////////////////////////////////////////////////////////////////
Function SmallestOf3% (i1%, i2%, i3%)
Dim iMin%
iMin% = i1%
If i2% < iMin% Then iMin% = i2%
If i3% < iMin% Then iMin% = i3%
SmallestOf3% = iMin%
End Function ' SmallestOf3
' /////////////////////////////////////////////////////////////////////////////
Function SngRoundedToStr$ (sngValue As Single, intNumPlaces As Integer)
Dim sngNew As Single
sngNew = RoundSingle!(sngValue, intNumPlaces)
SngRoundedToStr$ = SngToStr$(sngNew)
End Function ' SngRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function SngToInt% (sngOld As Single)
Dim sngNew As Single
Dim sValue As String
Dim iPos As Integer
sngNew = RoundSingle!(sngOld, 0)
'sValue = _Trim$(Str$(sngNew))
sValue = SngToStr$(sngNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' SngToInt% = Val(Left$(sValue, iPos - 1))
'Else
' SngToInt% = Val(sValue)
'End If
SngToInt% = Val(sValue)
End Function ' SngToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function SngToStr$ (n!)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n!)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
SngToStr$ = result$
End Function ' SngToStr$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
'cWhite = _RGB32(254, 254, 254)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
'cEmpty~& = -1
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
'' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'' BEGIN DEBUGGING ROUTINES #DEBUGGING
'' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'Sub DebugPrint (MyString As String)
' If m_bDebug = TRUE Then
' '_Echo MyString
'
' ReDim arrLines(-1) As String
' Dim iLoop As Integer
' split MyString, Chr$(13), arrLines()
' For iLoop = LBound(arrLines) To UBound(arrLines)
' _Echo arrLines(iLoop)
' Next iLoop
' End If
'End Sub ' DebugPrint
'
'' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'' END DEBUGGING ROUTINES @DEBUGGING
'' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #REFERENCE
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
'#END