Battleship UI: GameSheet

Question

In the previous post I presented the MVC architecture, but all we saw of the View was the pretty bits. From the outside everything looks innocently pretty:

Battleship game in progress

The guts of the worksheet's code-behind is a bit more... chaotic. Maybe not chaotic-evil, but chaotic nonetheless, despite the fact that it's really doing nothing more than exposing methods for the GridViewAdapter to interfact with, and handful of events for the GridViewAdapter to handle & relay to the game controller... I find there's too much code in there.

The UI involves a rather large number of named shapes (some clickable and thus attached to a sheet-local macro), so a lot of that code is just named (often indexed) properties that return a specific shape. The various shapes include the "player" buttons you click to pick your grid and opponent, the "fleet status" box, the ship pictures in it, and each individual "X" marker carefully positioned to cover each ship's peg holes; then there's a gigantic "HIT!", "MISS" and "SUNK" shape on each grid, and two "Game Over" shapes per grid (one winning, one losing), and in AI vs AI games there's an "acquired targets" box under each grid to show each player's enemy ships, with an "X" marker to mark sunken targets. Oh and then there's an "information" and "error" box with a clickable OK button to display various messages.

game screen with all shapes visible

The grid cells contain a hidden numeric value, and the white/red dots (and ships' preview/confirmed/illegal positions) are achieved using a custom conditional formatting:

custom conditional formatting configuration

These values correspond to the GridState enum values.

All feedback & cleanup ideas are welcome!

'@Folder("Battleship.View.Worksheet")
Option Explicit
Private Const InfoBoxMessage As String = _
 "ENEMY FLEET DETECTED" & vbNewLine & _
 "ALL SYSTEMS READY" & vbNewLine & vbNewLine & _
 "DOUBLE CLICK IN THE ENEMY GRID TO FIRE A MISSILE." & vbNewLine & vbNewLine & _
 "FIND AND DESTROY ALL ENEMY SHIPS BEFORE THEY DESTROY YOUR OWN FLEET!"
Private Const InfoBoxPlaceShips As String = _
 "FLEET DEPLOYMENT" & vbNewLine & _
 "ACTION REQUIRED: DEPLOY %SHIP%" & vbNewLine & vbNewLine & _
 " -CLICK TO PREVIEW" & vbNewLine & _
 " -RIGHT CLICK TO ROTATE" & vbNewLine & _
 " -DOUBLE CLICK TO CONFIRM" & vbNewLine & vbNewLine
Private Const ErrorBoxInvalidPosition As String = _
 "FLEET DEPLOYMENT" & vbNewLine & _
 "SYSTEM ERROR" & vbNewLine & vbNewLine & _
 " -SHIPS CANNOT OVERLAP." & vbNewLine & _
 " -SHIPS MUST BE ENTIRELY WITHIN THE GRID." & vbNewLine & vbNewLine & _
 "DEPLOY SHIP TO ANOTHER POSITION."
Private Const ErrorBoxInvalidKnownAttackPosition As String = _
 "TARGETING SYSTEM" & vbNewLine & vbNewLine & _
 "SPECIFIED GRID LOCATION IS ALREADY IN A KNOWN STATE." & vbNewLine & vbNewLine & _
 "NEW VALID COORDINATES REQUIRED."
Private previousMode As ViewMode
Private Mode As ViewMode
Private Random As IRandomizer
Public Event CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
Public Event SelectionChange(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
Public Event RightClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
Public Event DoubleClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
Public Sub OnNewGame()
 Application.ScreenUpdating = False
 Mode = NewGame
 ClearGrid 1
 ClearGrid 2
 LockGrids
 HideAllShapes
 ShowShapes HumanPlayerButton(1), _
 AIPlayerButton(1, RandomAI), _
 AIPlayerButton(1, FairplayAI), _
 AIPlayerButton(1, MercilessAI), _
 HumanPlayerButton(2), _
 AIPlayerButton(2, RandomAI), _
 AIPlayerButton(2, FairplayAI), _
 AIPlayerButton(2, MercilessAI)
 Me.Activate
 Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Activate()
 Set Random = New GameRandomizer
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, ByRef Cancel As Boolean)
 Cancel = True
 Dim gridId As Byte
 Dim position As IGridCoord
 Set position = RangeToGridCoord(target, gridId)
 RaiseEvent DoubleClick(gridId, position, Mode)
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
 Cancel = True
 If Mode = FleetPosition Then
 Dim gridId As Byte
 Dim position As IGridCoord
 Set position = RangeToGridCoord(target, gridId)
 RaiseEvent RightClick(gridId, position, Mode)
 End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
 Dim gridId As Byte
 Dim position As IGridCoord
 Set position = RangeToGridCoord(target, gridId)
 If Not position Is Nothing Then
 Me.Unprotect
 CurrentSelectionGrid(gridId).value = position.ToA1String
 CurrentSelectionGrid(IIf(gridId = 1, 2, 1)).value = Empty
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
 RaiseEvent SelectionChange(gridId, position, Mode)
 End If
End Sub
Public Function RangeToGridCoord(ByVal target As Range, ByRef gridId As Byte) As IGridCoord
 If target.Count > 1 Then Exit Function
 For gridId = 1 To 2
 With PlayerGrid(gridId)
 If Not Intersect(.Cells, target) Is Nothing Then
 Set RangeToGridCoord = _
 GridCoord.Create(xPosition:=target.Column - .Column + 1, _
 yPosition:=target.Row - .Row + 1)
 Exit Function
 End If
 End With
 Next
End Function
Public Function GridCoordToRange(ByVal gridId As Byte, ByVal position As IGridCoord) As Range
 With PlayerGrid(gridId)
 Set GridCoordToRange = .Cells(position.Y, position.X)
 End With
End Function
Public Sub ClearGrid(ByVal gridId As Byte)
 Me.Unprotect
 PlayerGrid(gridId).value = Empty
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub LockGrids()
 Me.Unprotect
 PlayerGrid(1).Locked = True
 PlayerGrid(2).Locked = True
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub UnlockGrid(ByVal gridId As Byte)
 Me.Unprotect
 PlayerGrid(gridId).Locked = False
 PlayerGrid(IIf(gridId = 1, 2, 1)).Locked = True
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub LockGrid(ByVal gridId As Byte)
 Me.Unprotect
 PlayerGrid(gridId).Locked = True
 PlayerGrid(IIf(gridId = 1, 2, 1)).Locked = False
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Private Property Get PlayerGrid(ByVal gridId As Byte) As Range
 Set PlayerGrid = Me.Names("PlayerGrid" & gridId).RefersToRange
End Property
Private Property Get CurrentSelectionGrid(ByVal gridId As Byte) As Range
 Set CurrentSelectionGrid = Me.Names("CurrentSelectionGrid" & gridId).RefersToRange
End Property
Private Property Get TitleLabel() As Shape
 Set TitleLabel = Me.Shapes("Title")
End Property
Private Property Get MissLabel(ByVal gridId As Byte) As Shape
 Set MissLabel = Me.Shapes("MissLabelGrid" & gridId)
End Property
Private Property Get HitLabel(ByVal gridId As Byte) As Shape
 Set HitLabel = Me.Shapes("HitGrid" & gridId)
End Property
Private Property Get SunkLabel(ByVal gridId As Byte) As Shape
 Set SunkLabel = Me.Shapes("SunkGrid" & gridId)
End Property
Private Property Get GameOverWinLabel(ByVal gridId As Byte) As Shape
 Set GameOverWinLabel = Me.Shapes("GameOverWinGrid" & gridId)
End Property
Private Property Get GameOverLoseLabel(ByVal gridId As Byte) As Shape
 Set GameOverLoseLabel = Me.Shapes("GameOverLoseGrid" & gridId)
End Property
Private Property Get InformationBox() As Shape
 Set InformationBox = Me.Shapes("InformationBox")
End Property
Private Property Get ErrorBox() As Shape
 Set ErrorBox = Me.Shapes("ErrorBox")
End Property
Private Property Get FleetStatusBox() As Shape
 Set FleetStatusBox = Me.Shapes("FleetStatusBox")
End Property
Private Property Get AcquiredTargetsBox(ByVal gridId As Byte) As Shape
 Set AcquiredTargetsBox = Me.Shapes("Grid" & gridId & "TargetsBox")
End Property
Private Property Get AcquiredTargetShip(ByVal gridId As Byte, ByVal shipName As String) As Shape
 Set AcquiredTargetShip = Me.Shapes("Grid" & gridId & "Target_" & VBA.Strings.Replace(shipName, " ", vbNullString))
End Property
Private Property Get ShipHitMarker(ByVal shipName As String, ByVal index As Byte) As Shape
 Set ShipHitMarker = Me.Shapes(VBA.Strings.Replace(shipName, " ", vbNullString) & "_Hit" & index)
End Property
Private Property Get SunkTargetMarker(ByVal gridId As Byte, ByVal shipName As String) As Shape
 Set SunkTargetMarker = Me.Shapes("Grid" & gridId & "TargetSunk_" & VBA.Strings.Replace(shipName, " ", vbNullString))
End Property
Private Property Get HumanPlayerButton(ByVal gridId As Byte) As Shape
 Set HumanPlayerButton = Me.Shapes("HumanPlayer" & gridId)
End Property
Private Property Get AIPlayerButton(ByVal gridId As Byte, ByVal difficulty As AIDifficulty) As Shape
 Select Case difficulty
 Case AIDifficulty.RandomAI
 Set AIPlayerButton = Me.Shapes("RandomAIPlayer" & gridId)
 Case AIDifficulty.FairplayAI
 Set AIPlayerButton = Me.Shapes("FairPlayAIPlayer" & gridId)
 Case AIDifficulty.MercilessAI
 Set AIPlayerButton = Me.Shapes("MercilessAIPlayer" & gridId)
 End Select
End Property
Private Sub HidePlayerButtons(Optional ByVal gridId As Byte)
 If gridId = 0 Then
 For gridId = 1 To 2
 HideShapes HumanPlayerButton(gridId), _
 AIPlayerButton(gridId, RandomAI), _
 AIPlayerButton(gridId, FairplayAI), _
 AIPlayerButton(gridId, MercilessAI)
 Next
 Else
 HideShapes HumanPlayerButton(gridId), _
 AIPlayerButton(gridId, RandomAI), _
 AIPlayerButton(gridId, FairplayAI), _
 AIPlayerButton(gridId, MercilessAI)
 End If
End Sub
Public Sub OnHumanPlayer1()
 HidePlayerButtons 1
 HideShapes HumanPlayerButton(2)
 RaiseEvent CreatePlayer(1, HumanControlled, Unspecified)
End Sub
Public Sub OnHumanPlayer2()
 HidePlayerButtons 2
 HideShapes HumanPlayerButton(1)
 RaiseEvent CreatePlayer(2, HumanControlled, Unspecified)
End Sub
Public Sub OnRandomAIPlayer1()
 HidePlayerButtons 1
 RaiseEvent CreatePlayer(1, ComputerControlled, RandomAI)
End Sub
Public Sub OnRandomAIPlayer2()
 HidePlayerButtons 2
 RaiseEvent CreatePlayer(2, ComputerControlled, RandomAI)
End Sub
Public Sub OnFairPlayAIPlayer1()
 HidePlayerButtons 1
 RaiseEvent CreatePlayer(1, ComputerControlled, FairplayAI)
End Sub
Public Sub OnFairPlayAIPlayer2()
 HidePlayerButtons 2
 RaiseEvent CreatePlayer(2, ComputerControlled, FairplayAI)
End Sub
Public Sub OnMercilessAIPlayer1()
 HidePlayerButtons 1
 RaiseEvent CreatePlayer(1, ComputerControlled, MercilessAI)
End Sub
Public Sub OnMercilessAIPlayer2()
 HidePlayerButtons 2
 RaiseEvent CreatePlayer(2, ComputerControlled, MercilessAI)
End Sub
Public Sub HideInformationBox()
 InformationBox.Visible = msoFalse
 Mode = previousMode
 If Mode = player1 Then
 UnlockGrid 2
 ElseIf Mode = player2 Then
 UnlockGrid 1
 End If
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub HideErrorBox()
 ErrorBox.Visible = msoFalse
 Mode = previousMode
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub ShowInfoBeginDeployShip(ByVal shipName As String)
 Mode = FleetPosition
 ShowFleetStatus
 ShowInformation Replace(InfoBoxPlaceShips, "%SHIP%", UCase$(shipName))
End Sub
Public Sub ShowInfoBeginAttackPhase()
 Mode = player1
 ShowInformation InfoBoxMessage
End Sub
Public Sub ShowErrorKnownPositionAttack()
 ShowError ErrorBoxInvalidKnownAttackPosition
End Sub
Public Sub RefreshGrid(ByVal grid As PlayerGrid)
 Application.ScreenUpdating = False
 Me.Unprotect
 PlayerGrid(grid.gridId).value = Application.WorksheetFunction.Transpose(grid.StateArray)
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
 Application.ScreenUpdating = True
End Sub
Private Sub ShowInformation(ByVal message As String)
 Me.Unprotect
 With InformationBox
 With .GroupItems("InformationBoxBackground")
 With .TextFrame
 .Characters.Delete
 .Characters.Text = vbNewLine & message
 .VerticalAlignment = xlVAlignTop
 .VerticalOverflow = xlOartVerticalOverflowEllipsis
 .HorizontalAlignment = xlHAlignLeft
 End With
 End With
 .Visible = msoTrue
 End With
 previousMode = Mode
 Mode = MessageShown
 Me.Protect
 Me.EnableSelection = xlNoSelection
End Sub
Public Sub ShowError(ByVal message As String)
 Me.Unprotect
 With ErrorBox
 With .GroupItems("ErrorBoxBackground")
 With .TextFrame
 .Characters.Delete
 .Characters.Text = vbNewLine & message
 .VerticalAlignment = xlVAlignTop
 .VerticalOverflow = xlOartVerticalOverflowEllipsis
 .HorizontalAlignment = xlHAlignLeft
 End With
 End With
 .Visible = msoTrue
 End With
 previousMode = Mode
 Mode = MessageShown
 Me.Protect
 Me.EnableSelection = xlNoSelection
End Sub
Public Sub HideAllShapes()
 Me.Unprotect
 Application.ScreenUpdating = False
 HideFleetStatus
 HideAcquiredTargetBoxes
 HideShapes InformationBox, ErrorBox
 Dim grid As Byte
 For grid = 1 To 2
 HideShapes HitLabel(grid), _
 SunkLabel(grid), _
 MissLabel(grid), _
 MissLabel(grid), _
 HumanPlayerButton(grid), _
 AIPlayerButton(grid, RandomAI), _
 AIPlayerButton(grid, FairplayAI), _
 AIPlayerButton(grid, MercilessAI), _
 GameOverWinLabel(grid), _
 GameOverLoseLabel(grid), _
 AcquiredTargetsBox(grid)
 Next
 Application.ScreenUpdating = True
 Me.Protect
End Sub
Public Sub ShowAllShapes()
'for debugging
 Application.ScreenUpdating = False
 ShowFleetStatus
 ShowAcquiredTargetBoxes
 ShowShapes InformationBox, ErrorBox
 Dim grid As Byte
 For grid = 1 To 2
 ShowShapes HitLabel(grid), _
 SunkLabel(grid), _
 MissLabel(grid), _
 MissLabel(grid), _
 HumanPlayerButton(grid), _
 AIPlayerButton(grid, RandomAI), _
 AIPlayerButton(grid, FairplayAI), _
 AIPlayerButton(grid, MercilessAI), _
 GameOverWinLabel(grid), _
 GameOverLoseLabel(grid), _
 AcquiredTargetsBox(grid)
 Next
 Application.ScreenUpdating = True
End Sub
Private Sub HideFleetStatus()
 HideShapes FleetStatusBox
 Dim shipFleet As Scripting.Dictionary
 Set shipFleet = Ship.Fleet
 Dim Names As Variant
 Names = shipFleet.Keys
 Dim sizes As Variant
 sizes = shipFleet.Items
 Dim currentName As Byte
 For currentName = LBound(Names) To UBound(Names)
 HideShipStatus Names(currentName)
 Dim position As Byte
 For position = 1 To sizes(currentName)
 HideShapes ShipHitMarker(Names(currentName), position)
 Next
 Next
End Sub
Private Sub HideAcquiredTargetBoxes()
 Dim shipFleet As Scripting.Dictionary
 Set shipFleet = Ship.Fleet
 Dim Names As Variant
 Names = shipFleet.Keys
 Dim gridId As Byte
 For gridId = 1 To 2
 AcquiredTargetsBox(gridId).Visible = msoFalse
 Dim currentName As Byte
 For currentName = LBound(Names) To UBound(Names)
 AcquiredTargetShip(gridId, Names(currentName)).Visible = msoFalse
 SunkTargetMarker(gridId, Names(currentName)).Visible = msoFalse
 Next
 Next
End Sub
Private Sub ShowAcquiredTargetBoxes()
 Dim shipFleet As Scripting.Dictionary
 Set shipFleet = Ship.Fleet
 Dim Names As Variant
 Names = shipFleet.Keys
 Dim gridId As Byte
 For gridId = 1 To 2
 AcquiredTargetsBox(gridId).Visible = msoTrue
 Dim currentName As Byte
 For currentName = LBound(Names) To UBound(Names)
 AcquiredTargetShip(gridId, Names(currentName)).Visible = msoTrue
 SunkTargetMarker(gridId, Names(currentName)).Visible = msoTrue
 Next
 Next
End Sub
Public Sub ShowAcquiredTarget(ByVal gridId As Byte, ByVal shipName As String, Optional ByVal sunken As Boolean = False)
 AcquiredTargetsBox(gridId).Visible = msoTrue
 AcquiredTargetShip(gridId, shipName).Visible = msoTrue
 SunkTargetMarker(gridId, shipName).Visible = IIf(sunken, msoTrue, msoFalse)
End Sub
Private Sub ShowFleetStatus()
 FleetStatusBox.Visible = msoTrue
End Sub
Private Sub HideShipStatus(ByVal shipName As String)
 Me.Shapes("FleetStatus_" & VBA.Strings.Replace(shipName, " ", vbNullString)).Visible = msoFalse
End Sub
Private Sub ShowShipStatus(ByVal shipName As String)
 Me.Shapes("FleetStatus_" & VBA.Strings.Replace(shipName, " ", vbNullString)).Visible = msoTrue
End Sub
Public Sub UpdateShipStatus(ByVal player As IPlayer, ByVal hitShip As IShip)
 Dim positions As Variant
 positions = hitShip.StateArray
 Dim currentPosition As Byte, currentMarker As Byte
 For currentPosition = LBound(positions) To UBound(positions)
 currentMarker = currentMarker + 1
 If positions(currentPosition) Then
 If player.PlayerType = HumanControlled Then
 ShipHitMarker(hitShip.Name, currentMarker).Visible = msoTrue
 Else
 'todo: update AI player targets
 End If
 End If
 Next
End Sub
Public Sub ShowAnimationMiss(ByVal gridId As Byte)
 FlashShape MissLabel(gridId), IIf(Random.NextSingle < 0.75, 1, IIf(Random.NextSingle < 0.75, 2, 3)), 10
End Sub
Public Sub ShowAnimationHit(ByVal gridId As Byte)
 FlashShape HitLabel(gridId), IIf(Random.NextSingle < 0.75, 1, IIf(Random.NextSingle < 0.75, 2, 3))
End Sub
Public Sub ShowAnimationSunk(ByVal gridId As Byte)
 FlashShape SunkLabel(gridId), IIf(Random.NextSingle < 0.75, 2, 4), 12
End Sub
Public Sub ShowAnimationVictory(ByVal gridId As Byte)
 GameOverWinLabel(gridId).Visible = msoTrue
 Mode = GameOver
End Sub
Public Sub ShowAnimationDefeat(ByVal gridId As Byte)
 FlashShape GameOverLoseLabel(gridId), 4
 GameOverLoseLabel(gridId).Visible = msoTrue
 Mode = GameOver
End Sub
Public Sub PreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)
 RefreshGrid player.PlayGrid
 Me.Unprotect
 With PlayerGrid(player.PlayGrid.gridId) _
 .Cells(1, 1) _
 .Offset(newShip.GridPosition.Y - 1, newShip.GridPosition.X - 1) _
 .Resize(RowSize:=IIf(newShip.Orientation = Vertical, newShip.Size, 1), _
 ColumnSize:=IIf(newShip.Orientation = Horizontal, newShip.Size, 1))
 .value = GridState.PreviewShipPosition
 End With
 Dim intersecting As GridCoord
 Set intersecting = player.PlayGrid.IntersectsAny(newShip.GridPosition, newShip.Orientation, newShip.Size)
 If Not intersecting Is Nothing Then
 PlayerGrid(player.PlayGrid.gridId).Cells(intersecting.Y, intersecting.X).value = GridState.InvalidPosition
 End If
 Me.Protect
 Me.EnableSelection = xlUnlockedCells
