Code Insights with Rubberduck + Excel

You’re writing a rather large VBA/VB6 project, and you’re starting to have a sizable amount of passing unit tests. Did you know you can copy the test results to the clipboard with a single click?

…and then paste them onto a new worksheet and turn it into a data table:

If you’re not sure what to do next, you can even let Excel give you ideas – you’ll find the Recommended Charts button under the Insert Ribbon tab:

With the count of method by component chart, we can see what test modules have more test methods; the sum of duration by component chart can show us which test modules take the longer to execute – or we could average it across test categories, or archive test results and later aggregate them… and then use this data to performance-profile problematic test scenarios.

Similarly, the “Copy to Clipboard” button from the Code Explorer can be used to export a table into Excel, and using the recommended pivot tables feature, we can get a detailed breakdown of the project – for example count of names by declaration type creates a pivot table that lists all Rubberduck declaration types, so you can easily know how many line labels your project has, or how many Declare Function imports are used:

With a little bit of filtering and creativity, we can regroup all Constant, Function, PropertyGet and Variable declarations by return type, and easily identify, say, everything that returns a Variant:

The possibilities are practically endless: the data could be timestamped and exported to some Access or SQL Server database, to feed some dashboard or report showing how a project grows over time.

How would you analyze your VBA projects? What code metrics would you like to be able to review and pivot like this? Share your ideas, or implement them, and send a pull request our way!

Advertisements

Introducing the Reference Explorer

Back in the 2.1.x announcement post over a whole year ago, one of the bullet points about the upcoming roadmap said we were going to “make you never want to use the VBE’s Project References dialog ever again“; it took a bit longer than expected, but as far as we can tell, this feature does exactly that.

If you’ve been following the project on social media recently, you already know that the next version of Rubberduck will introduce a very exciting, unique new feature: the Reference Explorer dialog, and the addition of a references node in the Code Explorer tree.

Vanilla-VBE

Since forever, adding a reference to the active project in the VBE is a rather… vanilla experience. Functional, but somewhere between bland and tedious.

What’s wrong with it?

Regardless of what we think of the very 1998-era buttons docked on the side, the dialog works. There’s a list of available libraries (sorted alphabetically), we can browse for unlisted ones, cancel or accept changes, and the libraries that are selected when the dialog is displayed, are conveniently shown at the top of the list!

On a closer look though…

The vanilla-VBE project references dialog
  1. The list of available libraries has the available libraries listed in alphabetical order. You can’t resize the dialog to show more, but you get first-key search. The Scripting runtime’s library name starts with “Microsoft”… which happens to also be the case for a few other libraries; this makes the extremely useful Scripting.Dictionary and Scripting.FileSystemObject classes pretty much hidden until you stumble upon a blog post or a Stack Overflow answer that introduces them.
  2. The selected libraries show up at the top of the list, in priority order. Locked libraries are stacked at the top. You use the up/down arrow buttons to move the selected library up or down, but you can’t move the locked ones.
  3. The priority buttons are used to determine the identifier resolution order; if an identifier exists in two or more libraries, VBA/VB6 binds to the type defined in the library with the highest priority. There’s no visual cue in the list itself to identify the locked-in type libraries, so the Enabled state of these buttons is used to convey that information: you can’t move the locked-in, default references.
  4. The bottom panel is useful… but the path gets cropped if it’s longer than the rather narrow dialog can fit, and you can’t select or copy the text. The actual library version number isn’t shown.

Visual Studio

Let’s take a look at what adding a project reference using the latest version of Microsoft Visual Studio feels like:

The Microsoft Visual Studio 2017 Reference Manager dialog

The dialog can be resized, search is no longer limited to a single character, but still limited to the beginning of the [Name]. The library info is now richer; it moved to the right side, and a panel on the left side determines the contents of the list. Other than that, besides a new [Version] column and a nice dark theme, …the mechanics are pretty much the same as they were 20 years ago: check boxes in a list. Priority is no longer relevant in .NET though – namespaces fixed that.

Rubberduck

This screenshot was taken shortly before the pull request was opened:

The Rubberduck ‘Add/Remove References’ dialog (work in process: release build may differ)
  1. Available libraries appear in a list on the left-hand side of the dialog. Like in Visual Studio, the version number appears next to the library name, and the list is sorted alphabetically. There is no checkbox: instead, the selected library can be moved into the list of referenced libraries.
  2. Referenced libraries appear in a list on the right-hand side of the dialog. Since there is no checkbox, the selected library can be moved back into the list of available libraries.
  3. Priority up/down buttons appear for the selected referenced library, unless it’s locked.
  4. Icons differentiate locked libraries, libraries that were already referenced when the dialog was shown, and libraries that were newly added. In the list of available libraries, recent and pinned libraries have an icon too.
  5. Search works on a “contains” basis, and matches the library name, description, and path. It immediately filters the list of available libraries.
  6. Tabs for quickly accessing type libraries recently referenced, or pinned libraries, or registered. Host-specific project types are in a separate tab, as applicable.
  7. Bottom panel displays the full name and path of the selected type library. The text can be selected and copied into the clipboard.
  8. Browse button allows referencing any project/library that isn’t listed anywhere. If a library can’t be loaded, it will appear in the list as a broken reference, before it’s even tentatively added to the project.

If you haven’t seen it in action yet, here’s a sneak peek:

Of course that’s just the beginning: layout is not completely final, drag-and-drop functionality remains to-do, among other enhancements.

A first iteration of this feature will likely be merged some time next week, and since this is a major, completely new feature, we’ll bump the minor version and that will be Rubberduck 2.4.0, to be released by the end of 2018…

…not too long after the imminent 2.3.1 hotfix release.

If you think this is one of the coolest things a VBE add-in could possibly do, you’re probably not alone. Share the news, and star us on GitHub!

Introducing Rubberduck v2.3.0

Version 2.2.0 was released in April 2018. Well over 1,700 commits and 2,185 modified files later, Rubberduck is now more stable than ever, and well overdue for a new release. November 25th will see Rubberduck 2.3 issued – as of this writing, we’re ironing a few wrinkles, but everything looks like we’re on track to release some time this Sunday.

A tremendous amount of effort went into the core, the engine, and the brain: the number of situations causing inspection false positives is on a serious decline, and we’ve taken very important steps towards ensuring proper tear-down of every component. Rubberduck 2.3 is by far the most stable release to date, and all the invisible work lays the foundation for the very exciting things to come.

We’re all extremely proud to present the results of so many months of hard work! Here’s a non-exhaustive overview of the new features (versus 2.2.0).

