Space Invader Style Game - Model / Presenter Decoupled From View - Functional Again Too

Question

Thank you for your patience. The game is fully functional again!

I have tried to incorporate all the advice I have received so far. Thank you for taking the time to review and comment.

I have now decoupled the Model / Presenter from the View as much as VBA allows (please correct me if wrong). There are two functions from inside the view which the presenter calls. One of these functions ends the game, the other takes in a collection which the view promptly displays to the player.

When your ship collides with a space object you get a game over message box and then the userform unloads, an upgrade over the previous version which lead to crashes when you tried to run game twice.

Rather than throwing all of the spaceobjects into a single collection I have kept the separate collections for each "type" of spaceobject; incoming, missile and ship. Separate Collections for these objects makes handling collisions and object removal more manageable.

In the immediate term I want to re introduce scoring and a missile count limit. Also I need to fix the scaling of the objects. I have them in a ratio with gameboard height / width. Somehow it was not working for me? Then I am thinking about heat seeking missiles (give me a chance to work on algorithim stuff a bit, should be fun)

You can find the workbook here:

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

Note that you cannot import and run Gameboard.frm without the corresponding Gameboard.frx file. Frx is a proprietary Microsoft file type that degenerates into alien symbols inside notepad, not sure how to link here.

Also note that StopWatch, BoardDimensions and each of the Collections have

Attribute VB_PredeclaredId = True

Big ups to:

StopWatch was put together by the fellow who runs bytecomb, a great site for vba tips. Link: https://bytecomb.com/accurate-performance-timers-in-vba/

GameBoard.frm:

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} GameBoard 
   Caption         =   "UserForm1"
   ClientHeight    =   9495
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   10095
   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 Collection)
    Dim Ctrl                                                            As Image
    Dim SpaceObjectIndex                                                As Variant

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

    For SpaceObjectIndex = 1 To ControlsToAdd.Count
        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 = fmPictureSizeModeStretch
    Next SpaceObjectIndex
End Sub

Public Sub CloseGame()
    MsgBox "GAMEOVER"
    Unload Me
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

GameLogic.bas:

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)
Const Interval = 3

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

    BoardDimensions.Width = BoardWith
    BoardDimensions.Height = BoardHeight

    Set SleepWatch = New StopWatch
    SleepWatch.Start

    Set GenerateIncSpaceObjectsRound1 = New StopWatch
    GenerateIncSpaceObjectsRound1.Start

    InitializePlayerShip

    Do
        GameBoard.RefreshGameBoard CombineCollections

        MoveSpaceObjects.MoveIncomingMissiles
        MoveSpaceObjects.MoveIncomingSpaceObjects

        Collisions.HandleMissileCollisions
        If Collisions.HandleShipCollisions Then Exit Do

        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

    GameBoard.CloseGame
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)
    CollectionShips.Add PlayerShip
End Function

Private Function LaunchMissile()
    Dim LaunchedMissile                                                     As ISpaceObject
    Set LaunchedMissile = SpaceObjectFactory.NewSpaceObject(Missile)
    CollectionMissiles.Add LaunchedMissile
End Function

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

Private Function CombineCollections() As Collection
    Dim ISpaceObjectIndex                                                   As Long

    Set CombineCollections = New Collection

    For ISpaceObjectIndex = 1 To CollectionIncomingSpaceObjects.Count
        CombineCollections.Add CollectionIncomingSpaceObjects.Item(ISpaceObjectIndex)
    Next ISpaceObjectIndex

    For ISpaceObjectIndex = 1 To CollectionMissiles.Count
        CombineCollections.Add CollectionMissiles.Item(ISpaceObjectIndex)
    Next ISpaceObjectIndex

    For ISpaceObjectIndex = 1 To CollectionShips.Count
        CombineCollections.Add CollectionShips.Item(ISpaceObjectIndex)
    Next ISpaceObjectIndex
End Function

MoveSpaceObjects.bas:

Attribute VB_Name = "MoveSpaceObjects"
Option Explicit

Public Enum Direction
    Left = 0
    Right = 1
End Enum

