Show Posts

Programs / CalenTools a collection of calendar stuff

« on: January 06, 2022, 07:38:59 pm »
Some of this is quite old. Some I wrote in the past couple of months.

I'm open to any comments. I know the coding is a bit simplistic and rough around the edges so to speak.

I just found out that my ASCII boxes didn't survive the copy and paste process. Oh well.

Oh, thanks to Jack for the help with the convert to Julian Day algorithm.
Code: QB64: [Select]
Dim Shared Dt$
Dim Shared y
Dim Shared m
Dim Shared d
Dim Shared y$
Dim Shared m$
Dim Shared d$
Dim Shared JD
Dim Shared row
Dim Shared col
Dim Shared FDay$
Dim Shared dow
Dim Shared doy
Dim Shared DM
Dim Shared LY
Dim Shared dlm
Dim Shared dtm
Dim Shared dnm
Dim Shared MoNa$
Dim Shared WkDa$
Dim Shared xerr
 
Screen _NewImage(80, 50)
_ScreenMove _Middle
_Title "CalenTools"
 
xerr = 0
FDay$ = ""
 
filenum = FreeFile
If _FileExists("calentools.dat") Then
    Open "calentools.dat" For Input As #filenum
    Input #filenum, FDay$
    Close #filenum
End If
 
Main_Menu
Sub Main_Menu
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "º                                  Main Menu                                   º"
    Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
    Print "º 0. CalenTools only works for years between 1583 and 3266 inclusive.          º"
    Print "º    See why, and read about Julian Day numbers and ISO week numbers.          º"
    Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¶"
    Print "º 1. Add or Subtract days from a date.                                         º"
    Print "º 2. Calendars for a month and/or a year.                                      º"
    Print "º 3. Day of week e.g., 1968-03-17 was a Sunday.                                º"
    Print "º 4. Day of week repetitive e.g., what years following 1968 was 03-17 a Sunday.º"
    Print "º 5. Day of year number from date e.g., 1968-03-17 was 77th day of the year.   º"
    Print "º 6. Date from day of year number e.g., in 1968 77th day was 03-17.            º"
    Print "º 7. Difference between two dates in Years Months and Days.                    º"
    Print "º 8. Find Easter day.                                                          º"
    Print "º 9. Date to Julian Day number.                                                º"
    Print "º A. Julian Day number to date.                                                º"
    Print "º B. Was/is/will it be a Leap Year.                                            º"
    Print "º c. Week number of the year (this is ISO week numbers).                       º"
    Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¶"
    Print "º Q. To Quit.  You can also quit from any other prompt by entering Q.          º"
    Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
    Print "º Enter the number/letter of your choice:                                      º"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Locate 22, 42: Input " ", q$:
    q$ = LCase$(q$)
    Select Case q$
        Case "0": Why_Dates
        Case "1": Start_ASD
        Case "2": Start_Cals
        Case "3": Start_DoW
        Case "4": Start_DoWR
        Case "5": Start_DoY
        Case "6": Start_RDoY
        Case "7": Start_DYMD
        Case "8": Start_Easter
        Case "9": Start_Date_to_JD
        Case "a": Start_JD_to_Date
        Case "b": Start_Leap_Year
        Case "c": Start_WkNo
        Case "q": Done
        Case Else: Main_Menu
    End Select
End Sub
 
Sub Start_ASD
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Add or Subtract Days  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Are you Adding to or Subtracting from a date (A/S)"; q$
    q$ = LCase$(q$)
 
    If q$ = "a" Then
        OpWd$ = " plus "
        xWd$ = "add"
        yWd$ = "add to"
    ElseIf q$ = "s" Then
        OpWd$ = " minus "
        xWd$ = "subtrtact"
        yWd$ = "subtrtact from"
    ElseIf q$ = "q" Then
        Done
    Else
        Print " You must enter 'A' for adding or 'S' for subtracting."
        Input " Press 'Enter' to continue."; q$
        If LCase$(q$) = "q" Then Done
        Start_ASD
    End If
 
    Print " Enter the number of days you want to "; xWd$; ":";: Input " ", ND$
    If LCase$(ND$) = "q" Then Done
    ND = Val(ND$)
 
    Print " Enter date to "; yWd$; " (yyyy-mm-dd)";: Input " ", Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_ASD
 
    Date_to_JD
    JDs = JD
    If LCase$(q$) = "a" Then
        JD = JDs + ND
    Else
        JD = JDs - ND
    End If
    JD_to_Date
 
    Zellers
 
    Day_Names_Long
 
    YMD_to_Str
 
    Print: Print
    Print " "; Dt$; RTrim$(OpWd$); ND; "days is "; WkDa$; ","; y$; "-" + LTrim$(m$); "-"; LTrim$(d$)
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_ASD
End Sub
 
