vbAccelerator Object Store Sample (25K)
15 Aug 1999
First Posted
IShellFolder Extended Type Library Version 1.2 (ISHF_Ex.Tlb)
vbAccelerator - Contents of code file: frmTest.frm
VERSION 5.00
Begin VB.Form frmTest
Caption = "vbAccelerator: Storing Objects in ItemData/Tag
properties."
ClientHeight = 6615
ClientLeft = 4335
ClientTop = 1740
ClientWidth = 6600
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 = 6615
ScaleWidth = 6600
Begin VB.ListBox lstIUnknown
Height = 2790
Left = 2280
TabIndex = 7
Top = 1320
Width = 2055
End
Begin VB.CommandButton cmdEnum
Caption = "&Enum Items"
Height = 375
Left = 120
TabIndex = 6
Top = 4860
Width = 1395
End
Begin VB.ListBox lstPerformance
Height = 2010
Left = 2940
TabIndex = 5
Top = 4440
Width = 3555
End
Begin VB.CommandButton cmdClear
Caption = "&Clear"
Height = 375
Left = 120
TabIndex = 4
Top = 5280
Width = 1395
End
Begin VB.TextBox txtItems
Height = 315
Left = 1620
TabIndex = 3
Text = "5000"
Top = 4440
Width = 1215
End
Begin VB.ListBox lstIMalloc
Height = 2790
Left = 4440
TabIndex = 2
Top = 1320
Width = 2055
End
Begin VB.CommandButton cmdAdd
Caption = "&Add Items"
Height = 375
Left = 120
TabIndex = 1
Top = 4440
Width = 1395
End
Begin VB.ListBox lstCollection
Height = 2790
Left = 120
TabIndex = 0
Top = 1320
Width = 2055
End
Begin VB.Image imgIcon
Height = 480
Left = 120
Picture = "frmTest.frx":1272
Top = 60
Width = 480
End
Begin VB.Label Label2
Caption = "Using IMalloc to store and restore data in memory:"
Height = 435
Left = 4440
TabIndex = 11
Top = 720
Width = 2055
End
Begin VB.Label lblCaption
Caption = "Using ObjPtr and IUnknown to control reference
count:"
Height = 435
Index = 1
Left = 2280
TabIndex = 10
Top = 720
Width = 2055
End
Begin VB.Label lblCaption
Caption = "The VB Way: Using a Collection"
Height = 435
Index = 0
Left = 120
TabIndex = 9
Top = 720
Width = 2055
End
Begin VB.Label lblInfo
Caption = "This demo program compares three methods of storing
objects against a ListBox's ItemData property."
Height = 495
Left = 660
TabIndex = 8
Top = 60
Width = 5655
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ==========================================================
' Storing Objects against a controls ItemData or Tag
' property.
'
' This sample demonstrates three different techniques for
' storing an object in a long or string variable. By
' running the tests at different numbers of items, you
' can determine which is most useful for your app.
'
'
' Copyright 1999 Steve McMahon
' steve@vbaccelerator.com
'
' Uses the ISHF_Ex.tlb from Brad Martinez excellent
' EnumDeskVB sample (version 2). Visit his site at:
' http://www.mvps.org/btmtz/
'
' ----------------------------------------------------------
' vbAccelerator - advanced, free source code:
' http://vbAccelerator.com/
' ==========================================================
Private m_lS As Long
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_cVB As cListBoxStorageClass
Private m_cIU As cListBoxStorageIUnknown
Private m_cIM As cListBoxStorageIMalloc
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 Function GetNumber(ByVal sText As String) As Long
Dim l As Long
On Error Resume Next
l = CStr(sText)
If Err.Number = 0 Then
GetNumber = l
Else
MsgBox "Error: " & Err.Description
End If
End Function
Private Sub cmdAdd_Click()
Dim i As Long
Dim lNum As Long
Dim cD As cListBoxItem
lNum = GetNumber(txtItems.Text)
' Test collection method:
lstCollection.Visible = False
StartTime
For i = 1 To lNum
lstCollection.AddItem "Test" & i
Set cD = New cListBoxItem
cD.ItemData = i * 5
cD.ItemExtraData = i * 10
cD.ItemString = i & "Test"
m_cVB.ItemData(i - 1) = cD
Next i
StopTime "VB:Add-" & lNum
lstCollection.Visible = True
' Test IUnknown method:
lstIUnknown.Visible = False
StartTime
For i = 1 To lNum
lstIUnknown.AddItem "Test" & i
Set cD = New cListBoxItem
cD.ItemData = i * 5
cD.ItemExtraData = i * 10
cD.ItemString = i & "Test"
m_cIU.ItemData(i - 1) = cD
Next i
StopTime "IUnknown:Add-" & lNum
lstIUnknown.Visible = True
' Test IMalloc method:
lstIMalloc.Visible = False
StartTime
For i = 1 To lNum
lstIMalloc.AddItem "Test" & i
cD.ItemData = i * 5
cD.ItemExtraData = i * 10
cD.ItemString = i & "Test"
m_cIM.ItemData(i - 1) = cD
Next i
StopTime "IMalloc:Add-" & lNum
lstIMalloc.Visible = True
End Sub
Private Sub cmdClear_Click()
' To prevent the speed of ListBox redraw
' from affecting the results, make the
' ListBox invisible whilst modifying the
' contents:
lstIUnknown.Visible = False
lstIMalloc.Visible = False
lstCollection.Visible = False
' Test VB collection clear:
StartTime
m_cVB.Clear
StopTime "VB:Clear"
' Test IUnknown clear:
StartTime
m_cIU.Clear
StopTime "IUnknown:Clear"
' Test IMalloc clear:
StartTime
m_cIM.Clear
StopTime "IMalloc:Clear"
lstIUnknown.Visible = True
lstIMalloc.Visible = True
lstCollection.Visible = True
End Sub
Private Sub cmdEnum_Click()
Dim cD As cListBoxItem
Dim i As Long
Dim l As Long
StartTime
For i = 0 To lstCollection.ListCount - 1
Set cD = m_cVB.ItemData(i)
l = cD.ItemData
Next i
StopTime "VB:Enum-" & i
StartTime
For i = 0 To lstIUnknown.ListCount - 1
Set cD = m_cIU.ItemData(i)
l = cD.ItemData
Next i
StopTime "IUnknown:Enum-" & i
StartTime
For i = 0 To lstIMalloc.ListCount - 1
Set cD = m_cIM.ItemData(i)
l = cD.ItemData
Next i
StopTime "IMalloc:Enum-" & i
End Sub
Private Sub Form_Load()
Me.Icon = imgIcon.Picture
' Prepare the objects:
Set m_cVB = New cListBoxStorageClass
Set m_cIM = New cListBoxStorageIMalloc
Set m_cIU = New cListBoxStorageIUnknown
m_cVB.Initialise lstCollection
m_cIU.Initialise lstIUnknown
m_cIM.Initialise lstIMalloc
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' Force a clear on unload; this is
' not strictly necessary since the
' termination of the objects will
' do this:
cmdClear_Click
End Sub
Private Sub lstCollection_DblClick()
' Display data associated with an item when
' it is double clicked:
If lstCollection.ListIndex > -1 Then
With m_cVB.ItemData(lstCollection.ListIndex)
MsgBox .ItemData & "," & .ItemExtraData & "," & .ItemString,
vbInformation
End With
End If
End Sub
Private Sub lstIMalloc_DblClick()
' Display data associated with an item when
' it is double clicked:
If lstIMalloc.ListIndex > -1 Then
With m_cIM.ItemData(lstIMalloc.ListIndex)
MsgBox .ItemData & "," & .ItemExtraData & "," & .ItemString,
vbInformation
End With
End If
End Sub
Private Sub lstIUnknown_Click()
' Display data associated with an item when
' it is double clicked:
If lstIUnknown.ListIndex > -1 Then
With m_cIU.ItemData(lstIUnknown.ListIndex)
MsgBox .ItemData & "," & .ItemExtraData & "," & .ItemString,
vbInformation
End With
End If
End Sub
