vbAccelerator - Contents of code file: frmSpeedTest.frm

VERSION 5.00
Object = "{DE8CE233-DD83-481D-844C-C07B96589D3A}#1.1#0"; "vbalSGrid6.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frmSpeedTest 
   Caption         =   "vbAccelerator SGrid 2.0 Performance Tester"
   ClientHeight    =   9495
   ClientLeft      =   3540
   ClientTop       =   2190
   ClientWidth     =   6540
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmSpeedTest.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   9495
   ScaleWidth      =   6540
   Begin VB.CommandButton cmdClear 
      Caption         =   "&Clear"
      Height          =   315
      Left            =   5220
      TabIndex        =   7
      Top             =   7260
      Width           =   1215
   End
   Begin vbAcceleratorSGrid6.vbalGrid grdResults 
      Height          =   1695
      Left            =   120
      TabIndex        =   6
      Top             =   7680
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   2990
      BackgroundPictureHeight=   0
      BackgroundPictureWidth=   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DisableIcons    =   -1  'True
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid grdMS 
      Height          =   2295
      Left            =   120
      TabIndex        =   4
      Top             =   4920
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   4048
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin MSComctlLib.ListView lvwTest 
      Height          =   2295
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   4048
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin vbAcceleratorSGrid6.vbalGrid grdTest 
      Height          =   2295
      Left            =   120
      TabIndex        =   2
      Top             =   2520
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   4048
      BackgroundPictureHeight=   0
      BackgroundPictureWidth=   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DisableIcons    =   -1  'True
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "&Test"
      Height          =   315
      Left            =   3960
      TabIndex        =   1
      Top             =   7260
      Width           =   1215
   End
   Begin VB.TextBox txtRows 
      Height          =   315
      Left            =   2340
      TabIndex        =   0
      Text            =   "1000"
      Top             =   7260
      Width           =   1515
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Number of Rows to Test:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   7320
      Width           =   2415
   End
End
Attribute VB_Name = "frmSpeedTest"
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 Const mcCOLS = 10
Private m_iRows As Long

Private Sub ConfigureListView()
Dim i As Long
   With lvwTest
      .ListItems.Clear
      .ColumnHeaders.Clear
      For i = 1 To mcCOLS
         .ColumnHeaders.Add , , "Col" & i
      Next i
   End With
End Sub

Private Function TestAppendListView() As Long
Dim i As Long
Dim j As Long
Dim lT As Long
Dim itmX As ListItem
   lT = timeGetTime
   With lvwTest
      For i = 1 To m_iRows
         Set itmX = .ListItems.Add(, , "Row" & i & ";Col 1")
         For j = 2 To mcCOLS
            itmX.SubItems(j - 1) = "Row" & i & ";Col" & j - 1
         Next
      Next
   End With
   TestAppendListView = timeGetTime - lT
End Function

Private Function TestInsertListView() As Long
Dim i As Long
Dim j As Long
Dim lT As Long
Dim itmX As ListItem
   lT = timeGetTime
         
   ' Add first row
   With lvwTest
      i = 1
      Set itmX = .ListItems.Add(, , "Row" & i & ";Col 1")
      For j = 2 To mcCOLS
         itmX.SubItems(j - 1) = "Row" & i & ";Col" & j - 1
      Next
      
      For i = 2 To m_iRows
         Set itmX = .ListItems.Add(i, , "Row" & i & ";Col 1")
         For j = 2 To mcCOLS
            itmX.SubItems(j - 1) = "Row" & i & ";Col" & j - 1
         Next
      Next
   End With
   TestInsertListView = timeGetTime - lT
   
End Function

Private Function TestDeleteStartListView() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With lvwTest.ListItems
      For i = .Count To 1 Step -1
         .Remove 1
      Next i
   End With
   TestDeleteStartListView = timeGetTime - lT
End Function

Private Function TestDeleteEndListView() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With lvwTest.ListItems
      For i = .Count To 1 Step -1
         .Remove i
      Next i
   End With
   TestDeleteEndListView = timeGetTime - lT
