home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / nfsrc21.zip / AREDIT.PRG < prev    next >
Text File  |  1991-08-16  |  11KB  |  309 lines
  1. /*
  2.  * File......: ArEdit.prg
  3.  * Author....: James J. Orlowski, M.D.
  4.  * CIS ID....: 72707,601
  5.  * Date......: $Date:   15 Aug 1991 23:05:56  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/aredit.prv  $
  8.  * 
  9.  * 
  10.  * Modification history:
  11.  * ---------------------
  12.  *
  13.  * $Log:   E:/nanfor/src/aredit.prv  $
  14.  * 
  15.  *    Rev 1.2   15 Aug 1991 23:05:56   GLENN
  16.  * Forest Belt proofread/edited/cleaned up doc
  17.  * 
  18.  *    Rev 1.1   12 Jun 1991 00:42:38   GLENN
  19.  * A referee suggested changing the documentation such that the return value
  20.  * is shown as "xElement" rather than "cElement" because the function 
  21.  * can return different types.
  22.  * 
  23.  *    Rev 1.0   07 Jun 1991 23:03:24   GLENN
  24.  * Initial revision.
  25.  *
  26.  *
  27.  */
  28.  
  29.  
  30.  
  31. /*
  32.  
  33.     Some notes:
  34.  
  35.        The tbmethods section is a short cut from Spence's book instead
  36.        of using the longer DO CASE method.
  37.        
  38.        Jim Gale showed me the basic array browser and Robert DiFalco
  39.        showed me the improved  skipblock in public messages on Nanforum.
  40.  
  41.        I added the functionality of the "Edit Get" code block
  42.        (ie bGetFunc), TestGet() demo, and the add/delete rows.
  43.  
  44. */
  45.  
  46.  
  47. /*  $DOC$
  48.  *  $FUNCNAME$
  49.  *     FT_AREDIT()
  50.  *  $CATEGORY$
  51.  *     Array
  52.  *  $ONELINER$
  53.  *     2 dimensional array editing function using TBrowse
  54.  *  $SYNTAX$
  55.  *     FT_AREDIT( <nTop>, <nLeft>, <nBottom>, <nRight>, <Array Name>, ;
  56.  *        <nElem>, <aHeadings>, <aBlocks> [, <bGetFunc> ] ) -> xElement
  57.  *  $ARGUMENTS$
  58.  *     <nTop>, <nLeft>, <nBottom>, <nRight> are coordinates for TBrowse
  59.  *
  60.  *     <Array Name> is name of 2 dimensional to array edit
  61.  *
  62.  *     <nElem>      is pointer for element in array
  63.  *
  64.  *     <aHeadings>  is array of column headings
  65.  *
  66.  *     <aBlocks>    is array of blocks describing each array element
  67.  *
  68.  *     [ <bGetFunc> ] is get editing function for handling individual elements
  69.  *  $RETURNS$
  70.  *     Value of element positioned on when exit FT_AREDIT()
  71.  *     The type of this value depends on what is displayed.
  72.  *  $DESCRIPTION$
  73.  *     This function allows you to position yourself in an array, 
  74.  *     add and delete rows with the <F7> and <F8> keys, 
  75.  *     and pass a UDF with information to edit the individual gets.
  76.  *  $EXAMPLES$
  77.  *      FT_AREDIT(3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks)
  78.  *
  79.  *      This example will allow you to browse a 2 dimensional array
  80.  *      But you can't edit it since there is no GetBlock UDF
  81.  *      It allows the user to hit ENTER to select an element or ESC to
  82.  *      return 0
  83.  *
  84.  *      * This second example shows how to edit a 2 dimensional array 
  85.  *      * as might be done to edit an invoice
  86.  *
  87.  *            LOCAL i, ar[3, 26], aBlocks[3], aHeadings[3]
  88.  *            LOCAL nElem := 1, bGetFunc
  89.  *
  90.  *      * Set up two dimensional array "ar"
  91.  *
  92.  *            FOR i = 1 TO 26
  93.  *               ar[1, i] := i          //  1  ->  26  Numeric
  94.  *               ar[2, i] := CHR(i+64)  // "A" -> "Z"  Character
  95.  *               ar[3, i] := CHR(91-i)  // "Z" -> "A"  Character
  96.  *             NEXT i
  97.  *
  98.  *      * SET UP aHeadings Array for column headings
  99.  *
  100.  *            aHeadings  := { "Numbers", "Letters", "Reverse" }
  101.  *
  102.  *      * Need to set up individual array blocks for each TBrowse column
  103.  *
  104.  *        aBlocks[1] := {|| STR(ar[1, nElem], 2) } // prevent default 10 spaces
  105.  *        aBlocks[2] := {|| ar[2, nElem] }
  106.  *        aBlocks[3] := {|| ar[3, nElem] }
  107.  *
  108.  *      * set up TestGet() as the passed Get Function so FT_ArEdit knows how
  109.  *      * to edit the individual gets.
  110.  *
  111.  *        bGetFunc   := { | b, ar, nDim, nElem | TestGet(b, ar, nDim, nElem) }
  112.  *        SetColor( "N/W, W/N, , , W/N" )
  113.  *        CLEAR SCREEN
  114.  *        FT_AREDIT(3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks, bGetFunc)
  115.  *
  116.  *  $END$
  117.  */
  118.  
  119. #include "inkey.ch"
  120.  
  121. * Default heading, column, footer separators
  122. #define DEF_HSEP    "═╤═"
  123. #define DEF_CSEP    " │ "
  124. #define DEF_FSEP    "═╧═"
  125.  
  126. * Default info for tb_methods section
  127. #define KEY_ELEM 1
  128. #define BLK_ELEM 2
  129.  
  130. #ifdef FT_TEST
  131.    PROCEDURE Test
  132.       * Thanks to Jim Gale for helping me understand the basics
  133.       LOCAL i, ar[3, 26], aBlocks[3], aHeadings[3], nElem := 1, bGetFunc, cRet
  134.       * set up 2 dimensional array ar[]
  135.       FOR i = 1 TO 26
  136.          ar[1, i] := i          //  1  ->  26  Numeric
  137.          ar[2, i] := CHR(i+64)  // "A" -> "Z"  Character
  138.          ar[3, i] := CHR(91-i)  // "Z" -> "A"  Character
  139.       NEXT i
  140.       * Set Up aHeadings[] for column headings
  141.       aHeadings  := { "Numbers", "Letters", "Reverse" }
  142.       * Set Up Blocks Describing Individual Elements in Array ar[]
  143.       aBlocks[1] := {|| STR(ar[1, nElem], 2)}  // to prevent default 10 spaces
  144.       aBlocks[2] := {|| ar[2, nElem]}
  145.       aBlocks[3] := {|| ar[3, nElem]}
  146.       * Set up TestGet() as bGetFunc
  147.       bGetFunc   := {|b, ar, nDim, nElem|TestGet(b, ar, nDim, nElem)}
  148.    
  149.       SET SCOREBOARD OFF
  150.       SetColor( "W/N")
  151.       CLEAR SCREEN
  152.       @ 21,4 SAY "Use Cursor Keys To Move Between Fields, <F7> = Delete Row, <F8> = Add Row"
  153.       @ 22,7 SAY "<ESC> = Quit Array Edit, <Enter> or <Any Other Key> Edits Element"
  154.       SetColor( "N/W, W/N, , , W/N" )
  155.       cRet := FT_ArEdit(3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks, bGetFunc)
  156.       SetColor( "W/N")
  157.       CLEAR SCREEN
  158.       ? cRet
  159.       ? "Lastkey() = ESC:", LASTKEY() == K_ESC
  160.    RETURN
  161.    
  162.    FUNCTION TestGet( b, ar, nDim, nElem)
  163.       LOCAL GetList   := {}
  164.       LOCAL nRow      := ROW()
  165.       LOCAL nCol      := COL()
  166.       LOCAL cSaveScrn := SAVESCREEN(21, 0, 22, MaxCol())
  167.       LOCAL cOldColor := SetColor( "W/N")
  168.       @ 21, 0 CLEAR TO 22, MaxCol()
  169.       @ 21,29 SAY "Editing Array Element"
  170.       SetColor(cOldColor)
  171.       DO CASE
  172.          CASE nDim == 1
  173.             @ nRow, nCol GET ar[1, nElem] PICTURE "99"
  174.             READ
  175.             b:refreshAll()
  176.          CASE nDim == 2
  177.             @ nRow, nCol GET ar[2, nElem] PICTURE "!"
  178.             READ
  179.             b:refreshAll()
  180.          CASE nDim == 3
  181.             @ nRow, nCol GET ar[3, nElem] PICTURE "!"
  182.             READ
  183.             b:refreshAll()
  184.       ENDCASE
  185.       RESTSCREEN(21, 0, 22, MaxCol(), cSaveScrn)
  186.       @ nRow, nCol SAY ""
  187.    RETURN(.t.)
  188. #endif
  189.  
  190. FUNCTION FT_ArEdit( nTop, nLeft, nBot, nRight, ;
  191.                    ar, nElem, aHeadings, aBlocks, bGetFunc)
  192.    * ANYTYPE[]   ar        - Array to browse
  193.    * NUMERIC     nElem     - Element In Array
  194.    * CHARACTER[] aHeadings - Array of Headings for each column
  195.    * BLOCK[]     aBlocks   - Array containing code block for each column.
  196.    * CODE BLOCK  bGetFunc  - Code Block For Special Get Processing
  197.    *  NOTE: When evaluated a code block is passed the array element to
  198.    *          be edited
  199.                    
  200.    LOCAL exit_requested := .F., nKey, meth_no, ;
  201.          cSaveWin, i, b, column
  202.    LOCAL nDim, nWorkRow, cType, cVal
  203.    LOCAL tb_methods := ;
  204.          { ;
  205.            {K_DOWN,       {|b| b:down()}}, ;
  206.            {K_UP,         {|b| b:up()}}, ;
  207.            {K_PGDN,       {|b| b:pagedown()}}, ;
  208.            {K_PGUP,       {|b| b:pageup()}}, ;
  209.            {K_CTRL_PGUP,  {|b| b:gotop()}}, ;
  210.            {K_CTRL_PGDN,  {|b| b:gobottom()}}, ;
  211.            {K_RIGHT,      {|b| b:right()}}, ;
  212.            {K_LEFT,       {|b| b:left()}}, ;
  213.            {K_HOME,       {|b| b:home()}}, ;
  214.            {K_END,        {|b| b:end()}}, ;
  215.            {K_CTRL_LEFT,  {|b| b:panleft()}}, ;
  216.            {K_CTRL_RIGHT, {|b| b:panright()}}, ;
  217.            {K_CTRL_HOME,  {|b| b:panhome()}}, ;
  218.            {K_CTRL_END,   {|b| b:panend()}} ;
  219.          }
  220.  
  221.    cSaveWin := SaveScreen(nTop, nLeft, nBot, nRight)
  222.    @ nTop, nLeft TO nBot, nRight
  223.  
  224.    b := TBrowseNew(nTop + 1, nLeft + 1, nBot - 1, nRight - 1)
  225.    b:headsep := DEF_HSEP
  226.    b:colsep  := DEF_CSEP
  227.    b:footsep := DEF_FSEP
  228.  
  229.    b:gotopblock    := {|| nElem := 1}
  230.    b:gobottomblock := {|| nElem := LEN(ar[1])}
  231.  
  232.    * skipblock originally coded by Robert DiFalco
  233.    b:SkipBlock     := {|nSkip, nStart| nStart := nElem,;
  234.       nElem := MAX( 1, MIN( LEN(ar[1]), nElem + nSkip ) ),;
  235.       nElem - nStart }
  236.  
  237.    FOR i = 1 TO LEN(aBlocks)
  238.        column := TBColumnNew(aHeadings[i], aBlocks[i] )
  239.        b:addcolumn(column)
  240.    NEXT
  241.  
  242.    exit_requested = .F.
  243.    DO WHILE !exit_requested
  244.  
  245.       DO WHILE NEXTKEY() == 0 .AND. !b:stabilize()
  246.       ENDDO
  247.  
  248.       nKey := INKEY(0)
  249.  
  250.       meth_no := ASCAN(tb_methods, {|elem| nKey = elem[KEY_ELEM]})
  251.       IF meth_no != 0
  252.           EVAL(tb_methods[meth_no, BLK_ELEM], b)
  253.       ELSE
  254.           DO CASE
  255.               CASE nKey == K_F7
  256.                   FOR nDim = 1 TO LEN(ar)
  257.                      ADEL(ar[nDim], nElem)
  258.                      ASIZE(ar[nDim], LEN(ar[nDim]) - 1)
  259.                   NEXT
  260.                   b:refreshAll()
  261.  
  262.               CASE nKey == K_F8
  263.                   FOR nDim = 1 TO LEN(ar)
  264.                      * check valtype of current element before AINS()
  265.                      cType := VALTYPE(ar[nDim, nElem])
  266.                      cVal  := ar[nDim, nElem]
  267.                      ASIZE(ar[nDim], LEN(ar[nDim]) + 1)
  268.                      AINS(ar[nDim], nElem)
  269.                      IF cType == "C"
  270.                         ar[nDim, nElem] := SPACE(LEN(cVal))
  271.                      ELSEIF cType == "N"
  272.                         ar[nDim, nElem] := 0
  273.                      ELSEIF cType == "L"
  274.                         ar[nDim, nElem] := .f.
  275.                      ELSEIF cType == "D"
  276.                         ar[nDim, nElem] := CTOD("  /  /  ")
  277.                      ENDIF
  278.                   NEXT
  279.                   b:refreshAll()
  280.  
  281.               CASE nKey == K_ESC
  282.                   exit_requested := .T.
  283.  
  284.               * Other exception handling ...
  285.               CASE VALTYPE(bGetFunc) == "B"
  286.                  IF nKey <> K_ENTER
  287.                     * want last key to be part of GET edit so KEYBOARD it
  288.                     KEYBOARD CHR(LASTKEY())
  289.                  ENDIF
  290.                  EVAL(bGetFunc, b, ar, b:colPos, nElem )
  291.                  * after get move to next field
  292.                  KEYBOARD IF(b:colPos < b:colCount, ;
  293.                               CHR(K_RIGHT), CHR(K_HOME) + CHR(K_DOWN) )
  294.  
  295.               * Placing K_ENTER here below Edit Block (i.e. bGetFunc) 
  296.               * defaults K_ENTER to Edit when bGetFunc Is Present
  297.               * BUT if no bGetFunc, then K_ENTER selects element to return
  298.               CASE nKey == K_ENTER
  299.                   exit_requested := .T.
  300.  
  301.           ENDCASE
  302.       ENDIF // meth_no != 0
  303.    ENDDO // WHILE !exit_requested
  304.    RestScreen(nTop, nLeft, nBot, nRight, cSaveWin)
  305.    * if no bGetFunc then ESC returns 0, otherwise return value of last element
  306. RETURN IF( VALTYPE(bGetFunc) == NIL .AND. nKey == K_ESC, ;
  307.            0, ar[b:colPos, nElem] )
  308. * EOFcn FT_ArEdit()
  309.