Login

2112 · 01-05-2026, 10:55 AM

Cal300, whole year calendar from 1800 to 2099
This was written in qb45, modified to work in QB64
Could help someone to make a nice calendar.

Code: (Select All)



_Title ("CAL300")

Clear: On Error GoTo 390: Width 80, 50

CHANGECOLOR = 0: SKIP1 = 1: LANG3$ = " EXTEN ": LANG2$ = " ENGLI "

M1A$ = "  JANUARY  ": M1B$ = " FEBRUARY  ": M1C$ = "  MARCH  "

M2A$ = "  APRIL  ": M2B$ = "    MAY    ": M2C$ = "  JUNE    "

M3A$ = "  JULY    ": M3B$ = "  AUGUST  ": M3C$ = " SEPTEMBER "

M4A$ = "  OCTOBER  ": M4B$ = " NOVEMBER  ": M4C$ = " DECEMBER  "

H$ = "SU MO TU WE TH FR SA"

M11A$ = " ˆ€ŒŽ“€ˆŽ‘": M11B$ = "”„Ž“€ˆŽ‘": M11C$ = "  ‹€’ˆŽ‘  "

M12A$ = " €ˆŠˆŽ‘  ": M12B$ = "  ‹€IŽ‘  ": M12C$ = "  ˆŽ“ŒˆŽ‘  "

M13A$ = "  ˆŽ“ŠˆŽ‘  ": M13B$ = " €“‚Ž“‘’Ž‘ ": M13C$ = "‘„’„‹ˆŽ‘"

M14A$ = " Ž‰’—ˆŽ‘ ": M14B$ = " ŒŽ„‹ˆŽ‘ ": M14C$ = "ƒ„‰„‹ˆŽ‘ "

H1$ = "‰“ ƒ„ ’ ’„ „ € ‘€"

K1$ = "        ": K2$ = "      "

K3$ = "                                                ": NMAX = 150

Dim A2$(4), B2$(4), C2$(4), D2$(4), E2$(4), F2$(4), G2$(4), H(300), EV$(NMAX, 3), X1$(6)

Dim A$(6, 4), B$(6, 4), C$(6, 4), D$(6, 4), E$(6, 4), F$(6, 4), G$(6, 4)

For I = 1 To 4: Read A2$(I): Next I

For I = 1 To 4: Read B2$(I): Next I

For I = 1 To 4: Read C2$(I): Next I

For I = 1 To 4: Read D2$(I): Next I

For I = 1 To 4: Read E2$(I): Next I

For I = 1 To 4: Read F2$(I): Next I

For I = 1 To 4: Read G2$(I): Next I

For K = 1 To 4: For I = 5 To 6: Read A$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read B$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read C$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read D$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read E$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read F$(I, K): Next I: Next K

For K = 1 To 4: For I = 5 To 6: Read G$(I, K): Next I: Next K

Data " 1  2  3  4  5  6  7"

Data " 8  9 10 11 12 13 14"

Data "15 16 17 18 19 20 21"

Data "22 23 24 25 26 27 28"

Data "    1  2  3  4  5  6"

Data " 7  8  9 10 11 12 13"

Data "14 15 16 17 18 19 20"

Data "21 22 23 24 25 26 27"

Data "      1  2  3  4  5"

Data " 6  7  8  9 10 11 12"

Data "13 14 15 16 17 18 19"

Data "20 21 22 23 24 25 26"

Data "          1  2  3  4"

Data " 5  6  7  8  9 10 11"

Data "12 13 14 15 16 17 18"

Data "19 20 21 22 23 24 25"

Data "            1  2  3"

Data " 4  5  6  7  8  9 10"

Data "11 12 13 14 15 16 17"

Data "18 19 20 21 22 23 24"

Data "                1  2"

Data " 3  4  5  6  7  8  9"

Data "10 11 12 13 14 15 16"

Data "17 18 19 20 21 22 23"

Data "                  1"

Data " 2  3  4  5  6  7  8"

Data " 9 10 11 12 13 14 15"

Data "16 17 18 19 20 21 22"

Data "29 30 31            "

Data "                    "

Data "29 30              "

Data "                    "

Data "29                  "

Data "                    "

Data "                    "

Data "                    "

Data "28 29 30 31        "

Data "                    "

Data "28 29 30            "

Data "                    "

Data "28 29              "

Data "                    "

Data "28                  "

Data "                    "

Data "27 28 29 30 31      "

Data "                    "

Data "27 28 29 30        "

Data "                    "

Data "27 28 29            "

Data "                    "

Data "27 28              "

Data "                    "

Data "26 27 28 29 30 31  "

Data "                    "

Data "26 27 28 29 30      "

Data "                    "

Data "26 27 28 29        "

Data "                    "

Data "26 27 28            "

Data "                    "

Data "25 26 27 28 29 30 31"

Data "                    "

Data "25 26 27 28 29 30  "

Data "                    "

Data "25 26 27 28 29      "

Data "                    "

Data "25 26 27 28        "

Data "                    "

Data "24 25 26 27 28 29 30"

Data "31                  "

Data "24 25 26 27 28 29 30"

Data "                    "

Data "24 25 26 27 28 29  "

Data "                    "

Data "24 25 26 27 28      "

Data "                    "

Data "23 24 25 26 27 28 29"

Data "30 31              "

Data "23 24 25 26 27 28 29"

Data "30                  "

Data "23 24 25 26 27 28 29"

Data "                    "

Data "23 24 25 26 27 28  "

Data "                    "

For I = 1 To 300: Read H(I): Next I

Data 4,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1,9,4,5,6,14,2,3,4,12,7,1,2

Data 10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1,9,4,5,6,14,2,3,4,12,7,1,2

Data 10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1,9,4,5,6,14,2,3,4,12,7,1,2

Data 10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1,2,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13,1,2,3,11,6,7,1

Data 9,4,5,6,14,2,3,4,12,7,1,2,10,5,6,7,8,3,4,5,13

ERRORFILE$ = "CAL300.CFG"



If _FileExists("CAL300.CFG") = -1 Then

    Open "CAL300.CFG" For Input As #1

    If EOF(1) = -1 Then GoTo 8

    Line Input #1, COLOR$

    If EOF(1) = -1 Then GoTo 8

    Line Input #1, LANG$

    8 Close #1

End If



COLOR$ = LTrim$(RTrim$(COLOR$)): LANG$ = LTrim$(RTrim$(LANG$))

If COLOR$ <> "1" And COLOR$ <> "2" And COLOR$ <> "3" And COLOR$ <> "4" And COLOR$ <> "5" Then COLOR$ = "3"

If LANG$ <> "1" And LANG$ <> "2" Then LANG$ = "1"

FLANG$ = LANG$: FCOL$ = COLOR$

SSS = 0: D = Val(Right$(Date$, 4))

20 Rem---------BLACK-----------

If COLOR$ = "1" Then

    C0 = 7: C1 = 8: C2 = 0: C3 = 15: C4 = 7: C5 = 15: C6 = 7: C7 = 0: C8 = 8: C9 = 8: C22 = 8

    C10 = 0: C11 = 8: C12 = 15: C13 = 7: C14 = 0: C15 = 15: C18 = 15: C19 = 0: C20 = 15: C21 = 15

End If

Rem-----------RED-----------

If COLOR$ = "2" Then

    C0 = 7: C1 = 8: C2 = 4: C3 = 4: C4 = 4: C5 = 15: C6 = 7: C7 = 0: C8 = 6: C9 = 12: C22 = 4

    C10 = 0: C11 = 8: C12 = 12: C13 = 13: C14 = 12: C15 = 15: C18 = 12: C19 = 7: C20 = 12: C21 = 10

End If

Rem-----------BLUE----------

If COLOR$ = "3" Then

    C0 = 7: C1 = 8: C2 = 1: C3 = 1: C4 = 1: C5 = 15: C6 = 7: C7 = 0: C8 = 6: C9 = 9: C22 = 1

    C10 = 0: C11 = 1: C12 = 12: C13 = 13: C14 = 9: C15 = 15: C18 = 12: C19 = 7: C20 = 3: C21 = 10

End If

Rem----------BROWN----------

If COLOR$ = "4" Then

    C0 = 7: C1 = 8: C2 = 6: C3 = 6: C4 = 6: C5 = 15: C6 = 7: C7 = 0: C8 = 6: C9 = 12: C22 = 6

    C10 = 0: C11 = 6: C12 = 12: C13 = 13: C14 = 12: C15 = 15: C18 = 12: C19 = 7: C20 = 12: C21 = 10

End If

Rem----------GREEN----------

If COLOR$ = "5" Then

    C0 = 7: C1 = 8: C2 = 0: C3 = 1: C4 = 2: C5 = 15: C6 = 7: C7 = 0: C8 = 6: C9 = 1: C22 = 2

    C10 = 0: C11 = 0: C12 = 12: C13 = 13: C14 = 0: C15 = 15: C18 = 12: C19 = 0: C20 = 10: C21 = 10

End If

Color C22, 0

Locate 1, 1, 0

Print "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ";

Locate 49, 1, 0: Print "ÛÛÛ                                                                            Û";

Locate 50, 1, 0

Print "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ";

For I = 2 To 48

    Locate I, 1: Print "ÛÛ";: Locate I, 79: Print "ÛÛ";

Next I

For I = 3 To 49: Locate I, 79: Print " ";: Next I

Locate 5, 37: Color C3, C0: Print "      "

If CHANGECOLOR = 1 Then GoTo 310

140 Color C15, C0

Locate 2, 3, 0: Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";

Color 8, C0: Print "¿"

Color C15, C0: Locate 3, 3, 0: Print "³";

Color C7, C0: Print "                                Day:  /      Days left:                  ³"

Color C15, C0: Locate 4, 3, 0: Print "À";

Color 0, C0: Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

Locate 5, 3, 0: Print "                                                                            "

Locate 5, 37: Color C3, C0: Print "      "

Color 0, C0

Locate 6, 3, 0: Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"

For I = 7 To 14

    Locate I, 3, 0: Print "³                        ³                        ³                        ³"

Next I

Locate 15, 3, 0: Print "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"

For I = 16 To 23

    Locate I, 3, 0: Print "³                        ³                        ³                        ³"

Next I

Locate 24, 3, 0: Print "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"

For I = 25 To 32

    Locate I, 3, 0: Print "³                        ³                        ³                        ³"

Next I

Locate 33, 3, 0: Print "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"

For I = 34 To 41

    Locate I, 3, 0: Print "³                        ³                        ³                        ³"

Next I

Locate 42, 3, 0: Print "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

Locate 43, 3, 0: Print "                                                                            "

Color C15, C0

Locate 44, 3, 0: Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";

Color 0, C0: Print "¿"

Color C15, C0

Locate 45, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³"

Color C15, C0

Locate 46, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³";

Color C15, C0

Locate 47, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³";

Color C15, C0

Locate 48, 3, 0: Print "À";

Color 0, C0: Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ";

Color C7, C0

Locate 7, 4: Print "1": Locate 7, 29: Print "2": Locate 7, 54: Print "3"