Official VB6 IDE Support

As of v2.3.0 (with special thanks to @mansellan), Rubberduck officially works in Visual Studio 6.0, the glorious, the… legendary VB6 IDE.

That’s right: code inspections, code metrics, all navigation enhancements, unit testing, refactorings, …all your favorite Rubberduck features, in the Visual Basic 6.0 editor.

VB6

This is without a doubt the biggest improvement to ever come to the VB6 IDE this century, from an open-source project.

As is the case for VBA hosts, if you already have Smart Indenter installed, Rubberduck will detect the legacy 32-bit add-in and prompt to import your settings – note that configuring Rubberduck’s indenter will not affect your Smart Indenter settings.


Autocompletion Enhancements

Rubberduck now changes how typing code in the editor feels. If you ever edited VBA/VB6 code in Notepad++ (let alone VB.NET code in the latest Visual Studio), you know that the VBE shows its age when you type a " double quote or open a ( parenthesis. With Rubberduck, typing code in the VBE will now feel radically different than without, in a very good way. A new dedicated settings page makes it easy to enable/disable each feature separately, and leaves room for future customization and enhancements.

Due to its rather invasive nature, a design decision was made to ship autocompletion features disabled by default; these features must be enabled manually, in the autocompletion settings tab of Rubberduck’s “Settings” dialog:

AutoCompleteSettings-v2.3

Self-Closing Pairs

It’s hard to describe everything enabling SCP completion does. A picture is worth a thousand words, so… how about seeing them in action?

When {BACKSPACE} is pressed and the caret immediately follows any opening token, Rubberduck attempts to locate and remote the matching closing token, wherever it is on the current logical line of code – nested or not.

Smart Concatenation

When enabled, Rubberduck will step in when the {ENTER} key is pressed while the caret is inside a string literal, to automatically append ” & _” to the current line.

The feature can also be configured so that when the {CTRL} key is held down when {ENTER} is pressed, ” & vbNewLine & _” will be appended to the current line.

{BACKSPACE} cleanly reverts smart-concatenation when the caret is on the last line of the logical code line and the caret line contains nothing but the opening & closing quotes.

Block Completion

Block completion will be implemented early in the 2.3.x cycle: these settings have no effect whatsoever for now.

The vision for this feature, is to capture “trigger” keywords (e.g. For), select them; if {TAB} or {ENTER} is pressed (as configured) when the “trigger” is selected (among other conditions), then the block expands, and Rubberduck automatically highlights a placeholder expression; hitting {TAB} again selects the next placeholder, {SHIFT}+{TAB} the previous. Providing a value for the last placeholder places the caret inside the block, indented as per indenter settings.

Auto-correct

Later in the 2.3.x cycle, auto-completion will be further enhanced with an “auto-correct” feature, which will enable automatically expanding e.g. foo++ into foo = foo + 1, among other ideas… including automatic fixing of a configurable list of “frequent typos”.


New Inspections

As with every new Rubberduck release, the team implemented a number of new inspections. This release introduces an internal API for code path analysis, which allows us to start implementing the more involved inspections on our plate!

These new inspections bring the total number to 75!

AssignmentNotUsed

The first inspection to leverage code path analysis, will now flag this code:

foo = 42 ' <~ value is never used
foo = 10
Debug.Print foo

When an assignment is subsequently discarded before the stored value is accessed, Rubberduck will notify about the redundant assignment, as a code quality issue.

DuplicatedAnnotation

This inspection, spliced from the existing “illegal annotation” inspection, helps validate/sanitize Rubberduck annotations – for example, contradicting @Folder annotations:

'@Folder("Foo")
'@Folder("Bar")

ExcelUdfNameIsValidCellReference

An Excel-specific inspection that flags public functions that are visible as worksheet user-defined functions (UDF), but shadowed by a cell reference. This inspection is particularly useful with recent 64-bit versions of Microsoft Excel, where 16,384 columns effectively reserve every 3-letter combination up to “XFC”.

Public Function Foo123() As String
'FOO123 is a valid cell reference; function cannot be invoked!
End Function

This first iteration only inspects public functions in standard procedural modules.

IsMissingOnInappropriateArgument

A rather specific inspection validating usages of IsMissing, flagging instances where the function is given a non-Variant argument.

Public Sub DoSomething(Optional ByVal foo As String)
    If IsMissing(foo) Then ' condition is always false
    End If
End Sub

IsMissingWithNonArgumentParameter

Another inspection validating usages of IsMissing, flagging instances where the function is given a non-parameter argument.

Public Sub DoSomething()
    Dim foo As Variant
    If IsMissing(foo) Then ' condition is always false
    End If
End Sub

ObsoleteCallingConvention

CDecl calling convention isn’t supported on Windows; Declare statements using it should be wrapped with conditional compilation directives so as to only compile in a Mac environment.

Private Declare Sub Beep CDecl Lib "kernel32" (dwFreq As Any, dwDuration As Any)

ObsoleteMemberUsage

Rubberduck 2.3 introduces a new @Obsolete annotation, which can be used for annotating “obsolete” procedures – the inspection flags usages of procedures marked with this annotation.

OnLocalError

The Local token is redundant in On Error statements. This inspection flags usages.

Private Sub DoSomething()
    On Local Error GoTo ErrHandler
    '...
    Exit Sub
ErrHandler:
End Sub

The rationale being, runtime errors are always local; the two syntaxes look different but do exactly the same thing.


v2.3.x

There are a number of features that were intended to be developed for 2.2.x, that didn’t make it into this release – not because the ideas were dropped, but because of mere time constraints. The add/remove references dialog is one such feature. Keep an eye out on 2.3.x pre-release builds and announcements; the v2.4 announcement will recap everything that happened in 2.3.x, but every new feature will very likely see its own dedicated blog post as it is merged and pre-released.

Clean VBA Code pt.2: Avoiding implicit code

Clean code adheres to a number of principles. Does adhering to these principles make good code? Maybe, maybe not. But it definitely helps. One thing I find myself repeating quite a lot in my more recent Stack Overflow answers, is that code should “say what it does, and do what it says” – to me this means writing explicit code. Not just having  Option Explicit specified, but avoiding the pitfalls of various “shortcuts” VBA lets us use to… cheat ourselves.

Avoid implicit member calls, write code that says what it does, and does what it says.  Instead of:

Cells(i, 2) = 42

 
Prefer explicit qualifiers, and explicit member calls:

ActiveSheet.Cells(i, 2).Value = 42

