home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / compuserve / Basic / CALNDR.BXB < prev    next >
Text File  |  2006-10-19  |  3KB  |  137 lines
  1.  
  2. 100 REM PRINTERNAME IN 1220
  3. 110 CALL CLEAR
  4. 120 CALL SCREEN(8)
  5. 130 PRINT "  *** CALENDAR PROGRAM ***": : : : :"   WANT TO CHECK A DATE?": :"SEE
  6.  WHAT DAY OF THE WEEK AN": :
  7. 140 PRINT "IMPORTANT EVENT OCCURED ON?": : : :"THEN THIS IS THE PROGRAM FORYOU! 
  8. IT WILL PRINT THE MONTH"
  9. 150 PRINT "FOR ANY YEAR BETWEEN 1600 &  2399, YOU CAN EVEN HAVE IT   PRINTED ON 
  10. YOUR PRINTER!": : : :
  11. 160 PRINT "  TYPE ANY KEY TO CONTINUE"
  12. 170 FOR A=97 TO 102
  13. 180 READ M$
  14. 190 CALL CHAR(A,M$)
  15. 200 NEXT A
  16. 210 DATA FFFF,00000000FF,E0E0E0E0E0E0E0E,0707070707070707,C0C0,0303
  17. 220 CALL KEY(0,A,S)
  18. 230 IF S=0 THEN 220
  19. 240 CALL CLEAR
  20. 250 INPUT "TYPE MONTH YOU WISH TO SEE, THEN PRESS ENTER:                MONTH?(1
  21. -12) ":M
  22. 260 IF (M<1)+(M>12)<0 THEN 240
  23. 270 PRINT "": : : :
  24. 280 INPUT "TYPE YEAR YOU WISH TO SEE,  THEN PRESS ENTER:                YEAR?(16
  25. 00-2399) ":Y
  26. 290 IF (Y<1600)+(Y>2399)<0 THEN 270
  27. 300 CALL CLEAR
  28. 310 REM PRINT CALENDAR 
  29. 320 CALL SOUND(400,600,0)
  30. 330 CALL HCHAR(5,5,97,23)
  31. 340 FOR A=7 TO 19 STEP 2
  32. 350 CALL HCHAR(A,5,98,23)
  33. 360 NEXT A
  34. 370 CALL VCHAR(5,4,100,16)
  35. 380 CALL VCHAR(5,28,99,16)
  36. 390 CALL HCHAR(21,5,97,23)
  37. 400 CALL HCHAR(21,4,102)
  38. 410 CALL HCHAR(21,28,101)
  39. 420 RESTORE 460
  40. 430 FOR A=1 TO M
  41. 440 READ M$
  42. 450 NEXT A
  43. 460 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOV
  44. EMBER,DECEMBER
  45. 470 M$=M$&" "&STR$(Y)
  46. 480 FOR I=1 TO LEN(M$)
  47. 490 CALL HCHAR(6,I+INT((32-LEN(M$))/2),ASC(SEG$(M$,I,1)))
  48. 500 NEXT I
  49. 510 M$="S  M  T  W  T  F  S"
  50. 520 R=8
  51. 530 C=6
  52. 540 GOSUB 1330
  53. 550 REM CALCULATE DAYS FROM JAN.1, 1582 
  54. 560 RESTORE 690
  55. 570 Z=0
  56. 580 D=1
  57. 590 IF (Y/4)-INT(Y/4)<>0 THEN 640
  58. 600 IF (Y=2000)+(Y=1600)<0 THEN 640
  59. 610 D=D+1
  60. 620 IF M>2 THEN 640
  61. 630 Z=1
  62. 640 IF M=1 THEN 700
  63. 650 FOR A=1 TO M-1
  64. 660 READ C
  65. 670 D=D+C
  66. 680 NEXT A
  67. 690 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  68. 700 YN=Y-1582
  69. 710 D=D+(YN*365)
  70. 720 D=D+INT((YN-3)/4)
  71. 730 A=((D/7)-INT(D/7))*7
  72. 740 A=INT(A-.5)+1
  73. 750 IF Y>2000 THEN 770
  74. 760 A=A+1
  75. 770 A=A+2
  76. 780 GOTO 800
  77. 790 A=A-7
  78. 800 IF A>7 THEN 790
  79. 810 READ O
  80. 820 IF M<>2 THEN 840
  81. 830 O=O+Z
  82. 840 IF (Z=1)+(M<3)<>-2 THEN 870
  83. 850 A=A-1
  84. 860 REM PRINTS DATES  
  85. 870 C=4+(3*A)
  86. 880 R=10
  87. 890 FOR I=1 TO O
  88. 900 M$=STR$(I)
  89. 910 FOR A=1 TO LEN(M$)
  90. 920 CALL HCHAR(R,A+C-LEN(M$),ASC(SEG$(M$,A,1)))
  91. 930 NEXT A
  92. 940 C=C+3
  93. 950 IF C<26 THEN 980
  94. 960 C=7
  95. 970 R=R+2
  96. 980 NEXT I
  97. 990 RESTORE 1170
  98. 1000 FOR A=1 TO 4
  99. 1010 READ R,C,M$
  100. 1020 GOSUB 1330
  101. 1030 NEXT A
  102. 1040 CALL KEY(0,A,S)
  103. 1050 IF (S=0)+(A<49)+(A>52)<0 THEN 1040
  104. 1060 ON A-48 GOTO 1200,1070,1120,240
  105. 1070 M=M-1
  106. 1080 IF M<>0 THEN 300
  107. 1090 M=12
  108. 1100 Y=Y-1
  109. 1110 GOTO 300
  110. 1120 M=M+1
  111. 1130 IF M<13 THEN 300
  112. 1140 M=1
  113. 1150 Y=Y+1
  114. 1160 GOTO 300
  115. 1170 DATA 2,3,TYPE 1 FOR PRINTED COPY,22,3,TYPE 2 FOR PREVIOUS MONTH,23,3,TYPE 3
  116.  FOR FOLLOWING MONTH
  117. 1180 DATA 24,3,TYPE 4 FOR NEW SELECTION
  118. 1190 REM ******************          PRINTOUT ROUTINE 
  119. 1200 CALL HCHAR(2,1,32,32)
  120. 1210 CALL HCHAR(22,1,32,96)
  121. 1220 OPEN #1:"RS232/2.BA=4800",OUTPUT
  122. 1230 FOR I=5 TO 21
  123. 1240 M$=""
  124. 1250 FOR A=1 TO 28
  125. 1260 CALL GCHAR(I,A,Z)
  126. 1270 M$=M$&CHR$(Z)
  127. 1280 NEXT A
  128. 1290 PRINT #1:M$
  129. 1300 NEXT I
  130. 1310 CLOSE #1
  131. 1320 GOTO 990
  132. 1330 FOR I=1 TO LEN(M$)
  133. 1340 CALL HCHAR(R,C+I,ASC(SEG$(M$,I,1)))
  134. 1350 NEXT I
  135. 1360 RETURN
  136.  
  137.