Down the rabbit hole with MVP

Question

Following-up on this post where I implemented a Repository Pattern in vba to abstract ADODB and enable testing my Excel app without hitting a database backend; curious about how far vba would let me push inversion-of-control and loose coupling, I decided to grab the red pill, and see how deep the rabbit hole goes.

---

Presentation

With the original design, despite the decoupled data access, I still would have needed a form for every table I wanted to maitain, since the presentation logic was still coupled with the views.

I scratched that, and created a SimpleView form that I intended to use for anything I would want to maintain with that application, now or in the future.

design-time CRUD form

SimpleView form

Option Explicit
Private Type ViewModel
 Model As SqlResult
 Selection As SqlResultRow
 Callback As ICommandCallback
End Type
Private vm As ViewModel
Private minHeight As Integer
Private minWidth As Integer
Private layoutBindings As New List
Implements IView
Private Sub UserForm_Initialize()
 
 minHeight = Me.Height
 minWidth = Me.Width
 
 BindControlLayouts
 
End Sub
Private Sub BindControlLayouts()
 
 Dim backgroundImageLayout As New ControlLayout
 backgroundImageLayout.Bind Me, BackgroundImage, AnchorAll
 
 Dim closeButtonLayout As New ControlLayout
 closeButtonLayout.Bind Me, CloseButton, BottomAnchor + RightAnchor
 
 Dim itemsListLayout As New ControlLayout
 itemsListLayout.Bind Me, ItemsList, AnchorAll
 
 Dim addButtonLayout As New ControlLayout
 addButtonLayout.Bind Me, AddButton, RightAnchor
 
 Dim editButtonLayout As New ControlLayout
 editButtonLayout.Bind Me, EditButton, RightAnchor
 
 Dim showDetailsButtonLayout As New ControlLayout
 showDetailsButtonLayout.Bind Me, ShowDetailsButton, RightAnchor
 
 Dim deleteButtonLayout As New ControlLayout
 deleteButtonLayout.Bind Me, DeleteButton, RightAnchor
 
 layoutBindings.Add closeButtonLayout, _
 backgroundImageLayout, _
 itemsListLayout, _
 addButtonLayout, _
 editButtonLayout, _
 showDetailsButtonLayout, _
 deleteButtonLayout
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 Cancel = True
 Hide
End Sub
Private Sub UserForm_Resize()
 Application.ScreenUpdating = False
 If Me.Width < minWidth Then Me.Width = minWidth
 If Me.Height < minHeight Then Me.Height = minHeight
 
 Dim layout As ControlLayout
 For Each layout In layoutBindings
 layout.Resize Me
 Next
 Application.ScreenUpdating = True
End Sub
Public Property Get Model() As SqlResult
 Set Model = vm.Model
End Property
Public Property Set Model(ByVal value As SqlResult)
 Set vm.Model = value
 OnModelChanged
End Property
Public Property Get SelectedItem() As SqlResultRow
 Set SelectedItem = vm.Selection
End Property
Public Property Set SelectedItem(ByVal value As SqlResultRow)
 
 If (Not (value Is Nothing)) Then
 If (ObjPtr(value.ParentResult) <> ObjPtr(vm.Model)) Then
 
 Set value.ParentResult = vm.Model
 
 End If
 End If
 
 Set vm.Selection = value
 EvaluateCanExecuteCommands
 
End Property
Private Sub EvaluateCanExecuteCommands()
 AddButton.Enabled = vm.Callback.CanExecute(ExecuteAddCommand)
 CloseButton.Enabled = vm.Callback.CanExecute(ExecuteCloseCommand)
 DeleteButton.Enabled = vm.Callback.CanExecute(ExecuteDeleteCommand)
 EditButton.Enabled = vm.Callback.CanExecute(ExecuteEditCommand)
 ShowDetailsButton.Enabled = vm.Callback.CanExecute(ExecuteShowDetailsCommand)
End Sub
Public Sub Initialize(cb As ICommandCallback, ByVal ViewModel As SqlResult, ByVal title As String, ByVal commands As ViewAction)
 
 Localize title
 Set vm.Callback = cb
 Set Model = ViewModel
 
 AddButton.Visible = commands And ViewAction.Create
 EditButton.Visible = commands And ViewAction.Edit
 DeleteButton.Visible = commands And ViewAction.Delete
 ShowDetailsButton.Visible = commands And ViewAction.ShowDetails
 
