Return to Question

'@Folder("Battleship.Model.Player")
Option Explicit

Private Const KnownGridStateErrorMsg As String _
    = "Specified coordinate is not in an unknown state."
Private Const CannotAddShipAtPositionMsg As String _
    = "Cannot add a ship of this size at this position."
Private Const CannotAddMoreShipsMsg As String _
    = "Cannot add more ships to this grid."

Public Enum PlayerGridErrors
    KnownGridStateError = vbObjectError Or 127
    CannotAddShipAtPosition
    CannotAddMoreShips
End Enum

Public Enum AttackResult
    Miss
    Hit
    Sunk
End Enum

Public Enum GridState
    '@Description("Content at this coordinate is unknown.")
    Unknown = -1
    '@Description("Unconfirmed friendly ship position.")
    PreviewShipPosition = 0
    '@Description("Confirmed friendly ship position.")
    ShipPosition = 1
    '@Description("Unconfirmed invalid/overlapping ship position.")
    InvalidPosition = 2
    '@Description("No ship at this coordinate.")
    PreviousMiss = 3
    '@Description("An enemy ship occupies this coordinate.")
    PreviousHit = 4
End Enum

Private Type TPlayGrid
    Id As Byte
    ships As Collection
    State(1 To Globals.GridSize, 1 To Globals.GridSize) As GridState
End Type

Private this As TPlayGrid

Public Function Create(ByVal grid As Byte) As PlayerGrid
    With New PlayerGrid
        .GridId = grid
        Set Create = .Self
    End With
End Function

'@Description("Gets the ID of this grid. 1 for Player1, 2 for Player2.")
Public Property Get GridId() As Byte
    GridId = this.Id
End Property

Public Property Let GridId(ByVal value As Byte)
    this.Id = value
End Property

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

'@Description("Gets the number of ships placed on the grid.")
Public Property Get ShipCount() As Long
    ShipCount = this.ships.Count
End Property

Private Sub Class_Initialize()
    Set this.ships = New Collection
    Dim currentX As Long
    For currentX = LBound(this.State, 1) To UBound(this.State, 1)
        Dim currentY As Long
        For currentY = LBound(this.State, 2) To UBound(this.State, 2)
            this.State(currentX, currentY) = GridState.Unknown
        Next
    Next
End Sub

'@Description("Adds the specified ship to the grid. Throws if position is illegal.")
Public Sub AddShip(ByVal item As IShip)
    
    If Not CanAddShip(item.GridPosition, item.orientation, item.size) Then
        Err.Raise PlayerGridErrors.CannotAddShipAtPosition, TypeName(Me), CannotAddShipAtPositionMsg
    End If
    
    If this.ships.Count >= Globals.ShipsPerGrid Then
        Err.Raise PlayerGridErrors.CannotAddMoreShips, TypeName(Me), CannotAddMoreShipsMsg
    End If
    
    ' will throw a duplicate key error if item.Name is already in collection
    this.ships.Add item, item.Name
    
    Dim currentX As Long
    For currentX = item.GridPosition.X To item.GridPosition.X + IIf(item.orientation = Horizontal, item.size - 1, 0)
        Dim currentY As Long
        For currentY = item.GridPosition.Y To item.GridPosition.Y + IIf(item.orientation = Vertical, item.size - 1, 0)
            this.State(currentX, currentY) = GridState.ShipPosition
        Next
    Next

End Sub

'@Description("Gets a value indicating whether a ship can be added at the specified position/direction/size.")
Public Function CanAddShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
    CanAddShip = (position.X + IIf(direction = Horizontal, shipSize - 1, 0) <= UBound(this.State, 1)) _
             And (position.Y + IIf(direction = Vertical, shipSize - 1, 0) <= UBound(this.State, 2)) _
             And (position.X > 0 And position.Y > 0) _
             And IntersectsAny(position, direction, shipSize) Is Nothing
End Function

