home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / spec-occ.lzh / SPEC-OCC.BAS next >
Encoding:
BASIC Source File  |  1987-01-25  |  10.8 KB  |  345 lines
  1. 10 KEY OFF:CLS
  2. 20 SCREEN 0
  3. 30 WIDTH 40
  4. 40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
  5. 50 PRINT"░┌───────────────────────────────────┐░"
  6. 60 PRINT"░│                                   │░"
  7. 70 PRINT"░│            6017-A.BAS             │░"
  8. 80 PRINT"░│        SPECIAL OCCASIONS          │░"
  9. 90 PRINT"░│                                   │░"
  10. 100 PRINT"░│                                   │░"
  11. 110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF  │░"
  12. 120 PRINT"░│      ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄      │░"
  13. 130 PRINT"░│        █   █   █ █     █   █      │░"
  14. 140 PRINT"░│        █   █▄▄▄█ █     █   █      │░"
  15. 150 PRINT"░│        █   █     █     █   █      │░"
  16. 160 PRINT"░│      ▄▄█▄▄ █     █▄▄▄▄ █▄▄▄█      │░"
  17. 170 PRINT"░│                                   │░"
  18. 180 PRINT"░│      International PC Owners      │░"
  19. 190 PRINT"░│                                   │░"
  20. 200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
  21. 210 PRINT"░│                                   │░"
  22. 220 PRINT"░└───────────────────────────────────┘░"
  23. 230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
  24. 240 PRINT
  25. 250 PRINT "       PRESS ANY KEY TO CONTINUE
  26. 260 A$=INKEY$: IF A$="" THEN 260
  27. 270 WIDTH 80
  28. 280 CLS
  29. 1000 '**********************************
  30. 1010 '**                              **
  31. 1020 '**     SPECIAL OCCASIONS        **
  32. 1030 '**      by PHIL MICHITSCH       **
  33. 1040 '**                              **
  34. 1050 '**    IBM 64K, 1 DISK DRIVE     **
  35. 1060 '**      PRINTER OPTIONAL        **
  36. 1070 '**      40 COLUMN SCREEN        **
  37. 1080 '**        MONO OR COLOR         **
  38. 1090 '**     (USE MODE COMMAND        **
  39. 1100 '**      TO SWITCH BEFORE        **
  40. 1110 '**      RUNNING PROGRAM)        **
  41. 1120 '**                              **
  42. 1130 '**********************************
  43. 1140 GOSUB 3740
  44. 1150 CLS:KEY OFF:S=0
  45. 1160 COLOR 7,0:WIDTH 40
  46. 1170 FOR J= 10 TO 32
  47. 1180 LOCATE 5,J,0:PRINT CHR$ (220)
  48. 1190 NEXT J
  49. 1200 FOR J= 10 TO 32
  50. 1210 LOCATE 9,J:PRINT CHR$ (223)
  51. 1220 NEXT J
  52. 1230 FOR J= 6 TO 8
  53. 1240 LOCATE J,10:PRINT CHR$ (219)
  54. 1250 NEXT J
  55. 1260 FOR J= 6 TO 8
  56. 1270 LOCATE J,32:PRINT CHR$ (219)
  57. 1280 NEXT J
  58. 1290 COLOR 0,7
  59. 1300 LOCATE 7,13
  60. 1310 PRINT "SPECIAL OCCASIONS"
  61. 1320 COLOR 7,0
  62. 1330 FOR J= 8 TO 34
  63. 1340 LOCATE 4,J:PRINT CHR$ (176)
  64. 1350 NEXT J
  65. 1360 FOR J= 8 TO 34
  66. 1370 LOCATE 10,J:PRINT CHR$ (176)
  67. 1380 NEXT J
  68. 1390 FOR J= 5 TO 9
  69. 1400 LOCATE J,8:PRINT CHR$ (176)
  70. 1410 NEXT J
  71. 1420 FOR J= 5 TO 9
  72. 1430 LOCATE J,34:PRINT CHR$ (176)
  73. 1440 NEXT J
  74. 1450 COLOR 9,0
  75. 1460 LOCATE 12,19:PRINT "MENU"
  76. 1470 COLOR 7,0
  77. 1480 LOCATE 14,13:PRINT "1) ADD OCCASION"
  78. 1490 LOCATE 16,13:PRINT "2) DELETE OCCASION"
  79. 1500 LOCATE 18,13:PRINT "3) DISPLAY LISTING
  80. 1510 BEEP
  81. 1520 LOCATE 21,7:PRINT "PLEASE CHOOSE ENTRY 1,2 OR 3"
  82. 1530 LET X$="0"
  83. 1540 X$=INKEY$
  84. 1550 IF X$>"0" THEN 1560 ELSE 1540
  85. 1560 IF X$="1" THEN 1680
  86. 1570 IF X$="2" THEN 2080
  87. 1580 IF X$="3" THEN 2550
  88. 1590 IF X$="0" THEN 1540
  89. 1600 COLOR 25,0
  90. 1610 LOCATE 23,12:PRINT "WRONG ENTRY - RETRY"
  91. 1620 COLOR 7,0
  92. 1630 FOR X= 1 TO 1700
  93. 1640 NEXT X
  94. 1650 LOCATE 23,12 :PRINT "                      "
  95. 1660 BEEP
  96. 1670 GOTO 1530
  97. 1680 GOSUB 3670
  98. 1690 REM ROUTINE TO ADD AND SORT NEW OCCASION
  99. 1700 COLOR 9,0: LOCATE 12,15
  100. 1710 PRINT "ADD OCCASION"
  101. 1720 COLOR 7,0:LOCATE 14,1
  102. 1730 BEEP
  103. 1740 INPUT "ENTER NAME OF CELEBRANT  ",A$
  104. 1750 BEEP
  105. 1760 LOCATE 16,1,0:INPUT "ENTER MONTH OF OCCASION  ",B$
  106. 1770 FOR Y=1 TO 12
  107. 1780 IF B$=Z$(Y) THEN 1900
  108. 1790 NEXT Y
  109. 1800 FOR X=1 TO 30
  110. 1810 LOCATE 18,14,0:PRINT "THE MONTH INPUT"
  111. 1820 LOCATE 19,9 :PRINT "IS INCORRECT,PLEASE RETRY
  112. 1830 LOCATE 20,11 :PRINT "(USE CAPITAL LETTERS)"
  113. 1840 NEXT X
  114. 1850 LOCATE 18,1:PRINT"                                        "
  115. 1860 PRINT"                                        "
  116. 1870 PRINT"                                        "
  117. 1880 LOCATE 16,1,0:PRINT"                                        "
  118. 1890 GOTO 1750
  119. 1900 LOCATE 18,1,0:INPUT "ENTER DAY OF MONTH (1-31)  ",C
  120. 1910 IF C >31 OR C=0 GOTO 1930
  121. 1920 GOTO 1990
  122. 1930 FOR X= 1 TO 40:LOCATE 20,1
  123. 1940 PRINT "PLEASE USE A NUMBER BETWEEN 01-31"
  124. 1950 NEXT X
  125. 1960 LOCATE 20,1:PRINT"                                         "
  126. 1970 LOCATE 18,1:PRINT"                                        "
  127. 1980 GOTO 1900
  128. 1990 LOCATE 20,1,0:INPUT "PLEASE INPUT TYPE OF OCCASION  ",D$
  129. 2000 LOCATE 22,1,0:PRINT "A FILE WITH THIS INFO IS NOW BEING CREATED"
  130. 2010 OPEN B$ FOR APPEND AS #1
  131. 2020 WRITE#1,A$,B$,C,D$
  132. 2030 FOR X=1 TO 1000
  133. 2040 NEXT X
  134. 2050 CLOSE 1
  135. 2060 GOSUB 3670
  136. 2070 GOTO 1150
  137. 2080 GOSUB 3670
  138. 2090 LOCATE 12,12:PRINT "PLEASE ENTER BELOW"
  139. 2100 LOCATE 14,10:PRINT "THE MONTH IN WHICH THE"
  140. 2110 LOCATE 16,11:PRINT "PERSON TO BE DELETED"
  141. 2120 LOCATE 18,16:PRINT "APPEARS IN"
  142. 2130 COLOR 0,7:BEEP
  143. 2140 LOCATE 20,13,1:PRINT " MONTH ";:COLOR 7,0
  144. 2150 INPUT " ",MONTH$
  145. 2160 FOR Y=1 TO 12
  146. 2170 IF MONTH$=Z$(Y) THEN 2240
  147. 2180 NEXT Y
  148. 2190 FOR X= 1 TO 60
  149. 2200 LOCATE 22,13,0:PRINT "WRONG INPUT,RETRY"
  150. 2210 NEXT X
  151. 2220 LOCATE 22,1,0:PRINT SPC(40)
  152. 2230 GOTO 2080
  153. 2240 OPEN MONTH$ FOR INPUT AS #1
  154. 2250 DIM F$(40),G$(40),H$(40),I$(40)
  155. 2260 FOR J=1 TO 40
  156. 2270 IF EOF(1) THEN 2300
  157. 2280 INPUT #1,F$(J),G$(J),H$(J),I$(J)
  158. 2290 NEXT J
  159. 2300 GOSUB 3670
  160. 2310 LOCATE 12,6,0:PRINT "THE FOLLOWING NAMES ARE LISTED"
  161. 2320 LOCATE 13,9,0:PRINT "UNDER THE MONTH ";MONTH$
  162. 2330 IF EOF(1) AND J=1 THEN 4070
  163. 2340 CLOSE 1:L=J-1:T=15
  164. 2350 FOR K=1 TO L
  165. 2360 LOCATE (T),12,0
  166. 2370 PRINT F$(K)
  167. 2380 T=T+1
  168. 2390 NEXT K
  169. 2400 LOCATE 22,3,0:PRINT "ENTER EXACTLY AS ABOVE,THE NAME OF"
  170. 2410 LOCATE 23,8,0:PRINT "THE PERSON TO BE DELETED"
  171. 2420 LOCATE 24,10,1
  172. 2430 INPUT;N$
  173. 2440 OPEN MONTH$ FOR INPUT AS #1
  174. 2450 OPEN "TEMPOCCA" FOR OUTPUT AS #2
  175. 2460 IF EOF (1) THEN 2510
  176. 2470 INPUT#1,FF$,GG$,HH$,II$
  177. 2480 IF FF$=N$ THEN 2460
  178. 2490 WRITE#2,FF$,GG$,HH$,II$
  179. 2500 GOTO 2460
  180. 2510 CLOSE
  181. 2520 KILL MONTH$
  182. 2530 NAME "TEMPOCCA" AS MONTH$
  183. 2540 GOTO 1150
  184. 2550 REM ROUTINE TO DISPLAY/PRINT ANY MONTH/MONTHS OCCASIONS
  185. 2560 GOSUB 3670
  186. 2570 ON ERROR GOTO 3810
  187. 2580 LOCATE 12,7,0 :PRINT "PLEASE ENTER BELOW, THE MONTH "
  188. 2590 LOCATE 14,7 :PRINT "YOU WOULD LIKE TO BE DISPLAYED"
  189. 2600 LOCATE 16,14,1 :BEEP :COLOR 0,7 :PRINT " MONTH ";:COLOR 7,0:
  190. 2610 INPUT " ",E$
  191. 2620 FOR Y=1 TO 12
  192. 2630 IF E$=Z$(Y) THEN 2760
  193. 2640 NEXT Y
  194. 2650 FOR X=1 TO 30
  195. 2660 LOCATE 18,14,0 :PRINT "THE MONTH INPUT"
  196. 2670 LOCATE 19,9 :PRINT "IS INCORRECT ,PLEASE RETRY"
  197. 2680 LOCATE 20,11 :PRINT "(USE CAPITAL LETTERS)
  198. 2690 NEXT X
  199. 2700 LOCATE 18,1 :PRINT "                                                  "
  200. 2710 PRINT "                                                              "
  201. 2720 PRINT "                                                              "
  202. 2730 LOCATE 16,1,0:PRINT"                                                   "
  203. 2740 GOTO 2600
  204. 2750 N=10
  205. 2760 LOCATE 19,7 :PRINT "A FILE CONTAINING ALL THE INFO"
  206. 2770 IF LEN (E$)=3 THEN N=12
  207. 2780 IF LEN (E$)=4 THEN N=12
  208. 2790 IF LEN (E$)=5 THEN N=12
  209. 2800 IF LEN (E$)=6 THEN N=11
  210. 2810 IF LEN (E$)=7 THEN N=10
  211. 2820 IF LEN (E$)=8 THEN N=10
  212. 2830 IF LEN (E$)=9 THEN N=10
  213. 2840 LOCATE 21,N :PRINT "FOR THE MONTH "; E$
  214. 2850 LOCATE 23,10 :PRINT "IS NOW BEING PROCESSED"
  215. 2860 FOR X= 1 TO 1500
  216. 2870 NEXT X
  217. 2880 OPEN E$ FOR INPUT AS #1
  218. 2890 DIM F$(40),G$(40),H$(40),I$(40)
  219. 2900 FOR J=1 TO 40
  220. 2910 IF EOF(1) THEN 2990
  221. 2920 INPUT #1,F$(J),G$(J),H$(J),I$(J)
  222. 2930 NEXT J
  223. 2940 LOCATE 25,17,0:COLOR 26,0:PRINT "YOU HAVE EXCEEDED THE LIMITATIONS OF THIS PROGRAM"
  224. 2950 COLOR 7,0 :
  225. 2960 FOR X= 1 TO 6000
  226. 2970 NEXT X
  227. 2980 GOTO 1150
  228. 2990 IF EOF(1) AND J=1 THEN 4070
  229. 3000 CLOSE 1
  230. 3010 GOSUB 3670
  231. 3020 L=J-1
  232. 3030 M=12
  233. 3040 IF LEN (E$)=3 THEN M=19
  234. 3050 IF LEN (E$)=4 THEN M=18
  235. 3060 IF LEN (E$)=5 THEN M=17
  236. 3070 IF LEN (E$)=6 THEN M=17
  237. 3080 IF LEN (E$)=7 THEN M=17
  238. 3090 IF LEN (E$)=8 THEN M=16
  239. 3100 IF LEN (E$)=9 THEN M=16
  240. 3110 LOCATE 12,M
  241. 3120 COLOR 0,7:PRINT " ";E$;" "
  242. 3130 LOCATE 14,6 : COLOR 9,0:PRINT "NAME";
  243. 3140 LOCATE 14,21:PRINT "DATE";
  244. 3150 LOCATE 14,30:PRINT "OCCASION"
  245. 3160 COLOR 7,0
  246. 3170 LOCATE 16,1
  247. 3180 IF L > 4 THEN S=1
  248. 3190 FOR K=1 TO L
  249. 3200 PRINT F$(K);
  250. 3210 PRINT TAB(22) H$(K);
  251. 3220 PRINT TAB(30) I$(K)
  252. 3230 IF S=0 THEN PRINT
  253. 3240 NEXT K
  254. 3250 LOCATE 25,1:COLOR 15,0
  255. 3260 PRINT "F1-PRINT REPORT       F2-RETURN TO MENU";
  256. 3270 KEY(1)ON:KEY(2)ON
  257. 3280 T$=INKEY$
  258. 3290 ON KEY (1) GOSUB 3340
  259. 3300 ON KEY (2) GOSUB 3320
  260. 3310 GOTO 3280
  261. 3320 KEY (1) OFF:KEY (2) OFF
  262. 3330 GOTO 1150
  263. 3340 REM PRINT ROUTINE
  264. 3350 KEY (1) OFF:KEY (2) OFF
  265. 3360 ESC$=CHR$(27)
  266. 3370 FOR X=1 TO 10
  267. 3380 LPRINT
  268. 3390 NEXT X
  269. 3400 LPRINT ESC$"B"
  270. 3410 LPRINT ESC$"!"
  271. 3420 LPRINT ESC$"E":LPRINT ESC$"Y"
  272. 3430 LPRINT TAB(8) "***************************"
  273. 3440 LPRINT TAB(8) "* +++++++++++++++++++++++ *"
  274. 3450 LPRINT TAB(8) "* +                     + *"
  275. 3460 LPRINT TAB(8) "* +  SPECIAL OCCASIONS  + *"
  276. 3470 LPRINT TAB(8) "* +                     + *"
  277. 3480 LPRINT TAB(8) "* +++++++++++++++++++++++ *"
  278. 3490 LPRINT TAB(8) "***************************"
  279. 3500 LPRINT :LPRINT
  280. 3510 LPRINT TAB(18)ESC$"X";E$;ESC$"Y"
  281. 3520 LPRINT
  282. 3530 LPRINT SPC(4)ESC$"X";" NAME ";ESC$"Y";SPC(10)ESC$"X";" DATE ";ESC$"Y";"   ";ESC$"X";" OCCASION ";ESC$"Y"
  283. 3540 LPRINT
  284. 3550 P=J-1
  285. 3560 LPRINT
  286. 3570 FOR X= 1 TO P
  287. 3580 Z=LEN(F$(X))
  288. 3590 Y=(22 - Z)
  289. 3600 LPRINT F$(X);SPC(Y)H$(X);SPC(6)I$(X)
  290. 3610 LPRINT
  291. 3620 NEXT X
  292. 3630 FOR X= 1 TO 10
  293. 3640 LPRINT
  294. 3650 NEXT X
  295. 3660 GOTO 3270
  296. 3670 REM SUBROUTINE TO CLEAR THE SCREEN BELOW PICTURE
  297. 3680 Y$="                                           "
  298. 3690 FOR N=12 TO 23
  299. 3700 LOCATE N,1,0:PRINT Y$
  300. 3710 NEXT N
  301. 3720 RETURN
  302. 3730 PRINT"ALRIGHT"
  303. 3740 REM ROUTINE TO ASSIGN ALL THE MONTHS A STRING VAR
  304. 3750 DIM Z$(12)
  305. 3760 FOR Y=1 TO 12
  306. 3770 READ Z$(Y)
  307. 3780 NEXT Y
  308. 3790 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  309. 3800 RETURN
  310. 3810 REM ERROR ROUTINE -TRIED TO OPEN FILE THAT WAS NON-EXISTANT
  311. 3820 IF ERR=27 THEN GOTO 3970
  312. 3830 IF ERR=53 THEN GOTO 3850
  313. 3840 RESUME NEXT
  314. 3850 GOSUB 3670
  315. 3860 LOCATE 13,5,0 :PRINT "THERE IS CURRENTLY NO INFORMATION "
  316. 3870 LOCATE 15,5,0 :PRINT "IN THE FILE FOR THE MONTH ";E$
  317. 3880 LOCATE 17,5,0 :PRINT "YOU CAN MAKE AN ADDITION TO THIS"
  318. 3890 LOCATE 19,7,0 :PRINT "FILE IF YOU LIKE BY ENTERING"
  319. 3900 LOCATE 21,8,0 :PRINT "THE #1 ON THE MENU SCREEN"
  320. 3910 OPEN E$ FOR APPEND AS #1
  321. 3920 CLOSE
  322. 3930 FOR X=1 TO 80
  323. 3940 NEXT X
  324. 3950 GOSUB 3670
  325. 3960 GOTO 1450
  326. 3970 GOSUB 3670
  327. 3980 LOCATE 13,5,0 :PRINT "THE CURRENT OPERATION CANNOT BE "
  328. 3990 LOCATE 15,5,0 :PRINT "COMPLETED BECAUSE THE PRINTER IS"
  329. 4000 LOCATE 17,13,0 :PRINT "NOT OPERATIONAL"
  330. 4010 LOCATE 19,5,0 :PRINT "PLEASE RETURN PRINTER TO ON-LINE"
  331. 4020 LOCATE 21,9,0 :PRINT "BEFORE HITTING F1 AGAIN"
  332. 4030 FOR X=1 TO 3000
  333. 4040 NEXT X
  334. 4050 CLOSE 1
  335. 4060 RESUME 3010
  336. 4070 GOSUB 3670
  337. 4080 LOCATE 17,8,0 :COLOR 15,0
  338. 4090 PRINT "THIS FILE IS CURRENTLY EMPTY "
  339. 4100 FOR X=1 TO 2000
  340. 4110 NEXT X
  341. 4120 GOSUB 3670
  342. 4130 CLOSE 1
  343. 4140 GOTO 1150
  344. 4150 END
  345.