End Sub
Private Sub Localize(ByVal title As String)
 
 Me.Caption = title
 CloseButton.Caption = GetResourceString("CloseButtonText")
 InstructionsLabel.Caption = GetResourceString("SimpleViewInstructionsText")
 AddButton.ControlTipText = GetResourceString("AddButtonToolTip")
 EditButton.ControlTipText = GetResourceString("EditButtonToolTip")
 DeleteButton.ControlTipText = GetResourceString("DeleteButtonToolTip")
 ShowDetailsButton.ControlTipText = GetResourceString("ShowDetailsButtonToolTip")
 
End Sub
Private Sub OnModelChanged()
 
 ItemsList.Clear
 If vm.Model Is Nothing Then Exit Sub
 vm.Model.ValueSeparator = StringFormat("\t")
 
 Dim row As SqlResultRow
 For Each row In vm.Model
 
 Set row.ParentResult = vm.Model
 ItemsList.AddItem row.ToString
 
 Next
 
End Sub
Private Sub AddButton_Click()
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteAddCommand
End Sub
Private Sub DeleteButton_Click()
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteDeleteCommand
End Sub
Private Sub CloseButton_Click()
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteCloseCommand
End Sub
Private Sub EditButton_Click()
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteEditCommand
End Sub
Private Sub ShowDetailsButton_Click()
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteShowDetailsCommand
End Sub
Private Sub ItemsList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 If vm.Callback.CallbackOwner Is Nothing Then Exit Sub
 vm.Callback.Execute ExecuteEditCommand
End Sub
Private Sub ItemsList_Change()
 If ItemsList.ListIndex >= 0 Then
 Set SelectedItem = vm.Model(ItemsList.ListIndex)
 Else
 Set SelectedItem = Nothing
 End If
End Sub
Private Sub IView_Initialize(cb As ICommandCallback, ByVal ViewModel As SqlResult, ByVal title As String, ByVal commands As ViewAction)
 Initialize cb, ViewModel, title, commands
End Sub
Private Property Get IView_CommandCallback() As ICommandCallback
 Set IView_CommandCallback = vm.Callback
End Property
Private Property Set IView_Model(ByVal value As SqlResult)
 Set Model = value
End Property
Private Property Get IView_Model() As SqlResult
 Set IView_Model = Model
End Property
Private Property Set IView_SelectedItem(ByVal value As SqlResultRow)
 Set SelectedItem = value
End Property
Private Property Get IView_SelectedItem() As SqlResultRow
 Set IView_SelectedItem = SelectedItem
End Property
Private Sub IView_Show()
 Show
End Sub
Private Sub IView_Hide()
 Hide
End Sub

---

Talking to someone you can't see

I was thrilled to see vba let me use the Implements keyword on a form, and do Implements IView. But when I went and created the IView interface, I was hoping to be able to use events, so that the view could tell the presenter about things such as "user clicked a button, do something about it".

The problem is that Implements doesn't support events. But instead of thinking "I guess that's the bottom of the rabbit hole", I came up with this:

CommandCallback class module

Option Explicit
Private owner As IPresenter
Private method As CallbackMethodName
Private methodNames As New Dictionary
Implements ICommandCallback
Private Sub Class_Initialize()
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteCloseCommand), "ExecuteCloseCommand"
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteAddCommand), "ExecuteAddCommand"
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteDeleteCommand), "ExecuteDeleteCommand"
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteEditCommand), "ExecuteEditCommand"
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteRefreshCommand), "ExecuteRefreshCommand"
 methodNames.Add "cb" & CStr(CallbackMethodName.ExecuteShowDetailsCommand), "ExecuteShowDetailsCommand"
End Sub
Public Property Get CallbackOwner() As IPresenter
 Set CallbackOwner = owner
End Property
Public Property Set CallbackOwner(ByVal value As IPresenter)
 Set owner = value
