home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.whtech.com
/
ftp.whtech.com.tar
/
ftp.whtech.com
/
compuserve
/
Basic
/
CALNDR.BXB
< prev
next >
Wrap
Text File
|
2006-10-19
|
3KB
|
137 lines
100 REM PRINTERNAME IN 1220
110 CALL CLEAR
120 CALL SCREEN(8)
130 PRINT " *** CALENDAR PROGRAM ***": : : : :" WANT TO CHECK A DATE?": :"SEE
WHAT DAY OF THE WEEK AN": :
140 PRINT "IMPORTANT EVENT OCCURED ON?": : : :"THEN THIS IS THE PROGRAM FORYOU!
IT WILL PRINT THE MONTH"
150 PRINT "FOR ANY YEAR BETWEEN 1600 & 2399, YOU CAN EVEN HAVE IT PRINTED ON
YOUR PRINTER!": : : :
160 PRINT " TYPE ANY KEY TO CONTINUE"
170 FOR A=97 TO 102
180 READ M$
190 CALL CHAR(A,M$)
200 NEXT A
210 DATA FFFF,00000000FF,E0E0E0E0E0E0E0E,0707070707070707,C0C0,0303
220 CALL KEY(0,A,S)
230 IF S=0 THEN 220
240 CALL CLEAR
250 INPUT "TYPE MONTH YOU WISH TO SEE, THEN PRESS ENTER: MONTH?(1
-12) ":M
260 IF (M<1)+(M>12)<0 THEN 240
270 PRINT "": : : :
280 INPUT "TYPE YEAR YOU WISH TO SEE, THEN PRESS ENTER: YEAR?(16
00-2399) ":Y
290 IF (Y<1600)+(Y>2399)<0 THEN 270
300 CALL CLEAR
310 REM PRINT CALENDAR
320 CALL SOUND(400,600,0)
330 CALL HCHAR(5,5,97,23)
340 FOR A=7 TO 19 STEP 2
350 CALL HCHAR(A,5,98,23)
360 NEXT A
370 CALL VCHAR(5,4,100,16)
380 CALL VCHAR(5,28,99,16)
390 CALL HCHAR(21,5,97,23)
400 CALL HCHAR(21,4,102)
410 CALL HCHAR(21,28,101)
420 RESTORE 460
430 FOR A=1 TO M
440 READ M$
450 NEXT A
460 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOV
EMBER,DECEMBER
470 M$=M$&" "&STR$(Y)
480 FOR I=1 TO LEN(M$)
490 CALL HCHAR(6,I+INT((32-LEN(M$))/2),ASC(SEG$(M$,I,1)))
500 NEXT I
510 M$="S M T W T F S"
520 R=8
530 C=6
540 GOSUB 1330
550 REM CALCULATE DAYS FROM JAN.1, 1582
560 RESTORE 690
570 Z=0
580 D=1
590 IF (Y/4)-INT(Y/4)<>0 THEN 640
600 IF (Y=2000)+(Y=1600)<0 THEN 640
610 D=D+1
620 IF M>2 THEN 640
630 Z=1
640 IF M=1 THEN 700
650 FOR A=1 TO M-1
660 READ C
670 D=D+C
680 NEXT A
690 DATA 31,28,31,30,31,30,31,31,30,31,30,31
700 YN=Y-1582
710 D=D+(YN*365)
720 D=D+INT((YN-3)/4)
730 A=((D/7)-INT(D/7))*7
740 A=INT(A-.5)+1
750 IF Y>2000 THEN 770
760 A=A+1
770 A=A+2
780 GOTO 800
790 A=A-7
800 IF A>7 THEN 790
810 READ O
820 IF M<>2 THEN 840
830 O=O+Z
840 IF (Z=1)+(M<3)<>-2 THEN 870
850 A=A-1
860 REM PRINTS DATES
870 C=4+(3*A)
880 R=10
890 FOR I=1 TO O
900 M$=STR$(I)
910 FOR A=1 TO LEN(M$)
920 CALL HCHAR(R,A+C-LEN(M$),ASC(SEG$(M$,A,1)))
930 NEXT A
940 C=C+3
950 IF C<26 THEN 980
960 C=7
970 R=R+2
980 NEXT I
990 RESTORE 1170
1000 FOR A=1 TO 4
1010 READ R,C,M$
1020 GOSUB 1330
1030 NEXT A
1040 CALL KEY(0,A,S)
1050 IF (S=0)+(A<49)+(A>52)<0 THEN 1040
1060 ON A-48 GOTO 1200,1070,1120,240
1070 M=M-1
1080 IF M<>0 THEN 300
1090 M=12
1100 Y=Y-1
1110 GOTO 300
1120 M=M+1
1130 IF M<13 THEN 300
1140 M=1
1150 Y=Y+1
1160 GOTO 300
1170 DATA 2,3,TYPE 1 FOR PRINTED COPY,22,3,TYPE 2 FOR PREVIOUS MONTH,23,3,TYPE 3
FOR FOLLOWING MONTH
1180 DATA 24,3,TYPE 4 FOR NEW SELECTION
1190 REM ****************** PRINTOUT ROUTINE
1200 CALL HCHAR(2,1,32,32)
1210 CALL HCHAR(22,1,32,96)
1220 OPEN #1:"RS232/2.BA=4800",OUTPUT
1230 FOR I=5 TO 21
1240 M$=""
1250 FOR A=1 TO 28
1260 CALL GCHAR(I,A,Z)
1270 M$=M$&CHR$(Z)
1280 NEXT A
1290 PRINT #1:M$
1300 NEXT I
1310 CLOSE #1
1320 GOTO 990
1330 FOR I=1 TO LEN(M$)
1340 CALL HCHAR(R,C+I,ASC(SEG$(M$,I,1)))
1350 NEXT I
1360 RETURN