End Sub
Public Sub ConfirmShipPosition(ByVal player As IPlayer, ByVal newShip As IShip, ByRef confirmed As Boolean)
 If player.PlayGrid.CanAddShip(newShip.GridPosition, newShip.Orientation, newShip.Size) Then
 player.PlayGrid.AddShip newShip
 RefreshGrid player.PlayGrid
 ShowShipStatus newShip.Name
 confirmed = True
 Else
 ShowError ErrorBoxInvalidPosition
 End If
End Sub
Public Sub ShowShapes(ParamArray objects() As Variant)
 Win32API.ScreenUpdate False
 Dim i As Long, current As Shape
 For i = LBound(objects) To UBound(objects)
 Set current = objects(i)
 current.Visible = msoTrue
 Next
 Win32API.ScreenUpdate True
End Sub
Public Sub HideShapes(ParamArray objects() As Variant)
 Win32API.ScreenUpdate False
 Dim i As Long, current As Shape
 For i = LBound(objects) To UBound(objects)
 Set current = objects(i)
 current.Visible = msoFalse
 Next
 Win32API.ScreenUpdate True
End Sub
Private Sub FlashShape(ByVal target As Shape, ByVal flashes As Long, Optional ByVal Delay As Long = 8)
 Me.Unprotect
 target.Rotation = -10 + (Random.NextSingle * 20)
 'Target.Top = Target.Top - 10 + (random.NextSingle * 20)
 'Target.Left = Target.Left - 10 + (random.NextSingle * 20)
 ShowShapes target
 Sleep Delay * 10
 Dim i As Long
 For i = 0 To flashes - 1
 ShowShapes target
 Sleep Delay * 1.5
 HideShapes target
 Sleep Delay * 0.75
 Next
 ShowShapes target
 Sleep Delay * 20
 HideShapes target
 Me.Protect
