home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB03.PRG < prev    next >
Encoding:
Text File  |  1992-03-09  |  7.4 KB  |  254 lines
  1.     // Tb03.prg
  2.     //
  3.     // Simple database browse with added cosmetics
  4.     // Allows user to resize and move the display
  5.     // Compile with /a /m /n /w
  6.     // Link with Nantucket's Dict.obj for the dictionary routines
  7.  
  8.     #include "Inkey.ch"
  9.     #include "Tbutils.ch"  // For DEF_ .. Separator characters
  10.  
  11.     // Key press to enter move mode
  12.     #define K_MOVE_KEY K_F2
  13.  
  14.     FUNCTION Tb03
  15.  
  16.     FIELD Lname, Fname, Addr1, Addr2, Addr3, Addr4 IN TbDbf1
  17.  
  18.     LOCAL oTbr  := TBrowseDb(10, 20, 20, 60)
  19.     LOCAL oTbc1 := TBColumnNew("Last name",  {|| Lname })
  20.     LOCAL oTbc2 := TBColumnNew("First name", {|| Fname })
  21.     LOCAL oTbc3 := TBColumnNew("Address 1",  {|| Addr1 })
  22.     LOCAL oTbc4 := TBColumnNew("Address 2",  {|| Addr2 })
  23.     LOCAL oTbc5 := TBColumnNew("Address 3",  {|| Addr3 })
  24.     LOCAL oTbc6 := TBColumnNew("Address 4",  {|| Addr4 })
  25.     LOCAL nKey
  26.     LOCAL lExitRequested
  27.     LOCAL aWin
  28.  
  29.       oTbr:colSep  := DEF_CSEP
  30.       oTbr:headSep := DEF_HSEP
  31.       oTbr:footSep := DEF_FSEP
  32.  
  33.       CLEAR SCREEN
  34.  
  35.       // First save the tbrowse window in the tbrowse object's
  36.       // cargo instance variable
  37.       oTbr:cargo := DictNew()
  38.       aWin := { oTbr:nTop - 1,    oTbr:nLeft - 1,  ;
  39.                 oTbr:nBottom + 1, oTbr:nRight + 1, ;
  40.                 SaveScreen(oTbr:nTop - 1,    oTbr:nLeft - 1, ;
  41.                            oTbr:nBottom + 1, oTbr:nRight + 1) }
  42.  
  43.       DictPut(oTbr:cargo, "Tbrowse Window", aWin)
  44.  
  45.       // Frame the tbrowse window
  46.       @ oTbr:nTop - 1, oTbr:nLeft - 1 TO ;
  47.         oTbr:nBottom + 1, oTbr:nRight + 1
  48.  
  49.       USE TbDbf1
  50.  
  51.       oTbr:addColumn(oTbc1)
  52.       oTbr:addColumn(oTbc2)
  53.       oTbr:addColumn(oTbc3)
  54.       oTbr:addColumn(oTbc4)
  55.       oTbr:addColumn(oTbc5)
  56.       oTbr:addColumn(oTbc6)
  57.  
  58.       lExitRequested := .F.
  59.       DO WHILE !lExitRequested
  60.         DO WHILE !oTbr:stabilize()
  61.         ENDDO
  62.         nKey := InKey(0)
  63.  
  64.         DO CASE
  65.           CASE nKey == K_DOWN;       oTbr:down()
  66.           CASE nKey == K_UP;         oTbr:up()
  67.           CASE nKey == K_PGDN;       oTbr:pageDown()
  68.           CASE nKey == K_PGUP;       oTbr:pageUp()
  69.           CASE nKey == K_CTRL_PGUP;  oTbr:goTop()
  70.           CASE nKey == K_CTRL_PGDN;  oTbr:goBottom()
  71.           CASE nKey == K_RIGHT;      oTbr:right()
  72.           CASE nKey == K_LEFT;       oTbr:left()
  73.           CASE nKey == K_HOME;       oTbr:home()
  74.           CASE nKey == K_END;        oTbr:end()
  75.           CASE nKey == K_CTRL_LEFT;  oTbr:panLeft()
  76.           CASE nKey == K_CTRL_RIGHT; oTbr:panRight()
  77.           CASE nKey == K_CTRL_HOME;  oTbr:panHome()
  78.           CASE nKey == K_CTRL_END;   oTbr:panEnd()
  79.           CASE nKey == K_MOVE_KEY;   TBMove(oTbr)
  80.           CASE nKey == K_ESC;        lExitRequested := .T.
  81.         ENDCASE
  82.       ENDDO
  83.  
  84.     RETURN NIL
  85.  
  86.  
  87.     FUNCTION TBMove(oTbr)
  88.  
  89.       TBTopLeftMove(oTbr)
  90.       TBBottRightMove(oTbr)
  91.  
  92.     RETURN NIL
  93.  
  94.  
  95.     FUNCTION TBTopLeftMove(oTbr)
  96.  
  97.     LOCAL nKey, lMoved, nDictEntry, aWin
  98.  
  99.       // first redraw the top and left frame blinking
  100.       @ oTbr:nTop - 1, oTbr:nLeft - 1, ;
  101.         oTbr:nTop - 1, oTbr:nRight + 1 ;
  102.         BOX chr(218) + chr(196) + chr(191) COLOR "N/W*,W/N"
  103.  
  104.       @ oTbr:nTop - 1, oTbr:nLeft - 1, ;
  105.         oTbr:nBottom + 1, oTbr:nLeft - 1 ;
  106.         BOX chr(191) + chr(179) + chr(217) COLOR "N/W*,W/N"
  107.  
  108.       nKey := inkey(0)
  109.       lMoved := .F.
  110.       DO WHILE !(nKey == K_ESC)
  111.         DO CASE
  112.           CASE nKey == K_UP
  113.             IF oTbr:nTop > 1
  114.               oTbr:nTop--
  115.               lMoved := .T.
  116.             ENDIF
  117.  
  118.           CASE nKey == K_DOWN
  119.             IF oTbr:nTop < oTbr:nBottom
  120.               oTbr:nTop++
  121.               lMoved := .T.
  122.             ENDIF
  123.  
  124.           CASE nKey == K_LEFT
  125.             IF oTbr:nLeft > 1
  126.               oTbr:nLeft--
  127.               lMoved := .T.
  128.             ENDIF
  129.  
  130.           CASE nKey == K_RIGHT
  131.             IF oTbr:nLeft < oTbr:nRight
  132.               oTbr:nLeft++
  133.               lMoved := .T.
  134.             ENDIF
  135.         ENDCASE
  136.  
  137.         IF lMoved
  138.           // First get our window from cargo dictionary
  139.           aWin := DictAt(oTbr:cargo, "Tbrowse Window")
  140.           Restscreen(aWin[1], aWin[2],  ;
  141.                      aWin[3], aWin[4], ;
  142.                      aWin[5])
  143.  
  144.           // First save the tbrowse window in the tbrowse object's
  145.           // cargo instance variable
  146.           aWin := { oTbr:nTop - 1,    oTbr:nLeft - 1,  ;
  147.                     oTbr:nBottom + 1, oTbr:nRight + 1, ;
  148.                     SaveScreen(oTbr:nTop - 1,    oTbr:nLeft - 1, ;
  149.                                oTbr:nBottom + 1, oTbr:nRight + 1) }
  150.           DictPut(oTbr:cargo, "Tbrowse Window", aWin)
  151.  
  152.           // test here
  153.           DO WHILE NextKey() = 0 .AND. !oTbr:stabilize()
  154.           ENDDO
  155.  
  156.          // Redraw the top and left frame blinking
  157.          @ oTbr:nTop - 1, oTbr:nLeft - 1 TO ;
  158.             oTbr:nTop - 1, oTbr:nRight + 1 COLOR "N/W*,W/N"
  159.  
  160.          @ oTbr:nTop - 1, oTbr:nLeft - 1 TO ;
  161.             oTbr:nBottom + 1, oTbr:nLeft - 1 COLOR "N/W*,W/N"
  162.           lMoved := .F.
  163.  
  164.         ENDIF
  165.  
  166.         nKey := InKey(0)
  167.       ENDDO
  168.  
  169.       // Now redraw the frame
  170.       @ oTbr:nTop - 1, oTbr:nLeft - 1 TO ;
  171.         oTbr:nBottom + 1, oTbr:nRight + 1
  172.  
  173.     RETURN NIL
  174.  
  175.  
  176.     FUNCTION TBBottRightMove(oTbr)
  177.  
  178.     LOCAL nKey, lMoved, aWin
  179.  
  180.       // first redraw the frame blinking
  181.  
  182.       @ oTbr:nTop - 1, oTbr:nRight + 1 TO ;
  183.         oTbr:nBottom + 1, oTbr:nRight + 1 COLOR "N/W*,W/N"
  184.  
  185.       @ oTbr:nBottom + 1, oTbr:nLeft - 1 TO ;
  186.         oTbr:nBottom + 1, oTbr:nRight + 1 COLOR "N/W*,W/N"
  187.  
  188.       nKey := InKey(0)
  189.       lMoved := .F.
  190.       DO WHILE !(nKey == K_ESC)
  191.         DO CASE
  192.           CASE nKey == K_UP
  193.             IF oTbr:nBottom > oTbr:nTop
  194.               oTbr:nBottom--
  195.               lMoved := .T.
  196.             ENDIF
  197.  
  198.           CASE nKey == K_DOWN
  199.             IF oTbr:nBottom < maxrow() - 1
  200.               oTbr:nBottom++
  201.               lMoved := .T.
  202.             ENDIF
  203.  
  204.           CASE nKey == K_LEFT
  205.             IF oTbr:nRight > oTbr:nLeft
  206.               oTbr:nRight--
  207.               lMoved := .T.
  208.             ENDIF
  209.  
  210.           CASE nKey == K_RIGHT
  211.             IF oTbr:nRight < maxcol() - 1
  212.               oTbr:nRight++
  213.               lMoved := .T.
  214.             ENDIF
  215.         ENDCASE
  216.  
  217.         IF lMoved
  218.           // First get our window from cargo dictionary
  219.           aWin := DictAt(oTbr:cargo, "Tbrowse Window")
  220.           RestScreen(aWin[1], aWin[2],  ;
  221.                      aWin[3], aWin[4], ;
  222.                      aWin[5])
  223.  
  224.           // First save the tbrowse window in the tbrowse object's
  225.           // cargo instance variable
  226.           aWin := { oTbr:nTop - 1,    oTbr:nLeft - 1,  ;
  227.                     oTbr:nBottom + 1, oTbr:nRight + 1, ;
  228.                     SaveScreen(oTbr:nTop - 1,    oTbr:nLeft - 1, ;
  229.                                oTbr:nBottom + 1, oTbr:nRight + 1) }
  230.  
  231.           DictPut(oTbr:cargo, "Tbrowse Window", aWin)
  232.  
  233.           DO WHILE !oTbr:stabilize()
  234.           ENDDO
  235.  
  236.           @ oTbr:nTop - 1, oTbr:nRight + 1 TO ;
  237.             oTbr:nBottom + 1, oTbr:nRight + 1 COLOR "N/W*,W/N"
  238.  
  239.           @ oTbr:nBottom + 1, oTbr:nLeft - 1 TO ;
  240.             oTbr:nBottom + 1, oTbr:nRight + 1 COLOR "N/W*,W/N"
  241.  
  242.           lMoved := .F.
  243.  
  244.         ENDIF
  245.  
  246.         nKey := InKey(0)
  247.       ENDDO
  248.  
  249.       // Now redraw the frame
  250.       @ oTbr:nTop - 1, oTbr:nLeft - 1 TO ;
  251.         oTbr:nBottom + 1, oTbr:nRight + 1
  252.  
  253.     RETURN NIL
  254.