Results 1 to 3 of 3

Thread: Collection extended: find out keys of a Collection

Threaded View

  1. #3

    Thread Starter
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Collection extended: find out keys of a Collection

    Here is an extension to the module: SetColItem. It lets you change a Collection item without removing it first.

    Code:
    Public Sub SetColItem(Collection As Collection, NewItem, Optional ByVal Index As Long, Optional Key As String)
        Dim lngA As Long, lngCurPtr As Long, lngHeader(5) As Long, lngKeyPtr As Long, lngPtr() As Long, lngVarHead(5) As Long, varArray()
        If Not Collection Is Nothing Then
            ' now have a go at this...
            If (LenB(Key) > 0) Or (Index >= 1 And Index <= Collection.Count) Then
                ' we do not want to have API calls in a loop because they're slow
                ' we can avoid that by faking a safe array to our liking!
                lngHeader(0) = 1 ' dimensions
                lngHeader(1) = 4 ' bytes per item
                lngHeader(4) = 1 ' number of items
                ' put lngPtr array into our control
                PutMem4 ArrayPtr(lngPtr), VarPtr(lngHeader(0))
                ' we have to loop...
                If LenB(Key) Then
                    ' work on key
                    lngKeyPtr = StrPtr(Key)
                    ' starting pointer: we trick to begin from the last item
                    lngCurPtr = ObjPtr(Collection) + 8
                    ' and then we loop...
                    For Index = Collection.Count To 1 Step -1
                        ' pointer change: get previous item
                        lngHeader(3) = lngCurPtr + 20
                        ' remember current pointer
                        lngCurPtr = lngPtr(0)
                        ' pointer change: get string pointer
                        lngHeader(3) = lngCurPtr + 16
                        ' compare for equality
                        If lngPtr(0) Then If lstrcmpiW(lngPtr(0), lngKeyPtr) = 0 Then Exit For
                    Next Index
                Else
                    ' work on index
                    If Index < Collection.Count \ 2 Then
                        ' pointer change: get first item
                        lngHeader(3) = ObjPtr(Collection) + 24
                        ' loop from beginning to end
                        For lngA = 2 To Index
                            ' pointer change: get next item
                            lngHeader(3) = lngPtr(0) + 24
                        Next lngA
                    Else
                        ' pointer change: get last item
                        lngHeader(3) = ObjPtr(Collection) + 28
                        ' loop from end to beginning
                        For lngA = Collection.Count - 1 To Index Step -1
                            ' pointer change: get previous item
                            lngHeader(3) = lngPtr(0) + 20
                        Next lngA
                    End If
                    lngCurPtr = lngPtr(0)
                End If
                ' if Index is set then we can go on
                If Index Then
                    ' the cool stuff continues: now we create a Variant array
                    lngVarHead(0) = 1
                    lngVarHead(1) = 16
                    lngVarHead(3) = lngCurPtr
                    lngVarHead(4) = 1
                    PutMem4 ArrayPtr(varArray), VarPtr(lngVarHead(0))
                    ' then we do just the simplest thing of replacing a Variant with another...
                    If VarType(NewItem) <> vbObject Then
                        varArray(0) = NewItem
                    Else
                        Set varArray(0) = NewItem
                    End If
                    PutMem4 ArrayPtr(varArray), 0
                End If
                ' we are done with that trick, reset lngPtr to null
                PutMem4 ArrayPtr(lngPtr), 0
            Else
                ' Index Out Of Range
                Err.Raise 9
            End If
        Else
            ' No Object
            Err.Raise 91
        End If
    End Sub
    Probably not one of the most useful things out there, but this brings out a new possible idea: a CollectionToArray converter method that could return a Variant array with the items and a String array with keys, and which efficiently clears up the Collection as it goes. Although I don't know what a Collection would like if it had just null items before being destroyed, but I guess that is something I'll just see if I bother with this.


    ... and by going further, by having such arrays it would be easily possible to make a sorter that would sort Collection items by their respective key! Sorting the actual items makes no sense since a Collection item can be anything, and that makes it unsortable. The keys are sortable as they're always strings.
    Last edited by Merri; May 31st, 2009 at 05:45 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width