End Sub

---

Update: The full code is now on GitHub!

• AJD: Again, don't have time to run a proper review answer. A quick thought for the Public Sub On[]PlayerX series could be collapsed into a single sub with two parameters (P1, P2 tag), looping twice over a Select Case and hiding/raising events as required. But I couldn't quickly see where they were called, so I may be missing something.
• AJD: The other thing that struck me was your use of shapes alongside the conditional formatting. If you simply fill the grid with the right number, the system will put the right shape in there and you would not have to manage and manipulate shapes. Again, I may be missing something here but that is because I have not spent the time to look at the code in context.
• Mathieu Guindon: Forgot to mention, OnXxxx public parameterless procedures are macros attached to shapes. It's the user clicking a button, basically. So nope, can't collapse =)
• Mathieu Guindon: The grid is updated by dumping the gridstate array into the worksheet; cond.formatting does the rest - the named shapes are the rest of the UI: the ships that appear on the right panel as you confirm them, the markers indicating their status, the HIT!, MISS, and SUNK animations, etc
• TinMan: I find it ironic that you name your constants using Pascal notation because you hate "All Caps" screaming at you but your constant values are in "All Caps".

Answer 1

One thing I'm confused about while reading this, is gridId as Byte - I assume it can only be 1 or 2 - ID of the player, unless I'm mistaken.

