Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

A simple doublely linked list class

Total Hit ( 1804)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Click here to copy the following block
Option Explicit

'
' A simple doublely linked list class
'

Private m_head As clsListItem
Private m_tail As clsListItem
Private m_cur As clsListItem

Private m_count As Long
'
' Adds ItemData to the head of the linked list
'
Public Sub AddFirst(ItemData As Variant)
  Dim Item As New clsListItem

  If VarType(ItemData) = vbObject Then
    Set Item.ItemData = ItemData
  Else
    Item.ItemData = ItemData
  End If

  If (m_head Is Nothing) Then
    Set m_head = Item
    Set m_tail = Item
    Set m_cur = Item
  Else
    Set Item.NextItem = m_head
    Set Item.PrevItem = Nothing
    Set Item.NextItem.PrevItem = Item
    Set m_head = Item
  End If
  
  m_count = m_count + 1
End Sub

'
' Adds ItemData to the end of the linked list.
'
Public Sub AddLast(ItemData As Variant)
  Dim Item As New clsListItem

  If VarType(ItemData) = vbObject Then
    Set Item.ItemData = ItemData
  Else
    Item.ItemData = ItemData
  End If

  If (m_tail Is Nothing) Then
    Set m_head = Item
    Set m_tail = Item
    Set m_cur = Item
  Else
    Set Item.PrevItem = m_tail
    Set Item.NextItem = Nothing
    Set Item.PrevItem.NextItem = Item
    Set m_tail = Item
  End If
  
  m_count = m_count + 1
End Sub

'
' Returns the number of items in the linked list.
'
Property Get Count() As Long
  Count = m_count
End Property

'
' Returns the current item.
'
Property Get CurrentItem() As Variant
  If m_cur Is Nothing Then
   CurrentItem = Null
  Else
   If VarType(m_cur.ItemData) = vbObject Then
     Set CurrentItem = m_cur.ItemData
   Else
     CurrentItem = m_cur.ItemData
   End If
  End If
End Property

'
' Sets the current item.
'
Property Let CurrentItem(ItemData As Variant)
  If Not m_cur Is Nothing Then
   m_cur.ItemData = ItemData
  End If
End Property
Property Set CurrentItem(ItemData As Variant)
  If Not m_cur Is Nothing Then
   Set m_cur.ItemData = ItemData
  End If
End Property
'
' Inserts ItemData after the current item in the list.
'
Public Sub InsertAfter(ItemData As Variant)
  Dim Item As New clsListItem

  If VarType(ItemData) = vbObject Then
    Set Item.ItemData = ItemData
  Else
    Item.ItemData = ItemData
  End If

  If (m_cur Is Nothing) Then
    Set m_head = Item
    Set m_tail = Item
    Set m_cur = Item
  Else
    Set Item.NextItem = m_cur.NextItem
    Set Item.PrevItem = m_cur
    Set m_cur.NextItem = Item
    'Add the following line.
    Set m_cur.NextItem.PrevItem = Item
    
    If (m_cur.NextItem Is Nothing) Then
      Set m_tail = m_cur
    End If
  End If
  
  m_count = m_count + 1
End Sub

'
' Delete's the
'
Public Sub DeleteAll()
  Dim m As clsListItem
  Dim m2 As clsListItem
 
  m = m_head
 
  Do While Not (m Is Nothing)
   Set m2 = m.NextItem
   Set m.NextItem = Nothing
   Set m.PrevItem = Nothing
   Set m = m2
  Loop
 
  m_head = Nothing
  m_tail = Nothing
  m_cur = Nothing
  m_count = 0
End Sub
 
Public Sub DeleteCurrent()
  Dim tmp As clsListItem

  If (m_cur Is Nothing) Then
    Exit Sub
  End If

  If (m_cur.PrevItem Is Nothing) Then
    '
    ' Delete head of list
    '
    Set m_head = m_cur.NextItem
    If (m_head Is Nothing) Then
      '
      ' Also deleting tail, list becomes empty
      '
      Set m_tail = Nothing
      Set m_cur = Nothing
    Else
      Set m_head.PrevItem = Nothing
      Set m_cur = m_head
    End If
  ElseIf (m_cur.NextItem Is Nothing) Then
    '
    ' Deleting end of list
    '
    Set m_tail = m_cur.PrevItem
    If (m_tail Is Nothing) Then
      '
      ' Also deleting head, list becomes empty
      '
      Set m_head = Nothing
      Set m_cur = Nothing
    Else
      Set m_cur = m_tail
      Set m_cur.NextItem = Nothing
    End If
  Else
    '
    ' Delete somewhere inside of list
    '
    Set tmp = m_cur.NextItem
    Set m_cur.PrevItem.NextItem = m_cur.NextItem
    Set m_cur.NextItem.PrevItem = m_cur.PrevItem
    Set m_cur = tmp
  End If
  
  m_count = m_count - 1
End Sub
'
' Return's the first item in the list.
'
Public Function FirstItem() As Variant
  If (m_head Is Nothing) Then
    FirstItem = Null
  Else
    If (VarType(m_head.ItemData) = vbObject) Then
      Set FirstItem = m_head.ItemData
    Else
      FirstItem = m_head.ItemData
    End If
    Set m_cur = m_head
  End If
End Function


'
' Returns the next item in the list.
'
Public Function NextItem() As Variant
  If (m_cur Is Nothing) Then
    NextItem = Null
    Debug.Print "First Null"
  Else
    If (m_cur Is Nothing) Then
      NextItem = Null
    Else
      Set m_cur = m_cur.NextItem
      If (VarType(m_cur.ItemData) = vbObject) Then
        Set NextItem = m_cur.ItemData
      Else
        NextItem = m_cur.ItemData
      End If
    End If
  End If
End Function

'
' Returns the last item in the list.
'
Public Function LastItem() As Variant
  If (m_tail Is Nothing) Then
    LastItem = Null
  Else
    Set m_cur = m_tail
    If (VarType(m_cur.ItemData) = vbObject) Then
      Set LastItem = m_cur.ItemData
    Else
      LastItem = m_cur.ItemData
    End If
  End If
End Function

'
' Returns the previous item in the list.
'
Public Function PrevItem() As Variant
  If (m_cur Is Nothing) Then
    PrevItem = Null
  Else
    If (m_cur.PrevItem Is Nothing) Then
      PrevItem = Null
    Else
      Set m_cur = m_cur.PrevItem
      If (VarType(m_cur.ItemData) = vbObject) Then
        Set PrevItem = m_cur.ItemData
      Else
        PrevItem = m_cur.ItemData
      End If
    End If
  End If
End Function


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.