home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / BROWSE.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  9.6 KB  |  508 lines
  1. /***
  2. *    _browse.prg
  3. *
  4. *    Dennis L. Dias
  5. */
  6.  
  7. #include "inkey.ch"
  8. #include "setcurs.ch"
  9.  
  10.  
  11. // this code block will toggle insert mode and cursor
  12. static bInsToggle := {|| SetCursor( if( ReadInsert( !ReadInsert() ),;
  13.                                         SC_NORMAL, SC_INSERT        ;
  14.                                       )                                ;
  15.                                   )                                    ;
  16.                      }
  17.  
  18.  
  19. /***
  20. *    Browse([nTop, nLeft, nBottom, nRight])
  21. *
  22. *    View, add, change, delete
  23. */
  24.  
  25. func browse(nTop, nLeft, nBottom, nRight)
  26.  
  27. local oB, n, lMore, cScrSave, lAppend, lKillAppend,;
  28.       nKey, nCursSave, lGotKey, bKeyBlock
  29.  
  30.     if ( !Used() )
  31.         // no database in use
  32.         return (.f.)
  33.     end
  34.  
  35.     if ( Pcount() < 4 )
  36.         nTop := 1
  37.         nLeft := 0
  38.         nBottom := 23
  39.         nRight := 79
  40.     end
  41.  
  42.     cScrSave := saveScreen(nTop, nLeft, nBottom, nRight)
  43.  
  44.     // frame window
  45.     @ nTop, nLeft, nBottom, nRight box "╒═╕│╛═╘│"
  46.     @ nTop + 3, nLeft say "╞"
  47.     @ nTop + 3, nRight say "╡"
  48.  
  49.     // clear status row
  50.     @ nTop + 1, nLeft + 1 say Space(nRight - nLeft - 1)
  51.  
  52.     // create a TBrowse object for a database
  53.     oB := TBrowseDB(nTop + 2, nLeft + 1, nBottom - 1, nRight - 1)
  54.     oB:headSep := " ═"
  55.     oB:skipBlock := {|x| Skipped(x, lAppend)}
  56.  
  57.     // add one column for each field
  58.     for n := 1 to Fcount()
  59.         oB:addColumn(TBColumnNew(FieldName(n), FieldBlock(FieldName(n))))
  60.     next
  61.  
  62.     if ( Eof() )
  63.         go top
  64.     end
  65.  
  66.     // init
  67.     lAppend := lKillAppend := .F.
  68.     nCursSave := SetCursor(0)
  69.     while ( !oB:stabilize() ) ; end
  70.  
  71.     if ( LastRec() == 0 )
  72.         // empty file..force append mode
  73.         nKey := K_DOWN
  74.         lGotKey := .t.
  75.     else
  76.         lGotKey := .f.
  77.     end
  78.  
  79.     lMore := .t.
  80.     while (lMore)
  81.         if ( !lGotKey )
  82.             // stabilization will be interrupted by any keystroke
  83.             while ( !oB:stabilize() )
  84.                 if ( (nKey := Inkey()) != 0 )
  85.                     lGotKey := .t.
  86.                     exit
  87.                 end
  88.             end
  89.         end
  90.  
  91.         if ( !lGotKey )
  92.             // the TBrowse object is stable
  93.             if ( oB:hitBottom )
  94.                 if ( !lAppend .or. Recno() != LastRec() + 1 )
  95.                     if ( lAppend )
  96.                         // continue appending..restore color to current row
  97.                         oB:refreshCurrent()
  98.                         while ( !oB:stabilize() ) ; end
  99.  
  100.                         // ensure bottom of file without refresh
  101.                         go bottom
  102.                     else
  103.                         // begin append mode
  104.                         lAppend := .t.
  105.  
  106.                         // turn the cursor on
  107.                         SetCursor( if(ReadInsert(), SC_INSERT, SC_NORMAL) )
  108.                     end
  109.  
  110.                     // move to next row and stabilize to set rowPos
  111.                     oB:down()
  112.                     while ( !oB:stabilize() ) ; end
  113.  
  114.                     // color the row
  115.                     oB:colorRect({oB:rowPos,1,oB:rowPos,oB:colCount},{2,2})
  116.                 end
  117.             end
  118.  
  119.             // display status and stabilize again for correct cursor pos
  120.             Statline(oB, lAppend)
  121.             while ( !oB:stabilize() ) ; end
  122.  
  123.             // idle
  124.             nKey := Inkey(0)
  125.  
  126.             if ( (bKeyBlock := SetKey(nKey)) != NIL )
  127.                 // run SET KEY block
  128.                 Eval(bKeyBlock, ProcName(1), ProcLine(1), "")
  129.                 loop    // NOTE
  130.             end
  131.         else
  132.             // reset for next loop
  133.             lGotKey := .f.
  134.         end
  135.  
  136.         do case
  137.         case ( nKey == K_DOWN )
  138.             if ( lAppend )
  139.                 oB:hitBottom := .t.
  140.             else
  141.                 oB:down()
  142.             end
  143.  
  144.         case ( nKey == K_UP )
  145.             if ( lAppend )
  146.                 lKillAppend := .t.
  147.             else
  148.                 oB:up()
  149.             end
  150.  
  151.         case ( nKey == K_PGDN )
  152.             if ( lAppend )
  153.                 oB:hitBottom := .t.
  154.             else
  155.                 oB:pageDown()
  156.             end
  157.  
  158.         case ( nKey == K_PGUP )
  159.             if ( lAppend )
  160.                 lKillAppend := .t.
  161.             else
  162.                 oB:pageUp()
  163.             end
  164.  
  165.         case ( nKey == K_CTRL_PGUP )
  166.             if ( lAppend )
  167.                 lKillAppend := .t.
  168.             else
  169.                 oB:goTop()
  170.             end
  171.  
  172.         case ( nKey == K_CTRL_PGDN )
  173.             if ( lAppend )
  174.                 lKillAppend := .t.
  175.             else
  176.                 oB:goBottom()
  177.             end
  178.  
  179.         case ( nKey == K_RIGHT )
  180.             oB:right()
  181.  
  182.         case ( nKey == K_LEFT )
  183.             oB:left()
  184.  
  185.         case ( nKey == K_HOME )
  186.             oB:home()
  187.  
  188.         case ( nKey == K_END )
  189.             oB:end()
  190.  
  191.         case ( nKey == K_CTRL_LEFT )
  192.             oB:panLeft()
  193.  
  194.         case ( nKey == K_CTRL_RIGHT )
  195.             oB:panRight()
  196.  
  197.         case ( nKey == K_CTRL_HOME )
  198.             oB:panHome()
  199.  
  200.         case ( nKey == K_CTRL_END )
  201.             oB:panEnd()
  202.  
  203.         case ( nKey == K_INS )
  204.             // toggle insert mode and cursor if append mode
  205.             if ( lAppend )
  206.                 Eval(bInsToggle)
  207.             end
  208.  
  209.         case ( nKey == K_DEL )
  210.             // delete key..toggle deleted() flag
  211.             if ( Recno() != LastRec() + 1 )
  212.                 if ( Deleted() )
  213.                     recall
  214.                 else
  215.                     delete
  216.                 end
  217.             end
  218.  
  219.         case ( nKey == K_RETURN )
  220.             // edit
  221.             if ( lAppend .or. Recno() != LastRec() + 1 )
  222.                 nKey := DoGet(oB, lAppend)
  223.  
  224.                 // use returned value as next key if not zero
  225.                 lGotKey := ( nKey != 0 )
  226.             else
  227.                 // begin append mode
  228.                 nKey := K_DOWN
  229.                 lGotKey := .t.
  230.             end
  231.  
  232.         case ( nKey == K_ESC )
  233.             // exit browse
  234.             lMore := .f.
  235.  
  236.         otherwise
  237.             if ( nKey >= 32 .and. nKey <= 255 )
  238.                 // begin edit and supply the first character
  239.                 keyboard Chr(K_RETURN) + Chr(nKey)
  240.             end
  241.         end
  242.  
  243.         if ( lKillAppend )
  244.             // turn off append mode
  245.             lKillAppend := .f.
  246.             lAppend := .f.
  247.  
  248.             // refresh respecting any change in index order
  249.             FreshOrder(oB)
  250.             SetCursor(0)
  251.         end
  252.     end
  253.  
  254.     // restore
  255.     SetCursor(nCursSave)
  256.     restScreen(nTop, nLeft, nBottom, nRight, cScrSave)
  257.  
  258. return (.t.)
  259.  
  260.  
  261. /***
  262. *    DoGet()
  263. *
  264. *    Edit the current field
  265. */
  266.  
  267. static func DoGet(oB, lAppend)
  268.  
  269. local bInsSave, lScoreSave, lExitSave
  270. local oCol, oGet, nKey, cExpr, xEval
  271. local lFresh, nCursSave, mGetVar
  272.  
  273.     // make sure the display is correct
  274.     oB:hitTop := .f.
  275.     Statline(oB, lAppend)
  276.     while ( !oB:stabilize() ) ; end
  277.  
  278.     // save state
  279.     lScoreSave := Set(_SET_SCOREBOARD, .f.)
  280.     lExitSave := Set(_SET_EXIT, .t.)
  281.  
  282.     // set insert key to toggle insert mode and cursor
  283.     bInsSave := SetKey(K_INS, bInsToggle)
  284.  
  285.     // turn the cursor on
  286.     nCursSave := SetCursor( if(ReadInsert(), SC_INSERT, SC_NORMAL) )
  287.  
  288.     // get the controlling index key
  289.     cExpr := IndexKey(0)
  290.     if ( !Empty(cExpr) )
  291.         // expand key expression for later comparison
  292.         xEval := &cExpr
  293.     end
  294.  
  295.     // get column object from browse
  296.     oCol := oB:getColumn(oB:colPos)
  297.  
  298.     // use temp for safety
  299.     mGetVar := Eval(oCol:block)
  300.  
  301.     // create a corresponding GET with ambiguous set/get block
  302.     oGet := GetNew(Row(), Col(),                                    ;
  303.                    {|x| if(PCount() == 0, mGetVar, mGetVar := x)},    ;
  304.                    "mGetVar",, oB:colorSpec)
  305.  
  306.     // refresh flag
  307.     lFresh := .f.
  308.  
  309.     // read it
  310.     if ( ReadModal( {oGet} ) )
  311.         // new data has been entered
  312.         if ( lAppend .and. Recno() == LastRec() + 1 )
  313.             // new record confirmed
  314.             APPEND BLANK
  315.         end
  316.  
  317.         // replace with new data
  318.         Eval(oCol:block, mGetVar)
  319.  
  320.         // test for change in index order
  321.         if ( !Empty(cExpr) .and. !lAppend )
  322.             if ( xEval != &cExpr )
  323.                 // change in index key eval
  324.                 lFresh := .t.
  325.             end
  326.         end
  327.     end
  328.  
  329.     if ( lFresh )
  330.         // record in new indexed order
  331.         FreshOrder(oB)
  332.  
  333.         // no other action
  334.         nKey := 0
  335.     else
  336.         // refresh the current row only
  337.         oB:refreshCurrent()
  338.  
  339.         // certain keys move cursor after edit if no refresh
  340.         nKey := ExitKey(lAppend)
  341.     end
  342.  
  343.     if ( lAppend )
  344.         // maintain special row color
  345.         oB:colorRect({oB:rowPos,1,oB:rowPos,oB:colCount}, {2,2})
  346.     end
  347.  
  348.     // restore state
  349.     SetCursor(nCursSave)
  350.     Set(_SET_SCOREBOARD, lScoreSave)
  351.     Set(_SET_EXIT, lExitSave)
  352.     SetKey(K_INS, bInsSave)
  353.  
  354. return (nKey)
  355.  
  356.  
  357. /***
  358. *    ExitKey()
  359. *
  360. *    Determine the follow-up action after editing a field
  361. */
  362.  
  363. static func ExitKey(lAppend)
  364.  
  365. local nKey
  366.  
  367.     nKey := LastKey()
  368.     if ( nKey == K_PGDN )
  369.         // move down if not append mode
  370.         if ( lAppend )
  371.             nKey := 0
  372.         else
  373.             nKey := K_DOWN
  374.         end
  375.  
  376.     elseif ( nKey == K_PGUP )
  377.         // move up if not append mode
  378.         if ( lAppend )
  379.             nKey := 0
  380.         else
  381.             nKey := K_UP
  382.         end
  383.  
  384.     elseif ( nKey == K_RETURN .or. (nKey >= 32 .and. nKey <= 255) )
  385.         // return key or type out..move right
  386.         nKey := K_RIGHT
  387.  
  388.     elseif ( nKey != K_UP .and. nKey != K_DOWN )
  389.         // no other action
  390.         nKey := 0
  391.     end
  392.  
  393. return (nKey)
  394.  
  395.  
  396. /***
  397. *    FreshOrder()
  398. *
  399. *    Refresh respecting any change in index order
  400. */
  401.  
  402. static func FreshOrder(oB)
  403.  
  404. local nRec
  405.  
  406.     nRec := Recno()
  407.     oB:refreshAll()
  408.  
  409.     // stabilize to see if TBrowse moves the record pointer
  410.     while ( !oB:stabilize() ) ; end
  411.  
  412.     if ( nRec != LastRec() + 1 )
  413.         // record pointer may move if bof is on screen
  414.         while ( Recno() != nRec )
  415.             // falls through unless record is closer to bof than before
  416.             oB:up()
  417.             while ( !oB:stabilize() ) ; end
  418.         end
  419.     end
  420.  
  421. return (NIL)
  422.  
  423.  
  424. /***
  425. *    Statline()
  426. *
  427. *    display status at coordinates relative to TBrowse object
  428. */
  429.  
  430. static func Statline(oB, lAppend)
  431.  
  432. local nTop, nRight
  433.  
  434.     nTop := oB:nTop - 1
  435.     nRight := oB:nRight
  436.  
  437.     @ nTop, nRight - 27 say "Record "
  438.     if ( LastRec() == 0 .and. !lAppend )
  439.         // file is empty
  440.         @ nTop, nRight - 20 say "<none>               "
  441.     elseif ( Recno() == LastRec() + 1 )
  442.         // no record number if eof
  443.         @ nTop, nRight - 40 say "         "
  444.         @ nTop, nRight - 20 say "                <new>"
  445.     else
  446.         // normal record..display Recno()/LastRec() and Deleted()
  447.         @ nTop, nRight - 40 say If(Deleted(), "<Deleted>", "         ")
  448.         @ nTop, nRight - 20 say Pad(Ltrim(Str(Recno())) + "/" +;
  449.                                     Ltrim(Str(LastRec())), 16) +;
  450.                                 If(oB:hitTop, "<bof>", "     ")
  451.     end
  452.  
  453. return (NIL)
  454.  
  455.  
  456. /***
  457. *    Skipped(n)
  458. *
  459. *    Skip thru database and return the
  460. *    actual number of records skipped
  461. */
  462.  
  463. static func Skipped(nRequest, lAppend)
  464.  
  465. local nCount
  466.  
  467.     nCount := 0
  468.     if ( LastRec() != 0 )
  469.         if ( nRequest == 0 )
  470.             skip 0
  471.  
  472.         elseif ( nRequest > 0 .and. Recno() != LastRec() + 1 )
  473.             // forward
  474.             while ( nCount < nRequest )
  475.                 skip 1
  476.                 if ( Eof() )
  477.                     if ( lAppend )
  478.                         // eof record allowed if append mode
  479.                         nCount++
  480.                     else
  481.                         // back to last actual record
  482.                         skip -1
  483.                     end
  484.  
  485.                     exit
  486.                 end
  487.  
  488.                 nCount++
  489.             end
  490.  
  491.         elseif ( nRequest < 0 )
  492.             // backward
  493.             while ( nCount > nRequest )
  494.                 skip -1
  495.                 if ( Bof() )
  496.                     exit
  497.                 end
  498.  
  499.                 nCount--
  500.             end
  501.         end
  502.     end
  503.  
  504. return (nCount)
  505.  
  506.  
  507. // eof _browse.prg
  508.