Space Invader Style Game Written In VBA

Question

EDIT: Link to the github,

https://github.com/Evanml2030/Excel-SpaceInvader

THE README (APPLIES HERE TOO):

VBA version of a classic game

Yes, I know that "Missile" is repeatedly written as "Missle".

It will not run unless you change the pathways to images that will be uploaded into form controls. You can find these inside Ship.cls, MissleFactory, AlienFactory, CometFactory, StarFactory

Obviously needs some basic refactoring, finished over weekend and haven't had time to fix up. Will do if not during week, then definitely this weekend. I am thinking of implementing an ShipWeapons interface, to allow of different sort of weapons. Maybe "heat seeking" style missile or something. Also shields? More types of spaceObjects. And I was thinking of making some spaceObjects indestructible. Maybe make some spaceObjects, i.e. the sun, increase in size momentarily after being struck.

Etc Etc.

MAIN:

There are a ton of modules and classes here but I will try my best to keep this organized.

The following classes have, Attribute VB_PredeclaredId = True: MissleCntrlsCol, MissleCount, MissleObjectsDataCol, Ship, SpaceObjectsCntrlsCol, SpaceObjectCount, SpaceObjectsDataCol

Also please note that you must change the pathway to image in each of the factories as well as inside the ship class initializer.

enter image description here

Userform Code:

Really want to try and follow the MVP model here, keeping userform dumb.

Option Explicit
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim passVal As Long
 Select Case KeyCode
 Case "37", "39", "32"
 passVal = CInt(KeyCode)
 GameLogic.HandleSendKeys Me, passVal
 End Select
End Sub

Modules:

GameLogic

Option Explicit
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub RunGame()
Dim newBoard As GameBoard
Dim shipObj As ship
Dim ShipCntrl As Control
Dim startTime As Long
Dim endTime As Long
Dim x As Long
 Set newBoard = New GameBoard
 newBoard.Show vbModeless
 ScaleItems.MaxSize = 60
 Set ShipCntrl = SHLoadShipOntoGameBoard.LoadShipOntoBoard(newBoard)
 startTime = timeGetTime
 Do While x < 100
 endTime = timeGetTime
 If (endTime - startTime) > 2000 Then
 startTime = endTime
 SOLoadSpaceObjectOntoGameBoard.LoadSpaceObjectOntoBoard newBoard
 End If
 CollisionsMissleSpaceObject.HandleMissleSpaceObjectCollisions newBoard
 If CollisionsShipSpaceObject.HandleShipSpaceObjectCollisions(newBoard) Then Exit Do
 SOMoveSpaceObjects.MoveSpaceObjects newBoard
 MMoveMissles.MoveMissleObjects newBoard
 DoEvents
 Sleep 25
 Loop
End Sub
Public Sub HandleSendKeys(ByRef board As GameBoard, ByRef caseNum As Long)
 Select Case caseNum
 Case "37"
 SHMoveShip.moveShipLeft board
 Case "39"
 SHMoveShip.moveShipRight board
 Case "32"
 MLoadMissleObjectOntoBoard.LoadMissleObjectOntoBoard board
 MissleCount.IncrementMissleCount
 ChangeBoardLabelMissleCount board
 End Select
End Sub
Private Sub ChangeBoardLabelMissleCount(ByRef board As GameBoard)
 board.MissleCount.Caption = CStr(25 - MissleCount.Count)
End Sub

CollisionsMissleSpaceObject:

Option Explicit
Sub HandleMissleSpaceObjectCollisions(ByRef board As GameBoard)
Dim spaceObject As ISpaceObject
Dim spaceObjectCntrl As Control
Dim missle As missle
Dim missleCntrl As Control
Dim indexMissle As Long
Dim indexSpaceObject As Long
 For indexMissle = MissleObjectsDataCol.Count To 1 Step -1
 Set missle = MissleObjectsDataCol.Item(indexMissle)
 Set missleCntrl = MissleCntrlsCol.Item(indexMissle)
 For indexSpaceObject = SpaceObjectDataCol.Count To 1 Step -1
 Set spaceObject = SpaceObjectDataCol.Item(indexSpaceObject)
 Set spaceObjectCntrl = SpaceObjectCntrlsCol.Item(indexSpaceObject)
 If CheckIfCollided(missle, spaceObject) Then
 MDestroyMissleObject.DestroyMissleObject board, missle, indexMissle
 SODestroySpaceObject.DestroySpaceObject board, spaceObject, indexSpaceObject
 End If
 Next indexSpaceObject
 Next indexMissle
