8
\$\begingroup\$

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

        ElseIf (ipControlType And ControlTypes.eComboBox) And TypeName(lControl) = "ComboBox" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eFrame) And TypeName(lControl) = "Frame" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eLabel) And TypeName(lControl) = "Label" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eLine) And TypeName(lControl) = "Line" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eListBox) And TypeName(lControl) = "ListBox" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eRadioButton) And TypeName(lControl) = "RadioButton" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eRectangle) And TypeName(lControl) = "Rectangle" Then
            mpCollection.Add lControl

        ElseIf (ipControlType And ControlTypes.eTextBox) And TypeName(lControl) = "TextBox" Then
            mpCollection.Add lControl

        End If

    Next lControl

End Sub

The thinking behind the last argument of BuildControlCollection is to allow multiple options to be passed (eg eTextBox Or eButton) - I've seen this used in the built-in functions such as MsgBox - the second argument (somewhat inaccurately named Buttons) of which allows you to specify for eg vbOKOnly Or vbExclamation to get a messagebox with both an OK button and a warning triangle. 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.

I understand that it works by comparing bits - for eg, vbOKOnly may be 0000 0001, whilst vbExclamation may be 0001 0000, so passing vbOkOnly Or vbExclamation (0001 0001) matches on both bits.

Whilst my implementation above definitely works, that enormous If/ElseIf smells funny. If anyone can tell me what the bit flagging thing used in MsgBox is called, that would be really useful too.

\$\endgroup\$

2 Answers 2

5
\$\begingroup\$

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) & "<" & TypeName(this.key) & "," & TypeName(this.value) & ">"
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(lControl) = kvp.Value Then
           CanAddThisControl = True
           Exit For
        End If
    Next

End Function

This should enable you to make the loop in BuildControlCollection as simple as this:

For Each lControl In ipForm.Controls

    If (ipControlType And eAll) Or CanAddThisControl(lControl) Then
        mpCollection.Add lControl
    End If

Next

Now this is a little inefficient, because CanAddThisControl is rebuilding the KeyValuePair collection every time it's called. But it's a fair start I think.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ Beautiful, thanks. (damn VB6 case insensitivity!) Also this in spades. \$\endgroup\$
    – Kai
    Commented Mar 17, 2014 at 16:15
  • \$\begingroup\$ @Kai my pleasure! BTW welcome to 150, you're officially counted as an "avid user" now. Are you running? \$\endgroup\$ Commented Mar 17, 2014 at 16:34
2
\$\begingroup\$

I know we're supposed to use Hungarian notation in VBA, but it's useless with the modern IDE. Get rid of it unless you're working in VBScript. The only reason I say to bother with Hungarian notation in VBScript is because everything is a variant in that flavor of the language.

\$\endgroup\$

Your Answer

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

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