HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Generating a collection of controls

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
generatingcollectioncontrols

Problem

This question I asked previously mentions a function named BuildControlCollection, which I didn't go into the details of since it wasn't relevant. However, because the implementation contains some funky code I'm not 100% on (it completely works, I'm just unsure if it's the best way to do it), I decided to put this up for review too.

Public Sub BuildControlCollection(ByRef ipForm As Form, 
                                  ByRef mpCollection As Collection, 
                                  ByVal ipControlType As ControlTypes)


The function takes the form that we're building a control collection from, an unset collection object (which will be created and filled), and an enum value to indicate the type(s) of controls to fill the collection with.

```
Enum ControlTypes
eTextBox = &H1
eComboBox = &H2
eLabel = &H4
eButton = &H8
eFrame = &H10
eRadioButton = &H20
eListBox = &H40
eLine = &H80
eRectangle = &H100
eCheckbox = &H200
eChart = &H400
eAll = &H800
End Enum

Public Sub BuildControlCollection(ByRef ipForm As Form, _
ByRef mpCollection As Collection, _
ByVal ipControlType As ControlTypes)

If Not mpCollection Is Nothing Then
Err.Raise 5000, "Collection has previously been set. This operation would delete the collection."
End If

Set mpCollection = New Collection

Dim lControl As Control
For Each lControl In ipForm.Controls

If ipControlType And eAll Then
mpCollection.Add lControl

ElseIf (ipControlType And ControlTypes.eButton) And TypeName(lControl) = "CommandButton" Then
mpCollection.Add lControl

ElseIf (ipControlType And ControlTypes.eChart) And TypeName(lControl) = "ObjectFrame" Then
mpCollection.Add lControl

ElseIf (ipControlType And ControlTypes.eCheckbox) And TypeName(lControl) = "CheckBox" Then
mpCollection.Add lControl

Solution

I don't know what this is called, so I haven't been able to Google a real implementation, so I've had to make my best guess at it. [...] If anyone can tell me what the bit flagging thing used in MsgBox is called, that would be really useful too.

They're called Flag enums in .NET (see this SO question), and apparently the naming is also appropriate for VB6 enums.

That If block definitely smells, because all branches result in lControl being added to mpCollection. Hence, it's not really an If...Else If logic you need here, rather something like:

If CanAddThisControl(ipControlType, lControl) Then mpCollection.Add lControl


This effectively eliminates/replaces the entire If block, but leaves you with a CanAddThisControl method to implement. Let's see...

Private Function CanAddThisControl(ipControlType As ControlTypes, lControl As Control) As Boolean

    'return true if the enum value matches the control's type

End Function


This is where VB6/VBA's lack of structures really hurts. What you need is really some kind of KeyValuePair that associates an enum value with a control type. What if we created a class to do just that?

Private Type tKeyValuePair
    key As Variant
    value As Variant
End Type

Private this As tKeyValuePair
Option Explicit

Public Property Get key() As Variant
    If IsObject(this.key) Then
        Set key = this.key
    Else
        key = this.key
    End If
End Property

Public Property Let key(k As Variant)
    If IsEmpty(k) Then Err.Raise 5
    this.key = k
End Property

Public Property Set key(k As Variant)
    If IsEmpty(k) Then Err.Raise 5
    Set this.key = k
End Property

Public Property Get value() As Variant
    If IsObject(this.value) Then
        Set value = this.value
    Else
        value = this.value
    End If
End Property

Public Property Let value(v As Variant)
    this.value = v
End Property

Public Property Set value(v As Variant)
    Set this.value = v
End Property

Public Function ToString() As String
    ToString = TypeName(Me) & ""
End Function


(damn VB6 case insensitivity!)

So now we have a way of associating enum values with a string:

Private Function CreateKeyValuePair(key As ControlTypes, value As String) As KeyValuePair
    Dim result As New KeyValuePair
    result.key = key
    result.value = value
    Set CreateKeyValuePair = result
End Function

Private Function GetControlTypesAsKeyValuePairs As Collection
    Dim result As New Collection
    result.Add CreateKeyValuePair(ControlTypes.eButton, "Button")
    result.Add CreateKeyValuePair(ControlTypes.eChart, "ObjectFrame")
    result.Add CreateKeyValuePair(ControlTypes.eCheckBox, "CheckBox")
    result.Add CreateKeyValuePair(ControlTypes.eComboBox, "ComboBox")
    result.Add CreateKeyValuePair(ControlTypes.eFrame, "Frame")
    result.Add CreateKeyValuePair(ControlTypes.eLabel, "Label")
    result.Add CreateKeyValuePair(ControlTypes.eLine, "Line")
    result.Add CreateKeyValuePair(ControlTypes.eListBox, "ListBox")
    result.Add CreateKeyValuePair(ControlTypes.eRadioButton, "RadioButton")
    result.Add CreateKeyValuePair(ControlTypes.eRectangle, "Rectangle")
    result.Add CreateKeyValuePair(ControlTypes.eTextBox, "TextBox")
    Set GetControlTypesAsKeyValuePairs = result
End Function


The above code could be simplified to a one-liner if you implemented a List to wrap the poorly tooled Collection class; see this CR post:

Private Function GetControlTypesAsKeyValuePairs() As List
      Dim result As New List
      result.Add CreateKeyValuePair(ControlTypes.eButton, "Button"), _
                 CreateKeyValuePair(ControlTypes.eChart, "ObjectFrame"), _
                 CreateKeyValuePair(ControlTypes.eCheckBox, "CheckBox"), _
                 CreateKeyValuePair(ControlTypes.eComboBox, "ComboBox"), _
                 CreateKeyValuePair(ControlTypes.eFrame, "Frame"), _
                 CreateKeyValuePair(ControlTypes.eLabel, "Label"), _
                 CreateKeyValuePair(ControlTypes.eLine, "Line"), _
                 CreateKeyValuePair(ControlTypes.eListBox, "ListBox"), _
                 CreateKeyValuePair(ControlTypes.eRadioButton, "RadioButton"), _
                 CreateKeyValuePair(ControlTypes.eRectangle, "Rectangle"), _
                 CreateKeyValuePair(ControlTypes.eTextBox, "TextBox")
      Set GetControlTypesAsKeyValuePairs = result
  End Function


Now that we have a way of associating each enum value with a specific string, we're equipped to implement CanAddThisControl - I'll assume you went with a Collection, but the code would be pretty much identical if you used the List class I've mentioned above (just swap Collection for List):

```
Private Function CanAddThisControl(ipControlType As ControlTypes, lControl As Control) As Boolean

