Yaslaw.Info

User Tools

Site Tools

You are here: Yaslaw.Info » VBA » Klassen » [VBA] Iterator » Code
Trace:
vba:classes:iterator:code

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
Next revision 		Previous revision
vba:classes:iterator:code [24.03.2014 15:01:37]
yaslaw 		vba:classes:iterator:code [19.11.2014 09:04:25] (current)
yaslaw
Line 1: Line 1:
 ====== Code ====== ====== Code ======
-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 +>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 
-<code vb Iterator.cls>​ +<source ​'/​vba/​classes/​iterator.cls' ​vb>
-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.0.0 +
-'Name         : Iterator +
-'​Author ​      : Stefan Erb (ERS) +
-'​History ​     : 28.02.2014 - ERS - Creation +
-' ​            : 03.03.2014 - ERS - DAO.Recordset und DAO.Fields hinzugefügt +
-' ​            : 05.03.2014 - ERS - iParams mit itNothingAsEmptyList hinzugefügt +
-' ​                                 Property Value und Method toKey() hinzugefügt +
-' ​              ​17.03.2014 - ERS - Fehler im initialze() behoben +
-' ​                                 Methode toEOF() hinzugfügt +
-' ​                                 Property lastIndex 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 +
-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 keys() ​     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 +
- +
-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 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(keys(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 Static Function initialize( _ +
-        ByRef iList As Variant, _ +
-        Optional ByVal iParams As itParams = itDefault _ +
-) As Boolean +
-    Dim i +
- +
-    myParams = iParams +
- +
-    '​Diverse Vorprüfungen:​ +
-    'Falls Null, Nothing, Empty, ""​ als leere Liste gewertet werden soll, ein leeres Array erstellen +
-    If IsNull(iList) And (iParams And itNothingAsEmptyList) Then        'iList ist Null +
-        iList = Array() +
-    ElseIf IsObject(iList) And (iParams And itNothingAsEmptyList) 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 (iParams And itNothingAsEmptyList) 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 itDictionary: ​     keys = iList.keys ​          '​Das Dictionary bracuht den Key um auf den  Wert zuzugreifen. Dieser wird hier extrahiert +
-        Case itMatch: ​          ref map, iList.SubMatches ​  '​Bei Matches ist die Liste im Attribut SubMatches versteckt. Der Rest vom Match isnteressiert uns nicht weiter +
-        Case itDaoFields,​ itProperties: ​                    '​DAO.Fields bekommen den Feldnamen als Key +
-            ReDim keys(count - 1)                           '​Keys-Array dimensionieren +
-            For i = 0 To count - 1                          'Alle Keys auslesen +
-                keys(i) = map(i).name +
-            Next i +
-        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 itNoList: ​         Err.Raise IT_ERR_NOT_SUPPORTED_MAP,​ "​Iterator.init",​ "​Parameter is not a supported map" +
-    End Select +
-    cnt = count                         '​Count ​ speichern +
-    Call reset                          'Den Zeiger auf BOF setzen +
- +
-    If Me.isEmpty And (iParams And itErrorAtEmptyList) Then Err.Raise IT_ERR_EMPTY_MAP,​ "​Iterator.init",​ "Empty Map" +
- +
-    initialize = Not Me.isEmpty +
- +
-    '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 +
- +
-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 +
-    Call 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 +
-    Call 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 +
-    Call 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 +
-    Call 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 +
-    Call 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:​ +
-            pPos = posFromKey(iKey) +
-        Case Else: +
-            pPos = iKey - delta +
-    End Select +
-    '​Mittels toPosition zur Position springen +
-    toKey = toPosition(pPos,​ , 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 (myParams And itListNextNoParamsAsToNext) 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 (myParams And itDaoValue) 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 +
- +
-'​------------------------------------------------------------------------------- +
-'-- 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 keys(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) +
-    Select Case listType +
-        Case itDaoRecordset:​ +
-            map.absolutePosition = Me.absolutePosition +
-            '​map.Move Me.absolutePosition,​ rsStart +
-            ref oItem, map.fields +
-        Case itDaoFields:​ +
-            ref oItem, map(Me.absolutePosition) +
-        Case Else: +
-            ref oItem, map(Me.KEY) +
-    End Select +
-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 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  'Wennd ie 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 ( _ +
-                myParams And itIndexInsteadKey _ +
-            ) _ +
-    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 +
- +
-'​------------------------------------------------------------------------------- +
-' -- 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 +
-    On Error Resume Next +
-    Call getCurrent(current) +
-    If Err.number <> 0 Then value = "#ERR (" & Err.number & ") " & Err.description +
-End Property +
- +
-'/** +
-' * Gibt den Value aus. Bei den meisten Listen entspricht das dem current. +
-' */ +
-Public Property Get value() As Variant +
-    Select Case listType +
-        Case itDaoFields,​ itMatch, itProperties:​ +
-            On Error Resume Next +
-            ref value, current.value ​       '​Value-Property auslesen +
-            If Err.number <> 0 Then value = "#ERR (" & Err.number & ") " & Err.description +
-        Case Else: +
-            ref value, current +
-    End Select +
-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:​ +
-            KEY = keys(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 +
- +
-'/** +
-' * 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 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 +
-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 +
-</code>+
vba/classes/iterator/code.1395669697.txt.gz · Last modified: 24.03.2014 15:01:38 (external edit)

Page Tools

Except where otherwise noted, content on this wiki is licensed under the following license: GNU Free Documentation License 1.3
GNU Free Documentation License 1.3 Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki