vbAccelerator - Contents of code file: frmTest.frm

VERSION 5.00
Begin VB.Form frmTest 
   Caption         =   "Stack Performance Tester"
   ClientHeight    =   4380
   ClientLeft      =   3885
   ClientTop       =   2295
   ClientWidth     =   6210
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmTest.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   6210
   Begin VB.TextBox txtNumber 
      Height          =   315
      Left            =   4800
      TabIndex        =   2
      Text            =   "5000"
      Top             =   480
      Width           =   1335
   End
   Begin VB.ListBox lstPerformance 
      Height          =   2400
      Left            =   0
      TabIndex        =   1
      Top             =   1860
      Width           =   4635
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "&Test"
      Height          =   375
      Left            =   4800
      TabIndex        =   0
      Top             =   60
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   $"frmTest.frx":1272
      Height          =   975
      Left            =   60
      TabIndex        =   4
      Top             =   960
      Width           =   4515
   End
   Begin VB.Label lblInfo 
      Caption         =   $"frmTest.frx":135B
      Height          =   975
      Left            =   60
      TabIndex        =   3
      Top             =   60
      Width           =   4515
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As
 Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long)
 As Long
Private m_lS As Long

Private Sub StartTime()
   timeBeginPeriod 1
   m_lS = timeGetTime()
End Sub
Private Function StopTime(ByVal sMsg As String) As Long
Dim lStopTime As Long
   lStopTime = timeGetTime() - m_lS
   lstPerformance.AddItem sMsg & " : " & lStopTime
   StopTime = lStopTime
   timeEndPeriod 1
End Function

Private Sub cmdTest_Click()

   Dim cS As IStack
   Dim nCount As Long
   
   On Error Resume Next
   nCount = CLng(txtNumber.Text)
   If nCount > 0 Then

      Dim cSC As New cStackCollection
      Set cS = cSC
      Test "cStackCollection", cS, nCount
      StartTime
      ' Kill the object
      Set cS = Nothing
      Set cSC = Nothing
      StopTime "cStackCollection,Kill " & nCount
      
      Dim cSLO As New cStackLinkedObject
      Set cS = cSLO
      Test "cStackLinkedObject", cS, nCount
      StartTime
      ' Kill the object
      Set cS = Nothing
      Set cSLO = Nothing
      StopTime "cStackLinkedObject,Kill " & nCount
      
      Dim cSA As New cStackArray
      Set cS = cSA
      Test "cStackArray", cS, nCount
      StartTime
      ' Kill the object
      Set cS = Nothing
      Set cSA = Nothing
      StopTime "cStackArray,Kill " & nCount
   
      Dim cSI As New cStackIMalloc
      Set cS = cSI
      Test "cStackMalloc", cSI, nCount
      StartTime
      ' Kill the object
      Set cS = Nothing
      Set cSI = Nothing
      StopTime "cStackMalloc,Kill " & nCount
   
   Else
      MsgBox "Enter a number of times to test", vbExclamation
      txtNumber.SetFocus
   End If
   
End Sub

Private Sub Test(ByVal sTestName As String, cS As IStack, ByVal nCount As Long)
Dim i As Long
Dim s As String

   StartTime
   ' Push nCount:
   For i = 1 To nCount
      cS.Push "Test" & i
   Next i
   StopTime sTestName & ",Push " & nCount
   
   StartTime
   ' Pop nCount:
   For i = 1 To nCount
      s = cS.Pop
   Next i
   StopTime sTestName & ",Pop " & nCount
   
   ' Push nCount again:
   For i = 1 To nCount
      cS.Push "Test" & i
   Next i
         
   
End Sub