End Sub
Private Function CheckIfCollided(ByRef missle As missle, ByRef spaceObject As ISpaceObject) As Boolean
Dim hOverlap As Boolean
Dim vOverlap As Boolean
 hOverlap = (missle.left - spaceObject.width < spaceObject.left) And (spaceObject.left < missle.left + missle.width)
 vOverlap = (missle.top - spaceObject.height < spaceObject.top) And (spaceObject.top < missle.top + missle.height)
 CheckIfCollided = hOverlap And vOverlap
End Function

CollisionsShipSpaceObject:

Option Explicit
Function HandleShipSpaceObjectCollisions(ByRef board As GameBoard) As Boolean
Dim spaceObject As ISpaceObject
Dim spaceObjectCntrl As Control
Dim indexSpaceObject As Long
 For indexSpaceObject = SpaceObjectDataCol.Count To 1 Step -1
 Set spaceObject = SpaceObjectDataCol.Item(indexSpaceObject)
 Set spaceObjectCntrl = SpaceObjectCntrlsCol.Item(indexSpaceObject)
 If CheckIfCollided(spaceObject) Then
 HandleShipSpaceObjectCollisions = True
 End If
 Next indexSpaceObject
End Function
Private Function CheckIfCollided(ByRef spaceObject As ISpaceObject) As Boolean
Dim hOverlap As Boolean
Dim vOverlap As Boolean
 hOverlap = (ship.left - spaceObject.width < spaceObject.left) And (spaceObject.left < ship.left + ship.width)
 vOverlap = (ship.top - spaceObject.height < spaceObject.top) And (spaceObject.top < ship.top + ship.height)
 CheckIfCollided = hOverlap And vOverlap
End Function

DestroyMissleObject:

Option Explicit
Sub DestroyMissleObject(ByRef board As GameBoard, ByRef missleObject As missle, ByRef index As Long)
 board.Controls.Remove missleObject.ImageName
 MissleObjectsDataCol.Remove index
 MissleCntrlsCol.Remove index
End Sub

LoadMissleObjectOntoBoard:

Option Explicit
Sub LoadMissleObjectOntoBoard(ByRef board As GameBoard)
Dim missleObject As missle
Dim cntrl As Control
 Set missleObject = MMissleFactory.NewMissle
 Set cntrl = AddMissleObjectImgControlToBoard(board, missleObject)
 InitalizeMissleObjectImgControl cntrl, missleObject
 AddMissleObjectToDataCol missleObject
 AddMissleObjectCntrlToCntrlsCol cntrl
End Sub
Private Function AddMissleObjectImgControlToBoard(ByRef board As GameBoard, ByRef missleObject As Object) As Control
 Set AddMissleObjectImgControlToBoard = board.Controls.Add("Forms.Image.1", missleObject.ImageName)
End Function
Private Sub InitalizeMissleObjectImgControl(ByRef cntrl As Control, ByRef missleObject As missle)
 With cntrl
 .left = missleObject.left
 .top = missleObject.top
 .height = missleObject.height
 .width = missleObject.width
 .Picture = LoadPicture(missleObject.ImgPathWay)
 .PictureSizeMode = 1
 End With
End Sub
Private Sub AddMissleObjectToDataCol(ByRef missleObject As missle)
 MissleObjectsDataCol.Add missleObject
End Sub
Private Sub AddMissleObjectCntrlToCntrlsCol(ByRef cntrl As Control)
 MissleCntrlsCol.Add cntrl
End Sub

MMissleFactory:

Option Explicit
Public Function NewMissle() As missle
Dim width As Long
Dim height As Long
 width = ScaleItems.MaxSize / 2
 height = ScaleItems.MaxSize / 2.15
 IncrementMissleCount
 With New missle
 .ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\laserBeam.jpg"
 .SetInitialLeft ((ship.width - width) / 2) + ship.left
 .SetInitialTop ship.top - height
 .height = height
 .width = width
 .ImageName = "Missle" & CStr(MissleCount.Count)
 Set NewMissle = .Self
 End With
End Function
Private Sub IncrementMissleCount()
 MissleCount.IncrementMissleCount
End Sub

MMoveMissles:

