8
\$\begingroup\$

Based on my understanding of Model View Presenter (MVP) I have it generate a diagram. Is this a correct implementation of MVP?

What deficiencies are there in my implementation?

UI

enter image description here

Generated diagram

enter image description here

The code

'LoadingModule class
'@Folder("Model")
Option Explicit

Private Type THelper
    PointLoads As Long
    DistributedLoads As Long
    LeftSupport As BoundaryCondition
    RightSupport As BoundaryCondition
    SpanCondition As SpanType
End Type

Private this As THelper

Public Property Get PointLoadsCount() As Long
    PointLoadsCount = this.PointLoads
End Property

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

Public Property Get DistributedLoadsCount() As Long
    DistributedLoadsCount = this.DistributedLoads
End Property

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

Public Property Get LeftBoundaryCondition() As BoundaryCondition
    LeftBoundaryCondition = this.LeftSupport
End Property

Public Property Let LeftBoundaryCondition(ByVal value As BoundaryCondition)
    this.LeftSupport = value
End Property

Public Property Get RightBoundaryCondition() As BoundaryCondition
    RightBoundaryCondition = this.RightSupport
End Property

Public Property Let RightBoundaryCondition(ByVal value As BoundaryCondition)
    this.RightSupport = value
End Property

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

Private Sub Class_Initialize()
    this.PointLoads = 0
    this.DistributedLoads = 0
    this.LeftSupport = BoundaryCondition.Fixed
    this.RightSupport = BoundaryCondition.Fixed
    this.SpanCondition = SpanType.Simple
End Sub

Public Property Get SpanCondition() As SpanType
    SpanCondition = this.SpanCondition
End Property

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

'IView Interface
'@Folder("Abstractions")
'@Interface
Option Explicit

Public Function ShowDialog(ByVal viewModel As Object) As Boolean
End Function

'Userform
'@Folder("UI")
Option Explicit

Implements IView

Private lastPointLoadValue As Long
Private lastDistributedLoadValue As Long
Private Const NumericInputsOnly As String = "Only numeric inputs allowed"

Private Type TView
    IsCancelled As Boolean
    model As VBAProject.LoadingModel
End Type

Private this As TView

Public Property Get model() As LoadingModel
    Set model = this.model
End Property

Public Property Let model(ByVal value As LoadingModel)
    Set this.model = value
End Property


Public Property Get IsCancelled() As Boolean
    IsCancelled = this.IsCancelled
End Property

Private Sub CancelButton_Click()
    OnCancel
End Sub

Private Function IView_ShowDialog(ByVal viewModel As Object) As Boolean
    Set this.model = viewModel

    SyncUIWithModel

    Me.Show
    IView_ShowDialog = Not this.IsCancelled
End Function

Private Sub SyncUIWithModel()
    Dim spanCounter As Long
    For spanCounter = 0 To SpanTypeListBox.ListCount - 1
        If (SpanTypeListBox.List(spanCounter) = SpanConditionConverter.ToString(this.model.SpanCondition)) Then
            SpanTypeListBox.ListIndex = spanCounter
            Exit For
        End If
    Next

    If model.SpanCondition = Cantilever Then
        model.LeftBoundaryCondition = Fixed
        model.RightBoundaryCondition = Free
    End If

    Dim leftCounter As Long
    For leftCounter = 0 To LeftSupportTypeListBox.ListCount - 1
        If (LeftSupportTypeListBox.List(leftCounter) = SupportTypeConverter.ToString(this.model.LeftBoundaryCondition)) Then
            LeftSupportTypeListBox.ListIndex = leftCounter
            Exit For
        End If
    Next

    Dim rightCounter As Long
    For rightCounter = 0 To RightSupportTypeListBox.ListCount - 1
        If (RightSupportTypeListBox.List(rightCounter) = SupportTypeConverter.ToString(this.model.RightBoundaryCondition)) Then
            RightSupportTypeListBox.ListIndex = rightCounter
            Exit For
        End If
    Next