Sub Start_Cals
    Cls
    If FDay$ = "s" Or FDay$ = "m" Then
        Cals
    Else
        Get_1st_Day
    End If
End Sub
 
Sub Get_1st_Day
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Calendars  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Print " Do you wish weeks to start on Sunday or Monday.  Your choice will be"
    Print " remembered until you quit, unless you change it in the Calendar menu."
    Input " (S/M): ", FDay$
    FDay$ = LCase$(FDay$)
    If FDay$ = "q" Then
        Done
    ElseIf FDay$ = "s" Or FDay$ = "m" Then
        Cals
    Else
        Get_1st_Day
    End If
End Sub
 
Sub Cals:
    Cls
    Tday = Val(Mid$(Date$, 4, 2))
    Locate 1, 18: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Locate 2, 18: Print "º                 Calendar                  º"
    Locate 3, 18: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
    Locate 4, 18: Print "º 1. This month                             º"
    Locate 5, 18: Print "º 2. Another month this year                º"
    Locate 6, 18: Print "º 3. A month in a dIfferent year            º"
    Locate 7, 18: Print "º 4. Calendar of this year                  º"
    Locate 8, 18: Print "º 5. Calendar of another year               º"
    Locate 9, 18: Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¶"
    Locate 10, 18: Print "º C. Change first day of week               º"
    Locate 11, 18: Print "º M. Main Menu                              º"
    Locate 12, 18: Print "º S. Save 1st day of week to disc           º"
    Locate 13, 18: Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¶"
    Locate 14, 18: Print "º Q. To Quit CalenTools                     º"
    Locate 15, 18: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
    Locate 16, 18: Print "º Enter the number/letter of your choice:   º"
    Locate 17, 18: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Locate 16, 59: Input " ", q$
    q$ = LCase$(q$)
    Select Case q$
        Case "1"
            y = Val(Right$(Date$, 4))
            m = Val(Left$(Date$, 2))
            Make_Month
        Case "2"
            Locate 18, 19: Input " Enter month mm: ", m$
            If LCase$(q$) = "q" Then Done
            m = Val(m$)
            If m < 1 Or m > 12 Then
                Print " Enter a month number between 1 and 12."
                Input " Press 'Enter' to continue. ", q$
                If LCase$(q$) = "q" Then Done
                Cals
            End If
            y = Val(Right$(Date$, 4))
            Make_Month
        Case "3"
            Locate 18, 19: Input " Enter a year and month yyyy-mm: ", Dt$
            If LCase$(Dt$) = "q" Then Done
            If Len(Dt$) <> 7 Then
                Print " Enter a 4 digit year '-' 2 digit month, e.g., yyyy-mm"
                Input " Press 'Enter' to continue. ", q$
                Cals
            End If
            y = Val(Left$(Dt$, 4))
            m = Val(Right$(Dt$, 2))
            If m < 1 Or m > 12 Or y < 1583 Or y > 3266 Then
                Print " You must enter year from 1583 to 3266 and a month from 1 - 12."
                Input " Press 'Enter' to continue. ", q$
                If LCase$(q$) = "q" Then Done
                Cals
            End If
            Make_Month
        Case "4"
            y = Val(Right$(Date$, 4))
            Make_Year
        Case "5"
            Locate 18, 19: Input " Enter a year yyyy ", y$
            If LCase$(y$) = "q" Then Done
            y = Val(y$)
            If Len(y) <> 4 Or y < 1583 Or y > 3266 Then
                Print
                Print " Enter a year between 1583 and 3266."
                Input " Press 'Enter' to continue. ", q$
                If LCase$(q$) = "q" Then Done
                Cals
            End If
            Make_Year
        Case "c"
            Get_1st_Day: Cals
        Case "m"
            Main_Menu
        Case "s"
            Save_1st_Day
        Case "q"
            Done
        Case Else
            Cals
    End Select
    If Val(q$) < 4 Then row = row + 1
    Locate row - 1, 1: Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_Cals
End Sub
 