End Property
Public Function CanExecute(ByVal cb As CallbackMethodName) As Boolean
 If owner Is Nothing Then Exit Sub
 CanExecute = CallByName(owner, "Can" & methodNames("cb" & CStr(cb)), VbMethod)
End Function
Public Sub Execute(ByVal cb As CallbackMethodName)
 If owner Is Nothing Then Exit Sub
 CallByName owner, methodNames("cb" & CStr(cb)), VbMethod
End Sub
Private Property Set ICommandCallback_CallbackOwner(ByVal value As IPresenter)
 Set CallbackOwner = value
End Property
Private Property Get ICommandCallback_CallbackOwner() As IPresenter
 Set ICommandCallback_CallbackOwner = CallbackOwner
End Property
Private Function ICommandCallback_CanExecute(ByVal cb As CallbackMethodName) As Boolean
 ICommandCallback_CanExecute = CanExecute(cb)
End Function
Private Sub ICommandCallback_Execute(ByVal cb As CallbackMethodName)
 If ICommandCallback_CanExecute(cb) Then Execute cb
End Sub

---

Presenter Implementations

Presenter implementations are all going to be pretty similar, almost in a boring way. Here's one that implements every feature (other implementations may not be implementing all commands):

CustomerGroupsPreseter class module

Option Explicit
Private service As IRepository
Private details As IPresenter
Private vw As IView
Implements IPresenter
Public Property Get Repository() As IRepository
 Set Repository = service
End Property
Public Property Set Repository(ByVal value As IRepository)
 Set service = value
End Property
Public Property Get View() As IView
 Set View = vw
End Property
Public Property Set View(ByVal value As IView)
 Set vw = value
End Property
Public Property Get DetailsPresenter() As IPresenter
 Set DetailsPresenter = details
End Property
Public Property Set DetailsPresenter(ByVal value As IPresenter)
 Set details = value
End Property
Public Sub Show()
 Refresh
 View.Show
End Sub
Private Sub Refresh()
 Dim Model As SqlResult
 Set Model = service.GetAll
 Set View.Model = Model
End Sub
Private Function NewCustomerGroup(Optional ByVal id As Long = 0, Optional ByVal description As String = vbNullString) As SqlResultRow
 
 Dim result As SqlResultRow
 
 Dim values As New Dictionary
 values.Add "Id", id
 values.Add "Description", description
 
 Set result = Repository.NewItem(View.Model, values)
 Set NewCustomerGroup = result
 
End Function
Private Sub Class_Terminate()
 Unload View
End Sub
Private Function IPresenter_CanExecuteAddCommand() As Boolean
 IPresenter_CanExecuteAddCommand = True
End Function
Private Function IPresenter_CanExecuteCloseCommand() As Boolean
 IPresenter_CanExecuteCloseCommand = True
End Function
Private Function IPresenter_CanExecuteDeleteCommand() As Boolean
 IPresenter_CanExecuteDeleteCommand = Not View.SelectedItem Is Nothing
End Function
Private Function IPresenter_CanExecuteEditCommand() As Boolean
 IPresenter_CanExecuteEditCommand = Not View.SelectedItem Is Nothing
End Function
Private Function IPresenter_CanExecuteRefreshCommand() As Boolean
 IPresenter_CanExecuteRefreshCommand = True
End Function
Private Function IPresenter_CanExecuteShowDetailsCommand() As Boolean
 If View.SelectedItem Is Nothing Then Exit Function
 Dim detailsModel As SqlResult
 Set detailsModel = details.Repository.GetAll.WhereFieldEquals("CustomerGroupId", View.SelectedItem("Id"))
 
 IPresenter_CanExecuteShowDetailsCommand = detailsModel.Count > 0
 
End Function
Private Property Set IPresenter_DetailsPresenter(ByVal value As IPresenter)
 Set DetailsPresenter = value
End Property
Private Property Get IPresenter_DetailsPresenter() As IPresenter
 Set IPresenter_DetailsPresenter = DetailsPresenter
End Property
Public Sub ExecuteRefreshCommand()
 Set View.Model = Repository.GetAll
End Sub
Public Sub ExecuteShowDetailsCommand()
 Dim detailsModel As SqlResult
 Set detailsModel = details.Repository.GetAll.WhereFieldEquals("CustomerGroupId", View.SelectedItem("Id"))
 
 Set details.View.Model = detailsModel
 details.Show