End Sub

Private Sub OKButton_Click()
    Me.Hide
End Sub

Private Sub OnCancel()
    this.IsCancelled = True
    Me.Hide
End Sub

Private Sub SpanTypeListBox_Click()
    If Not this.model Is Nothing Then
        this.model.SpanCondition = SpanConditionConverter.ToEnum(SpanTypeListBox.List(SpanTypeListBox.ListIndex))
    End If

    If this.model.SpanCondition = Cantilever Then
        MsgBox "Don't forget to mark the right boundary condition as free."
    End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = VbQueryClose.vbFormControlMenu Then
        Cancel = True
        OnCancel
    End If
End Sub

Private Sub LeftSupportTypeListBox_Change()
'    viewModel.LeftSupport = SupportTypeConverter.ToEnum(LeftSupportTypeListBox.value)
    ' ^ Errors out | v workaround
    If Not this.model Is Nothing Then
        this.model.LeftBoundaryCondition = SupportTypeConverter.ToEnum(LeftSupportTypeListBox.List(LeftSupportTypeListBox.ListIndex))
    End If
End Sub

Private Sub RightSupportTypeListBox_Change()
'    viewModel.RightSupport = SupportTypeConverter.ToEnum(RightSupportTypeListBox.value)
    If Not this.model Is Nothing Then
        this.model.RightBoundaryCondition = SupportTypeConverter.ToEnum(RightSupportTypeListBox.List(RightSupportTypeListBox.ListIndex))
    End If
End Sub

Private Sub UserForm_Initialize()
    LeftSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Fixed), 0
    LeftSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Pinned), 1
    LeftSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Roller), 2
    LeftSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Free), 3
    LeftSupportTypeListBox.SetFocus

    RightSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Fixed), 0
    RightSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Pinned), 1
    RightSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Roller), 2
    RightSupportTypeListBox.AddItem SupportTypeConverter.ToString(BoundaryCondition.Free), 3

    SpanTypeListBox.AddItem SpanConditionConverter.ToString(SpanType.Simple), 0
    SpanTypeListBox.AddItem SpanConditionConverter.ToString(SpanType.Cantilever), 1

    PointLoadsSpinButton.value = 0
    PointLoadsTextBox.value = PointLoadsSpinButton.value

    DistributedLoadsSpinButton.value = 0
    DistributedLoadsTextBox.value = DistributedLoadsSpinButton.value
End Sub

Private Sub PointLoadsSpinButton_Change()
    PointLoadsTextBox.value = PointLoadsSpinButton.value
    lastPointLoadValue = PointLoadsSpinButton.value
End Sub

Private Sub PointLoadsTextBox_Change()
    If PointLoadsTextBox = vbNullString Then
        PointLoadsTextBox.value = 0
    End If

    If Not IsNumeric(PointLoadsTextBox.value) Then
        PointLoadsTextBox.value = lastPointLoadValue
        MsgBox NumericInputsOnly
        Exit Sub
    End If

    PointLoadsSpinButton.value = PointLoadsTextBox.value
    If Not this.model Is Nothing Then
        this.model.PointLoadsCount = PointLoadsTextBox.value
    End If
End Sub

Private Sub DistributedLoadsSpinButton_Change()
    DistributedLoadsTextBox.value = DistributedLoadsSpinButton.value
    lastDistributedLoadValue = DistributedLoadsSpinButton.value
End Sub

Private Sub DistributedLoadsTextBox_Change()
    If DistributedLoadsTextBox.value = vbNullString Then
        DistributedLoadsTextBox.value = 0
    End If

    If Not IsNumeric(DistributedLoadsTextBox.value) Then
        DistributedLoadsTextBox.value = lastDistributedLoadValue
        MsgBox NumericInputsOnly
        Exit Sub
    End If

    DistributedLoadsSpinButton.value = DistributedLoadsTextBox.value
    If Not this.model Is Nothing Then
        this.model.DistributedLoadsCount = CLng(DistributedLoadsTextBox.value)
    End If