So in RangeToGridCoord you take the gridID ByRef, but why?

Public Function RangeToGridCoord(ByVal target As Range, ByRef gridId As Byte) As IGridCoord
 If target.Count > 1 Then Exit Function
 For gridId = 1 To 2
 With PlayerGrid(gridId)
 If Not Intersect(.Cells, target) Is Nothing Then
 Set RangeToGridCoord = _
 GridCoord.Create(xPosition:=target.Column - .Column + 1, _
 yPosition:=target.Row - .Row + 1)
 Exit Function
 End If
 End With
 Next
End Function

You call this function in three different worksheet events, passing a null gridId each time, then you make it iterate over both possibilities -

For gridID = 1 to 2

Maybe (read: definitely) I'm missing some interactions that occur from/to different game areas or mechanics, but this alone looks unnecessary. You're converting a target to a coordinate, but only for the player whose grid intersects that target - but unless a target is more than 1 cell, it can only ever intersect 1 or 0 player grids. Maybe this has something to do with the IGridCoord, but from here, on this question I don't understand the need for the loop - either it intersects or it doesn't, assuming you pass a non-null gridId to the function, right?

• Mathieu Guindon: Perhaps a better name would have been ByRef outGridId As GridId: given a Range, we don't know whether we're in grid 1 or in grid 2 until we intersect that range with the grids' range; since I don't want IGridCoord to have any knowledge of being in a grid, I'm returning this information as an out/ref parameter. And I agree, that Byte is bleeding everywhere and it's annoying; something like a GridId enum would fix that; GridId.Player1, or GridId.Player2.
• Raystafarian: So by design you give it a null that it evaluates to give you the Grid ID? And you do this byref because your function is otherwise returning a different result, and you want to capture this as well? Or am I misunderstanding?
• Mathieu Guindon: that's correct. well except for the null part (you give it a Byte reference, i.e. a local variable to return the result into) ;-) the idea of the function is that it returns an X,Y coordinate, given a Range on the game sheet - A1 is $S12ドル in grid 2, and $D12ドル in grid 1, as far as Excel knows. But the game doesn't care for the actual range addresses.

