Space Invader game written In VBA, 3rd iteration [closed]

Question

Closed. This question is off-topic. It is not currently accepting answers.

Code not implemented or not working as intended: Code Review is a community where programmers peer-review your working code to address issues such as security, maintainability, performance, and scalability. We require that the code be working correctly, to the best of the author's knowledge, before proceeding with a review.

Closed 6 years ago.

Improve this question

Here is a link to the workbook, classes, modules and forms:

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

Positive:
I have decoupled the view from the control / presenter. I have implemented what I think is an MVP style design. I have refactored much of the code, making it leaner and meaner. I explored was to reduce the number of factories, but found that I to either A) create classes with "constructor" that set initial values B) store initial values in separate functions that I call from the factory method. I felt that my solution was most elegant of these.

Negative:
I have two BIG issues. First, my method of scaling is not working. I am taking the Game Board dimensions and using them to set the width / length of my game pieces. Somehow my method of figuring these values is not working.

Second I have moved from a custom collection to a dictionary as my method of storing game pieces. However as I loop through the pieces I every so often get a 424 Object Required error. This usually comes in the following line:

If CheckIfCollided(GamePiecesCollection.Item(MissileKey), GamePiecesCollection.Item(IncomingSpaceObjectKey)) Then

My handle ship incoming space objects collision function is not working at all LOL. Almost makes me want to switch back to a custom collection. But for some reason I thought that a dictionary would make condensing all of my collections, that is storing my ship, missiles and incoming space objects in the same collection, would be easier than fitting them into a custom collection.

Here is the code. Note the gameboard form wont load without frx file, which I cannot post here:

Note that I am using the Microsoft Scripting Runtime Library

GameBoard:

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} GameBoard 
   Caption         =   "UserForm1"
   ClientHeight    =   9495
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   7725
   OleObjectBlob   =   "GameBoard.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "GameBoard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub UserForm_Activate()
    GameLogic.RunGame Me.InsideHeight, Me.InsideWidth
End Sub

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

Public Sub RefreshGameBoard(ByVal ControlsToAdd As Scripting.Dictionary)
Dim Ctrl                                            As Image
Dim SpaceObjectIndex                                As Variant

    For Each Ctrl In Me.Controls
        Me.Controls.remove Ctrl.Name
    Next Ctrl

    For Each SpaceObjectIndex In ControlsToAdd.Keys()
        Set Ctrl = Me.Controls.Add("Forms.Image.1", ControlsToAdd.Item(SpaceObjectIndex).Name, True)
        Ctrl.Left = ControlsToAdd.Item(SpaceObjectIndex).Left
        Ctrl.Top = ControlsToAdd.Item(SpaceObjectIndex).Top
        Ctrl.Height = ControlsToAdd.Item(SpaceObjectIndex).Height
        Ctrl.Width = ControlsToAdd.Item(SpaceObjectIndex).Width
        Ctrl.Picture = LoadPicture(LinkToImage(ControlsToAdd.Item(SpaceObjectIndex).SpaceObjectType))
        Ctrl.PictureSizeMode = fmPictureSizeModeZoom
    Next SpaceObjectIndex
End Sub

Private Function LinkToImage(ByVal SpaceObjectType As SpaceObjectType) As String
    Select Case SpaceObjectType
        Case Alien
            LinkToImage = "C:\Users\evanm\OneDrive\Desktop\Excel\SpaceInvader\AlienShip.jpg"
        Case Comet
            LinkToImage = "C:\Users\evanm\OneDrive\Desktop\Excel\SpaceInvader\Comet.jpg"
        Case Star
            LinkToImage = "C:\Users\evanm\OneDrive\Desktop\Excel\SpaceInvader\Star.jpg"
        Case Missile
            LinkToImage = "C:\Users\evanm\OneDrive\Desktop\Excel\SpaceInvader\Missile.jpg"
        Case Ship
            LinkToImage = "C:\Users\evanm\OneDrive\Desktop\Excel\SpaceInvader\SpaceShip.jpg"
    End Select
