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