Option Explicit
Sub MoveMissleObjects(ByRef board As GameBoard)
Dim missleObject As missle
Dim missleObjectCntrl As Control
Dim index As Long
 For index = MissleObjectsDataCol.Count To 1 Step -1
 Set missleObject = MissleObjectsDataCol.Item(index)
 Set missleObjectCntrl = MissleCntrlsCol.Item(index)
 If MissleObjectOutOfBounds(board, missleObject) Then
 MDestroyMissleObject.DestroyMissleObject board, missleObject, index
 Set missleObject = Nothing
 Set missleObjectCntrl = Nothing
 Else
 MoveMissleObject missleObject, missleObjectCntrl
 End If
 Next index
End Sub
Private Function MissleObjectOutOfBounds(ByRef board As GameBoard, ByRef missleObject As missle) As Boolean
 If missleObject.top = 0 Then
 MissleObjectOutOfBounds = True
 Else
 MissleObjectOutOfBounds = False
 End If
End Function
Private Sub MoveMissleObject(ByRef missleObject As missle, ByRef missleObjectCntrl As Control)
 missleObject.top = missleObject.top - 1
 missleObjectCntrl.top = missleObject.top
End Sub

SHLoadShipOntoGameBoard:

Public Function moveShipLeft(ByRef board As GameBoard)
Dim ShipCntrl As Control
Set ShipCntrl = board.Controls(ship.ImageName)
 If ship.left > 0 Then
 ship.left = ship.left - 5
 ShipCntrl.left = ship.left
 End If
End Function
Function moveShipRight(ByRef board As GameBoard)
Dim ShipCntrl As Control
Set ShipCntrl = board.Controls(ship.ImageName)
 If ship.left + ship.width < board.width Then
 ship.left = ship.left + 5
 ShipCntrl.left = ship.left
 Else
 End If
End Function

SOAlienFactory:

Option Explicit
Public Function NewAlien(ByRef board As GameBoard) As SpaceObjectAlien
Dim width As Long
Dim height As Long
 width = ScaleItems.MaxSize / 1.5
 height = ScaleItems.MaxSize / 1.5
 IncrementSpaceObjectCount
 With New SpaceObjectAlien
 .ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\alienShip.jpg"
 .SetInitialLeft Application.WorksheetFunction.RandBetween(0, board.width - width)
 .SetInitialTop 0
 .height = height
 .width = width
 .ImageName = "SpaceObject" & CStr(SpaceObjectCount.Count)
 Set NewAlien = .Self
 End With
End Function
Private Sub IncrementSpaceObjectCount()
 SpaceObjectCount.IncrementCount
End Sub

SOCometFactory:

Option Explicit
Public Function NewComet(ByRef board As GameBoard) As SpaceObjectComet
Dim width As Long
Dim height As Long
 width = ScaleItems.MaxSize / 1.75
 height = ScaleItems.MaxSize / 1.75
 IncrementSpaceObjectCount
 With New SpaceObjectComet
 .ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\regComet.jpg"
 .SetInitialLeft Application.WorksheetFunction.RandBetween(0, board.width - width)
 .SetInitialTop 0
 .width = width
 .height = height
 .ImageName = "SpaceObject" & CStr(SpaceObjectCount.Count)
 Set NewComet = .Self
 End With
End Function
Private Sub IncrementSpaceObjectCount()
 SpaceObjectCount.IncrementCount
End Sub

SOStarFactory:

Option Explicit
Public Function NewStar(ByRef board As GameBoard) As SpaceObjectStar
Dim width As Long
Dim height As Long
 width = ScaleItems.MaxSize
 height = ScaleItems.MaxSize
 IncrementSpaceObjectCount
 With New SpaceObjectStar
 .ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\yellowStar.jpg"
 .SetInitialLeft Application.WorksheetFunction.RandBetween(0, board.width - width)
 .SetInitialTop 0
 .width = width
 .height = height
 .ImageName = "SpaceObject" & CStr(SpaceObjectCount.Count)
 Set NewStar = .Self
 End With
End Function
Private Sub IncrementSpaceObjectCount()
 SpaceObjectCount.IncrementCount
End Sub

SODestroySpaceObject:

Option Explicit
Sub DestroySpaceObject(ByRef board As GameBoard, ByRef spaceObject As ISpaceObject, ByRef index As Long)
 board.Controls.Remove spaceObject.ImageName
 SpaceObjectDataCol.Remove index
 SpaceObjectCntrlsCol.Remove index
End Sub

LoadSpaceObjectOntoBoard:

Option Explicit
Sub DestroySpaceObject(ByRef board As GameBoard, ByRef spaceObject As ISpaceObject, ByRef index As Long)
 board.Controls.Remove spaceObject.ImageName
 SpaceObjectDataCol.Remove index
 SpaceObjectCntrlsCol.Remove index
End Sub

SOMOveSpaceObjects:

Option Explicit
Sub MoveSpaceObjects(ByRef board As GameBoard)
Dim spaceObject As ISpaceObject
Dim spaceObjectCntrl As Control
Dim index As Long
For index = SpaceObjectDataCol.Count To 1 Step -1
 Set spaceObject = SpaceObjectDataCol.Item(index)
 Set spaceObjectCntrl = SpaceObjectCntrlsCol.Item(index)
 If SpaceObjectOutOfBounds(board, spaceObject) Then
 SODestroySpaceObject.DestroySpaceObject board, spaceObject, index
 Set spaceObject = Nothing
 Set spaceObjectCntrl = Nothing
 Else
 MoveSpaceObject spaceObject, spaceObjectCntrl
 End If
Next index
End Sub
Private Function SpaceObjectOutOfBounds(ByRef board As GameBoard, ByRef spaceObject As ISpaceObject) As Boolean
 If spaceObject.top + spaceObject.height > board.height Then
 SpaceObjectOutOfBounds = True
 Else
 SpaceObjectOutOfBounds = False
 End If
End Function
Private Sub MoveSpaceObject(ByRef spaceObject As ISpaceObject, ByRef spaceObjectCntrl As Control)
 spaceObject.top = spaceObject.top + 1
 spaceObjectCntrl.top = spaceObject.top
End Sub

CLASS MODULES:

ISpaceObject:

Option Explicit
Public Property Let left(ByRef changeLeft As Long)
End Property
Public Property Get left() As Long
End Property
Public Property Let top(ByRef changeTop As Long)
End Property
Public Property Get top() As Long
End Property
Public Property Get ImageName() As String
End Property
Public Property Get width() As Long
End Property
Public Property Get height() As Long
End Property
Public Property Get ImagePathway() As String
End Property

Missle:

Option Explicit
Private Type MissleData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
End Type
Private this As MissleData
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As missle
 Set Self = Me
End Property
Public Property Let ImageName(ByRef Name As String)
 this.ImageName = Name
End Property
 Public Property Get ImageName() As String
 ImageName = this.ImageName
 End Property
Public Property Let left(ByRef changeLeft As Long)
 this.left = changeLeft
End Property
Public Property Get left() As Long
 left = this.left
End Property
Public Property Let top(ByRef changeTop As Long)
 this.top = changeTop
End Property
Public Property Get top() As Long
 top = this.top
End Property

MissleCntrlsCol:

Option Explicit
Private MissleObjectsCntrls As Collection
Private Sub Class_Initialize()
 Set MissleObjectsCntrls = New Collection
End Sub
Private Sub Class_Terminate()
 Set MissleObjectsCntrls = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
 Set NewEnum = MissleObjectsCntrls.[_NewEnum]
End Property
Public Sub Add(obj As Control)
 MissleObjectsCntrls.Add obj
End Sub
Public Sub Remove(index As Variant)
 MissleObjectsCntrls.Remove index
End Sub
Public Property Get Item(index As Variant) As Control
 Set Item = MissleObjectsCntrls.Item(index)
End Property
Property Get Count() As Long
 Count = MissleObjectsCntrls.Count
End Property
Public Sub Clear()
 Set MissleObjectsCntrls = New Collection
End Sub

MissleCount:

Option Explicit
Private pcount As Long
Public Property Get Count() As Long
 Count = pcount
End Property
Public Property Let Count(ByRef value As Long)
 pcount = value
End Property
Public Sub IncrementMissleCount()
 pcount = pcount + 1
End Sub

MissleObjectsDataCol:

Option Explicit
Private MissleObjectsData As Collection
Private Sub Class_Initialize()
 Set MissleObjectsData = New Collection
End Sub
Private Sub Class_Terminate()
 Set MissleObjectsData = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
 Set NewEnum = MissleObjectsData.[_NewEnum]
End Property
Public Sub Add(obj As missle)
 MissleObjectsData.Add obj
End Sub
Public Sub Remove(index As Variant)
 MissleObjectsData.Remove index
End Sub
Public Property Get Item(index As Variant) As missle
 Set Item = MissleObjectsData.Item(index)
End Property
Property Get Count() As Long
 Count = MissleObjectsData.Count
End Property
Public Sub Clear()
 Set MissleObjectsData = New Collection
End Sub