End Function

CheckObject:

Attribute VB_Name = "CheckObjectType"
Option Explicit

Public Function IsIncomingSpaceObject(ByVal SpaceObjectOne As ISpaceObject) As Boolean
    If SpaceObjectOne.SpaceObjectType < Missile Then
        IsIncomingSpaceObject = True
    Else
        IsIncomingSpaceObject = False
    End If
End Function

Public Function IsMissile(ByVal SpaceObjectTwo As ISpaceObject) As Boolean
    If SpaceObjectTwo.SpaceObjectType = Missile Then
        IsMissile = True
    Else
        IsMissile = False
    End If
End Function

Collisions:

    Option Explicit

Function HandleMissileCollisions() As Dictionary
    Dim TempDict                                        As Dictionary
    Dim MissileKey                                      As Variant
    Dim IncomingSpaceObjectKey                          As Variant

    Set TempDict = GamePiecesCollection

    For Each MissileKey In GamePiecesCollection.Keys()
        If CheckObjectType.IsMissile(GamePiecesCollection.Item(MissileKey)) = True Then
            For Each IncomingSpaceObjectKey In GamePiecesCollection.Keys()
                If CheckObjectType.IsIncomingSpaceObject(GamePiecesCollection.Item(IncomingSpaceObjectKey)) And (IncomingSpaceObjectKey <> MissileKey) = True Then
                    If CheckIfCollided(GamePiecesCollection.Item(MissileKey), GamePiecesCollection.Item(IncomingSpaceObjectKey)) Then
                        TempDict.remove MissileKey
                        TempDict.remove IncomingSpaceObjectKey
                    End If
                End If
            Next IncomingSpaceObjectKey
        End If
    Next MissileKey
    Set GamePiecesCollection = TempDict
End Function

Function HandleShipCollisions() As PlayerShipHit
    Dim Ship                                            As ISpaceObject
    Dim IncomingSpaceObjectKey                          As Variant

    Set Ship = GamePiecesCollection.Items(0)

    For Each IncomingSpaceObjectKey In GamePiecesCollection.Keys()
        If CheckObjectType.IsIncomingSpaceObject(GamePiecesCollection.Item(IncomingSpaceObjectKey)) = True Then
            If CheckIfCollided(Ship, GamePiecesCollection(IncomingSpaceObjectKey)) Then
                HandleShipCollisions = Hit
                Exit For
            End If
        End If
    Next IncomingSpaceObjectKey
End Function

Private Function CheckIfCollided(ByVal First As ISpaceObject, ByVal Second As ISpaceObject) As Boolean
    Dim HorizontalOverlap                               As Boolean
    Dim VerticalOverlap                                 As Boolean

    HorizontalOverlap = (First.Left - Second.Width < Second.Left) And (Second.Left < First.Left + First.Width)
    VerticalOverlap = (First.Top - Second.Height < Second.Top) And (Second.Top < First.Top + First.Height)
    CheckIfCollided = HorizontalOverlap And VerticalOverlap
End Function

GameLogic:

Attribute VB_Name = "GameLogic"
Option Explicit

Public Enum SpaceObjectType
    Alien = 1
    Comet = 2
    Star = 3
    Missile = 4
    Ship = 5
End Enum

Public Enum PlayerShipHit
    Hit = 1
    NotHit = 0
End Enum

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Public GamePiecesCollection As Scripting.Dictionary
Const Interval = 3

