DECLARE SUB calendar (Y%, M%)
DECLARE FUNCTION JD! (Y%, M%, DT!)
DECLARE FUNCTION WeekDay! (Y%, M%, D%)
DECLARE FUNCTION MaxDay! (Y%, M%)
REM Программа вывода календаря на любой месяц
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DIM SHARED DAYS(1 TO 12)
FOR j = 1 TO 12: READ DAYS(j): NEXT j
CLS
INPUT "Задайте год : ", Y%
INPUT "Задайте месяц : ", M%
calendar Y%, M%
END
SUB calendar (Y%, M%)
DIM i AS INTEGER, j AS INTEGER, k AS INTEGER, q AS INTEGER
DIM a(42), b$(7)
b$(0) = "понедельник": b$(1) = "вторник ": b$(2) = "среда "
b$(3) = "четверг ": b$(4) = "пятница ": b$(5) = "суббота "
b$(6) = "воскресенье"
CLS
PRINT " Календарь на "; M%; " месяц "; Y%; " года"
i = WeekDay(Y%, M%, 1)
IF i = 0 THEN i = 7
q = MaxDay(Y%, M%)
FOR j = 0 TO 41: a(j) = 0: NEXT j
k = 1
FOR j = i - 1 TO q + i - 2: a(j) = k: k = k + 1: NEXT j
FOR j = 0 TO 6
LOCATE j + 3, 10: PRINT b$(j);
k = 0
WHILE k <= 35
IF a(k + j) <> 0 THEN
PRINT USING "####"; a(k + j);
ELSE PRINT " ";
END IF
k = k + 7
WEND
NEXT j
END SUB
FUNCTION JD (Y%, M%, DT)
DIM a AS INTEGER, b AS INTEGER, mm AS INTEGER, yy AS INTEGER
DIM c AS LONG
b = 0
yy = Y%
mm = M%
IF M% < 3 THEN yy = yy - 1: mm = mm + 12
a = yy \ 100
IF Y% + M% / 100! + DT / 10000 > 1582.1015# THEN
b = b + 2 - a + a \ 4
END IF
c = INT(365.25 * yy)
IF yy < 0 THEN c = INT(365.25 * yy - .75)
JD = c + INT(30.6001 * (mm + 1)) + DT + 1720994.5# + b
END FUNCTION
FUNCTION MaxDay (Y%, M%)
MaxDay = DAYS(M%)
IF M% <> 2 THEN EXIT FUNCTION
IF (Y% MOD 400 = 0) OR ((Y% MOD 4 = 0) AND (Y% MOD 100 <> 0)) THEN
MaxDay = 29
END IF
END FUNCTION
FUNCTION WeekDay (Y%, M%, D%)
d1! = D% + 1.5
WeekDay = INT(JD(Y%, M%, d1!)) MOD 7
END FUNCTION