Calender
SwordfishUser.Calender History
Hide minor edits - Show changes to output
Changed line 3 from:
CheckLeap = Works out If the year is a leap year returns 1 If yes 0 If no \\
to:
CheckLeap = Works out If the year is a leap year returns True If yes False If no \\
Changed lines 137-138 from:
* Purpose : Works out if the year is a leap year returns 1 if yes 0 if no *
to:
* Purpose : Works out if the year is a leap year returns True If yes False *
* If no *
* If no *
Changed lines 14-15 from:
Its based on a set of routines by Mohammed Tayem for the Proton compiler Orginal can be found here [[http://users.picbasic.org/Howto/Calender/working_with_calendars_and_dates.htm]]
to:
Its based on a set of routines by Mohammed Tayem for the Proton compiler Orginal can be found [[http://users.picbasic.org/Howto/Calender/working_with_calendars_and_dates.htm | here]]
Changed lines 226-227 from:
Const DayOfWeek(7) As String = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
to:
Const DayOfWeek(7) As String = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday",
"Saturday")
"Saturday")
Changed lines 239-240 from:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct","Nov","Dec")
to:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct",
"Nov","Dec")
"Nov","Dec")
Changed lines 251-252 from:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September","October","November","December")
to:
Const MonthStr(12) As String = ("January","February","March","April","May","June",
"July","August","September","October","November","December")
"July","August","September","October","November","December")
Changed lines 140-148 from:
Public Function CheckLeap(PYear As Word) As Byte
result = 0
If PYear Mod 4 = 0 Then
Result = 1
ElseIf PYear Mod 100 = 0 Then
Result = 0
ElseIf PYear Mod 400 = 0 Then
Result = 1
EndIf
ElseIf PYear Mod 400 = 0 Then
Result = 1
EndIf
to:
Public Function CheckLeap(PYear As Word) As Boolean
CheckLeap = false
If (PYear And $03) = 0 Then
CheckLeap = true
EndIf
CheckLeap = false
If (PYear And $03) = 0 Then
CheckLeap = true
EndIf
Deleted line 145:
Changed lines 156-158 from:
If PMonth = 2 Then
to:
MonthDays = MonthLookup(PMonth)
If PMonth = 2 Then
If CheckLeap(PYear) Then
Inc (MonthDays)
EndIf
If PMonth = 2 Then
If CheckLeap(PYear) Then
Inc (MonthDays)
EndIf
Deleted line 162:
Changed lines 187-188 from:
If PMonth > 2 Then
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
to:
If PMonth = 2 Then
If CheckLeap(PYear) Then
Inc (PDay)
EndIf
If CheckLeap(PYear) Then
Inc (PDay)
EndIf
Changed lines 238-239 from:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep",
"Oct","Nov","Dec")
"Oct","Nov","Dec")
to:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct","Nov","Dec")
Changed lines 249-250 from:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August",
"September","October","November","December")
"September","October","November","December")
to:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September","October","November","December")
Changed lines 5-6 from:
TotalDays = Works the total number of days from 1/1/0001 To the test date \\
DayOfWeek = Works the day of the week from the TotalDays value \\
DayOfWeek = Works the day of the week from the TotalDays value \\
to:
TotalDays = Works out the total number of days from 1/1/0001 To the test date \\
DayOfWeek = Works out the day of the week from the TotalDays value \\
DayOfWeek = Works out the day of the week from the TotalDays value \\
Added line 13:
Changed lines 3-12 from:
CheckLeap = Works out If the year is a leap year returns 1 If yes 0 If no
MonthDays = Works out the number of days in the month taking into account leap years
TotalDays = Works the total number of days from 1/1/0001 To the test date
DayOfWeek = Works the day of the week from the TotalDays value
WDayStrShort = Returns a String with the short text For the day of the week
WDayStrLong = Returns a String with the full text For the day of the week
MonthStrShort = Returns a String with the short text For the Month
MonthStrlong = Returns a String with the full text For the Month
DateIsValid = Returns a true Or false To say if the passed date is valid
MonthDays = Works out the number of days in the month taking into account leap years
DayOfWeek = Works the day of the week from the TotalDays value
WDayStrShort = Returns a String with the short text For the day of the week
to:
CheckLeap = Works out If the year is a leap year returns 1 If yes 0 If no \\
MonthDays = Works out the number of days in the month taking into account leap years \\
TotalDays = Works the total number of days from 1/1/0001 To the test date \\
DayOfWeek = Works the day of the week from the TotalDays value \\
WDayStrShort = Returns a String with the short text For the day of the week \\
WDayStrLong = Returns a String with the full text For the day of the week \\
MonthStrShort = Returns a String with the short text For the Month \\
MonthStrlong = Returns a String with the full text For the Month \\
DateIsValid = Returns a true Or false To say if the passed date is valid \\
MonthDays = Works out the number of days in the month taking into account leap years \\
TotalDays = Works the total number of days from 1/1/0001 To the test date \\
DayOfWeek = Works the day of the week from the TotalDays value \\
WDayStrShort = Returns a String with the short text For the day of the week \\
WDayStrLong = Returns a String with the full text For the day of the week \\
MonthStrShort = Returns a String with the short text For the Month \\
MonthStrlong = Returns a String with the full text For the Month \\
DateIsValid = Returns a true Or false To say if the passed date is valid \\
Changed lines 190-191 from:
If PMonth > 2 Then ' Only if in month > 2
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
to:
If PMonth > 2 Then
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
Added lines 13-14:
Its based on a set of routines by Mohammed Tayem for the Proton compiler Orginal can be found here [[http://users.picbasic.org/Howto/Calender/working_with_calendars_and_dates.htm]]
Changed lines 239-240 from:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct","Nov","Dec")
to:
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep",
"Oct","Nov","Dec")
"Oct","Nov","Dec")
Changed lines 251-252 from:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September",
"October","November","December")
"October","November","December")
to:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August",
"September","October","November","December")
"September","October","November","December")
Changed lines 1-2 from:
Here is a handy calender module providing the following functions
to:
Here' a handy calender module providing the following functions
Changed lines 13-14 from:
At the bottom is the module and on top a little didty to show it in action. Enter you birth day and todays date and it will return the day of the week you were born and how many days old you are.
to:
At the bottom is the module and on top a little ditty to show it in action. Enter you birth day and today's date and it will return the day of the week you were born and how many days old you are.
Changed lines 248-249 from:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September","October","November","December")
to:
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September",
"October","November","December")
"October","November","December")
Added lines 1-276:
Here is a handy calender module providing the following functions
CheckLeap = Works out If the year is a leap year returns 1 If yes 0 If no
MonthDays = Works out the number of days in the month taking into account leap years
TotalDays = Works the total number of days from 1/1/0001 To the test date
DayOfWeek = Works the day of the week from the TotalDays value
WDayStrShort = Returns a String with the short text For the day of the week
WDayStrLong = Returns a String with the full text For the day of the week
MonthStrShort = Returns a String with the short text For the Month
MonthStrlong = Returns a String with the full text For the Month
DateIsValid = Returns a true Or false To say if the passed date is valid
At the bottom is the module and on top a little didty to show it in action. Enter you birth day and todays date and it will return the day of the week you were born and how many days old you are.
Have fun, and don't get to depressed ;)
Tim
=code [=
Include "usart.bas"
Include "convert.bas"
Include "Calender.bas"
Function InputNoFromUsart() As Word
Dim InputStr As String * 5
ReadTerminator = 13
ReadItem(InputStr)
InputNoFromUsart = StrToDec(InputStr)
End Function
Sub NewLine()
USART.Write(10,13)
End Sub
Structure date
year As Word
Month As Byte
date As Byte
End Structure
Dim birthday As date
Dim Today As date
Dim TotalDaysAlive As LongWord
Dim TotalDaysAlive2 As LongWord
Dim DayBorn As Byte
Dim Temp As Char
Dim Nextstep As Boolean
SetBaudrate(br19200)
Repeat
NewLine()
Repeat
Nextstep = true
USART.Write("Please enter your year of birth",10,13)
birthday.year = InputNoFromUsart()
USART.Write("Please enter the month of birth",10,13)
birthday.Month = InputNoFromUsart()
USART.Write("Please enter the date of birth",10,13)
birthday.date = InputNoFromUsart()
If Not DateIsValid(birthday.year,birthday.Month,birthday.date) Then
USART.Write("Sorry that date is invalid please try again",10,13)
Nextstep = false
EndIf
Until Nextstep = true
Repeat
Nextstep = true
USART.Write("Please enter todays year",10,13)
Today.year = InputNoFromUsart()
USART.Write("Please enter todays month",10,13)
Today.Month = InputNoFromUsart()
USART.Write("Please enter todays date",10,13)
Today.date = InputNoFromUsart()
If Not DateIsValid(Today.year,Today.Month,Today.date) Then
USART.Write("Sorry that date is invalid please try again",10,13)
Nextstep = false
EndIf
Until Nextstep = true
NewLine()
TotalDaysAlive = TotalDays(birthday.year,birthday.Month,birthday.date)
DayBorn = DayOfWeek(TotalDaysAlive)
TotalDaysAlive = TotalDays(Today.year,Today.Month,Today.date) - TotalDaysAlive
USART.Write("You were Born on ",WDayStrLong(DayBorn),32,DecToStr(birthday.date))
USART.Write(" In ",MonthStrlong(birthday.Month),32,DecToStr(birthday.year),10,13)
USART.Write("And you are now ",DecToStr(TotalDaysAlive)," days old")
NewLine()
USART.Write("try again?")
NewLine()
Repeat
Temp = USART.ReadByte()
Until Temp = "y" Or Temp = "n"
Until Temp = "n"
End
=]
=code [=
{
****************************************************************
* Name : Calender.BAS *
* Author : Tim Box *
* Notice : Not Copyrighted (c) 2006 TJB Systems Ltd *
* : No Rights Reserved *
* Date : 14/10/2006 *
* Version : 1.0 *
* Notes : *
* : *
****************************************************************
}
Module Calender
{
****************************************************************************
* Name : CheckLeap *
* Purpose : Works out if the year is a leap year returns 1 if yes 0 if no *
****************************************************************************
}
Public Function CheckLeap(PYear As Word) As Byte
result = 0
If PYear Mod 4 = 0 Then
Result = 1
ElseIf PYear Mod 100 = 0 Then
Result = 0
ElseIf PYear Mod 400 = 0 Then
Result = 1
EndIf
End Function
{
****************************************************************************
* Name : MonthDays *
* Purpose : Works out the number of days in the month taking into account *
* leap years *
****************************************************************************
}
Public Function MonthDays(PYear As Word,PMonth As Byte) As Byte
Const MonthLookup(13) As Byte = (0,31,29,31,30,31,30,31,31,30,31,30,31)
result = MonthLookup(PMonth)
If PMonth = 2 Then
result = result + CheckLeap(PYear)
End If
End Function
{
****************************************************************************
* Name : TotalDays *
* Purpose : Works the total number of days from 1/1/0001 to the test date *
****************************************************************************
}
Public Function TotalDays(PYear As Word,Pmonth As Byte,PDay As Byte) As LongWord
Const DaysThisYear(13) As Word = (0,0,31,59,90,120,151,181,212,243,273,304,334)
Dim CompleteYears As Word
Dim CompleteMonthDays As Word
Dim LeapYears As Word
Dim Complete4YearCycles As Word
Dim Complete100YearCycles As Byte
Dim Complete400YearCycles As Byte
// Calculate total days of all complete years ( current year is excluded)
CompleteYears = PYear - 1
Complete4YearCycles = CompleteYears/4
Complete100YearCycles = CompleteYears/100
Complete400YearCycles = CompleteYears/400
LeapYears = Complete4YearCycles - Complete100YearCycles + Complete400YearCycles
TotalDays = (CompleteYears * 365) + LeapYears
// Now add in the days in this year
CompleteMonthDays = DaysThisYear(Pmonth)
If PMonth > 2 Then ' Only if in month > 2
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
EndIf
TotalDays = TotalDays + CompleteMonthDays + PDay ' Sum all days }
End Function
{
****************************************************************************
* Name : DayOfWeek *
* Purpose : Works the day of the week from the total no TotalDays value *
****************************************************************************
}
Public Function DayOfWeek(TotalDays As LongWord)As Byte
DayOfWeek = TotalDays Mod 7
Inc(result)
End Function
{
****************************************************************************
* Name : WDayStrShort *
* Purpose : Returns a string with the short text for the day of the week *
****************************************************************************
}
Public Function WDayStrShort(PWday As Byte) As String * 3
Const DayOfWeek(7) As String = ("Sun","Mon","Tue","Wed","Thr","Fri","Sat")
Dec(PWday)
WDayStrShort = DayOfWeek(PWday)
End Function
{
****************************************************************************
* Name : WDayStrLong *
* Purpose : Returns a string with the full text for the day of the week *
****************************************************************************
}
Public Function WDayStrLong(PWday As Byte) As String * 9
Const DayOfWeek(7) As String = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
Dec(PWday)
WDayStrLong = DayOfWeek(PWday)
End Function
{
****************************************************************************
* Name : MonthStrShort *
* Purpose : Returns a string with the short text for the Month *
****************************************************************************
}
Public Function MonthStrShort(PMonth As Byte) As String * 3
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct","Nov","Dec")
Dec(PMonth)
MonthStrShort = MonthStr(PMonth)
End Function
{
****************************************************************************
* Name : MonthStrlong *
* Purpose : Returns a string with the full text for the Month *
****************************************************************************
}
Public Function MonthStrlong(PMonth As Byte) As String * 9
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September","October","November","December")
Dec(PMonth)
MonthStrlong = MonthStr(PMonth)
End Function
{
****************************************************************************
* Name : DateIsValid *
* Purpose : Returns a true or false to say if the passed date is valid *
****************************************************************************
}
Public Function DateIsValid(PYear As Word,PMonth As Byte, PDay As Byte) As Boolean
Dim DaysInMonth As Byte
DateIsValid = false
If PYear > 0 Then
If PMonth > 0 Then
If PMonth < 13 Then
DaysInMonth = MonthDays(PYear,PMonth)
If PDay > 0 Then
If PDay <= DaysInMonth Then
DateIsValid = true
EndIf
EndIf
EndIf
EndIf
EndIf
End Function
End
=]
CheckLeap = Works out If the year is a leap year returns 1 If yes 0 If no
MonthDays = Works out the number of days in the month taking into account leap years
TotalDays = Works the total number of days from 1/1/0001 To the test date
DayOfWeek = Works the day of the week from the TotalDays value
WDayStrShort = Returns a String with the short text For the day of the week
WDayStrLong = Returns a String with the full text For the day of the week
MonthStrShort = Returns a String with the short text For the Month
MonthStrlong = Returns a String with the full text For the Month
DateIsValid = Returns a true Or false To say if the passed date is valid
At the bottom is the module and on top a little didty to show it in action. Enter you birth day and todays date and it will return the day of the week you were born and how many days old you are.
Have fun, and don't get to depressed ;)
Tim
=code [=
Include "usart.bas"
Include "convert.bas"
Include "Calender.bas"
Function InputNoFromUsart() As Word
Dim InputStr As String * 5
ReadTerminator = 13
ReadItem(InputStr)
InputNoFromUsart = StrToDec(InputStr)
End Function
Sub NewLine()
USART.Write(10,13)
End Sub
Structure date
year As Word
Month As Byte
date As Byte
End Structure
Dim birthday As date
Dim Today As date
Dim TotalDaysAlive As LongWord
Dim TotalDaysAlive2 As LongWord
Dim DayBorn As Byte
Dim Temp As Char
Dim Nextstep As Boolean
SetBaudrate(br19200)
Repeat
NewLine()
Repeat
Nextstep = true
USART.Write("Please enter your year of birth",10,13)
birthday.year = InputNoFromUsart()
USART.Write("Please enter the month of birth",10,13)
birthday.Month = InputNoFromUsart()
USART.Write("Please enter the date of birth",10,13)
birthday.date = InputNoFromUsart()
If Not DateIsValid(birthday.year,birthday.Month,birthday.date) Then
USART.Write("Sorry that date is invalid please try again",10,13)
Nextstep = false
EndIf
Until Nextstep = true
Repeat
Nextstep = true
USART.Write("Please enter todays year",10,13)
Today.year = InputNoFromUsart()
USART.Write("Please enter todays month",10,13)
Today.Month = InputNoFromUsart()
USART.Write("Please enter todays date",10,13)
Today.date = InputNoFromUsart()
If Not DateIsValid(Today.year,Today.Month,Today.date) Then
USART.Write("Sorry that date is invalid please try again",10,13)
Nextstep = false
EndIf
Until Nextstep = true
NewLine()
TotalDaysAlive = TotalDays(birthday.year,birthday.Month,birthday.date)
DayBorn = DayOfWeek(TotalDaysAlive)
TotalDaysAlive = TotalDays(Today.year,Today.Month,Today.date) - TotalDaysAlive
USART.Write("You were Born on ",WDayStrLong(DayBorn),32,DecToStr(birthday.date))
USART.Write(" In ",MonthStrlong(birthday.Month),32,DecToStr(birthday.year),10,13)
USART.Write("And you are now ",DecToStr(TotalDaysAlive)," days old")
NewLine()
USART.Write("try again?")
NewLine()
Repeat
Temp = USART.ReadByte()
Until Temp = "y" Or Temp = "n"
Until Temp = "n"
End
=]
=code [=
{
****************************************************************
* Name : Calender.BAS *
* Author : Tim Box *
* Notice : Not Copyrighted (c) 2006 TJB Systems Ltd *
* : No Rights Reserved *
* Date : 14/10/2006 *
* Version : 1.0 *
* Notes : *
* : *
****************************************************************
}
Module Calender
{
****************************************************************************
* Name : CheckLeap *
* Purpose : Works out if the year is a leap year returns 1 if yes 0 if no *
****************************************************************************
}
Public Function CheckLeap(PYear As Word) As Byte
result = 0
If PYear Mod 4 = 0 Then
Result = 1
ElseIf PYear Mod 100 = 0 Then
Result = 0
ElseIf PYear Mod 400 = 0 Then
Result = 1
EndIf
End Function
{
****************************************************************************
* Name : MonthDays *
* Purpose : Works out the number of days in the month taking into account *
* leap years *
****************************************************************************
}
Public Function MonthDays(PYear As Word,PMonth As Byte) As Byte
Const MonthLookup(13) As Byte = (0,31,29,31,30,31,30,31,31,30,31,30,31)
result = MonthLookup(PMonth)
If PMonth = 2 Then
result = result + CheckLeap(PYear)
End If
End Function
{
****************************************************************************
* Name : TotalDays *
* Purpose : Works the total number of days from 1/1/0001 to the test date *
****************************************************************************
}
Public Function TotalDays(PYear As Word,Pmonth As Byte,PDay As Byte) As LongWord
Const DaysThisYear(13) As Word = (0,0,31,59,90,120,151,181,212,243,273,304,334)
Dim CompleteYears As Word
Dim CompleteMonthDays As Word
Dim LeapYears As Word
Dim Complete4YearCycles As Word
Dim Complete100YearCycles As Byte
Dim Complete400YearCycles As Byte
// Calculate total days of all complete years ( current year is excluded)
CompleteYears = PYear - 1
Complete4YearCycles = CompleteYears/4
Complete100YearCycles = CompleteYears/100
Complete400YearCycles = CompleteYears/400
LeapYears = Complete4YearCycles - Complete100YearCycles + Complete400YearCycles
TotalDays = (CompleteYears * 365) + LeapYears
// Now add in the days in this year
CompleteMonthDays = DaysThisYear(Pmonth)
If PMonth > 2 Then ' Only if in month > 2
CompleteMonthDays = CompleteMonthDays + CheckLeap(PYear)
EndIf
TotalDays = TotalDays + CompleteMonthDays + PDay ' Sum all days }
End Function
{
****************************************************************************
* Name : DayOfWeek *
* Purpose : Works the day of the week from the total no TotalDays value *
****************************************************************************
}
Public Function DayOfWeek(TotalDays As LongWord)As Byte
DayOfWeek = TotalDays Mod 7
Inc(result)
End Function
{
****************************************************************************
* Name : WDayStrShort *
* Purpose : Returns a string with the short text for the day of the week *
****************************************************************************
}
Public Function WDayStrShort(PWday As Byte) As String * 3
Const DayOfWeek(7) As String = ("Sun","Mon","Tue","Wed","Thr","Fri","Sat")
Dec(PWday)
WDayStrShort = DayOfWeek(PWday)
End Function
{
****************************************************************************
* Name : WDayStrLong *
* Purpose : Returns a string with the full text for the day of the week *
****************************************************************************
}
Public Function WDayStrLong(PWday As Byte) As String * 9
Const DayOfWeek(7) As String = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
Dec(PWday)
WDayStrLong = DayOfWeek(PWday)
End Function
{
****************************************************************************
* Name : MonthStrShort *
* Purpose : Returns a string with the short text for the Month *
****************************************************************************
}
Public Function MonthStrShort(PMonth As Byte) As String * 3
Const MonthStr(12) As String = ("Jan","Feb","Mar","Apr","May","Jun","Jly","Aug","Sep","Oct","Nov","Dec")
Dec(PMonth)
MonthStrShort = MonthStr(PMonth)
End Function
{
****************************************************************************
* Name : MonthStrlong *
* Purpose : Returns a string with the full text for the Month *
****************************************************************************
}
Public Function MonthStrlong(PMonth As Byte) As String * 9
Const MonthStr(12) As String = ("January","February","March","April","May","June","July","August","September","October","November","December")
Dec(PMonth)
MonthStrlong = MonthStr(PMonth)
End Function
{
****************************************************************************
* Name : DateIsValid *
* Purpose : Returns a true or false to say if the passed date is valid *
****************************************************************************
}
Public Function DateIsValid(PYear As Word,PMonth As Byte, PDay As Byte) As Boolean
Dim DaysInMonth As Byte
DateIsValid = false
If PYear > 0 Then
If PMonth > 0 Then
If PMonth < 13 Then
DaysInMonth = MonthDays(PYear,PMonth)
If PDay > 0 Then
If PDay <= DaysInMonth Then
DateIsValid = true
EndIf
EndIf
EndIf
EndIf
EndIf
End Function
End
=]