This article is reprinted from the November 1990 edition of
TechNotes/dBASE IV.  Due to the limitations of this media, certain
graphic elements such as screen shots, illustrations and some tables
have been omitted.  Where possible, reference to such items has been
deleted.  As a result, continuity may be compromised.  

TechNotes is a monthly publication from the Ashton-Tate Software
Support Center.  For subscription information, call 800-545-9364.

Popup Calendar
Steve Koterski

Here's a quick and easy pop-up calendar routine that can be easily
incorporated into an existing application or run from the dot prompt.
Using the Uparrow and Downarrow arrow keys, you can view previous and
subsequent months, and with PgUp and PgDn, years before and after the
current year, all without opening a database, initializing an array,
or disrupting data currently residing on-screen.

Program Execution

The routine utilizes a UDF called BlowBox2() written by Dan Madoni to
draw the exploding, shadowed box.  The location of the first date is
determined by the numeric day of the week returned by DOW() times the
number of columns per day (4), plus the distance from the left side of
the screen (47).  The succeeding date locations are parsed out by way
of two nested DO WHILE loops.  The inner looping control statement,

mcol<=71 .AND. MONTH(CTOD(mdate)) =mmonth

prevents incremental date locations from exceeding the right side of
the box and dates from exceeding the last date in the portrayed month,
and increments the print columns. 

The outer looping statement,

MONTH(CTOD(mdate)) = mmonth

prevents dates beyond the current month on row changes and increments
the row count.  An INKEY() loop traps keystrokes, allowing only
directional keys that would leave the loop to affect program
operation.  These keystrokes are then passed through a DO CASE
construct to determine the next action to take.  Special allowance was
made in the DO CASE for incrementing beyond the last month of the year
and decrementing to prior to the first month. 

Usage

To call this routine from within an application, an ON KEY LABEL
invocation would give the impression of memory residence to the
calendar. The routine's use of SAVE SCREEN guarantees the integrity of
data already on the screen and SET("ATTRIBUTES") allows returns
changes to the environment to their pre-routine settings.  

To use it from the dot prompt, you could, in your Config.db, program a
function key (I preferred F9) to "DO SMALLCAL;".  SmallCal makes no
calls to external programs, so it is very portable. 

SmallCal.prg
* Program: Smallcal.prg
* Creates and displays pop-up calendar
*
*  Set up environment
SET TALK OFF
STORE SUBSTR(SET("ATTRIBUTE"), 1, AT(",", SET("ATTRIBUTE")) - 1) ;TO
mcolor
mcolor2 = mcolor
STORE SET("ESCAPE") TO mescape
STORE SET("CENTURY") TO mcentury
SET CENTURY ON
SET ESCAPE OFF
SAVE SCREEN TO smallcal

*  Initialize memory variables

STORE DAY(DATE()) TO mday
STORE MONTH(DATE()) TO mmonth
STORE YEAR(DATE()) TO myear
STORE DTOC(DATE()) TO mdate
STORE 11 TO mrow
STORE 47 TO mcol
STORE 0 TO sel

*  Ready screen

? BOX(9, 45, 18, 74, 6)
SET COLOR OF NORMAL TO W+/GR
@ 9, 45 TO 17,74 DOUBLE COLOR W+/GR
@ 18, 46 SAY "Month:Up/Dn   Year:PgUp/PgDn" 

*  Main procedure

mdate=LTRIM(STR(mmonth)) + "/01/" + RIGHT(STR(myear), 4)
DO WHILE sel # 27                                               && Esc
                STORE 47 TO mcol
                STORE 11 TO mrow
                @ 10, 47 CLEAR TO 16,73
                @ 10, mcol SAY CMONTH(CTOD(mdate))
                @ 10, 69 SAY YEAR({&mdate}) PICT "9999"
                mcol = 47 + (DOW(CTOD(mdate)) - 1) * 4
                DO WHILE MONTH(CTOD(mdate)) = mmonth
                        DO WHILE mcol <= 71 .AND. MONTH(CTOD(mdate)) = mmonth
                                mcolor = IIF(DAY(CTOD(mdate)) = DAY(DATE()),
"GR+/B", "W+/GR")
                                @ mrow,mcol SAY DAY(CTOD(mdate)) PICT "99"
COLOR &mcolor
                                SET COLOR OF NORMAL TO W+/GR
                                mcol = mcol + 4
                                mday = mday + 1
                                mdate = DTOC(CTOD(mdate) + 1)
                        ENDDO
                        mcol = 47
                        mrow = mrow + 1
                ENDDO

                *  Trap keystroke

                STORE 0 TO sel
                DO WHILE sel = 0
                        sel = INKEY()
                        IF sel # 18 .AND. sel # 3 .AND. sel # 5 .AND. sel # 24
.AND. sel # 27
                                sel = 0
                                LOOP
                        ENDIF
                ENDDO
                DO CASE
                        CASE sel = 18                   && PgUp
                                myear = myear + 1
                        CASE sel = 3                    && PgDn
                                myear = myear - 1
                        CASE sel = 5                    && Up Arrow
                                myear = IIF(mmonth = 12, myear + 1, myear)
                                mmonth = IIF(mmonth = 12, 1, mmonth + 1)
                        CASE sel = 24                   && Dn Arrow
                                myear = IIF(mmonth = 1,myear - 1, myear)
                                mmonth = IIF(mmonth = 1, 12, mmonth - 1)
                ENDCASE
                mdate = LTRIM(STR(mmonth)) + "/01/" + RIGHT(STR(myear), 4)
ENDDO
*  Reset environment
RESTORE SCREEN FROM smallcal
RELEASE smallcal
SET ESCAPE &mescape
SET CENTURY &mcentury
SET COLOR OF NORMAL TO &mcolor2
RETURN


FUNCTION BOX
                *  Written by Dan Madoni, modified by Steve Koterski
                PARAMETERS bfrom1, bfrom2, bto1, bto2, mcolor
                DO CASE
                        CASE mcolor = 0
                                SET COLOR OF NORMAL TO w/n
                        CASE mcolor = 1
                                SET COLOR OF NORMAL TO w/b
                        CASE mcolor = 2
                                SET COLOR OF NORMAL TO w/g
                        CASE mcolor = 3
                                SET COLOR OF NORMAL TO w/bg
                        CASE mcolor = 4
                                SET COLOR OF NORMAL TO w/r
                        CASE mcolor = 5
                                SET COLOR OF NORMAL TO w/rb
                        CASE mcolor = 6
                                SET COLOR OF NORMAL TO w/gr
                        CASE mcolor = 7
                                SET COLOR OF NORMAL TO w/w
                ENDCASE
                blenofbox = ABS((bto2 - bfrom2) / 2)
                bdrawhere = bfrom2 + blenofbox
                bcntr1 = 0
                DO WHILE bcntr1 < (blenofbox - 1)
                        bcntr1 = bcntr1 + 1
                        @ (bfrom1 + 1), ((bdrawhere + 2) - bcntr1) FILL TO ;
                                (bto1 + 1), ((bdrawhere + 2) + bcntr1) COLOR
n+/n
                        @ bfrom1, (bdrawhere - bcntr1) FILL TO bto1,
(bdrawhere + bcntr1) 
                        @ bfrom1,(bdrawhere - bcntr1) CLEAR TO bto1,
(bdrawhere + bcntr1)
                ENDDO
                @ (bfrom1 + 1), (bfrom2 + 2) FILL TO (bto1 + 1),(bto2 + 2)
COLOR n+/n
                @ bfrom1, bfrom2 CLEAR TO bto1, bto2 
                SET COLOR OF NORMAL TO w+/b
RETURN ""