Sub Make_Month
    Cls
    Print
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    row = 3
    col = 30
    d = 1
    Make_Cal
End Sub
 
Sub Make_Year
    Cls
    Print
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    row = 3
    m = 1
    d = 1
    nm = m
    For mr = 1 To 4
        col = 5
        For cm = 1 To 3
            Make_Cal
            nm = nm + 1
            d = 1
            m = nm
            row = row - 8
            col = col + 25
        Next cm
        row = row + 9
    Next mr
End Sub
 
Sub Make_Cal
    TDay = Val(Mid$(Date$, 4, 2))
    Zellers
    If FDay$ = "m" Then dow = dow - 1: If dow < 0 Then dow = 6
    n2 = dow
 
    Day_Of_Year
    n1 = doy: m1 = m
    m = m + 1
 
    If m > 12 Then
        n3 = 31
    Else
        Day_Of_Year: n3 = doy - n1
    End If
 
    m = m1
    Month_Names_Long
    Color 7, 0: Locate row, col + 1: Print MoNa$; " "; y
    row = row + 1
 
    If FDay$ = "m" Then
        Color 7, 0: Locate row, col + 1: Print "Mo Tu We Th Fr"
        Color 12, 0: Locate row, col + 16: Print "Sa Su": Color 7, 0
    Else
        Color 12, 0: Locate row, col + 1: Print "Su"
        Color 7, 0: Locate row, col + 4: Print "Mo Tu We Th Fr"
        Color 12, 0: Locate row, col + 19: Print "Sa": Color 7, 0
    End If
 
    row = row + 1
    dn = 0
 
    ' This sets up printing "Gray Days"
    DM = m1
    Days_In_Month
    GD = dlm - n2 + 1
    aGD = 1
 
    ' Print the calendars
    For i = 1 To 6
        C = col
        g = 1
        wkd = 0
        For j = 1 To 7
            s = C
            If g < n2 + 1 And i = 1 Or dn >= n3 Then
 
                If dn < 1 Then
                    Color 8, 0: Locate row, s: Print GD
                ElseIf dn >= n3 Then
                    If aGD <= 9 Then s = s + 1
                    Color 8, 0: Locate row, s: Print aGD
                    Color 7, 0
                    aGD = aGD + 1
                End If
 
            ElseIf m1 = Val(Left$(Date$, 2)) And y = Val(Right$(Date$, 4)) And dn + 1 = TDay Then
                dn = dn + 1
                If dn <= 9 Then s = s + 1
                Color 11, 0: Locate row, s: Print dn
            ElseIf (FDay$ = "s" And wkd = 0 Or wkd = 6) Or (FDay$ = "m" And wkd >= 5 Or wkd = 6) Then
                dn = dn + 1
                If dn <= 9 Then s = s + 1
                Color 12, 0: Locate row, s: Print dn: Color 7, 0
            ElseIf m1 <> Val(Left$(Date$, 2)) Or y <> Val(Right$(Date$, 4)) Or dn + 1 <> TDay Then
                dn = dn + 1
                If dn <= 9 Then s = s + 1
                Color 7, 0: Locate row, s: Print dn
            End If
            wkd = wkd + 1
            C = C + 3
            g = g + 1
            GD = GD + 1
        Next j
        row = row + 1
    Next i
End Sub
 
Sub Start_DoW
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Day of Week  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Print " Enter date to check (yyyy-mm-dd)";: Input Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_DoW
 
    Zellers
 
    Day_Names_Long
 
    YMD_to_Str
 
    Print: Print
    Print " "; Dt$; " was/is/will be a "; WkDa$
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_DoW
End Sub
 
Sub Start_DoWR
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Day of Week Repetitive  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Print " Enter date to start checking at (yyyy-mm-dd)";: Input Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_DoWR
 
    Print
    Print " Do you want to check until today or for a given number of years?"
    Input " Press 0 for today or a (positive) number up to 250 "; YrCt$
    If LCase$(YrCt$) = "q" Then Done
    YrCt = Val(YrCt$)
 
    If YrCt < 1 Then
        YrCt = Val(Right$(Date$, 4)) - y
    ElseIf YrCt > 250 Then
        YrCt = 250
    End If
 
    Zellers
    b = dow
 
    Print
    Print " Date             Day YrNo Count"
    Print
    row = 10
    col = 23
    x = 0
    C = 0
    Do Until x = YrCt
        Zellers
 
        Day_Names_Short
 
        c$ = Str$(C)
        x$ = Str$(x)
 
        If b = dow Then
            y$ = Str$(y)
            If m < 10 Then
                m$ = "0" + LTrim$(Str$(m))
            Else
                m$ = Str$(m)
            End If
            If d < 10 Then
                d$ = "0" + LTrim$(Str$(d))
            Else
                d$ = Str$(d)
            End If
 
            Locate row, 1: Print " "; LTrim$(y$); "-"; LTrim$(m$); "-"; LTrim$(d$); "  was  "; WkDa$
 
            If x < 10 Then
                Locate row, col + 2: Print x$
            ElseIf x < 100 Then
                Locate row, col + 1: Print x$
            Else
                Locate row, col: Print x$
            End If
 
            If C < 10 Then
                Locate row, col + 7: Print c$
            ElseIf C < 100 Then
                Locate row, col + 6: Print c$
            Else
                Locate row, col + 5: Print c$
            End If
            C = C + 1
            row = row + 1
        End If
 
        x = x + 1
        y = y + 1
    Loop
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_DoWR
End Sub
 
Sub Start_DoY
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Day of Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a date, e.g. 1969-07-20 (yyyy-mm-dd): "; Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_DoY
 
    Day_Of_Year
 
    YMD_to_Str
 
    Print: Print
    Print " "; Dt$; " was/is/will be day number "; doy
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_DoY
End Sub
 
Sub Start_RDoY
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Reverse Day of Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter year and day number, 1969-074 (yyyy-nnn): "; Dt$
    If LCase$(Dt$) = "q" Then Done
 
    If Len(Dt$) <> 8 Then
        Print " You need a 4 digit year '-' 3 digit day number: yyyy-nnn."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_RDoY
    End If
 
    y = Val(Left$(Dt$, 4))
    If y < 1583 Or y > 3266 Then
        Print
        Print " Enter a year between 1583 and 3266."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_RDoY
    End If
 
    doy = Val(Right$(Dt$, Len(Dt$) - InStr(Dt$, "-")))
 
    Leap_Year
    If LY = 0 Then
        diy = 365
    Else
        diy = 366
    End If
 
    If doy < 1 Or doy > diy Then
        Print " You need day of year number between 1 and "; diy
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_RDoY
    End If
 
    If doy > 59 + LY Then
        d = doy + 2 - LY
    Else
        d = doy
    End If
 
    m = 100 * (d + 91) \ 3055
    d = d + 91 - (3055 * m \ 100)
    m = m - 2
 
    Zellers
 
    Day_Names_Long
 
    Month_Names_Long
 
    YMD_to_Str
 
    Print: Print
    Print " For day number"; doy; "of"; y$; " the date was/is/will be "; WkDa$; ", "; MoNa$; d$
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_RDoY
End Sub
 
Sub Start_DYMD
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍ¼  Difference Between Dates in Years, Months, and Days  ÈÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
 
    Input " Enter first date (yyyy-mm-dd)"; Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_DYMD
 
    Yr1 = y
    Mo1 = m
    Da1 = d
    Dt1$ = Dt$
 
    Date_to_JD
    JD1 = JD
 
    Input " Enter second date (yyyy-mm-dd)"; Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_DYMD
 
    Yr2 = y
    mo2 = m
    da2 = d
    Dt2$ = Dt$
 
    Date_to_JD
    JD2 = JD
 
    ' Determine which Date/JD is larger.
    If JD1 > JD2 Then
        LrJD = JD1
        LrYr = Yr1
        LrMo = Mo1
        LrDa = Da1
        LrDt$ = Dt1$
        SmJD = JD2
        SmYr = Yr2
        SmMo = mo2
        SmDa = da2
        SmDt$ = Dt2$
    Else
        LrJD = JD2
        LrYr = Yr2
        LrMo = mo2
        LrDa = da2
        LrDt$ = Dt2$
        SmJD = JD1
        SmYr = Yr1
        SmMo = Mo1
        SmDa = Da1
        SmDt$ = Dt1$
    End If
 
    ' Find the difference between the two dates in days.
    OpJ$ = Str$(LrJD - SmJD)
    OpJD = LrJD - SmJD
 
    ' Find the Days, Months, and Years between the two dates.
    ' Find Days
    If SmDa = LrDa Then
        OpDa = 0
    ElseIf SmDa < LrDa Then
        OpDa = LrDa - SmDa
    Else
        DM = LrMo
        y = LrYr
        Days_In_Month
        OpDa = LrDa + dlm - SmDa
        LrMo = LrMo - 1
    End If
 
    'find Months
    If SmMo = LrMo Then
        OpMo = 0
    ElseIf SmMo < LrMo Then
        OpMo = LrMo - SmMo
    Else
        OpMo = LrMo + 12 - SmMo
        LrYr = LrYr - 1
    End If
 
    'find Years
    If LrYr = SmYr Then
        OpYr = 0
    Else
        OpYr = LrYr - SmYr
    End If
 
    SJD$ = Str$(SmJD)
    LJD$ = Str$(LrJD)
 
    Print: Print
    Print " The difference between "; SmDt$; " and "; LrDt$; " is:"
    Print
    Print " "; LTrim$(OpJ$); " Days,"
    Print " or"; OpYr; "Years,"; OpMo; "Months, and"; OpDa; "Days,"
    Print " or"; OpYr * 12 + OpMo; "Months and"; OpDa; "Days,"
    Print " or"; OpJD \ 7; "Weeks and"; OpJD Mod 7; "Days."
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_DYMD
End Sub
 
Sub Start_Easter
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Find Easter  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a year yyyy: ", y$
    If LCase$(y$) = "q" Then Done
    y = Val(y$)
 
    If Len(y) <> 4 Or y < 1583 Or y > 3266 Then
        Print
        Print " Enter a year between 1583 and 3266."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_RDoY
    End If
 
    A = y Mod 19
    B = y Mod 4
    C = y Mod 7
    P = (y \ 100)
    Q = ((13 + 8 * P) \ 25)
    m = (15 - Q + P - P \ 4) Mod 30
    n = (4 + P - P \ 4) Mod 7
    d = (19 * A + m) Mod 30
    E = (2 * B + 4 * C + 6 * d + n) Mod 7
    day = (22 + d + E)
 
    If d = 29 And E = 6 Then
        m = 4
        d = 19
    ElseIf d = 28 And E = 6 Then
        m = 4
        d = 18
    Else
        If day > 31 Then
            day$ = Str$(day - 31)
            If Val(day$) < 10 Then day$ = Str$(0) + LTrim$(day$)
            m = 4
            d = day - 31
        Else
            day$ = Str$(day)
            If Val(day$) < 10 Then day$ = Str$(0) + LTrim$(day$)
            m = 3
            d = day
        End If
    End If
 
    Month_Names_Long
    Print: Print
    Print " In"; y; "Easter was/is/will be on Sunday, "; MoNa$; day$
 
    Date_to_JD
    JD = JD - 47
 
    JD_to_Date
 
    YMD_to_Str
 
    Month_Names_Long
 
    Print " And Mardi Gras was/is/will be on Tuesday, "; MoNa$; d$
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_Easter
End Sub
 
Sub Start_Date_to_JD
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Date to Julian Day Number  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a date yyyy-mm-dd: ", Dt$
    If LCase$(Dt$) = "q" Then Done
 
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_Date_to_JD
 
    Date_to_JD
 
    Print: Print
    Print " "; LTrim$(Dt$); " is Julian Day number: "; JD
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_Date_to_JD
End Sub
 
Sub Start_JD_to_Date
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Julian Day Number to Date  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a number between 2299239 (1583-01-01) and 2914307 (3266-12-31): ", JD$
    If LCase$(JD$) = "q" Then Done
    JD = Val(JD$)
 
    If JD < 2299239 Or JD > 2914672 Then
        Print " You entered "; JD$; " This is an incorrect value for the JD number."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_JD_to_Date
    End If
 
    JD_to_Date
 
    Zellers
 
    Day_Names_Long
 
    YMD_to_Str
 
    Print: Print
    Print " "; JD$; " is the Julian Day Number for "; WkDa$ + y$ + "-" + LTrim$(m$) + "-" + LTrim$(d$)
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_JD_to_Date
End Sub
 
Sub Start_Leap_Year
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Leap Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a year yyyy: ", y$
    If LCase$(y$) = "q" Then Done
    y = Val(y$)
    If y < 1583 Or y > 3266 Then
        Print
        Print " Enter a year between 1583 and 3266."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        Start_Leap_Year
    End If
 
    Leap_Year
    If LY = 1 Then
        ly$ = "Yes"
        lyw$ = "was/is/will be"
    Else
        ly$ = "No"
        lyw$ = "wasn't/isn't/won't be"
    End If
    Print: Print
    Print " "; ly$; " "; y$; " "; lyw$; " a Leap Year."
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_Leap_Year
End Sub
 
Sub Start_WkNo
    Cls
    Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
    Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  Week Number  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
    Print
    Input " Enter a date yyyy-mm-dd: ", Dt$
    If LCase$(Dt$) = "q" Then Done
    Date_to_YMD
    If xerr = 1 Then xerr = 0: Start_WkNo
 
    lwn = (y + (y \ 4) - (y \ 100) + (y \ 400)) Mod 7
 
    Zellers
    If dow = 0 Then dow = 7
 
    Day_Of_Year
 
    WN = (10 + doy - dow) \ 7
 
    If WN < 1 Then
        yy = y: y = y - 1
        mm = m: m = 1
        dd = d: d = 1
        Zellers
        Leap_Year
        If dow = 4 Then
            WN = 53
        ElseIf dow = 3 And LY = 1 Then
            WN = 53
        Else
            WN = 52
        End If
        y = yy: m = mm: d = dd
        Zellers
        If dow = 7 Then dow = 0
        Day_Names_Long
        If m = 1 And WN > 50 Then y = y - 1
        WN$ = Str$(WN)
        Print: Print
        Print " "; Dt$; " is "; WkDa$; " of week number"; RTrim$(WN$); ","; y
    Else
        Zellers
        If dow = 7 Then dow = 0
        Day_Names_Long
        If lwn < 4 And WN = 53 Then
            WN = 1
            y = y + 1
        End If
        WN$ = Str$(WN)
        Print: Print
        Print " "; Dt$; " is "; WkDa$; " of week number"; RTrim$(WN$); ","; y
    End If
 
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Again: Start_WkNo
End Sub
 
' ================================================================================
'                        common SUBs used by other routines
' ================================================================================
 
Sub Again
    Dt$ = ""
    y = 0
    m = 0
    d = 0
    JD = 0
    row = CsrLin
    Do
        Locate row, 1: Print "                                                                               "
        Locate row, 1: Input " Enter 'A' to go again, 'M' for main menu, or 'Q' to quit (A/M/Q)"; q$
        q$ = LCase$(q$)
        If q$ = "a" Then
            Exit Do
        ElseIf q$ = "m" Then
            Main_Menu
        ElseIf q$ = "q" Then
            Done
        End If
    Loop
End Sub
 
' Gives the day of week for any Gregorian calendar date.
Sub Zellers
    If m > 2 Then
        mz = m - 2: yz = y
    Else
        mz = m + 10: yz = y - 1
    End If
 
    cz = yz \ 100: dz = yz - 100 * cz
    dow = ((13 * mz - 1) \ 5) + d + dz + (dz \ 4) + (cz \ 4) - cz - cz + 77
    dow = dow - 7 * (dow \ 7)
End Sub
 
' Gives the day of the year
Sub Day_Of_Year
    doy = (3055 * (m + 2) \ 100) - 91
    Leap_Year
    If m > 2 Then doy = doy - 2 + LY
    doy = doy + d
End Sub
 
Sub Leap_Year
    LY = 0
    If y Mod 4 = 0 Then LY = 1
    If y Mod 100 = 0 Then LY = 0
    If y Mod 400 = 0 Then LY = 1
End Sub
 
' Get the number of days for last month (dlm), this month (dtm), and next month (dnm)
Sub Days_In_Month
    Leap_Year
    DM1 = DM * 2 - 1
    dlm = Val(Mid$("313128313031303131303130", DM1, 2))
    If dlm = 28 And LY = 1 Then dlm = 29
    dtm = Val(Mid$("312831303130313130313031", DM1, 2))
    If dtm = 28 And LY = 1 Then dtm = 29
    dnm = Val(Mid$("283130313031313031303131", DM1, 2))
    If dnm = 28 And LY = 1 Then dnm = 29
End Sub
 
' Convert a Gregorian Date to a Julian Day number.
Sub Date_to_JD
    JD = d - 32075 + (1461 * (y + 4800 + ((m - 14) \ 12)) \ 4) + 367 * (m - 2 - ((m - 14) \ 12) * 12) \ 12 - 3 * ((y + 4900 + ((m - 14) \ 12)) \ 100) \ 4
End Sub
 
' Convert a Julian Day number to a Gregorian Date.
Sub JD_to_Date
    L = JD + 68569
    n = 4 * L \ 146097
    L = L - (146097 * n + 3) \ 4
    y = 4000 * (L + 1) \ 1461001
    L = L - (1461 * y \ 4) + 31
    m = 80 * L \ 2447
    d = L - (2447 * m \ 80)
    L = m \ 11
    m = m + 2 - (12 * L)
    y = 100 * (n - 49) + y + L
End Sub
 
Sub Day_Names_Short
    Select Case dow
        Case 0: WkDa$ = "Sun"
        Case 1: WkDa$ = "Mon"
        Case 2: WkDa$ = "Tue"
        Case 3: WkDa$ = "Wed"
        Case 4: WkDa$ = "Thu"
        Case 5: WkDa$ = "Fri"
        Case 6: WkDa$ = "Sat"
    End Select
End Sub
 
Sub Day_Names_Long
    Select Case dow
        Case 0: WkDa$ = "Sunday"
        Case 1: WkDa$ = "Monday"
        Case 2: WkDa$ = "Tuesday"
        Case 3: WkDa$ = "Wednesday"
        Case 4: WkDa$ = "Thursday"
        Case 5: WkDa$ = "Friday"
        Case 6: WkDa$ = "Saturday"
    End Select
End Sub
 
Sub Month_Names_Short
    Select Case m
        Case 1: MoNa$ = "Jan"
        Case 2: MoNa$ = "Feb"
        Case 3: MoNa$ = "Mar"
        Case 4: MoNa$ = "Apr"
        Case 5: MoNa$ = "May"
        Case 6: MoNa$ = "Jun"
        Case 7: MoNa$ = "Jul"
        Case 8: MoNa$ = "Aug"
        Case 9: MoNa$ = "Sep"
        Case 10: MoNa$ = "Oct"
        Case 11: MoNa$ = "Nov"
        Case 12: MoNa$ = "Dec"
    End Select
End Sub
 
Sub Month_Names_Long
    Select Case m
        Case 1: MoNa$ = "January"
        Case 2: MoNa$ = "February"
        Case 3: MoNa$ = "March"
        Case 4: MoNa$ = "April"
        Case 5: MoNa$ = "May"
        Case 6: MoNa$ = "June"
        Case 7: MoNa$ = "July"
        Case 8: MoNa$ = "August"
        Case 9: MoNa$ = "September"
        Case 10: MoNa$ = "October"
        Case 11: MoNa$ = "November"
        Case 12: MoNa$ = "December"
    End Select
End Sub
 
' Convert input date (Dt$) to year, month, and day integers And check that they are valid
Sub Date_to_YMD
    y = Val(Left$(Dt$, 4))
    m = Val(Mid$(Dt$, 6, 2))
    d = Val(Right$(Dt$, 2))
 
    DM = m
    Days_In_Month
    If Len(Dt$) <> 10 Then
        Print
        Print " Your date has too few or too many characters in it."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        xerr = 1
    ElseIf y < 1583 Or y > 3266 Then
        Print
        Print " Enter a year between 1583 and 3266."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        xerr = 1
    ElseIf m < 1 Or m > 12 Then
        Print
        Print " Enter a month number between 1 and 12."
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        xerr = 1
    ElseIf d < 1 Or d > dtm Then
        Print
        Print " Enter a day number between 1 and "; dtm;
        Input " Press 'Enter' to continue. ", q$
        If LCase$(q$) = "q" Then Done
        xerr = 1
    End If
End Sub
 
' Convert Year, month, and day integers to strings and add leading 0s to digits less than 10
Sub YMD_to_Str
    y$ = Str$(y)
    m$ = Str$(m)
    d$ = Str$(d)
 
    If m < 10 Then m$ = Str$(0) + LTrim$(m$)
    If d < 10 Then d$ = Str$(0) + LTrim$(d$)
End Sub
 
Sub Why_Dates
    Cls
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Print
    Print "    CalenTools will not work with years prior to 1583 or after 3266, this was"
    Print " done intentionally partly as an error prevention measure."
    Print "    Prior to 1583 most of the western world used the Julian Calendar which had"
    Print " an extra 3 leap years every 400 years.  Pope Gregory XIII wrote a papal bull"
    Print " in Feb. 1582 to correct for this error by suppressing 10 days.  Thus causing"
    Print " Oct. 5, 1582 to become Oct. 15, 1582.  (So I dropped the last two and a half"
    Print " months of 1582 because and I don't think most people will need them)."
    Print "    The papel bull was adopted by most countries at different times.  A lof of"
    Print " Roman Catholic countries Spain, Portugal, etc. and their colonies changed on"
    Print " Oct. 15, 1582. Great Britain and the American colonies changed in 1752.  The"
    Print " most recant change from The Julian calendar that I know of is Turkey in 1927."
    Print "    As Far as I know only a few religions still use the Julian calendar.  You"
    Print " can use the search engine of your choice to find a list of when the different"
    Print " countries adopted the Gregorian calendar."
    Print "    As for after 3266, it my be my limited sense of reality, but I don't really"
    Print " think it's necessary as I think there will be something better by then.  Maybe"
    Print " even a whole new calendar system. "
    Print "    Also it's the end of the first Julian Period so Julian Day numbers will"
    Print " restart at one.  I'm using Julian Day numbers are here to 'Add or Subtract"
    Print " Days' and to find the 'Difference between two dates'."
    Print "    The Julian Period and Julian Day numbers (not to be confused with the"
    Print " Julian Calendar) start at noon on -4712-01-01 of the Julian calendar (or"
    Print " -4713-11-24 Gregorian Calendar).  This is because in 4713 BC the 'Indiction'"
    Print " (15 yrs.), the 'Golden Number' (19) and the 'Solar Number' (28 yrs.) were all"
    Print " one.  The Julian Period is 7980 years long.  The next time this happens is"
    Print " Jan. 01, 3268 Julian calendar or Nov. 24, 3267 Gregorian calendar."
    Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
    Print
    Print "    The ISO (International Organization for Standardization) week starts on"
    Print " Mon. The 1st week of the year has Jan. 4th and the first Thu. of the year in"
    Print " it. If Jan. the 1st is a Thu., making Sun. the 4th the last day of the week,"
    Print " the first day of the first week is Mon. Dec. 29th of the previous year.  If"
    Print " Jan. 4th is a Mon. then Jan. 1st is Fri. of the last week of the previous year."
    Print "    Also a year that starts on Thu. (or Wed. if a leap year) has 53 weeks"
    Print " because there are 53 Thu. in the year and therefore 53 continuous weeks that"
    Print " each have at least 4 days of the current calendar year per week.  Therefore,"
    Print " Fri. Jan. 1st 2016 is Fri. of the 53rd week of 2015."
    Print "    There are 71 of these 53 week years every 400 years."
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Input " Press 'Enter' to continue. ", q$
    If LCase$(q$) = "q" Then
        Done
    Else
        Main_Menu
    End If
End Sub
 
Sub Save_1st_Day
    Cls
    Print
    Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
    Print " Saving this will create a 3 byte file on your hard drive.  This file will"
    Print " waste a lot of space.  Depending on drive size and operating system you are"
    Print " wasting, on average, between 509 to 4093 bytes.  Just to save you from having"
    Print " to press 's' or 'm' every time you view calendars in CalenTools."
    Print
    Print " The file it creates will be in the same directory that you have CalenTools in."
    Print " So if you have it on the desktop you will end up with two CalenTools files on"
    Print " your desktop.   Also if for whatever reason you happen to have a file named"
    Print " 'calentools.dat' in the same directory it will be over written."
    Print
    Input " Do you wish to continue (Y/N)"; q$
    q$ = LCase$(q$)
    If q$ = "q" Then
        Done
    ElseIf q$ = "n" Then
        Cals
    ElseIf q$ = "y" Then
        Do_Save
    Else
        Save_1st_Day
    End If
End Sub
 
Sub Do_Save
    fd$ = FDay$ 'This is in case you are using Sun. but want to save Mon.
    Print
    Input " Do you want the week to start on Sunday or Monday (S/M)"; q$
    q$ = LCase$(q$)
    If q$ = "q" Then Done
    FDay$ = q$
    filenum = FreeFile
    Open "calentools.dat" For Output As #filenum
    Print #filenum, FDay$
    Close #filenum
    FDay$ = fd$
    Cals
End Sub
 
Sub Done
    System
End Sub
 
News:

Messages - redwdc

Programs / CalenTools a collection of calendar stuff

QB64 Discussion / Re: problem with Yr-Mo-Da difference program

QB64 Discussion / Re: problem with Yr-Mo-Da difference program

QB64 Discussion / problem with Yr-Mo-Da difference program
