vbAccelerator - Contents of code file: cIndexCollection.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cIndexCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'
' cIndexCollection
'
' Implements a collection intended to be accessed by
' Index using an array.  Reading items is very fast,
' as is adding or removing items from the end of the
' array, however, inserting or removing items from
' the start is very slow due to the number of
' shifts on the data we must perform
'


Private m_lItem() As Long
Private m_lCount As Long
Private m_lArraySize As Long
Private m_lAllocationSize As Long

Public Property Get AllocationSize() As Long
   AllocationSize = m_lAllocationSize
End Property
Public Property Let AllocationSize(ByVal lAllocationSize As Long)
   m_lAllocationSize = lAllocationSize
End Property


Public Property Get Item(ByVal Index As Long) As Long
   ' Return the item at Index.  Note since this
   ' array does not automatically reduce size we
   ' need to check that index is in bounds:
   If Index > 0 And Index <= m_lCount Then
      Item = m_lItem(Index)
   Else
      ' Subscript out of range
      Err.Raise 9
   End If
End Property
Public Property Let Item(ByVal Index As Long, ByVal Value As Long)
   If Index > 0 And Index <= m_lCount Then
      m_lItem(Index) = Value
   Else
      ' Subscript out of range
      Err.Raise 9
   End If
End Property
Public Sub Add(ByVal Value As Long, Optional ByVal Index As Long = -1)
Dim j As Long
      
   ' Increase array size:
   m_lCount = m_lCount + 1
   If m_lCount > m_lArraySize Then
      m_lArraySize = m_lArraySize + m_lAllocationSize
      ReDim Preserve m_lItem(1 To m_lArraySize) As Long
   End If
   
   If Index <= 0 Then
      ' Add to the end:
      m_lItem(m_lCount) = Value
   Else
      ' Shift up from Index to m_lCount-1
      For j = m_lCount - 1 To Index Step -1
         m_lItem(j + 1) = m_lItem(j)
      Next j
      ' Set item at Index
      m_lItem(Index) = Value
   End If
   
End Sub
Public Sub Remove(Optional ByVal Index As Long = -1)
Dim j As Long
   ' Reduce size:
   If Index <= 0 Or Index >= m_lCount Then
      m_lCount = m_lCount - 1
      If m_lCount < 0 Then
         m_lCount = 0
      End If
   Else
      If m_lCount > 1 Then
         ' shift down from Index to m_lCount-1
         For j = Index + 1 To m_lCount
            m_lItem(j - 1) = m_lItem(j)
         Next j
         m_lCount = m_lCount - 1
      Else
         m_lCount = 0
      End If
   End If
End Sub
Public Property Get Count() As Long
   ' Number of items in the array:
   Count = m_lCount
End Property
Public Property Get Exists(ByVal Index As Long)
   ' Does the item at Index exist?
   Exists = (Index > 0 And Index <= m_lCount)
End Property
Public Sub HeapMinimize()
   ' Reduce the array storage size to
   ' match the number of items in it:
   If m_lArraySize > m_lCount Then
      If m_lCount <= 0 Then
         Erase m_lItem
         m_lArraySize = 0
      Else
         ReDim Preserve m_lItem(1 To m_lCount) As Long
         m_lArraySize = m_lCount
      End If
   End If
End Sub
Public Sub Clear()
   ' Clear down the array:
   m_lCount = 0
End Sub

Private Sub Class_Initialize()
   m_lAllocationSize = 1
End Sub