Diesen Code nicht einfach als Text in eine Class kopieren! Damit die Attribute item und NewEnum als Standarts definiert werden, muss der Code über Visual Basic → Import importieren

Iterator.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Iterator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Iterator
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/classes/iterator
'Environment  : VBA 2007+
'Version      : 2.2.0
'Name         : Iterator
'Author       : Stefan Erb (ERS)
'History      : 28.02.2014 - ERS - Creation
'               ...
'               22.04.2014 - ERS - Excel Workbook uns Sheets hinzugefügt
'                                  extractKeysTo() und den Parameter keys hinzugefügt
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
'/**
' * Parameter zur Steuerung des Verhalten des Iterators
' * Die einzelnen Parameter sind mit + kombinierbar
' */
Public Enum itParams
    itNone = 0                          'Kein Parameter hat gültigkeit
    itNothingAsEmptyList = 2 ^ 0        'Leerer String, Nothing, Empty, Null wird als leere Liste akzeptiert und wirft kein Fehler
    itListNextNoParamsAsToNext = 2 ^ 1  'Wenn bei listNext keine Parameter angeben werden, einfach eins vorrücken.
    itErrorAtEmptyList = 2 ^ 2          'Fehler generieren, wenn die iListe leer ist
    itDaoValue = 2 ^ 3                  'Field-Value anstelle von Field ausgeben
    itIndexInsteadKey = 2 ^ 4                     'Gibt bei den toX() Funktionen den Index anstelle des Keys zurück
    itDefault = itNothingAsEmptyList + itListNextNoParamsAsToNext
    [_LAST] = 4
End Enum
 
'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
Private Const IT_ERR_NO_PARAMS = vbObjectError + 5000           'Bei einer list-Funktion wurden keine Parameter übergeben
Private Const IT_ERR_NOT_SUPPORTED_MAP = vbObjectError + 5001   'Ist keine bekannte Liste
Private Const IT_ERR_EMPTY_MAP = vbObjectError + 5002           'Die Liste ist leer
Private Const IT_ERR_KEY_NOT_FOUND = vbObjectError + 5003       'Der angegebene Key wurde nicht in der Liste gefunden
 
'/**
' * Interne Typenunterscheidung der Liste
' */
Private Enum itListType
    itArray
    itDictionary
    itCollection
    itMatchCollection
    itMatch
    itDaoRecordset
    itDaoFields
    itDaoField
    itProperties
    itNoList
    itExcelWoorkbook
    itExcelSheets
End Enum
 
Private map         As Variant      'Die Liste selber
Private col         As Collection   'Für den ForEach braucht es leider eine Collection-Class
Private listType    As itListType   'Typ der Liste
Private pos         As Long         'Absolute Position, beginnend bei 0
Private myKeys()    As Variant      'Auflistung der Keys. Wird nur bei Dictionaries, DAO.Fields und Properties gebraucht
Private delta       As Long         'Index-Abweichung des ersten Indexes zu 0: Index = pos + delta
Private cnt         As Long         'Anzahl Einträge
Private myParams    As itParams     'Parameters
Private subItCache()    As Iterator
 
Public Event arriveEndOf(pos As PositionEnum)
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
 
' -- COLLECTION METHODES ---
' http://msdn.microsoft.com/en-us/library/aa262338%28v=vs.60%29.aspx
 
'/**
' * Der NewEnum wird für die For Each.. Next Schleife verwendet
' *
' * Diese Funktion hat das Attribut "'Attribute NewEnum.VB_UserMemId = -4"
' * !! Diese Iterierung hat keinen Einfluss auf die aktuelle Position !!
' *
' * @return Das nächste element
' */
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = col.[_NewEnum]
End Function
 
 
'/**
' * Entspricht dem item()-Befehl der Listenobjekte
' * Alle 3 Propert-Funktionen aben das versteckte Attribut "Attribute item.VB_UserMemId = 0"
' * Dadurch kann mittels it(1), it("MyFeild"), it!MyField etc darauf zugegriffen werden.
' *
' * !! Das Verhalten dieser Funktion ist NICHT standartisiert. Sie entspricht dem entsprechenden Verhalten der Source !!
' *
' * @param  Variant Index/Key
' * @return Variant
' */
Public Property Get Item(ByVal iIndex As Variant) As Variant
Attribute Item.VB_UserMemId = 0
'Attribute item.VB_UserMemId = 0
    Select Case listType
        Case itDaoFields, itDaoRecordset:       'Bei FieldListen je nach Parameter das Field oder den Value ausgeben
            ref Item, IIf((myParams And itDaoValue), map(iIndex).value, map(iIndex))
        Case itDictionary:                      'Bei Dictionaries über den Key zugreiffen
            If IsNumeric(iIndex) Then
                ref Item, map(myKeys(iIndex))
            Else
                ref Item, map(iIndex)
            End If
        Case Else:
            ref Item, map(iIndex)
    End Select
