home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / prt / z-cal.ba < prev   
Text File  |  2006-10-19  |  2KB  |  43 lines
  1. 0 'Z-CAL.BA  Alan L. Zeichick
  2. 1 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
  3. 2 'changes in lines 24,26,32,35,38,42
  4. 3 '      24: Print wide/bold month
  5. 4 '  others: Decrease left margin
  6. 5 '
  7. 10 'Initialize the arrays
  8. 11 DIMDN$(7),MN$(12),MS(12):FORCT=1TO7:READDN$(CT):NEXTCT:DATA Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday
  9. 12 FORCT=1TO12:READMN$(CT),MS(CT):NEXTCT
  10. 13 DATA January,31,February,28,March,31,April,30,May,31,June,30,July,31,August,31,September,30,October,31,November,30,December,31
  11. 14 'Get the date and number of months
  12. 15 CLS:CALL17001:PRINT@12," Print Calendar ":CALL17006:PRINT@85,"Alan L. Zeichick
  13. 16 CALL17001:PRINT@160," Enter starting month and year (MM,YY): ":CALL17006:PRINT@255,;:INPUTMM,YY:IFYY<100THENYY=YY+1900
  14. 17 CALL17001:PRINT@160,"   How many calenders should I make?   ":CALL17006:PRINT@255,"     ";:INPUTNM:FORLP=1TONM
  15. 18 ' Calculate starting date
  16. 19 IFMM>2THENWD=365*YY+1+31*(MM-1)-INT(.4*MM+2.3)+INT(YY/4)-INT(3/4*INT((YY/100)+1)):GOTO21
  17. 20 WD=365*YY+1+31*(MM-1)+INT((YY-1)/4)-(INT(3/4*INT(((YY-1)/100)+1)))
  18. 21 WD=WD-INT(WD/7)*7:IFWD<1THENWD=7
  19. 22 DY=MS(MM):IFMM=2 ANDYY MOD4=0 ANDYY MOD100<>0THENDY=29
  20. 23 'Print the month name
  21. 24 TT$=MN$(MM)+","+STR$(YY):SP=(32-LEN(TT$))/2+10:LPRINTCHR$(27)"!"CHR$(27)"Q"TAB(SP)TT$;CHR$(27);CHR$(34);CHR$(27)"R":LPRINT:LPRINT
  22. 25 'Print day names
  23. 26 FORDC=1TO7:SP=(6-LEN(DN$(DC)))/2+1+DC*10:LPRINTTAB(SP)DN$(DC);:NEXTDC:LPRINT
  24. 27 ' Back up to Sunday and begin
  25. 28 SD=2-WD:WK=INT(((MS(MM)+WD-8)/7)+2)
  26. 29 'Repeat for each week in the month
  27. 30 FORWC=1TOWK
  28. 31 'Print the top dividing line
  29. 32 LPRINTSPACE$(8);
  30. 33 FORDC=1TO7:LPRINT"+---------";:NEXTDC:LPRINT"+"
  31. 34 ' Print the date line
  32. 35 LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"|";:IFSD>=1 ANDSD<=DYTHENLPRINTUSING"#########";SD;ELSELPRINT"         ";
  33. 36 SD=SD+1:NEXTDC:LPRINT"|"
  34. 37 'Print the day boxes
  35. 38 FORBC=1TO7:LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"|         ";:NEXTDC:LPRINT"|":NEXTBC
  36. 39 'End the each-week loop
  37. 40 NEXTWC
  38. 41 'Print the bottom dividing line
  39. 42 LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"+---------";:NEXTDC:LPRINT"+"
  40. 43 'Page eject, go to next month
  41. 44 LPRINTCHR$(12):MM=MM+1:IFMM>12THENYY=YY+1:MM=12
  42. 45 NEXTLP:MENU
  43.