home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
dbms_mag
/
9106
/
aquarium
next >
Wrap
Text File
|
1991-04-30
|
5KB
|
193 lines
«LM0»STEVE, REMEMBER TO UPLOAD THE ACCOMPANYING LISTING TO
TELEPATH FOR JUNE: F:\MANUS\91JUN\GRUMPFIS\TELEPATH.TXT
Listing 1: The Good Housekeeper (Summer '87 code)
function ewe_dee_ef
private oldcolor, oldscrn, oldrow, oldcol
oldcolor = setcolor() && save color setting
oldscrn = savescreen(0, 0, 24, 79) && save screen contents
oldrow = row() && save current row
oldcol = col() && save current column
*
* body of function
*
setcolor(oldcolor) && restore color
restscreen(0, 0, 24, 79, oldscrn) && restore screen
@ oldrow, oldcol say '' && restore cursor position
return whatever
****************************
Listing 2: The Good Housekeeper (Clipper 5.0 version)
function ewe_dee_ef
SaveEnv()
*
* body of function
*
RestEnv()
return whatever
**********************************
Caption for Listing 3 (STEVE: we need to include these lines as
comments in listing if you decide not to use a caption):
SaveEnv() lets you save the current cursor row/column/size, color, and screen; RestEnv() restores the cursor row/column/size, color, and screen.
Listing 3: SaveEnv() and RestEnv()
static envstack_ := {} // stack used by SaveEnv() and RestEnv()
/* manifest constants used by SaveEnv() and RestEnv() */
#define ROW 1
#define COLUMN 2
#define CURSOR 3
#define COLOR 4
#define SCREEN 5
function SaveEnv()
aadd(envstack_, { row(), col(), setcursor(), setcolor(), ;
savescreen(0, 0, maxrow(), maxcol()) } )
return nil
* end of function SaveEnv()
function RestEnv()
local ele := len(envstack_)
/* preclude empty array, which would cause an array access error!*/
if ele > 0
/* reset row/column position */
setpos(envstack_[ele, ROW], envstack_[ele, COLUMN])
/* reset cursor state */
setcursor(envstack_[ele, CURSOR])
/* reset color */
setcolor(envstack_[ele, COLOR])
/* restore screen */
restscreen(0, 0, maxrow(), maxcol(), envstack_[ele, SCREEN])
/* truncate array by lopping off last element */
asize(envstack_, ele - 1)
endif
return NIL
* end of function RestEnv()
*********************************
Listing 4: A nested READ
memvar getlist // to squelch compiler warnings
function main
local x := 0, mdate := date() + 14
cls
@10,10 say "Balance: " ;
get x picture '#####. ##' valid credit(@x)
@11,10 say "Due date:" get mdate
read
return nil
function credit(balance)
local x := 0, getlist := {}, ;
oldscrn := savescreen(10, 40, 10, 64)
@10,40 say "Credit (if any):" ;
get x picture '#####. ##'
read
balance -= x
/* subtract credit from original balance */
restscreen(10, 40, 10, 64, oldscrn)
return . t.
******************************************
Caption for Listing 5:
SaveGets() saves current GETs and clears 'em out. RestGets()
restores GETs.
Listing 5: SaveGets() and RestGets()
function SaveGets()
aadd(getstack_, memvar->getlist)
memvar->getlist := {}
return len(getstack_)
* end function SaveGets()
function RestGets(ele)
/* use LIFO (last item in array) if no parameter was passed */
ele = if(ele == NIL, len(getstack_), ele)
/* preclude empty array */
if len(getstack_) > 0 .and. ele <= len(getstack_)
memvar->getlist := getstack_[ele]
/* truncate length of array only if using LIFO,
if no param passed */
if ele == len(getstack_) .and. pcount() = 0
asize(getstack_, len(getstack_) - 1)
endif
endif
return NIL
* end function RestGets()
*******************************************
Optional Caption for Listing 6:
This sample code makes use of SaveGets() and RestGets() to save and restore three sets of GETs.
Listing 6: Using SaveGets() and RestGets()
memvar getlist // to squelch compiler warnings
function 3setsogets
local x := { 1, 2, 3, 4, 5, 6, 7, 8, 9}, y, z
for z = 1 to 3
for y = 1 to 3
@ y * 2, 0 get x[(z - 1) * 3 + y]
next
gfsavegets()
next
cls
gfrestgets(2)
reget()
read
gfrestgets(1)
reget()
read
gfrestgets(3)
reget()
read
// display all values
aeval(x, { | a | qout(a) } )
return nil
//ReGet(): redisplay all active GETs
static function reget
aeval(getlist, { | get | get:display() } )
return nil
**********************************
Caption for Listing 7: SaveEnv2() accepts parameters to check and change cursor and color settings.
Listing 7: SaveEnv2(): A modified SaveEnv()
#define TOP coords[1]
#define LEFT coords[2]
#define BOTTOM coords[3]
#define RIGHT coords[4]
function SaveEnv2(scrn_save, curs_size, newcolor)
local coords := if(scrn_save = NIL .or. valtype(scrn_save) == "A",; scrn_save, { 0, 0, maxrow(), maxcol() } )
aadd(envstack_, { row(), col(), setcursor(curs_size), ;
setcolor(newcolor), if(valtype(coords) = "A",;
{ TOP, LEFT, BOTTOM, RIGHT,;
savescreen(TOP, LEFT, BOTTOM, RIGHT) }, NIL) } )
return nil