Sub RunGame(ByVal BoardWith As Long, ByVal BoardHeight As Long)
    Dim SleepWatch As StopWatch
    Dim GenerateIncSpaceObjectsRound1 As StopWatch

    Set SleepWatch = New StopWatch
    SleepWatch.Start

    BoardDimensions.Width = BoardWith
    BoardDimensions.Height = BoardHeight

    Set GamePiecesCollection = New Scripting.Dictionary

    Set GenerateIncSpaceObjectsRound1 = New StopWatch
    GenerateIncSpaceObjectsRound1.Start

    Set SleepWatch = New StopWatch
    SleepWatch.Start

    InitializePlayerShip

    Do
        GameBoard.RefreshGameBoard GamePiecesCollection
        MoveSpaceObjects.MoveIncomingSpaceObjectsAndMissiles

        Collisions.HandleMissileCollisions
        Collisions.HandleShipCollisions

        If Format(GenerateIncSpaceObjectsRound1.Elapsed, "0.000000") > 3.25 Then
            ReleaseIncomingSpaceObject
            ReleaseIncomingSpaceObject
            ReleaseIncomingSpaceObject
            GenerateIncSpaceObjectsRound1.Restart
        End If

        If Format(SleepWatch.Elapsed, "0.000000") < Interval Then
            Sleep Interval - Format(SleepWatch.Elapsed, "0.000000")
            SleepWatch.Restart
        End If

        DoEvents
    Loop
End Sub

Public Sub HandleSendKeys(ByVal KeyCode As Long)
    Select Case KeyCode
        Case 37
            MoveSpaceObjects.MoveShip Left
        Case 39
            MoveSpaceObjects.MoveShip Right
        Case 32
            LaunchMissile
    End Select
End Sub

Private Function InitializePlayerShip()
Dim PlayerShip As ISpaceObject
    Set PlayerShip = SpaceObjectFactory.NewSpaceObject(Ship)
    GamePiecesCollection.Add PlayerShip.Name, PlayerShip
End Function

Private Function LaunchMissile()
Dim LaunchedMissile As ISpaceObject
    CountMissiles.IncrementMissileCount
    Set LaunchedMissile = SpaceObjectFactory.NewSpaceObject(Missile)
    GamePiecesCollection.Add LaunchedMissile.Name, LaunchedMissile
End Function

Private Function ReleaseIncomingSpaceObject()
Dim IncomingSpaceObject As ISpaceObject
    CountIncomingSpaceObjects.IncrementCountIncomingSpaceObjects
    Set IncomingSpaceObject = SpaceObjectFactory.NewSpaceObject(Application.WorksheetFunction.RandBetween(1, 3))
    GamePiecesCollection.Add IncomingSpaceObject.Name, IncomingSpaceObject
End Function

MoveSpaceObjects:

Attribute VB_Name = "MoveSpaceObjects"
Option Explicit

Public Enum Direction
    Left = 0
    Right = 1
End Enum

Sub MoveIncomingSpaceObjectsAndMissiles()
Dim SpaceObjectIndex                                As Variant

    For Each SpaceObjectIndex In GamePiecesCollection.Keys()
        If CheckObjectType.IsMissile(GamePiecesCollection.Item(SpaceObjectIndex)) = True Then
            If GamePiecesCollection.Item(SpaceObjectIndex).Top - 1 <= 0 Then
                GamePiecesCollection.remove SpaceObjectIndex
            Else
                GamePiecesCollection.Item(SpaceObjectIndex).Top = GamePiecesCollection.Item(SpaceObjectIndex).Top - 1
            End If
        ElseIf CheckObjectType.IsIncomingSpaceObject(GamePiecesCollection.Item(SpaceObjectIndex)) = True Then
            If GamePiecesCollection.Item(SpaceObjectIndex).Top + 1 >= BoardDimensions.Height Then
                GamePiecesCollection.remove SpaceObjectIndex
            Else
                GamePiecesCollection.Item(SpaceObjectIndex).Top = GamePiecesCollection.Item(SpaceObjectIndex).Top + 1
            End If
        End If
    Next SpaceObjectIndex
End Sub

