|
Supports Access/Office 2000, 2002, 2003, and Visual Basic 6.0!
Also
available for: |
|
|
Why SourceBook? |
|
| SourceBook Info: | |
|
|
|
| Get SourceBook Now: | |
|
|
|
|
"The code is exactly how I
would like to write code and the algorithms used are very efficient
and well-documented." |
|
| Visit: Total .NET SourceBook for Visual Studio .NET Developers | |
|
|
|
Sample Code from Total Visual SourceBook
Total Visual SourceBook comes with an extensive library of ready to run code. All code is fully documented, commented, uses standardized style and naming conventions, and implements error handling.
This page shows a sample module and class from Total Visual SourceBook to give you an idea of how our code is developed.
Sample Class: CMMTimer
Description
Simulate the action of a stop watch by using a high-resolution multimedia timer.
Comments
This class uses a high-resolution multi-media timer to track elapsed time. This class is useful for timing user operations, or for bench-marking your applications. Because it uses the Windows multi-media timer it uses much higher resolution than the built-in VB Timer function.
' Class : CMMTimer
' Description : Track elapsed time
' Source : Total Visual SourceBook
'
' Declarations for Windows API calls
Private Declare Function timeGetTime _
Lib "winmm.dll" () _
As Long
' Local variables to hold Public Property values
Private m_lngScaleFactor As Long
' Private class-specific variables
Private mlngElapsedTime As Long
Private mlngStarted As Long
Private mfStopped As Boolean
Private Sub Class_Initialize()
' Set initial values to defaults which may be overridden
' with property settings
' Source: Total Visual SourceBook
' scales value from milliseconds to seconds
m_lngScaleFactor = 1000
End Sub
Public Property Get ElapsedTime() As Double
' Returns: the current Elapsed Time value, scaled by the
' value of the ScaleFactor property
' Source : Total Visual SourceBook
'
On Error GoTo PROC_ERR
ElapsedTime = _
cDbl((mlngElapsedTime + GetCurrentElapsedTime()) / _
m_lngScaleFactor)
PROC_EXIT:
Exit Property
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"ElapsedTime"
Resume PROC_EXIT
End Property
Public Property Get ScaleFactor() As Long
' Returns: the current value of ScaleFactor
' Source: Total Visual SourceBook
'
ScaleFactor = m_lngScaleFactor
End Property
Public Property Let ScaleFactor(ByVal lngValue As Long)
' lngValue: Set the scaling factor. A value of 1000 returns
' results in portions of seconds; a value of 60000
' returns results in portions of minutes
' Source: Total Visual SourceBook
'
If lngValue > 0 Then
m_lngScaleFactor = lngValue
End If
End Property
Public Sub ResumeTimer()
' Comments : Resumes a timing operation which was paused
' with the StopTimer method. If the timer was not
' started already, it is started automatically.
' Parameters: None
' Returns : Nothing
' Source : Total Visual SourceBook
'
On Error GoTo PROC_ERR
mlngStarted = timeGetTime
mfStopped = False
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"ResumeTimer"
Resume PROC_EXIT
End Sub
Public Sub StartTimer()
' Comments : Starts a timing operation. The value of ElapsedTime
' is reset before beginning
' Parameters: None
' Returns : Nothing
' Source : Total Visual SourceBook
'
On Error GoTo PROC_ERR
mlngStarted = timeGetTime
mfStopped = False
mlngElapsedTime = 0
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"StartTimer"
Resume PROC_EXIT
End Sub
Public Sub StopTimer()
' Comments : Stops the timer. Current elapsed time value is
' not reset.
' Parameters: None
' Returns : Nothing
' Source : Total Visual SourceBook
'
On Error GoTo PROC_ERR
' Set Elapsed Time value to the previous elapsed time
' value, plus any increment since the timer was last started
mlngElapsedTime = mlngElapsedTime + GetCurrentElapsedTime()
mlngStarted = 0
mfStopped = True
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"StopTimer"
Resume PROC_EXIT
End Sub
Private Function GetCurrentElapsedTime() As Long
' Comments : Returns the elapsed time since the timer
' was last started
' Parameters: None
' Returns : Current Elapsed Time
' Source : Total Visual SourceBook
'
On Error GoTo PROC_ERR
If mlngStarted <> 0 And mfStopped = False Then
GetCurrentElapsedTime = (timeGetTime - mlngStarted)
End If
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"GetCurrentElapsedTime"
Resume PROC_EXIT
End Function
|
Sample Module: ModSort
Description
Provides a variety of routines to sort the contents of arrays.
Comments
The sort routines provided in this module use variant arguments. This is done to allow sorting on any data type from strings to dates. However, for maximum performance, these routines should be tailored to the specific data type you wish to sort. For example the quick sort is declared as:
Sub QuickSortVariantArray(avarIn() _
As Variant, ByVal intLowBound As Integer, _
ByVal intHighBound As Integer)
If you wish to search on integers, this declaration would be changed to:
Sub QuickSortIntegerArray(aintIn() _
As Integer, ByVal intLowBound As Integer, _
ByVal intHighBound As Integer)
Please note that the parameter references in the procedure also need to be updated to the new variable names.
Public Sub BubbleSortVariantArray(avarIn() As Variant)
' Comments : Bubble-sorts the passed variant array
' Parameters: avarIn() array of variants
' Returns : Nothing
' Source : Total Visual SourceBook
'
Dim intLowBounds As Integer
Dim intHighBounds As Integer
Dim intX As Integer
Dim intY As Integer
Dim varTmp As Variant
On Error GoTo PROC_ERR
' Get the bounds of the array
intLowBounds = LBound(avarIn)
intHighBounds = UBound(avarIn)
' For each element in the array
For intX = intLowBounds To intHighBounds - 1
' for each element in the array
For intY = intX + 1 To intHighBounds
' If a value lower in the array is greater than a values higher
' in the array, swap them
If avarIn(intX) > avarIn(intY) Then
varTmp = avarIn(intX)
avarIn(intX) = avarIn(intY)
avarIn(intY) = varTmp
End If
Next intY
Next intX
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"BubbleSortVariantArray"
Resume PROC_EXIT
End Sub
Public Sub QuickSortVariantArray( _
avarIn() As Variant, _
ByVal intLowBound As Integer, _
ByVal intHighBound As Integer)
' Comments : Quicksorts the passed array of Variants
' Parameters: avarIn() - array of Variant that gets sorted
' intLowBound - low bound of array
' intHighBound - high bound of array
' Returns : Nothing
' Source : Total Visual SourceBook
'
Dim intX As Integer
Dim intY As Integer
Dim varMidBound As Variant
Dim varTmp As Variant
On Error GoTo PROC_ERR
' If there is data to sort
If intHighBound > intLowBound Then
' Calculate the value of the middle array element
varMidBound = avarIn((intLowBound + intHighBound) \ 2)
intX = intLowBound
intY = intHighBound
' Split the array into halves
Do While intX <= intY
If avarIn(intX) >= varMidBound And avarIn(intY) <= varMidBound Then
varTmp = avarIn(intX)
avarIn(intX) = avarIn(intY)
avarIn(intY) = varTmp
intX = intX + 1
intY = intY - 1
Else
If avarIn(intX) < varMidBound Then
intX = intX + 1
End If
If avarIn(intY) > varMidBound Then
intY = intY - 1
End If
End If
Loop
' Sort the lower half of the array
QuickSortVariantArray avarIn(), intLowBound, intY
' Sort the upper half of the array
QuickSortVariantArray avarIn(), intX, intHighBound
End If
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"QuickSortVariantArray"
Resume PROC_EXIT
End Sub
Public Sub ShellSortVariantArray(avarIn() As Variant)
' Comments : Sorts the passed variant array using shell-sort algorithm
' Parameters: avarIn() array of integers
' Returns : Nothing
' Source : Total Visual SourceBook
'
Dim intLowBound As Integer
Dim intHighBound As Integer
Dim intX As Integer
Dim intY As Integer
Dim varTmp As Variant
On Error GoTo PROC_ERR
' Get the upper and lower bounds of the array
intLowBound = LBound(avarIn)
intHighBound = UBound(avarIn)
' Get the middle of the array
intY = (intHighBound - intLowBound + 1) \ 2
Do While intY > 0
' Sort the lower portion of the array
For intX = intLowBound To intHighBound - intY
If avarIn(intX) > avarIn(intX + intY) Then
varTmp = avarIn(intX)
avarIn(intX) = avarIn(intX + intY)
avarIn(intX + intY) = varTmp
End If
Next intX
' Sort the upper portion of the array
For intX = intHighBound - intY To intLowBound Step -1
If avarIn(intX) > avarIn(intX + intY) Then
varTmp = avarIn(intX)
avarIn(intX) = avarIn(intX + intY)
avarIn(intX + intY) = varTmp
End If
Next intX
' Divide the array into smaller portions for the next loop
intY = intY \ 2
Loop
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"ShellSortVariantArray"
Resume PROC_EXIT
End Sub
|
