如何在VB中实现循环链表.急用!

forever_chang(阿瑟大发) 的方法不行，没那么简单。
你用数组模拟链表好了
以下是一个双向链表的例子，供参考：
ClsItem.cls
**********************************************************
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
'Item.cls-This Class is simply the data structure for a doubly
'linked list.
'***************************************************************
Option Explicit'***************************************************************
'Data members
'***************************************************************
Public strData As String
Public intData As Integer
'***************************************************************
'Doubly-linked list Pointers
'**************************************************************
Public clsItemNext As clsItem
Public clsItemPrev As clsItem
listerhelper.bas
'*****************************************************
Attribute VB_Name = "ListHelpers"
Option Explicit
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 = clsNewItemEnd 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 = NothingEnd 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 = clsNewItemEnd Function
listdemo.frm
'***********************************************************
VERSION 5.00
Begin VB.Form listDemo
   Caption         =   "Form1"
   ClientHeight    =   3630
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6195
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   3630
   ScaleWidth      =   6195
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdRemoveItem
      Caption         =   "RemoveItem"
      Height          =   465
      Left            =   3300
      TabIndex        =   1
      Top             =   2160
      Width           =   1995
   End
   Begin VB.CommandButton cmdInsertBefore
      Caption         =   "InsertBefore"
      Height          =   465
      Left            =   660
      TabIndex        =   0
      Top             =   2160
      Width           =   1935
   End
End
Attribute VB_Name = "listDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'***************************************************************
'listDemo-Demonstratex one way to build and use a linked list
'***************************************************************'Form level pointer to the head and current item in the linked listPrivate mclsHead As New clsItem
Private mclsCurItem As clsItem'Build then initial list,set the Head,and does some prep workPrivate Sub Form_Load()
Dim i As Integer'Optional_label the head(helpful during debugging)
mclsHead.strData = "Head"'Set the current item to the headSet mclsCurItem = mclsHead'Create three items to give the user something play with
For i = 1 To 3
    Set mclsCurItem = _
       InsertAfter(mclsCurItem, "Item" & CStr(i), i)
Next i
'Code has been intentionally omitted from this listing
End Sub'Although VB is supposed to do clearup,Ifeel Better freeing the
'list mySelf,This is not a required element of this program.Private Sub Form_Unload(Cancel As Integer)
'let's bo good citizens and free list ourselves
Dim clsCurItem As clsItem
Set clsCurItem = mclsHead.clsItemNext
'Remove all of the items in the list(print the count in the
'immediate window
Do While Not (clsCurItem.clsItemNext Is Nothing)
  Set clsCurItem = RemoveItem(clsCurItem)
  Debug.Print ListHelpers.mintCount

Loop
End Sub'***************************************************************
'Iserts an item in the list before the iten specified by user
'***************************************************************Private Sub cmdInsertBefore_Click()
'Get a pointer to the item that will be after the newly
'inserted item.
Set mclsCurItem = GetIndex(mclsHead, , Val(InputBox _
   ("Enter a integer index:", _
   "IsertBefore", CStr(mclsCurItem.intData))))
'Insert the item in the list (using some generated default data)
Set mclsCurItem = InsertBefore(mclsCurItem, "Item" & _
CStr(ListHelpers.mintCount + 1), ListHelpers.mintCount + 1)
'If insertBefore worked,then update the listbox and labelsEnd Sub
'*****************************************************************
'Remove then current selected item
'*****************************************************************
Private Sub cmdRemoveItem_Click()'RemoveItem return a pointer to another item in the list, so
'keep that value for futher processingDim clsReturn As clsItem'Don't let the user remove the head(optional)If mclsCurItem.strData = mclsHead.strData Then
    MsgBox "You can't remove the head. please select snother item."
    Exit Sub
End If
'if there is more than one item in the list...
If ListHelpers.mintCount > 1 Then
     'remove the current item and catch the pointer to the item
     'return by removeitem.
    Set clsReturn = RemoveItem(mclsCurItem)
    'if return does'nt have an item in front of it ,then it
    'is tail.
    If clsReturn.clsItemNext Is Nothing Then
    'if nothing is before the item returned,then clsReturn
    'is the last item in the list(which is the head)
        If clsReturn.clsItemPrev Is Nothing Then
           Set mclsCurItem = Nothing
    'Otherwise set the current item to the 2nd to last item
        Else
           Set mclsCurItem = clsReturn.clsItemPrev
        End If

    'Otherwise, set the current item to whatever is front
    'of clsreturn(because clsreturn could be head)
    Else
      Set mclsCurItem = clsReturn.clsItemNext
    End If
End If

End Sub

调试易

如何在VB中实现循环链表.急用!

解决方案 »