Sub MoveIncomingMissiles()
    Dim SpaceObjectIndex                                                    As Variant

    For SpaceObjectIndex = CollectionMissiles.Count To 1 Step -1
        If CollectionMissiles.Item(SpaceObjectIndex).Top - 3 <= 0 Then
            CollectionMissiles.Remove SpaceObjectIndex
        Else
            CollectionMissiles.Item(SpaceObjectIndex).Top = CollectionMissiles.Item(SpaceObjectIndex).Top - 3
        End If
    Next SpaceObjectIndex
End Sub

Sub MoveIncomingSpaceObjects()
    Dim SpaceObjectIndex                                                    As Variant

    For SpaceObjectIndex = CollectionIncomingSpaceObjects.Count To 1 Step -1
        If CollectionIncomingSpaceObjects.Item(SpaceObjectIndex).Top + 3 >= BoardDimensions.Height Then
            CollectionIncomingSpaceObjects.Remove SpaceObjectIndex
        Else
            CollectionIncomingSpaceObjects.Item(SpaceObjectIndex).Top = CollectionIncomingSpaceObjects.Item(SpaceObjectIndex).Top + 3
        End If
    Next SpaceObjectIndex
End Sub

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

SpaceObjectFactory.bas

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
    With New Spaceobject
        .SetInitialLeft Application.WorksheetFunction.RandBetween(1, BoardDimensions.Width)
        .SetInitialTop 1
        .Height = BoardDimensions.Width / 10
        .Width = BoardDimensions.Width / 10
        .SpaceObjectType = Alien
        .Name = "INCSPACEOBJECT" & CollectionIncomingSpaceObjects.Count
        Set NewSpaceObjectAlien = .Self
    End With
End Function

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

Private Function NewSpaceObjectMissile() As Spaceobject
    With New Spaceobject
        .SetInitialLeft ((CollectionShips.Item(1).Width - (BoardDimensions.Width / 20)) / 2) + CollectionShips.Item(1).Left
        .SetInitialTop CollectionShips.Item(1).Top - BoardDimensions.Height / 15
        .Height = BoardDimensions.Height / 15
        .Width = BoardDimensions.Height / 20
        .SpaceObjectType = Missile
        .Name = "MISSILE" & CollectionMissiles.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 Round(BoardDimensions.Height - ((BoardDimensions.Height / 7) * 1.25), 0)
        .Height = BoardDimensions.Height / 7
        .Width = BoardDimensions.Width / 7
        .SpaceObjectType = Ship
        .Name = "SHIP"
        Set NewSpaceObjectShip = .Self
    End With
End Function

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

Collisions.bas:

Attribute VB_Name = "Collisions"
Option Explicit

Sub HandleMissileCollisions()
    Dim MissileObject                                                       As ISpaceObject
    Dim IncomingSpaceObject                                                 As ISpaceObject
    Dim MissileObjectsIndex                                                 As Long
    Dim IncomingSpaceObjectIndex                                            As Long

    For MissileObjectsIndex = CollectionMissiles.Count To 1 Step -1
        Set MissileObject = CollectionMissiles.Item(MissileObjectsIndex)
        For IncomingSpaceObjectIndex = CollectionIncomingSpaceObjects.Count To 1 Step -1
            Set IncomingSpaceObject = CollectionIncomingSpaceObjects.Item(IncomingSpaceObjectIndex)
            If CheckIfCollided(MissileObject, IncomingSpaceObject) Then
                CollectionMissiles.Remove MissileObjectsIndex
                CollectionIncomingSpaceObjects.Remove IncomingSpaceObjectIndex
                Exit For
            End If
        Next IncomingSpaceObjectIndex
    Next MissileObjectsIndex
End Sub

Function HandleShipCollisions() As Boolean
    Dim ShipObject                                                          As ISpaceObject
    Dim IncomingSpaceObject                                                 As ISpaceObject
    Dim ShipObjectIndex                                                     As Long
    Dim IncomingSpaceObjectIndex                                            As Long

    For ShipObjectIndex = CollectionShips.Count To 1 Step -1
        Set ShipObject = CollectionShips.Item(ShipObjectIndex)
        For IncomingSpaceObjectIndex = CollectionIncomingSpaceObjects.Count To 1 Step -1
            Set IncomingSpaceObject = CollectionIncomingSpaceObjects.Item(IncomingSpaceObjectIndex)
            If CheckIfCollided(ShipObject, IncomingSpaceObject) Then
                HandleShipCollisions = True
                Exit For
            End If
        Next IncomingSpaceObjectIndex
    Next ShipObjectIndex
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