In Excel, avoid working with ActiveSheet when you mean to work with Sheet1. Use the Worksheets collection instead of the Sheets collection when you mean to retrieve a worksheet in a workbook; sheets can contain charts and other non-worksheet sheet types.

Dim targetBook As Workbook
Set targetBook = Application.Workbooks.Open(path)

Dim targetSheet As Worksheet
Set targetSheet = targetBook.Worksheets("Sheet1")

Debug.Print targetSheet.Range("A1").Value

If the sheet we need exists in ThisWorkbook at compile-time, then we don’t need a variable for it – it already exists:

Debug.Print Sheet1.Range("A1").Value

Every sheet in your Excel VBA project has a code name that you can set to any valid VBA module identifier name (up to 31 characters), and that identifier is now accessible from anywhere in your VBA project. To change the name, modify the (Name) property in the properties toolwindow (F4).


About the Bang! operator…

Avoid the Bang! operator. How many of the people using it know that the identifier to the right of the operator is a string literal that isn’t compile-time validated? It looks like early-bound code, but it isn’t. The Bang! operator is an implicit default member call against a default member that takes a string parameter. So this:

rs.Fields!Field1 = 42

Is really this:

rs.Fields.Item("Field1").Value = 42

Now, this doesn’t mean we have to go crazy and dogmatic here – default properties are idiomatic, and not necessarily toxic… when used carefully. The Item member of a collection class is, by convention, the default member of the class:

rs.Fields("Field1").Value = 42

Note that Fields is plural, which strongly signals that ("Field1") is an indexed  property accessor (it is)… and we could even infer that it returns a Field object reference. There’s an implicit default member call happening, yes, but it’s pure syntax sugar here: even if we don’t know that Fields is a class with a default Item property, we can tell that syntactically, we’re invoking something, getting an object reference back and assigning its Value property with a value.

Contrast with rs.Fields!Field1 = 42, which reads like… witchcraft, come to think of it.

As an Excel programmer I’m biased though: Access programmers probably see the Bang! operator differently. After all, it’s everywhere, in every tutorial – why would it suddenly be wrong?

Pros:

  • Faster to type (?).
  • Encourages using standard PascalCase field names and collection keys. Kinda.

Cons:

  • Confusing syntax for an unfamiliar reader; makes a string look like a member access. That one’s arguably on the reader/maintainer to read up, yes. Still.
  • No compile-time validation: what follows the ! operator is a string. Option Explicit will not save you from a typo.
  • If any explicit member call follows the string, it is inherently late-bound and not compile-time validated either; the editor will offer no intellisense for it.
  • Requires otherwise rather uncommon [square bracket] tokens around the name when the name contains spaces.

You have to put the Bang! operator in context: 25 years ago, using fully spelled-out variable names was seen as wasteful and borderline ludicrous. Code was written to be executed, not read: the faster you could type, the better. Oh, how things have changed!

Here’s a screenshot from an old, deleted Stack Overflow question about the Bang! operator in… VB.NET:

BangOperator

The Bang! operator is a relic of the past. There’s no reason to use it in modern code, be it in VBA, VB6… or VB.NET.

Clean VBA Code pt.1: Bad Habits

We know clean code when we see it. Clean code is a pleasure to read and maintain. Clean code makes its purpose obvious, and is easily extended or modified. I cannot recommend Robert C. Martin’s Clean Code: A Handbook of Agile Software Craftsmanship enough – to me it was an eye opener. Code examples are in Java, but the principles are mostly language-agnostic – and the realization that the vast majority of it could also be applied to VBA changed how I saw VBA code, quite radically over time.

Sometimes deeply rooted, some habits we’ve been carrying since forever – things we never even thought for a split-second could be second-guessed, things VBA programmers do, stem from how code was written back in the 1990’s.

VBA is essentially stuck in 1998. Most of its commonly agreed-upon best practices are from another era, and while developers in every single other language moved on to more modern conventions, a lot of VBA folks are (sometimes firmly) holding on to coding practices that are pretty much universally considered harmful today: this has to be part of why so many programmers dread maintaining VBA code so much.

Is Rubberduck enforcing any of this?

Rubberduck will never force you to change your coding style. If we implemented an inspection inspired by any of these guidelines, it was to make it easy to identify the code that doesn’t adhere to them – every inspection in Rubberduck can be disabled through inspection settings. You own your code, you’re in charge. Rubberduck is just there to help take action if you want to, not to boss you around.

Bad Habits

In no particular order:

Systems Hungarian

If you haven’t read Joel Spolsky’s excellent Making Wrong Code Look Wrong yet, by all means take the time now – it’s a very, very good read, and throughout the years I must have read it a dozen times, and linked to it a hundred times.

Done and bookmarked? Ok. So now you know Hungarian Notation was never intended to encode data types into variable names, and that this practice only came into existence because of an unfortunate misunderstanding. The intent was to use short prefixes to identify the kind of variable (not its data type), in the context of the application. This is Apps Hungarian – as opposed to Systems Hungarian. The former is very useful and still relevant to this day, the latter is essentially useless clutter. No modern naming best-practices encourage this unfortunate prefixing scheme – it may be a hard one to unlearn, but it’s worth it. Plus it spares the world from this …gem:

Dim oRange As Range

v-for-variant, i-for-integer, l-for-long (what one has to be the worst), s-for-string (or worse, “str”), o-for-object… all are useless prefixes that serve no purpose, obscure a variable’s name, and that’s just when they’re correct: when they’re incorrect or inconsistent, they start getting distracting and bug-inducing, on top of just being mildly annoying …or amusing. What does strString As String (the ultimate tautology!) tell you about the purpose of a parameter? That’s right, nothing at all.

Disemvoweling

In BASIC 2.0 on a Commodore-64 you had a whole 2 meaningful characters to name your variables. You could use more, but the first 2 had to be unique.

How awesome is it that things have changed! In VBA an identifier can be up to 255 characters long. Programming isn’t about writing code, at least 90% of it is about reading code. The handful of keystrokes you’re saving are turning into tenfold the amount of time wasted investigating the meaning of these cryptic variables.

Stop stripping the vowels from variable names for no reason: they’re essential to convey meaning (at least without needing to then clarify in a comment). The few spared keystrokes aren’t worth all the “fun” you’ll have re-reading that code in a year’s time.

Wall of Declarations

I was taught to begin all procedure scopes with the declarations for all the variables in that scope, supposedly to enhance readability. For years, it seemed like a good idea – until I had to debug a 700-liner legacy procedure that started with a literal wall of declarations… with half of them not used anywhere, and the whole thing taking up more than a whole screen’s height. In fact, every single time I answered (or commented on) a question on Stack Overflow and noticed a variable wasn’t used anywhere, there was a wall of declarations at the top of the procedure.

