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