CollectionMissiles.cls:

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

Private CollectionMissiles As Collection
Private pCount As Long

Private Sub Class_Initialize()
    Set CollectionMissiles = New Collection
End Sub

Private Sub Class_Terminate()
    Set CollectionMissiles = Nothing
End Sub

Public Sub Add(obj As ISpaceObject)
    CollectionMissiles.Add obj
End Sub

Public Sub Remove(index As Variant)
    CollectionMissiles.Remove index
End Sub

Public Property Get Item(index As Variant) As ISpaceObject
    Set Item = CollectionMissiles.Item(index)
End Property

Property Get Count() As Long
    Count = CollectionMissiles.Count
End Property

Public Sub Clear()
    Set CollectionMissiles = New Collection
End Sub

CollectionIncomingSpaceObjects.cls:

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

Private CollectionIncomingSpaceObjects As Collection

Private Sub Class_Initialize()
    Set CollectionIncomingSpaceObjects = New Collection
End Sub

Private Sub Class_Terminate()
    Set CollectionIncomingSpaceObjects = Nothing
End Sub

Public Sub Add(obj As ISpaceObject)
    CollectionIncomingSpaceObjects.Add obj
End Sub

Public Sub Remove(index As Variant)
    CollectionIncomingSpaceObjects.Remove index
End Sub

Public Property Get Item(index As Variant) As ISpaceObject
    Set Item = CollectionIncomingSpaceObjects.Item(index)
End Property

Property Get Count() As Long
    Count = CollectionIncomingSpaceObjects.Count
End Property

Public Sub Clear()
    Set CollectionIncomingSpaceObjects = New Collection
End Sub

CollectionShips.cls:

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

Private CollectionShips As Collection
Private pCount As Long

Private Sub Class_Initialize()
    Set CollectionShips = New Collection
End Sub

Private Sub Class_Terminate()
    Set CollectionShips = Nothing
End Sub

Public Sub Add(obj As ISpaceObject)
    CollectionShips.Add obj
End Sub

Public Sub Remove(index As Variant)
    CollectionShips.Remove index
End Sub

Public Property Get Item(index As Variant) As ISpaceObject
    Set Item = CollectionShips.Item(index)
End Property

Property Get Count() As Long
    Count = CollectionShips.Count
End Property

Public Sub Clear()
    Set CollectionShips = New Collection
End Sub

ISpaceObject.cls

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

Private Function IsMissile() As Boolean
End Function

Private Function IsIncomingSpaceObject() As Boolean
End Function

BoardDimensions.cls:

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

StopWatch.cls

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

Answer 1

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

I really, really, really don't like this indentation style that shoves data types as far to the right as possible. The fact that, while consistent within modules, it's inconsistent across the project, makes it very distracting, and harder to parse what variable is of what data type - especially when there's a wall of declarations:

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

Use an indenter to apply consistent indenting style across the entire project: don't change the rules depending on which module you're looking at. If fixed-column data types rocks your boat, configure the indenter as such, and use that. But don't switch indentation styles between modules.

That Function InitializePlayerShip procedure has no declared return type, and doesn't assign any; it returns an implicit Variant/Empty for no reason, every time it's invoked. Make it a Sub if you don't care for a return value.

CollectionShips.Add PlayerShip is very worrying: you're storing application state in your classes' default instance, which effectively turns that state into global state. This is exactly what's wrong with storing state in default instances, and why it should be avoided at all costs: you might as well replace all these PredeclaredId classes with standard modules. They're full-fledged objects, but you're treating them like global state that can be accessed from anywhere: passing an instance as a parameter becomes useless/redundant, since the instance is already global.

VB_PredeclaredId isn't wrong in itself. In fact, I use it all the time. But NEVER use it to turn a class into some global-scope data bag. Every single time I enable the predeclared ID on a class, I use it to expose a convenient factory method, and ensure I never, ever use that default instance as I would any other instance of the same type. Storing state in the default instance defeats the very purpose of having class modules in the first place.

Every single Collection* class is redundant and should be removed. If you need a collection of ships, use a Collection and put ships in it.