End Sub

'Presenter module
Option Explicit

Private ws As Worksheet
Private Const defaultSupportDimension As Long = 10
Private Const defaultSpanWidth As Double = 300

Public Sub CreateLoadingDiagram()
    Dim view As IView
    Set view = New BasicView
    Dim model As LoadingModel
    Set model = New LoadingModel
    If Not view.ShowDialog(model) Then
        Exit Sub
    End If

    Set ws = ActiveSheet

    Dim leftBoundaryConiditionShape As Shape
    Dim topLeftCell As Range
    Set topLeftCell = ActiveWindow.VisibleRange(7, 2)
    Set leftBoundaryConiditionShape = CreateBoundaryConditionShape( _
                                        model.LeftBoundaryCondition, _
                                        topLeftCell.Left, _
                                        topLeftCell.Top)

    Dim spanWidth As Double
    If (model.SpanCondition = Simple) Then
        spanWidth = defaultSpanWidth
    Else
        spanWidth = defaultSpanWidth / 2
    End If

    Dim rightBoundaryConditionShape As Shape
    Set rightBoundaryConditionShape = CreateBoundaryConditionShape( _
                                        model.RightBoundaryCondition, _
                                        topLeftCell.Left - defaultSupportDimension / 2 + spanWidth, _
                                        topLeftCell.Top)
    Dim beamMember As Shape
    Set beamMember = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                            topLeftCell.Left + defaultSupportDimension / 2, _
                                            topLeftCell.Top, _
                                            topLeftCell.Left + defaultSpanWidth, _
                                            topLeftCell.Top)

    Dim distributedLoadHeightOffset As Long
    AddDistributedLoads model.DistributedLoadsCount, _
                        beamMember, _
                        topLeftCell, _
                        distributedLoadHeightOffset

    '@Ignore UnassignedVariableUsage
    AddPointLoads model.PointLoadsCount, beamMember, distributedLoadHeightOffset

    Set ws = Nothing
End Sub

Private Function CreateBoundaryConditionShape(ByVal condition As BoundaryCondition, ByVal leftEdge As Double, ByVal topEdge As Double) As Shape
    If condition = Free Then
        Exit Function
    End If

    If condition = Fixed Then
        Set CreateBoundaryConditionShape = CreateFixedBoundaryConditionShape(leftEdge, topEdge)
        Exit Function
    End If

    Dim shapeType As MsoAutoShapeType
    If condition = Pinned Then
        shapeType = MsoAutoShapeType.msoShapeIsoscelesTriangle
    ElseIf condition = Roller Then
        shapeType = MsoAutoShapeType.msoShapeOval
    End If

    Set CreateBoundaryConditionShape = ws.Shapes.AddShape(shapeType, _
                                                            leftEdge, _
                                                            topEdge, _
                                                            defaultSupportDimension, _
                                                            defaultSupportDimension)
End Function

Private Function CreateFixedBoundaryConditionShape(ByVal leftEdge As Double, ByVal topEdge As Double) As Shape
    Dim horizon As Shape
    Set horizon = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                            leftEdge, _
                                            topEdge, _
                                            leftEdge + defaultSupportDimension, _
                                            topEdge)
    Dim slanted1 As Shape
    Set slanted1 = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                            leftEdge, _
                                            topEdge + 0.5 * defaultSupportDimension, _
                                            leftEdge + 0.5 * defaultSupportDimension, _
                                            topEdge)
    Dim slanted2 As Shape
    Set slanted2 = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                            leftEdge, _
                                            topEdge + 1 * defaultSupportDimension, _
                                            leftEdge + 1 * defaultSupportDimension, _
                                            topEdge)
    Dim slanted3 As Shape
    Set slanted3 = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                            leftEdge + 0.5 * defaultSupportDimension, _
                                            topEdge + 1 * defaultSupportDimension, _
                                            leftEdge + 1 * defaultSupportDimension, _
                                            topEdge + 0.5 * defaultSupportDimension)
    Set CreateFixedBoundaryConditionShape = ws.Shapes.Range(Array(horizon.Name, slanted1.Name, slanted2.Name, slanted3.Name)).Group