End Function

Private Sub ConfigureSGrid()
Dim i As Long
   With grdTest
      .Clear True
      For i = 1 To mcCOLS
         .AddColumn , "Col" & i
      Next i
   End With
End Sub

Private Function TestAppendSGrid() As Long
Dim i As Long
Dim j As Long
Dim lT As Long
   lT = timeGetTime
   With grdTest
      .Redraw = False
      .Rows = m_iRows
      For i = 1 To m_iRows
         For j = 1 To mcCOLS
            .CellText(i, j) = "Row" & i & ";Col" & j
         Next
      Next
      .Redraw = True
   End With
   TestAppendSGrid = timeGetTime - lT
End Function

Private Function TestInsertSGrid() As Long
Dim i As Long
Dim j As Long
Dim lT As Long
   lT = timeGetTime
   With grdTest
      .Redraw = False
      ' Add first row
      .AddRow
      i = 1
      For j = 1 To mcCOLS
         .CellText(i, j) = "Row" & i & ";Col" & j
      Next
      
      For i = 2 To m_iRows
         .AddRow 1
         For j = 1 To mcCOLS
            .CellText(1, j) = "Row" & i & ";Col" & j
         Next
      Next
      .Redraw = True
   End With
   TestInsertSGrid = timeGetTime - lT
End Function

Private Function TestDeleteStartSGrid() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With grdTest
      .Redraw = False
      For i = .Rows To 1 Step -1
         .RemoveRow 1
      Next i
      .Redraw = True
   End With
   TestDeleteStartSGrid = timeGetTime - lT
End Function

Private Function TestDeleteEndSGrid() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With grdTest
      .Redraw = False
      For i = .Rows To 1 Step -1
         .RemoveRow i
      Next i
      .Redraw = True
   End With
   TestDeleteEndSGrid = timeGetTime - lT
End Function

Private Function configureFlexGrid()
Dim i As Long
   With grdMS
      .Cols = mcCOLS
      .FixedCols = 0
      .FixedRows = 0
      .Rows = m_iRows + 1
      .Row = 0
      For i = 1 To mcCOLS
         .Col = i - 1
         .Text = "Col" & i
      Next i
   End With
End Function

Private Function TestAppendFlexGrid() As Long
Dim i As Long
Dim j As Long
Dim lT As Long
   lT = timeGetTime
   With grdMS
      .Redraw = False
      .Rows = m_iRows
      For i = 2 To m_iRows
         For j = 1 To mcCOLS
            .Row = i - 1
            .Col = j - 1
            .Text = "Row" & i & ";Col" & j
         Next
      Next
      .Redraw = True
   End With
   TestAppendFlexGrid = timeGetTime - lT
End Function
Private Function TestInsertFlexGrid() As Long
Dim lT As Long
Dim i As Long
Dim j As Long

   lT = timeGetTime
   
   With grdMS
      .Redraw = False
      
      ' Add first row:
      .Row = 0
      For i = 1 To mcCOLS
         .Col = i - 1
         .Text = "Col" & i
      Next i
      
      For i = 2 To m_iRows
         .AddItem "Row " & i & ";Col" & j, 0
         For j = 2 To mcCOLS
            .Row = 0
            .Col = j - 1
            .Text = "Row" & i & ";Col" & j
         Next j
      Next i
      
      .Redraw = True
   End With
   
   TestInsertFlexGrid = timeGetTime - lT
   
End Function
Private Function TestDeleteStartFlexGrid() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With grdMS
      .Redraw = False
      For i = .Rows To 2 Step -1 ' Cannot delete last row
         .RemoveItem 1
      Next i
      .Redraw = True
   End With
   TestDeleteStartFlexGrid = timeGetTime - lT
End Function
Private Function TestDeleteEndFlexGrid() As Long
Dim i As Long
Dim lT As Long
   lT = timeGetTime
   With grdMS
      .Redraw = False
      For i = .Rows To 1 Step -1 ' Cannot delete last row
         .RemoveItem i
      Next i
      .Redraw = True
   End With
   TestDeleteEndFlexGrid = timeGetTime - lT