Sub MoveShip(ByVal MoveShipDirection As Direction)
    Select Case MoveShipDirection
        Case Direction.Left
            If GamePiecesCollection.Item("SHIP").Left - 4 >= 0 Then
                GamePiecesCollection.Item("SHIP").Left = GamePiecesCollection.Item("SHIP").Left - 5
            Else
                GamePiecesCollection.Item("SHIP").Left = 0
            End If
        Case Direction.Right
            If (GamePiecesCollection.Item("SHIP").Left + GamePiecesCollection.Item("SHIP").Width) < BoardDimensions.Width Then
                GamePiecesCollection.Item("SHIP").Left = GamePiecesCollection.Item("SHIP").Left + 4
            Else
                GamePiecesCollection.Item("SHIP").Left = BoardDimensions.Width - GamePiecesCollection.Item("SHIP").Width
            End If
    End Select
End Sub

SpaceObjectFactory:

Attribute VB_Name = "SpaceObjectFactory"
Option Explicit

Public Function NewSpaceObject(ByVal SpaceObjectType As SpaceObjectType) As SpaceObject
    Select Case SpaceObjectType
        Case Alien
            Set NewSpaceObject = NewSpaceObjectAlien
        Case Comet
            Set NewSpaceObject = NewSpaceObjectComet
        Case Missile
            Set NewSpaceObject = NewSpaceObjectMissile
        Case Ship
            Set NewSpaceObject = NewSpaceObjectShip
        Case Star
            Set NewSpaceObject = NewSpaceObjectStar
    End Select
End Function

Private Function NewSpaceObjectAlien() As SpaceObject
    CountIncomingSpaceObjects.IncrementCountIncomingSpaceObjects
    With New SpaceObject
        .SetInitialLeft Application.WorksheetFunction.RandBetween(1, BoardDimensions.Width)
        .SetInitialTop 1
        .Height = BoardDimensions.Width / 10
        .Width = BoardDimensions.Width / 10
        .SpaceObjectType = Alien
        .Name = "INCSPACEOBJECT" & CountIncomingSpaceObjects.Count
        Set NewSpaceObjectAlien = .Self
    End With
End Function

Private Function NewSpaceObjectComet() As SpaceObject
    CountIncomingSpaceObjects.IncrementCountIncomingSpaceObjects
    With New SpaceObject
        .SetInitialLeft Application.WorksheetFunction.RandBetween(1, BoardDimensions.Width)
        .SetInitialTop 1
        .Height = BoardDimensions.Height / 7
        .Width = BoardDimensions.Height / 7
        .SpaceObjectType = Comet
        .Name = "INCSPACEOBJECT" & CountIncomingSpaceObjects.Count
        Set NewSpaceObjectComet = .Self
    End With
End Function

Private Function NewSpaceObjectMissile() As SpaceObject
    CountMissiles.IncrementMissileCount
    With New SpaceObject
        .SetInitialLeft ((GamePiecesCollection.Item("SHIP").Width - (BoardDimensions.Width / 20)) / 2) + GamePiecesCollection.Item("SHIP").Left
        .SetInitialTop GamePiecesCollection.Item("SHIP").Top - BoardDimensions.Height / 15
        .Height = BoardDimensions.Height / 15
        .Width = BoardDimensions.Width / 20
        .SpaceObjectType = Missile
        .Name = "MISSILE" & CountMissiles.Count
        Set NewSpaceObjectMissile = .Self
    End With
End Function

Private Function NewSpaceObjectShip() As SpaceObject
    With New SpaceObject
        .SetInitialLeft BoardDimensions.Width / 2 - ((BoardDimensions.Height / 7) / 2)
        .SetInitialTop BoardDimensions.Height - ((BoardDimensions.Height / 7) * 1.25)
        .Height = BoardDimensions.Height / 7
        .Width = BoardDimensions.Width / 7
        .SpaceObjectType = Ship
        .Name = "SHIP"
        Set NewSpaceObjectShip = .Self
    End With
End Function

