$TYPECHECK ON
$ESCAPECHARS ON
DEFINT SUN = 1, MON = 2
DEFINT TUE = 3, WED = 4
DEFINT THU = 5, FRI = 6
DEFINT SAT = 7
CONST FirstYear = 1980
CONST Feb29 = 0
DEFINT FirstDay = TUE
FUNCTION PeriodFeb29Year( y& AS INTEGER ) AS INTEGER
PeriodFeb29Year = y& MOD 4
END FUNCTION
FUNCTION FebDay( order& AS INTEGER ) AS INTEGER
IF order&=0 THEN :FebDay=29
ELSE :FebDay=28
END IF
END FUNCTION
FUNCTION AmountDayInMonth( num& AS INTEGER, y& AS INTEGER ) AS INTEGER
SELECT CASE num&
CASE 1,3,5,7,8,10,12: AmountDayInMonth = 31
CASE 2: AmountDayInMonth = FebDay(PeriodFeb29Year( y& ))
CASE 4,6,9,11: AmountDayInMonth = 30
END SELECT
END FUNCTION
FUNCTION Jan1DayInYear(y& AS INTEGER) AS INTEGER
SELECT CASE (y&-FirstYear) MOD 28
CASE 0,5,11,22: Jan1DayInYear = TUE
CASE 6,12,17,23: Jan1DayInYear = WED
CASE 1,7,18,24: Jan1DayInYear = THU
CASE 2,8,13,19: Jan1DayInYear = FRI
CASE 3,14,20,25: Jan1DayInYear = SAT
CASE 4,9,15,26: Jan1DayInYear = SUN
CASE 10,16,21,27: Jan1DayInYear = MON
END SELECT
END FUNCTION
FUNCTION DayOrder( d&, n& ) AS INTEGER
IF d&+n&>7 THEN
DayOrder = d&+n&-7
ELSEIF d&+n&<1 THEN
DayOrder = d&+n&+7
ELSE
DayOrder = d&+n&
END IF
END FUNCTION
FUNCTION LastDayInBeforeMonth(d& AS INTEGER,m& AS INTEGER, y& AS INTEGER) AS INTEGER
DIM C& AS INTEGER
SELECT CASE m&
CASE 9,12: C&=-3
CASE 4,7 C&=-2
CASE 10,1: C&=-1
CASE 5: C&=0
CASE 8: C&=1
CASE 2,3,11: C&=2
CASE 6: C&=3
END SELECT
C& = DayOrder(d&,C&)
IF PeriodFeb29Year(y&)=Feb29 THEN
IF m&>2 THEN
LastDayInBeforeMonth = DayOrder(C&,1)
ELSE
LastDayInBeforeMonth = C&
END IF
ELSE
LastDayInBeforeMonth = C&
END IF
END FUNCTION
FUNCTION Day$(d$) AS STRING
DEFINT year& = VAL(FIELD$(d$,"-",3)) ,month& = VAL(FIELD$(d$,"-",1)), day& = VAL(FIELD$(d$,"-",2))
DEFINT d& = Jan1DayInYear( year& )
IF (year&<1980) OR (month&<1) OR (month&>12) OR (day&<1) OR (day&>31) THEN
Day$="-"
ELSEIF day& > AmountDayInMonth( month&, year& ) THEN
Day$ = "-"
ELSE
d& = LastDayInBeforeMonth(d&, month&, year&)
d& = DayOrder(d&,day& MOD 7)
SELECT CASE d&
CASE 1:D$="Sun"
CASE 2:D$="Mon"
CASE 3:D$="Tues"
CASE 4:D$="Wednes"
CASE 5:D$="Thurs"
CASE 6:D$="Fri"
CASE 7:D$="Satur"
END SELECT
Day$=D$+"day"
END IF
END FUNCTION
SUB printDay( s$ AS STRING )
PRINT s$;" : ";Day$( s$ )
END SUB
PRINT "Today is : ";Day$(DATE$)
PRINT "3-3-2004 is "+Day$("3-3-2004")
printDay("10-5-2038")
printDay("01-8-2039")
printDay("1-8-2039")
printDay("6-30-2037")
printDay("0-30-2004")
printDay("2-29-2003")
printDay("6-28-1945")
FUNCTION Day(d$) AS INTEGER
DEFINT year& = VAL(FIELD$(d$,"-",3)) ,month& = VAL(FIELD$(d$,"-",1)), day& = VAL(FIELD$(d$,"-",2))
DEFINT d& = Jan1DayInYear( year& )
IF (year&<1980) OR (month&<1) OR (month&>12) OR (day&<1) OR (day&>31) THEN
Day=0
ELSEIF day& > AmountDayInMonth( month&, year& ) THEN
Day=0
ELSE
d& = LastDayInBeforeMonth(d&, month&, year&)
d& = DayOrder(d&,day& MOD 7)
day = d&
END IF
END FUNCTION
DEFINT N
DEFSTR MONTH$(1 TO 12) = { "January","February","March","April","May","June", _
"July","August","September","October","November","December "}
SUB CalendarStr$( m& AS INTEGER, y& AS INTEGER )
DIM FirstDayMonth AS INTEGER
DIM S$ AS STRING
DEFINT d&=1
?""
?" < ";MONTH$(m&);" ";STR$(y&);" >"
?" sun mon tue wed thu fri sat"
FirstDayMonth = Day(STR$(m&)+"-"+STR$(d&)+"-"+STR$(y&))
S$=STRING$((FirstDayMonth-1)*6," ")
FOR N=1 TO AmountDayInMonth(m&,y&)
S$=S$+STRING$(6-LEN(STR$(N))," ")+STR$(N)
IF DayOrder(N,FirstDayMonth-1) MOD 7 = 0 THEN
S$ = S$+"\r\n"
END IF
NEXT
?S$
END SUB
CalendarStr$(2,2002)
INPUT N
|
|