home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9106.ZIP / AQUARIUM next >
Encoding:
Text File  |  1991-04-30  |  4.9 KB  |  193 lines
  1. «LM0»STEVE, REMEMBER TO UPLOAD THE ACCOMPANYING LISTING TO 
  2. TELEPATH FOR JUNE: F:\MANUS\91JUN\GRUMPFIS\TELEPATH.TXT
  3.  
  4. Listing 1: The Good Housekeeper (Summer '87 code)
  5.  
  6. function ewe_dee_ef
  7.  
  8. private oldcolor, oldscrn, oldrow, oldcol
  9. oldcolor = setcolor()             && save color setting
  10. oldscrn = savescreen(0, 0, 24, 79)   && save screen contents
  11. oldrow = row()                  && save current row
  12. oldcol = col()                 && save current column 
  13. *
  14. * body of function
  15. *
  16. setcolor(oldcolor)             && restore color
  17. restscreen(0, 0, 24, 79, oldscrn)    && restore screen
  18. @ oldrow, oldcol say ''             && restore cursor position 
  19. return whatever
  20.  
  21.         ****************************
  22.  
  23. Listing 2: The Good Housekeeper (Clipper 5.0 version)
  24.  
  25. function ewe_dee_ef 
  26. SaveEnv()
  27. *
  28. * body of function
  29. *
  30. RestEnv()
  31. return whatever 
  32.  
  33.         
  34.         **********************************
  35.  
  36. Caption for Listing 3 (STEVE: we need to include these lines as
  37. comments in listing if you decide not to use a caption): 
  38. SaveEnv() lets you save the current cursor row/column/size, color, and screen; RestEnv() restores the cursor row/column/size, color, and screen. 
  39.  
  40. Listing 3:  SaveEnv() and RestEnv()
  41.  
  42. static envstack_ := {}   // stack used by SaveEnv() and RestEnv() 
  43.  
  44. /* manifest constants used by SaveEnv() and RestEnv() */ 
  45. #define ROW     1 
  46. #define COLUMN  2 
  47. #define CURSOR  3 
  48. #define COLOR   4 
  49. #define SCREEN  5 
  50.  
  51. function SaveEnv() 
  52. aadd(envstack_, { row(), col(), setcursor(), setcolor(), ;       
  53.                   savescreen(0, 0, maxrow(), maxcol()) } )  
  54. return nil 
  55.  
  56. * end of function SaveEnv() 
  57.  
  58.  
  59. function RestEnv() 
  60. local ele := len(envstack_) 
  61. /* preclude empty array, which would cause an array access error!*/
  62.  
  63. if ele > 0 
  64.    /* reset row/column position */ 
  65.    setpos(envstack_[ele, ROW], envstack_[ele, COLUMN]) 
  66.    /* reset cursor state */ 
  67.    setcursor(envstack_[ele, CURSOR]) 
  68.    /* reset color */ 
  69.    setcolor(envstack_[ele, COLOR]) 
  70.    /* restore screen */ 
  71.    restscreen(0, 0, maxrow(), maxcol(), envstack_[ele, SCREEN]) 
  72.    /* truncate array by lopping off last element */ 
  73.    asize(envstack_, ele - 1) 
  74. endif 
  75. return NIL 
  76.  
  77. * end of function RestEnv() 
  78.  
  79.         *********************************
  80.  
  81. Listing 4: A nested READ
  82.  
  83. memvar getlist // to squelch compiler warnings
  84. function main
  85. local x := 0, mdate := date() + 14
  86. cls
  87. @10,10 say "Balance: " ;
  88.        get x picture '#####. ##' valid credit(@x) 
  89. @11,10 say "Due date:"  get mdate
  90. read
  91. return nil
  92.  
  93. function credit(balance)
  94. local x := 0, getlist := {}, ;
  95.             oldscrn := savescreen(10, 40, 10, 64) 
  96. @10,40 say "Credit (if any):" ;
  97.        get x picture '#####. ##'
  98. read
  99. balance -= x   
  100.    /* subtract credit from original balance */ 
  101. restscreen(10, 40, 10, 64, oldscrn)
  102. return . t. 
  103.  
  104.         ******************************************
  105.  
  106. Caption for Listing 5: 
  107. SaveGets() saves current GETs and clears 'em out. RestGets()
  108. restores GETs.
  109.  
  110. Listing 5: SaveGets() and RestGets()
  111.  
  112. function SaveGets() 
  113. aadd(getstack_, memvar->getlist) 
  114. memvar->getlist := {} 
  115. return len(getstack_) 
  116.  
  117. * end function SaveGets() 
  118.  
  119.  
  120. function RestGets(ele) 
  121. /* use LIFO (last item in array) if no parameter was passed */ 
  122. ele = if(ele == NIL, len(getstack_), ele) 
  123.   /* preclude empty array */ 
  124. if len(getstack_) > 0 .and. ele <= len(getstack_) 
  125.    memvar->getlist := getstack_[ele] 
  126.    /* truncate length of array only if using LIFO, 
  127.             if no param passed */
  128.    if ele == len(getstack_) .and. pcount() = 0 
  129.       asize(getstack_, len(getstack_) - 1) 
  130.    endif 
  131. endif 
  132. return NIL 
  133.  
  134. * end function RestGets() 
  135.  
  136.  
  137.             *******************************************
  138.  
  139. Optional Caption for Listing 6:
  140. This sample code makes use of SaveGets() and RestGets() to save and restore three sets of GETs. 
  141.  
  142. Listing 6: Using SaveGets() and RestGets()
  143.  
  144. memvar getlist // to squelch compiler warnings
  145.  
  146. function 3setsogets
  147. local x := { 1, 2, 3, 4, 5, 6, 7, 8, 9}, y, z
  148. for z = 1 to 3
  149. for y = 1 to 3
  150. @ y * 2, 0 get x[(z - 1) * 3 + y]
  151. next
  152. gfsavegets()
  153. next
  154. cls
  155. gfrestgets(2)
  156. reget()
  157. read
  158. gfrestgets(1)
  159. reget()
  160. read
  161. gfrestgets(3)
  162. reget()
  163. read
  164. // display all values
  165. aeval(x, { | a | qout(a) } )
  166. return nil
  167.  
  168. //ReGet(): redisplay all active GETs
  169. static function reget
  170. aeval(getlist, { | get | get:display() } ) 
  171. return nil
  172.  
  173.         **********************************
  174.  
  175. Caption for Listing 7: SaveEnv2() accepts parameters to check and change cursor and color settings. 
  176.  
  177. Listing 7: SaveEnv2(): A modified SaveEnv()
  178.  
  179. #define TOP    coords[1]
  180. #define LEFT   coords[2]
  181. #define BOTTOM coords[3]
  182. #define RIGHT  coords[4]
  183.  
  184. function SaveEnv2(scrn_save, curs_size, newcolor)
  185. local coords := if(scrn_save = NIL .or. valtype(scrn_save) == "A",;                     scrn_save, { 0, 0, maxrow(), maxcol() } )
  186. aadd(envstack_, { row(), col(), setcursor(curs_size), ;
  187.      setcolor(newcolor), if(valtype(coords) = "A",;
  188.      { TOP, LEFT, BOTTOM, RIGHT,;
  189. savescreen(TOP, LEFT, BOTTOM, RIGHT) }, NIL) } )
  190.  
  191. return nil
  192.  
  193.