Skip to content

Instantly share code, notes, and snippets.

@miau
Created February 3, 2011 01:23
Show Gist options
  • Save miau/808871 to your computer and use it in GitHub Desktop.
Save miau/808871 to your computer and use it in GitHub Desktop.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "OrderedDictionary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private m_Dic As Object
Private m_Keys As Collection
Private Sub Class_Initialize()
Set m_Dic = CreateObject("Scripting.Dictionary")
Set m_Keys = New Collection
End Sub
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = m_Keys.[_NewEnum]
End Function
Public Sub Add(ByVal key As Variant, ByVal NewItem As Variant)
On Error GoTo ERR_HAND
m_Dic.Add key, NewItem
m_Keys.Add key
Exit Sub
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Sub
Public Property Get Count() As Long
Count = m_Keys.Count
End Property
Public Function Exists(ByVal key As Variant) As Boolean
Exists = m_Dic.Exists(key)
End Function
Public Property Get Item(ByVal key As Variant) As Variant
Attribute Item.VB_UserMemId = 0
On Error GoTo ERR_HAND
If IsObject(m_Dic(key)) Then
Set Item = m_Dic(key)
Else
Item = m_Dic(key)
End If
Exit Property
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Property
Public Property Let Item(ByVal key As Variant, ByVal NewItem As Variant)
On Error Resume Next
Me.Remove key
On Error GoTo ERR_HAND
Me.Add key, NewItem
Exit Property
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Property
Public Function Items() As Variant()
Items = m_Dic.Items
End Function
Public Function Keys() As Variant()
On Error Resume Next
Keys = CollectionToArray(m_Keys)
Exit Function
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Function
Public Sub Remove(ByVal key As Variant)
If Not m_Dic.Exists(key) Then
Exit Sub
End If
On Error GoTo ERR_HAND
m_Dic.Remove key
Dim i As Integer
For i = 1 To m_Keys.Count
If m_Keys(i) = key Then
m_Keys.Remove i
Exit Sub
End If
Next
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Sub
Public Sub RemoveAll()
On Error GoTo ERR_HAND
m_Dic.RemoveAll
Set m_Keys = Nothing
Set m_Keys = New Collection
Exit Sub
ERR_HAND:
Err.Raise Err.Number, "OrderedDictionary Class", Err.Description
End Sub
Public Function Inspect() As String
Dim key As Variant
Dim result As String
result = "{"
For Each key In Me
If result <> "{" Then
result = result & ", "
End If
result = result & key & ": "
If TypeName(Me(key)) = "OrderedDictionary" Then
result = result & Me(key).Inspect
ElseIf TypeName(Me(key)) = "Collection" Then
result = result & "[" & Join(CollectionToArray(Me(key)), ", ") & "]"
ElseIf IsObject(Me(key)) Then
result = result & TypeName(Me(key))
Else
result = result & Me(key)
End If
Next
result = result & "}"
Inspect = result
End Function
Private Function CollectionToArray(col As Collection) As Variant()
Dim result As Variant
ReDim result(1 To col.Count)
Dim i As Integer
For i = 1 To col.Count
If IsObject(col(i)) Then
Set result(i) = col(i)
Else
result(i) = col(i)
End If
Next
CollectionToArray = result
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment