Skip to main content
Code Review

Return to Question

Commonmark migration
Source Link

###Context

Context

###Linq?

Linq?

###Example

Example

###Context

###Linq?

###Example

Context

Linq?

Example

replaced http://codereview.stackexchange.com/ with https://codereview.stackexchange.com/
Source Link

Ok not exactly , but very much inspired by System.Linq.Enumerable, and only made possible with the Reflection.Delegate Reflection.Delegate class. I'm working on a Grouping class that will enable adding a GroupBy method in there... but for now these are the members of the LinqEnumerable class:

Ok not exactly , but very much inspired by System.Linq.Enumerable, and only made possible with the Reflection.Delegate class. I'm working on a Grouping class that will enable adding a GroupBy method in there... but for now these are the members of the LinqEnumerable class:

Ok not exactly , but very much inspired by System.Linq.Enumerable, and only made possible with the Reflection.Delegate class. I'm working on a Grouping class that will enable adding a GroupBy method in there... but for now these are the members of the LinqEnumerable class:

Notice removed Draw attention by Malachi
Bounty Ended with cheezsteak's answer chosen by Malachi
Tweeted twitter.com/#!/StackCodeReview/status/547829960468340737
Notice added Draw attention by Malachi
Bounty Started worth 50 reputation by Malachi
added Aggregate function
Source Link
Mathieu Guindon
  • 75.5k
  • 18
  • 194
  • 467

members of LinqEnumerablemembers of LinqEnumerable

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
 Dim equatable As IEquatable
 If TypeOf value Is IEquatable Then
 
 Set equatable = value
 EquateReferenceTypes = equatable.Equals(other)
 Else
 
 EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
 End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
 EquateValueTypes = (value = other)
End Function
Friend Sub Add(ParamArray values())
 Dim valuesArray() As Variant
 valuesArray = values
 AddArray valuesArray
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
 AddArray values.ToArray
End Sub
Friend Sub AddArray(values() As Variant)
 Dim value As Variant, i As Long
 For i = LBound(values) To UBound(values)
 encapsulated.Add values(i)
 Next
End Sub
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
 If IsObject(encapsulated(index)) Then
 Set Item = encapsulated(index)
 Else
 Item = encapsulated(index)
 End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
 Set NewEnum = encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
 Count = encapsulated.Count
End Property
Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
 Contains = (IndexOf(value) <> -1)
End Function
Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not result.Contains(value) Then result.Add value
 Next
 
 Set Distinct = result
 
End Function
Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not values.Contains(value) Then result.Add value
 Next
 
 Set Except = result
 
End Function
Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(1)) Then
 Set First = Item(1)
 Else
 First = Item(1)
 End If
End Function
Public Function FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."
 
 Dim result As New LinqEnumerable
 result.AddArray values
 
 Set FromArray = result
 
End Function
Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromCollection = result
 
End Function
Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
 
 Dim result As LinqEnumerable
 Set result = LinqEnumerable.FromArray(value.ToArray)
 
 Set FromEnumerable = result
 
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromList = result
 
End Function
Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."
 Dim result As LinqEnumerable
 If index > Count Then Err.Raise 9
 Dim lastIndex As Long
 lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)
 Set result = New LinqEnumerable
 Dim i As Long
 For i = index To lastIndex
 result.Add Item(i)
 Next
 Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 If Count = 0 Then IndexOf = -1: Exit Function
 
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then IndexOf = i: Exit Function
 Next
 IndexOf = -1
End Function
Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(Count)) Then
 Set Last = Item(Count)
 Else
 Last = Item(Count)
 End If
End Function
Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 LastIndexOf = -1
 If Count = 0 Then Exit Function
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then LastIndexOf = i
 Next
End Function
Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."
 Dim result() As Variant
 ReDim result(1 To Count)
 Dim i As Long
 If Count = 0 Then Exit Function
 For i = 1 To Count
 If IsObject(Item(i)) Then
 Set result(i) = Item(i)
 Else
 result(i) = Item(i)
 End If
 Next
 
 ToArray = result
End Function
Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."
 
 Dim result As New Scripting.Dictionary
 
 Dim value As Variant
 For Each value In encapsulated
 
 If valueSelector Is Nothing Then
 result.Add keySelector.Execute(value), value
 Else
 result.Add keySelector.Execute(value), valueSelector.Execute(value)
 End If
 Next
 
 Set ToDictionary = result
 