Dim enums As Collection
Set enums = GetControlTypesAsKeyValuePairs

Dim kvp As KeyValuePair
For Each kvp In enums
If (ipControlType And kvp.Key) And TypeName(lContr

Code Snippets

If CanAddThisControl(ipControlType, lControl) Then mpCollection.Add lControl
Private Function CanAddThisControl(ipControlType As ControlTypes, lControl As Control) As Boolean

    'return true if the enum value matches the control's type

End Function
Private Type tKeyValuePair
    key As Variant
    value As Variant
End Type

Private this As tKeyValuePair
Option Explicit

Public Property Get key() As Variant
    If IsObject(this.key) Then
        Set key = this.key
    Else
        key = this.key
    End If
End Property

Public Property Let key(k As Variant)
    If IsEmpty(k) Then Err.Raise 5
    this.key = k
End Property

Public Property Set key(k As Variant)
    If IsEmpty(k) Then Err.Raise 5
    Set this.key = k
End Property

Public Property Get value() As Variant
    If IsObject(this.value) Then
        Set value = this.value
    Else
        value = this.value
    End If
End Property

Public Property Let value(v As Variant)
    this.value = v
End Property

Public Property Set value(v As Variant)
    Set this.value = v
End Property

Public Function ToString() As String
    ToString = TypeName(Me) & "<" & TypeName(this.key) & "," & TypeName(this.value) & ">"
End Function
Private Function CreateKeyValuePair(key As ControlTypes, value As String) As KeyValuePair
    Dim result As New KeyValuePair
    result.key = key
    result.value = value
    Set CreateKeyValuePair = result
End Function

Private Function GetControlTypesAsKeyValuePairs As Collection
    Dim result As New Collection
    result.Add CreateKeyValuePair(ControlTypes.eButton, "Button")
    result.Add CreateKeyValuePair(ControlTypes.eChart, "ObjectFrame")
    result.Add CreateKeyValuePair(ControlTypes.eCheckBox, "CheckBox")
    result.Add CreateKeyValuePair(ControlTypes.eComboBox, "ComboBox")
    result.Add CreateKeyValuePair(ControlTypes.eFrame, "Frame")
    result.Add CreateKeyValuePair(ControlTypes.eLabel, "Label")
    result.Add CreateKeyValuePair(ControlTypes.eLine, "Line")
    result.Add CreateKeyValuePair(ControlTypes.eListBox, "ListBox")
    result.Add CreateKeyValuePair(ControlTypes.eRadioButton, "RadioButton")
    result.Add CreateKeyValuePair(ControlTypes.eRectangle, "Rectangle")
    result.Add CreateKeyValuePair(ControlTypes.eTextBox, "TextBox")
    Set GetControlTypesAsKeyValuePairs = result
End Function
Private Function GetControlTypesAsKeyValuePairs() As List
      Dim result As New List
      result.Add CreateKeyValuePair(ControlTypes.eButton, "Button"), _
                 CreateKeyValuePair(ControlTypes.eChart, "ObjectFrame"), _
                 CreateKeyValuePair(ControlTypes.eCheckBox, "CheckBox"), _
                 CreateKeyValuePair(ControlTypes.eComboBox, "ComboBox"), _
                 CreateKeyValuePair(ControlTypes.eFrame, "Frame"), _
                 CreateKeyValuePair(ControlTypes.eLabel, "Label"), _
                 CreateKeyValuePair(ControlTypes.eLine, "Line"), _
                 CreateKeyValuePair(ControlTypes.eListBox, "ListBox"), _
                 CreateKeyValuePair(ControlTypes.eRadioButton, "RadioButton"), _
                 CreateKeyValuePair(ControlTypes.eRectangle, "Rectangle"), _
                 CreateKeyValuePair(ControlTypes.eTextBox, "TextBox")
      Set GetControlTypesAsKeyValuePairs = result
  End Function

Context

StackExchange Code Review Q#44555, answer score: 5

Revisions (0)

No revisions yet.