diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3c2cbf0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ + +bin/~$LinqVBA.xlsm diff --git a/src/CallByFunc.cls b/src/CallByFunc.cls index eb34fe6..ca3eca1 100644 --- a/src/CallByFunc.cls +++ b/src/CallByFunc.cls @@ -13,53 +13,37 @@ Implements IFunc Option Explicit 'スコープ適当。Argumentsをどんな形で見せるか… -Private clsMemberName As String -Private clsCallType As VBA.VbCallType -Private clsArguments() As Variant -Private clsChildCallBack As IFunc +Private memberName_ As String +Private callType_ As VBA.VbCallType +Private arguments_() As Variant +Private childFunc_ As IFunc -Property Get MemberName() As String: Let MemberName = clsMemberName: End Property -Property Get CallType() As VBA.VbCallType: Let CallType = clsCallType: End Property -Function Arguments() As Variant: Let Arguments = clsArguments: End Function -Property Get ChildCallBack() As IFunc: Set ChildCallBack = clsChildCallBack: End Property -Property Set ChildCallBack(ByVal iCB As IFunc): Set clsChildCallBack = iCB: End Property +Property Get MemberName() As String: Let MemberName = memberName_: End Property +Property Get CallType() As VBA.VbCallType: Let CallType = callType_: End Property +Property Get Arguments() As Variant: Let Arguments = arguments_: End Property +Property Get ChildFunc() As IFunc: Set ChildFunc = childFunc_: End Property +Property Set ChildFunc(ByVal func As IFunc): Set childFunc_ = func: End Property 'コンストラクタ・既定のプロシージャ - '既定のインスタンスを使って - 'CallByFunc( 〜 - 'と使用することを想定 - -Public Function Init( _ - ByVal iMemeberName As String, _ - ByVal iCallType As VBA.VbCallType, _ - ParamArray iArgs() As Variant _ +Friend Function Init( _ + ByVal iMemeberName As String, _ + ByVal iCallType As VBA.VbCallType, _ + ByRef iArgs() As Variant _ ) As CallByFunc -Attribute Init.VB_UserMemId = 0 -' - 'Attribute Init.VB_UserMemId = 0 If Me Is CallByFunc Then - Dim callArgs() As Variant - ReDim callArgs(LBound(iArgs) To UBound(iArgs) + 2) - callArgs(0) = iMemeberName: callArgs(1) = iCallType - Dim i As Long - For i = 2 To UBound(callArgs) - callArgs(i) = iArgs(i - 2) - Next i - - Dim tCallByFunc As CallByFunc - Set tCallByFunc = New CallByFunc - Set Init = CallByNameEx(tCallByFunc, "Init", VbMethod, callArgs) - Exit Function + With New CallByFunc + Set Init = .Init(iMemeberName, iCallType, iArgs) + End With 'New CallByFunc Else - Static alreadyInit As Boolean - If alreadyInit Then Err.Raise 17 + If alreadyInit Then _ + ThrowLINQ InvalidOperationException - Let clsMemberName = iMemeberName - Let clsCallType = iCallType - Let clsArguments = iArgs + Let memberName_ = iMemeberName + Let callType_ = iCallType + Let arguments_ = iArgs Let alreadyInit = True @@ -67,19 +51,28 @@ Attribute Init.VB_UserMemId = 0 End If End Function -Function SetChild(ByVal callBack As IFunc) As CallByFunc - Set clsChildCallBack = callBack +Function SetChild(ByVal func As IFunc) As CallByFunc + Set childFunc_ = func Set SetChild = Me End Function +Function RemoveChild() As CallByFunc + Set childFunc_ = Nothing + Set RemoveChild = Me +End Function + +Function AsIFunc() As IFunc + Set AsIFunc = Me +End Function + Private Function IFunc_Exec(iElement As Variant) As Variant Dim tmp As Variant - AssignVal tmp, CallByNameEx(iElement, clsMemberName, clsCallType, clsArguments) + AssignVal tmp, CallByNameEx(iElement, memberName_, callType_, arguments_) - If clsChildCallBack Is Nothing Then + If childFunc_ Is Nothing Then AssignVal IFunc_Exec, tmp Else - AssignVal IFunc_Exec, clsChildCallBack.Exec(tmp) + AssignVal IFunc_Exec, childFunc_.Exec(tmp) End If End Function diff --git a/src/CompareOperator.cls b/src/CompareOperator.cls index 0fc3e3d..7946763 100644 --- a/src/CompareOperator.cls +++ b/src/CompareOperator.cls @@ -39,19 +39,16 @@ Public Expression As Variant Private clsRegExp As VBScript_RegExp_55.RegExp - -Public Function Init( _ +Friend Function Init( _ ByVal iOperator As CompareOperators, _ ByVal iExpresion As Variant _ ) As CompareOperator -Attribute Init.VB_UserMemId = 0 'Attribute Init.VB_UserMemId = 0 - - + If Me Is CompareOperator Then With New CompareOperator Set Init = .Init(iOperator, iExpresion) - End With + End With 'New CompareOperator Exit Function End If diff --git a/src/Enumerable.cls b/src/Enumerable.cls index 2203057..d7eda85 100644 --- a/src/Enumerable.cls +++ b/src/Enumerable.cls @@ -9,40 +9,129 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Option Explicit -Private clsCollection As VBA.Collection +Private sequence_ As VBA.Collection Public Function From(ByVal iEnumerable As Variant) As Enumerable Attribute From.VB_UserMemId = 0 'Attribute From.VB_UserMemId = 0 + If Me Is Enumerable Then + With New Enumerable + Set From = .From(iEnumerable) + End With 'New Enumerable + Exit Function + End If + If TypeOf iEnumerable Is VBA.Collection Then - Set clsCollection = iEnumerable + Set sequence_ = iEnumerable Else - Set clsCollection = New VBA.Collection + Set sequence_ = New VBA.Collection Dim iter As Variant For Each iter In iEnumerable - clsCollection.Add iter + sequence_.Add iter Next iter End If Set From = Me End Function -Public Function Where(ByVal iPredicate As IFunc) As Enumerable +'Selectが予約語なのでSelect1 +'Select is reserved as VBA keyword. +Public Function Select1(ByVal func As IFunc) As Enumerable + Dim newCol As VBA.Collection: Set newCol = New VBA.Collection + + Dim iter As Variant + For Each iter In sequence_ + newCol.Add func.Exec(iter) + Next iter + + Set Select1 = Enumerable.From(newCol) +End Function + +Public Function SelectMany(ByVal func As IFunc) As Enumerable + Dim newCol As VBA.Collection: Set newCol = New VBA.Collection + + Dim iter As Variant, childIter As Variant + For Each iter In sequence_ + For Each childIter In func.Exec(iter) + newCol.Add childIter + Next childIter + Next iter + + Set SelectMany = Enumerable.From(newCol) +End Function + +Public Sub ForEach(ByVal func As IFunc) + Dim iter As Variant + For Each iter In sequence_ + Call func.Exec(iter) + Next iter +End Sub + +Public Function Where(ByVal predicate As IFunc) As Enumerable + Dim newCol As VBA.Collection: Set newCol = New VBA.Collection + + Dim iter As Variant + For Each iter In sequence_ + If predicate.Exec(iter) Then _ + newCol.Add iter + + Next iter + + Set Where = Enumerable.From(newCol) +End Function + +Public Function OfType(ByVal iTypeName As String) As Enumerable Dim newCol As VBA.Collection: Set newCol = New VBA.Collection Dim iter As Variant - For Each iter In clsCollection - If iPredicate.Exec(iter) Then + For Each iter In sequence_ + If VBA.TypeName(iter) Like iTypeName Then _ newCol.Add iter - End If + + Next iter + + Set OfType = Enumerable.From(newCol) +End Function + +Public Function OrderBy(ByVal func As IFunc) As Enumerable + Set OrderBy = Enumerable.From(MergeSort(sequence_, func, True)) +End Function + +Public Function OrderByDescending(ByVal func As IFunc) As Enumerable + Set OrderByDescending = Enumerable.From(MergeSort(sequence_, func, False)) +End Function + +Public Function ToCollection() As VBA.Collection + Dim newCol As VBA.Collection: Set newCol = New VBA.Collection + + Dim iter As Variant + For Each iter In sequence_ + newCol.Add iter Next iter - Set Where = LinqFrom(newCol) + Set ToCollection = newCol + End Function +Public Function Count(Optional ByVal predicate As IFunc) As Long + If predicate Is Nothing Then + Let Count = sequence_.Count + Exit Function + End If + + Dim iter As Variant, cnt As Long + For Each iter In sequence_ + If predicate.Exec(iter) Then _ + cnt = cnt + 1 + + Next iter + + Let Count = cnt + +End Function Public Function GetEnumerator() As stdole.IEnumVARIANT Attribute GetEnumerator.VB_UserMemId = -4 'Attribute GetEnumerator.VB_UserMemId = -4 - Set GetEnumerator = clsCollection.[_NewEnum] + Set GetEnumerator = sequence_.[_NewEnum] End Function diff --git a/src/IFunc.cls b/src/IFunc.cls new file mode 100644 index 0000000..0aa2789 --- /dev/null +++ b/src/IFunc.cls @@ -0,0 +1,16 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IFunc" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +'JPN:汎用コールバック用インターフェイス +Option Explicit + +'JPN:何かしらの処理を実行する +Public Function Exec(iElement As Variant) As Variant +Attribute Exec.VB_UserMemId = 0 +End Function