End Function
Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."
 Dim result As New VBA.Collection
 
 Dim value As Variant
 For Each value In encapsulated
 result.Add value
 Next
 
 Set ToCollection = result
End Function
Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."
 
 Dim result As System.List
 Set result = List.Create
 result.AddArray Me.ToArray
 
 Set ToList = result
 
End Function
Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."
 
 Dim result As LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 If TypeName(element) = value Then result.Add element
 Next
 
 Set OfTypeName = result
 
End Function
Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 result.Add selector.Execute(element)
 Next
 
 Set SelectValues = result
 
End Function
Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 
 'verbose, but works with anything that supports a For Each loop
 
 Dim subList As Variant
 Set subList = selector.Execute(element)
 
 Dim subElement As Variant
 For Each subElement In subList
 result.Add subElement
 Next
 
 Next
 
 Set SelectMany = result
 
End Function
Public Function Aggregate(ByVal accumulator As Delegate) As Variant
Attribute Aggregate.VB_Description = "Applies an accumulator function over a sequence."
 Dim result As Variant
 Dim isFirst As Boolean
 Dim value As Variant
 For Each value In encapsulated
 If isFirst Then
 result = value
 isFirst = False
 Else
 result = accumulator.Execute(result, value)
 End If
 Next
 Aggregate = result
End Function
Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."
 Dim result As New LinqEnumerable
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result.Add element
 Next
 
 Set Where = result
End Function
Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set FirstWhere = element
 Else
 FirstWhere = element
 End If
 Exit Function
 End If
 Next
 
End Function
Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."
 
 Dim result As Variant
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set result = element
 Else
 result = element
 End If
 End If
 Next
 
 If IsObject(result) Then
 Set LastWhere = result
 Else
 LastWhere = result
 End If
 
End Function
Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."
 Dim result As Long
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result = result + 1
 Next
 CountIf = result
End Function
Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."
 
 Dim element As Variant
 For Each element In encapsulated
 If Not predicate.Execute(element) Then
 Exit Function
 End If
 Next
 
 AllItems = True
 
End Function
Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 AnyItem = True
 Exit Function
 End If
 Next
End Function

###Example

Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")
Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
 .Aggregate(accumulator)

Produces this output:

fox brown quick the

members of LinqEnumerable

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
 Dim equatable As IEquatable
 If TypeOf value Is IEquatable Then
 
 Set equatable = value
 EquateReferenceTypes = equatable.Equals(other)
 Else
 
 EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
 End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
 EquateValueTypes = (value = other)
End Function
Friend Sub Add(ParamArray values())
 Dim valuesArray() As Variant
 valuesArray = values
 AddArray valuesArray
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
 AddArray values.ToArray
End Sub
Friend Sub AddArray(values() As Variant)
 Dim value As Variant, i As Long
 For i = LBound(values) To UBound(values)
 encapsulated.Add values(i)
 Next
End Sub
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
 If IsObject(encapsulated(index)) Then
 Set Item = encapsulated(index)
 Else
 Item = encapsulated(index)
 End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
 Set NewEnum = encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
 Count = encapsulated.Count
End Property
Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
 Contains = (IndexOf(value) <> -1)
End Function
Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not result.Contains(value) Then result.Add value
 Next
 
 Set Distinct = result
 
End Function
Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not values.Contains(value) Then result.Add value
 Next
 
 Set Except = result
 
End Function
Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(1)) Then
 Set First = Item(1)
 Else
 First = Item(1)
 End If
End Function
Public Function FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."
 
 Dim result As New LinqEnumerable
 result.AddArray values
 
 Set FromArray = result
 
End Function
Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromCollection = result
 
End Function
Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
 
 Dim result As LinqEnumerable
 Set result = LinqEnumerable.FromArray(value.ToArray)
 
 Set FromEnumerable = result
 
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromList = result
 
End Function
Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."
 Dim result As LinqEnumerable
 If index > Count Then Err.Raise 9
 Dim lastIndex As Long
 lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)
 Set result = New LinqEnumerable
 Dim i As Long
 For i = index To lastIndex
 result.Add Item(i)
 Next
 Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 If Count = 0 Then IndexOf = -1: Exit Function
 
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then IndexOf = i: Exit Function
 Next
 IndexOf = -1
End Function
Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(Count)) Then
 Set Last = Item(Count)
 Else
 Last = Item(Count)
 End If
