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

' Copyright (c) FMS, Inc.        www.fmsinc.com
' Licensed to owners of Total Visual SourceBook
'
' Class       : CStack
' Description : Class that implements a stack.
'               A stack is a restricted form of a list. All insertions and deletions occur at one end of the list.
'               The stack data type defines three operations, Push, Pop, and Top.
'                   - Push places an item on the top of the list
'                   - Pop removes an item from the top of the list
'                   - Top retrieves, but does not remove, an item from the top of the list
'               The stack is a LIFO, or Last-In, First-Out, data type. This means that data enters and exits from the same end of the list. An example of a stack is a spring loaded plate dispenser in a cafeteria. The last plate placed in the dispenser is the first one removed.
'               This class is implemented using an array based approach. When the array becomes full, the array is grown by the amount specified in the GrowBy property. This class supports object variables in addition to the standard text and numeric types.
' Source      : Total Visual SourceBook


' Local variables to hold Public Property Values
Private m_intGrowBy As Integer

' Private class-specific variables
' Internal array variable to store stack items
Private mavarData() As Variant

' The index of the top item in the stack
Private mintTop As Integer
' The maximum size of the stack
Private mintMax As Integer

' This constant is used to specify the defualt size to grow the stack by
Private Const mcintDefaultGrowBy As Integer = 10

Private Sub Class_Initialize()
  ' Comments: Sets initial values
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  ' Initialize stack
  ReDim mavarData(mcintDefaultGrowBy)
  
  ' Set the index into the array to zero
  mintTop = 0
  
  ' Initialize growby variable to default value
  m_intGrowBy = mcintDefaultGrowBy
  
  ' Set the maximum size of the stack
  mintMax = mcintDefaultGrowBy
  
PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.Class_Initialize"
  Resume PROC_EXIT
End Sub

Public Property Get GrowBy() As Integer
  ' Comments: Gets the amount the stack grows by when it needs to be reallocated.
  '           The default value  is ten. If you know that hundreds of items are going to placed on the stack, you can increase this number to reduce the number of ReDims of the mavarData array.
  ' Returns : GrowBy property
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  GrowBy = m_intGrowBy
  
PROC_EXIT:
  Exit Property

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.GrowBy"
  Resume PROC_EXIT
End Property

Public Property Let GrowBy(ByVal intValue As Integer)
  ' Comments: Sets the amount to grow the stack by when it needs to be reallocated.
  ' Params  : intValue      GrowBy variable
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  m_intGrowBy = intValue
  
PROC_EXIT:
  Exit Property

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.GrowBy"
  Resume PROC_EXIT
End Property

Public Function Pop(varData As Variant) As Boolean
  ' Comments: Removes the topmost item off the stack, and places it in the varData variable
  ' Params  : varData       Returns the data contained on the stack
  ' Returns : True if an item was popped off the stack, or False if there is no data left
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  ' If there is data remaining on the stack
  If mintTop > 0 Then
    
    ' decrement the index into the array by 1
    mintTop = mintTop - 1
    
    ' If the data stored in this node is an object, then use the Set syntax. Otherwise just assign the variable
    If IsObject(mavarData(mintTop)) Then
      Set varData = mavarData(mintTop)
      Set mavarData(mintTop) = Nothing
    Else
      varData = mavarData(mintTop)
    End If
    
    Pop = True
  Else
    ' There is no data on the stack, so return False
    Pop = False
    ' Set the data parameter to nothing
    Set varData = Nothing
  End If
  
PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.Pop"
  Resume PROC_EXIT
End Function

Public Sub Push(varData As Variant)
  ' Comments: Pushes the data specified in varData on the top of the stack.
  '           If the stack is full, it grows by the amount specified by the GrowBy property.
  ' Params  : varData       The data to push onto the stack
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  ' Check to make sure we have room in our internal array for this item. If not then grow the stack by the GrowBy variable
  If mintTop > mintMax Then
    mintMax = mintMax + m_intGrowBy
    ReDim Preserve mavarData(mintMax)
  End If
  
  ' If the data to store is an object, then use the Set syntax. Otherwise just assign the variable
  If IsObject(varData) Then
    Set mavarData(mintTop) = varData
  Else
    mavarData(mintTop) = varData
  End If
  
  ' Increment the index into the array by 1
  mintTop = mintTop + 1
  
PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.Push"
  Resume PROC_EXIT
End Sub

Public Function Top(varData As Variant) As Boolean
  ' Comments: Returns the item on the top of the stack. This function differs from pop in that it does not remove the item from the stack.
  ' Params  : varData       Returns the data contained on the stack
  ' Returns : True if there is an item on top of the stack, or False if there is no data left
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR
  
  ' If there is data remaining on the stack
  If mintTop >= 0 Then
    
    ' If the data stored in this node is an object, then use the Set syntax. Otherwise just assign the variable
    If IsObject(mavarData(mintTop - 1)) Then
      Set varData = mavarData(mintTop - 1)
    Else
      varData = mavarData(mintTop - 1)
    End If
    
    Top = True
  Else
    ' There is no data on the stack, so return False
    Top = False
    ' Set the data parameter to empty
    varData = Empty
  End If
  
PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.number & ". " & Err.Description, , _
    "CStack.Top"
  Resume PROC_EXIT
End Function