Private Function NewSpaceObjectStar() As SpaceObject
    CountIncomingSpaceObjects.IncrementCountIncomingSpaceObjects
    With New SpaceObject
        .SetInitialLeft Application.WorksheetFunction.RandBetween(1, BoardDimensions.Width)
        .SetInitialTop 1
        .Height = BoardDimensions.Height / 5
        .Width = BoardDimensions.Height / 5
        .SpaceObjectType = Star
        .Name = "INCSPACEOBJECT" & CountIncomingSpaceObjects.Count
        Set NewSpaceObjectStar = .Self
    End With
End Function

BoardDimensions:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "BoardDimensions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type BoardDimensionsData
    Width As Long
    Height As Long
End Type

Private this As BoardDimensionsData

Public Property Let Width(ByVal Width As Long)
    this.Width = Width
End Property

Public Property Get Width() As Long
    Width = this.Width
End Property

Public Property Let Height(ByVal Height As Long)
    this.Height = Height
End Property

Public Property Get Height() As Long
    Height = this.Height
End Property

COUNT INCOMING SPACE OBJECTS:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CountIncomingSpaceObjects"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private pCount As Long

Public Property Get Count() As Long
    Count = pCount
End Property

Private Property Let Count(ByRef value As Long)
    pCount = value
End Property

Public Sub IncrementCountIncomingSpaceObjects()
    pCount = pCount + 1
End Sub

CountMissiles:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CountMissiles"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private pCount As Long

Public Property Get Count() As Long
    Count = pCount
End Property

Private Property Let Count(ByRef value As Long)
    pCount = value
End Property

Public Sub IncrementMissileCount()
    pCount = pCount + 1
End Sub

ISpaceObject:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ISpaceObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Property Let Left(ByVal changeLeft As Long)
End Property

Public Property Get Left() As Long
End Property

Public Property Let Top(ByVal changeTop As Long)
End Property

Public Property Get Top() As Long
End Property

Public Property Get Width() As Long
End Property

Public Property Get Height() As Long
End Property

Public Property Get Name() As String
End Property

Public Property Get SpaceObjectType() As SpaceObjectType
End Property

SpaceObject:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "SpaceObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Implements ISpaceObject

Private Type SpaceObjectData
    Left As Long
    Top As Long
    Height As Long
    Width As Long
    SpaceObjectType As String
    Name As String
End Type

Private this As SpaceObjectData

Public Sub SetInitialLeft(ByVal InitialLeft As Long)
    this.Left = InitialLeft
End Sub

Public Sub SetInitialTop(ByVal InitialTop As Long)
    this.Top = InitialTop
End Sub

Public Property Let Height(ByVal Height As Long)
    this.Height = Height
End Property

Public Property Let Width(ByVal Width As Long)
    this.Width = Width
End Property

Public Property Let SpaceObjectType(ByVal SpaceObjectType As SpaceObjectType)
    this.SpaceObjectType = SpaceObjectType
End Property

Public Property Let Name(ByVal Name As String)
    this.Name = Name
End Property

Public Property Get Self() As SpaceObject
    Set Self = Me
End Property

Private Property Let ISpaceObject_Top(ByVal changeTop As Long)
    this.Top = changeTop
End Property

Private Property Get ISpaceObject_Top() As Long
    ISpaceObject_Top = this.Top
End Property

Private Property Let ISpaceObject_Left(ByVal changeLeft As Long)
    this.Left = changeLeft
End Property

Private Property Get ISpaceObject_Left() As Long
    ISpaceObject_Left = this.Left
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

Private Property Get ISpaceObject_Name() As String
    ISpaceObject_Name = this.Name
End Property

Private Property Get ISpaceObject_SpaceObjectType() As Long
    ISpaceObject_SpaceObjectType = this.SpaceObjectType
End Property

StopWatch:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "StopWatch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" ( _
    lpPerformanceCount As UInt64) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" ( _
    lpFrequency As UInt64) As Long

Private pFrequency As Double
Private pStartTS As UInt64
Private pEndTS As UInt64
Private pElapsed As Double
Private pRunning As Boolean

Private Type UInt64
    LowPart As Long
    HighPart As Long
End Type

Private Const BShift_32 = 4294967296# ' 2 ^ 32

Private Function U64Dbl(U64 As UInt64) As Double
    Dim lDbl As Double, hDbl As Double
    lDbl = U64.LowPart
    hDbl = U64.HighPart
    If lDbl < 0 Then lDbl = lDbl + BShift_32
    If hDbl < 0 Then hDbl = hDbl + BShift_32
    U64Dbl = lDbl + BShift_32 * hDbl
End Function

Private Sub Class_Initialize()
    Dim PerfFrequency As UInt64
    QueryPerformanceFrequency PerfFrequency
    pFrequency = U64Dbl(PerfFrequency)
End Sub

Public Property Get Elapsed() As Double
    If pRunning Then
        Dim pNow As UInt64
        QueryPerformanceCounter pNow
        Elapsed = pElapsed + (U64Dbl(pNow) - U64Dbl(pStartTS)) / pFrequency
    Else
        Elapsed = pElapsed
    End If
End Property

Public Sub Start()
    If Not pRunning Then
        QueryPerformanceCounter pStartTS
        pRunning = True
    End If
End Sub

Public Sub Pause()
    If pRunning Then
        QueryPerformanceCounter pEndTS
        pRunning = False
        pElapsed = pElapsed + (U64Dbl(pEndTS) - U64Dbl(pStartTS)) / pFrequency
    End If
End Sub

Public Sub Reset()
    pElapsed = 0
    pRunning = False
End Sub

Public Sub Restart()
    pElapsed = 0
    QueryPerformanceCounter pStartTS
    pRunning = True
End Sub

Public Property Get Running() As Boolean
   Running = pRunning
End Property

Code not working? "[...] I have two BIG issues. First, my method of scaling is not working. [...] . Second [...] every so often get a 424 Object Required error. " — AJD, Commented Sep 29, 2018 at 6:15
My handle ship incoming space objects collision function is not working at all LOL - there is a lot that doesn't work yet... I could understand if you wrote that some particular part isn't quite right and that you are still working on that and we should ignore it but this question's focus seems to be on the bugs and this is off-topic here. This looks like an interesting project so could you clearly show which code parts are broken and should not be reviewed? But I'm afraid this might be too much anyway. — t3chb0t, Commented Sep 29, 2018 at 8:18
@t3chb0t Honestly it's simply not ready for review yet. OP should feel free to come back once it works, but that time has not come yet. — Mast, Commented Sep 29, 2018 at 10:16

AJD · Accepted Answer · 2018-09-29 06:47:20Z

At the risk of answering an off-topic question(*): Nothing says "review all logic in the program" than code like the following:

Public Function IsMissile(ByVal SpaceObjectTwo As ISpaceObject) As Boolean
    If SpaceObjectTwo.SpaceObjectType = Missile Then
        IsMissile = True
    Else
        IsMissile = False
    End If
End Function

which can be replaced by

Public Function IsMissile(ByVal SpaceObjectTwo As ISpaceObject) As Boolean
    IsMissile = (SpaceObjectTwo.SpaceObjectType = Missile)
End Function

And, seeing as this is a very simply single line function that is only used once in the code (with a sister function that is only used twice in the code), could be easily placed in-line in the code.