End Function

Private Sub AddDistributedLoads(ByVal nuberOfDistributedLoads As Long, ByVal beamMemberShape As Shape, ByVal topLeftCell As Range, ByRef outDistributedLoadHeightOffset As Long)
    Const distributedLoadHeight As Long = 30
    Dim counter As Long
    For counter = 1 To nuberOfDistributedLoads
        outDistributedLoadHeightOffset = counter * distributedLoadHeight
        Dim distributedLoad As Shape
        Set distributedLoad = ws.Shapes.AddShape(MsoAutoShapeType.msoShapeRectangle, _
                              topLeftCell.Left + defaultSupportDimension / 2, _
                              topLeftCell.Top - outDistributedLoadHeightOffset, _
                              beamMemberShape.Width, _
                              distributedLoadHeight)
        distributedLoad.Fill.Visible = msoFalse
    Next
End Sub

Private Sub AddPointLoads(ByVal numberOfPointLoads As Long, ByVal beamMember As Shape, ByVal distributedLoadHeightOffset As Long)
    Dim leftDisplacement As Double
    leftDisplacement = beamMember.Width / (1 + numberOfPointLoads)

    Dim counter As Long
    For counter = 1 To numberOfPointLoads
        Dim pointLoadInsertion As Double
        pointLoadInsertion = beamMember.Left + (leftDisplacement * counter)
        Dim pointLoad As Shape
        Set pointLoad = ws.Shapes.AddConnector(MsoConnectorType.msoConnectorStraight, _
                                                pointLoadInsertion, _
                                                beamMember.Top - 50 - distributedLoadHeightOffset, _
                                                pointLoadInsertion, _
                                                beamMember.Top - distributedLoadHeightOffset)
        pointLoad.Line.EndArrowheadStyle = MsoArrowheadStyle.msoArrowheadTriangle
    Next
End Sub

Converters are used to allow using Enums instead of strings to maintain consistency and avoid global variables. They have the VB_PredeclaredId attribute set to True.

'@PredeclaredId
'@Folder("Converters")
Option Explicit

Public Enum SpanType
    NotSet
    Simple
    Cantilever
End Enum

Private StringForEnum As Dictionary
Private EnumForString As Dictionary

Private Sub Class_Initialize()
    PopulateDictionaries
End Sub

Private Sub PopulateDictionaries()
    Set EnumForString = New Dictionary
    EnumForString.CompareMode = TextCompare

    EnumForString.Add "Simple", SpanType.Simple
    EnumForString.Add "Cantilever", SpanType.Cantilever

    Set StringForEnum = New Dictionary
    EnumForString.CompareMode = TextCompare
    Dim key As Variant
    For Each key In EnumForString.Keys
        StringForEnum.Add EnumForString.Item(key), key
    Next
End Sub

Public Function ToEnum(ByVal value As String) As SpanType
    If Not EnumForString.Exists(value) Then
        ThrowInvalidArgument "ToEnum", value
    End If

    ToEnum = EnumForString(value)
End Function

Public Function ToString(ByVal value As SpanType) As String
    If Not StringForEnum.Exists(value) Then
        ThrowInvalidArgument "ToString", CStr(value)
    End If

    ToString = StringForEnum(value)
End Function

Private Sub ThrowInvalidArgument(ByVal source As String, ByVal value As String)
    Err.Raise 5, Information.TypeName(Me) & "." & source, "Invalid input '" & value & "' was supplied."
End Sub

Public Property Get Enums() As Variant
    Enums = EnumForString.Items
End Property