Declare variables where you’re using them. That way you’ll never need to wonder if a variable is used or not, and you’ll never waste considerable time constantly scrolling up & back down, then back up, then down, when debugging a large procedure.

Code that is easy to maintain, is code that is easy to modify, and thus easy to refactor. Having 10 lines of declarations at the top of a procedure scope isn’t working in that direction: as the code changes, the maintainer will be more inclined to keep the style that’s in place, i.e. to append to the list of declarations so as to keep all the declarations together… whereas if there’s no such list in the first place, starting one will look wrong.

Banner Comments

Procedures should be responsible for a little as possible. One thing, ideally. Whenever there’s a comment that looks like this in the body of a procedure:

'==== reticulate splines ====

It’s a missed opportunity: the procedure wants that chunk of code extracted into its own ReticulateSplines scope, taking in parameters for whatever local variables it’s using… and this ties back to the Wall of Declarations: if the variables are declared close to where they’re first used, then extracting that chunk of code and knowing what declarations to bring over to the new scope, becomes much easier… and accidentally leaving unused variables behind is in turn much harder to do now.

Banner comments literally scream “I’m doing to many things!” – don’t split procedures with banner comments. Write smaller procedures instead.

Snake_Case_Naming

Everywhere you look, in every standard type library you can include in a VBA project, everything uses a standard PascalCase naming style. By adopting a consistent PascalCase naming scheme, you make your code blend in seamlessly. But this isn’t just a personal preference thing: Snake_Case cannot be consistently applied to any object-oriented code written in VBA, because you can’t have a method named Do_Something on an interface. The compiler will simply refuse to consider InterfaceName_Do_Something as valid: because you used Snake_Case on a public member name, your code is now broken and can’t be compiled anymore. And if you drop the underscores just for interface methods, then you’re no longer using a consistent naming style, and that’s a problem when consistency is king (and it is!).

(to be continued…)

Lazy Object / Weak Reference

Sometimes a class needs to hold a reference to the object that “owns” it – i.e. the object that created it. When this happens, the owner object often needs to hold a reference to all the “child” objects it creates. If we say Class1 is the “parent” and Class2 is the “child”, we get something like this:

'Class1
Option Explicit
Private children As VBA.Collection

Public Sub Add(ByVal child As Class2)
    Set child.Owner = Me
    children.Add child
End Sub

Private Sub Class_Initialize()
    Set children = New VBA.Collection
End Sub

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

And Class2 might look like this:

'Class2
Option Explicit
Private parent As Class1

Public Property Get Owner() As Class1
    Set Owner = parent
End Property

Public Property Set Owner(ByVal value As Class1)
    Set parent = value
End Property

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

The problem might not be immediately apparent to untrained eyes, but this is a memory leak bug – this code produces no debug output, despite the Class_Terminate handlers:

'Module1
Option Explicit

Public Sub Test()
    Dim foo As Class1
    Set foo = New Class1
    foo.Add New Class2
    Set foo = Nothing
End Sub

Both objects remain in memory and outlive the Test procedure scope! Depending on what the code does, this could easily go from “accidental sloppy object management” to a serious bug leaving a ghost process running, with Task Manager being the only way to kill it! How do we fix this?

Not keeping a reference to Class1 in Class2 would fix it, but then Class2 might not be working properly. Surely there’s another way.

Suppose we abstract away the very notion of holding a reference to an object. Suppose we don’t hold an object reference anymore, instead we hold a Long integer that represents the address at which we’ll find the object pointer we’re referencing. To put it in simpler words, instead of holding the object itself, we hold a ticket that tells us where to go find it when we need to use it. We can do this in VBA.

First we define an interface that encapsulates the idea of an object reference – IWeakReference, that simply exposes an Object get-only property:

'@Description("Describes an object that holds the address of a pointer to another object.")
'@Interface
Option Explicit

'@Description("Gets the object at the held pointer address.")
Public Property Get Object() As Object
End Property

Then we implement it with a WeakReference class. The trick is to use CopyMemory from the Win32 API to take the bytes at a given address and copy them into an object reference we can use and return.

For an easy-to-use API, we give the class a default instance by toggling the VB_PredeclaredId attribute, and use a factory method to create and return an IWeakReference given any object reference: we take the object’s object pointer using the ObjPtr function, store/encapsulate that pointer address into a private instance field, and implement the IWeakReference.Object getter such that if anything goes wrong, we return Nothing instead of bubbling a run-time error.

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

#If Win64 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
#End If

Private Type TReference
#If VBA7 Then
    Address As LongPtr
#Else
    Address As Long
#End If
End Type

Private this As TReference

'@Description("Default instance factory method.")
Public Function Create(ByVal instance As Object) As IWeakReference
    With New WeakReference
        .Address = ObjPtr(instance)
        Set Create = .Self
    End With
End Function

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

#If VBA7 Then
Public Property Get Address() As LongPtr
#Else
Public Property Get Address() As Long
#End If
    Address = this.Address
End Property

#If VBA7 Then
Public Property Let Address(ByVal Value As LongPtr)
#Else
Public Property Let Address(ByVal Value As Long)
#End If
    this.Address = Value
End Property

Private Property Get IWeakReference_Object() As Object
' Based on Bruce McKinney's code for getting an Object from the object pointer:

#If VBA7 Then
    Dim pointerSize As LongPtr
#Else
    Dim pointerSize As Long
#End If

    On Error GoTo CleanFail
    pointerSize = LenB(this.Address)

    Dim obj As Object
    CopyMemory obj, this.Address, pointerSize

    Set IWeakReference_Object = obj
    CopyMemory obj, 0&, pointerSize

CleanExit:
    Exit Property

CleanFail:
    Set IWeakReference_Object = Nothing
    Resume CleanExit
End Property

Now Class2 can hold an indirect reference to Class1, like this:

'Class2
Option Explicit
Private parent As IWeakReference

Public Property Get Owner() As Class1
    Set Owner = parent.Object
End Property

Public Property Set Owner(ByVal Value As Class1)
    Set parent = WeakReference.Create(Value)
End Property

Private Sub Class_Terminate()
    Debug.Print TypeName(Me) & " is terminating"
End Sub

Now Module1.Test produces the expected output, and the memory leak is fixed:

Class1 is terminating
Class2 is terminating

Understanding ‘Me’ (no flowers, no bees)

