home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "Module1"
- Option Explicit
-
- Declare Function GetTickCount Lib "kernel32" () As Long
-
- Global Const Op_FillF = 0
- Global Const Op_FillN = 1
- Global Const Op_Calc = 2
- Global Const Op_Scroll = 3
- Global Const Op_LoadW = 4
- Global Const Op_LoadA = 5
- Global Const Op_Save = 6
- Global Const Op_Copy = 7
- Global Const Op_Insert = 8
- Global Const Op_Delete = 9
- Global Const Op_Sort = 10
-
-
- ' Current settings for the timing operations
- Global Set_FillRows%
- Global Set_FillCols%
- Global Set_CalcRows%
- Global Set_CalcCols%
- Global Set_CopyRows%
- Global Set_InsertRows%
- Global Set_DeleteRows%
- Global Set_ScrollRows%
- Global Set_SortRows%
-
-
- ' These are the defaults for the timing operations
- Global Const DefFillRows = 100
- Global Const DefFillCols = 50
- Global Const DefCalcRows = 1000
- Global Const DefCalcCols = 50
- Global Const DefCopyRows = 10000
- Global Const DefInsertRows = 10000
- Global Const DefDeleteRows = 10000
- Global Const DefScrollRows = 10000
- Global Const DefSortRows = 10000
-
- Global Global_Time_VTI#
-
-
-
- Sub CalcTime()
-
- ' Calculates the amount of time it takes to recalc
-
- Dim TheRow%, TheCol%
- Dim RandNum#, BigNum#
-
- ' Fill Worksheet
-
- ' Clear the worksheet and display how many formulas
- Call ClearAll
- BigNum# = CDbl(Set_CalcRows) * CDbl(Set_CalcCols)
- Form1.Results.Caption = "Recalculate " + Format$(BigNum, "##,##0") + " Formulas"
- Form1.Refresh
-
- Form1.MousePointer = 11 ' Hourglass
-
- ' Turn recalc off while we fill the worksheet
- Form1.F1Book1.AutoRecalc = False
-
- ' Put a random number in A1
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 1
- Form1.F1Book1.Number = Int(Rnd(1) * 1000)
- Form1.F1Book1.NumberFormat = "###0.00"
-
- ' Put formulas in the rest of Row 1
- If Set_CalcCols > 1 Then
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 2
- Form1.F1Book1.Formula = "A1+1"
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.SetSelection 1, 2, 1, Set_CalcCols
- Form1.F1Book1.EditCopyRight
- End If
-
- ' Put all formulas in Row 2
- If Set_CalcRows > 1 Then
- Form1.F1Book1.Row = 2
- Form1.F1Book1.Col = 1
- Form1.F1Book1.Formula = "A1+1"
- Form1.F1Book1.NumberFormat = "###0.00"
- If Set_CalcCols > 1 Then
- Form1.F1Book1.Col = 2
- Form1.F1Book1.Formula = "A2+1"
- Form1.F1Book1.SetSelection 2, 2, 2, Set_CalcCols
- Form1.F1Book1.EditCopyRight
- End If
-
- ' Copy Row 2 down to fill the worksheet
- Form1.F1Book1.SetSelection 2, 1, Set_CalcRows - 2, Set_CalcCols
- Form1.F1Book1.EditCopyDown
- End If
-
- 'Recalc back on to recalc all the formulas
- Form1.F1Book1.AutoRecalc = True
-
- ' Restore Mouse Pointer
- Form1.MousePointer = 0
-
- 'Set up Formula One for recalc test
- Form1.F1Book1.AutoRecalc = False
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 1
- Form1.F1Book1.Number = Int(Rnd(1) * 1000)
-
- Call Time_Operation(Op_Calc) ' Time both products
-
- End Sub
-
- Sub ClearAll()
-
- Dim sserror%
-
- ' Clear Formula One
- Form1.F1Book1.SetSelection -1, -1, 0, 0
- Form1.F1Book1.EditClear 1
- Form1.VTSTimeRaw = ""
- Form1.Refresh
-
- End Sub
-
- Sub CopyData()
-
- Dim sserror%
-
- Call ClearAll
- Form1.Results.Caption = "Copy" + Format$(Set_CopyRows, " ##,###") + " Rows"
- Form1.Refresh
-
-
- ' Fill Formula One
-
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 1
- Form1.F1Book1.TEXT = "Copy..."
- Form1.F1Book1.Col = 2
- Form1.F1Book1.TEXT = "Test..."
-
- Form1.F1Book1.Col = 3
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Number = 1234.56
-
- Form1.F1Book1.Col = 4
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Formula = "C1+1"
-
- Form1.F1Book1.Col = 5
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Formula = "D1+1"
-
- Form1.F1Book1.AutoRecalc = False
-
- Call Time_Operation(Op_Copy)
- Form1.F1Book1.AutoRecalc = True
-
- End Sub
-
-
-
- Sub Delete_VTI()
-
- Dim sserror%, i%
-
- ' Delete the specified number of rows
- Form1.F1Book1.SetSelection 1, -1, Set_DeleteRows, 256
- Form1.F1Book1.EditDelete F1ShiftVertical
-
- End Sub
-
- Sub DeleteRows()
-
- Call ClearAll
- Form1.Results.Caption = "Delete " + Format$(Set_DeleteRows, "##,##0") + " Rows"
- Form1.Refresh
-
- Form1.MousePointer = 11
-
- Call Dummy_Data(Set_DeleteRows)
-
- Form1.Refresh
- Form1.MousePointer = 0
-
- Call Time_Operation(Op_Delete) ' Time
-
- End Sub
-
- Sub Dummy_Data(DummyRows%)
-
- ' Fill Formula One
-
- Form1.F1Book1.AutoRecalc = True
-
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 1
- Form1.F1Book1.TEXT = "VCI..."
- Form1.F1Book1.Col = 2
- Form1.F1Book1.TEXT = "Test..."
-
- Form1.F1Book1.Col = 3
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Number = 1
-
- Form1.F1Book1.Col = 4
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Formula = "C1+1"
-
- Form1.F1Book1.Col = 5
- Form1.F1Book1.NumberFormat = "###0.00"
- Form1.F1Book1.Formula = "D1+1"
-
- Form1.F1Book1.AutoRecalc = False
-
- Form1.F1Book1.SetSelection 1, 1, DummyRows - 1, 5
- Form1.F1Book1.EditCopyDown
-
- Form1.F1Book1.AutoRecalc = True
-
- End Sub
-
- Sub Fill_VTI(FillType As Integer)
-
- Dim TheRow%, TheCol%
-
- Form1.F1Book1.AutoRecalc = False
-
- For TheRow = Set_FillRows To 1 Step -1
- For TheCol = Set_FillCols To 1 Step -1
-
- If FillType = 1 Then ' Formulas
- Form1.F1Book1.FormulaRC(TheRow, TheCol) = "A1+1"
- Else ' Numbers
- Form1.F1Book1.NumberRC(TheRow, TheCol) = 12345
- End If
-
- Next TheCol
- Next TheRow
-
- Form1.F1Book1.AutoRecalc = True
-
- If FillType = 1 Then ' Recalculate if Formulas
- Form1.F1Book1.Row = 1
- Form1.F1Book1.Col = 1
- Form1.F1Book1.Number = 1
- Form1.F1Book1.Recalc
- End If
-
- End Sub
-
- Sub FillTimeF()
-
- Call ClearAll
- Form1.Results.Caption = "Fill With" + Format$(Set_FillRows * Set_FillCols, " ##,##0") + " Formulas"
- Form1.Refresh
-
- Call Time_Operation(Op_FillF)
-
- End Sub
-
-
- Sub FillTimeN()
-
- Call ClearAll
- Form1.Results.Caption = "Fill With" + Format$(Set_FillRows * Set_FillCols, " ##,##0") + " Numbers"
- Form1.Refresh
-
- Call Time_Operation(Op_FillN)
-
- End Sub
-
- Sub Insert_VTI()
-
- Dim sserror%, i%
-
- ' Insert specified number of rows
- Form1.F1Book1.SetSelection 1, -1, Set_InsertRows, 256
- Form1.F1Book1.EditInsert F1ShiftVertical
-
- End Sub
-
- Sub InsertRows()
-
- Call ClearAll
- Form1.Results.Caption = "Insert " + Format$(Set_InsertRows, "##,##0") + " Rows"
- Form1.Refresh
-
- Form1.MousePointer = 11 ' Hourglass pointer
-
- Call Dummy_Data(10) ' Put in 10 dummy rows
- Form1.Refresh
-
- Form1.MousePointer = 0
-
- Call Time_Operation(Op_Insert) ' Time FO
-
- End Sub
-
- Sub Load_AVTI()
-
- Dim SSName$
- Dim ReadFileType%
-
- ' Load the ascii file
- SSName$ = App.Path + "\FOTime1.txt"
- Form1.F1Book1.Read SSName$, ReadFileType
-
- Form1.F1Book1.TopRow = 1
- Form1.F1Book1.LeftCol = 1
-
- End Sub
-
- Sub Load_VTI()
-
-
- Dim SSName$
- Dim ReadFileType%
-
- SSName$ = App.Path + "\FOTime1.vts"
- Form1.F1Book1.Read SSName$, ReadFileType
-
- Form1.F1Book1.TopRow = 1
- Form1.F1Book1.LeftCol = 1
-
- End Sub
-
- Sub LoadAscii()
-
- Dim SSName$
- Dim AsciiLoadRows%
-
- AsciiLoadRows = 1000 ' 1000 Rows of Ascii Data
-
- Call ClearAll
- Form1.Results.Caption = "Load " + Format$(AsciiLoadRows, "##,##0") + " Row Ascii File"
- Form1.Refresh
-
- Form1.MousePointer = 11 ' Houseglass mouse pointer
-
- Call Dummy_Data(AsciiLoadRows) ' 1,000 rows of dummy data to save
- Form1.Refresh
-
- ' Save the ascii data to a file
- SSName$ = App.Path + "\FOTime1.txt"
- Form1.F1Book1.Write SSName$, F1FileTabbedText
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
- Call Time_Operation(Op_LoadA) ' Time the load process
-
- End Sub
-
- Sub LoadFile()
-
- Dim SSName$
- Dim WorksheetRows%
-
- WorksheetRows = 1000 ' Load 1000 row worksheet
-
- Call ClearAll
- Form1.Results.Caption = "Load " + Format$(WorksheetRows, "##,##0") + " Row Worksheet"
- Form1.Refresh
-
- ' Create some dummy data
- Form1.MousePointer = 11 ' Houseglass mouse pointer
-
- Call Dummy_Data(1000) ' 1,000 rows of dummy data to save then load
- Form1.Refresh
-
- ' Save a worksheet
- SSName$ = App.Path + "\FOTime1.vts"
- Form1.F1Book1.Write SSName$, F1FileExcel5
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
- Call ClearAll
- Call Time_Operation(Op_LoadW) ' Time the load operation
-
- End Sub
-
- Sub Save_VTI()
-
- Dim SSName$
-
- SSName$ = App.Path + "\FOTime2.vts"
-
- Form1.F1Book1.Write SSName$, F1FileExcel5
-
- End Sub
-
- Sub SaveFile()
-
- Dim SaveRows%
-
- SaveRows = 1000 ' Save 1000 row worksheet
-
- Call ClearAll
- Form1.Results.Caption = "Save " + Format$(SaveRows, "##,##0") + " Row Worksheet"
- Form1.Refresh
-
- Form1.MousePointer = 11 ' Houseglass mouse pointer
-
- Call Dummy_Data(SaveRows) ' 1,000 rows of dummy data to save
- Form1.Refresh
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
- Call Time_Operation(Op_Save) ' Time the save
-
- End Sub
-
- Sub Scroll_VTI()
-
- Dim TheRow%
-
- Form1.F1Book1.TopRow = 1
- For TheRow = 1 To Set_ScrollRows%
- Form1.F1Book1.TopRow = TheRow
- Next TheRow
-
- Form1.F1Book1.Row = Form1.F1Book1.TopRow
- Form1.F1Book1.Col = 1
-
- End Sub
-
-
- Sub ScrollTime()
-
- Call ClearAll
- Form1.Results.Caption = "Scroll " + Format$(Set_ScrollRows, "##,##0") + " Rows"
- Form1.Refresh
-
- ' Fill Worksheet
-
- Form1.MousePointer = 11 ' Hourglass mouse pointer
-
- Call Dummy_Data(Set_ScrollRows) ' Create data to scroll
- Form1.Refresh
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
- Call Time_Operation(Op_Scroll) ' Time Scroll
-
-
- End Sub
-
- Sub SortRows()
-
- Dim TheRow%, TheCol%
-
- Call ClearAll ' Clear the worksheet
- Form1.Results.Caption = "Sort " + Format$(Set_SortRows, "##,##0") + " Rows"
- Form1.Refresh
-
- Form1.MousePointer = 11 ' Hourglass mouse pointer
-
- Call Dummy_Data(Set_SortRows) ' Create data to sort
-
- ' Put a set of random numbers in the first column to sort
-
- Form1.F1Book1.AutoRecalc = False
-
- TheCol = 1
- For TheRow = 1 To Set_SortRows
- Form1.F1Book1.NumberRC(TheRow, TheCol) = Int(Rnd(1) * 1000)
- Next TheRow
-
- Form1.F1Book1.AutoRecalc = True
- Form1.Refresh
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
- Call Time_Operation(Op_Sort) ' Time FO
-
- End Sub
-
- Sub Time_Operation(Operation As Integer)
-
- Dim StartTime&, EndTime&
- Dim i%
-
- Form1.MousePointer = 11 ' Hourglass mouse pointer
-
- ' Set all timer variables to 0
- Form1.VTSTimeRaw = ""
- Form1.Insuff.Visible = False
- Form1.Refresh
-
- ' Time Formula One
-
- StartTime = GetTickCount() ' Get Starting Time
-
- Select Case Operation
- Case Op_FillF
- Call Fill_VTI(1) ' Formulas
- Case Op_FillN
- Call Fill_VTI(2) ' Numbers
- Case Op_Calc
- Form1.F1Book1.AutoRecalc = True
- Case Op_Scroll
- Call Scroll_VTI
- Case Op_LoadW
- Call Load_VTI
- Case Op_LoadA
- Call Load_AVTI
- Case Op_Save
- Call Save_VTI
- Case Op_Copy
- Form1.F1Book1.SetSelection 1, 1, Set_CopyRows + 1, 5
- Form1.F1Book1.EditCopyDown
- Case Op_Insert
- Call Insert_VTI
- Case Op_Delete
- Call Delete_VTI
- Case Op_Sort
- Form1.F1Book1.Sort3 1, 1, Set_SortRows, 10, True, 1, 2, 3
- End Select
-
- 'Get Ending Time
- EndTime = GetTickCount()
-
- ' Calculate time and display
- Global_Time_VTI = (EndTime - StartTime) / 1000
- Form1.VTSTimeRaw = Format$(Global_Time_VTI, "0.00") + " Seconds"
-
- ' If the time was short it may be invalid
- If (EndTime - StartTime) < 200 Then
- Form1.Insuff.Visible = True
- End If
- Form1.Refresh
-
- Form1.MousePointer = 0 ' Normal mouse pointer
-
-
- End Sub
-
-
-