Archive: Calendar Printing Utility (think GNU cal)

'This code is Copyright (C) 2006 HMCsoft and Ebben Feagan
'Modified 1/13/11 to work with FreeBASIC 0.21b
'Added leap year function from http://www.freebasic.net/forum/viewtopic.php?t=17166
'to replace faulty leap year logic
#Include "vbcompat.bi"
 
Declare Sub uses()
Declare Function checkLeapYear(y As Integer) As Integer
 
Type dateholder
        serial As Double
        thismonth As Integer
        thisday As Integer
        thisyear As Integer
        thiswkday As Integer
End Type
 
Dim n As UByte
Dim wkday(7) As String
Dim mnth(6,7) As UByte
Dim monthdays(12) As UByte
Dim today As dateholder
Dim firstday As UByte
Dim lastday As UByte
Dim isLeapYear As Single
Dim m As UByte
Dim tog As UByte
Dim thismonth As String
 
For n = 1 To 7
        wkday(n)=WeekdayName(n,1)
Next n
monthdays(1)=31
monthdays(2)=28
monthdays(3)=31
monthdays(4)=30
monthdays(5)=31
monthdays(6)=30
monthdays(7)=31
monthdays(8)=31
monthdays(9)=30
monthdays(10)=31
monthdays(11)=30
monthdays(12)=31
 
If Len(Command$(1))<>0 Then
        Select Case UCase(Command$(1))
                Case "NOW"
                        today.serial=Now
                Case Else
                        today.serial=DateSerial(Val(Command$(3)),Val(Command$(1)),Val(Command$(2)))
        End Select
Else
        uses()
End If
 
today.thismonth=Month(today.serial)
today.thisday=Day(today.serial)
today.thisyear=Year(today.serial)
today.thiswkday=Weekday(today.serial)
firstday=1
lastday=monthdays(today.thismonth)
If today.thismonth=2 Then
        isLeapYear=checkLeapYear(today.thisyear)
 
        If isLeapYear<>0 Then
                lastday=monthdays(today.thismonth)
        Else
                lastday=29
        End If
End If
 
tog=0
For n=1 To 6
        For m=1 To 7
                If tog>lastday Then GoTo exitfor
                If tog<>0 Then
                        mnth(n,m)=tog
                        tog+=1
                End If
 
                If n=1 And m=Weekday(DateSerial(today.thisyear,today.thismonth,firstday)) Then
                        tog=1
                        mnth(n,m)=tog
                        tog+=1
                End If
        Next m
Next n
exitfor:
Color 15
 
thismonth = MonthName(today.thismonth)
thismonth = thismonth+" "+Str(today.thisyear)
Print
Print Spc(Int(28/2)-Int(Len(thismonth)/2)),thismonth
For n=1 To 7
        If n<7 Then
                Print wkday(n)+" ";
        Else
                Print wkday(n)
        End If
Next n
Color 7
For n=1 To 6
        For m=1 To 7
                If mnth(n,m)<>0 Then
                        If mnth(n,m)=today.thisday Then Color 14
                        If Len(Str(mnth(n,m)))=1 Then
                                Print " ";Str(mnth(n,m));" ";
                        Else
                                Print " ";Str(mnth(n,m));
                        End If
                Else
                        Print "   ";
                End If
                Color 7
                Print " ";
                If mnth(n,m)=lastday Then GoTo exitprint
        Next m
        Print ""
 
Next n
exitprint:
Print
 
 
Sub uses()
        Print "USAGE: cal date"
        Print "Date can be now for current month,"
        Print "or a date in the form MM DD YYYY"
        Print
        End
End Sub
 
 
Function checkLeapYear(y As Integer) As Integer
        If y Mod 400 = 0 Then
                Return 1
        ElseIf y Mod 100 = 0
                Return 0
        ElseIf y Mod 4 = 0
                Return 1
        End If
        Return 0
End Function