Locate 16, 4: Print "4": Locate 16, 29: Print "5": Locate 16, 54: Print "6"

Locate 25, 4: Print "7": Locate 25, 29: Print "8": Locate 25, 54: Print "9"

Locate 34, 4: Print "10": Locate 34, 29: Print "11": Locate 34, 54: Print "12"

150 S = H(D - 1799)

ReDim T1$(6), T2$(6), T3$(6), T4$(6), T5$(6), T6$(6)

ReDim T7$(6), T8$(6), T9$(6), T10$(6), T11$(6), T12$(6)

On S GOTO 170, 180, 190, 200, 210, 220, 230, 240, 250, 260, 270, 280, 290, 300

170 For I = 1 To 6

    If I > 4 Then T1$(I) = A$(I, 1): T2$(I) = D$(I, 4): T3$(I) = D$(I, 1)

    If I > 4 Then T4$(I) = G$(I, 2): T5$(I) = B$(I, 1): T6$(I) = E$(I, 2)

    If I > 4 Then T7$(I) = G$(I, 1): T8$(I) = C$(I, 1): T9$(I) = F$(I, 2)

    If I > 4 Then T10$(I) = A$(I, 1): T11$(I) = D$(I, 2): T12$(I) = F$(I, 1)

    If I < 5 Then T1$(I) = A2$(I): T2$(I) = D2$(I): T3$(I) = D2$(I): T4$(I) = G2$(I)

    If I < 5 Then T5$(I) = B2$(I): T6$(I) = E2$(I): T7$(I) = G2$(I): T8$(I) = C2$(I)

    If I < 5 Then T9$(I) = F2$(I): T10$(I) = A2$(I): T11$(I) = D2$(I): T12$(I) = F2$(I)

Next I

GoTo 310

180 For I = 1 To 6

    If I > 4 Then T1$(I) = B$(I, 1): T2$(I) = E$(I, 4): T3$(I) = E$(I, 1)

    If I > 4 Then T4$(I) = A$(I, 2): T5$(I) = C$(I, 1): T6$(I) = F$(I, 2)

    If I > 4 Then T7$(I) = A$(I, 1): T8$(I) = D$(I, 1): T9$(I) = G$(I, 2)

    If I > 4 Then T10$(I) = B$(I, 1): T11$(I) = E$(I, 2): T12$(I) = G$(I, 1)

    If I < 5 Then T1$(I) = B2$(I): T2$(I) = E2$(I): T3$(I) = E2$(I): T4$(I) = A2$(I)

    If I < 5 Then T5$(I) = C2$(I): T6$(I) = F2$(I): T7$(I) = A2$(I): T8$(I) = D2$(I)

    If I < 5 Then T9$(I) = G2$(I): T10$(I) = B2$(I): T11$(I) = E2$(I): T12$(I) = G2$(I)

Next I

GoTo 310

190 For I = 1 To 6

    If I > 4 Then T1$(I) = C$(I, 1): T2$(I) = F$(I, 4): T3$(I) = F$(I, 1)

    If I > 4 Then T4$(I) = B$(I, 2): T5$(I) = D$(I, 1): T6$(I) = G$(I, 2)

    If I > 4 Then T7$(I) = B$(I, 1): T8$(I) = E$(I, 1): T9$(I) = A$(I, 2)

    If I > 4 Then T10$(I) = C$(I, 1): T11$(I) = F$(I, 2): T12$(I) = A$(I, 1)

    If I < 5 Then T1$(I) = C2$(I): T2$(I) = F2$(I): T3$(I) = F2$(I): T4$(I) = B2$(I)

    If I < 5 Then T5$(I) = D2$(I): T6$(I) = G2$(I): T7$(I) = B2$(I): T8$(I) = E2$(I)

    If I < 5 Then T9$(I) = A2$(I): T10$(I) = C2$(I): T11$(I) = F2$(I): T12$(I) = A2$(I)

Next I

GoTo 310

200 For I = 1 To 6

    If I > 4 Then T1$(I) = D$(I, 1): T2$(I) = G$(I, 4): T3$(I) = G$(I, 1)

    If I > 4 Then T4$(I) = C$(I, 2): T5$(I) = E$(I, 1): T6$(I) = A$(I, 2)

    If I > 4 Then T7$(I) = C$(I, 1): T8$(I) = F$(I, 1): T9$(I) = B$(I, 2)

    If I > 4 Then T10$(I) = D$(I, 1): T11$(I) = G$(I, 2): T12$(I) = B$(I, 1)

    If I < 5 Then T1$(I) = D2$(I): T2$(I) = G2$(I): T3$(I) = G2$(I): T4$(I) = C2$(I)

    If I < 5 Then T5$(I) = E2$(I): T6$(I) = A2$(I): T7$(I) = C2$(I): T8$(I) = F2$(I)

    If I < 5 Then T9$(I) = B2$(I): T10$(I) = D2$(I): T11$(I) = G2$(I): T12$(I) = B2$(I)

Next I

GoTo 310

210 For I = 1 To 6

    If I > 4 Then T1$(I) = E$(I, 1): T2$(I) = A$(I, 4): T3$(I) = A$(I, 1)

    If I > 4 Then T4$(I) = D$(I, 2): T5$(I) = F$(I, 1): T6$(I) = B$(I, 2)

    If I > 4 Then T7$(I) = D$(I, 1): T8$(I) = G$(I, 1): T9$(I) = C$(I, 2)

    If I > 4 Then T10$(I) = E$(I, 1): T11$(I) = A$(I, 2): T12$(I) = C$(I, 1)

    If I < 5 Then T1$(I) = E2$(I): T2$(I) = A2$(I): T3$(I) = A2$(I): T4$(I) = D2$(I)

    If I < 5 Then T5$(I) = F2$(I): T6$(I) = B2$(I): T7$(I) = D2$(I): T8$(I) = G2$(I)

    If I < 5 Then T9$(I) = C2$(I): T10$(I) = E2$(I): T11$(I) = A2$(I): T12$(I) = C2$(I)

Next I

GoTo 310

220 For I = 1 To 6

    If I > 4 Then T1$(I) = F$(I, 1): T2$(I) = B$(I, 4): T3$(I) = B$(I, 1)

    If I > 4 Then T4$(I) = E$(I, 2): T5$(I) = G$(I, 1): T6$(I) = C$(I, 2)

    If I > 4 Then T7$(I) = E$(I, 1): T8$(I) = A$(I, 1): T9$(I) = D$(I, 2)

    If I > 4 Then T10$(I) = F$(I, 1): T11$(I) = B$(I, 2): T12$(I) = D$(I, 1)

    If I < 5 Then T1$(I) = F2$(I): T2$(I) = B2$(I): T3$(I) = B2$(I): T4$(I) = E2$(I)

    If I < 5 Then T5$(I) = G2$(I): T6$(I) = C2$(I): T7$(I) = E2$(I): T8$(I) = A2$(I)

    If I < 5 Then T9$(I) = D2$(I): T10$(I) = F2$(I): T11$(I) = B2$(I): T12$(I) = D2$(I)

Next I

GoTo 310

230 For I = 1 To 6

    If I > 4 Then T1$(I) = G$(I, 1): T2$(I) = C$(I, 4): T3$(I) = C$(I, 1)

    If I > 4 Then T4$(I) = F$(I, 2): T5$(I) = A$(I, 1): T6$(I) = D$(I, 2)

    If I > 4 Then T7$(I) = F$(I, 1): T8$(I) = B$(I, 1): T9$(I) = E$(I, 2)

    If I > 4 Then T10$(I) = G$(I, 1): T11$(I) = C$(I, 2): T12$(I) = E$(I, 1)

    If I < 5 Then T1$(I) = G2$(I): T2$(I) = C2$(I): T3$(I) = C2$(I): T4$(I) = F2$(I)

    If I < 5 Then T5$(I) = A2$(I): T6$(I) = D2$(I): T7$(I) = F2$(I): T8$(I) = B2$(I)

    If I < 5 Then T9$(I) = E2$(I): T10$(I) = G2$(I): T11$(I) = C2$(I): T12$(I) = E2$(I)

Next I

GoTo 310

240 For I = 1 To 6

    If I > 4 Then T1$(I) = A$(I, 1): T2$(I) = D$(I, 3): T3$(I) = E$(I, 1)

    If I > 4 Then T4$(I) = A$(I, 2): T5$(I) = C$(I, 1): T6$(I) = F$(I, 2)

    If I > 4 Then T7$(I) = A$(I, 1): T8$(I) = D$(I, 1): T9$(I) = G$(I, 2)

    If I > 4 Then T10$(I) = B$(I, 1): T11$(I) = E$(I, 2): T12$(I) = G$(I, 1)

    If I < 5 Then T1$(I) = A2$(I): T2$(I) = D2$(I): T3$(I) = E2$(I): T4$(I) = A2$(I)

    If I < 5 Then T5$(I) = C2$(I): T6$(I) = F2$(I): T7$(I) = A2$(I): T8$(I) = D2$(I)

    If I < 5 Then T9$(I) = G2$(I): T10$(I) = B2$(I): T11$(I) = E2$(I): T12$(I) = G2$(I)

Next I

GoTo 310

250 For I = 1 To 6

    If I > 4 Then T1$(I) = B$(I, 1): T2$(I) = E$(I, 3): T3$(I) = F$(I, 1)

    If I > 4 Then T4$(I) = B$(I, 2): T5$(I) = D$(I, 1): T6$(I) = G$(I, 2)

    If I > 4 Then T7$(I) = B$(I, 1): T8$(I) = E$(I, 1): T9$(I) = A$(I, 2)

    If I > 4 Then T10$(I) = C$(I, 1): T11$(I) = F$(I, 2): T12$(I) = A$(I, 1)

    If I < 5 Then T1$(I) = B2$(I): T2$(I) = E2$(I): T3$(I) = F2$(I): T4$(I) = B2$(I)

    If I < 5 Then T5$(I) = D2$(I): T6$(I) = G2$(I): T7$(I) = B2$(I): T8$(I) = E2$(I)

    If I < 5 Then T9$(I) = A2$(I): T10$(I) = C2$(I): T11$(I) = F2$(I): T12$(I) = A2$(I)

Next I

GoTo 310

260 For I = 1 To 6

    If I > 4 Then T1$(I) = C$(I, 1): T2$(I) = F$(I, 3): T3$(I) = G$(I, 1)

    If I > 4 Then T4$(I) = C$(I, 2): T5$(I) = E$(I, 1): T6$(I) = A$(I, 2)

    If I > 4 Then T7$(I) = C$(I, 1): T8$(I) = F$(I, 1): T9$(I) = B$(I, 2)

    If I > 4 Then T10$(I) = D$(I, 1): T11$(I) = G$(I, 2): T12$(I) = B$(I, 1)

    If I < 5 Then T1$(I) = C2$(I): T2$(I) = F2$(I): T3$(I) = G2$(I): T4$(I) = C2$(I)

    If I < 5 Then T5$(I) = E2$(I): T6$(I) = A2$(I): T7$(I) = C2$(I): T8$(I) = F2$(I)

    If I < 5 Then T9$(I) = B2$(I): T10$(I) = D2$(I): T11$(I) = G2$(I): T12$(I) = B2$(I)