Public Property Get Strings() As Variant
    Strings = EnumForString.Keys
End Property

'@PredeclaredId
'@Folder("Converters")
Option Explicit

Public Enum BoundaryCondition
    NotSet
    Fixed
    Pinned
    Roller
    Free
End Enum

Private StringForEnum As Dictionary
Private EnumForString As Dictionary

Private Sub Class_Initialize()
    PopulateDictionaries
End Sub

Private Sub PopulateDictionaries()
    Set EnumForString = New Dictionary
    EnumForString.CompareMode = TextCompare

    EnumForString.Add "Fixed", BoundaryCondition.Fixed
    EnumForString.Add "Pinned", BoundaryCondition.Pinned
    EnumForString.Add "Roller", BoundaryCondition.Roller
    EnumForString.Add "Free", BoundaryCondition.Free

    Set StringForEnum = New Dictionary
    EnumForString.CompareMode = TextCompare
    Dim key As Variant
    For Each key In EnumForString.Keys
        StringForEnum.Add EnumForString.Item(key), key
    Next
End Sub

Public Function ToEnum(ByVal value As String) As BoundaryCondition
    If Not EnumForString.Exists(value) Then
        ThrowInvalidArgument "ToEnum", value
    End If

    ToEnum = EnumForString(value)
End Function

Public Function ToString(ByVal value As BoundaryCondition) As String
    If Not StringForEnum.Exists(value) Then
        ThrowInvalidArgument "ToString", CStr(value)
    End If

    ToString = StringForEnum(value)
End Function

Private Sub ThrowInvalidArgument(ByVal source As String, ByVal value As String)
    Err.Raise 5, Information.TypeName(Me) & "." & source, "Invalid input '" & value & "' was supplied."
End Sub

Public Property Get Enums() As Variant
    Enums = EnumForString.Items
End Property

Public Property Get Strings() As Variant
    Strings = EnumForString.Keys
End Property
Improve this question
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Very nice implementation. There is very little I would change, and then it would likely be more as personal preferences. For example, I've tended to define a single source for all the Enum declarations and converters in a module instead of a persistent class. In that module, I'll often include a central list of custom error codes and descriptions to ensure consistency of numbering across the app. These aren't nits at all, more stylistic differences. Good work. \$\endgroup\$
    – PeterT
    Feb 22, 2019 at 15:20

1 Answer 1

Reset to default
1
\$\begingroup\$

Amazing work! As PeterT mentioned very little to change in your code, however with that said I did notice some code that keeps repeating itself, not sure if this is intentional.

Checking if the Model is null

If Not this.model Is Nothing Then, this code appears 6 times through out the UserForm, I believe you can validate if the model is null in your IView_ShowDialog procedure, right before you sync the model with the UI, execution will stop if the viewModel is not set.

Private Function IView_ShowDialog(ByVal viewModel As Object) As Boolean
If viewModel Is Nothing Then Exit Function 'exits if viewModel is null

Set this.model = viewModel

SyncUIWithModel

Me.Show
IView_ShowDialog = Not this.IsCancelled
End Function

Public Properties

You are declaring a Public Property Get PointLoadsCount but have a PointLoads private variable under THelper. Why not just use PointLoadsCount, you'll have less naming and less variables to manage, plus it looks cleaner and makes more sense when using this keyword. This is just personal preference, but I do find it easier to manage.

Private Type THelper
    PointLoadsCount As Long
End Type

Private this As THelper

Public Property Get PointLoadsCount() As Long
    PointLoadsCount = this.PointLoadsCount 'renamed to match Private varaible
End Property

Last note, I believe you can eliminate the following line of code, as you are already setting the model, right before you show the form, additionally this would throw a Runtime Error if executed.

Public Property Let model(ByVal value As LoadingModel)'should be a Set not Let 
    Set this.model = value
End Property

Overall excellent implementation, especially with your Enum converters!

Improve this answer
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.