From Swordfish Wiki

SwordfishUser: 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
Retrieved from http://www.sfcompiler.co.uk/wiki/pmwiki.php?n=SwordfishUser.Calender
Page last modified on October 15, 2006, at 09:59 PM