End Function
Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 LastIndexOf = -1
 If Count = 0 Then Exit Function
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then LastIndexOf = i
 Next
End Function
Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."
 Dim result() As Variant
 ReDim result(1 To Count)
 Dim i As Long
 If Count = 0 Then Exit Function
 For i = 1 To Count
 If IsObject(Item(i)) Then
 Set result(i) = Item(i)
 Else
 result(i) = Item(i)
 End If
 Next
 
 ToArray = result
End Function
Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."
 
 Dim result As New Scripting.Dictionary
 
 Dim value As Variant
 For Each value In encapsulated
 
 If valueSelector Is Nothing Then
 result.Add keySelector.Execute(value), value
 Else
 result.Add keySelector.Execute(value), valueSelector.Execute(value)
 End If
 Next
 
 Set ToDictionary = result
 
End Function
Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."
 Dim result As New VBA.Collection
 
 Dim value As Variant
 For Each value In encapsulated
 result.Add value
 Next
 
 Set ToCollection = result
End Function
Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."
 
 Dim result As System.List
 Set result = List.Create
 result.AddArray Me.ToArray
 
 Set ToList = result
 
End Function
Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."
 
 Dim result As LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 If TypeName(element) = value Then result.Add element
 Next
 
 Set OfTypeName = result
 
End Function
Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 result.Add selector.Execute(element)
 Next
 
 Set SelectValues = result
 
End Function
Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 
 'verbose, but works with anything that supports a For Each loop
 
 Dim subList As Variant
 Set subList = selector.Execute(element)
 
 Dim subElement As Variant
 For Each subElement In subList
 result.Add subElement
 Next
 
 Next
 
 Set SelectMany = result
 
End Function
Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."
 Dim result As New LinqEnumerable
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result.Add element
 Next
 
 Set Where = result
End Function
Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set FirstWhere = element
 Else
 FirstWhere = element
 End If
 Exit Function
 End If
 Next
 
End Function
Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."
 
 Dim result As Variant
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set result = element
 Else
 result = element
 End If
 End If
 Next
 
 If IsObject(result) Then
 Set LastWhere = result
 Else
 LastWhere = result
 End If
 
End Function
Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."
 Dim result As Long
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result = result + 1
 Next
 CountIf = result
End Function
Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."
 
 Dim element As Variant
 For Each element In encapsulated
 If Not predicate.Execute(element) Then
 Exit Function
 End If
 Next
 
 AllItems = True
 
End Function
Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 AnyItem = True
 Exit Function
 End If
 Next
End Function

members of LinqEnumerable

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
 Dim equatable As IEquatable
 If TypeOf value Is IEquatable Then
 
 Set equatable = value
 EquateReferenceTypes = equatable.Equals(other)
 Else
 
 EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
 End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
 EquateValueTypes = (value = other)
End Function
Friend Sub Add(ParamArray values())
 Dim valuesArray() As Variant
 valuesArray = values
 AddArray valuesArray
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
 AddArray values.ToArray
End Sub
Friend Sub AddArray(values() As Variant)
 Dim value As Variant, i As Long
 For i = LBound(values) To UBound(values)
 encapsulated.Add values(i)
 Next
End Sub
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
 If IsObject(encapsulated(index)) Then
 Set Item = encapsulated(index)
 Else
 Item = encapsulated(index)
 End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
 Set NewEnum = encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
 Count = encapsulated.Count
End Property
Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
 Contains = (IndexOf(value) <> -1)
End Function
Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not result.Contains(value) Then result.Add value
 Next
 
 Set Distinct = result
 
End Function
Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In encapsulated
 If Not values.Contains(value) Then result.Add value
 Next
 
 Set Except = result
 
End Function
Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(1)) Then
 Set First = Item(1)
 Else
 First = Item(1)
 End If
End Function
Public Function FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."
 
 Dim result As New LinqEnumerable
 result.AddArray values
 
 Set FromArray = result
 
End Function
Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromCollection = result
 
End Function
Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
 
 Dim result As LinqEnumerable
 Set result = LinqEnumerable.FromArray(value.ToArray)
 
 Set FromEnumerable = result
 
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
 
 Dim result As New LinqEnumerable
 
 Dim value As Variant
 For Each value In values
 result.Add value
 Next
 
 Set FromList = result
 
