I found it would be really helpful to iterate through a dictionary object with
the For Each/Next Loop as well as the For/Next loop and access items by their index position.
I created a wrapper Class and several of the methods/properties which allowed me to index through
the dictionary but didn't see how to implement the For Each loop with a class object. I found an extended dictionary class code on
the net which used the object property to return the dictionary object itself. It was also a
more elegant implementation so I used the basic class code and included additional properties
and methods. The class code is listed at the end. One caveat with using the index access method
is that it shouldn't be used with a numeric key. That would confuse it. Use some non-numeric key
if you're creating the key iteratively, ie something like "key" & i or "#" & i.
I hope you find this useful.
Class xDictionary extends the VBscript Dictionary object with these
additional methods and properties.
Object - Returns the actual dictionary object
Sort - Sorts the dictionary key-item pairs
UnSort - Randomizes the dictionary key-items pairs, can't use reserved keywords Random or Randomize
SortedKeys - Returns an array of sorted keys
UnSortedKeys - Returns an array of randomized keys
item(index) - returns the item at the ordinal position index
AddFromDictionary( dictionary object ) - Adds the key-item pairs from a dictionary object
LoadFromDictionary( dictionary object ) - Removes all key-item pairs then adds the key-item pairs
xKey(index) - returns the key from the ordinal position index
How to use:
Replace
Code: Select all
Dim oTestDB : Set oTestDB = CreateObject("Scripting.Dictionary")
Code: Select all
Dim oTestDB : Set oTestDB = New xDictionary
Sample code to demonstrate sort and unsort methods
Add items to the dictionary:
Code: Select all
Dim oTestDB : Set oTestDB = New xDictionary
Dim sKey,i,a
Call oTEstDB.Add("C","Cat")
Call oTestDB.Add("A","Apple")
Call oTestDB.Add("B","Bat")
Code: Select all
oTestDB.Sort
These two methods to iterate through the dictionary will
produce the same results. First, using a For Each loop:
Code: Select all
For each sKey in oTestDB.Object ' note the use of the Object property
msgbox(oTestDB.Item(skey))
Next
Code: Select all
For i = 0 to oTest.DB.count-1
msgbox(oTestDB.Item(i))
Next
Code: Select all
oTestDB.UnSort
Code: Select all
oTestDB.Item(2)="Ball"
Code: Select all
oTestDB.Remove(0)
Here's a more practical, working example using UnSort to Randomize a playlist:
Code: Select all
Sub RandomizePlaylist(arg)
Dim i
Dim oSongList : Set oSongList = SDB.CurrentSongList
Dim oTrackList : Set oTrackList = New xDictionary
Dim oNewSongList : Set oNewSongList = SDB.NewSongList
Dim oCurrentNode : Set oCurrentNode = SDB.MainTree.CurrentNode
Dim oPlayList : Set oPlayList = sdb.playlistbytitle( oCurrentNode.caption )
If not (oCurrentNode.NodeType=61) Then
Exit Sub
End If
' add each track to the dictionary
For i = 0 to oSongList.count - 1
If not (oTrackList.Exists(oSongList.Item(i).Title & oSongList.Item(i).ArtistName)) Then
Call oTrackList.Add(oSongList.Item(i).Title & oSongList.Item(i).ArtistName, oSongList.Item(i))
End If
Next
' Randomize the dictionary
oTrackList.Unsort
' Create an SDB.SongList of the randomized tracks
For i = 0 to oTrackList.Count-1
oNewSongList.Add(oTrackList.Item(i))
Next
' Clear the playlist and add back the sorted tracks
oPlayList.clear
oPlayList.AddTracks(oNewSongList)
Set oNewSongList = Nothing
End Sub
an item for each Artist and the item itself is a dictionary object
containing all tracks for that artist. With the extended dictionary it
was easy to randomize the artist as well as the tracks for each artist:
Code: Select all
' randomize the artists
TracksDB.UnSort
For each sKey in TracksDB.Object
' Randomize the tracks for this artist
TracksDB.item(sKey).unsort
Next
Below is the code for the extended dictionary class.
Code: Select all
Class xDictionary
'The actual dictionary that we will use
Private oDict
'Intialize event gets executed whenever an object is created
Sub Class_Initialize()
Set oDict = CreateObject("Scripting.Dictionary")
End Sub
'Executed when the object is destroyed
Sub Class_Terminate()
'Remove all the keys
oDict.RemoveAll
'Destroy the dictionary
Set oDict = Nothing
End Sub
'Returns the actual dictionary object. This allows to do pass dictionary
'to function which might support the actual dictionarty object such
'as for each key in xyz.object
Public Function Object()
Set Object = oDict
End Function
'Now we need add all functions that the Dictionary already supports
Public Property Get HashVal(Text)
HashVal = oDict.HashVal(Text)
End Property
'Method to add a Key Value Pair
Public Sub Add(ByVal Key, ByVal Item)
oDict.Add Key, Item
End Sub
'Return the array of keys
Public Function Keys()
Keys = oDict.Keys
End Function
'Return the array of keys sorted
Public Function SortedKeys()
SortedKeys = aSort(oDict.Keys)
End Function
'Return the array of keys Randomized
Public Function unSortedKeys()
UnSortedKeys = aRandom(oDict.Keys)
End Function
'Property to change key
Public Property Let Key(oldKey, newKey)
oDict.Key(oldKey) = newKey
End Property
'Returns array of items
Public Function Items()
Items = oDict.Items
End Function
'Check if certain key exists or not
Public Function Exists(Key)
Exists = oDict.Exists(Key)
End Function
'Remove All keys
Public Sub RemoveAll()
oDict.RemoveAll
End Sub
'Remove a specified key
Public Sub Remove (Key)
oDict.Remove GetKey(Key)
End Sub
'Get count of items in dictionary
Public Property Get Count()
Count = oDict.Count
End Property
'Get Property for CompareMode
Public Property Get CompareMode()
CompareMode = oDict.CompareMode
End Property
'Let Property for CompareMode
Public Property Let CompareMode(newMode)
oDict.CompareMode = newMode
End Property
' For testing purposes
Public Property Get xKey(key)
xKey = GetKey(key)
End Property
'Function to translate keys from Index to actual key
Private Function GetKey(Key)
'Return actual key in case we are not
'able to translate index to key
GetKey = Key
If IsNumeric(Key) Then
Dim KeyIndex
keyIndex = CInt(Key)
'Check if index is within range
If keyIndex < Me.Count Then
Dim aKeys
aKeys = Me.Keys
'Translate from Index to Key
GetKey = aKeys(keyIndex)
Exit Function
End If
End If
End Function
'Item is the Default property for dictionary. So we
'need to use default keyword with Property Get
'Default keyword can be used with a only one Function
'or Get Property
Public Default Property Get Item(Key)
'If an object is stored for the Key
'then we need to use Set to return the object
If IsObject(oDict.Item(GetKey(Key))) Then
Set Item = oDict.Item(GetKey(Key))
Else
Item = oDict.Item(GetKey(Key))
End If
End Property
'Let property Item
Public Property Let Item(Key, Value)
'Check if the value is an object
If IsObject(Value) Then
'The value is an object, use the Set method
Set oDict(GetKey(Key)) = Value
Else
'The value is not an object assign it
oDict(GetKey(Key)) = Value
End If
End Property
'Property Set Item
Public Property Set Item(Key, Value)
Set oDict(GetKey(Key)) = Value
End Property
' Rebuild the dictionary with sorted keys
Public Sub Sort()
Dim oTempDic : Set oTempDic = CreateObject("Scripting.Dictionary")
Dim a,sKey
a = me.SortedKeys
For each sKey in a
oTempDic.Add skey, oDict.item(sKey)
Next
me.LoadFromDictionary(oTempDic)
End Sub
' Rebuild the dictionary with Randomized keys - can't use Randomize keyword
Public Sub unSort()
Dim oTempDic : Set oTempDic = CreateObject("Scripting.Dictionary")
Dim a,sKey
a = me.UnsortedKeys
For each sKey in a
oTempDic.Add skey, oDict.item(sKey)
Next
me.LoadFromDictionary(oTempDic)
End Sub
' Simple Bubble Sort - could add a second param to indicate Ascending or Descending
Private Function aSort(a)
Dim i,j,temp,myArray
myArray=a
for i = UBound(myArray) - 1 To 0 Step -1
for j= 0 to i
if myArray(j)>myArray(j+1) then ' change to >
temp=myArray(j+1)
myArray(j+1)=myArray(j)
myArray(j)=temp
end if
next
next
asort=myArray
End Function ' Sort
' Randomize Array
Private Function aRandom(a)
Dim i,j,r,temp,myArray
myArray=a
Randomize
for i = 0 to Ubound(myArray)
r=Int((Ubound(myArray) + 1) * Rnd)
temp=myArray(i)
myArray(i)=myArray(r)
myArray(r)=temp
next
aRandom=myArray
End Function
'AddFromDictionary takes an actual dictionary object and
'add all keys from it
Public Sub AddFromDictionary(oldDict)
Dim aKeys,sKey
aKeys = oldDict.Keys
For Each sKey In aKeys
oDict.Add sKey, oldDict.item(sKey)
Next
End Sub
'LoadFromDictionary function removes all keys
'and then add the keys from dictionary. It is
'equivalent of creating a clone from a existing
'dictionarty object
Public Sub LoadFromDictionary(oldDict)
oDict.RemoveAll
Me.AddFromDictionary oldDict
End Sub
End Class