Function HandleMissileCollisions() As Dictionary
    Dim TempDict                                        As Dictionary
    Dim MissileKey                                      As Variant
    Dim IncomingSpaceObjectKey                          As Variant

    Set TempDict = GamePiecesCollection

    For Each MissileKey In GamePiecesCollection.Keys()
        If GamePiecesCollection.Item(MissileKey).SpaceObjectType = Missile Then
            For Each IncomingSpaceObjectKey In GamePiecesCollection.Keys()
                If GamePiecesCollection.Item(IncomingSpaceObjectKey).SpaceObjectType < Missile) And (IncomingSpaceObjectKey <> MissileKey) Then
                    If CheckIfCollided(GamePiecesCollection.Item(MissileKey), GamePiecesCollection.Item(IncomingSpaceObjectKey)) Then
                        TempDict.remove MissileKey
                        TempDict.remove IncomingSpaceObjectKey
                    End If
                End If
            Next IncomingSpaceObjectKey
        End If
    Next MissileKey
    Set GamePiecesCollection = TempDict
End Function

Function HandleShipCollisions() As PlayerShipHit
    Dim Ship                                            As ISpaceObject
    Dim IncomingSpaceObjectKey                          As Variant

    Set Ship = GamePiecesCollection.Items(0)

    For Each IncomingSpaceObjectKey In GamePiecesCollection.Keys()
        If GamePiecesCollection.Item(IncomingSpaceObjectKey) < Missile Then
            If CheckIfCollided(Ship, GamePiecesCollection(IncomingSpaceObjectKey)) Then
                HandleShipCollisions = Hit
                Exit For
            End If
        End If
    Next IncomingSpaceObjectKey
End Function

Your use of enum implies assumed knowledge about the order of the enum. While it works in this case, it does make the code a little less maintainable. You can argue that having IsMissile type functions helps - but in this case, you only used it once and the function itself made assumptions about the enum.

I think a broader statement about helper classes is that the help/value they add should be greater than the effort to code and maintain. And sometimes the singleton classes can be easily rolled into another class because that is where they are helping.

In this case, if CheckObjectType was rolled into ISpaceObject, then that would be helpful in increasing the readability of the code. For example:

For Each MissileKey In GamePiecesCollection.Keys()
    If GamePiecesCollection.Item(MissileKey).IsMissile Then
        For Each IncomingSpaceObjectKey In GamePiecesCollection.Keys()
            If GamePiecesCollection.Item(IncomingSpaceObjectKey).IsIncomingSpaceObject) And (IncomingSpaceObjectKey <> MissileKey) Then
                If CheckIfCollided(GamePiecesCollection.Item(MissileKey), GamePiecesCollection.Item(IncomingSpaceObjectKey)) Then
                    TempDict.remove MissileKey
                    TempDict.remove IncomingSpaceObjectKey
                End If
            End If
        Next IncomingSpaceObjectKey
    End If
Next MissileKey

Now when you read the modified code above, you can start asking yourself is my logic correct?

GamePiecesCollection.Item(IncomingSpaceObjectKey).IsIncomingSpaceObject) And (IncomingSpaceObjectKey <> MissileKey) 
' seems to roll over itself a couple of times!

Don't get me wrong - I like my onions and how creating layers of code both increases human readability at each layer and reduces the number of times code is repeated. But there is both a sensible level of how much abstraction and the ability to understand when something is an intricate part of the object as opposed to being a separate class in itself.

(*) Reference my comment against the OP: Code not working? "[...] I have two BIG issues. First, my method of scaling is not working. [...] . Second [...] every so often get a 424 Object Required error. "

Stack Exchange Network

Space Invader game written In VBA, 3rd iteration [closed]

GameBoard:

CheckObject:

Collisions:

GameLogic:

MoveSpaceObjects:

SpaceObjectFactory:

BoardDimensions:

CountMissiles:

ISpaceObject:

SpaceObject:

StopWatch:

1 Answer 1

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

Linked

Hot Network Questions

Space Invader game written In VBA, 3rd iteration [closed]

GameBoard:

CheckObject:

Collisions:

GameLogic:

MoveSpaceObjects:

SpaceObjectFactory:

BoardDimensions:

CountMissiles:

ISpaceObject:

SpaceObject:

StopWatch:

1 Answer 1

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

Linked

Related

Hot Network Questions

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