patternMinor
Generating a collection of controls
Viewed 0 times
generatingcollectioncontrols
Problem
This question I asked previously mentions a function named
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
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
They're called Flag enums in .NET (see this SO question), and apparently the naming is also appropriate for VB6 enums.
That
This effectively eliminates/replaces the entire
This is where VB6/VBA's lack of structures really hurts. What you need is really some kind of
(damn VB6 case insensitivity!)
So now we have a way of associating enum values with a string:
The above code could be simplified to a one-liner if you implemented a
Now that we have a way of associating each enum value with a specific string, we're equipped to implement
```
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
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 lControlThis 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 FunctionThis 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 FunctionThe 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 FunctionNow 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 lControlPrivate Function CanAddThisControl(ipControlType As ControlTypes, lControl As Control) As Boolean
'return true if the enum value matches the control's type
End FunctionPrivate 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 FunctionPrivate 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 FunctionPrivate 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 FunctionContext
StackExchange Code Review Q#44555, answer score: 5
Revisions (0)
No revisions yet.