home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / HELPBROW.PRG < prev    next >
Encoding:
Text File  |  1991-05-29  |  7.7 KB  |  231 lines
  1. /*
  2.    Program: HELPBROW()
  3.    System: GRUMPFISH LIBRARY
  4.    Author: Greg Lief
  5.    Copyright (c) 1988-90, Greg Lief
  6.    Clipper 5.01 Version
  7.    Compile instructions: clipper helpbrow /n/w/a
  8.  
  9.        Calls: SHADOWBOX()  (function in SHADOWBO.PRG)
  10.               ERR_MSG()    (function in ERRORMSG.PRG)
  11.  
  12.    Interactive help for data validation
  13. */
  14.  
  15. //───── begin preprocessor directives
  16.  
  17. #include "grump.ch"
  18. #include "inkey.ch"
  19.  
  20. //───── end preprocessor directives
  21.  
  22. function helpbrow(s_area, field1, head1, field2, head2, editable, ;
  23.                   boxcolor, sayrow, saycol, ntop, nleft, nbottom, nright)
  24. local oldcolor, wk_area := select(), buffer, buffer2, key, browse, column, ;
  25.       marker, searchstr, oldscore := set(_SET_SCOREBOARD, .f.), mwidth := 2, ;
  26.       oldsoftie, oldscrn, oldf10, ntoprow, nleftcol, cdescrip, msg, ;
  27.       had2open := .f., curr_var := getactive():varGet(), getlist := {}
  28. GFSaveEnv()
  29. default editable to .t.
  30. default field2 to nil
  31. //───── make sure lookup database is already open -- if not, open it!
  32. if select(s_area) == 0
  33.    if file(s_area + '.dbf')
  34.       had2open := .t.    // so we know to close the file on the way out
  35.       use (s_area) new
  36.    else
  37.       err_msg("Could not locate file " + s_area + ".dbf")
  38.       return .t.
  39.    endif
  40. else
  41.    select(select(s_area))
  42. endif
  43. //───── check for existence of index file - if none, resort to LOCATE (ugh!)
  44. if indexord() = 0
  45.    locate for fieldget(fieldpos(field1)) == curr_var
  46. else
  47.    searchstr := []     // initialize search string for use below
  48.    //───── use softseek to position record pointer at closest hit
  49.    oldsoftie := set(_SET_SOFTSEEK, .t.)
  50.    seek curr_var
  51.    set(_SET_SOFTSEEK, oldsoftie)
  52. endif
  53. if ! found()
  54.    //───── if we're at the very bottom of the file, jump up
  55.    if eof()
  56.       go top
  57.    endif
  58.    //───── shut off F10 if it is configured as a hot-key because we need it
  59.    oldf10 := setkey(K_F10, NIL)
  60.    setcursor(0)       // shut off cursor - already saved by GFSaveEnv()
  61.    /*
  62.       if we are not using an index, go back to the top
  63.       if we are using an index, we don't want to mess
  64.       with the record pointer because it is better to
  65.       leave it at the nearest matching record
  66.    */
  67.    if searchstr == NIL
  68.       go top
  69.    endif
  70.    default boxcolor to ColorSet(C_APICK_BOXOUTLINE, .T.)
  71.    //───── determine necessary width of fields/headings for box
  72.    mwidth += max(len(head1), if(type(field1) == "C", ;
  73.              len(fieldget(fieldpos(field1))), ;
  74.              len(str(fieldget(fieldpos(field1))))))
  75.    if field2 != NIL
  76.       mwidth += max(len(head2), if(type(field2) == "C", ;
  77.              len(fieldget(fieldpos(field2))), ;
  78.              len(str(fieldget(fieldpos(field1))))))
  79.    endif
  80.    /*
  81.       establish box coordinates if not passed as parameters
  82.       notice that coordinates are dynamic based upon the
  83.       width (calculated above) and # of fields in database
  84.    */
  85.    default ntop to max(6, 12 - lastrec() / 2)
  86.    default nleft to int(((maxcol() + 1) - mwidth) / 2)
  87.    default nright to nleft + mwidth
  88.    default nbottom to min(maxrow() - if(editable, 4, 3), ntop + 3 + lastrec())
  89.  
  90.    browse := TBrowseDB(ntop + 1, nleft + 1, nbottom - 1, nright - 1)
  91.    browse:headSep := "═"
  92.    browse:colorSpec := boxcolor + ',' + ColorSet(C_APICK_CURRENT, .T.)
  93.    column := TBColumnNew(head1, fieldblock(field1) )
  94.    column:width := max(len(head1), if(type(field1) == "C", ;
  95.              len(fieldget(fieldpos(field1))), ;
  96.              len(str(fieldget(fieldpos(field1))))))
  97.    browse:addColumn(column)
  98.    if field2 != NIL
  99.       column := TBColumnNew(head2, fieldblock(field2) )
  100.       column:width := max(len(head2), if(type(field2) == "C", ;
  101.              len(fieldget(fieldpos(field2))), ;
  102.              len(str(fieldget(fieldpos(field2))))))
  103.       browse:addColumn(column)
  104.    endif
  105.    oldcolor := setcolor(boxcolor)
  106.    oldscrn := savescreen(0, 0, maxrow(), maxcol())
  107.    shadowbox(ntop, nleft, nbottom, nright, 1)
  108.    nleftcol := int( (maxcol() - 62) / 2)
  109.    ntoprow := maxrow() - if(searchstr == NIL, 2, 3) - if(editable, 1, 0)
  110.    SINGLEBOX(ntoprow, nleftcol, maxrow(), maxcol() - nleftcol)
  111.    SCRNCENTER(ntoprow + 1, "Move highlight bar to desired value and " + ;
  112.                        "press Enter to select")
  113.    if editable
  114.       SCRNCENTER(row() + 1, "Press F10 to add '" + ;
  115.              if(valtype(curr_var) = "N", ltrim(str(curr_var)), curr_var) + ;
  116.              "' as a new code")
  117.    endif
  118.    if searchstr != NIL
  119.       SCRNCENTER(row() + 1, "Type first few letters to jump to desired value")
  120.    endif
  121.    do while .t.
  122.  
  123.       //───── wait for the display to stabilize, which will
  124.       //───── loop once for each row in the browse window.
  125.       //───── allow a keypress to bust out of this loop
  126.       dispbegin()
  127.       do while ! browse:stabilize() .and. (key := inkey()) = 0
  128.       enddo
  129.       dispend()
  130.  
  131.       if browse:stable
  132.          key := ginkey(0, "KEY")
  133.       endif
  134.  
  135.       //───── deal with the keypress
  136.       do case
  137.  
  138.          case key == K_UP
  139.             browse:up()
  140.  
  141.          case key == K_LEFT
  142.             browse:left()
  143.  
  144.          case key == K_RIGHT
  145.             browse:right()
  146.  
  147.          case key == K_DOWN
  148.             browse:down()
  149.  
  150.          case key == K_CTRL_PGUP
  151.             browse:goTop()
  152.  
  153.          case key == K_CTRL_PGDN
  154.             browse:goBottom()
  155.  
  156.          case key == K_PGUP .or. key == K_HOME
  157.             browse:pageUp()
  158.  
  159.          case key == K_PGDN .or. key == K_END
  160.             browse:pageDown()
  161.  
  162.          case key == K_F10 .and. field2 != NIL .and. editable
  163.             cdescrip := space(len(fieldget(fieldpos(field2))))
  164.             msg := "Enter description for code '" + ;
  165.                    if(valtype(curr_var) == "N", ;
  166.                    ltrim(str(curr_var)), curr_var) + "'"
  167.             nleftcol := int((maxcol() - len(msg) - len(cdescrip) - 2) / 2)
  168.             buffer2 := ShadowBox(11, nleftcol, 13, maxcol() - nleftcol, 2)
  169.             @ 12, nleftcol + 1 ssay msg
  170.             @ row(), col() + 1 get cdescrip
  171.             setcursor(2)
  172.             read
  173.             setcursor(0)
  174.             ByeByeBox(buffer2)
  175.             if ! empty(cdescrip)
  176.                append blank
  177.                if ! neterr()
  178.                   fieldput(fieldpos(field1), curr_var)
  179.                   fieldput(fieldpos(field2), cdescrip)
  180.                else
  181.                   err_msg(NETERR_MSG)
  182.                endif
  183.                exit
  184.             endif
  185.  
  186.          case key == K_ENTER
  187.             getactive():varPut(fieldget(fieldpos(field1)))
  188.             exit
  189.  
  190.          case ( key > 31 .and. key < 255 ) .and. searchstr != NIL   // search
  191.             marker := recno()
  192.             seek searchstr + chr(key)
  193.             if eof()
  194.                go marker
  195.             else
  196.                searchstr += CHR(key)
  197.                browse:refreshAll()
  198.             endif
  199.  
  200.          case key == K_BS .and. searchstr != NIL   // truncate search string
  201.             if len(searchstr) > 0
  202.                searchstr := substr(searchstr, 1, len(searchstr) - 1)
  203.                seek searchstr
  204.                browse:refreshAll()
  205.             endif
  206.  
  207.       endcase
  208.    enddo
  209.    setkey(K_F10, oldf10)   // reset F10 keypress to its previous setting
  210.    setcolor(oldcolor)
  211.    restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  212. endif
  213. //───── display look-up description if you asked for it
  214. if sayrow != NIL .and. saycol != NIL
  215.    @ sayrow, saycol ssay fieldget(fieldpos(field2))
  216. endif
  217. //───── close lookup database if we had to open it
  218. if had2open
  219.    use
  220. endif
  221. //───── clean up
  222. select(wk_area)
  223. set(_SET_SCOREBOARD, oldscore)
  224. GFRestEnv()
  225. return .t.   // always a happy ending (sniffle...)
  226.  
  227. * end function HelpBrow()
  228. *--------------------------------------------------------------------*
  229.  
  230. * eof helpbrow.prg
  231.