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.
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