home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBEXS.EXE / TBEX10.PRG < prev    next >
Encoding:
Text File  |  1992-03-17  |  2.9 KB  |  99 lines
  1.     // Tbex10.prg
  2.     //
  3.     // Simple database browse with added cosmetics
  4.     // Compile with /a /m /n /w
  5.     //
  6.     // K_F6 allows user to select field name to add to display
  7.  
  8.     #include "Inkey.ch"
  9.  
  10.     // Default column separator
  11.     #define DEF_CSEP  " " + chr(179) + " "
  12.  
  13.     // Default heading separator
  14.     #define DEF_HSEP chr(205) + chr(209) + chr(205)
  15.  
  16.     // Default footing separator
  17.     #define DEF_FSEP chr(205) + chr(207) + chr(205)
  18.  
  19.  
  20.     FUNCTION Tbex10
  21.  
  22.     FIELD Lname, Fname, Addr1, Addr2, Addr3, Addr4 IN Tbdbf1
  23.  
  24.     LOCAL oTbr  := TBrowseDb(1, 1, MaxRow() - 1, MaxCol() - 1)
  25.     LOCAL oTbc1 := TBColumnNew("Last name",  {|| Lname })
  26.     LOCAL nKey
  27.     LOCAL lExitRequested
  28.     LOCAL aFieldNames
  29.     LOCAL nFieldNum
  30.     LOCAL cSaveScr
  31.     LOCAL oTbcTemp
  32.     LOCAL aSelectedFields
  33.  
  34.       oTbr:colSep  := DEF_CSEP
  35.       oTbr:headSep := DEF_HSEP
  36.       oTbr:footSep := DEF_FSEP
  37.  
  38.       CLEAR SCREEN
  39.       @ 0, 0 TO MaxRow(), MaxCol()
  40.  
  41.       USE Tbdbf1
  42.  
  43.       aFieldNames := Array(Fcount())
  44.       aSelectedFields := Array(Fcount())
  45.       AFill(aSelectedFields, .T.)
  46.  
  47.       Afields(aFieldNames)
  48.  
  49.       // Find Lname field and make it unselectable
  50.       nFieldNum := Ascan(aFieldNames, "LNAME")
  51.       aSelectedFields[nFieldNum] := .F.
  52.  
  53.       oTbc1:width := 20
  54.       oTbr:addColumn(oTbc1)
  55.  
  56.       lExitRequested := .F.
  57.       SetColor("W+/N,N/W+,N,N,W/N")
  58.  
  59.       DO WHILE !lExitRequested
  60.         DO WHILE !oTbr:stabilize()
  61.         ENDDO
  62.         nKey := InKey(0)
  63.  
  64.         DO CASE
  65.           CASE nKey == K_F6
  66.             cSaveScr  := SaveScreen(10, 60, 20, 71)
  67.             @ 10, 60 TO 20, 71
  68.             nFieldNum := Achoice(11, 61, 19, 70, aFieldNames, ;
  69.                                  aSelectedFields)
  70.  
  71.             RestScreen(10, 60, 20, 71, cSaveScr)
  72.             IF nFieldNum > 0
  73.               oTbcTemp := TBColumnNew(aFieldnames[nFieldNum], ;
  74.                                       FieldBlock(aFieldNames[nFieldNum]))
  75.               oTbr:addColumn(oTbcTemp)
  76.               // Make this field unselectable ...
  77.               aSelectedFields[nFieldNum] := .F.
  78.             ENDIF
  79.  
  80.           CASE nKey == K_DOWN;       oTbr:down()
  81.           CASE nKey == K_UP;         oTbr:up()
  82.           CASE nKey == K_PGDN;       oTbr:pageDown()
  83.           CASE nKey == K_PGUP;       oTbr:pageUp()
  84.           CASE nKey == K_CTRL_PGUP;  oTbr:goTop()
  85.           CASE nKey == K_CTRL_PGDN;  oTbr:goBottom()
  86.           CASE nKey == K_RIGHT;      oTbr:right()
  87.           CASE nKey == K_LEFT;       oTbr:left()
  88.           CASE nKey == K_HOME;       oTbr:home()
  89.           CASE nKey == K_END;        oTbr:end()
  90.           CASE nKey == K_CTRL_LEFT;  oTbr:panLeft()
  91.           CASE nKey == K_CTRL_RIGHT; oTbr:panRight()
  92.           CASE nKey == K_CTRL_HOME;  oTbr:panHome()
  93.           CASE nKey == K_CTRL_END;   oTbr:panEnd()
  94.           CASE nKey == K_ESC;        lExitRequested := .T.
  95.         ENDCASE
  96.       ENDDO
  97.  
  98.     RETURN NIL
  99.