End Sub
Private Sub IPresenter_ExecuteShowDetailsCommand()
 ExecuteShowDetailsCommand
End Sub
Public Sub ExecuteAddCommand()
 
 Dim description As String
 If Not RequestUserInput(prompt:="Please enter a description for the new CustomerGroup:", _
 title:="Edit", _
 outResult:=description, _
 default:="(new customer group)") _
 Then
 Exit Sub
 End If
 
 Repository.Add NewCustomerGroup(description:=description)
 Refresh
End Sub
Public Sub ExecuteCloseCommand()
 View.Hide
End Sub
Public Sub ExecuteDeleteCommand()
 Dim id As Long
 id = View.SelectedItem("id")
 
 Dim childRecords As Long
 childRecords = details.Repository.GetAll.WhereFieldEquals("CustomerGroupId", id).Count
 
 If childRecords > 0 Then
 MsgBox StringFormat("This item has {0} item(s) associated to it,\nit cannot be deleted.", childRecords), vbExclamation, "Attention!"
 Exit Sub
 End If
 
 If RequestUserConfirmation(StringFormat("Delete item #{0}?\n(this cannot be undone!)", id)) Then
 Repository.Remove id
 Refresh
 End If
End Sub
Public Sub ExecuteEditCommand()
 
 Dim id As Long
 id = View.SelectedItem("id")
 
 Dim description As String
 If Not RequestUserInput(prompt:=StringFormat("Please enter a new description for the CustomerGroup ID#{0}:", id), _
 title:="Edit", _
 outResult:=description, _
 default:=View.SelectedItem("description")) _
 Then
 Exit Sub
 End If
 
 Repository.Update id, NewCustomerGroup(id, description)
 Refresh
End Sub
Private Sub IPresenter_ExecuteAddCommand()
 ExecuteAddCommand
End Sub
Private Sub IPresenter_ExecuteCloseCommand()
 ExecuteCloseCommand
End Sub
Private Sub IPresenter_ExecuteDeleteCommand()
 ExecuteDeleteCommand
End Sub
Private Sub IPresenter_ExecuteEditCommand()
 ExecuteEditCommand
End Sub
Private Sub IPresenter_ExecuteRefreshCommand()
 ExecuteRefreshCommand
End Sub
Private Property Let IPresenter_MasterId(ByVal value As Long)
'not implemented
End Property
Private Property Get IPresenter_MasterId() As Long
'not implemented
End Property
Private Property Set IPresenter_Repository(ByVal value As IRepository)
 Set Repository = value
End Property
Private Property Get IPresenter_Repository() As IRepository
 Set IPresenter_Repository = Repository
End Property
Private Sub IPresenter_Show()
 Show
End Sub
Private Property Set IPresenter_View(ByVal value As IView)
 Set View = value
End Property
Private Property Get IPresenter_View() As IView
 Set IPresenter_View = View
End Property

This implementation is a "master" presenter, if it were a "details" presenter, the MasterId property would be properly implemented, and the DetailsPresenter might be left out; other implementations may not respond to Add and Delete commands - hence, for each data table I'll want to maintain, I'll have to implement an IPresenter.

---

Wait, it's localized, too?

In case you're curious about this GetResourceString function that's used in the forms; one of the requirements is to have the application display in English on English systems, and in French on French systems; so I implemented a Resources code module:

Resources code module

Option Explicit
Public Enum Culture
 EN_US = 1033
 EN_UK = 2057
 EN_CA = 4105
 FR_FR = 1036
 FR_CA = 3084
End Enum
Private resourceSheet As Worksheet
Public Sub Initialize()
 
 Dim languageCode As String
 
 Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
 
 Case Culture.EN_CA, Culture.EN_UK, Culture.EN_US:
 languageCode = "EN"
 
 Case Culture.FR_CA, Culture.FR_FR:
 languageCode = "FR"
 
 Case Else:
 languageCode = "EN"
 
 End Select
 Set resourceSheet = Worksheets("Resources." & languageCode)
 