Next I

GoTo 310

270 For I = 1 To 6

    If I > 4 Then T1$(I) = D$(I, 1): T2$(I) = G$(I, 3): T3$(I) = A$(I, 1)

    If I > 4 Then T4$(I) = D$(I, 2): T5$(I) = F$(I, 1): T6$(I) = B$(I, 2)

    If I > 4 Then T7$(I) = D$(I, 1): T8$(I) = G$(I, 1): T9$(I) = C$(I, 2)

    If I > 4 Then T10$(I) = E$(I, 1): T11$(I) = A$(I, 2): T12$(I) = C$(I, 1)

    If I < 5 Then T1$(I) = D2$(I): T2$(I) = G2$(I): T3$(I) = A2$(I): T4$(I) = D2$(I)

    If I < 5 Then T5$(I) = F2$(I): T6$(I) = B2$(I): T7$(I) = D2$(I): T8$(I) = G2$(I)

    If I < 5 Then T9$(I) = C2$(I): T10$(I) = E2$(I): T11$(I) = A2$(I): T12$(I) = C2$(I)

Next I

GoTo 310

280 For I = 1 To 6

    If I > 4 Then T1$(I) = E$(I, 1): T2$(I) = A$(I, 3): T3$(I) = B$(I, 1)

    If I > 4 Then T4$(I) = E$(I, 2): T5$(I) = G$(I, 1): T6$(I) = C$(I, 2)

    If I > 4 Then T7$(I) = E$(I, 1): T8$(I) = A$(I, 1): T9$(I) = D$(I, 2)

    If I > 4 Then T10$(I) = F$(I, 1): T11$(I) = B$(I, 2): T12$(I) = D$(I, 1)

    If I < 5 Then T1$(I) = E2$(I): T2$(I) = A2$(I): T3$(I) = B2$(I): T4$(I) = E2$(I)

    If I < 5 Then T5$(I) = G2$(I): T6$(I) = C2$(I): T7$(I) = E2$(I): T8$(I) = A2$(I)

    If I < 5 Then T9$(I) = D2$(I): T10$(I) = F2$(I): T11$(I) = B2$(I): T12$(I) = D2$(I)

Next I

GoTo 310

290 For I = 1 To 6

    If I > 4 Then T1$(I) = F$(I, 1): T2$(I) = B$(I, 3): T3$(I) = C$(I, 1)

    If I > 4 Then T4$(I) = F$(I, 2): T5$(I) = A$(I, 1): T6$(I) = D$(I, 2)

    If I > 4 Then T7$(I) = F$(I, 1): T8$(I) = B$(I, 1): T9$(I) = E$(I, 2)

    If I > 4 Then T10$(I) = G$(I, 1): T11$(I) = C$(I, 2): T12$(I) = E$(I, 1)

    If I < 5 Then T1$(I) = F2$(I): T2$(I) = B2$(I): T3$(I) = C2$(I): T4$(I) = F2$(I)

    If I < 5 Then T5$(I) = A2$(I): T6$(I) = D2$(I): T7$(I) = F2$(I): T8$(I) = B2$(I)

    If I < 5 Then T9$(I) = E2$(I): T10$(I) = G2$(I): T11$(I) = C2$(I): T12$(I) = E2$(I)

Next I

GoTo 310

300 For I = 1 To 6

    If I > 4 Then T1$(I) = G$(I, 1): T2$(I) = C$(I, 3): T3$(I) = D$(I, 1)

    If I > 4 Then T4$(I) = G$(I, 2): T5$(I) = B$(I, 1): T6$(I) = E$(I, 2)

    If I > 4 Then T7$(I) = G$(I, 1): T8$(I) = C$(I, 1): T9$(I) = F$(I, 2)

    If I > 4 Then T10$(I) = A$(I, 1): T11$(I) = D$(I, 2): T12$(I) = F$(I, 1)

    If I < 5 Then T1$(I) = G2$(I): T2$(I) = C2$(I): T3$(I) = D2$(I): T4$(I) = G2$(I)

    If I < 5 Then T5$(I) = B2$(I): T6$(I) = E2$(I): T7$(I) = G2$(I): T8$(I) = C2$(I)

    If I < 5 Then T9$(I) = F2$(I): T10$(I) = A2$(I): T11$(I) = D2$(I): T12$(I) = F2$(I)

Next I

310 CHANGECOLOR = 0

Color C15, C0: Locate 5, 38, 0: Print D

If SKIP1 = 1 Then

    YEAR$ = Right$(Date$, 4): DATE1$ = Date$

    LT = 0: LTA = 0: FD = 0

    GoSub 450

    Color C7, C0: Locate 3, 40: Print Using "###"; LTA;

    Print "/";: Print Using "###"; (365 + FD)

    Locate 3, 60: Print Using "###"; (365 + FD - LTA);

    SKIP1 = 0

End If

311 Color C2, C0

For I = 1 To 6

    Locate 8 + I, 6: Print T1$(I): Locate 8 + I, 31: Print T2$(I): Locate 8 + I, 56: Print T3$(I)

    Locate 35 + I, 6: Print T10$(I): Locate 35 + I, 31: Print T11$(I): Locate 35 + I, 56: Print T12$(I)

Next I

Color C12, C0

If S = 2 Or S = 8 Then Locate 40, 62: Print "25"

If S = 1 Or S = 14 Then Locate 40, 59: Print "25"

If S = 7 Or S = 13 Then Locate 40, 56: Print "25"

If S = 6 Or S = 12 Then Locate 39, 74: Print "25"

If S = 5 Or S = 11 Then Locate 39, 71: Print "25"

If S = 4 Or S = 10 Then Locate 39, 68: Print "25"

If S = 3 Or S = 9 Then Locate 39, 65: Print "25"

Color C7, C0

Locate 45, 4: Print "  Esc:Exit  F1:Ext/Eng  F2:Color  F3:About  F4:Schedule"

If D <> 1800 And D <> 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

If D = 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10                    "; Chr$(25); " : Today    Home : 1800    End : 2099"

If D = 1800 Then Locate 47, 4: Print "                  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

312 If SSS = 0 And LANG$ = "1" Then

    Color C9, C0

    Locate 8, 6: Print H$: Locate 8, 31: Print H$: Locate 8, 56: Print H$

    Locate 17, 6: Print H$: Locate 17, 31: Print H$: Locate 17, 56: Print H$

    Locate 26, 6: Print H$: Locate 26, 31: Print H$: Locate 26, 56: Print H$

    Locate 35, 6: Print H$: Locate 35, 31: Print H$: Locate 35, 56: Print H$

    Color C10, C0

    Locate 7, 11: Print M1A$: Locate 7, 36: Print M1B$: Locate 7, 61: Print M1C$

    Locate 16, 11: Print M2A$: Locate 16, 36: Print M2B$: Locate 16, 61: Print M2C$

    Locate 25, 11: Print M3A$: Locate 25, 36: Print M3B$: Locate 25, 61: Print M3C$

    Locate 34, 11: Print M4A$: Locate 34, 36: Print M4B$: Locate 34, 61: Print M4C$

End If

If SSS = 0 And LANG$ = "2" Then

    Color C9, C0

    Locate 8, 6: Print H1$: Locate 8, 31: Print H1$: Locate 8, 56: Print H1$

    Locate 17, 6: Print H1$: Locate 17, 31: Print H1$: Locate 17, 56: Print H1$

    Locate 26, 6: Print H1$: Locate 26, 31: Print H1$: Locate 26, 56: Print H1$

    Locate 35, 6: Print H1$: Locate 35, 31: Print H1$: Locate 35, 56: Print H1$

    Color C10, C0

    Locate 7, 11: Print M11A$: Locate 7, 36: Print M11B$: Locate 7, 61: Print M11C$

    Locate 16, 11: Print M12A$: Locate 16, 36: Print M12B$: Locate 16, 61: Print M12C$

    Locate 25, 11: Print M13A$: Locate 25, 36: Print M13B$: Locate 25, 61: Print M13C$

    Locate 34, 11: Print M14A$: Locate 34, 36: Print M14B$: Locate 34, 61: Print M14C$

End If

Color C2, C0

For I = 1 To 6

    Locate 17 + I, 6: Print T4$(I): Locate 17 + I, 31: Print T5$(I): Locate 17 + I, 56: Print T6$(I)

    Locate 26 + I, 6: Print T7$(I): Locate 26 + I, 31: Print T8$(I): Locate 26 + I, 56: Print T9$(I)

Next I

SSS = 1

315 Rem----------------------TODAY---------------------

If D = Val(Right$(Date$, 4)) Then

    MONTH$ = Left$(Date$, 2): Day$ = Mid$(Date$, 4, 2)

    NEXTDAY$ = Mid$(Date$, 4, 2)

    If Left$(Day$, 1) = "0" Then Day$ = " " + Right$(Day$, 1)

    X1 = 0: Y1 = 0: X2 = 0: Y2 = 0: X = 0

    For I = 1 To 12

        If Val(LTrim$(RTrim$(MONTH$))) = I Then X = I

    Next I

    For I = 1 To 6

        If X = 1 Then X1$(I) = T1$(I): X1 = 8: Y1 = 4

        If X = 2 Then X1$(I) = T2$(I): X1 = 8: Y1 = 29

        If X = 3 Then X1$(I) = T3$(I): X1 = 8: Y1 = 54

        If X = 4 Then X1$(I) = T4$(I): X1 = 17: Y1 = 4

        If X = 5 Then X1$(I) = T5$(I): X1 = 17: Y1 = 29

        If X = 6 Then X1$(I) = T6$(I): X1 = 17: Y1 = 54

        If X = 7 Then X1$(I) = T7$(I): X1 = 26: Y1 = 4

        If X = 8 Then X1$(I) = T8$(I): X1 = 26: Y1 = 29

        If X = 9 Then X1$(I) = T9$(I): X1 = 26: Y1 = 54

        If X = 10 Then X1$(I) = T10$(I): X1 = 35: Y1 = 4

        If X = 11 Then X1$(I) = T11$(I): X1 = 35: Y1 = 29

        If X = 12 Then X1$(I) = T12$(I): X1 = 35: Y1 = 54

    Next I

    For I = 1 To 6: For K = 1 To 20 Step 3

            If Day$ = Mid$(X1$(I), K, 2) Then X2 = I - 1: Y2 = K - 1

    Next K: Next I

    Color C5, C6: Locate 1 + X1 + X2, Y1 + Y2 + 2: Print Day$

    Y3 = Y1 + Y2

    If Y3 = 4 Or Y3 = 29 Or Y3 = 54 Then DAY2$ = "  Sunday, "

    If Y3 = 7 Or Y3 = 32 Or Y3 = 57 Then DAY2$ = "  Monday, "

    If Y3 = 10 Or Y3 = 35 Or Y3 = 60 Then DAY2$ = "  Tuesday, "

    If Y3 = 13 Or Y3 = 38 Or Y3 = 63 Then DAY2$ = "Wednesday, "

    If Y3 = 16 Or Y3 = 41 Or Y3 = 66 Then DAY2$ = " Thursday, "

    If Y3 = 19 Or Y3 = 44 Or Y3 = 69 Then DAY2$ = "  Friday, "

    If Y3 = 22 Or Y3 = 47 Or Y3 = 72 Then DAY2$ = " Saturday, "