End Function
Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."
 Dim result As LinqEnumerable
 If index > Count Then Err.Raise 9
 Dim lastIndex As Long
 lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)
 Set result = New LinqEnumerable
 Dim i As Long
 For i = index To lastIndex
 result.Add Item(i)
 Next
 Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 If Count = 0 Then IndexOf = -1: Exit Function
 
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then IndexOf = i: Exit Function
 Next
 IndexOf = -1
End Function
Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."
 If Count = 0 Then Exit Function
 
 If IsObject(Item(Count)) Then
 Set Last = Item(Count)
 Else
 Last = Item(Count)
 End If
End Function
Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."
 Dim found As Boolean
 Dim isRef As Boolean
 LastIndexOf = -1
 If Count = 0 Then Exit Function
 Dim i As Long
 For i = 1 To Count
 If IsObject(Item(i)) Then
 found = EquateReferenceTypes(value, Item(i))
 Else
 found = EquateValueTypes(value, Item(i))
 End If
 If found Then LastIndexOf = i
 Next
End Function
Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."
 Dim result() As Variant
 ReDim result(1 To Count)
 Dim i As Long
 If Count = 0 Then Exit Function
 For i = 1 To Count
 If IsObject(Item(i)) Then
 Set result(i) = Item(i)
 Else
 result(i) = Item(i)
 End If
 Next
 
 ToArray = result
End Function
Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."
 
 Dim result As New Scripting.Dictionary
 
 Dim value As Variant
 For Each value In encapsulated
 
 If valueSelector Is Nothing Then
 result.Add keySelector.Execute(value), value
 Else
 result.Add keySelector.Execute(value), valueSelector.Execute(value)
 End If
 Next
 
 Set ToDictionary = result
 
End Function
Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."
 Dim result As New VBA.Collection
 
 Dim value As Variant
 For Each value In encapsulated
 result.Add value
 Next
 
 Set ToCollection = result
End Function
Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."
 
 Dim result As System.List
 Set result = List.Create
 result.AddArray Me.ToArray
 
 Set ToList = result
 
End Function
Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."
 
 Dim result As LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 If TypeName(element) = value Then result.Add element
 Next
 
 Set OfTypeName = result
 
End Function
Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 result.Add selector.Execute(element)
 Next
 
 Set SelectValues = result
 
End Function
Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."
 
 Dim result As New LinqEnumerable
 
 Dim element As Variant
 For Each element In encapsulated
 
 'verbose, but works with anything that supports a For Each loop
 
 Dim subList As Variant
 Set subList = selector.Execute(element)
 
 Dim subElement As Variant
 For Each subElement In subList
 result.Add subElement
 Next
 
 Next
 
 Set SelectMany = result
 
End Function
Public Function Aggregate(ByVal accumulator As Delegate) As Variant
Attribute Aggregate.VB_Description = "Applies an accumulator function over a sequence."
 Dim result As Variant
 Dim isFirst As Boolean
 Dim value As Variant
 For Each value In encapsulated
 If isFirst Then
 result = value
 isFirst = False
 Else
 result = accumulator.Execute(result, value)
 End If
 Next
 Aggregate = result
End Function
Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."
 Dim result As New LinqEnumerable
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result.Add element
 Next
 
 Set Where = result
End Function
Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set FirstWhere = element
 Else
 FirstWhere = element
 End If
 Exit Function
 End If
 Next
 
End Function
Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."
 
 Dim result As Variant
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 If IsObject(element) Then
 Set result = element
 Else
 result = element
 End If
 End If
 Next
 
 If IsObject(result) Then
 Set LastWhere = result
 Else
 LastWhere = result
 End If
 
End Function
Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."
 Dim result As Long
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then result = result + 1
 Next
 CountIf = result
End Function
Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."
 
 Dim element As Variant
 For Each element In encapsulated
 If Not predicate.Execute(element) Then
 Exit Function
 End If
 Next
 
 AllItems = True
 
End Function
Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."
 Dim element As Variant
 For Each element In encapsulated
 If predicate.Execute(element) Then
 AnyItem = True
 Exit Function
 End If
 Next
End Function

###Example

Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")
Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
 .Aggregate(accumulator)

Produces this output:

fox brown quick the
Source Link
Mathieu Guindon
  • 75.5k
  • 18
  • 194
  • 467
Loading
lang-vb

AltStyle によって変換されたページ (->オリジナル) /