You may have read that Me was a keyword, or that it was some kind of “special object that’s built into Excel”; or, you might have inferred that it’s some kind of hidden instance/module-level variable that’s only there in class/form/document modules: that’s pretty much how I was understanding Me, until I saw what the language specifications say about it (emphasis mine):

Within the <procedure-body> of a procedure declaration that is defined within a <class-module-code-section> the declared type of the reserved name Me is the named class defined by the enclosing class module and the data value of Me is an object reference to the object that is the target object of the currently active invocation of the function.

So Me is a reserved name… and it only exists in procedure scope; the type being the class it’s used in makes it easy for IntelliSense to know what the members are, but its value is ultimately provided by the caller – from section 5.3.1.5 “Parameter lists”:

Each procedure that is a method has an implicit ByVal parameter called the current object that corresponds to the target object of an invocation of the method. The current object acts as an anonymous local variable with procedure extent and whose declared type is the class name of the class module containing the method declaration. […]

In other words when you do this:

Dim foo As Class1
Set foo = New Class1
foo.DoSomething 42

What really happens under the hood is something like this:

Dim foo As Class1
Set foo = New Class1
Class1.DoSomething foo, 42

So every parameterless method you ever wrote like this:

Public Sub DoSomething()
End Sub

Is understood by VBA as this (assuming that method is in Class1):

Public Sub DoSomething(ByVal Me As Class1)
End Sub

…which, interestingly, is pretty much the same mechanics as the this pointer in C++.

So Me isn’t a magic keyword, and doesn’t have anything whatsoever to do with Excel (or whatever your VBA host application is) – Me is simply a reserved name that allows us to refer to this hidden current object pointer inside a procedure scope, and that current object is whichever instance of the current class the calling code is working with.

OOP Battleship Part 4: AI Strategies

NewGame

If you recall the AIPlayer class from Part 2, the Create factory method takes an IGameStrategy parameter:

Public Function Create(ByVal gridId As Byte, ByVal GameStrategy As IGameStrategy) As IPlayer
    With New AIPlayer
        .PlayerType = ComputerControlled
        .GridIndex = gridId
        Set .Strategy = GameStrategy
        Set .PlayGrid = PlayerGrid.Create(gridId)
        Set Create = .Self
    End With
End Function

An AIPlayer can be created with an instance of any class that implements the IGameStrategy interface.

In any OOP language that supports class inheritance, we could have a base class e.g. GameStrategyBase, from which we could derive the various implementations, and with that we would have a place to write all the code that’s common to all implementations, …or that all implementations would possibly need to use… or not. See, class inheritance is the most important language feature that the “VBA can’t do OOP” or “VBA is not a real language” crowd love to bring up. And yet, more often than not, class inheritance isn’t the ideal solution – composition is.

And we’re going to do exactly that, by composing all IGameStrategy implementations with a GameStrategyBase class:

Battleship.AI

Coupling a game strategy with this “base” class isn’t an issue: the class is specifically meant to be used by IGameStrategy implementations. So we can shamelessly do this:

Option Explicit
Implements IGameStrategy
Private base As GameStrategyBase

Private Sub Class_Initialize()
    Set base = New GameStrategyBase
End Sub

And then proceed with implementing the PlaceShip method, given that AI player’s own PlayerGrid and the IShip the game controller is asking us to place on the grid. The base.PlaceShip method simply returns the first legal position+direction it can find.

Then we can implement the Play function to return an IGridCoord position and let the controller know what position this player is shooting at. We have a number of helper functions in GameStrategyBase we can use for that.

Random

The RandomShotStrategy shoots at random coordinates until it has located all enemy ships …then proceeds to sink them all, one after the other. It also places its ships randomly, regardless of whether the ships are adjacent or not.

Private Sub IGameStrategy_PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)

    Dim direction As ShipOrientation
    Dim position As IGridCoord
    Set position = base.PlaceShip(Random, grid, currentShip, direction)

    grid.AddShip Ship.Create(currentShip.ShipKind, direction, position)
    If grid.shipCount = PlayerGrid.ShipsPerGrid Then grid.Scramble

End Sub

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
    Dim position As IGridCoord
    Do
        If EnemyShipsNotAcquired(enemyGrid)  0 Then
            Set position = base.ShootRandomPosition(Random, enemyGrid)
        Else
            Set position = base.DestroyTarget(Random, enemyGrid, enemyGrid.FindHitArea)
        End If
    Loop Until base.IsLegalPosition(enemyGrid, position)
    Set IGameStrategy_Play = position
End Function

Here the double-negative in the statement “the number of enemy ships not acquired, is not equal to zero” (WordPress is having a hard time with rendering that  operator, apparently), will probably be end up being inverted into a positive statement, which would make it read better. Perhaps If EnemyShipsToFind = 0 Then, and invert the Else logic. Or…

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
    Dim position As IGridCoord
    Do
        If EnemyShipsToFind(enemyGrid) > 0 Then
            Set position = base.ShootRandomPosition(Random, enemyGrid)
enemyGrid.FindHitArea)
        Else
            Set position = base.DestroyTarget(Random, enemyGrid,
        End If
    Loop Until base.IsLegalPosition(enemyGrid, position)
    Set IGameStrategy_Play = position
End Function

That EnemyShipsToFind function should probably be a member of the PlayerGrid class.

FairPlay

The FairPlayStrategy is similar, except it will proceed to destroy an enemy ship as soon as it’s located. It also takes care to avoid placing ships adjacent to each other.

Private Sub IGameStrategy_PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)
    Do
        Dim direction As ShipOrientation
        Dim position As IGridCoord
        Set position = base.PlaceShip(Random, grid, currentShip, direction)

    Loop Until Not grid.HasAdjacentShip(position, direction, currentShip.Size)

    grid.AddShip Ship.Create(currentShip.ShipKind, direction, position)
    If grid.shipCount = PlayerGrid.ShipsPerGrid Then grid.Scramble
End Sub

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
    Dim position As GridCoord
    Do
        Dim area As Collection
        Set area = enemyGrid.FindHitArea

        If Not area Is Nothing Then
            Set position = base.DestroyTarget(Random, enemyGrid, area)
        Else
            Set position = base.ShootRandomPosition(Random, enemyGrid)
        End If
    Loop Until base.IsLegalPosition(enemyGrid, position)
    Set IGameStrategy_Play = position
End Function

Merciless

The MercilessStrategy is more elaborate: it doesn’t just shoot at random – it shoots in patterns, targeting the edges and/or the center areas of the grid. It will destroy an enemy ship as soon as it’s found, and will avoid shooting in an area that couldn’t possibly host the smallest enemy ship that’s still afloat. And yet, it’s possible it just shoots a random position, too:

