Search Tools Links Login

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

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 103 times

Categories

ASP/ HTML

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.