End Property
 
'//TODO: ALlgemein das Ändern der zugrundeliegenden Daten ermöglichen
 
'Public Property Let item(ByVal iIndex As Variant, ByRef iValue As Variant)
''Attribute item.VB_UserMemId = 0
'End Property
'Public Property Set item(ByVal iIndex As Variant, ByRef iValue As Variant)
''Attribute item.VB_UserMemId = 0
'End Property
 
 
' -- OTHER METHODES ---
 
'/**
' * Initialisuert den Iterator
' * @param  Variant     Die Liste, über welche Iteriert werden soll
' * @param  itParams    Parameters
' * @return Boolean     true: iList ist eine Liste und hat Werte
' */
Public Function initialize( _
        ByRef iList As Variant, _
        Optional ByVal iParams As itParams = itDefault _
) As Boolean
    Dim i
On Error GoTo Err_Handler
 
    myParams = iParams
 
    'Diverse Vorprüfungen:
    'Falls Null, Nothing, Empty, "" als leere Liste gewertet werden soll, ein leeres Array erstellen
    If IsNull(iList) And Me.paramNothingAsEmptyList Then        'iList ist Null
        iList = Array()
    ElseIf IsObject(iList) And Me.paramNothingAsEmptyList Then  'iList ist Nothing -> Ein Objekt
        If iList Is Nothing Then iList = Array()
    ElseIf IsArray(iList) Then
        'Platzhalter, damit bei einem Array nicht der vergleich iList="" ausgeführt wird, der zu einem Fehler führen würde
    ElseIf Me.paramNothingAsEmptyList And (VBA.isEmpty(iList) Or iList = "") Then 'iList ist kein Objekt
        iList = Array()
    End If
 
    ref map, iList                      'Liste übernehmen
    listType = getListType(iList)       'Art der Liste ermitteln
 
    delta = 0                           'Index = AbsolutPosition + delta
 
SPEZ:                                   'Spezialsettings der einzelnen ListenTypen
    Select Case listType
        Case itArray:           delta = LBound(map)         'Der Array beginnt bei lbound(list) zu zählen
        Case itCollection:      delta = 1                   'Die Cellection beginnt bei 1 mit Zählen
        Case itMatch:           ref map, iList.SubMatches   'Bei Matches ist die Liste im Attribut SubMatches versteckt. Der Rest vom Match isnteressiert uns nicht weiter
        Case itDaoField:
            listType = itProperties                         'ListType als itProperties setzen
            ref map, iList.Properties                       'Properties als map übernehmen
            GoTo SPEZ                                       'Die Definition für itProperties übernhemen
        Case itExcelWoorkbook:
            listType = itExcelSheets                        'WorkSheet als Sheets setzen
            ref map, iList.Sheets                           'Sheets als map übernehmen
            GoTo SPEZ                                       'Die Definition für itExcelSheets übernhemen
        Case itExcelSheets:     delta = 1
        Case itNoList:          Err.Raise IT_ERR_NOT_SUPPORTED_MAP, "Iterator.init", "Parameter is not a supported map"
    End Select
 
    cnt = count                         'Count  speichern
    createKeyList                       'Keys erstellen
    Call reset                          'Den Zeiger auf BOF setzen
 
    If Me.isEmpty And Me.paramErrorAtEmptyList Then Err.Raise IT_ERR_EMPTY_MAP, "Iterator.init", "Empty Map"
 
    'Für "For Each value in it" braucht es leider iene Collection
    'Darum wird hier alles in eine eigene Collection abgefüllt
    Set col = New Collection
    Do While Me.toNext
        col.Add Me.current
    Loop
    Me.reset
 
    'Cache für SubIterator initialisieren
    If Not Me.isEmpty Then ReDim subItCache(Me.lastIndex)
 
    initialize = Not Me.isEmpty
 
