home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a066 / 1.img / DBROWSE.PRG < prev    next >
Encoding:
Text File  |  1992-03-20  |  7.2 KB  |  324 lines
  1. /*
  2.         dbrowse.prg
  3.  
  4.         Adapted from Nantucket's sample TBDEMO.PRG.
  5.  
  6.         Demonstrates inheriting from Clipper's predefined classes,
  7.         in this case TBROWSE.
  8.  
  9.         Portions copyright Nantucket Corp.
  10. */
  11.  
  12. #include "class(y).ch"
  13. #include "inkey.ch"
  14. #include "setcurs.ch"
  15.  
  16.  
  17. create class dBrowse from TBrowse
  18.     instvar appendMode
  19.  
  20. export:
  21.     method  autoFields
  22.     method  exec
  23.  
  24.     method  goBottom
  25.     method  goTop
  26.     method  skipper
  27.     method  editCell
  28.     method  doGet
  29. endclass
  30.  
  31.  
  32. constructor new (nTop, nLeft, nBottom, nRight), (nTop, nLeft, nBottom, nRight)
  33.     ::headSep := "═╤═"
  34.     ::colSep  := " │ "
  35.  
  36.     // just to prove that these are no longer necessary...
  37.     ::goBottomBlock := NIL
  38.     ::goTopBlock    := NIL
  39.  
  40.     // the skipBlock is still necessary, since there is no skip method.
  41.     ::skipBlock := {|x| ::skipper(x) }
  42.  
  43.     // the caller might want to change this, and is free to do so
  44.     // especially on a monochrome screen
  45.     ::colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R"
  46. return
  47.  
  48.  
  49. /*
  50.     :autoFields
  51.  
  52.     add a column for each field in the current workarea
  53. */
  54.  
  55. method procedure autoFields
  56.     local n, cType
  57.  
  58.     // add a column for recno()
  59.     local column := TBColumn():new( "  Rec #", {|| Recno()} )
  60.     ::addColumn(column)
  61.  
  62.     for n = 1 to FCount()
  63.  
  64.         // make the new column
  65.         column := TBColumn():new(  FieldName(n), ;
  66.                                 FieldWBlock(FieldName(n), Select()) )
  67.  
  68.         // evaluate the block once to get the field's data type
  69.         cType := valtype(eval(column:block))
  70.  
  71.         // if numeric, use a color block to highlight negative values */
  72.         if cType == "N"
  73.             column:defColor := {5, 6}
  74.             column:colorBlock := {|x| if( x < 0, {7, 8}, {5, 6} )}
  75.         else
  76.             column:defColor := {3, 4}
  77.         end
  78.  
  79.         ::addColumn(column)
  80.     next
  81. return
  82.  
  83.  
  84. method procedure goBottom
  85.     go bottom
  86.     skip ::rowPos - ::rowCount
  87.     ::rowPos := ::rowCount
  88.     ::refreshAll()
  89. return
  90.  
  91.  
  92. method procedure goTop
  93.     go top
  94.     ::rowPos := 1
  95.     ::refreshAll()
  96. return
  97.  
  98.  
  99. method procedure exec
  100.     local nKey
  101.     local nCursSave := SetCursor(0)
  102.     local lMore := .t.
  103.  
  104.     ::appendMode := .f.
  105.  
  106.     while lMore
  107.         // don't allow cursor to move into frozen columns
  108.         if ::colPos <= ::freeze
  109.             ::colPos := ::freeze + 1
  110.         end
  111.  
  112.         // stabilize the display
  113.         while !::stabilize()
  114.             nKey := inkey()
  115.             if nKey <> 0
  116.                 exit            // abort if a key is waiting
  117.             end
  118.         end
  119.  
  120.         if ::stable
  121.             // display is stable
  122.             if ::hitBottom .and. !::appendMode
  123.                 // banged against EOF; go into append mode
  124.                 ::appendMode := .t.
  125.                 nKey := K_DOWN
  126.             else
  127.                 if ::hitTop .or. ::hitBottom
  128.                     Tone(125, 0)
  129.                 end
  130.  
  131.                 // Make sure that the current record is showing up-to-date
  132.                 // data in case we are on a network.
  133.                 ::refreshCurrent()
  134.                 while !::stabilize()
  135.                 end
  136.  
  137.                 // everything's done; just wait for a key
  138.                 nKey := InKey(0)
  139.             end
  140.         end
  141.  
  142.         // process key
  143.         do case
  144.         case nKey == K_DOWN
  145.             ::down()
  146.  
  147.         case nKey == K_UP
  148.             ::up()
  149.  
  150.             if ::appendMode
  151.                 ::appendMode := .f.
  152.                 ::refreshAll()
  153.             end
  154.  
  155.         case nKey == K_PGDN
  156.             ::pageDown()
  157.  
  158.         case nKey == K_PGUP
  159.             ::pageUp()
  160.             if ::appendMode
  161.                 ::appendMode := .f.
  162.                 ::refreshAll()
  163.             end
  164.  
  165.         case nKey == K_CTRL_PGUP
  166.             ::goTop()
  167.             ::appendMode := .f.
  168.  
  169.         case nKey == K_CTRL_PGDN
  170.             ::goBottom()
  171.             ::appendMode := .f.
  172.  
  173.         case nKey == K_RIGHT
  174.             ::right()
  175.  
  176.         case nKey == K_LEFT
  177.             ::left()
  178.  
  179.         case nKey == K_HOME
  180.             ::home()
  181.  
  182.         case nKey == K_END
  183.             ::end()
  184.  
  185.         case nKey == K_CTRL_LEFT
  186.             ::panLeft()
  187.  
  188.         case nKey == K_CTRL_RIGHT
  189.             ::panRight()
  190.  
  191.         case nKey == K_CTRL_HOME
  192.             ::panHome()
  193.  
  194.         case nKey == K_CTRL_END
  195.             ::panEnd()
  196.  
  197.         case nKey == K_ESC
  198.             lMore := .f.
  199.  
  200.         case nKey == K_RETURN
  201.             ::editCell()
  202.  
  203.         otherwise
  204.             keyboard chr(nKey)
  205.             ::editCell()
  206.         end
  207.     end
  208.     SetCursor(nCursSave)
  209. return
  210.  
  211.  
  212. /*
  213.     :skipper
  214. */
  215.  
  216. method function skipper(n)
  217.     local i := 0
  218.  
  219.     if lastrec() <> 0
  220.         if n == 0
  221.             skip 0
  222.         elseif n > 0 .and. recno() <> lastrec() + 1
  223.             while i < n
  224.                 skip 1
  225.                 if eof()
  226.                     if ::appendMode
  227.                         i++
  228.                     else
  229.                         skip -1
  230.                     end
  231.                     exit
  232.                 end
  233.                 i++
  234.             end
  235.         elseif n < 0
  236.             while i > n
  237.                 skip -1
  238.                 if bof()
  239.                     exit
  240.                 end
  241.                 i--
  242.             end
  243.         end
  244.     end
  245. return i
  246.  
  247.  
  248. method procedure editCell
  249.     // Save pertinent info about current record
  250.     local xKeyVal := if(empty(indexkey()), nil, &(indexkey()))
  251.     local nRec    := recno()
  252.  
  253.     ::doGet()
  254.     ::appendMode := .F.
  255.  
  256.     if empty(indexkey()) .or. (xKeyVal == &(indexkey()))
  257.         // make sure browse is correctly updated
  258.         ::refreshCurrent()
  259.     else
  260.         // record may have moved relative to other records
  261.         ::refreshAll()
  262.  
  263.         while !::stabilize()
  264.         end
  265.  
  266.         do while recno() <> nRec
  267.             ::up()
  268.             while !::stabilize()
  269.             end
  270.         end
  271.     end
  272. return
  273.  
  274.  
  275. method procedure doGet
  276.     local column, get, nKey
  277.  
  278.     // save state
  279.     local lScoreSave := Set(_SET_SCOREBOARD, .f.)
  280.     local lExitSave  := Set(_SET_EXIT, .t.)
  281.     local bInsSave   := SetKey(K_INS)
  282.  
  283.     // make sure browse is stable
  284.     while !::stabilize()
  285.     end
  286.  
  287.     // if confirming new record, append blank
  288.     if ::appendMode .and. recno() == lastrec() + 1
  289.         append blank
  290.     end
  291.  
  292.     // set insert key to toggle insert mode and cursor
  293.     SetKey( K_INS, ;
  294.         { || SetCursor( if(ReadInsert(!ReadInsert()), SC_NORMAL, SC_INSERT)) };
  295.           )
  296.  
  297.     // initial cursor setting
  298.     SetCursor( if(ReadInsert(), SC_INSERT, SC_NORMAL) )
  299.  
  300.     // get column object from browse
  301.     column := ::getColumn(::colPos)
  302.  
  303.     // create a corresponding GET
  304.     get := Get():new(row(), col(), column:block, column:heading,, ::colorSpec)
  305.  
  306.     // read it
  307.     ReadModal( {get} )
  308.  
  309.     // restore state
  310.     SetCursor(0)
  311.     Set(_SET_SCOREBOARD, lScoreSave)
  312.     Set(_SET_EXIT, lExitSave)
  313.     SetKey(K_INS, bInsSave)
  314.  
  315.     // check exit key from get
  316.     nKey := LastKey()
  317.     if nKey == K_UP .or. nKey == K_DOWN .or. nKey == K_PGUP .or. nKey == K_PGDN
  318.         keyboard chr(nKey)
  319.     end
  320. return
  321.  
  322.  
  323. // eof dbrowse.prg
  324.