End Function

Private Sub cmdClear_Click()
   grdResults.Clear
End Sub

Private Sub cmdTest_Click()
Dim lRow As Long
      
   m_iRows = CLng(txtRows.Text)
   timeBeginPeriod 1
   
   grdResults.AddRow
   lRow = grdResults.Rows
   grdResults.CellText(lRow, 1) = m_iRows
   grdResults.CellText(lRow, 2) = "ListView (MSCOMCTL.OCX)"
   runListViewTests lRow
   
   grdResults.AddRow
   lRow = grdResults.Rows
   grdResults.CellText(lRow, 1) = m_iRows
   grdResults.CellText(lRow, 2) = "SGrid 2.0 (vbalSGrid.OCX)"
   runSGridTests lRow
   
   grdResults.AddRow
   lRow = grdResults.Rows
   grdResults.CellText(lRow, 1) = m_iRows
   grdResults.CellText(lRow, 2) = "Flex Grid (MSHFLXGD.OCX)"
   runFlexGridTests lRow
      
   timeEndPeriod 1
   
End Sub

Private Sub runListViewTests(ByVal lResultRow As Long)
   
   ' Append
   grdResults.CellText(lResultRow, 3) = TestAppendListView()
   ' Delete start
   grdResults.CellText(lResultRow, 6) = TestDeleteStartListView()
   ' Insert
   grdResults.CellText(lResultRow, 4) = TestInsertListView()
   ' Delete end
   grdResults.CellText(lResultRow, 5) = TestDeleteEndListView()
   
End Sub
Private Sub runSGridTests(ByVal lResultRow As Long)
   
   ' Append
   grdResults.CellText(lResultRow, 3) = TestAppendSGrid()
   ' Delete start
   grdResults.CellText(lResultRow, 6) = TestDeleteStartSGrid()
   ' Insert
   grdResults.CellText(lResultRow, 4) = TestInsertSGrid()
   ' Delete end
   grdResults.CellText(lResultRow, 5) = TestDeleteEndSGrid()
   
End Sub
Private Sub runFlexGridTests(ByVal lResultRow As Long)
   
   ' Append
   grdResults.CellText(lResultRow, 3) = TestAppendFlexGrid()
   ' Delete start
   grdResults.CellText(lResultRow, 6) = TestDeleteStartFlexGrid()
   ' Insert
   grdResults.CellText(lResultRow, 4) = TestInsertFlexGrid()
   ' Delete end
   grdResults.CellText(lResultRow, 5) = TestDeleteEndFlexGrid()

End Sub

Private Function ResultsCsv() As String
Dim lRow As Long
Dim lCol As Long
Dim sCSV As String
   With grdResults
      For lRow = 1 To .Rows
         If (lRow > 1) Then
            sCSV = sCSV & vbCrLf
         End If
         For lCol = 1 To .Columns
            If (lCol > 1) Then
               sCSV = sCSV & ","
            End If
            sCSV = sCSV & grdResults.CellText(lRow, lCol)
         Next lCol
      Next lRow
   End With
   ResultsCsv = sCSV
End Function


Private Sub Form_Load()
   
   With grdResults
      
      .AddColumn "Rows", "Rows"
      .AddColumn "Control", "Control"
      .AddColumn "Append", "Append Rows"
      .AddColumn "Insert", "Insert Rows"
      .AddColumn "DeleteEnd", "Delete From End"
      .AddColumn "Delete", "Delete From Start"
                  
      .AllowGrouping = True
      .HideGroupingBox = True
                  
   End With
   
   ConfigureListView
   ConfigureSGrid
   configureFlexGrid
   
End Sub

Private Sub Form_Resize()
On Error Resume Next
   lvwTest.Width = Me.ScaleWidth - lvwTest.Left * 2
   grdTest.Width = Me.ScaleWidth - grdTest.Left * 2
   grdMS.Width = Me.ScaleWidth - grdMS.Left * 2
End Sub