Exit_Handler:
    Exit Function
Err_Handler:
    Debug.Assert False
    Err.Raise Err.number, Err.Source, Err.description, Err.helpContext, Err.helpContext
    GoTo Exit_Handler
    Resume
End Function
 
'/**
' * Analog zu initialze. Erstellt aber direkt ein Recordset aus einem SQL
' * @param  String      SLQ String
' * @param  itParams    Parameters
' * @return Boolean     true: iList ist eine Liste und hat Werte
' */
Public Static Function initializeRs( _
        ByVal iSql As String, _
        Optional ByVal iParams As itParams = itDefault _
) As Boolean
    Dim db  As Database:    Set db = CurrentDb
    initializeRs = Me.initialize(CurrentDb.OpenRecordset(iSql, dbOpenSnapshot, dbReadOnly), iParams)
    Set db = Nothing
End Function
 
'/**
' * Geht zum nächsten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toNext( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = pos + 1
    toNext = Not EOF:   If Not toNext Then RaiseEvent arriveEndOf(adPosEOF): Exit Function
    keyOrIndex oKey
    getCurrent oItem
End Function
 
'/**
' * Geht zum nächsten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toPrev( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = pos - 1
    toPrev = Not BOF:   If Not toPrev Then RaiseEvent arriveEndOf(adPosBOF):  Exit Function
    keyOrIndex oKey
    getCurrent oItem
End Function
 
