FUNCTION: Return Astrology Sign By Birthday
Function: Returns someones astrology sign using their birthday in m/dd/yyyy or m/dd/yy format ie. 8/27/1983 -- > Virgo
Original Author: snowboardr
Inputs
A date value
8/27/1983
8/27/83
Code
Option Explicit
Option Compare Text
'
'-- Copyright Matthew Janofsky 2000
'
'-- Use the class to implement a stopwatch whenever
' you want to time how many milliseconds it takes
' to perform some action.
'
' Example usage:
'
' Public Sub MySub()
' Dim SW As CStopWatch
' Dim X As Long
'
' Set SW = New CStopWatch
'
' '-- Start the timer.
' SW.StartTimer
' For X = 1 To 100000
' '-- Do something.
' If X Mod 10000 = 0 Then
' '-- Show the lap time.
' Debug.Print " Laptime: " & SW.LapTime _
' & " Elapsed: " & SW.ElapsedMilliseconds
' End If
' Next X
' SW.StopTimer
' Debug.Print "Loop Time: " & SW.ElapsedMilliseconds
'
' Set SW = Nothing
' End Sub
'
' Debug output:
' Laptime: 0 Elapsed: 0
' Laptime: 6 Elapsed: 6
' Laptime: 5 Elapsed: 11
' Laptime: 4 Elapsed: 15
' Laptime: 5 Elapsed: 20
' Laptime: 5 Elapsed: 25
' Laptime: 5 Elapsed: 30
' Laptime: 0 Elapsed: 30
' Laptime: 5 Elapsed: 35
' Laptime: 5 Elapsed: 40
' Loop Time: 40
'-- Local Declares
Private Declare Function GetTickCount Lib "kernel32" () As Long
'-- Local private variables
Private m_lStartTime As Long
Private m_lEndTime As Long
Private m_lLastLapTime As Long
Public Sub StopTimer()
On Error GoTo StopTimer_Error
m_lEndTime = GetTickCount()
'-- Exit the procedure.
GoTo StopTimer_Exit
StopTimer_Error:
Err.Raise Err.Number, "CStopWatch::StopTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume StopTimer_Exit
Resume 'For debugging purposes
StopTimer_Exit:
End Sub
Public Sub ResetTimer()
On Error GoTo ResetTimer_Error
m_lStartTime = 0
m_lEndTime = 0
m_lLastLapTime = 0
'-- Exit the procedure.
GoTo ResetTimer_Exit
ResetTimer_Error:
Err.Raise Err.Number, "CStopWatch::ResetTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume ResetTimer_Exit
Resume 'For debugging purposes
ResetTimer_Exit:
End Sub
Public Sub StartTimer()
On Error GoTo StartTimer_Error
Dim lStoppedTime As Long
'-- If there is an endtime, we need to calculate how much time
' has elapsed since it was stopped and adjust the start time
' and last lap time accordingly. We don't want to
' include time that passed while the watch was stopped.
If m_lEndTime > 0 Then
'-- How long were we stopped?
lStoppedTime = GetTickCount() - m_lEndTime
'-- Adjust the start time.
m_lStartTime = m_lStartTime + lStoppedTime
'-- Adjust the LapTime.
m_lLastLapTime = m_lLastLapTime + lStoppedTime
Else
'-- First time we've started. Just capture the start time.
m_lStartTime = GetTickCount()
End If
'-- Clear the endtime.
m_lEndTime = 0
'-- Exit the procedure.
GoTo StartTimer_Exit
StartTimer_Error:
Err.Raise Err.Number, "CStopWatch::StartTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume StartTimer_Exit
Resume 'For debugging purposes
StartTimer_Exit:
End Sub
Public Property Get ElapsedMilliseconds() As Long
On Error GoTo ElapsedMilliseconds_Error
If m_lStartTime = 0 Then
'-- The timer hasn't started yet. Return 0.
ElapsedMilliseconds = 0
GoTo ElapsedMilliseconds_Exit
End If
If m_lEndTime = 0 Then
'-- The user has not clicked stop yet. Give an elapsed time.
ElapsedMilliseconds = GetTickCount() - m_lStartTime
Else
'-- There is a stop time. Just calculate the difference.
ElapsedMilliseconds = m_lEndTime - m_lStartTime
End If
'-- Exit the procedure.
GoTo ElapsedMilliseconds_Exit
ElapsedMilliseconds_Error:
Err.Raise Err.Number, "CStopWatch::ElapsedMilliseconds()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume ElapsedMilliseconds_Exit
Resume 'For debugging purposes
ElapsedMilliseconds_Exit:
End Property
Public Property Get Laptime() As Long
'-- Return the number of seconds since the last LapTime.
On Error GoTo Laptime_Error
Dim lCurrentLapTime As Long
Dim lRetVal As Long
lCurrentLapTime = Me.ElapsedMilliseconds
If m_lLastLapTime = 0 Then
'-- First Lap. Just return the Elapsed Milliseconds.
lRetVal = lCurrentLapTime
Else
lRetVal = lCurrentLapTime - m_lLastLapTime
End If
'-- Save the last lap time.
m_lLastLapTime = lCurrentLapTime
'-- Return the lap time.
Laptime = lRetVal
'-- Exit the procedure.
GoTo Laptime_Exit
Laptime_Error:
Err.Raise Err.Number, "CStopWatch::Laptime()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume Laptime_Exit
Resume 'For debugging purposes
Laptime_Exit:
End Property
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.