Calender
Here' a handy calender module providing the following functions
CheckLeap = Works out If the year is a leap year returns True If yes False If no
MonthDays = Works out the number of days in the month taking into account leap years
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
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
Its based on a set of routines by Mohammed Tayem for the Proton compiler Orginal can be found here
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.
Have fun, and don't get to depressed ;)
Tim
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
{ **************************************************************** * 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 True If yes False * * If no * **************************************************************************** } Public Function CheckLeap(PYear As Word) As Boolean CheckLeap = false If (PYear And $03) = 0 Then CheckLeap = true 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) MonthDays = MonthLookup(PMonth) If PMonth = 2 Then If CheckLeap(PYear) Then Inc (MonthDays) EndIf 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 If CheckLeap(PYear) Then Inc (PDay) EndIf 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