A Classy Little Stack
An Example...
Option Explicit
' Module Name : CStack
' Author : Tom Brennfleck
' Date : 21/05/96 01:30
' Description : Stack class
'
' Usage : Dim Stack As New CStack
'
' Methods : .Push - Push a value onto the stack
' : .Pop - Pop a value from the stack
' : .Clear - Clear the stack of all values
' : .GetPopValue - Look at next value on the stack
'
' Property's : .Count - Number of items on the stack
' : .IsEmpty - Is the stack empty (True|False)
' History : 21/05/96 01:30: Tom Brennfleck: Original Code.
' declare some privates.
Private m_StackArray() As Variant
Private m_nStackSize As Integer
Private m_nCurrPos As Integer
Private m_bIsEmpty As Boolean
Private Const INC_SIZE = 10
' declare some properties
Public Property Get IsEmpty() As Boolean
' read only property returns if the stack is empty
IsEmpty = m_bIsEmpty
End Property
Public Property Get Count() As Integer
' read only property returns the number of items
' on the stack
Count = m_nCurrPos
End Property
Public Sub Clear()
' Proc Name : Clear
' Scope : Public
' Author : Tom Brennfleck
' Date : 21/05/96 01:30
' Description : Clear the stack of all items
'
' History : 21/05/96 01:30: Tom Brennfleck: Original Code.
m_nStackSize = 0
m_nCurrPos = 0
m_bIsEmpty = True
ReDim m_StackArray(1 To INC_SIZE)
End Sub
Public Sub Push(Value As Variant)
' Proc Name : Push
' Scope : Public
' Author : Tom Brennfleck
' Date : 21/05/96 01:31
' Description : push a value onto the stack make
' bigger if required
'
' History : 21/05/96 01:31: Tom Brennfleck: Original Code.
m_bIsEmpty = False
m_nCurrPos = m_nCurrPos + 1
' test if we need to increase size
If m_nCurrPos > m_nStackSize Then
m_nStackSize = m_nStackSize + INC_SIZE
ReDim Preserve m_StackArray(1 To m_nStackSize)
End If
' set value
m_StackArray(m_nCurrPos) = Value
End Sub
Public Function Pop() As Variant
' Proc Name : Pop
' Scope : Public
' Author : Tom Brennfleck
' Date : 21/05/96 01:32
' Description : return the top value of the stack and remove it
' from the stack.
'
' History : 21/05/96 01:32: Tom Brennfleck: Original Code.
' test if we still have any values to get
If m_nCurrPos > 0 Then
Pop = m_StackArray(m_nCurrPos)
m_nCurrPos = m_nCurrPos - 1
If m_nCurrPos <= 0 Then
m_bIsEmpty = True
End If
Else
m_bIsEmpty = True
End If
End Function
Public Function GetPopValue() As Variant
' Proc Name : GetPopValue
' Scope : Public
' Author : Tom Brennfleck
' Date : 21/05/96 01:34
' Description : Look at but dont touch the value on the
' stack
' History : 21/05/96 01:34: Tom Brennfleck: Original Code.
If m_nCurrPos > 0 Then
GetPopValue = m_StackArray(m_nCurrPos)
Else
m_bIsEmpty = True
End If
End Function
Private Sub Class_Initialize()
' initialise the stack class
m_nStackSize = 0
m_nCurrPos = 0
m_bIsEmpty = True
ReDim m_StackArray(1 To INC_SIZE)
End Sub