Answer 2

The IShip Conundrum

While writing my UI for the game I ran into several problems both trying to extend the Ship class and write my own class that implements the IShip interface.

The main issue I had writing my own Ship class was that 80+ percent of the code would be copied from the OP's Ship class. Where is the code reuse? Since the majority of the Ship code is consists of either settings or methods that need to be present in all IShip classes, I concluded an Abstract class was needed. This lead me to try to use the Ship class as a base class (similar the Answer - VBA: is there something like Abstract Class? .

After I subclassed the Ship class, I tried to replace the Ships that were being passed from the Controller to the View but found that it is not possible to do. Faced with this problem I tried to modify the Controller.

My approach to modifying the Controller was simply pass to replace the Ship factories in the Controller with a class instance that implemented IShip. I found that the Controller was dependent on the ShipKinds method of the Ship class and not the IShip interface. ShipKinds should be added to the IShip interface.

This lead me to think deeper on the roles and interactions of the IShip, Controller, and View. It seems that the Controller produces the IShips because the View cannot validate the IShip placement without know of the IPlayerGrid model. Is there a use case in which the Controller would need different versions of IShip...I don't think so. After all the Controller is responsible for managing the flow of interactions between the Model, View and Strategies not for modifying or using the IShips. The View, however, could definitely benefit by using custom IShip classes. It would be really convenient to have the Ships reference labels, images, divs or whatever that are responsible for rendering them. But is the View is the one would benefit the most from a custom IShp, why are the IShips immutable by the View?

I think a better setup would be to have the Controller request the IShips from the View for validation. This will allow the Controller to still be validating the IShips against the Model, while allowing the View to implement whichever type of IShip that it needs. This setup would also allow the same Controller to be used by all types of Views without modification.

At this point I decided to follow the script that was laid out by the WorksheetView class and everything fell in place nicely. After I got my prototype working and posted it to CR, I realized that I had made it much more complicated than it needed to be. My next prototype will probably contain 40% less VBA code.

Random Thoughts

Having to click the ShowInformation between each deployment is annoying. I would like to see this changed to a passive (non response) alert.

I would also like to see a ShipIndex property and DeploymentComplete method added to the IGridViewCommands interface. This would facilitate repositioning ships after their positions were confirmed.

What do you think of a (削除) MultiplayerHumanStrategy (削除ここまで) MultiPlayer Mode? The idea is to store each players ship and attack position information on a worksheet. The (削除) Strategies (削除ここまで) game could then take advantage of the new Co-Authoring feature to allow multiple players to play, in real-time, over a network.