Comments

Sometimes I need to hold a few items in a stack and use the Collection Object to do this. There's no need of course, now that that Stack Class is here anyway. I've used a Variant array to hold the items so it can take strings, numbers, objects etc.

The buffer size is set to 100. If you're intending to store a lot more than 100 items in the stack (say 1000) then you'll want to adjust the buffer size to increase efficiency (as the Items array would be redimensioned 10 times).

Reference

StackClass Properties

Count

Read-Only

Return Type is a Long

StackClass Methods

Peek ()

Returns the topmost Item without removing it from the stack

Return Type is a Variant Value

Pop ()

Returns the topmost Item and removes it from the stack

Return Type is a Variant Value

Push Item

Adds the given Item to the top of the stack

Clear

Removes all the Items from the stack

Usage

Add ZipClass.cls and ZipFile.cls to your project and ensure that zlib.dll is reachable

'Example 1

   Dim Stack as StackClass

   Set Stack = New StackClass

   Stack.Push 1
   Stack.Push 2
   Stack.Push 3

   Debug.Print Stack.Peek  'Prints 3
   Debug.Print Stack.Pop   'Prints 3
   Debug.Print Stack.Pop   'Prints 2
   Debug.Print Stack.Pop   'Prints 1

   Set Stack = Nothing


'Example 2

   Dim Stack as StackClass

   Set Stack = New StackClass

   Stack.Push 1
   Stack.Push 2
   Stack.Push 3

   While Stack.Count > 0
      Debug.Print Stack.Pop 'Prints 3, then 2, then 1
   Wend

   Set Stack = Nothing

The Code

StackClass.cls

Option Explicit

Private Const BUFFER_SIZE As Long = 100

Private Items() As Variant
Private Index As Long

Public Property Get Count() As Long

   Count = Index

End Property

Public Sub Clear()

   ReDim Items(BUFFER_SIZE - 1)
   Index = 0

End Sub

Public Sub Push(Item As Variant)

   If UBound(Items) = Index Then
      ReDim Preserve Items(Index + BUFFER_SIZE)
   End If

   If IsObject(Item) Then
      Set Items(Index) = Item
   Else
      Items(Index) = Item
   End If
   Index = Index + 1

End Sub

Public Function Pop() As Variant

   Dim l As Long

   If Index > 0 Then
      Index = Index - 1
      If IsObject(Items(Index)) Then
         Set Pop = Items(Index)
      Else
         Pop = Items(Index)
      End If
   End If

   If (UBound(Items) - Index) \ BUFFER_SIZE > 0 Then
      ReDim Preserve Items(UBound(Items) - BUFFER_SIZE)
   End If

End Function

Public Function Peek() As Variant

   If Index > 0 Then
      Peek = Items(Index - 1)
      If IsObject(Items(Index - 1)) Then
         Set Peek = Items(Index - 1)
      Else
         Peek = Items(Index - 1)
      End If
   End If

End Function

Private Sub Class_Initialize()

   Clear

End Sub

Private Sub Class_Terminate()

   Erase Items

End Sub

Downloads

  StackClass.zip - contains: StackClass.cls (717 bytes)

© Copyright Notice

Unless otherwise stated, the code on this site is Copyright to Andrew McMillan. You may use this code in your projects (both commercial and non-commercial) but you are not permitted to republish this code in any form without the Author's prior consent.

The code on this site is supplied "as is" and no claims are made as to its soundness. The Author claims no responsibility for or liability from use of said source code.