Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TN9011.ZIP
Filename : POPCAL.TXT

 
Output of file : POPCAL.TXT contained in archive : TN9011.ZIP
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 ""




  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TN9011.ZIP
Filename : POPCAL.TXT

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/