home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.whtech.com
/
ftp.whtech.com.tar
/
ftp.whtech.com
/
club100
/
bus
/
calend.ba
< prev
next >
Wrap
Text File
|
2006-10-19
|
1KB
|
22 lines
0 'Club 100 Library, Modem 415-939-1246
1 'CALEND.BA - Author unknown, revised by Robert Benson
10 CLS:PRINT@50,CHR$(152)" = Advance a Month":PRINT@90,CHR$(153)" = Retreat a Month":PRINT@170,"[ENTER] to Continue"
11 O$=INKEY$:IFO$=""GOTO11ELSEIFO$<>CHR$(13)THENMENU
12 YY=VAL(MID$(DATE$,7,2))+1900:M=VAL(MID$(DATE$,1,2)):L$="312831303130313130313031"
13 CLS:Y=YY-1901:L=INT((YY/4-INT(YY/4))*4+.5):D=Y*365+INT(Y/4)+1:IFM=1GOTO15
14 FORI=1TOM-1:D=D+VAL(MID$(L$,I*2-1,2)):NEXT:IFL<>0GOTO16
15 IFM>2THEND=D+1
16 PRINTTAB(16)MID$("JanFebMarAprMayJunJulAugSepOctNovDec",M*3-2,3);YY
17 PRINTTAB(7)"Sun Mon Tue Wed Thu Fri Sat"
18 W=INT((D/7-INT(D/7))*7+.5)+1:IFW=7THENPRINTTAB(6)ELSEPRINTTAB(6+W*4)
19 FORI=1TOVAL(MID$(L$,M*2-1,2)):P=I+W-1:IFW=7THENW=0:GOTO21
20 IFP/7=INT(P/7)THENPRINT:PRINTTAB(6)
21 IFI<10THENPRINTCHR$(32);
22 IFI=VAL(MID$(DATE$,4,2))ANDM=VAL(LEFT$(DATE$,2))THENPRINTCHR$(27)+"p";
23 PRINTI;CHR$(27)+"q";:NEXT:IFL<>0GOTO25
24 IFM=2THENPRINT" 29"
25 K$=INKEY$:IFK$=""GOTO25ELSEIFASC(K$)=77THENMENU
26 IFASC(K$)=30THENM=M+1:IFM>12THENM=1:YY=YY+1
27 IFASC(K$)=31THENM=M-1:IFM<1THENM=12:YY=YY-1
28 IFASC(K$)<30ORASC(K$)>31GOTO25ELSE13