Private Sub IGameStrategy_PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)
    Do
        Dim direction As ShipOrientation
        Dim position As IGridCoord
        Set position = base.PlaceShip(Random, grid, currentShip, direction)
    Loop Until Not grid.HasAdjacentShip(position, direction, currentShip.Size)

    grid.AddShip Ship.Create(currentShip.ShipKind, direction, position)
    If grid.shipCount = PlayerGrid.ShipsPerGrid Then grid.Scramble
End Sub

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
    Dim position As GridCoord
    Do
        Dim area As Collection
        Set area = enemyGrid.FindHitArea

        If Not area Is Nothing Then
            Set position = base.DestroyTarget(Random, enemyGrid, area)
        Else
            If this.Random.NextSingle < 0.1 Then
                Set position = base.ShootRandomPosition(this.Random, enemyGrid)
            ElseIf this.Random.NextSingle < 0.6 Then
                Set position = ScanCenter(enemyGrid)
            Else
                Set position = ScanEdges(enemyGrid)
            End If
        End If

    Loop Until base.IsLegalPosition(enemyGrid, position) And _
               base.VerifyShipFits(enemyGrid, position, enemyGrid.SmallestShipSize) And _
               AvoidAdjacentHitPosition(enemyGrid, position)
    Set IGameStrategy_Play = position
End Function

In most cases (ScanCenter and ScanEdges do), the AI doesn’t even care to “remember” the last hit it made: instead, it asks the enemy grid to give it a “hit area”. It then proceeds to analyze whether that area is horizontal or vertical, and then attempts to extend it further.

It’s Open-Source!

I uploaded the complete code to GitHub: https://github.com/rubberduck-vba/Battleship.

OOP Battleship Part 3: The View

Download the macro-enabled Excel workbook here

Now that we have defined our model, we need a view. In MVC terms, the view is the component that’s making the game state visible to the player; it is responsible for the two-way communication with the controller. Since we’re in Microsoft Excel, we can use a worksheet to do this. So we craft a lovely-looking Battleship game screen:

pgyam

I used a stock image for the background, spent more time than I probably should have looking for images of the game ships, and used a number of rounded rectangle shapes to make various boxes and buttons – the clickable ones being attached to sheet-local macros. The two game grids use a customized 5-icon conditional format that not-so-coincidentally map to the GridState enum values:

jxpfw

If you recall from the previous post, the GridState enum was defined as follows:

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

The PlayerGrid class has a StateArray read-only property that returns a 2D variant array with Unknown values being Empty, and the rest of the state values being returned as-is: this means in order to “refresh” the view, all we need to do is dump this 2D variant array onto the appropriate game grid, and we’re done!

Private Property Get PlayerGrid(ByVal gridId As Byte) As Range
    Set PlayerGrid = Me.Names("PlayerGrid" & gridId).RefersToRange
End Property

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

Listing all the code here like I did for the model post would be rather boring, so I’m not going to do that. If the model was just a handful of classes with factory methods and explicit interfaces, the view is much more interesting as a concept.

The worksheet handles 3 worksheet events:

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)
    If Mode = FleetPosition Or Mode = player1 And gridId = 2 Or Mode = player2 And gridId = 1 Then
        RaiseEvent DoubleClick(gridId, position, Mode)
    End If
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

Notice these aren’t doing anything really – they merely work out a way to talk to another component – see, making a worksheet (or any document module class) implement an interface is a very bad idea: don’t do it (unless you like to crash the host and lose everything). So instead, we make another class implement the “view” interfaces, and make that class talk to the worksheet – a bit like we did in There is no worksheet.

The view needs two interfaces: one for the controller to send messages to the view, and the other for the view to send messages to the controller. If we call controller-to-view messages “commands”, and view-to-controller messages “events”, then the names IGridViewEvents and IGridViewCommands make complete sense!

So the WorksheetView class (not the GameSheet worksheet) implements the IGridViewCommands interface, like this:

Private Sub IGridViewCommands_OnBeginAttack(ByVal currentPlayerGridId As Byte)
    sheetUI.ShowInfoBeginAttackPhase currentPlayerGridId
End Sub

Private Sub IGridViewCommands_OnBeginShipPosition(ByVal currentShip As IShip, ByVal player As IPlayer)
    sheetUI.ShowInfoBeginDeployShip currentShip.Name
End Sub

Private Sub IGridViewCommands_OnBeginWaitForComputerPlayer()
    Application.Cursor = xlWait
    Application.StatusBar = "Please wait..."
End Sub

the WorksheetView class also handles the custom events sent from the worksheet, like this:

Private Sub sheetUI_DoubleClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    Select Case Mode
        
        Case ViewMode.FleetPosition
            ViewEvents.ConfirmShipPosition gridId, position
            
        Case ViewMode.player1, ViewMode.player2
            ViewEvents.AttackPosition gridId, position
            
    End Select
End Sub

Private Sub sheetUI_PlayerReady()
    ViewEvents.HumanPlayerReady
End Sub

Private Sub sheetUI_RightClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    If Mode = FleetPosition Then ViewEvents.PreviewRotateShip gridId, position
End Sub