End If

320 Do

    If D = Val(Right$(Date$, 4)) And NEXTDAY$ <> Mid$(Date$, 4, 2) Then

        Color C2, C0: Locate 1 + X1 + X2, Y1 + Y2 + 2: Print Day$: GoTo 315

    End If

    If YEAR$ <> Right$(Date$, 4) Then D = Val(Right$(Date$, 4)): GoTo 150

    GoSub 410

    Locate 3, 4, 0: Print DAY2$; MO$; Mid$(Date$, 4, 2); ", "; Right$(Date$, 4); "  "

    YEAR$ = Right$(Date$, 4): DATE1$ = Date$

    LT = 0: LTA = 0: FD = 0

    GoSub 450

    Color C7, C0: Locate 3, 40: Print Using "###"; LTA;

    Print "/";: Print Using "###"; (365 + FD)

    Locate 3, 60: Print Using "###"; (365 + FD - LTA);

    R$ = ""

    R$ = InKey$

    Rem---------------ESC:EXIT--------------

    If R$ = Chr$(27) Then

        Color C18, C0

        Locate 45, 4, 0: Print "                                                                        "

        Locate 46, 4, 0: Print "                          EXIT CAL300 (Y/N) ?                          "

        Locate 47, 4, 0: Print "                                                                        "



        Do

            IN$ = "": IN$ = InKey$

            If IN$ = Chr$(13) Or IN$ = "Y" Or IN$ = "y" Or IN$ = "“" Or IN$ = "¬" Then GoTo 400

            If IN$ = Chr$(27) Or IN$ = "N" Or IN$ = "n" Or IN$ = "Œ" Or IN$ = "¤" Then

                Color C7, C0

                Locate 45, 4: Print "  Esc:Exit  F1:Ext/Eng  F2:Color  F3:About  F4:Schedule"

                Locate 46, 4, 0: Print "                                                                      "

                If D <> 1800 And D <> 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

                If D = 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10                    "; Chr$(25); " : Today    Home : 1800    End : 2099"

                If D = 1800 Then Locate 47, 4: Print "                  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

                Exit Do

            End If

        Loop

    End If

    If Mid$(R$, 2, 1) = "G" And D <> 1800 Then D = 1800: GoTo 150

    If Mid$(R$, 2, 1) = "O" And D <> 2099 Then D = 2099: GoTo 150

    If Mid$(R$, 2, 1) = "P" And D <> Val(Right$(Date$, 4)) Then D = Val(Right$(Date$, 4)): GoTo 150

    If Mid$(R$, 2, 1) = "K" And D > 1800 Then D = D - 1: GoTo 150

    If Mid$(R$, 2, 1) = "I" And D > 1810 Then D = D - 10: GoTo 150

    If Mid$(R$, 2, 1) = "I" And D <= 1810 And D <> 1800 Then D = 1800: GoTo 150

    If Mid$(R$, 2, 1) = "M" And D < 2099 Then D = D + 1: GoTo 150

    If Mid$(R$, 2, 1) = "Q" And D < 2089 Then D = D + 10: GoTo 150

    If Mid$(R$, 2, 1) = "Q" And D >= 2089 And D <> 2099 Then D = 2099: GoTo 150

    Rem--------------F1:EXTEN/ENGLI--------------

    If (Mid$(R$, 2, 1) = ";" Or R$ = "É") Then



        If LANG$ = "2" Then LANG$ = "1" Else LANG$ = "2"

        If LANG$ = "1" Then

            Color C9, C0

            Locate 8, 6: Print H$: Locate 8, 31: Print H$: Locate 8, 56: Print H$

            Locate 17, 6: Print H$: Locate 17, 31: Print H$: Locate 17, 56: Print H$

            Locate 26, 6: Print H$: Locate 26, 31: Print H$: Locate 26, 56: Print H$

            Locate 35, 6: Print H$: Locate 35, 31: Print H$: Locate 35, 56: Print H$

            Color C10, C0

            Locate 7, 11: Print M1A$: Locate 7, 36: Print M1B$: Locate 7, 61: Print M1C$

            Locate 16, 11: Print M2A$: Locate 16, 36: Print M2B$: Locate 16, 61: Print M2C$

            Locate 25, 11: Print M3A$: Locate 25, 36: Print M3B$: Locate 25, 61: Print M3C$

            Locate 34, 11: Print M4A$: Locate 34, 36: Print M4B$: Locate 34, 61: Print M4C$

        End If

        If LANG$ = "2" Then

            Color C9, C0

            Locate 8, 6: Print H1$: Locate 8, 31: Print H1$: Locate 8, 56: Print H1$

            Locate 17, 6: Print H1$: Locate 17, 31: Print H1$: Locate 17, 56: Print H1$

            Locate 26, 6: Print H1$: Locate 26, 31: Print H1$: Locate 26, 56: Print H1$

            Locate 35, 6: Print H1$: Locate 35, 31: Print H1$: Locate 35, 56: Print H1$

            Color C10, C0

            Locate 7, 11: Print M11A$: Locate 7, 36: Print M11B$: Locate 7, 61: Print M11C$

            Locate 16, 11: Print M12A$: Locate 16, 36: Print M12B$: Locate 16, 61: Print M12C$

            Locate 25, 11: Print M13A$: Locate 25, 36: Print M13B$: Locate 25, 61: Print M13C$

            Locate 34, 11: Print M14A$: Locate 34, 36: Print M14B$: Locate 34, 61: Print M14C$

        End If

    End If

    Rem---------------F3:ABOUT--------------

    If (Mid$(R$, 2, 1) = "=" Or R$ = "¼") Then



        Color C14, C4

        Locate 16, 23

        Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"

        For I = 1 To 2

            Locate 16 + I, 23: Print "³                                  ³"

        Next I

        For I = 3 To 14

            Locate 16 + I, 23: Print "³                                  ³"

        Next I

        Locate 31, 23

        Print "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

        Color 0, 0

        For I = 3 To 14: Locate 16 + I, 24: Print "                                  "

        Next I

        For I = 1 To 15

            Locate 16 + I, 59: Print " "

        Next I

        Locate 32, 24

        Print "                                    "

        Color C20, C4: Locate 18, 24: Print "  Cal300 v2.0 - Freeware  "

        Color C14, C4: Locate 19, 23: Print "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"

        Color C21, C0

        Locate 45, 4: Print "                                                                        "

        Locate 46, 32: Print "Any key : Continue"

        Locate 47, 4: Print "                                                                        "

        Color C0, C1

        AB1$ = ""

        AB2$ = "Calendar from 1800 to 2099"

        AB3$ = "written in QB45 - QB64"

        AB4$ = ""

        AB5$ = ""

        For I = 1 To Len(AB1$)

            Locate 21, 24 + I: Print Mid$(AB1$, I, 1)

            _Delay .01

        Next I

        For I = 1 To Len(AB2$)

            Locate 23, 24 + I: Print Mid$(AB2$, I, 1)

            _Delay .01

        Next I

        For I = 1 To Len(AB3$)

            Locate 25, 24 + I: Print Mid$(AB3$, I, 1)

            _Delay .01

        Next I

        For I = 1 To Len(AB4$)

            Locate 27, 24 + I: Print Mid$(AB4$, I, 1)

            _Delay .01

        Next I

        For I = 1 To Len(AB5$)

            Locate 29, 24 + I: Print Mid$(AB5$, I, 1)

            _Delay .01

        Next I

        Do

            R$ = "": R$ = InKey$

            If R$ <> "" Then

                Color 0, C0

                For I = 1 To 8

                    Locate 15 + I, 23

                    Print "    ³                        ³      "

                Next I

                Locate 24, 23

                Print "ÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄ"

                For I = 1 To 8

                    Locate 24 + I, 23

                    Print "    ³                        ³      "

                    Locate 16, 29: Print "5": Locate 16, 54: Print "6"

                    Locate 25, 29: Print "8": Locate 25, 54: Print "9"

                Next I

                Color C7, C0

                Locate 45, 4: Print "  Esc:Exit  F1:Ext/Eng  F2:Color  F3:About  F4:Schedule"

                Locate 46, 4: Print "                                                                        "

                If D <> 1800 And D <> 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

                If D = 2099 Then Locate 47, 4: Print " "; Chr$(27); ",PgUp :-1,-10                    "; Chr$(25); " : Today    Home : 1800    End : 2099"

                If D = 1800 Then Locate 47, 4: Print "                  "; Chr$(26); ",PgDn :+1,+10  "; Chr$(25); " : Today    Home : 1800    End : 2099"

                SSS = 0

                GoTo 312

            End If

        Loop

    End If

    Rem---------------F2:COLOR--------------

    If Mid$(R$, 2, 1) = "<" Or R$ = "»" Then



        CHANGECOLOR = 1: SSS = 0

        If COLOR$ = "1" Then COLOR$ = "2": GoTo 20

        If COLOR$ = "2" Then COLOR$ = "3": GoTo 20

        If COLOR$ = "3" Then COLOR$ = "4": GoTo 20

        If COLOR$ = "4" Then COLOR$ = "5": GoTo 20

        If COLOR$ = "5" Then COLOR$ = "1": GoTo 20

        GoTo 20

    End If

    Rem---------------F4:Schedule--------------

    If Mid$(R$, 2, 1) = ">" Or R$ = "È" Then GoTo 330

325 Loop

330

ERRORFILE$ = "CAL300.DAT"



If _FileExists("CAL300.DAT") = -1 Then

    Open "CAL300.DAT" For Input As #1

    N = 1

    Do

        If N = NMAX + 1 Then Exit Do

        If EOF(1) = -1 Then Exit Do

        Line Input #1, W$

        If Left$(W$, 1) = "" Then Exit Do

        EV$(N, 1) = Mid$(W$, 1, 9)

        EV$(N, 2) = Mid$(W$, 10, 6)

        EV$(N, 3) = Mid$(W$, 16, 49)

        N = N + 1

    Loop Until EOF(1) = -1

    Close #1

End If



For F = N To NMAX

    For G = 1 To 3

        If G = 1 Then EV$(F, 1) = K1$

        If G = 2 Then EV$(F, 2) = K2$

        If G = 3 Then EV$(F, 3) = K3$

    Next G

Next F

Color C15, C0

Locate 2, 3, 0: Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";

Color 8, C0

Print "¿"

Color C15, C0

Locate 3, 3, 0: Print "³                                                                          ";

Color 8, C0: Print "³"

Color C15, C0

Locate 4, 3, 0: Print "À";

Color 0, C0: Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

Locate 5, 3, 0: Print "ÚÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"

Locate 6, 3, 0: Print "³  ³          ³      ³                                                  ³"

