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