VBA实现数据结构中的双向链表类

数据结构中双向链表(Double Linked List)是一类很重要的数据结构，这里水文工具集介绍一个使用VBA实现的双向链表的类模块，代码的一些说明如下：

clsItem类：类似于关联节点，包含了元素数据和前后节点的引用(类似于指针)

ListHelpers类：包含了一些双向链表操作函数

具体VBA实现代码如下：

Option Explicit
'================================
' VBA实现数据结构中的双向链表类
'
' 
'================================
Public mintCount As Integer

'Insert   a   new   item   in   the   linked   list   after   an   existing   item
Public Function InsertAfter(clsPrevious As clsItem, _
                            Optional StrData As String, _
                            Optional IntData As Integer) As clsItem
'if   clsPrevious   hasn't   been   initialized,then   bail...
    If clsPrevious Is Nothing Then
        MsgBox "InsertAfter   failed:   Previous   item   was   invalid", vbExclamation
        Exit Function
    End If
    'Create   the   new   item.
    Dim clsNewItem As New clsItem
    'If   the   clsPrevious   is   the   not   the   tail   item,   then   the   item   after
    'clsprevious   need   its   clsitemPrev   pointer   set   to   the   new   item.
    If Not (clsPrevious.clsItemNext Is Nothing) Then
        Set clsPrevious.clsItemNext.clsItemPrev = clsNewItem
    End If
    'Set   the   value   for   the   newly   created   item
    With clsNewItem
        .StrData = StrData
        .IntData = IntData
        Set .clsItemPrev = clsPrevious
        Set .clsItemNext = clsPrevious.clsItemNext
    End With
    'Pointer   the   previous   item   to   the   newly   created   item.
    Set clsPrevious.clsItemNext = clsNewItem
    'Increment   then   item   count
    mintCount = mintCount + 1
    'Return   a   pointer   to   then   newly   insert   item
    Set InsertAfter = clsNewItem
End Function

'Remove   a   item   in   the   doubly   liked   list
Public Function RemoveItem(clsItemToRemove As clsItem) As clsItem
'if   a   valid   item   was   not   passed,   then   bail...
    If clsItemToRemove Is Nothing Then
        MsgBox "You   can't   remove   a   uninitialized   item!", vbExclamation
    End If
    'if   then   item   to   remove   is   tail..
    If clsItemToRemove.clsItemNext Is Nothing Then
        'if   next=   nothing   &   prev=nothing,the   last   item   in   list.
        If clsItemToRemove.clsItemPrev Is Nothing Then
            MsgBox "Can't   remove   then   last   item   in   the   list!", vbExclamation
            'Return   a   pointer   to   then   clsItemtoRemove
            Set RemoveItem = clsItemToRemove
            Exit Function
            'Otherwise,remove   then   item   and   return   a   pointer   to   the
            'previous   item.
        Else
            Set clsItemToRemove.clsItemPrev.clsItemNext = _
            clsItemToRemove.clsItemNext
            Set RemoveItem = clsItemToRemove.clsItemPrev
        End If
        'Othenwise,   sonmething   must   be   after   the   item   to   remove...
    Else
        'if   clsItemToRemove   is   then   head,then   remove   then   head   and   set
        'new   head   of   the   list.
        'OPTIONAL:You   may   want   to   raise   an   error   here!
        If clsItemToRemove.clsItemPrev Is Nothing Then
            Set clsItemToRemove.clsItemNext.clsItemPrev = _
            clsItemToRemove.clsItemPrev
            Set RemoveItem = clsItemToRemove.clsItemNext
            'Otherwise   clsItemToremove   is   in   the   middle   of   the   list...
        Else
            Set clsItemToRemove.clsItemPrev.clsItemNext = _
            clsItemToRemove.clsItemNext
            Set clsItemToRemove.clsItemNext.clsItemPrev = _
            clsItemToRemove.clsItemPrev
            Set RemoveItem = clsItemToRemove.clsItemPrev
        End If
    End If
    'Decrement   then   linked   list   item   count
    mintCount = mintCount - 1
    'Destroy   the   item   to   be   removed
    Set clsItemToRemove = Nothing

End Function

'Return   a   pointer     to   a   specific   item   in   the   list
Public Function GetIndex(ClsStart As clsItem, Optional StrData$, _
                         Optional IntData As Integer) As clsItem
'if   the   user   didn't   tell   us   where   to   start,   then   bail...
    If ClsStart Is Nothing Then Exit Function
    'If   the   user   didn't   tell   us   which   item   to   select,   then   bail...
    If IntData = 0 And StrData = "" Then Exit Function
    'dim   a   pointer   for   iterating   though   the   linke   list
    Dim clsCurItem As clsItem
    'Set   then   pointer   to   item   the   user   told   us   to   begin   with
    Set clsCurItem = ClsStart
    'Linear   search   through   all   items   in   the   list
    Do While Not (clsCurItem.clsItemNext Is Nothing)
        With clsCurItem
            If .IntData = IntData Or .StrData = StrData Then
                'Return   a   pointer   to   the   found   item   and   exit
                Set GetIndex = clsCurItem
                Exit Function
            End If
            Set clsCurItem = .clsItemNext
        End With
    Loop
    'Check   the   data   members   of   the   last   item   in   the   list
    With clsCurItem
        If .IntData = IntData Or .StrData = StrData Then
            'Return   a   pointer   t   the   found   item
            Set GetIndex = clsCurItem
        End If
    End With
    'if   not   found,then   return   Nothing(by   doing   anything)

End Function


'Insert   a   new   item   in   the   linked   list   before   an   existing   item
Public Function InsertBefore(clsNext As clsItem, _
                             Optional StrData As String, _
                             Optional IntData As Integer) As clsItem
'if   clsNext   hasn't   been   initialized,then   bail...
    If clsNext Is Nothing Then
        MsgBox "InsertBefore   failed:   Next   item   was   invalid", vbExclamation
        Exit Function
    End If
    'Create   the   new   item.
    Dim clsNewItem As New clsItem
    'If   the   clsNext   is   the   not   the   Head   item,   then   the   item   before
    'clsNext   need   its   clsitemNext   pointer   set   to   the   new   item.
    If Not (clsNext.clsItemPrev Is Nothing) Then
        Set clsNext.clsItemPrev.clsItemNext = clsNewItem
    End If
    'Set   the   value   for   the   newly   created   item
    With clsNewItem
        .StrData = StrData
        .IntData = IntData
        Set .clsItemNext = clsNext
        Set .clsItemPrev = clsNext.clsItemPrev
    End With
    'Pointer   the   next   item   to   the   newly   created   item.
    Set clsNext.clsItemPrev = clsNewItem
    'Increment   then   item   count
    mintCount = mintCount + 1
    'Return   a   pointer   to   then   newly   insert   item
    Set InsertBefore = clsNewItem

End Function

clsItem类

Option Explicit

'Data   members
Public StrData As String
Public IntData As Integer
'Doubly-linked   list   Pointers
Public clsItemNext As clsItem
Public clsItemPrev As clsItem