Locate 7, 3, 0: Print "ÃÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"

For I = 8 To 42

    Locate I, 3, 0: Print "³  ³          ³      ³                                                  ³"

Next I

Locate 43, 3, 0: Print "ÀÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

Color C15, C0

Locate 44, 3, 0: Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";

Color 0, C0: Print "¿"

Color C15, C0

Locate 45, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³"

Color C15, C0

Locate 46, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³";

Color C15, C0

Locate 47, 3, 0: Print "³                                                                          ";

Color 0, C0: Print "³";

Color C15, C0

Locate 48, 3, 0: Print "À";

Color 0, C0: Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ";

Color C3, C0: Locate 3, 37: Print "Schedule"

Color C7, C0

For F = 1 To 33

    Locate 8 + F, 77, 0: Print "²"

Next F

Color C8, C7: Locate 9, 77: Print "Û"

Color C0, C7: Locate 8, 77: Print "": Locate 42, 77: Print ""

Color C7, C0

Locate 45, 5: Print "  Esc:Cancel  F5:Save  F6:Clear  F7:+Line  F8:-Line  F10:Ext/Eng"

Locate 47, 5: Print "            PgUp, PgDn, Tab, , , , "; Chr$(26); ", Enter : Move, Edit  "

Color C11, C0

Locate 6, 4: Print "REC": Locate 6, 8: Print "DATE"

Locate 6, 19: Print "TIME": Locate 6, 27: Print "EVENT"

For F = 1 To 18

    Locate 6 + F * 2, 4: Print Using "###"; F

Next F

SSS = 0

GoSub 410

Locate 3, 8, 0: Print MO$; Mid$(Date$, 4, 2); ", "; Right$(Date$, 4); "  "

For F = 1 To 18

    Locate 6 + F * 2, 8: Print K1$ + " "

    Locate 6 + F * 2, 19: Print K2$ + " "

    Locate 6 + F * 2, 27: Print K3$ + " "

    Locate 6 + F * 2, 8: Print EV$(F, 1)

    Locate 6 + F * 2, 19: Print EV$(F, 2)

    Locate 6 + F * 2, 27: Print EV$(F, 3)

Next F

Y = 0: S = 1: S2 = 1: L = 1: K = 7: I = 0: M = 9: LO = 1: I2 = 6: L2 = 8

SAVE = 0

MIN$ = Mid$(Time$, 8, 1)

GoTo 336

335 Swap LANG2$, LANG3$

336 If LANG3$ = " EXTEN " Then Color C2, C0 Else Color C0, C2

Locate 6, 70: Print LANG2$

340 T = 0

Do

    Rem---------------------CURSOR-------------------------

    Color 23, C0: Locate 1 + K, I + I2 + 2, 1: Print "";

    Color C7, C0

    S = (K + 1) / 2 - 4 + L

    If Y <> S Then EV1$ = EV$(S, 1): EV2$ = EV$(S, 2): EV3$ = EV$(S, 3): Y = S

    If SAVE = 0 And (EV1$ <> EV$(S, 1) Or EV2$ <> EV$(S, 2) Or EV3$ <> EV$(S, 3)) Then SAVE = 1

    IN$ = "": IN$ = InKey$

    Rem------------------F10:LANGUAGE------------------

    If Mid$(IN$, 2, 1) = "D" Or IN$ = "Ê" Then GoTo 335

    If LANG2$ = " EXTEN " Then

        If Mid$(IN$, 2, 1) = "D" Or IN$ = "Ê" Then GoTo 335

        If IN$ = "A" Then IN$ = "€"

        If IN$ = "B" Then IN$ = ""

        If IN$ = "C" Then IN$ = "–"

        If IN$ = "D" Then IN$ = "ƒ"

        If IN$ = "E" Then IN$ = "„"

        If IN$ = "F" Then IN$ = "”"

        If IN$ = "G" Then IN$ = "‚"

        If IN$ = "H" Then IN$ = "†"

        If IN$ = "I" Then IN$ = "ˆ"

        If IN$ = "J" Then IN$ = ""

        If IN$ = "K" Then IN$ = "‰"

        If IN$ = "L" Then IN$ = "Š"

        If IN$ = "M" Then IN$ = "‹"

        If IN$ = "N" Then IN$ = "Œ"

        If IN$ = "O" Then IN$ = "Ž"

        If IN$ = "P" Then IN$ = ""

        If IN$ = "R" Then IN$ = ""

        If IN$ = "S" Then IN$ = "‘"

        If IN$ = "T" Then IN$ = "’"

        If IN$ = "U" Then IN$ = "‡"

        If IN$ = "V" Then IN$ = "—"

        If IN$ = "X" Then IN$ = "•"

        If IN$ = "Y" Then IN$ = "“"

        If IN$ = "Z" Then IN$ = "…"

        If IN$ = "a" Then IN$ = "˜"

        If IN$ = "b" Then IN$ = "™"

        If IN$ = "c" Then IN$ = "¯"

        If IN$ = "d" Then IN$ = "›"

        If IN$ = "e" Then IN$ = "œ"

        If IN$ = "f" Then IN$ = ""

        If IN$ = "g" Then IN$ = "š"

        If IN$ = "h" Then IN$ = "ž"

        If IN$ = "i" Then IN$ = " "

        If IN$ = "j" Then IN$ = "¥"

        If IN$ = "k" Then IN$ = "¡"

        If IN$ = "l" Then IN$ = "¢"

        If IN$ = "m" Then IN$ = "£"

        If IN$ = "n" Then IN$ = "¤"

        If IN$ = "o" Then IN$ = "¦"

        If IN$ = "p" Then IN$ = "§"

        If IN$ = "r" Then IN$ = "¨"

        If IN$ = "s" Then IN$ = "©"

        If IN$ = "t" Then IN$ = "«"

        If IN$ = "u" Then IN$ = "Ÿ"

        If IN$ = "v" Then IN$ = "à"

        If IN$ = "w" Then IN$ = "ª"

        If IN$ = "x" Then IN$ = "®"

        If IN$ = "y" Then IN$ = "¬"

        If IN$ = "z" Then IN$ = ""

    End If

    Rem---------------SCROLL BAR---------------

    If S2 <> S Then

        S2 = S

        L3 = Int((40 - 8) * (S - 1) / (NMAX - 1)) + 8

        If L3 <> L2 Then

            Color C7, C0: Locate 1 + L2, 77, 0: Print "²"

            Color C8, C7: Locate 1 + L3, 77, 0: Print "Û"

            L2 = L3: Color C7, C0

        End If

    End If

    350 Rem-----------------F5:SAVE---------------

    If (Mid$(IN$, 2, 1) = "?" Or IN$ = "Í") And SAVE = 1 Then

        SAVE = 0

        EV1$ = EV$(S, 1): EV2$ = EV$(S, 2): EV3$ = EV$(S, 3)



        Open "CAL300.DAT" For Output As #1

        For F = 1 To NMAX

            WORD$ = ""

            For G = 1 To 3

                WORD$ = WORD$ + EV$(F, G)

            Next G

            Print #1, WORD$

        Next F

        Close #1

        Color C21, C0

        Locate 45, 4: Print "                                                                        "

        Locate 46, 4: Print "                      RECORD SAVED.  PRESS ANY KEY ...                  "

        Locate 47, 4, 0: Print "                                                                        "

        Do

            IN$ = "": IN$ = InKey$

            If IN$ <> "" Then Exit Do

        Loop

        Color C7, C0

        Locate 45, 5: Print "  Esc:Cancel  F5:Save  F6:Clear  F7:+Line  F8:-Line  F10:Ext/Eng"

        Locate 46, 4, 0: Print "                                                                          "

        Locate 47, 5: Print "            PgUp, PgDn, Tab, , , , "; Chr$(26); ", Enter : Move, Edit  "

        If SAX = 1 Then SAX = 0: GoTo 140

        GoTo 340

    End If

    Rem------------------F6:CLEAR-------------------

    If Mid$(IN$, 2, 1) = "@" Or IN$ = "º" Then



        EV$(S, 1) = EV1$: EV$(S, 2) = EV2$: EV$(S, 3) = EV3$

        Locate 1 + K, 8, 0: Print K1$: Locate 1 + K, 8: Print EV$(S, 1)

        Locate 1 + K, 19: Print K2$: Locate 1 + K, 19: Print EV$(S, 2)

        Locate 1 + K, 27: Print K3$: Locate 1 + K, 27: Print EV$(S, 3)

        I = 0

        GoTo 340

    End If

    Rem----------------F7:+LINE LIMIT----------------

    If Mid$(IN$, 2, 1) = "A" Or IN$ = "Ì" Then

        If EV$(NMAX, 1) <> K1$ Or EV$(NMAX, 2) <> K2$ Or EV$(NMAX, 3) <> K3$ Then

            Color C18, C0

            Locate 45, 4: Print "                                                                        "

            Locate 46, 4, 0: Print "                CAN'T INSERT LINE. REC "; NMAX; " IS NOT EMPTY ...  "

            Locate 47, 4: Print "                                                                        "

            Do

                IN$ = "": IN$ = InKey$

                If IN$ <> "" Then Exit Do

            Loop

            Color C7, C0

            Locate 45, 5: Print "  Esc:Cancel  F5:Save  F6:Clear  F7:+Line  F8:-Line  F10:Ext/Eng"

            Locate 46, 4: Print "                                                                        "

            Locate 47, 5: Print "            PgUp, PgDn, Tab, , , , "; Chr$(26); ", Enter : Move, Edit "

            GoTo 340

        End If

    End If

    Rem-------------------F7:+LINE------------------

    If Mid$(IN$, 2, 1) = "A" Or IN$ = "Ì" Then



        For F = NMAX - 1 To S Step -1

            For G = 1 To 3

                EV$(F + 1, G) = EV$(F, G)

            Next G

        Next F

        EV$(S, 1) = K1$: EV$(S, 2) = K2$: EV$(S, 3) = K3$

        F2 = 0

        For F = L To L + 17

            F2 = F2 + 1

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

        GoTo 340

    End If

    Rem------------------F8:-LINE------------------

    If Mid$(IN$, 2, 1) = "B" Or IN$ = "¹" Then



        For F = S To NMAX - 1

            For G = 1 To 3

                EV$(F, G) = EV$(F + 1, G)

            Next G

        Next F

        EV$(NMAX, 1) = K1$: EV$(NMAX, 2) = K2$: EV$(NMAX, 3) = K3$

        F2 = 0

        For F = L To L + 17

            F2 = F2 + 1

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

        GoTo 340

    End If

    Rem---------------------TAB----------------------

    If IN$ = Chr$(9) And LO = 1 Then I = 0: LO = 2: M = 6: I2 = 17: GoTo 340

    If IN$ = Chr$(9) And LO = 2 Then I = 0: LO = 3: M = 49: I2 = 25: GoTo 340

    If IN$ = Chr$(9) And LO = 3 Then I = 0: LO = 1: M = 9: I2 = 6: GoTo 340

    Rem---------------------ESC----------------------

    If IN$ = Chr$(27) Then

        SKIP1 = 1

        If SAVE = 1 Then GoTo 360

        GoTo 140

        360 Color C18, C0

        Locate 45, 4, 0: Print "                                                                        "

        Locate 46, 4, 0: Print "                  RECORD HAS CHANGED.  SAVE IT (Y/N) ?                  "

        Locate 47, 4, 0: Print "                                                                        "

        SAX = 0

        Do

            IN$ = "": IN$ = InKey$

            If IN$ = Chr$(13) Or IN$ = "Y" Or IN$ = "y" Or IN$ = "“" Or IN$ = "¬" Then

                IN$ = "Í": SAX = 1

                GoTo 350

            End If

            If IN$ = "N" Or IN$ = "n" Or IN$ = "Œ" Or IN$ = "¤" Then GoTo 140

            If IN$ = Chr$(27) Then

                Color C7, C0

                Locate 45, 5: Print "  Esc:Cancel  F5:Save  F6:Clear  F7:+Line  F8:-Line  F10:Ext/Eng"

                Locate 46, 4, 0: Print "                                                                      "

                Locate 47, 5: Print "            PgUp, PgDn, Tab, , , , "; Chr$(26); ", Enter : Move, Edit  "

                GoTo 340

            End If

        Loop

    End If

    Rem------------------TIME,DATE-------------------

    If MIN$ <> Mid$(Time$, 8, 1) Then

        MIN$ = Mid$(Time$, 8, 1)

        GoSub 410

        Locate 3, 8, 0: Print MO$; Mid$(Date$, 4, 2); ", "; Right$(Date$, 4); "  "

    End If

    Rem---------------------HOME----------------------

    If Mid$(IN$, 2, 1) = "G" Then IN$ = "": I = 0

    Rem---------------------EŒD-----------------------

    If Mid$(IN$, 2, 1) = "O" Then IN$ = "": I = Len(RTrim$(EV$(S, LO)))

    Rem-------------------ARROW LEFT------------------

    If Mid$(IN$, 2, 1) = "K" And I > 0 Then I = I - 1

    Rem-------------------ARROW RIGHT-----------------

    If Mid$(IN$, 2, 1) = "M" And I < M Then I = I + 1

    Rem-------------------ARROW UP--------------------

    If Mid$(IN$, 2, 1) = "H" And K > 7 Then K = K - 2: GoTo 340

    Rem-------------------ARROW DOWN------------------

    If Mid$(IN$, 2, 1) = "P" And K < 41 Then K = K + 2: GoTo 340

    Rem---------------------ENTER---------------------

    If IN$ = Chr$(13) And LO = 1 Then: I = 0: I2 = 17: LO = 2: M = 6: GoTo 340

    If IN$ = Chr$(13) And LO = 2 Then: I = 0: I2 = 25: LO = 3: M = 49: GoTo 340

    If IN$ = Chr$(13) And K < 41 And LO = 3 Then: I = 0: I2 = 6: LO = 1: M = 9: K = K + 2: GoTo 340

    Rem------------------BACKSPACE--------------------

    If IN$ = Chr$(8) Then

        If I > 0 Then

            I = I - 1

            EV$(S, LO) = Left$(EV$(S, LO), I) + Mid$(EV$(S, LO), I + 2, M) + " "

            Locate 1 + K, I + I2 + 2, 0: Print Mid$(EV$(S, LO), I + 1, M) + " "

            GoTo 340

        End If

    End If

    Rem--------------------DELETE---------------------

    If Mid$(IN$, 2, 1) = "S" And I <> M Then

        If I > -1 Then

            EV$(S, LO) = Left$(EV$(S, LO), I) + Mid$(EV$(S, LO), I + 2, M) + " "

            Locate 1 + K, I + I2 + 2, 0: Print Mid$(EV$(S, LO), I + 1, M) + " "

            GoTo 340

        End If

    End If

    Rem--------------------SPACEBAR-------------------

    If IN$ = Chr$(32) Then

        I = I + 1

        If I > M Then I = M

        Locate 1 + K, I + I2 + 1, 0: Print " " + Mid$(EV$(S, LO), I, M - I)

        EV$(S, LO) = Left$(EV$(S, LO), I - 1) + " " + Mid$(EV$(S, LO), I, M - I)

    End If

    Rem------------------ANY KEY------------------

    If IN$ <> Chr$(8) And IN$ <> Chr$(9) And IN$ <> Chr$(13) And IN$ <> Chr$(27) And IN$ <> Chr$(32) And Len(IN$) = 1 Then

        I = I + 1

        If I > M Then I = M

        If I < 1 Then I = 1

        Locate 1 + K, I + I2 + 1, 0: Print IN$ + Mid$(EV$(S, LO), I, M - I)

        EV$(S, LO) = Left$(EV$(S, LO), I - 1) + IN$ + Mid$(EV$(S, LO), I, M - I)

    End If

    Rem--------------PAGE DOWN---------------

    If Mid$(IN$, 2, 1) = "Q" And L < NMAX - 17 Then

        If L < NMAX - 17 Then L = L + 18

        If L > NMAX - 17 Then L = NMAX - 17

        F2 = 0

        For F = L To L + 17

            F2 = F2 + 1

            Color C11, C0: Locate 6 + F2 * 2, 4: Print Using "###"; F

            Color C7, C0

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

    End If

    Rem ---------------PAGE UP----------------

    If Mid$(IN$, 2, 1) = "I" And L > 1 Then

        If L > 18 Then L = L - 18 Else L = 1

        F2 = 0

        For F = L To L + 17

            F2 = F2 + 1

            Color C11, C0: Locate 6 + F2 * 2, 4: Print Using "###"; F

            Color C7, C0

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

    End If

    Rem--------------DOWN ARROW---------------

    If Mid$(IN$, 2, 1) = "P" And L < NMAX - 17 And K = 41 Then

        F2 = 0

        L = L + 1

        For F = L To L + 17

            F2 = F2 + 1

            Color C11, C0: Locate 6 + F2 * 2, 4: Print Using "###"; F: Color C7, C0

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

    End If

    Rem ---------------UP ARROW----------------

    If Mid$(IN$, 2, 1) = "H" And L > 1 And K = 7 Then

        L = L - 1

        F2 = 0

        For F = L To L + 17

            F2 = F2 + 1

            Color C11, C0: Locate 6 + F2 * 2, 4: Print Using "###"; F: Color C7, C0

            Locate 6 + F2 * 2, 8, 0: Print EV$(F, 1)

            Locate 6 + F2 * 2, 19: Print EV$(F, 2)

            Locate 6 + F2 * 2, 27: Print EV$(F, 3)

        Next F

    End If

