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.

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

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? — Comintern, Sep 4, 2018 at 17:57
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. — Mathieu Guindon, Sep 4, 2018 at 18:12
@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! — learnAsWeGo, Sep 5, 2018 at 5:03

Comintern · Accepted Answer · 2018-09-06 04:29:25Z

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.

this is a great write up, will review more tomorrow. and i lold at the Missile mispelling er misspelling — learnAsWeGo, Sep 6, 2018 at 4:39
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, Sep 6, 2018 at 17:01
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, Sep 10, 2018 at 2:55
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? — learnAsWeGo, Sep 11, 2018 at 3:48
@learnAsWeGo - You shouldn't have to "paint" them - can't you just iterate over a control array and set the positions on the form? — Comintern, Sep 11, 2018 at 3:53

Stack Exchange Network

Space Invader Style Game Written In VBA

1 Answer 1

Architecture

Everything Else

Your Answer

Not the answer you're looking for? Browse other questions tagged
beginner
object-oriented
game
vba
excel
or ask your own question.

Linked

Hot Network Questions

Space Invader Style Game Written In VBA

1 Answer 1

Architecture

Everything Else

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged beginnerobject-orientedgamevbaexcel or ask your own question.

Linked

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
beginner
object-oriented
game
vba
excel
or ask your own question.