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