Loop

390 T = Err

Color 0, 0: Cls: Width 80, 25

Color 7, 0: Locate 1, 1: Print "Error code "; T

If T = 7 Then Print "Not enough memory"

If T = 14 Then Print "Not enough memory"

If T = 17 Then Print "Cannot continue"

If T = 25 Then Print "Device fault"

If T = 51 Then Print "Internal error"

If T = 61 Then Print "Not enough disk space"

If T = 70 Then Print "Permission denied"

If T = 72 Then Print "Disk-media error"

If T = 75 Then Print "Access of file "; ERRORFILE$; " is denied"

If T = 53 Then Print "File "; ERRORFILE$; " is missing from current path"

Print "Press any key to exit..."

Sleep

GoTo 500

400 If FCOL$ <> COLOR$ Or FLANG$ <> LANG$ Then

    Open "CAL300.CFG" For Output As #1

    Print #1, COLOR$

    Print #1, LANG$

    Close #1

End If

GoTo 500

410 Color C7, C0

If Val(Left$(Date$, 2)) = 1 Then MO$ = "January "

If Val(Left$(Date$, 2)) = 2 Then MO$ = "February "

If Val(Left$(Date$, 2)) = 3 Then MO$ = "March "

If Val(Left$(Date$, 2)) = 4 Then MO$ = "April "

If Val(Left$(Date$, 2)) = 5 Then MO$ = "May "

If Val(Left$(Date$, 2)) = 6 Then MO$ = "June "

If Val(Left$(Date$, 2)) = 7 Then MO$ = "July "

If Val(Left$(Date$, 2)) = 8 Then MO$ = "August "

If Val(Left$(Date$, 2)) = 9 Then MO$ = "September "

If Val(Left$(Date$, 2)) = 10 Then MO$ = "October "

If Val(Left$(Date$, 2)) = 11 Then MO$ = "November "

If Val(Left$(Date$, 2)) = 12 Then MO$ = "December "

Locate 3, 70: Print Time$

Return

450 For I = 1804 To 2099 Step 4

    If I = Val(Mid$(DATE1$, 7, 4)) Then FD = 1: Exit For

Next I

460 MONTH$ = Left$(DATE1$, 2): Day$ = Mid$(DATE1$, 4, 2)

If Val(MONTH$) = 1 Then LTA = Val(Day$)

If Val(MONTH$) = 2 Then LTA = 31 + Val(Day$)

If Val(MONTH$) = 3 Then LTA = 31 + 28 + FD + Val(Day$)

If Val(MONTH$) = 4 Then LTA = 31 + 28 + FD + 31 + Val(Day$)

If Val(MONTH$) = 5 Then LTA = 31 + 28 + FD + 31 + 30 + Val(Day$)

If Val(MONTH$) = 6 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + Val(Day$)

If Val(MONTH$) = 7 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + Val(Day$)

If Val(MONTH$) = 8 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + 31 + Val(Day$)

If Val(MONTH$) = 9 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + 31 + 31 + Val(Day$)

If Val(MONTH$) = 10 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + 31 + 31 + 30 + Val(Day$)

If Val(MONTH$) = 11 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + Val(Day$)

If Val(MONTH$) = 12 Then LTA = 31 + 28 + FD + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + Val(Day$)

Return

500 Color 7, 0: Cls: Clear: System: End

***SMcNeill*** · 01-05-2026, 11:16 AM

@2112 Every year or so, we see someone do something like this, and I'm always excited to see how they tackle creating a calendar.

https://qb64phoenix.com/forum/showthread.php?tid=129 Here's my calendar creation program, which has been around forever and ever now, and yet... /sniffle /sniffle ... never gets any comments or remarks on. For whatever reason, folks will write 12 pages of comments on something small like "spaghetti and meatballs", but it's rare to see even a single comment over something like a calendar -- and it's obvious which one is the most useful for folks! (Of course the cheesy meatballs are more important! We might actually look at how to make a circle with them! Big Grin

)

Mine... tracks daily sunrise, sunset, moon phase, astrology signs, holidays, current time, has a current news tracker which still goes over the latest news from the world for you. Works forwards and backwards, is nice and printable, has notes that you can attach to it for your own reference use (such as anniversary dates or birthdays)... It's all totatally free and written in QB64... AND...

It get absolutely zero love. /WAAH!!!

I'm thinking you need to add some noodles or spaghetti or something to your work here, before you'll see many comments on it. Wink

2112 · 01-05-2026, 12:42 PM