Everything in SpaceObjectFactory.bas belongs in SpaceObject; only the SpaceObject class should ever need to use the SpaceObject type - everything else only needs to see ISpaceObject. That factory method belongs on the default instance, and the SpaceObjectType enum belongs in the ISpaceObject interface module. Having a factory method on the class you're creating IS the reason for a .Self property and having a default instance - without a factory method, there's pretty much no reason to have a PredeclaredId.

The IsMissile and IsIncomingSpaceObject properties smell: you're special-casing one SpaceObjectType and treating it differently from the others - from an OOP point of view, that's pretty much a violation of the Liskov Substitution Principle. What's special about a Missile? What's special about an "incoming space object"? You don't need either - you need a Direction and Speed values, perhaps encapsulated in some Vector class, exposed as a property on ISpaceObject - and now if you want you can have space objects coming from any direction, at varying speeds! Not that it's in the specs, but the point is, an ISpaceObject shouldn't care whether it's an Alien or a Missile, with the unwritten assumption that the Missile moves upward - using a Vector or a combination of Direction and Speed removes that assumption and makes every implementation equal.

Answer 2

File Paths

It is best to use relative references when lining to external files.

Private Function LinkToImage(ByVal SpaceObjectType As SpaceObjectType) As String
    Dim Path As String
    Path = ThisWorkbook.Path & "\"
    Select Case SpaceObjectType
    Case Alien
        LinkToImage = Path & "AlienShip.jpg"
    Case Comet
        LinkToImage = Path & "Comet.jpg"
    Case Star
        LinkToImage = Path & "Star.jpg"
    Case Missile
        LinkToImage = Path & "Missile.jpg"
    Case Ship
        LinkToImage = Path & "SpaceShip.jpg"
    End Select
End Function

Images

Consider converting the JPEG files to GIFs and deleting their backgrounds and setting the image BorderStyle and BackStyle properties to transparent.

I would also add an Userform to store the default images. You could also have this form double as your SpaceObject factory. In this way, you will not have to distribute multiple file.

SpaceObject

Consider storing an internal reference to SpaceObject image and returning it as a default value.

Property Get Value() As Long
    Attribute Value.VB_UserMemId = 0
    Set Value = this.Image
End Property

SpaceObjects should only be destroyed when they leave the board. This will reduce the flickering. You will have to add Move and Intersect methods to the SpaceObject class.

The program seems to lag as more images are added to the Userform. Adding the max number images that will be needed to the userform in design mode instead of adding them at run time should result in an even frame rate. I would think it would also improve the overall performance.

Demo

Just for a quick demo, I converted the images to GIFs, deleted their backgrounds and loaded them into a Userform. Ideally, I would store the images in an ImageList but I don't think that Imagelists are currently supported. It seems that this technique is actually quite faster then loading the images from file. To adjust for the faster loading I had to change the game's interval rate from 3 to 20 for my demo.

Next I added a quick hack to make it work

Public Sub RefreshGameBoard(ByVal ControlsToAdd As Collection)
    Dim Ctrl                                                            As Image
    Dim SpaceObjectIndex                                                As Variant

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

    For SpaceObjectIndex = 1 To ControlsToAdd.Count
        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))
        CopyPicture Ctrl, ControlsToAdd.Item(SpaceObjectIndex).SpaceObjectType
        Ctrl.PictureSizeMode = fmPictureSizeModeStretch
    Next SpaceObjectIndex
End Sub

Sub CopyPicture(Ctrl As MSForms.Image, SpaceObjectType As SpaceObjectType)
    Select Case SpaceObjectType
    Case Alien
        Ctrl.Picture = DefaultImagesForm.AlienShip.Picture
    Case Comet
        Ctrl.Picture = DefaultImagesForm.Comet.Picture
    Case Star
        Ctrl.Picture = DefaultImagesForm.Star.Picture
    Case Missile
        Ctrl.Picture = DefaultImagesForm.Missile.Picture
    Case Ship
        Ctrl.Picture = DefaultImagesForm.SpaceShip.Picture
    End Select
    Ctrl.BorderStyle = fmBorderStyleNone
    Ctrl.BackStyle = fmBackStyleTransparent
End Sub

Note: The actual game does not flicker as much as the GIF.

---

Addendum: Collision Detection

Added Intersects Method to SpaceObject DefaultImagesForm new generates code for SpaceObjectFactory

Download Sample Workbook