Skip to main content
Commonmark migration
Source Link

###Enumerable.cls

Enumerable.cls

###Enumerable.cls

Enumerable.cls

added 229 characters in body
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177

For anyone interested, the reason you can call these functions without creating a new instance is setting VB_PredeclaredID = True creates a default instance of the class.

For anyone interested, the reason you can call these functions without creating a new instance is setting VB_PredeclaredID = True creates a default instance of the class.

Tweeted twitter.com/#!/StackCodeReview/status/498278020755783682
added 623 characters in body
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Enumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private c As Collection ' used for Range

Public Function Range(ByVal param1startValue As Long, ByVal param2endValue As Long) As Collection
Attribute Range.VB_Description = "Returns a collection of longs."
    Set c = New Collection
    Dim i As Long
    For i = param1startValue To param2endValue
        c.Add i
    Next
    Set Range = c
End Function

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = c.[_NewEnum]
End Property

' All of these functions work only on collectionObjects whose items have a default value.
' If the items do not have a default value,
'   Runtime Error 438 "Object doesn't support this property or method" is raised.

Public Function Contains(collectionObject As Variant, itemToSearchFor As Variant) As Boolean
Attribute Contains.VB_Description = "Checks if an item exists in a Collection. Matches on the default property."
    Dim item As Variant
    
    For Each item In collectionObject
        If item = itemToSearchFor Then
            Contains = True
            Exit Function
        End If
    Next item
    
    Contains = False
End Function

Public Function Min(collectionObject As Variant) As Variant
Attribute Min.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item < result Then
                result = item
            End If
        End If
    Next item
    
    Min = result
End Function

Public Function Max(collectionObject As Variant) As Variant
Attribute Max.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item > result Then
                result = item
            End If
        End If
    Next item
    
    Max = result
End Function

Public Function Intersect(collection1 As Variant, collection2 As Variant) As Collection
Attribute Intersect.VB_Description = "Returns a new collection containing the items that are common to both collection parameters. Returns Nothing if either parameter IsNothing."

    If collection1 Is Nothing Or collection2 Is Nothing Then
        Exit Function
    End If
    
    Set Intersect = New Collection
    Dim item As Variant
    Dim innerItem As Variant
    
    For Each item In collection1
        For Each innerItem In collection2
            If item = innerItem And Not IsEmpty(item) Then
                Intersect.Add innerItem
            End If
        Next innerItem
    Next item
End Function
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Enumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private c As Collection ' used for Range

Public Function Range(ByVal param1 As Long, ByVal param2 As Long) As Collection
    Set c = New Collection
    Dim i As Long
    For i = param1 To param2
        c.Add i
    Next
    Set Range = c
End Function

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = c.[_NewEnum]
End Property

' All of these functions work only on collectionObjects whose items have a default value.
' If the items do not have a default value,
'   Runtime Error 438 "Object doesn't support this property or method" is raised.

Public Function Contains(collectionObject As Variant, itemToSearchFor As Variant) As Boolean
    Dim item As Variant
    
    For Each item In collectionObject
        If item = itemToSearchFor Then
            Contains = True
            Exit Function
        End If
    Next item
    
    Contains = False
End Function

Public Function Min(collectionObject As Variant) As Variant
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item < result Then
                result = item
            End If
        End If
    Next item
    
    Min = result
End Function

Public Function Max(collectionObject As Variant) As Variant
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item > result Then
                result = item
            End If
        End If
    Next item
    
    Max = result
End Function

Public Function Intersect(collection1 As Variant, collection2 As Variant) As Collection
    
    If collection1 Is Nothing Or collection2 Is Nothing Then
        Exit Function
    End If
    
    Set Intersect = New Collection
    Dim item As Variant
    Dim innerItem As Variant
    
    For Each item In collection1
        For Each innerItem In collection2
            If item = innerItem And Not IsEmpty(item) Then
                Intersect.Add innerItem
            End If
        Next innerItem
    Next item
End Function
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Enumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private c As Collection ' used for Range

Public Function Range(ByVal startValue As Long, ByVal endValue As Long) As Collection
Attribute Range.VB_Description = "Returns a collection of longs."
    Set c = New Collection
    Dim i As Long
    For i = startValue To endValue
        c.Add i
    Next
    Set Range = c
End Function

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = c.[_NewEnum]
End Property

' All of these functions work only on collectionObjects whose items have a default value.
' If the items do not have a default value,
'   Runtime Error 438 "Object doesn't support this property or method" is raised.

Public Function Contains(collectionObject As Variant, itemToSearchFor As Variant) As Boolean
Attribute Contains.VB_Description = "Checks if an item exists in a Collection. Matches on the default property."
    Dim item As Variant
    
    For Each item In collectionObject
        If item = itemToSearchFor Then
            Contains = True
            Exit Function
        End If
    Next item
    
    Contains = False
End Function

Public Function Min(collectionObject As Variant) As Variant
Attribute Min.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item < result Then
                result = item
            End If
        End If
    Next item
    
    Min = result
End Function

Public Function Max(collectionObject As Variant) As Variant
Attribute Max.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
    Dim item As Variant
    Dim result As Variant
    Dim isFirstTry As Boolean: isFirstTry = True
    
    For Each item In collectionObject
        If isFirstTry Then
            result = item
            isFirstTry = False
        Else
            If item > result Then
                result = item
            End If
        End If
    Next item
    
    Max = result
End Function

Public Function Intersect(collection1 As Variant, collection2 As Variant) As Collection
Attribute Intersect.VB_Description = "Returns a new collection containing the items that are common to both collection parameters. Returns Nothing if either parameter IsNothing."

    If collection1 Is Nothing Or collection2 Is Nothing Then
        Exit Function
    End If
    
    Set Intersect = New Collection
    Dim item As Variant
    Dim innerItem As Variant
    
    For Each item In collection1
        For Each innerItem In collection2
            If item = innerItem And Not IsEmpty(item) Then
                Intersect.Add innerItem
            End If
        Next innerItem
    Next item
End Function
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177
Loading