(01-05-2026, 11:16 AM)SMcNeill Wrote: @2112 Every year or so, we see someone do something like this, and I'm always excited to see how they tackle creating a calendar.

https://qb64phoenix.com/forum/showthread.php?tid=129 Here's my calendar creation program, which has been around forever and ever now, and yet... /sniffle /sniffle ... never gets any comments or remarks on. For whatever reason, folks will write 12 pages of comments on something small like "spaghetti and meatballs", but it's rare to see even a single comment over something like a calendar -- and it's obvious which one is the most useful for folks! (Of course the cheesy meatballs are more important! We might actually look at how to make a circle with them! )

Mine... tracks daily sunrise, sunset, moon phase, astrology signs, holidays, current time, has a current news tracker which still goes over the latest news from the world for you. Works forwards and backwards, is nice and printable, has notes that you can attach to it for your own reference use (such as anniversary dates or birthdays)... It's all totatally free and written in QB64... AND...

It get absolutely zero love. /WAAH!!!

I'm thinking you need to add some noodles or spaghetti or something to your work here, before you'll see many comments on it.

Yes this is true, a comment or at least a rating
is very encouraging to continue posting programs.

As for your calendar,
I tried many times to download it but I can't. Just a few seconds
before the downloading finish, it stops and says
"Check internet connection". This happened before with
( .7z) extension files. Never with (.zip) extension files.
But it could be windows 7 or my browser (slimjet), I am not sure.

***SMcNeill*** · 01-05-2026, 01:32 PM

My main feedback on this is:

1) Add the $RESIZE:SMOOTH to the top of the code. On modern machines, I can't see a dang thing with this as it's so small compared to the resolution of the laptop itself. Being able to grab a corner of the program and resize makes it 100% more usable in my opinion.

2) I think there's something wrong with the shadowing at the top right of the screen. The top block of black is misaligned and not in proper place. You might want to take a quick look at that.

3) I don't have a printer hooked up to my system at the moment (all my ink has dried into packs of bricks it seems), but have you considered adding in a feature to print the page with a simple _PRINTIMAGE keybinding?

I think I've seen this before, over the ages. Is this just an updating of an old QB45 program or such to run on QB64? Or is this something original? Am I just getting so old and tired that everything new seems like something old anymore. LOL! Either way, you've done a good job on this. My biggest issue was just *seeing* it and reading it all, but $RESIZE:SMOOTH worked like a charm on my laptop with it.

2112 · 01-05-2026, 02:23 PM

It's an old qb45 program I made many years ago and was post in qb4all.com if I remember well.
Maybe you saw it there. Sadly qb4all is gone now, was a great site.

***Pete*** · (This post was last modified: 01-05-2026, 04:13 PM by Pete.)

(01-05-2026, 12:42 PM)2112 Wrote: Yes this is true, a comment or at least a rating
is very encouraging to continue posting programs.

As for your calendar,
I tried many times to download it but I can't. Just a few seconds
before the downloading finish, it stops and says
"Check internet connection". This happened before with
( .7z) extension files. Never with (.zip) extension files.
But it could be windows 7 or my browser (slimjet), I am not sure.

@2112

I had a same/similar issue with downloading later versions of QB64. I fixed that by updating to the latest 7Zip program. That might work for you, too.

I made my first calendar program in QuickBasic, around 1990 and a few after. My original still works today.... April 1, 2032. Perfectly coded! (Hears Steve, in the background, laughing his ASCII off).
https://qb64phoenix.com/forum/showthread...p+calendar

Now it isn't as elaborate as Steve's, which is helpful to prevent planting corn in Uranus.

I see you registered here in October. Welcome to the forum. Did you ever visit/post at the QBasic Forum? It's still up, but on a different server:

https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Pete

SierraKen · 01-05-2026, 06:20 PM

Hey 2112, this is pretty nifty! Good job with the conversion to QB64. I made a calendar making program many years ago myself, it's here:

https://qb64phoenix.com/forum/showthread.php?tid=2933

2112 · 01-05-2026, 06:38 PM

Pete , SierraKen ....
Very nice calendars, excellent work...
I didn't know about the qbasic forum, it looks very interesting.
Now I am thinking of making a program that
calculates how many days passed from date A to date B.
If I have time, maybe I will try it...

***Pete*** · 01-05-2026, 07:12 PM

(01-05-2026, 06:38 PM)2112 Wrote: Pete , SierraKen ....
Very nice calendars, excellent work...
I didn't know about the qbasic forum, it looks very interesting.
Now I am thinking of making a program that
calculates how many days passed from date A to date B.
If I have time, maybe I will try it...

@2112

Thanks.

The QBasic Forum and (That Other Pete) Pete's QBasic are two of the oldest that survived.

In regard to days between dates: https://qb64phoenix.com/forum/showthread...6#pid31006

The entire thread has a lot of info, too.

Pete

***SMcNeill*** · 01-05-2026, 07:17 PM

Code: (Select All)
Screen _NewImage(1280, 720, 32)

Print "Is the date in proper format?  The skies say "; CheckDayFormat(Date$)

Print "The Date = "; Date$

Print "Weekday  = "; GetWeekDayName(Date$); ", which is day number"; GetWeekDay(Date$); "of the week."

Print "Day      ="; GetDay(Date$)

Print "Month    ="; GetMonth(Date$)

Print "Year    ="; GetYear(Date$)

Print

Print "And to reverse the process we take those values and make them a date with :"; MakeDate(GetMonth(Date$), GetDay(Date$), GetYear(Date$))

Print

Print

Print

Print "And we can always fancify our date to universal formats: "

Print UniDate$("mm/dd/yyyy", Date$)

Print UniDate$("w, MM dd, YYYY", Date$)

Print UniDate$("W, MM DD, YYYY", Date$)

Print UniDate$("dd/mm/yyyy", Date$)

Print UniDate$("W, E D, YYYY", Date$)

Print UniDate$("mm-dd-yy", Date$)

Do

    Print

    Print "If you want to know the day that belongs to any date, give me a date in MM/DD/YYYY format =>";

    Input dat$

    If CheckDayFormat(dat$) Then

        Exit Do

    Else

        Print "Bad format for your date.  Sorry."

    End If

Loop

Print

Print dat$; "was a "; GetWeekDayName$(dat$)

Print

Print

Print "Do you want to know how many days were between two dates?"

Print "Give me the first date in MM/DD/YYYY format =>";

Input dat$

Print "Give me the first date in MM/DD/YYYY format =>";

Input dat2$

Print "There were "; DaysBetween(dat$, dat2$); " days between "; dat$; " and "; dat2$; "."

