home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / clockcal.zip / CALENDR2.PRG < prev    next >
Text File  |  1991-01-26  |  2KB  |  83 lines
  1. *** CALENDR2.prg
  2. *
  3. *  (c) CTS, MRI 1990
  4. *
  5. *=-  Print a calendar for the current month
  6. *
  7. *      an array will be used to hold the days of the month.  It will
  8. *      be 42 elements in size to compensate for the potential of any
  9. *      calendar covering 6 partial weeks.  The calendar's form is:
  10. *
  11. *                   Sun Mon Tue Wed Thu Fri Sat
  12. *         week 1     xx  xx  xx  xx  xx  xx  xx
  13. *         week 2     xx  xx  xx  xx  xx  xx  xx
  14. *         week 3     xx  xx  xx  xx  xx  xx  xx
  15. *         week 4     xx  xx  xx  xx  xx  xx  xx
  16. *         week 5     xx  xx  xx  xx  xx  xx  xx
  17. *         week 6     xx  xx  xx  xx  xx  xx  xx
  18. *
  19. *     the first and last week may have several spaces blank
  20. *
  21. *=-
  22. DECL x[42,1]
  23. mTALK=SET("TALK")='ON'
  24. SET TALK OFF
  25. y=1
  26. *
  27. *=-  Fill array with spaces
  28. *
  29. DO WHILE y<43
  30.     x[y,1]=SPACE(2)
  31.     y=y+1
  32. ENDDO
  33. *
  34. *=-  Get first day of month
  35. *
  36. xSTDAY=DATE()-DAY(DATE())+1
  37. *
  38. *=-  Get the first subscript element to use for fill the array
  39. *
  40. y=DOW(xSTDAY)
  41. *
  42. *=- used for filling the subscript of the month
  43. *
  44. xMONTH=MONTH(DATE())
  45. DO WHILE .T.
  46.   IF MONTH(xSTDAY)=xMONTH
  47.     x[y,1]=STR(DAY(xSTDAY),2)
  48.     y=y+1
  49.     xSTDAY=xSTDAY+1
  50.   ELSE
  51.     EXIT
  52.   ENDIF
  53. ENDDO
  54. *
  55. *=- Print the calendar
  56. *
  57. @1,12 SAY TRAN(CMONTH(DATE()),"@R X X X X X X X X X")
  58. @2,22 SAY YEAR(DATE())
  59. @3,5 to 11,33
  60. @4,6 SAY 'Sun Mon Tue Wen Thu Fri Sat'
  61. a=1
  62. y=5
  63. z=7
  64. b=1
  65. DO WHILE A<43
  66.     *=- Print 7 subscripts (a row of any week)
  67.     DO WHILE B<8
  68.         @y,z SAY x[a,1]
  69.         a=a+1
  70.         b=b+1
  71.         z=z+4
  72.     ENDDO
  73.     b=1
  74.     y=y+1
  75.     z=7
  76. ENDDO
  77. IF mTALK
  78.   SET TALK ON
  79. ENDIF
  80. RETURN
  81. *** End of CALENDR2.prg
  82. *
  83.