vbAccelerator - Contents of code file: fTestArrayList.frmVERSION 5.00
Begin VB.Form frmTestArrayList
Caption = "vbAccelerator Array List Tester"
ClientHeight = 3555
ClientLeft = 60
ClientTop = 450
ClientWidth = 4470
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "fTestArrayList.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3555
ScaleWidth = 4470
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdSanityCheck
Caption = "Thorough Check"
Height = 615
Left = 3240
TabIndex = 6
Top = 2100
Width = 1155
End
Begin VB.CommandButton cmdTest
Caption = "&Test"
Height = 375
Left = 3180
TabIndex = 3
Top = 60
Width = 1215
End
Begin VB.TextBox txtSize
Height = 285
Left = 120
TabIndex = 2
Text = "1000"
Top = 300
Width = 2955
End
Begin VB.TextBox txtLog
Height = 2415
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
Top = 960
Width = 3015
End
Begin VB.CommandButton cmdClear
Caption = "&Clear"
Height = 375
Left = 3180
TabIndex = 0
Top = 960
Width = 1215
End
Begin VB.Label lblIterations
Caption = "&Size of Array"
Height = 255
Index = 0
Left = 120
TabIndex = 5
Top = 60
Width = 2955
End
Begin VB.Label lblIterations
Caption = "&Results:"
Height = 255
Index = 1
Left = 120
TabIndex = 4
Top = 660
Width = 2955
End
End
Attribute VB_Name = "frmTestArrayList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private c As New cCollectionArrayList
Private c2 As New cArrayList
Private Size As Long
Private Iter As Long
Private Sub Speed(ByVal sName As String, coll As Object)
Dim i As Long
Dim cO As cMyObject
StartTiming
coll.Clear
LogTiming sName & ":Clear", EndTiming
StartTiming
For i = 1 To Size
Set cO = New cMyObject
cO.FirstName = "Steve"
cO.LastName = "McMahon"
cO.DateOfBirth = #12/7/1968#
cO.ID = i
coll.Add cO
Next i
LogTiming sName & ":Add", EndTiming
StartTiming
For i = 1 To Size
Set cO = coll.Item(i)
Next i
LogTiming sName & ":Read", EndTiming
StartTiming
For i = 1 To Size
coll.Remove
Next i
LogTiming sName & ":Remove", EndTiming
StartTiming
For i = 1 To Size
Set cO = New cMyObject
cO.FirstName = "Steve"
cO.LastName = "McMahon"
cO.DateOfBirth = #12/7/1968#
cO.ID = i
coll.Add cO, 1
Next i
LogTiming sName & ":Insert", EndTiming
StartTiming
coll.Clear
LogTiming sName & ":Clear", EndTiming
End Sub
Private Sub LogItem(ByVal sMsg As String)
txtLog.Text = txtLog.Text & vbCrLf & sMsg
End Sub
Private Sub LogTiming(ByVal sMsg As String, ByVal lT As Long)
LogItem lT & ": " & sMsg
End Sub
Private Sub cmdClear_Click()
txtLog.Text = ""
End Sub
Private Sub SanityCheck(coll As Object)
Dim cO As cMyDebugObject
Dim i As Long
Debug.Print "Sanity Check on " & TypeName(coll)
For i = 1 To 10
Set cO = New cMyDebugObject
cO.FirstName = "Steve"
cO.LastName = "McMahon"
cO.DateOfBirth = #12/7/1968#
cO.ID = i
coll.Add cO
Debug.Print coll.Item(i).ID
Next i
For i = 10 To 1 Step -1
coll.Remove i
Debug.Print coll.Count
Next i
For i = 1 To 10
Set cO = New cMyDebugObject
cO.FirstName = "Steve"
cO.LastName = "McMahon"
cO.DateOfBirth = #12/7/1968#
cO.ID = i
coll.Add cO, 1
Debug.Print coll.Item(1).ID
Next i
coll.Remove 5
For i = 1 To 9
Debug.Print coll.Item(i).ID
Next i
coll.Clear
End Sub
Private Sub cmdSanityCheck_Click()
SanityCheck c
SanityCheck c2
End Sub
Private Sub cmdTest_Click()
Size = CLng(txtSize.Text)
c2.AllocationSize = Size / 10
LogItem ""
LogItem ""
LogItem Size & " Items"
LogItem "------------------------------------------------"
Speed "Standard Collection", c
LogItem "------------------------------------------------"
Speed "Optimised Index Collection", c2
LogItem "------------------------------------------------"
LogItem ""
End Sub
|
|