ScaleItems:

Option Explicit
Private plargestSize As Long
Public Property Get MaxSize() As Long
 MaxSize = plargestSize
End Property
Public Property Let MaxSize(ByRef value As Long)
 plargestSize = value
End Property

Ship:

Option Explicit
Private Type ShipData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
 Name As String
End Type
Private this As ShipData
Private Sub Class_Initialize()
 this.ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\spaceShip.jpg"
 SetInitialLeft GameBoard.width / 2
 SetInitialTop GameBoard.height - (GameBoard.height / 8.5)
 this.width = ScaleItems.MaxSize
 this.height = ScaleItems.MaxSize
 this.ImageName = "Ship"
End Sub
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As SpaceObjectComet
 Set Self = Me
End Property
Public Property Let left(ByRef left As Long)
 this.left = left
End Property
Public Property Get left() As Long
 left = this.left
End Property
Public Property Let top(ByRef top As Long)
 this.height = height
End Property
Public Property Get top() As Long
 top = this.top
End Property
Public Property Let ImageName(ByRef ImageName As String)
 this.ImageName = height
End Property
Public Property Get ImageName() As String
 ImageName = this.ImageName
End Property

Ship:

Option Explicit
Private Type ShipData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
 Name As String
End Type
Private this As ShipData
Private Sub Class_Initialize()
 this.ImgPathWay = "Z:\Desktop Storage\EXCEL & C# PRACTICE\SpaceInvaders\spaceShip.jpg"
 SetInitialLeft GameBoard.width / 2
 SetInitialTop GameBoard.height - (GameBoard.height / 8.5)
 this.width = ScaleItems.MaxSize
 this.height = ScaleItems.MaxSize
 this.ImageName = "Ship"
End Sub
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As SpaceObjectComet
 Set Self = Me
End Property
Public Property Let left(ByRef left As Long)
 this.left = left
End Property
Public Property Get left() As Long
 left = this.left
End Property
Public Property Let top(ByRef top As Long)
 this.height = height
End Property
Public Property Get top() As Long
 top = this.top
End Property
Public Property Let ImageName(ByRef ImageName As String)
 this.ImageName = height
End Property
Public Property Get ImageName() As String
 ImageName = this.ImageName
End Property

SpaceObjectAlien:

Option Explicit
Implements ISpaceObject
Private Type AlienData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
End Type
Private this As AlienData
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Property Let ImageName(ByRef Name As String)
 this.ImageName = Name
End Property
Public Property Get ImageName() As String
 ImageName = this.ImageName
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As SpaceObjectAlien
 Set Self = Me
End Property
Private Property Get IspaceObject_ImagePathway() As String
 IspaceObject_ImagePathway = this.ImgPathWay
End Property
Private Property Get ISpaceObject_ImageName() As String
 this.ImageName = ISpaceObject_ImageName
End Property
Private Property Let ISpaceObject_Left(ByRef changeLeft As Long)
 this.left = changeLeft
End Property
Private Property Get ISpaceObject_Left() As Long
 ISpaceObject_Left = this.left
End Property
Private Property Let ISpaceObject_Top(ByRef changeTop As Long)
 this.top = changeTop
End Property
Private Property Get ISpaceObject_Top() As Long
 ISpaceObject_Top = this.top
End Property
Private Property Get ISpaceObject_Height() As Long
 ISpaceObject_Height = this.height
End Property
Private Property Get ISpaceObject_Width() As Long
 ISpaceObject_Width = this.width
End Property

SpaceObjectCntrlsCol:

Option Explicit
Private SpaceObjectsCntrls As Collection
Private Sub Class_Initialize()
 Set SpaceObjectsCntrls = New Collection
End Sub
Private Sub Class_Terminate()
 Set SpaceObjectsCntrls = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
 Set NewEnum = SpaceObjectsCntrls.[_NewEnum]
End Property
Public Sub Add(obj As Control)
 SpaceObjectsCntrls.Add obj
End Sub
Public Sub Remove(index As Variant)
 SpaceObjectsCntrls.Remove index
End Sub
Public Property Get Item(index As Variant) As Control
 Set Item = SpaceObjectsCntrls.Item(index)
End Property
Property Get Count() As Long
 Count = SpaceObjectsCntrls.Count
End Property
Public Sub Clear()
 Set SpaceObjectsCntrls = New Collection
End Sub

SpaceObjectComet:

Option Explicit
Implements ISpaceObject
Private Type CometData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
End Type
Private this As CometData
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Property Let ImageName(ByRef Name As String)
 this.ImageName = Name