'@Description("Gets a value indicating whether the specified position/direction/size intersects with any existing ship.")
Public Function IntersectsAny(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As GridCoord
    Dim currentShip As IShip
    For Each currentShip In this.ships
        Dim intersecting As GridCoord
        Set intersecting = currentShip.Intersects(Ship.Create("InsersectCheck", shipSize, direction, position))
        If Not intersecting Is Nothing Then
            Set IntersectsAny = intersecting
            Exit Function
        End If
    Next
End Function

'@Description("Gets a value indicating whether the specified position/direction/size has any adjacent existing ship.")
Public Function HasAdjacentShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
        
    Dim positionX As Long
    Dim positionY As Long
    
    If direction = Horizontal Then
        positionY = position.Y
        For positionX = position.X To position.X + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    Else
        positionX = position.X
        For positionY = position.Y To position.Y + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    End If
End Function

Private Function HasAnyAdjacentShips(ByVal coord As GridCoord) As Boolean
    Dim currentX As Long
    Dim currentY As Long
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.orientation = Horizontal Then
            currentY = currentShip.GridPosition.Y
            For currentX = currentShip.GridPosition.X To currentShip.GridPosition.X + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        Else
            currentX = currentShip.GridPosition.X
            For currentY = currentShip.GridPosition.Y To currentShip.GridPosition.Y + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        End If
    Next
End Function

'@Description("(side-effecting) Attempts a hit at the specified position; returns the result of the attack, and a reference to the hit ship if successful.")
Public Function TryHit(ByVal position As GridCoord, Optional ByRef hitShip As IShip) As AttackResult
    
    If this.State(position.X, position.Y) = GridState.PreviousHit Or _
       this.State(position.X, position.Y) = GridState.PreviousMiss Then
        Err.Raise PlayerGridErrors.KnownGridStateError, TypeName(Me), KnownGridStateErrorMsg
    End If
    
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.Hit(position) Then
            this.State(position.X, position.Y) = GridState.PreviousHit
            If currentShip.IsSunken Then
                TryHit = Sunk
            Else
                TryHit = Hit
            End If
            Set hitShip = currentShip
            Exit Function
        End If
    Next
    
    this.State(position.X, position.Y) = GridState.PreviousMiss
    TryHit = Miss
    
End Function

'@Description("Gets the GridState value at the specified position.")
Public Property Get State(ByVal position As GridCoord) As GridState
    On Error Resume Next
    State = this.State(position.X, position.Y)
    On Error GoTo 0
End Property

'@Description("Gets a 2D array containing the GridState of each coordinate in the grid.")
Public Property Get StateArray() As Variant
    Dim result(1 To Globals.GridSize, 1 To Globals.GridSize) As Variant
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            Dim value As GridState
            value = this.State(currentX, currentY)
            result(currentX, currentY) = IIf(value = Unknown, Empty, value)
        Next
    Next
    StateArray = result
End Property

'@Description("Gets a value indicating whether the ship at the specified position is sunken.")
Public Property Get IsSunken(ByVal position As GridCoord) As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.IsSunken Then
            If currentShip.orientation = Horizontal Then
                If currentShip.GridPosition.Y = position.Y Then
                    If position.X >= currentShip.GridPosition.X And _
                       position.X <= currentShip.GridPosition.X + currentShip.size - 1 _
                    Then
                        IsSunken = True
                        Exit Property
                    End If
                End If
            End If
        End If
    Next
End Property

'@Descrition("Gets a value indicating whether all ships have been sunken.")
Public Property Get IsAllSunken() As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If Not currentShip.IsSunken Then
            IsAllSunken = False
            Exit Property
        End If
    Next
    IsAllSunken = True
End Property

'@Description("Returns the GridCoord of known hits around the specified hit position.")
Public Function GetHitArea(ByVal position As GridCoord) As Collection
    Debug.Assert this.State(position.X, position.Y) = GridState.PreviousHit
    
    Dim result As Collection
    Set result = New Collection
    
    Dim currentX As Long
    Dim currentY As Long
    
    currentX = position.X
    currentY = position.Y
    
    Dim currentPosition As GridCoord
    
    If position.X > 1 Then
        Do While currentX >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            currentX = currentX - 1
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.X < Globals.GridSize Then
        Do While currentX <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentX = currentX + 1
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.Y > 1 Then
        Do While currentY >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY - 1
        Loop
    End If
        
    currentX = position.X
    currentY = position.Y
        
    If position.Y < Globals.GridSize Then
        Do While currentY <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY + 1
        Loop
    End If
    
    Set GetHitArea = result
    
End Function

'@Description("Removes confirmed ship positions from grid state.")
Public Sub Scramble()
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            If this.State(currentX, currentY) = GridState.ShipPosition Then
                this.State(currentX, currentY) = GridState.Unknown
            End If
        Next
    Next
End Sub

'@Folder("Battleship.Model.Player")
Option Explicit

Private Const KnownGridStateErrorMsg As String _
    = "Specified coordinate is not in an unknown state."
Private Const CannotAddShipAtPositionMsg As String _
    = "Cannot add a ship of this size at this position."
Private Const CannotAddMoreShipsMsg As String _
    = "Cannot add more ships to this grid."

Public Enum PlayerGridErrors
    KnownGridStateError = vbObjectError Or 127
    CannotAddShipAtPosition
    CannotAddMoreShips
End Enum

Public Enum AttackResult
    Miss
    Hit
    Sunk
End Enum

Public Enum GridState
    '@Description("Content at this coordinate is unknown.")
    Unknown = -1
    '@Description("Unconfirmed friendly ship position.")
    PreviewShipPosition = 0
    '@Description("Confirmed friendly ship position.")
    ShipPosition = 1
    '@Description("Unconfirmed invalid/overlapping ship position.")
    InvalidPosition = 2
    '@Description("No ship at this coordinate.")
    PreviousMiss = 3
    '@Description("An enemy ship occupies this coordinate.")
    PreviousHit = 4
End Enum

Private Type TPlayGrid
    Id As Byte
    ships As Collection
    State(1 To Globals.GridSize, 1 To Globals.GridSize) As GridState
End Type

Private this As TPlayGrid

Public Function Create(ByVal grid As Byte) As PlayerGrid
    With New PlayerGrid
        .GridId = grid
        Set Create = .Self
    End With
End Function

'@Description("Gets the ID of this grid. 1 for Player1, 2 for Player2.")
Public Property Get GridId() As Byte
    GridId = this.Id
End Property

Public Property Let GridId(ByVal value As Byte)
    this.Id = value
End Property

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

'@Description("Gets the number of ships placed on the grid.")
Public Property Get ShipCount() As Long
    ShipCount = this.ships.Count
End Property

Private Sub Class_Initialize()
    Set this.ships = New Collection
    Dim currentX As Long
    For currentX = LBound(this.State, 1) To UBound(this.State, 1)
        Dim currentY As Long
        For currentY = LBound(this.State, 2) To UBound(this.State, 2)
            this.State(currentX, currentY) = GridState.Unknown
        Next
    Next
End Sub

'@Description("Adds the specified ship to the grid. Throws if position is illegal.")
Public Sub AddShip(ByVal item As IShip)
    
    If Not CanAddShip(item.GridPosition, item.orientation, item.size) Then
        Err.Raise PlayerGridErrors.CannotAddShipAtPosition, TypeName(Me), CannotAddShipAtPositionMsg
    End If
    
    If this.ships.Count >= Globals.ShipsPerGrid Then
        Err.Raise PlayerGridErrors.CannotAddMoreShips, TypeName(Me), CannotAddMoreShipsMsg
    End If
    
    ' will throw a duplicate key error if item.Name is already in collection
    this.ships.Add item, item.Name
    
    Dim currentX As Long
    For currentX = item.GridPosition.X To item.GridPosition.X + IIf(item.orientation = Horizontal, item.size - 1, 0)
        Dim currentY As Long
        For currentY = item.GridPosition.Y To item.GridPosition.Y + IIf(item.orientation = Vertical, item.size - 1, 0)
            this.State(currentX, currentY) = GridState.ShipPosition
        Next
    Next

End Sub

'@Description("Gets a value indicating whether a ship can be added at the specified position/direction/size.")
Public Function CanAddShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
    CanAddShip = (position.X + IIf(direction = Horizontal, shipSize - 1, 0) <= UBound(this.State, 1)) _
             And (position.Y + IIf(direction = Vertical, shipSize - 1, 0) <= UBound(this.State, 2)) _
             And (position.X > 0 And position.Y > 0) _
             And IntersectsAny(position, direction, shipSize) Is Nothing
End Function

'@Description("Gets a value indicating whether the specified position/direction/size intersects with any existing ship.")
Public Function IntersectsAny(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As GridCoord
    Dim currentShip As IShip
    For Each currentShip In this.ships
        Dim intersecting As GridCoord
        Set intersecting = currentShip.Intersects(Ship.Create("InsersectCheck", shipSize, direction, position))
        If Not intersecting Is Nothing Then
            Set IntersectsAny = intersecting
            Exit Function
        End If
    Next
End Function

'@Description("Gets a value indicating whether the specified position/direction/size has any adjacent existing ship.")
Public Function HasAdjacentShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
        
    Dim positionX As Long
    Dim positionY As Long
    
    If direction = Horizontal Then
        positionY = position.Y
        For positionX = position.X To position.X + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    Else
        positionX = position.X
        For positionY = position.Y To position.Y + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    End If
End Function

Private Function HasAnyAdjacentShips(ByVal coord As GridCoord) As Boolean
    Dim currentX As Long
    Dim currentY As Long
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.orientation = Horizontal Then
            currentY = currentShip.GridPosition.Y
            For currentX = currentShip.GridPosition.X To currentShip.GridPosition.X + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        Else
            currentX = currentShip.GridPosition.X
            For currentY = currentShip.GridPosition.Y To currentShip.GridPosition.Y + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        End If
    Next
End Function

'@Description("(side-effecting) Attempts a hit at the specified position; returns the result of the attack, and a reference to the hit ship if successful.")
Public Function TryHit(ByVal position As GridCoord, Optional ByRef hitShip As IShip) As AttackResult
    
    If this.State(position.X, position.Y) = GridState.PreviousHit Or _
       this.State(position.X, position.Y) = GridState.PreviousMiss Then
        Err.Raise PlayerGridErrors.KnownGridStateError, TypeName(Me), KnownGridStateErrorMsg
    End If
    
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.Hit(position) Then
            this.State(position.X, position.Y) = GridState.PreviousHit
            If currentShip.IsSunken Then
                TryHit = Sunk
            Else
                TryHit = Hit
            End If
            Set hitShip = currentShip
            Exit Function
        End If
    Next
    
    this.State(position.X, position.Y) = GridState.PreviousMiss
    TryHit = Miss
    
End Function

'@Description("Gets the GridState value at the specified position.")
Public Property Get State(ByVal position As GridCoord) As GridState
    On Error Resume Next
    State = this.State(position.X, position.Y)
    On Error GoTo 0
End Property

'@Description("Gets a 2D array containing the GridState of each coordinate in the grid.")
Public Property Get StateArray() As Variant
    Dim result(1 To Globals.GridSize, 1 To Globals.GridSize) As Variant
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            Dim value As GridState
            value = this.State(currentX, currentY)
            result(currentX, currentY) = IIf(value = Unknown, Empty, value)
        Next
    Next
    StateArray = result
End Property

'@Description("Gets a value indicating whether the ship at the specified position is sunken.")
Public Property Get IsSunken(ByVal position As GridCoord) As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.IsSunken Then
            If currentShip.orientation = Horizontal Then
                If currentShip.GridPosition.Y = position.Y Then
                    If position.X >= currentShip.GridPosition.X And _
                       position.X <= currentShip.GridPosition.X + currentShip.size - 1 _
                    Then
                        IsSunken = True
                        Exit Property
                    End If
                End If
            End If
        End If
    Next
End Property

'@Descrition("Gets a value indicating whether all ships have been sunken.")
Public Property Get IsAllSunken() As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If Not currentShip.IsSunken Then
            IsAllSunken = False
            Exit Property
        End If
    Next
    IsAllSunken = True
End Property

'@Description("Returns the GridCoord of known hits around the specified hit position.")
Public Function GetHitArea(ByVal position As GridCoord) As Collection
    Debug.Assert this.State(position.X, position.Y) = GridState.PreviousHit
    
    Dim result As Collection
    Set result = New Collection
    
    Dim currentX As Long
    Dim currentY As Long
    
    currentX = position.X
    currentY = position.Y
    
    Dim currentPosition As GridCoord
    
    If position.X > 1 Then
        Do While currentX >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentX = currentX - 1
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.X < Globals.GridSize Then
        Do While currentX <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentX = currentX + 1
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.Y > 1 Then
        Do While currentY >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY - 1
        Loop
    End If
        
    currentX = position.X
    currentY = position.Y
        
    If position.Y < Globals.GridSize Then
        Do While currentY <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY + 1
        Loop
    End If
    
    Set GetHitArea = result
    
End Function

'@Description("Removes confirmed ship positions from grid state.")
Public Sub Scramble()
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            If this.State(currentX, currentY) = GridState.ShipPosition Then
                this.State(currentX, currentY) = GridState.Unknown
            End If
        Next
    Next
End Sub

'@Folder("Battleship.Model.Player")
Option Explicit

Private Const KnownGridStateErrorMsg As String _
    = "Specified coordinate is not in an unknown state."
Private Const CannotAddShipAtPositionMsg As String _
    = "Cannot add a ship of this size at this position."
Private Const CannotAddMoreShipsMsg As String _
    = "Cannot add more ships to this grid."

Public Enum PlayerGridErrors
    KnownGridStateError = vbObjectError Or 127
    CannotAddShipAtPosition
    CannotAddMoreShips
End Enum

Public Enum AttackResult
    Miss
    Hit
    Sunk
End Enum

Public Enum GridState
    '@Description("Content at this coordinate is unknown.")
    Unknown = -1
    '@Description("Unconfirmed friendly ship position.")
    PreviewShipPosition = 0
    '@Description("Confirmed friendly ship position.")
    ShipPosition = 1
    '@Description("Unconfirmed invalid/overlapping ship position.")
    InvalidPosition = 2
    '@Description("No ship at this coordinate.")
    PreviousMiss = 3
    '@Description("An enemy ship occupies this coordinate.")
    PreviousHit = 4
End Enum

Private Type TPlayGrid
    Id As Byte
    ships As Collection
    State(1 To Globals.GridSize, 1 To Globals.GridSize) As GridState
End Type

Private this As TPlayGrid

Public Function Create(ByVal grid As Byte) As PlayerGrid
    With New PlayerGrid
        .GridId = grid
        Set Create = .Self
    End With
End Function

'@Description("Gets the ID of this grid. 1 for Player1, 2 for Player2.")
Public Property Get GridId() As Byte
    GridId = this.Id
End Property

Public Property Let GridId(ByVal value As Byte)
    this.Id = value
End Property

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

'@Description("Gets the number of ships placed on the grid.")
Public Property Get ShipCount() As Long
    ShipCount = this.ships.Count
End Property

Private Sub Class_Initialize()
    Set this.ships = New Collection
    Dim currentX As Long
    For currentX = LBound(this.State, 1) To UBound(this.State, 1)
        Dim currentY As Long
        For currentY = LBound(this.State, 2) To UBound(this.State, 2)
            this.State(currentX, currentY) = GridState.Unknown
        Next
    Next
End Sub

'@Description("Adds the specified ship to the grid. Throws if position is illegal.")
Public Sub AddShip(ByVal item As IShip)
    
    If Not CanAddShip(item.GridPosition, item.orientation, item.size) Then
        Err.Raise PlayerGridErrors.CannotAddShipAtPosition, TypeName(Me), CannotAddShipAtPositionMsg
    End If
    
    If this.ships.Count >= Globals.ShipsPerGrid Then
        Err.Raise PlayerGridErrors.CannotAddMoreShips, TypeName(Me), CannotAddMoreShipsMsg
    End If
    
    ' will throw a duplicate key error if item.Name is already in collection
    this.ships.Add item, item.Name
    
    Dim currentX As Long
    For currentX = item.GridPosition.X To item.GridPosition.X + IIf(item.orientation = Horizontal, item.size - 1, 0)
        Dim currentY As Long
        For currentY = item.GridPosition.Y To item.GridPosition.Y + IIf(item.orientation = Vertical, item.size - 1, 0)
            this.State(currentX, currentY) = GridState.ShipPosition
        Next
    Next

End Sub

'@Description("Gets a value indicating whether a ship can be added at the specified position/direction/size.")
Public Function CanAddShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
    CanAddShip = (position.X + IIf(direction = Horizontal, shipSize - 1, 0) <= UBound(this.State, 1)) _
             And (position.Y + IIf(direction = Vertical, shipSize - 1, 0) <= UBound(this.State, 2)) _
             And (position.X > 0 And position.Y > 0) _
             And IntersectsAny(position, direction, shipSize) Is Nothing
End Function

'@Description("Gets a value indicating whether the specified position/direction/size intersects with any existing ship.")
Public Function IntersectsAny(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As GridCoord
    Dim currentShip As IShip
    For Each currentShip In this.ships
        Dim intersecting As GridCoord
        Set intersecting = currentShip.Intersects(Ship.Create("InsersectCheck", shipSize, direction, position))
        If Not intersecting Is Nothing Then
            Set IntersectsAny = intersecting
            Exit Function
        End If
    Next
End Function

'@Description("Gets a value indicating whether the specified position/direction/size has any adjacent existing ship.")
Public Function HasAdjacentShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
        
    Dim positionX As Long
    Dim positionY As Long
    
    If direction = Horizontal Then
        positionY = position.Y
        For positionX = position.X To position.X + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    Else
        positionX = position.X
        For positionY = position.Y To position.Y + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    End If
End Function

Private Function HasAnyAdjacentShips(ByVal coord As GridCoord) As Boolean
    Dim currentX As Long
    Dim currentY As Long
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.orientation = Horizontal Then
            currentY = currentShip.GridPosition.Y
            For currentX = currentShip.GridPosition.X To currentShip.GridPosition.X + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        Else
            currentX = currentShip.GridPosition.X
            For currentY = currentShip.GridPosition.Y To currentShip.GridPosition.Y + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        End If
    Next
End Function

'@Description("(side-effecting) Attempts a hit at the specified position; returns the result of the attack, and a reference to the hit ship if successful.")
Public Function TryHit(ByVal position As GridCoord, Optional ByRef hitShip As IShip) As AttackResult
    
    If this.State(position.X, position.Y) = GridState.PreviousHit Or _
       this.State(position.X, position.Y) = GridState.PreviousMiss Then
        Err.Raise PlayerGridErrors.KnownGridStateError, TypeName(Me), KnownGridStateErrorMsg
    End If
    
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.Hit(position) Then
            this.State(position.X, position.Y) = GridState.PreviousHit
            If currentShip.IsSunken Then
                TryHit = Sunk
            Else
                TryHit = Hit
            End If
            Set hitShip = currentShip
            Exit Function
        End If
    Next
    
    this.State(position.X, position.Y) = GridState.PreviousMiss
    TryHit = Miss
    
End Function

'@Description("Gets the GridState value at the specified position.")
Public Property Get State(ByVal position As GridCoord) As GridState
    On Error Resume Next
    State = this.State(position.X, position.Y)
    On Error GoTo 0
End Property

'@Description("Gets a 2D array containing the GridState of each coordinate in the grid.")
Public Property Get StateArray() As Variant
    Dim result(1 To Globals.GridSize, 1 To Globals.GridSize) As Variant
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            Dim value As GridState
            value = this.State(currentX, currentY)
            result(currentX, currentY) = IIf(value = Unknown, Empty, value)
        Next
    Next
    StateArray = result
End Property

'@Description("Gets a value indicating whether the ship at the specified position is sunken.")
Public Property Get IsSunken(ByVal position As GridCoord) As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.IsSunken Then
            If currentShip.orientation = Horizontal Then
                If currentShip.GridPosition.Y = position.Y Then
                    If position.X >= currentShip.GridPosition.X And _
                       position.X <= currentShip.GridPosition.X + currentShip.size - 1 _
                    Then
                        IsSunken = True
                        Exit Property
                    End If
                End If
            End If
        End If
    Next
End Property

'@Descrition("Gets a value indicating whether all ships have been sunken.")
Public Property Get IsAllSunken() As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If Not currentShip.IsSunken Then
            IsAllSunken = False
            Exit Property
        End If
    Next
    IsAllSunken = True
End Property

'@Description("Returns the GridCoord of known hits around the specified hit position.")
Public Function GetHitArea(ByVal position As GridCoord) As Collection
    Debug.Assert this.State(position.X, position.Y) = GridState.PreviousHit
    
    Dim result As Collection
    Set result = New Collection
    
    Dim currentX As Long
    currentX = position.X
    
    Dim currentY As Long
    currentY = position.Y
    
    If position.X < Globals.GridSize Then
        Do While currentX <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            result.Add GridCoord.Create(currentX, currentY)
            currentX = currentX + 1
        Loop
    ElseIf position.X > 1 Then
        Do While currentX >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            result.Add GridCoord.Create(currentX, currentY)
            currentX = currentX - 1
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.Y < Globals.GridSize Then
        Do While currentY <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            result.Add GridCoord.Create(currentX, currentY)
            currentY = currentY + 1
        Loop
    ElseIf position.Y > 1 Then
        Do While currentY >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            currentY = currentY - 1
        Loop
    End If
    
    Set GetHitArea = result
    
End Function

'@Description("Removes confirmed ship positions from grid state.")
Public Sub Scramble()
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            If this.State(currentX, currentY) = GridState.ShipPosition Then
                this.State(currentX, currentY) = GridState.Unknown
            End If
        Next
    Next
End Sub

'@Folder("Battleship.Model.Player")
Option Explicit

Private Const KnownGridStateErrorMsg As String _
    = "Specified coordinate is not in an unknown state."
Private Const CannotAddShipAtPositionMsg As String _
    = "Cannot add a ship of this size at this position."
Private Const CannotAddMoreShipsMsg As String _
    = "Cannot add more ships to this grid."

Public Enum PlayerGridErrors
    KnownGridStateError = vbObjectError Or 127
    CannotAddShipAtPosition
    CannotAddMoreShips
End Enum

Public Enum AttackResult
    Miss
    Hit
    Sunk
End Enum

Public Enum GridState
    '@Description("Content at this coordinate is unknown.")
    Unknown = -1
    '@Description("Unconfirmed friendly ship position.")
    PreviewShipPosition = 0
    '@Description("Confirmed friendly ship position.")
    ShipPosition = 1
    '@Description("Unconfirmed invalid/overlapping ship position.")
    InvalidPosition = 2
    '@Description("No ship at this coordinate.")
    PreviousMiss = 3
    '@Description("An enemy ship occupies this coordinate.")
    PreviousHit = 4
End Enum

Private Type TPlayGrid
    Id As Byte
    ships As Collection
    State(1 To Globals.GridSize, 1 To Globals.GridSize) As GridState
End Type

Private this As TPlayGrid

Public Function Create(ByVal grid As Byte) As PlayerGrid
    With New PlayerGrid
        .GridId = grid
        Set Create = .Self
    End With
End Function

'@Description("Gets the ID of this grid. 1 for Player1, 2 for Player2.")
Public Property Get GridId() As Byte
    GridId = this.Id
End Property

Public Property Let GridId(ByVal value As Byte)
    this.Id = value
End Property

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

'@Description("Gets the number of ships placed on the grid.")
Public Property Get ShipCount() As Long
    ShipCount = this.ships.Count
End Property

Private Sub Class_Initialize()
    Set this.ships = New Collection
    Dim currentX As Long
    For currentX = LBound(this.State, 1) To UBound(this.State, 1)
        Dim currentY As Long
        For currentY = LBound(this.State, 2) To UBound(this.State, 2)
            this.State(currentX, currentY) = GridState.Unknown
        Next
    Next
End Sub

'@Description("Adds the specified ship to the grid. Throws if position is illegal.")
Public Sub AddShip(ByVal item As IShip)
    
    If Not CanAddShip(item.GridPosition, item.orientation, item.size) Then
        Err.Raise PlayerGridErrors.CannotAddShipAtPosition, TypeName(Me), CannotAddShipAtPositionMsg
    End If
    
    If this.ships.Count >= Globals.ShipsPerGrid Then
        Err.Raise PlayerGridErrors.CannotAddMoreShips, TypeName(Me), CannotAddMoreShipsMsg
    End If
    
    ' will throw a duplicate key error if item.Name is already in collection
    this.ships.Add item, item.Name
    
    Dim currentX As Long
    For currentX = item.GridPosition.X To item.GridPosition.X + IIf(item.orientation = Horizontal, item.size - 1, 0)
        Dim currentY As Long
        For currentY = item.GridPosition.Y To item.GridPosition.Y + IIf(item.orientation = Vertical, item.size - 1, 0)
            this.State(currentX, currentY) = GridState.ShipPosition
        Next
    Next

End Sub

'@Description("Gets a value indicating whether a ship can be added at the specified position/direction/size.")
Public Function CanAddShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
    CanAddShip = (position.X + IIf(direction = Horizontal, shipSize - 1, 0) <= UBound(this.State, 1)) _
             And (position.Y + IIf(direction = Vertical, shipSize - 1, 0) <= UBound(this.State, 2)) _
             And (position.X > 0 And position.Y > 0) _
             And IntersectsAny(position, direction, shipSize) Is Nothing
End Function

'@Description("Gets a value indicating whether the specified position/direction/size intersects with any existing ship.")
Public Function IntersectsAny(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As GridCoord
    Dim currentShip As IShip
    For Each currentShip In this.ships
        Dim intersecting As GridCoord
        Set intersecting = currentShip.Intersects(Ship.Create("InsersectCheck", shipSize, direction, position))
        If Not intersecting Is Nothing Then
            Set IntersectsAny = intersecting
            Exit Function
        End If
    Next
End Function

'@Description("Gets a value indicating whether the specified position/direction/size has any adjacent existing ship.")
Public Function HasAdjacentShip(ByVal position As GridCoord, ByVal direction As ShipOrientation, ByVal shipSize As Byte) As Boolean
        
    Dim positionX As Long
    Dim positionY As Long
    
    If direction = Horizontal Then
        positionY = position.Y
        For positionX = position.X To position.X + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    Else
        positionX = position.X
        For positionY = position.Y To position.Y + shipSize - 1
            If HasAnyAdjacentShips(GridCoord.Create(positionX, positionY)) Then
                HasAdjacentShip = True
                Exit Function
            End If
        Next
    End If
End Function

Private Function HasAnyAdjacentShips(ByVal coord As GridCoord) As Boolean
    Dim currentX As Long
    Dim currentY As Long
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.orientation = Horizontal Then
            currentY = currentShip.GridPosition.Y
            For currentX = currentShip.GridPosition.X To currentShip.GridPosition.X + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        Else
            currentX = currentShip.GridPosition.X
            For currentY = currentShip.GridPosition.Y To currentShip.GridPosition.Y + currentShip.size - 1
                If GridCoord.Create(currentX, currentY).IsAdjacent(coord) Then
                    HasAnyAdjacentShips = True
                    Exit Function
                End If
            Next
        End If
    Next
End Function

'@Description("(side-effecting) Attempts a hit at the specified position; returns the result of the attack, and a reference to the hit ship if successful.")
Public Function TryHit(ByVal position As GridCoord, Optional ByRef hitShip As IShip) As AttackResult
    
    If this.State(position.X, position.Y) = GridState.PreviousHit Or _
       this.State(position.X, position.Y) = GridState.PreviousMiss Then
        Err.Raise PlayerGridErrors.KnownGridStateError, TypeName(Me), KnownGridStateErrorMsg
    End If
    
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.Hit(position) Then
            this.State(position.X, position.Y) = GridState.PreviousHit
            If currentShip.IsSunken Then
                TryHit = Sunk
            Else
                TryHit = Hit
            End If
            Set hitShip = currentShip
            Exit Function
        End If
    Next
    
    this.State(position.X, position.Y) = GridState.PreviousMiss
    TryHit = Miss
    
End Function

'@Description("Gets the GridState value at the specified position.")
Public Property Get State(ByVal position As GridCoord) As GridState
    On Error Resume Next
    State = this.State(position.X, position.Y)
    On Error GoTo 0
End Property

'@Description("Gets a 2D array containing the GridState of each coordinate in the grid.")
Public Property Get StateArray() As Variant
    Dim result(1 To Globals.GridSize, 1 To Globals.GridSize) As Variant
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            Dim value As GridState
            value = this.State(currentX, currentY)
            result(currentX, currentY) = IIf(value = Unknown, Empty, value)
        Next
    Next
    StateArray = result
End Property

'@Description("Gets a value indicating whether the ship at the specified position is sunken.")
Public Property Get IsSunken(ByVal position As GridCoord) As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If currentShip.IsSunken Then
            If currentShip.orientation = Horizontal Then
                If currentShip.GridPosition.Y = position.Y Then
                    If position.X >= currentShip.GridPosition.X And _
                       position.X <= currentShip.GridPosition.X + currentShip.size - 1 _
                    Then
                        IsSunken = True
                        Exit Property
                    End If
                End If
            End If
        End If
    Next
End Property

'@Descrition("Gets a value indicating whether all ships have been sunken.")
Public Property Get IsAllSunken() As Boolean
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If Not currentShip.IsSunken Then
            IsAllSunken = False
            Exit Property
        End If
    Next
    IsAllSunken = True
End Property

'@Description("Returns the GridCoord of known hits around the specified hit position.")
Public Function GetHitArea(ByVal position As GridCoord) As Collection
    Debug.Assert this.State(position.X, position.Y) = GridState.PreviousHit
    
    Dim result As Collection
    Set result = New Collection
    
    Dim currentX As Long
    Dim currentY As Long
    
    currentX = position.X
    currentY = position.Y
    
    Dim currentPosition As GridCoord
    
    If position.X > 1 Then
        Do While currentX >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            currentX = currentX - 1
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.X < Globals.GridSize Then
        Do While currentX <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentX = currentX + 1
        Loop
    End If
    
    currentX = position.X
    currentY = position.Y
    
    If position.Y > 1 Then
        Do While currentY >= 1 And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY - 1
        Loop
    End If
        
    currentX = position.X
    currentY = position.Y
        
    If position.Y < Globals.GridSize Then
        Do While currentY <= Globals.GridSize And this.State(currentX, currentY) = GridState.PreviousHit
            On Error Resume Next
            With GridCoord.Create(currentX, currentY)
                result.Add .Self, .ToString
            End With
            On Error GoTo 0
            currentY = currentY + 1
        Loop
    End If
    
    Set GetHitArea = result
    
End Function

'@Description("Removes confirmed ship positions from grid state.")
Public Sub Scramble()
    Dim currentX As Long
    For currentX = 1 To Globals.GridSize
        Dim currentY As Long
        For currentY = 1 To Globals.GridSize
            If this.State(currentX, currentY) = GridState.ShipPosition Then
                this.State(currentX, currentY) = GridState.Unknown
            End If
        Next
    Next
End Sub

The Globals module is just a standard procedural module that exposes, well, the game's globals:

'@Folder("Battleship")
Option Explicit

Public Const GridSize As Byte = 10
Public Const ShipsPerGrid As Byte = 5

Public Const Delay As Long = 1200

Public Const ShipNameCarrier As String = "Aircraft Carrier"
Public Const ShipNameBattleship As String = "Battleship"
Public Const ShipNameSubmarine As String = "Submarine"
Public Const ShipNameCruiser As String = "Cruiser"
Public Const ShipNameDestroyer As String = "Destroyer"

Public Function GetDefaultShips() As Variant
    GetDefaultShips = Array( _
        GetDefaultCarrier, _
        GetDefaultBattleship, _
        GetDefaultSubmarine, _
        GetDefaultCruiser, _
        GetDefaultDestroyer)
End Function

Private Function GetDefaultCarrier() As IShip
    Set GetDefaultCarrier = Ship.Create(ShipNameCarrier, 5, Horizontal, GridCoord.Create(1, 1))
End Function

Private Function GetDefaultBattleship() As IShip
    Set GetDefaultBattleship = Ship.Create(ShipNameBattleship, 4, Horizontal, GridCoord.Create(1, 1))
End Function

Private Function GetDefaultSubmarine() As IShip
    Set GetDefaultSubmarine = Ship.Create(ShipNameSubmarine, 3, Horizontal, GridCoord.Create(1, 1))
End Function

Private Function GetDefaultCruiser() As IShip
    Set GetDefaultCruiser = Ship.Create(ShipNameCruiser, 3, Horizontal, GridCoord.Create(1, 1))
End Function

Private Function GetDefaultDestroyer() As IShip
    Set GetDefaultDestroyer = Ship.Create(ShipNameDestroyer, 2, Horizontal, GridCoord.Create(1, 1))
End Function

I'm not 100% convinced this is the best place to put the ship names and default ships.