home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB51.ZIP / C5P78.EXE / SOURCE / TBDEMO.PRG < prev   
Encoding:
Text File  |  1990-05-26  |  5.9 KB  |  358 lines
  1. *****
  2. *
  3. *    tbdemo.prg
  4. *    Illustration of TBROWSE and GET objects
  5. *    Copyright (c) 1990 Nantucket Corp.  All rights reserved.
  6. *
  7. *    Note:  compile with /n/w/a
  8. *
  9.  
  10. #include "inkey.ch"
  11. #include "setcurs.ch"
  12.  
  13.  
  14. #define MY_HSEP        "═╤═"
  15. #define MY_CSEP        " │ "
  16.  
  17.  
  18. ****
  19. *    tbdemo <dbf> [<index>]
  20. *
  21.  
  22. func tbdemo(datafile, indexfile)
  23.  
  24.     if Valtype(datafile) == "U"
  25.         ?
  26.         ? "Must enter name of data file on command line."
  27.         ?
  28.         quit
  29.  
  30.     end
  31.  
  32.     if .not. (File(datafile) .or. File(datafile + ".dbf"))
  33.         ?
  34.         ? "File not found."
  35.         ?
  36.         quit
  37.  
  38.     end
  39.  
  40.     SetColor("n/bg")
  41.     CLEAR SCREEN
  42.  
  43.     * file exists
  44.     if Valtype(indexfile) == "C" .and.;
  45.        (File(indexfile) .or. File(indexfile + IndexExt()))
  46.         USE (datafile) INDEX (indexfile)
  47.  
  48.     else
  49.         USE (datafile)
  50.  
  51.     end
  52.  
  53.     MyBrowse(3, 6, MaxRow() - 2, MaxCol() - 6)
  54.  
  55.     SET COLOR TO
  56.     @ MaxRow(), 0 CLEAR
  57.  
  58. return (NIL)
  59.  
  60.  
  61.  
  62. ***
  63. *    MyBrowse()
  64. *
  65.  
  66. func MyBrowse(nTop, nLeft, nBottom, nRight)
  67. local b, column, cType, n
  68. local cColorSave, nCursSave
  69. local lMore, nKey, lAppend
  70.  
  71.  
  72.     /* make new browse object */
  73.     b := TBrowseDB(nTop, nLeft, nBottom, nRight)
  74.  
  75.     /* default heading and column separators */
  76.     b:headSep := MY_HSEP
  77.     b:colSep := MY_CSEP
  78.  
  79.     /* add custom 'skipper' (to handle append mode) */
  80.     b:skipBlock := {|x| Skipper(x, lAppend)}
  81.  
  82.     /* colors */
  83.     b:colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R"
  84.  
  85.  
  86.     /* add a column for recno() */
  87.     column := TBColumnNew( "  Rec #", {|| Recno()} )
  88.     b:addColumn(column)
  89.  
  90.     /* add a column for each field in the current workarea */
  91.     for n = 1 to FCount()
  92.  
  93.         /* make the new column */
  94.         column := TBColumnNew( FieldName(n), FieldBlock(FieldName(n)) )
  95.  
  96.  
  97.         /* evaluate the block once to get the field's data type */
  98.         cType := ValType( Eval(column:block) )
  99.  
  100.  
  101.         /* if numeric, use a color block to highlight negative values */
  102.         if ( cType == "N" )
  103.             column:defColor := {5, 6}
  104.             column:colorBlock := {|x| if( x < 0, {7, 8}, {5, 6} )}
  105.  
  106.         else
  107.             column:defColor := {3, 4}
  108.  
  109.         end
  110.  
  111.         b:addColumn(column)
  112.     next
  113.  
  114.  
  115.     /* freeze leftmost column (recno) */
  116.     b:freeze := 1
  117.  
  118.  
  119.     /* make a window shadow */
  120.     cColorSave := SetColor("N/N")
  121.     @ nTop+1, nLeft+1 CLEAR TO nBottom+1, nRight+1
  122.     SetColor("W/W")
  123.     @ nTop, nLeft CLEAR TO nBottom, nRight
  124.     SetColor(cColorSave)
  125.  
  126.  
  127.     nCursSave := SetCursor(0)
  128.     lAppend := .f.
  129.  
  130.     lMore := .t.
  131.     while (lMore)
  132.  
  133.         /* don't allow cursor to move into frozen columns */
  134.         if ( b:colPos <= b:freeze )
  135.             b:colPos := b:freeze + 1
  136.         end
  137.  
  138.         /* stabilize the display */
  139.         while ( !b:stabilize() )
  140.             nKey := InKey()
  141.             if ( nKey != 0 )
  142.                 exit             /* (abort if a key is waiting) */
  143.             end
  144.         end
  145.  
  146.  
  147.         if ( b:stable )
  148.             /* display is stable */
  149.             if ( b:hitBottom .and. !lAppend )
  150.                 /* banged against EOF; go into append mode */
  151.                 lAppend := .t.
  152.                 nKey := K_DOWN
  153.  
  154.             else
  155.                 if ( b:hitTop .or. b:hitBottom )
  156.                     Tone(125, 0)
  157.                 end
  158.  
  159.                 /* everything's done; just wait for a key */
  160.                 nKey := InKey(0)
  161.  
  162.             end
  163.         end
  164.  
  165.  
  166.         /* process key */
  167.         do case
  168.         case ( nKey == K_DOWN )
  169.             b:down()
  170.  
  171.         case ( nKey == K_UP )
  172.             b:up()
  173.  
  174.             if ( lAppend )
  175.                 lAppend := .f.
  176.                 b:refreshAll()
  177.             end
  178.  
  179.         case ( nKey == K_PGDN )
  180.             b:pageDown()
  181.  
  182.         case ( nKey == K_PGUP )
  183.             b:pageUp()
  184.             if ( lAppend )
  185.                 lAppend := .f.
  186.                 b:refreshAll()
  187.             end
  188.  
  189.         case ( nKey == K_CTRL_PGUP )
  190.             b:goTop()
  191.             lAppend := .f.
  192.  
  193.         case ( nKey == K_CTRL_PGDN )
  194.             b:goBottom()
  195.             lAppend := .f.
  196.  
  197.         case ( nKey == K_RIGHT )
  198.             b:right()
  199.  
  200.         case ( nKey == K_LEFT )
  201.             b:left()
  202.  
  203.         case ( nKey == K_HOME )
  204.             b:home()
  205.  
  206.         case ( nKey == K_END )
  207.             b:end()
  208.  
  209.         case ( nKey == K_CTRL_LEFT )
  210.             b:panLeft()
  211.  
  212.         case ( nKey == K_CTRL_RIGHT )
  213.             b:panRight()
  214.  
  215.         case ( nKey == K_CTRL_HOME )
  216.             b:panHome()
  217.  
  218.         case ( nKey == K_CTRL_END )
  219.             b:panEnd()
  220.  
  221.         case ( nKey == K_ESC )
  222.             lMore := .f.
  223.  
  224.         case ( nKey == K_RETURN )
  225.             DoGet(b, lAppend)
  226.  
  227.         otherwise
  228.             KEYBOARD( Chr(nKey) )
  229.             DoGet(b, lAppend)
  230.  
  231.         end
  232.  
  233.     end
  234.  
  235.     SetCursor(nCursSave)
  236.  
  237. return (.t.)
  238.  
  239.  
  240. ****
  241. *    Skipper()
  242. *
  243.  
  244. func Skipper(n, lAppend)
  245. local i
  246.  
  247.     i := 0
  248.     if ( LastRec() != 0 )
  249.         if ( n == 0 )
  250.             SKIP 0
  251.  
  252.         elseif ( n > 0 .and. Recno() != LastRec() + 1 )
  253.             while ( i < n )
  254.                 SKIP 1
  255.                 if ( Eof() )
  256.                     if ( lAppend )
  257.                         i++
  258.                     else
  259.                         SKIP -1
  260.                     end
  261.  
  262.                     exit
  263.                 end
  264.  
  265.                 i++
  266.             end
  267.  
  268.         elseif ( n < 0 )
  269.             while ( i > n )
  270.                 SKIP -1
  271.                 if ( Bof() )
  272.                     exit
  273.                 end
  274.  
  275.                 i--
  276.             end
  277.         end
  278.     end
  279.  
  280. return (i)
  281.  
  282.  
  283. ****
  284. *    DoGet()
  285. *
  286. func DoGet(b, lAppend)
  287. local bInsSave, lScoreSave, lExitSave
  288. local column, get, nKey
  289.  
  290.  
  291.     /* make sure browse is stable */
  292.     while ( !b:stabilize() ) ; end
  293.  
  294.  
  295.     /* if confirming new record, append blank */
  296.     if ( lAppend .and. Recno() == LastRec() + 1 )
  297.         APPEND BLANK
  298.     end
  299.  
  300.  
  301.     /* save state */
  302.     lScoreSave := Set(_SET_SCOREBOARD, .f.)
  303.     lExitSave := Set(_SET_EXIT, .t.)
  304.     bInsSave := SetKey(K_INS)
  305.  
  306.     /* set insert key to toggle insert mode and cursor */
  307.     SetKey( K_INS, ;
  308.         {|| SetCursor( if(ReadInsert(!ReadInsert()), SC_NORMAL, SC_INSERT))};
  309.           )
  310.  
  311.     /* initial cursor setting */
  312.     SetCursor( if(ReadInsert(), SC_INSERT, SC_NORMAL) )
  313.  
  314.  
  315.     /* get column object from browse */
  316.     column := b:getColumn(b:colPos)
  317.  
  318.     /* create a corresponding GET */
  319.     get := GetNew(Row(), Col(), column:block, column:heading,, b:colorSpec)
  320.  
  321.     /* read it */
  322.     ReadModal( {get} )
  323.  
  324.  
  325.     /* restore state */
  326.     SetCursor(0)
  327.     Set(_SET_SCOREBOARD, lScoreSave)
  328.     Set(_SET_EXIT, lExitSave)
  329.     SetKey(K_INS, bInsSave)
  330.  
  331.  
  332.     /* force redisplay of current row */
  333.     b:refreshCurrent()
  334.  
  335.  
  336.     /* check exit key */
  337.     nKey := LastKey()
  338.     if ( nKey == K_UP .or. nKey == K_DOWN .or. ;
  339.         nKey == K_PGUP .or. nKey == K_PGDN )
  340.  
  341.         KEYBOARD( Chr(nKey) )
  342.     end
  343.  
  344. return (NIL)
  345.  
  346.  
  347. ****
  348. *    FieldBlock()
  349. *
  350. func FieldBlock(cName)
  351. local cBlock
  352.  
  353.     cBlock := "{|x| if(PCount() == 0," + cName + "," + ;
  354.                     Str(Select()) + "->" + cName + ":= x)}"
  355.  
  356. return ( &cBlock )
  357.  
  358.