End Property
Public Property Get ImageName() As String
 ImageName = this.ImageName
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As SpaceObjectComet
 Set Self = Me
End Property
Private Property Get IspaceObject_ImagePathway() As String
 IspaceObject_ImagePathway = this.ImgPathWay
End Property
Private Property Get ISpaceObject_ImageName() As String
 ISpaceObject_ImageName = this.ImageName
End Property
Private Property Let ISpaceObject_Left(ByRef changeLeft As Long)
 this.left = changeLeft
End Property
Private Property Get ISpaceObject_Left() As Long
 ISpaceObject_Left = this.left
End Property
Private Property Let ISpaceObject_Top(ByRef changeTop As Long)
 this.top = changeTop
End Property
Private Property Get ISpaceObject_Top() As Long
 ISpaceObject_Top = this.top
End Property
Private Property Get ISpaceObject_Height() As Long
 ISpaceObject_Height = this.height
End Property
Private Property Get ISpaceObject_Width() As Long
 ISpaceObject_Width = this.width
End Property

SpaceObjectCount:

Option Explicit
Private pcount As Long
Public Property Get Count() As Long
 Count = pcount
End Property
Public Property Let Count(ByRef value As Long)
 pcount = value
End Property
Public Sub IncrementCount()
 pcount = pcount + 1
End Sub

SpaceObjectDataCol:

Option Explicit
Private SpaceObjectsData As Collection
Private Sub Class_Initialize()
 Set SpaceObjectsData = New Collection
End Sub
Private Sub Class_Terminate()
 Set SpaceObjectsData = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
 Set NewEnum = SpaceObjectsData.[_NewEnum]
End Property
Public Sub Add(obj As ISpaceObject)
 SpaceObjectsData.Add obj
End Sub
Public Sub Remove(index As Variant)
 SpaceObjectsData.Remove index
End Sub
Public Property Get Item(index As Variant) As ISpaceObject
 Set Item = SpaceObjectsData.Item(index)
End Property
Property Get Count() As Long
 Count = SpaceObjectsData.Count
End Property
Public Sub Clear()
 Set SpaceObjectsData = New Collection
End Sub

SpaceObjectStar:

Option Explicit
Implements ISpaceObject
Private Type StarData
 left As Long
 top As Long
 ImgPathWay As String
 ImageName As String
 width As Long
 height As Long
End Type
Private this As StarData
Public Property Let ImgPathWay(ByRef pathWayToImg As String)
 this.ImgPathWay = pathWayToImg
End Property
Public Property Get ImgPathWay() As String
 ImgPathWay = this.ImgPathWay
End Property
Public Property Let ImageName(ByRef Name As String)
 this.ImageName = Name
End Property
Public Property Get ImageName() As String
 ImageName = this.ImageName
End Property
Public Sub SetInitialLeft(ByRef initialLeft As Long)
 this.left = initialLeft
End Sub
Public Sub SetInitialTop(ByRef initialTop As Long)
 this.top = initialTop
End Sub
Public Property Let width(ByRef width As Long)
 this.width = width
End Property
Public Property Get width() As Long
 width = this.width
End Property
Public Property Let height(ByRef height As Long)
 this.height = height
End Property
Public Property Get height() As Long
 height = this.height
End Property
Public Property Get Self() As SpaceObjectStar
 Set Self = Me
End Property
Private Property Get IspaceObject_ImagePathway() As String
 IspaceObject_ImagePathway = this.ImgPathWay
End Property
Private Property Let ISpaceObject_ImageName(ByRef imageNameValue As String)
 this.ImageName = imageNameValue
End Property
Private Property Get ISpaceObject_ImageName() As String
 ISpaceObject_ImageName = this.ImageName
End Property
Private Property Let ISpaceObject_Left(ByRef changeLeft As Long)
 this.left = changeLeft
End Property
Private Property Get ISpaceObject_Left() As Long
 ISpaceObject_Left = this.left
End Property
Private Property Let ISpaceObject_Top(ByRef changeTop As Long)
 this.top = changeTop
End Property
Private Property Get ISpaceObject_Top() As Long
 ISpaceObject_Top = this.top
End Property
Private Property Get ISpaceObject_Height() As Long
 ISpaceObject_Height = this.height
End Property
Private Property Get ISpaceObject_Width() As Long
 ISpaceObject_Width = this.width
End Property

enter image description here

enter image description here