End Sub
Public Function GetResourceString(ByVal resourceName As String) As String
 
 Dim resxTable As ListObject
 If resourceSheet Is Nothing Then Initialize
 Set resxTable = resourceSheet.ListObjects(1)
 
 Dim i As Long
 For i = 1 To resxTable.ListRows.Count
 Dim lookup As String
 lookup = resxTable.Range(i + 1, 1)
 If lookup = resourceName Then
 GetResourceString = resxTable.Range(i + 1, 2)
 Exit Function
 End If
 Next
 
End Function

That's right: I'm hiding two worksheets in that workbook, named Resources.EN and Resources.FR and each containing a table (ListObject) that contains English and French string resources:

SimpleView with English resources SimpleView with French resources

• Blackhawk: "The problem is that Implements doesn't support events." <--- this :'(

Answer 1

There's usually very little I can say about your code, but maybe if I just start going down line by line I'll find something. I'm hoping someone else who knows more about mvp and dependency-injection come along as well.

Simple Form

• I don't see Types uses very often in vba. Normally when I do, what is really needed is a class. I don't think that's the case here, but if ViewModel changes down the road, it's not hard to switch.
• I think Selection would be less ambiguous as SelectedRow.
• Ummmm........ vm..... I know VB being case insensitive sucks, but couldn't you have at least dsmvwld it? I bet you were avoiding (gasp) hungarian notation. Given the choice between vm and vwModel, I'll take the dsmvwld hngNotation.
• I would probably use a couple of constants in UserForm_Initialize over Me.Height and Me.Width. It's too easy to change it accidentally in design mode.
• BindControlLayout looks good. I like the use of bitwise enumeration.
• UserForm_Resize Needs to have an error handler. Anytime you turn screen updating off, you'll need an error handler. Just in case.
• Okay, now I see why you went with vm and Selection. The user form has properties Model and SelectedItem. Naming is hard in vb. You could still use SelectedItem for the ViewModel Type though. I don't think it would cause any confusion.
• The localization is really frickin' cool. Seriously. That's cool. But, you've now bound the code to this specific workbook. What if you want to reuse this somewhere else? You're this far down the rabbit hole, why not create an interface that implements a dicitonary? I'm pretty sure I remember reading somewhere that you can leverage .Net's dictionary if the framework is installed on your users machines. (Hint: The .Net framework is installed on practically every windows machine.)
• All of the Click events have to check If vm.Callback.CallbackOwner Is Nothing. There's some duplication here, but I don't feel it's a big deal. You might consider creating a boolean function, but that might be overkill. (cough-cough it is cough-cough)

Ok, so I only touched on the "Simple Form" (and just a bit on resources), but I suspect I could only give more of the same kind of advice. So, I'll leave the rest of the code for someone else.

• Mathieu Guindon: The code is actually tied to an Excel workbook anyway; I could export the form and import it in another VBA project, localization will work as long as there's a [Resources.EN] worksheet. I used a private type to help a bit with naming clashes.. but yeah, naming is hard, especially in a case-insensitive language! Nice review! :)
• RubberDuck: That's a really good point. I hadn't thought about that. In that case you should take some precautions. You wouldn't want an ambitious user making their way into those hidden sheets. Password protect the workbook maybe? In Access I'd "compile" the project into an *.accde file. I don't know what options there are for Excel. (Thanks btw. Cool project.)

Answer 2

There's an itchy spot with extensibility: because an implementing class must implement all members of the IPresenter interface, adding new commands is quickly becoming a painful experience.

Say you have a view that has a MoveUpButton and a MoveDownButton. With the way it is right now, you'll have to add 4 methods to the IPresenter interface, and modify every single existing implementation accordingly, even if the other implementations don't need to implement these methods.

Instead of having ExecuteXxxxxxCommand and CanExecuteXxxxxxCommand methods for every command, design interfaces so as to avoid ever having to modify it in the future:

Public Sub ExecuteCommand(ByVal commandId As CommandType)
End Sub
Public Function CanExecuteCommand(ByVal commandId As CommandType) As Boolean
End Function

By passing in a CommandType enum parameter, you can now easily extend the design (by simply adding a new enum value for the new command) and add new commands without having to modify the IPresenter interface.