home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / bus / month.ba < prev    next >
Text File  |  2006-10-19  |  3KB  |  73 lines
  1. 1 'MONTH.BA by Alex Jacobs 1983 as found in The Model 100 Program Book, modified by Robert Benson (06/30/92)
  2. 10 CLS:C$=CHR$(34):PRINT@82,C$"MONTH"C$" Monthly Calender  8/31/84"
  3. 20 PRINT:PRINT"  <I>nstructions <M>onth"
  4. 30 PRINT:PRINT"   Press SPACE-BAR for the main Menu":BEEP:LINE(5,5)-(234,58),1,B
  5. 40 K$=INKEY$
  6. 50 IF K$="I"OR K$="i"THEN620
  7. 60 IF K$="M"OR K$="m"THEN90
  8. 70 IF K$=CHR$(32)THEN MENU
  9. 80 GOTO40
  10. 90 CLEAR 300
  11. 100 BS$=CHR$(8)
  12. 110 RV$=CHR$(27)+"p":NV$=CHR$(27)+"q"
  13. 120 A$="Jan31Feb28Mar31Apr30May31Jun30Jul31Aug31Sep30Oct31Nov30Dec31"
  14. 130 MCUR=VAL(LEFT$(DATE$,2))
  15. 140 YCUR=VAL(RIGHT$(DATE$,2))+1900
  16. 150 DCUR=VAL(MID$(DATE$,4,2))
  17. 160 MDISP=MCUR:YDISP=YCUR:GOSUB 520
  18. 170 GOTO 260
  19. 180 CLS:PRINT:PRINT"Input Year(";RV$;YDISP;NV$;"): ";:INPUT YDISP
  20. 190 PRINT"Input Month (";RV$;MDISP;NV$;"):           ";
  21. 200 FOR K=1TO 10:PRINT BS$;:NEXT K
  22. 210 INM=MDISP
  23. 220 INPUT INM
  24. 230 IF INM>0 AND INM<13THEN 250
  25. 240 BEEP:PRINT" The month must be between 1 and 12":PRINT@0,:GOTO 190
  26. 250 MDISP=INM:GOSUB 520
  27. 260 IF M$="Feb"THEN IF YDISP/4=INT(YDISP/4)THEN DINM=29
  28. 270 IF M$="Feb"THEN IF YDISP/100=INT(YDISP/100)THEN DINM=28
  29. 280 IF M$="Feb"THEN IF YDISP/400=INT(YDISP/400)THEN DIMN=29
  30. 290 HEAD$=M$+""+STR$(YDISP)
  31. 300 IF MDISP>2THEN YEQU=YDISP:GOTO 330
  32. 310 MEQU=MDISP+13
  33. 320 YEQU=YDISP-1:GOTO 340
  34. 330 MEQU=MDISP+1
  35. 340 D=INT(365.25*YEQU)-INT(YEQU/100)+INT(YEQU/400)+INT(30.6*MEQU)-478163!
  36. 350 W=INT(7.1*(D/7-INT(D/7)))
  37. 360 CLS:PRINT@1,"A=ANY";:PRINTTAB(20-INT((LEN(HEAD$))/2));HEAD$
  38. 370 PRINT"        ";RV$;"Sun Mon Tue Wed Thu Fri Sat ";NV$
  39. 380 IF MDISP=MCUR AND YDISP=YCUR THEN TDAY=DCUR ELSE TDAY=0
  40. 390 FOR I=1TO DINM
  41. 400 IF I=TDAY THEN PRINTTAB(7+(W*4));RV$;I;NV$;:W=W+1:GOTO 420
  42. 410 PRINTTAB(7+(W*4));I;:W=W+1
  43. 420 IF W>6THEN W=0:PRINT
  44. 430 NEXT I
  45. 440 GOSUB 590
  46. 450 I$=INKEY$:IF I$=""THEN 450
  47. 460 IF I$="A" OR I$="a"THEN 180
  48. 470 IF ASC(I$)=29THEN 530
  49. 480 IF ASC(I$)=28THEN 550
  50. 490 IF ASC(I$)=30THEN 570
  51. 500 IF ASC(I$)=31THEN 580
  52. 510 IF ASC(I$)=32THEN MENU ELSE 450
  53. 520 M$=MID$(A$,(5*MDISP)-4,3):DIN M=VAL(MID$(A$,(5*MDISP)-1,2)):RETURN
  54. 530 IF MDISP=1THEN YDISP=YDISP-1:MDISP=12:ELSE MDISP=MDISP-1
  55. 540 GOSUB 520:GOTO 260
  56. 550 IF MDISP=12THEN YDISP=YDISP+1:MDISP=1:ELSE MDISP=MDISP+1
  57. 560 GOSUB 520:GOTO 260
  58. 570 YDISP=YDISP+1:GOSUB 520:GOTO 260
  59. 580 YDISP=YDISP-1:GOSUB 520:GOTO 260
  60. 590 PRINT@80," Month":PRINT" "CHR$(155)"   "CHR$(154)
  61. 600 PRINT:PRINT" Year":PRINT" "CHR$(152)"  "CHR$(153)
  62. 610 RETURN
  63. 620 BEEP:CLS:PRINT:PRINT" Press "CHR$(155)" or "CHR$(154)" to see previous/following"
  64. 630 PRINT" month. Press "CHR$(152)" or "CHR$(153)" for the same month"
  65. 640 PRINT" in previous/following year."
  66. 650 PRINT:PRINT" You can specify an individual month by"
  67. 660 PRINT" pressing "C$"A"C$". Enter a year in 4 digits":PRINT" and the month as 1 to 12."
  68. 670 X=5000:GOSUB 710
  69. 680 CLS:PRINT:PRINT" If you just press ENTER the year which":PRINT" appears in reverse video will be used,"
  70. 690 PRINT" the same is true for the month.":PRINT:PRINT" Press the SPACE-BAR for the main Menu.":PRINT
  71. 700 X=3000:GOSUB 710:CLS:GOTO 90
  72. 710 FOR Z=1 TO X:NEXT:RETURN
  73.