enter image description here

• Comintern: Do you have the full source code on GitHub or some other location that would make it easier to view the code in its native habitat?
• learnAsWeGo: @Comintern Will put it up tonight
• Mathieu Guindon: Congratulations, you've got the attention of the Rubberduck dev team! Did you know Rubberduck would let you organize all these code files into a custom folder hierarchy? See this Battleship project for ideas.
• learnAsWeGo: @Comintern put it up, everything should be there!
• learnAsWeGo: @MathieuGuindon TY. Have finally downloaded RubberDuck. Am going to explore more tomorrow and this weekend (as well as your posts on the battleship project / the workbook itself) Very cool projects. Your posts have been a big help, for that thank you!

Answer 1

Architecture

I'll let other reviewers do more of the heavy lifting here, but there were a couple things that immediately stood out.

---

I'm not sure I understand the purpose of wrapping the Collection's in their own classes. You aren't adding any functionality at all other than making them pre-declared. This seems to me like a lot of superfluous code with 2 main goals:

• Make them act as globals. I'm not sure I like this any more than using the predeclared instances of a UserForm. It's like you want to use them like a global, but don't want to declare them as a global. If you're going to use globals, at least make it obvious that's what you're doing - the pre-declared attribute in VBA isn't visible, so at very least it would be deserving of a comment.
• Give you a singleton. Which would be nice if it were true, but there's absolutely nothing that would prevent a caller from newing up an instance and skipping the entire implicit instance. If you need a singleton, you need some mechanism to make sure that if I new up the object, I'll get the single instance. I consider this somewhat dangerous in design.

Basically all you end up with here is a bunch of code that simply forwards methods to an embedded Collection and an identifier. That's a ton of work for what is secretly just this:

Option Explicit
Public SpaceObjectsCntrls As Collection
Public SpaceObjectsData As Collection
Public MissleObjectsData As Collection
'etc.

What it looks like is that what you really want is a GameState object. So much of the state is carried by the process itself that I think you'd be better off just newing up a state in your Sub RunGame() and giving everything an explicit place to live.

---

Your GameBoard is tightly coupled with your presentation logic. Using an MVP framework would be much more useful here if the presenters were interchangeable. For example, let's say that I wanted to render your model directly onto an Excel Worksheet. It strikes me that this should be easy to do, but you have your controller so tightly bound up with the GameBoard that it would be difficult to pull off. If you had an interface (say IGamePresenter) that your UserForm implemented and worked with that in the controller, I could fairly easily wire it up (with an IDrawable to ISpaceObject adapter and a simple wrapper). The controller should be flexible enough that you can hand it an arbitrary model and and arbitrary presenter and it will work as long as the appropriate interfaces are implemented. In general, your modules are begging to belong to an ISpaceController interface, implemented by a controller class.

---

Control's want to be associated with ISpaceObject's. You do things like this all over the place:

 For indexSpaceObject = SpaceObjectDataCol.Count To 1 Step -1
 Set spaceObject = SpaceObjectDataCol.Item(indexSpaceObject)
 Set spaceObjectCntrl = SpaceObjectCntrlsCol.Item(indexSpaceObject)

Why not do something like a simple IBoundControl interface:

'IBoundControl
Public Property Get Control() As Control
End Property
Public Property Set Control(bound As Control)
End Property
Public Property Get SpaceObject() As ISpaceObject
End Property
Public Property Set SpaceObject(bound As ISpaceObject)
End Property

That allows you to just store the related items in a single SpaceObjectCollection or ISpaceObjectHandler or whatever. It also gets rid of a ton of duplicated code like this:

Private Sub InitalizeMissleObjectImgControl(ByRef cntrl As Control, ByRef missleObject As Missle)
 With cntrl
 .left = missleObject.left
 .top = missleObject.top
 .height = missleObject.height
 .width = missleObject.width
 .Picture = LoadPicture(missleObject.ImgPathWay)
 .PictureSizeMode = 1
 End With
End Sub

...because now you can simply send everything through this:

Private Sub InitalizeGameObject(ByVal gameItem As IBoundControl)
 With gameItem.Control
 .left = gameItem.SpaceObject.left
 .top = gameItem.SpaceObject.top
 .height = gameItem.SpaceObject.height
 .width = gameItem.SpaceObject.width
 .Picture = gameItem.SpaceObject.BitMap '<-- decouple from the presenter.
 .PictureSizeMode = 1
 End With
End Sub