'/**
' * Geht zum ersten Datensatz.
' * Vorsicht, während reset() eins vor den ersten Datensatz geht, geht toFirst() bereits auf den ersten Datensatz
' * Somit ists das eigentlich reset()+toNext()
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toFirst( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = 0
    toFirst = Not EOF:   If Not toFirst Then RaiseEvent arriveEndOf(adPosEOF):  Exit Function
    keyOrIndex oKey
    getCurrent oItem
End Function
 
'/**
' * Geht zum nächsten Datensatz. Der Key und er Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder pos des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toLast( _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = cnt - 1
    toLast = Not BOF:   If Not toLast Then RaiseEvent arriveEndOf(adPosBOF):  Exit Function
    keyOrIndex oKey
    getCurrent oItem
End Function
 
'/**
' * Geht zu einer spezifischen Position (begnnt bei 0). Der Key und der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Long        Absolute Position. Zwischen 0 und Count-1
' * @param  Variant     Key oder index des Items
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toPosition( _
        ByVal iAbsolutPosition As Long, _
        Optional ByRef oKey As Variant = Null, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    pos = iAbsolutPosition
    toPosition = Not BOF And Not EOF
    If Not toPosition Then RaiseEvent arriveEndOf(adPosUnknown):  Exit Function
    keyOrIndex oKey
    getCurrent oItem
End Function
 
'/**
' * Geht zu einem spezifischen Key. Der Datensatz werden als Parameter zurückgegeben, EOF als Return-Value
' * @param  Variant     Key oder index des Items (je nach Item)
' * @param  Variant     Das Item himself
' * @return Boolean     EOF
Public Function toKey( _
        ByRef iKey As Variant, _
        Optional ByRef oItem As Variant = Null _
) As Boolean
    Dim pPos As Long
    'Die Position ermitteln
    Select Case listType
        Case itDictionary, itDaoFields, itProperties, itExcelWoorkbook:
            pPos = posFromKey(iKey)
        Case Else:
            pPos = iKey - delta
    End Select
    'Mittels toPosition zur Position springen
    toKey = toPosition(pPos, , oItem)
    getCurrent oItem
End Function
 
'/**
' * Rückt den Zeiger um Eins vor und gibt die Elemente einer Unterliste aus.
' * @paramArray Variant    Auflistung der Variablen, die abgefüllt werden
' * @return     EOF
' */
Public Function listNext( _
        ParamArray oParams() As Variant _
) As Boolean
    Dim aParams()   As Variant: aParams = oParams
    Dim i As Long
 
    'Wenn keine Parameter übergeben werden, das ganze abbrechen.
    If UBound(oParams) = -1 And Not Me.paramListNextNoParamsAsToNext Then
        Err.Raise IT_ERR_NO_PARAMS, "Iterator.listNext", "no Parametes defined"
    End If
 
    listNext = toNext()
    listNext = listArray(aParams)
    If Not listNext Then Exit Function  'SubItem ist keine gültige Liste -> Exit
    For i = 0 To UBound(oParams)
        If listType = itDaoRecordset And Me.paramDaoValue Then
            ref oParams(i), aParams(i).value
        Else
            ref oParams(i), aParams(i)
        End If
    Next i
End Function
 
'/**
' * Ggibt die Elemente der aktuellen Unterliste aus.
' * @paramArray Variant    Auflistung der Variablen, die abgefüllt werden
' * @return EOF & BOF
' */
Public Function list( _
        ParamArray oParams() As Variant _
) As Boolean
    Dim aParams()   As Variant: aParams = oParams
    Dim i As Long
 
    'Wenn keine Parameter übergeben werden, das ganze abbrechen.
    If UBound(oParams) = -1 Then Err.Raise IT_ERR_NO_PARAMS, "Iterator.listNext", "no Parametes defined"
 
    list = listArray(aParams)
    'Parameter zurückschreiben
    For i = 0 To UBound(oParams):  oParams(i) = aParams(i):  Next i
End Function
 
'/**
' * Setzt den pos auf den Start-1 zurück, so dass bei einem toNext() der erste Datensatz kommt
' */
Public Sub reset()
    pos = -1
End Sub
 
'/**
' * Setzt den pos 1 nach dem Ende
' */
Public Sub toEOF()
    pos = Me.count
End Sub
 
'/**
' * Extrahiert die Keys in eine Liste. Die Liste kann vom Type Array, Collection oder Dictionary sein
' * @param  Variant     Liste in welche die Keys extrahiert werden soll
' * @param  Variant     Bei einem Dictionary kann ein Default-Value mitgegeben werden. In Dem Fall wird der Key auch als Key in das Dictionary eingetragen
' * @return Boolean     Angabe, ob das extrahieren erfolgreich war
' */
Public Function extractKeysTo(ByRef iList As Variant, Optional ByVal iDicDefaultValue As Variant = "NO_DEFAULT") As Boolean
    Dim i
 
    If Not isEmpty Then
        Select Case getListType(iList)
            Case itArray:
                iList = myKeys
                extractKeysTo = True:   Exit Function
            Case itCollection:
                For i = LBound(myKeys) To UBound(myKeys)
                    iList.Add myKeys(i)
                Next i
                extractKeysTo = True:   Exit Function
            Case itDictionary:
                For i = LBound(myKeys) To UBound(myKeys)
                    If iDicDefaultValue = "NO_DEFAULT" Then
                        iList.Add , myKeys(i)
                    Else
                        iList.Add myKeys(i), iDefaultValue
                    End If
                Next i
                extractKeysTo = True:   Exit Function
        End Select
    End If
    extractKeysTo = False
End Function
 
'-------------------------------------------------------------------------------
'-- Private Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Ermittelt die Position eines Keys
' * @param  Variant Key
' * @retrun Long
' */
Private Function posFromKey(ByVal iKey As Variant) As Long
    Dim flag As Boolean
    For posFromKey = 0 To cnt - 1
        If myKeys(posFromKey) = iKey Then
            flag = True
            Exit For
        End If
    Next posFromKey
    If flag = False Then Err.Raise IT_ERR_KEY_NOT_FOUND, "Iterator.toKey", "Key '" & iKey & "' not found in list"
End Function
 
'/**
' * Gibt eine Referenz auf das Item zurück
' * @param  oItem       Ausgabeparameter: das aktuelle Item
' */
Private Sub getCurrent(Optional ByRef oItem As Variant = Null, Optional ByVal iDaoValue As Boolean = False)
    Dim curr As Variant
On Error GoTo Err_Handler
 
    Select Case listType
        Case itDaoRecordset:
            map.absolutePosition = Me.absolutePosition
            'map.Move Me.absolutePosition, rsStart
            ref curr, map.fields
        Case itDaoFields:
            ref curr, map(Me.absolutePosition)
        Case Else:
            ref curr, map(Me.KEY)
    End Select
 
    ref oItem, curr
 
    'ggf Value anstelle des Current zurückgeben
    If Me.paramDaoValue Or iDaoValue Then
        Select Case listType
            Case itDaoFields, itMatch, itProperties:
                On Error Resume Next
                ref oItem, curr.value        'Value-Property auslesen
                If Err.number <> 0 Then value = "#ERR (" & Err.number & ") " & Err.description
        End Select
    End If
 
Exit_Handler:
    Exit Sub
Err_Handler:
    Debug.Assert False
    Err.Raise Err.number, Err.Source, Err.description, Err.helpContext, Err.helpContext
    GoTo Exit_Handler
    Resume
End Sub
 
'/**
' * Bei einer Variablenübergabe muss immer unterscheiden werden, ob es ein Objekt ist oder nicht.
' * Diese Sub nimmt einem die Arbeit ab
' * oNode = iNode
' * @param  Variant     Variable, die den Wert bekommen soll
' * @param  Variant     Ret Wert selber
' */
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
    If IsObject(iNode) Then
        'Objekte als referenz übergeben
        Set oNode = iNode
    Else
        'Je nach Datentyp der erwartet wird handeln.
        Select Case TypeName(oNode)
            Case "String":      oNode = CStr(Nz(iNode))
            Case "Integer":     oNode = CInt(Nz(iNode))
            Case "Long":        oNode = CLng(Nz(iNode))
            Case "Double":      oNode = CDbl(Nz(iNode))
            Case "Byte":        oNode = CByte(Nz(iNode))
            Case "Decimal":     oNode = CDec(Nz(iNode))
            Case "Currency":    oNode = CCur(Nz(iNode))
            Case "Date":        oNode = CDate(Nz(iNode))
            Case "Nothing":
            Case Else:          oNode = iNode
        End Select
    End If
End Sub
 
'/**
' * Ermittelt den Type einer Liste
' * @param  Variant     Die Liste
' * @return itListType
' */
Private Function getListType(ByRef iList As Variant) As itListType
    If IsArray(iList) Then
                                        getListType = itArray
    Else
        Select Case TypeName(iList)
            Case "Dictionary":          getListType = itDictionary
            Case "Collection":          getListType = itCollection
            Case "IMatchCollection2":   getListType = itMatchCollection
            Case "IMatch2":             getListType = itMatch
            Case "Recordset2":          getListType = itDaoRecordset
            Case "Fields":              getListType = itDaoFields
            Case "Field2":              getListType = itDaoField
            Case "Properties":          getListType = itProperties
            Case "Sheets":              getListType = itExcelSheets
            Case "Workbook":            getListType = itExcelWoorkbook
            Case Else:                  getListType = itNoList
        End Select
    End If
End Function
 
'/**
' * Ggibt die Elemente der aktuellen Unterliste als Array aus.
' * @param  Array<Variant>    Auflistung der Variablen, die abgefüllt werden
' * @return EOF & BOF
' */
Private Function listArray( _
        ByRef oParams() As Variant _
) As Boolean
    Dim subList As Variant
    Dim uBnd    As Long:            uBnd = UBound(oParams)
    Dim iT      As New Iterator
 
    listArray = Not Me.EOF And Not Me.BOF
    If Not listArray Then Exit Function             'SubItem ist keine gültige Liste -> Exit
    If uBnd = -1 Then Exit Function                 'Keine Parameter zum abfüllen -> Exit
 
    iT.initialize Me.current                        'Iterator für die Subliste initializieren
 
    Do While iT.toNext
        If uBnd < iT.absolutePosition Then Exit Do  'Wenn die Parameter ausgehen, Do verlasssen
        ref oParams(iT.absolutePosition), iT.current
    Loop
End Function
 
'/**
' * Gibt je nach Datentyp von oKey und Settings den Key oder den Index zurück
' * Logik:  oKey ist ein Zahl, me.Key nicht -> Index
' *         Der Paramter itIndexInsteadKey wurde gesetzt -> Index
' *         Ansonsten -> Key
' * @param  Referenz auf den Key
' */
Private Sub keyOrIndex(ByRef oKey As Variant)
    If _
            ( _
                IsNumeric(oKey) _
                And Not IsNumeric(Me.KEY) _
            ) Or Me.paramIndexInsteadKey _
    Then
        'Index anstelle des Keys
        oKey = Me.absolutePosition
    Else
        'Key
        ref oKey, Me.KEY
    End If
End Sub
 
'/**
' * Setzt oder entfernt ein Parameter im myParams
' * @param  Boolean     Setzen = true, entfernen = false
' * @param  itParams    Parameter der gesetzt werden soll
' */
Private Sub setParam(ByVal iFlag As Boolean, ByVal iParam As itParams)
    If iFlag And Not CBool(myParams And iParam) Then
        'Flag ist auf setzen, Para ist noch nicht gesetzt
        myParams = myParams + iParam
    ElseIf Not iFlag And CBool(myParams And iParam) Then
        'Flag ist False, Parameter ist vorerst noch gesetzt
        myParams = myParams - iParam
    End If
End Sub
 
'/**
' * erstellt die Key-Liste
Private Sub createKeyList()
    Dim i
    If Not isEmpty Then
        ReDim myKeys(delta To cnt - 1 + delta)
        Select Case listType
            Case itDictionary:
                myKeys = map.keys
            Case itDaoFields, itProperties, itExcelSheets:
                For i = LBound(myKeys) To UBound(myKeys)
                    myKeys(i) = map(i).Name
                Next i
            Case Else
                For i = LBound(myKeys) To UBound(myKeys)
                    myKeys(i) = i
                Next i
        End Select
    End If
End Sub
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
 
'/**
' * Referent auf die Aktuelle Liste
' */
Public Property Get Source() As Variant
    ref Source, map
End Property
Public Property Let Source(ByRef iList As Variant)  'Setzen für Objekte
    Me.initialize iList
End Property
Public Property Set Source(ByRef iList As Variant)  'Setzen für Arrays
    Me.initialize iList
End Property
 
'/**
' * Gibt das aktuelle Item zurück
' */
Public Property Get current() As Variant
    getCurrent current
End Property
 
'/**
' * Gibt den Value aus. Bei den meisten Listen entspricht das dem current.
' */
Public Property Get value() As Variant
    getCurrent value, True
End Property
 
'/**
' * Key oder pos des aktuellen Item.
' * Bei Dictionaries ist es der Key, beim Rest der Index
' */
Public Property Get KEY() As Variant
    Select Case listType
        Case itDictionary, itProperties, itDaoFields, itExcelSheets, itExcelWoorkbook:
            KEY = myKeys(Me.index)        'Bei Dictioniraies, Fields, Properties, den KEY/Namen ausgeben
        Case Else:
            KEY = Me.index              'Ansonsten den Index
    End Select
End Property
 
'/**
' * Index des aktuellen Item. Auch bei Dictionaries wird der index ausgegeben, nicht der Key
' * Der Index kann je nach listType unterschiedlich beginnen. Bei Arrays beginnt er bei lbound(map), bei Collections mit 1 und beim Rest mit 0
' */
Public Property Get index() As Long
    index = pos + delta
End Property
 
'/**
' * Unabhängig von der Indexierung der Liste (lBound() bei Array, starten mit 1 bei Collection)
' * Die Absolute Position in der Liste, beginnend mit 0
' * Bei einer leeren Liste wird -1 ausgegeben
' */
Public Property Get absolutePosition() As Long
    absolutePosition = pos
End Property
 
'/**
' * End Of File
' */
Public Property Get EOF() As Boolean
    EOF = IIf(isEmpty, True, pos >= cnt)
End Property
 
'/**
' * Begin Of File
' */
Public Property Get BOF() As Boolean
    BOF = IIf(isEmpty, True, pos < 0)
End Property
 
'/**
' * Gibt die Anzhal Items der Liste zurück
' */
Public Property Get count() As Long
    If isEmpty Then
        count = 0
    Else
        Select Case listType
            Case itArray:
                count = (UBound(map) + 1) - LBound(map)
            Case itDaoRecordset:
                Dim bookmark As Variant:    bookmark = map.bookmark
                map.MoveLast
                count = map.recordCount
                map.bookmark = bookmark
            Case Else:
                count = map.count
        End Select
    End If
End Property
 
'/**
' * Letzter Index. UBOUND() eines Array.
' */
Public Property Get lastIndex() As Long
    lastIndex = Me.count - 1 + delta
End Property
 
'/**
' * Erster Index. LBOUND() eines Arrays
' */
Public Property Get firstIndex() As Long
    firstIndex = delta
End Property
 
'/**
' * Prüft ob die Liste leer ist
' */
Public Property Get isEmpty() As Boolean
    Select Case listType
        Case itArray:
            On Error Resume Next
            Dim dummy As Long: dummy = LBound(map)
            isEmpty = IIf(Err.number <> 0, True, UBound(map) < LBound(map))
        Case itDaoRecordset:
            isEmpty = (map.recordCount = 0)
        Case Else:
            isEmpty = (map.count = 0)
    End Select
End Property
 
'/**
' * Gibt current als Iterator zurück
' */
Public Property Get subIterator() As Iterator
    If subItCache(Me.absolutePosition) Is Nothing Then
        Set subItCache(Me.absolutePosition) = New Iterator
        subItCache(Me.absolutePosition).initialize Me.current
    End If
    Set subIterator = subItCache(Me.absolutePosition)
End Property
 
'/**
' * Die Parameter als Enum-Set
' * @param  itParam
' */
Public Property Get Params() As itParams
    Params = myParams
End Property
Public Property Let Params(ByVal iParams As itParams)
    myParams = iParams
End Property
 
'/**
' * Die Keys als Array
' */
Public Property Get keys() As Variant()
    keys = myKeys
End Property
 
' --  DIE SETTINGS ALS EINZELPROPERTIES ---
' Die Settings können über diese Properties nach dem Initialisieren einzeln gesetzt werden
 
'itNothingAsEmptyList = 2 ^ 0
'Leerer String, Nothing, Empty, Null wird als leere Liste akzeptiert und wirft kein Fehler
Public Property Get paramNothingAsEmptyList() As Boolean
    paramNothingAsEmptyList = (myParams And itNothingAsEmptyList)
End Property
'Da dieses Attribut beim initialize() verwendet wird, macht es keinen Sinn dieses Flag später zu ändern
'Public Property Let paramNothingAsEmptyList(ByVal iFlag As Boolean)
'    setParam iFlag, itNothingAsEmptyList
'End Property
 
'itListNextNoParamsAsToNext = 2 ^ 1
'Wenn bei listNext keine Parameter angeben werden, einfach eins vorrücken.
Public Property Get paramListNextNoParamsAsToNext() As Boolean
    paramListNextNoParamsAsToNext = (myParams And itListNextNoParamsAsToNext)
End Property
Public Property Let paramListNextNoParamsAsToNext(ByVal iFlag As Boolean)
    setParam iFlag, itListNextNoParamsAsToNext
End Property
 
'itErrorAtEmptyList = 2 ^ 2
'Fehler generieren, wenn die iListe leer ist
Public Property Get paramErrorAtEmptyList() As Boolean
    paramErrorAtEmptyList = (myParams And itErrorAtEmptyList)
End Property
Public Property Let paramErrorAtEmptyList(ByVal iFlag As Boolean)
    setParam iFlag, itErrorAtEmptyList
End Property
 
'itDaoValue = 2 ^ 3
'Field-Value anstelle von Field ausgeben
Public Property Get paramDaoValue() As Boolean
    paramDaoValue = (myParams And itDaoValue)
End Property
Public Property Let paramDaoValue(ByVal iFlag As Boolean)
    setParam iFlag, itDaoValue
End Property
 
'itIndexInsteadKey = 2 ^ 4
'Gibt bei den toX() Funktionen den Index anstelle des Keys zurück
Public Property Get paramIndexInsteadKey() As Boolean
    paramIndexInsteadKey = CBool(myParams And itIndexInsteadKey)
End Property
Public Property Let paramIndexInsteadKey(ByVal iFlag As Boolean)
    setParam iFlag, itIndexInsteadKey
End Property