Private Sub sheetUI_SelectionChange(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    If Mode = FleetPosition Then ViewEvents.PreviewShipPosition gridId, position
End Sub

So what is this ViewEvents? If VBA allowed an interface to expose events, we wouldn’t need it: we would simply raise an event to relay the message directly to the controller, who would then handle the view events and respond with a command back to the view. But VBA does not let us expose events on an interface, so this is where the adapter pattern kicks in.

We have a GridViewAdapter class that implements both IGridViewEvents and IGridViewCommands interfaces; the WorksheetView holds a (weak) reference to the adapter, through its IGridViewEvents interface – so ViewEvents.AttackPosition is a method on the adapter.

The GridViewAdapter class receives these messages from the view, and relays them back to the controller, via events:

Private Sub IGridViewEvents_AttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnAttackPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_ConfirmShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnConfirmCurrentShipPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
    RaiseEvent OnCreatePlayer(gridId, pt, difficulty)
End Sub

Private Sub IGridViewEvents_HumanPlayerReady()
    RaiseEvent OnPlayerReady
End Sub

Private Sub IGridViewEvents_PreviewRotateShip(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnRotateCurrentShipPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_PreviewShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnPreviewCurrentShipPosition(gridId, position)
End Sub

The GameController has a Private WithEvents viewAdapter As GridViewAdapter private field, and with that it’s able to respond to the adapter’s events and, say, create a HumanPlayer in grid 1, or a MercilessAI AI player in grid2 – and then instruct the view to begin positioning the ships, one by one, until the game is ready to begin.

Apart from events, the worksheet exposes methods that display, hide, or flash such or such shape, depending on what the controller says needs to happen next: the worksheet doesn’t control anything whatsoever about the game mechanics – that’s the controller’s job. The view raises events, the adapter handles them and relays them to the controller; controller alters game state, and then sends a command to the view to reflect the current state.

This makes the controller blissfully unaware about any worksheet, or event about any WorksheetView class: it knows about the GridViewAdapter, but then looking at how the game is started…

Public Sub PlayWorksheetInterface()
    Dim view As WorksheetView
    Set view = New WorksheetView
    
    Dim randomizer As IRandomizer
    Set randomizer = New GameRandomizer
    
    Set controller = New GameController
    controller.NewGame GridViewAdapter.Create(view), randomizer
End Sub

…we can easily infer that the adapter would work with any class that implements the IGridViewCommands interface and that’s able to “adapt” its event model to the IGridViewEvents methods: the components are said to be decoupled; we can easily swap one implementation for another – be it for unit-testing the individual components… or we could implement a view that has nothing to do with any Excel worksheet.

We could easily add another button to the start screen, attach it to some PlayUserFormInterface macro, and do something like this:

Public Sub PlayUserFormInterface()
    Dim view As UserFormView
    Set view = New UserFormView
    
    Dim randomizer As IRandomizer
    Set randomizer = New GameRandomizer
    
    Set controller = New GameController
    controller.NewGame GridViewAdapter.Create(view), randomizer
End Sub

And then play the exact same game with a UI that’s entirely different.

OOP Battleship Part 2: The Model

Download the macro-enabled Excel workbook here

Merciless.png
“Merciless” AI (Player1) this close to winning this game

So we’re making a game of Battleship, and we’re going to do this using an object-oriented pattern called Model-View-Controller (MVC). The first thing we need to do, is to modelize the problem in terms of objects. We’re going to need:

  • Player object, so that we know who’s playing on which grid. A player might be human or computer-controlled, and a player has a grid.
  • PlayerGrid object, so that we know the state of each player’s game grid; a player’s grid has a number of ships on it.
  • Ship object that we can place on a player’s grid. A ship has a size and an orientation – we can place them anywhere on the grid, horizontally or vertically; a ship is also going to need to know where it’s hit and whether it’s sunken.
  • GridCoordinate object, to encapsulate X and Y positions and make it easy to pass these two values together as a single entity. This object could have an Offset method that gives us another coordinate at a relative X or Y position.

These objects solve the problem space of modelizing a game of Battleship: with them we have everything we need to track game state. We’ll need something else that can make the players take turns at shooting missiles at each other’s grid, but that will be the controller‘s job; we’ll also need something else that can display the game state and take a human user’s inputs, but that will be the view‘s job. The role of the model is to encapsulate the data that we need to manipulate, and with these objects we’ve got everything we need… for now.

GridCoordinate

Let’s start with the grid coordinates system, since that is our smallest building block, and a grid coordinate doesn’t need to know about a ship or a player interface. We want a grid coordinate to be read-only: once an instance is created for position A1, it’s A1 and remains A1. We want to be able to determine if two grid coordinates are the same without needing to check for both X and Y coordinates every time, and a function that returns True when a coordinate is adjacent to another would be useful, too. Next we’ll want a string representation of the coordinate that lines up with the A1 notation of the game grid, but it would also be useful to have a (x,y) representation that can easily round-trip from a string to a grid coordinate and back, without needing to work out the column number for H.

So the IGridCoord interface would look like this:

'@Folder("Battleship.Model")
'@Description("Describes a coordinate in a 2D grid.")
'@Interface
Option Explicit

'@Description("Gets the horizontal position.")
Public Property Get X() As Long
End Property

'@Description("Gets the vertical position.")
Public Property Get Y() As Long
End Property

'@Description("Creates and returns a new coordinate by offsetting this instance.")
Public Function Offset(Optional ByVal xOffset As Long, Optional ByVal yOffset As Long) As IGridCoord
End Function

'Description("Returns True if the specified coordinate is adjacent to this instance.")
Public Function IsAdjacent(ByVal other As IGridCoord) As Boolean
End Function

'@Description("Returns True if the specified coordinate describes the same location as this instance.")
Public Function Equals(ByVal other As IGridCoord) As Boolean
End Function

'@Description("Returns a (x,y) string representation of this instance.")
Public Function ToString() As String
End Function

'@Description("Returns a A1 string representation of this instance.
Public Function ToA1String() As String
End Function

We’re making it an interface, because otherwise there would be no way of exposing X and Y properties as read-only values. Now we’re going to be writing the game against this IGridCoord interface, rather than against the GridCoord class directly. In order to make it easy to create a grid coordinate by providing an X and an Y value, we’ll give the class a predeclared ID, and use its default instance not to store state, but to expose convenient factory methods.

The listing includes module attributes, so don’t juse copy-paste this in the VBE: you need to import it in a VBA project for it to work.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "GridCoord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'@Folder("Battleship.Model")
'@IgnoreModule UseMeaningfulName; X and Y are perfectly fine names here.
Option Explicit
Implements IGridCoord

Private Type TGridCoord
    X As Long
    Y As Long
End Type

Private this As TGridCoord

Public Function Create(ByVal xPosition As Long, ByVal yPosition As Long) As IGridCoord
    With New GridCoord
        .X = xPosition
        .Y = yPosition
        Set Create = .Self
    End With
End Function

Public Function FromString(ByVal coord As String) As IGridCoord
    coord = Replace(Replace(coord, "(", vbNullString), ")", vbNullString)

    Dim coords As Variant
    coords = Split(coord, ",")

    If UBound(coords) - LBound(coords) + 1  2 Then Err.Raise 5, TypeName(Me), "Invalid format string"

    Dim xPosition As Long
    xPosition = coords(LBound(coords))

    Dim yPosition As Long
    yPosition = coords(UBound(coords))

    Set FromString = Create(xPosition, yPosition)
End Function

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

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

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

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

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

Public Property Get Default() As IGridCoord
    Set Default = New GridCoord
End Property

Public Function ToString() As String
    ToString = "(" & this.X & "," & this.Y & ")"
End Function

Private Function IGridCoord_Equals(ByVal other As IGridCoord) As Boolean
    IGridCoord_Equals = other.X = this.X And other.Y = this.Y
End Function

Private Function IGridCoord_IsAdjacent(ByVal other As IGridCoord) As Boolean
    If other.Y = this.Y Then
        IGridCoord_IsAdjacent = other.X = this.X - 1 Or other.X = this.X + 1
    ElseIf other.X = this.X Then
        IGridCoord_IsAdjacent = other.Y = this.Y - 1 Or other.Y = this.Y + 1
    End If
End Function

Private Function IGridCoord_Offset(Optional ByVal xOffset As Long, Optional ByVal yOffset As Long) As IGridCoord
    Set IGridCoord_Offset = Create(this.X + xOffset, this.Y + yOffset)
End Function

Private Function IGridCoord_ToString() As String
    IGridCoord_ToString = Me.ToString
End Function

Private Function IGridCoord_ToA1String() As String
    IGridCoord_ToA1String = Chr$(64 + this.X) & this.Y
End Function

Private Property Get IGridCoord_X() As Long
    IGridCoord_X = this.X
End Property

Private Property Get IGridCoord_Y() As Long
    IGridCoord_Y = this.Y
End Property

So from the default instance, we have access to Create and FromString factory methods, a convenient Default property that gives a (0,0) default coordinate that should be equivalent to the class’ default instance; the writable X and Y properties are meant for instance state: they make no sense outside a factory method.

And now we can create and use a grid coordinate like this:

Dim position As IGridCoord
Set position = GridCoord.Create(3, 4)
Debug.Print position.ToA1String

We can also write a suite of test methods that validate that our GridCoord class behaves as expected in every case… and then make a PlayerGrid class, to represent each player’s grid.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "PlayerGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'@Folder("Battleship.Model.Player")
Option Explicit

Private Const GridSize As Byte = 10
Private Const MaxShipsPerGrid As Byte = 5

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 GridSize, 1 To GridSize) As GridState
End Type

Private this As TPlayGrid

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

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

Of course there’s more to it, but just listing it here would get boring – the important part is that there’s a GridState array, and a collection of ships. And then these GridState and AttackResult enums.

One important method is TryHit, which is the mechanism that sets the internal state to PreviousHit or PreviousMiss, depending on whether there’s a ship at the specified position – and if there’s one, we return a ByRef reference to it, so that the controller can tell the view to update that ship’s status:

'@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 IGridCoord, 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

Another important function is FindHitArea, which the AI player uses when it wants to hunt down a damaged ship – it returns a collection of collections of previously hit grid positions, that the AI player can then analyze to try and infer a direction:

'@Description("Finds area around a damaged ship, if one exists.")
Public Function FindHitArea() As Collection
    Dim currentShip As IShip
    For Each currentShip In this.ships
        If Not currentShip.IsSunken Then
            Dim currentAreas As Collection
            Set currentAreas = currentShip.HitAreas
            If currentAreas.Count > 0 Then
                Set FindHitArea = currentAreas(1)
                Exit Function
            End If
        End If
    Next
End Function

Lastly, the Scamble method is invoked for AI players’ grid – it replaces confirmed ship positions with unknown states, so that the AI enemy ships are hidden. Without this method, the AI-positioned ships would be in plain sight!

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

Player

What is a player? What does it need to be able to do? We know a player will need to be associated with a game grid; we know a player can be human or computer-controlled. And if we break down the game into individual steps, we can tell we’ll need a player to be able to place a ship on its grid, and – given the enemy grid, be able to tell the game where it’s going to be shooting next. So we can already have an IPlayer interface that formalizes this contract:

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

Public Enum PlayerType
    HumanControlled
    ComputerControlled
End Enum

'@Description("Identifies whether the player is human or computer-controlled.")
Public Property Get PlayerType() As PlayerType
End Property

'@Description("Gets the player's grid/state.")
Public Property Get PlayGrid() As PlayerGrid
End Property

'@Description("Places specified ship on game grid.")
Public Sub PlaceShip(ByVal currentShip As IShip)
End Sub

'@Description("Attempts to make a hit on the enemy grid.")
Public Function Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
End Function

The HumanPlayer implementation is rather boring – PlaceShip and Play do nothing. The AIPlayer implementation is much more interesting:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "AIPlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'@Folder("Battleship.Model.Player")
Option Explicit
Implements IPlayer

Private Const Delay As Long = 800

Private Type TPlayer
    GridIndex As Byte
    PlayerType As PlayerType
    PlayGrid As PlayerGrid
    Strategy As IGameStrategy
End Type

Private this As TPlayer

Public Function Create(ByVal gridId As Byte, ByVal GameStrategy As IGameStrategy) As IPlayer
    With New AIPlayer
        .PlayerType = ComputerControlled
        .GridIndex = gridId
        Set .Strategy = GameStrategy
        Set .PlayGrid = PlayerGrid.Create(gridId)
        Set Create = .Self
    End With
End Function

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

Public Property Get Strategy() As IGameStrategy
    Set Strategy = this.Strategy
End Property

Public Property Set Strategy(ByVal value As IGameStrategy)
    Set this.Strategy = value
End Property

Public Property Get PlayGrid() As PlayerGrid
    Set PlayGrid = this.PlayGrid
End Property

Public Property Set PlayGrid(ByVal value As PlayerGrid)
    Set this.PlayGrid = value
End Property

Public Property Get GridIndex() As Byte
    GridIndex = this.GridIndex
End Property

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

Public Property Get PlayerType() As PlayerType
    PlayerType = this.PlayerType
End Property

Public Property Let PlayerType(ByVal value As PlayerType)
    this.PlayerType = value
End Property

Private Property Get IPlayer_PlayGrid() As PlayerGrid
    Set IPlayer_PlayGrid = this.PlayGrid
End Property

Private Sub IPlayer_PlaceShip(ByVal currentShip As IShip)
    this.Strategy.PlaceShip this.PlayGrid, currentShip
End Sub

Private Function IPlayer_Play(ByVal enemyGrid As PlayerGrid) As IGridCoord
    Win32API.Sleep Delay
    Set IPlayer_Play = this.Strategy.Play(enemyGrid)
End Function

Private Property Get IPlayer_PlayerType() As PlayerType
    IPlayer_PlayerType = this.PlayerType
End Property

Notice the Play and PlaceShip methods aren’t actually implemented in the AIPlayer class; instead, we inject an IGameStrategy and that is what polymorphism allows us to do: we can now inject an instance of a class that implements a given strategy, and we can extend the game with another AI, without even changing a single line of existing AIPlayer code!

NewGame.png