home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB25.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  2.2 KB  |  90 lines
  1.     // Tb25.prg
  2.     //
  3.     // Multiple Select box routine
  4.     //
  5.     // Compile with /a /m /n /w
  6.     //
  7.     // Link with Tbutils, Dict
  8.  
  9.     #include "Inkey.ch"
  10.     #include "Tbutils.ch"
  11.  
  12.  
  13.     FUNCTION Tb25
  14.  
  15.     FIELD Lname, Fname, Addr1, Addr2, Addr3, Addr4 IN Tbdbf1
  16.  
  17.     LOCAL oTbr  := TBrowseDb(1, 1, MaxRow() - 1, MaxCol() - 1)
  18.     LOCAL oTbc1 := TBColumnNew("Last name",  {|| Lname })
  19.     LOCAL oTbc2 := TBColumnNew("First name", {|| Fname })
  20.     LOCAL oTbc3 := TBColumnNew("Address 1",  {|| Addr1 })
  21.     LOCAL oTbc4 := TBColumnNew("Address 2",  {|| Addr2 })
  22.     LOCAL oTbc5 := TBColumnNew("Address 3",  {|| Addr3 })
  23.     LOCAL oTbc6 := TBColumnNew("Address 4",  {|| Addr4 })
  24.     LOCAL nKey
  25.     LOCAL lExitRequested
  26.     LOCAL aSelected := {}
  27.     LOCAL oTbcSelect
  28.  
  29.       oTbcSelect := TBColumnNew(, {|| iif(Ascan(aSelected, Recno()) > 0, ;
  30.                                           " X ", "   ") })
  31.  
  32.       oTbr:colSep  := DEF_CSEP
  33.       oTbr:headSep := DEF_HSEP
  34.       oTbr:footSep := DEF_FSEP
  35.  
  36.       CLEAR SCREEN
  37.       @ 0, 0 TO MaxRow(), MaxCol()
  38.  
  39.       USE Tbdbf1
  40.       IF !File("tbdbf1.ntx")
  41.         INDEX ON Upper(Lname + Fname) TO Tbdbf1
  42.       ELSE
  43.         SET INDEX TO Tbdbf1
  44.       ENDIF
  45.  
  46.       oTbr:addColumn(oTbcSelect)
  47.       oTbr:addColumn(TBColumnNew("Record #", {|| Recno() }))
  48.       oTbr:addColumn(oTbc1)
  49.       oTbr:addColumn(oTbc2)
  50.       oTbr:addColumn(oTbc3)
  51.       oTbr:addColumn(oTbc4)
  52.       oTbr:addColumn(oTbc5)
  53.       oTbr:addColumn(oTbc6)
  54.  
  55.       lExitRequested := .F.
  56.       DO WHILE !lExitRequested
  57.         FullStabilize(oTbr)
  58.         nKey := Inkey(0)
  59.         IF !StdMeth(nKey, oTbr)
  60.           DO CASE
  61.             CASE nKey == K_ENTER
  62.               RecSelect(aSelected, Recno())
  63.               oTbr:refreshCurrent()
  64.  
  65.             CASE nKey == K_ESC
  66.               lExitRequested := .T.
  67.  
  68.           ENDCASE
  69.         ENDIF
  70.       ENDDO
  71.  
  72.       CLEAR SCREEN
  73.       Aeval(aSelected, {|nRecNum| Qout(nRecNum) })
  74.  
  75.     RETURN NIL
  76.  
  77.  
  78.     FUNCTION RecSelect(aSelected, rNum)
  79.  
  80.     LOCAL nElem := Ascan(aSelected, rNum)
  81.  
  82.       IF nElem > 0
  83.         Adel(aSelected, nElem)
  84.         Asize(aSelected, Len(aSelected) - 1)
  85.       ELSE
  86.         Aadd(aSelected, rNum)
  87.       ENDIF
  88.       
  89.     RETURN NIL
  90.