home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / BOXGET.PRG < prev    next >
Encoding:
Text File  |  1991-05-01  |  5.6 KB  |  147 lines
  1. /*
  2.    Function:  BOXGET()
  3.    Author:    Greg Lief
  4.    Copyright (c) 1991 Greg Lief
  5.    Purpose:   Generic GET
  6.    For Use By AQUARIUM readers
  7.    Compile:   clipper boxget /n /w /a
  8.    Link:      rtlink /free fi boxget
  9. */
  10.  
  11. #include "box.ch"
  12.  
  13. #command DEFAULT <param> TO <value> => ;
  14.          <param> := IF(<param> == NIL, <value>, <param>)
  15.  
  16. //───── put the following user-defined command in your own header file
  17. #command BOXGET <var>             ;
  18.          PROMPT <prom>            ;
  19.          [ BOXCOLOR <boxcolor> ]  ;
  20.          [ PICTURE <pict>  ]      ;
  21.          [ VALID <valid>   ]      ;
  22.          [ COLOR <color>   ]      ;
  23.          [ ROW <row>       ]      ;
  24.          [ COLUMN <column> ]      ;
  25.          [ <norest:NORESTORE> ]   ;
  26.          [ <restall:RESTOREALL> ] ;
  27.          [ <double:DOUBLE> ]      ;
  28.                               =>  ;
  29.       BoxGet(<prom>, <row>, <column>, ;
  30.              getnew( maxrow() + 1, maxcol() + 1, ;
  31.              { | _grumpy | if(pcount() = 0, <var>, <var> := _grumpy ) }, ;
  32.              <(var)>, <pict>, <color> ), ;
  33.              <{valid}>, <boxcolor>, <.norest.>, <.restall.>, <.double.> )
  34.  
  35.  
  36. #define TEST
  37.  
  38. // the following stub program demonstrates how to use this beast
  39. // test code courtesy of Matt Amis and Don Bayne - thanks guys
  40.  
  41. #ifdef TEST
  42.  
  43. function main
  44. local nx := 0, cx := Space(6), dx := Ctod(""), cphone := "5035881815"
  45. set delimiters to "││"
  46. set delimiters on
  47. @ 0, 0, maxrow(), maxcol() box replicate(chr(2), 9)
  48. boxget nx prompt "Numeric, pic 9999 nrest r4 c0" picture "9999" ;
  49.           norestore row 4 column 0
  50. boxget nx prompt "Numeric, pic 9999, val > 20 nrest r7 c0" picture "9999" ;
  51.           valid nX > 20 norestore row 7 column 0
  52. boxget nx prompt "Numeric, pic #### nrest r10 c0" picture '####' double ;
  53.           norestore row 10 column 0
  54. boxget nx prompt "Numeric nrest r16 c0" boxcolor "+W/R" ;
  55.           color "+W/RB, +GR/N" norestore row 16 column 0
  56. boxget nx prompt "Numeric nrest r19 c0" boxcolor "+W/R" ;
  57.           norestore row 19 column 0
  58. boxget cx prompt "Character, restoreall nrest r22 c0" ;
  59.           boxcolor "*+gr/n" restoreall row 22 column 0
  60. boxget cx prompt "Character, double" double
  61. boxget cx prompt "Character, nothing"
  62. boxget dx prompt "Date, pic 99/99/99" picture "99/99/99"
  63. boxget dx prompt "Date, pic 99/99/99, not empty valid" picture "99/99/99" ;
  64.           valid (! empty(dx))
  65. boxget cx prompt "Character, this is going to be a really long message "+ ;
  66.           "that automatically gets truncated by BOXGET()" boxcolor "+gr/n"
  67. boxget cx prompt "Character, pic @!" picture "@!"
  68. boxget cx prompt "Character, pic !!!!!!" picture "!!!!!!"
  69. boxget cphone prompt "Phone #" picture "@R (999) 999-9999"
  70. return nil
  71.  
  72. #endif
  73.  
  74. #define DELIMITERPAD  if(set(_SET_DELIMITERS), 2, 0)
  75. #define TOP     nrow
  76. #define LEFT    ncol
  77. #define BOTTOM  nrow + 2
  78. #define RIGHT   ncol + len(cprompt) + 4 + getlength + DELIMITERPAD
  79.  
  80. function boxget(cprompt, nrow, ncol, oget, cvalid, cboxcolor, ;
  81.                 norestore, restall, double)
  82. static boxstack_ := {}                          // to store screen shots
  83. local x, getlength, ;
  84.       settings := { setcursor(1), ;             // old cursor size
  85.                     row(), col(), ;             // old cursor position
  86.                     setcolor(cboxcolor), ;      // old color
  87.                     set(_SET_SCOREBOARD, .f.) } // I hate SCOREBOARD!!
  88. /*
  89.   Determine length of GET variable. We do this by verifying the length of
  90.   the GET buffer.  This is necessary not only in the event that no PICTURE
  91.   clause was used, but also because we cannot always trust the PICTURE
  92.   clause (e.g., "@!" and "@R"). Note that the GET must be activated with
  93.   the setFocus() method, because the g:buffer instance variable only exists
  94.   when the GET is active.
  95. */
  96. oget:setFocus()
  97. getlength = len(oget:buffer)
  98. oget:killFocus()
  99. // truncate long prompts to fit on screen
  100. cprompt = substr(cprompt, 1, maxcol() - 4 - DELIMITERPAD - getlength)
  101. default nrow to int( maxrow() / 2)
  102. default ncol to int( maxcol() - 3 - len(cprompt) - DELIMITERPAD - ;
  103.                      getlength ) / 2
  104. // if neither NORESTORE and RESTOREALL options were specified, add the
  105. // affected portion of screen so we can restore it upon exit
  106. if ! norestore .and. ! restall
  107.    aadd(settings, savescreen(TOP, LEFT, BOTTOM, RIGHT) )
  108. else
  109.    // otherwise, add it to the box stack for restoration later (RESTOREALL)
  110.    aadd(boxstack_, { TOP, LEFT, BOTTOM, RIGHT, ;
  111.                      savescreen(TOP, LEFT, BOTTOM, RIGHT) } )
  112. endif
  113. @ TOP, LEFT, BOTTOM, RIGHT box if(double, B_DOUBLE, B_SINGLE) + ' '
  114. setpos(TOP + 1, LEFT + 2)
  115. oget:postBlock = cvalid
  116. dispout( cprompt )
  117. oget:row = row()
  118.  
  119. // if delimiters are set ON, we must display them manually
  120. // because GETNEW() does not respect the rascally things!
  121. if set(_SET_DELIMITERS)
  122.    oget:col = col() + 2
  123.    dispout(' ' + left(set(_SET_DELIMCHARS), 1) + ;
  124.            space(getlength) + right(set(_SET_DELIMCHARS), 1))
  125. else
  126.    oget:col = col() + 1
  127. endif
  128. readmodal( { oget } )
  129.  
  130. // restore all screens if RESTOREALL was specified
  131. if restall .and. ! empty(boxstack_)
  132.    for x = len(boxstack_) to 1 step -1
  133.       restscreen(boxstack_[x, 1], boxstack_[x, 2], boxstack_[x, 3], ;
  134.                  boxstack_[x, 4], boxstack_[x, 5])
  135.    next
  136.    asize(boxstack_, 0)
  137. elseif ! norestore
  138.    restscreen(TOP, LEFT, BOTTOM, RIGHT, settings[6])
  139. endif
  140.  
  141. // restore all other environmental aspects
  142. setcursor(settings[1])                  // cursor size
  143. setpos(settings[2], settings[3])        // cursor position
  144. setcolor(settings[4])                   // color setting
  145. set(_SET_SCOREBOARD, settings[5])       // argh...
  146. return nil
  147.