home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
clockcal.zip
/
CALENDR2.PRG
< prev
next >
Wrap
Text File
|
1991-01-26
|
2KB
|
83 lines
*** CALENDR2.prg
*
* (c) CTS, MRI 1990
*
*=- Print a calendar for the current month
*
* an array will be used to hold the days of the month. It will
* be 42 elements in size to compensate for the potential of any
* calendar covering 6 partial weeks. The calendar's form is:
*
* Sun Mon Tue Wed Thu Fri Sat
* week 1 xx xx xx xx xx xx xx
* week 2 xx xx xx xx xx xx xx
* week 3 xx xx xx xx xx xx xx
* week 4 xx xx xx xx xx xx xx
* week 5 xx xx xx xx xx xx xx
* week 6 xx xx xx xx xx xx xx
*
* the first and last week may have several spaces blank
*
*=-
DECL x[42,1]
mTALK=SET("TALK")='ON'
SET TALK OFF
y=1
*
*=- Fill array with spaces
*
DO WHILE y<43
x[y,1]=SPACE(2)
y=y+1
ENDDO
*
*=- Get first day of month
*
xSTDAY=DATE()-DAY(DATE())+1
*
*=- Get the first subscript element to use for fill the array
*
y=DOW(xSTDAY)
*
*=- used for filling the subscript of the month
*
xMONTH=MONTH(DATE())
DO WHILE .T.
IF MONTH(xSTDAY)=xMONTH
x[y,1]=STR(DAY(xSTDAY),2)
y=y+1
xSTDAY=xSTDAY+1
ELSE
EXIT
ENDIF
ENDDO
*
*=- Print the calendar
*
@1,12 SAY TRAN(CMONTH(DATE()),"@R X X X X X X X X X")
@2,22 SAY YEAR(DATE())
@3,5 to 11,33
@4,6 SAY 'Sun Mon Tue Wen Thu Fri Sat'
a=1
y=5
z=7
b=1
DO WHILE A<43
*=- Print 7 subscripts (a row of any week)
DO WHILE B<8
@y,z SAY x[a,1]
a=a+1
b=b+1
z=z+4
ENDDO
b=1
y=y+1
z=7
ENDDO
IF mTALK
SET TALK ON
ENDIF
RETURN
*** End of CALENDR2.prg
*