Note that I'm just mapping values to each other there, which is a sign that IBoundControl can also serve as an adapter - that could easily be done in the concrete implementation as well.

---

Missle and Ship should implement ISpaceObject. There's no reason that they shouldn't, and it would allow you to generalize CheckIfCollided to test for the collision of any two ISpaceObject's. Note that you can also short-circuit the tests:

Private Function CheckIfCollided(ByVal first As ISpaceObject, ByVal second As ISpaceObject) As Boolean
 Select Case False
 Case first.left - second.width < second.left
 Case second.left < first.left + first.width
 Case first.top - second.height < second.top
 Case second.top < first.top + first.height
 Case Else
 CheckIfCollided = True
 End Select
End Function

---

Everything Else

---

Almost everywhere that you pass objects or interfaces is done ByRef. Almost all of these should be passed ByVal. This is a common misconception about reference objects - what is ByVal isn't the object, it's the pointer to the object. It prevents you from doing things like this:

Private Sub Foo(ByRef someObject As Object)
 Set someObject = Nothing 'or New, or whatever.
End Sub

That's pretty much all it does. There isn't any difference in overhead, it doesn't create a "copy" of anything other than the object pointer, and it signals to the caller that you aren't going to mess with their object's assignment.

---

I don't really understand the point of how you condition your main game loop here:

Do While x < 100
 '...
Loop

x is never initialized and never incremented, so your loop is functionally equivelent to this:

Do
 '...
Loop

There's absolutely nothing wrong with that, and it makes it immediately obvious that you intend for the contained code to run until your Exit Do statement. Just do that instead.

---

The only thing that you use the timing functions for are for calculating when new objects are spawned. The problem with this is that you are calling DoEvents inside the loop in order to allow the keystrokes to process. In fact, the Sleep call has a hard-coded value at the bottom of the loop. The amount of time that it takes DoEvents to return is going to be dependent on the processing power of the host machine, the Windows scheduler, system load, etc. That means the amount of time between "impulses" or "ticks" in your game loop could potentially vary wildly. I'd suggest using a fixed "tick" or "pulse" time to attempt to keep the game speed more constant:

'These aren't tested, and would probably need tweaking (or a difficulty setting)
Const pulseLength As Long = 100 
Const spawnInterval As Long = 20
Dim spawnCounter As Long
Do
 startTime = timeGetTime
 spawnCounter = spawnCounter + 1
 If spawnCounter = spawnInterval Then
 SOLoadSpaceObjectOntoGameBoard.LoadSpaceObjectOntoBoard newBoard
 spawnCounter = 0
 End If
 '...
 DoEvents
 Dim loopTime As Long
 loopTime = timeGetTime - startTime
 Debug.Assert loopTime > 0 'Oh noes! Time is running backwards!
 'Normalize the time between pulses.
 If loopTime < pulseLength Then
 Sleep pulseLength - loopTime
 End If
Loop

---

Your Case's in GameLogic.HandleSendKeys and GameBoard.UserForm_KeyDown are implicitly being cast from Long to String:

Public Sub HandleSendKeys(ByRef board As GameBoard, ByRef caseNum As Long)
 Select Case caseNum '<-- Long here
 Case "37" '<-- String here, implicit cast
 SHMoveShip.moveShipLeft board

Also, in GameBoard.UserForm_KeyDown you are implicitly calling the default member of KeyCode:

Select Case KeyCode

...should probably be...

Select Case KeyCode.Value

---

Small nitpick that was driving me crazy every time I saw it... Missle is spelled Missile, with 2 is.

• learnAsWeGo: this is a great write up, will review more tomorrow. and i lold at the Missile mispelling er misspelling
• learnAsWeGo: this is great. going to rework everything save for presenter and create new question. presenter I will need to review your work and rubberduck posts. I like concept insofar as i can understand it but need more time with it
• learnAsWeGo: i have explored the battleship posts on rubberduck, downloaded your spreadsheet and played with it (created additional sprites and played with their movement). i have some additional questions. when i get a chance i will start a conversation with you. thank you.
• learnAsWeGo: the problem as far as i see it is that userforms do not allow us to "paint" by array. it only allows us to create and manipulate controls objects. true both your example and controls share a left and top property, that tells us where to place object within the gameboard, but the methods of actually placing the object/focusing the object are much different. the check if overlap function does work for both as it relies only on top and left properties. does this make sense?
• Comintern: @learnAsWeGo - You shouldn't have to "paint" them - can't you just iterate over a control array and set the positions on the form?