Function DaysBetween&& (t1$, t2$)

    t1## = TimeStamp(t1$, 0)

    t2## = TimeStamp(t2$, 0)

    If t2## < t1## Then Swap t1##, t2##

    DaysBetween = (t2## - t1##) / (60 * 60 * 24)

End Function

Function CheckDayFormat (Day As String) 'use MM/DD/YYYY format

    Dim As String DD, MM, YYYY, TD, TM, TY

    If Len(Day$) <> 10 Then Glitch = -1

    DD = Left$(Day, 2)

    MM = Mid$(Day, 4, 2)

    YYYY = Right$(Day, 4)

    TD = Right$("00" + _Trim$(Str$(Val(DD))), 2)

    TM = Right$("00" + _Trim$(Str$(Val(MM))), 2)

    TY = Right$("0000" + _Trim$(Str$(Val(YYYY))), 4)

    If TD <> DD Then Glitch = -1

    If TM <> MM Then Glitch = -1

    If TY <> YYYY Then Glitch = -1

    If Glitch = 0 Then CheckDayFormat = -1

End Function

Function GetDay& (Day As String) 'use MM/DD/YYYY format

    If CheckDayFormat(Day$) = 0 Then GetDay = 0: Exit Function

    GetDay = Val(Mid$(Day, 4, 2))

End Function

Function GetMonth& (Day As String) 'use MM/DD/YYYY format

    If CheckDayFormat(Day$) = 0 Then GetMonth = 0: Exit Function

    GetMonth = Val(Left$(Day, 2))

End Function

Function GetYear& (Day As String) 'use MM/DD/YYYY format

    If CheckDayFormat(Day$) = 0 Then GetYear = 0: Exit Function

    GetYear = Val(Right$(Day, 4))

End Function

Function GetWeekDay& (Day$) 'use MM/DD/YYYY format

    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence

    If CheckDayFormat(Day$) = 0 Then GetWeekDay = 0: Exit Function

    Dim As Long century, zerocentury, result

    Dim As Long MM, DD, YYYY

    MM = GetMonth(Day$): DD = GetDay(Day$): YYYY = GetYear(Day$)

    If MM < 3 Then MM = MM + 12: YYYY = YYYY - 1

    century = YYYY Mod 100

    zerocentury = YYYY \ 100

    result = (DD + Int(13 * (MM + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7

    If result = 0 Then result = 7

    GetWeekDay& = result 'results are 1 to 7, from Sunday to Saturday

End Function

Function GetWeekDayName$ (Day$) 'use MM/DD/YYYY format

    Dim result As Long

    result = GetWeekDay(Day$)

    Select Case result

        Case 1: GetWeekDayName = "Sunday"

        Case 2: GetWeekDayName = "Monday"

        Case 3: GetWeekDayName = "Tuesday"

        Case 4: GetWeekDayName = "Wednesday"

        Case 5: GetWeekDayName = "Thursday"

        Case 6: GetWeekDayName = "Friday"

        Case 7: GetWeekDayName = "Saturday"

    End Select

End Function

Function MakeDate$ (MM As _Unsigned Long, DD As _Unsigned Long, YYYY As _Unsigned Long)

    Dim As String TD, TM, TY

    TM = Right$("00" + _Trim$(Str$(MM)), 2)

    TD = Right$("00" + _Trim$(Str$(DD)), 2)

    TY = Right$("0000" + _Trim$(Str$(YYYY)), 4)

    MakeDate = TM + "-" + TD + "-" + TY

End Function

Function UniDate$ (format$, userdate$)

    'some basic documentation for formatting:

    'dates sent via userdate$ should be in the standardized QB64 DATE$ format -- MM/DD/YYYY

    'To customize your return date format, use the following syntax

    'w = short weekday names.  (Mon, Tue, Wed, Thu, Fri, Sat, Sun)

    'W = long weekday names.  (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday)

    'E = Extended month names.  (January, February, March....)

    'M = long month names.  (Jan, Feb, Mar...)

    'm = short month names.  (01, 02, 03...)

    'D = long day names.  (01st, 02nd, 03rd...)

    'd = short day names.  (01, 02, 03...)

    'Y or y (case insensitive) = year.  Number of Yy present determines the number of digits we return.

    '      YY = 2-digit year

    '      YYYY = 4 digit year

    '      Y with any additional number of y's = 4 digit year by default, so a typo of YYYYY is the same as YYYY.

    'Any other character is simply considered part of the desired output and faithfully carried over into the proper spot.

    '      For example, "mm/dd/yyyy" gives us "02/10/2023" for Feb 10th, 2023.

    '      Second example, "dd.mm.yyyy" gives us "10.02.2023" for the same date.

    '      Third example, "dd EE YYYY" gives us "02 February 2023" for that same date.

    'Note:  Extra digits of most of these codes are simply ignored for error proofing purposes, with only the initial code being accepted.

    '      For example "mM YYYY" is actually processed as a simple "m YYYY".  The process won't mix short, long, or extended results.

    '      Also for example, "m YY" is the *exact* same as "mm YY".

    '      Feel free to use extra digits as you desire to help you keep track of positional spacing in your format string.

    '      Even though "M D, yyyy" may process the same as "MMM DDDD, YYYY", the second may work better for you if you're trying to track

    '            position of formatted objects.  (The output would be "Feb 10th, 2023", and those extra characters help hold that

    '            positioning for us easily.)

    'And, I think that's it.  Enjoy, guys!

    Dim As String temp, m, d, y, firstchar, Day

    Dim out$

    Dim As Long MonthSet, DaySet, WeekdaySet, result, YearSet, mm, dd, yyyy, century, zerocentury

    temp$ = userdate$

    If temp$ = "" Then temp$ = Date$

    m$ = Left$(temp$, 2)

    d$ = Mid$(temp$, 4, 2)

    y$ = Right$(temp$, 4)

    temp$ = format$

    Do

        firstchar$ = Left$(temp$, 1)

        Select Case firstchar$

            Case "E" 'extended month

                temp$ = Mid$(temp$, 2)

                If Not MonthSet Then

                    MonthSet = -1

                    Select Case Val(m$)

                        Case 1: out$ = out$ + "January"

                        Case 2: out$ = out$ + "February"

                        Case 3: out$ = out$ + "March"

                        Case 4: out$ = out$ + "April"

                        Case 5: out$ = out$ + "May"

                        Case 6: out$ = out$ + "June"

                        Case 7: out$ = out$ + "July"

                        Case 8: out$ = out$ + "August"

                        Case 9: out$ = out$ + "September"

                        Case 10: out$ = out$ + "October"

                        Case 11: out$ = out$ + "November"

                        Case 12: out$ = out$ + "December"

                    End Select

                End If

            Case "M" 'long month

                temp$ = Mid$(temp$, 2)

                If Not MonthSet Then

                    MonthSet = -1

                    Select Case Val(m$)

                        Case 1: out$ = out$ + "Jan"

                        Case 2: out$ = out$ + "Feb"

                        Case 3: out$ = out$ + "Mar"

                        Case 4: out$ = out$ + "Apr"

                        Case 5: out$ = out$ + "May"

                        Case 6: out$ = out$ + "Jun"

                        Case 7: out$ = out$ + "Jul"

                        Case 8: out$ = out$ + "Aug"

                        Case 9: out$ = out$ + "Sep"

                        Case 10: out$ = out$ + "Oct"

                        Case 11: out$ = out$ + "Nov"

                        Case 12: out$ = out$ + "Dec"

                    End Select

                End If

            Case "m" 'short month

                temp$ = Mid$(temp$, 2)

                If Not MonthSet Then

                    MonthSet = -1

                    Select Case Val(m$)

                        Case 1: out$ = out$ + "01"

                        Case 2: out$ = out$ + "02"

                        Case 3: out$ = out$ + "03"

                        Case 4: out$ = out$ + "04"

                        Case 5: out$ = out$ + "05"

                        Case 6: out$ = out$ + "06"

                        Case 7: out$ = out$ + "07"

                        Case 8: out$ = out$ + "08"

                        Case 9: out$ = out$ + "09"

                        Case 10: out$ = out$ + "10"

                        Case 11: out$ = out$ + "11"

                        Case 12: out$ = out$ + "12"

                    End Select

                End If

            Case "D" 'long day

                temp$ = Mid$(temp$, 2)

                If Not DaySet Then

                    DaySet = -1

                    out$ = out$ + Right$("00" + _Trim$(d$), 2)

                    Select Case Val(d$)

                        Case 1, 11, 21, 31: out$ = out$ + "st"

                        Case 2, 22: out$ = out$ + "nd"

                        Case 3, 23: out$ = out$ + "rd"

                        Case Else: out$ = out$ + "th"

                    End Select

                End If

            Case "d" 'short day

                temp$ = Mid$(temp$, 2)

                If Not DaySet Then

                    DaySet = -1

                    out$ = out$ + Right$("00" + _Trim$(d$), 2)

                End If

            Case "W" 'long weekday

                temp$ = Mid$(temp$, 2)

                If Not WeekdaySet Then

                    GoSub getday

                    Select Case result

                        Case 0: Day$ = "Saturday"

                        Case 1: Day$ = "Sunday"

                        Case 2: Day$ = "Monday"

                        Case 3: Day$ = "Tuesday"

                        Case 4: Day$ = "Wednesday"

                        Case 5: Day$ = "Thursday"

                        Case 6: Day$ = "Friday"

                    End Select

                    out$ = out$ + Day$

                End If

            Case "w" 'short weekday

                temp$ = Mid$(temp$, 2)

                If Not WeekdaySet Then

                    GoSub getday

                    Select Case result

                        Case 0: Day$ = "Sat"

                        Case 1: Day$ = "Sun"

                        Case 2: Day$ = "Mon"

                        Case 3: Day$ = "Tue"

                        Case 4: Day$ = "Wed"

                        Case 5: Day$ = "Thr"

                        Case 6: Day$ = "Fri"

                    End Select

                    out$ = out$ + Day$

                End If

            Case "Y", "y" 'year

                If Not YearSet Then

                    YearSet = -1

                    If Left$(UCase$(temp$), 4) = "YYYY" Then

                        temp$ = Mid$(temp$, 5)

                        out$ = out$ + y$

                    ElseIf Left$(UCase$(temp$), 2) = "YY" Then

                        temp$ = Mid$(temp$, 3)

                        out$ = out$ + Right$(y$, 2)

                    Else

                        temp$ = Mid$(temp$, 2)

                        out$ = out$ + y$

                    End If

                Else

                    temp$ = Mid$(temp$, 2)

                End If

            Case Else 'seperator

                temp$ = Mid$(temp$, 2)

                out$ = out$ + firstchar$

        End Select

    Loop Until temp$ = ""

    UniDate$ = out$

    Exit Function

    getday:

    WeekdaySet = -1

    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence

    mm = Val(m$): dd = Val(d$): yyyy = Val(y$)

    If mm < 3 Then mm = mm + 12: yyyy = yyyy - 1

    century = yyyy Mod 100

    zerocentury = yyyy \ 100

    result = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7

    Return

End Function

Function TimeStamp## (d1$, t##) 'date and timer

    'Based on Unix Epoch time, which starts at year 1970.

    Dim l As _Integer64, l1 As _Integer64, m As _Integer64

    Dim d As _Integer64, y As _Integer64, i As _Integer64

    Dim s As _Float, d$

    If CheckDayFormat(d1$) = 0 Then

        Print "Bad format for date.  Can not get a timestamp.  Default value of ERROR ERROR issued instead!"

        Error 5

        Exit Function

    End If

    d$ = d1$

    For i = 1 To Len(d$) 'replace hypens with /

        If Mid$(d$, i, 1) = "\" Then Mid$(d$, i) = "-"

        If Mid$(d$, i, 1) = "/" Then Mid$(d$, i) = "-"

    Next

    l = InStr(d$, "-")

    l1 = InStr(l + 1, d$, "-")

    m = Val(Left$(d$, l))

    d = Val(Mid$(d$, l + 1))

    y = Val(Mid$(d$, l1 + 1))

    If y < 1970 Then 'calculate shit backwards

        Select Case m 'turn the day backwards for the month

            Case 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days

            Case 2: d = 28 - d 'special 28 or 29.

            Case 4, 6, 9, 11: d = 30 - d '30 days

        End Select

        If y Mod 4 = 0 And m < 3 Then 'check for normal leap year, and we're before it...

            d = d + 1 'assume we had a leap year, subtract another day

            If y Mod 100 = 0 And y Mod 400 <> 0 Then d = d - 1 'not a leap year if year is divisible by 100 and not 400

        End If

        'then count the months that passed after the current month

        For i = m + 1 To 12

            Select Case i

                Case 2: d = d + 28

                Case 3, 5, 7, 8, 10, 12: d = d + 31

                Case 4, 6, 9, 11: d = d + 30

            End Select

        Next

        'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970

        d = d + 365 * (1969 - y) '365 days per each standard year

        For i = 1968 To y + 1 Step -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)

            d = d + 1 'subtract an extra day every leap year

            If (i Mod 100) = 0 And (i Mod 400) <> 0 Then d = d - 1 'but skipping every year divisible by 100, but not 400

        Next

        s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        TimeStamp## = -(s## + 24 * 60 * 60 - t##)

        Exit Function

    Else

        y = y - 1970

    End If

    For i = 1 To m 'for this year,

        Select Case i 'Add the number of days for each previous month passed

            Case 1: d = d 'January doestn't have any carry over days.

            Case 2, 4, 6, 8, 9, 11: d = d + 31

            Case 3 'Feb might be a leap year

                If (y Mod 4) = 2 Then 'if this year is divisible by 4 (starting in 1972)

                    d = d + 29 'its a leap year

                    If (y Mod 100) = 30 And (y Mod 400) <> 30 Then 'unless..

                        d = d - 1 'the year is divisible by 100, and not divisible by 400

                    End If

                Else 'year not divisible by 4, no worries

                    d = d + 28

                End If

            Case 5, 7, 10, 12: d = d + 30

        End Select

    Next

    d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

    For i = 2 To y - 1 Step 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)

        d = d + 1 'add an extra day every leap year

        If (i Mod 100) = 30 And (i Mod 400) <> 30 Then d = d - 1 'but skiping every year divisible by 100, but not 400

    Next

    s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

    TimeStamp## = (s## + t##)

End Function

Function ExtendedTimer##

    'Simplified version of the TimeStamp routine, streamlined to only give positive values based on the current timer.

    'Note:  Only good until the year 2100, as we don't do all the fancy calculations for leap years.

    'A timer should work quickly and efficiently in the background; and the less we do, the less lag we might insert

    'into a program.

    Dim m As Integer, d As Integer, y As Integer

    Dim s As _Float, day As String

    day = Date$

    m = Val(Left$(day, 2))

    d = Val(Mid$(day, 4, 2))

    y = Val(Right$(day, 4)) - 1970

    Select Case m 'Add the number of days for each previous month passed

        Case 2: d = d + 31

        Case 3: d = d + 59

        Case 4: d = d + 90

        Case 5: d = d + 120

        Case 6: d = d + 151

        Case 7: d = d + 181

        Case 8: d = d + 212

        Case 9: d = d + 243

        Case 10: d = d + 273

        Case 11: d = d + 304

        Case 12: d = d + 334

    End Select

    If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

    d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

    d = d + (y + 2) \ 4 'add in days for leap years passed

    s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

    ExtendedTimer## = (s + Timer)

End Function

Login
Username/Email:
Password:	Lost Password?
	Remember me