home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBEXS.EXE / TBEX23.PRG < prev    next >
Encoding:
Text File  |  1992-03-18  |  2.5 KB  |  100 lines

  1.     // Tbex23.prg
  2.     //
  3.     // Multiple Select box routine - highlights row rather than a
  4.     // separate column with X
  5.     //
  6.     // Compile with /a /m /n /w
  7.     //
  8.     // Link with Tbutils, Dict
  9.  
  10.     #include "Inkey.ch"
  11.     #include "Tbutils.ch"
  12.  
  13.     FUNCTION Tbex23
  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.     LOCAL i
  29.  
  30. //      oTbcSelect := TBColumnNew(, {|| iif(Ascan(aSelected, Recno()) > 0, ;
  31. //                                          " X ", "   ") })
  32.  
  33.       oTbr:colSep  := DEF_CSEP
  34.       oTbr:headSep := DEF_HSEP
  35.       oTbr:footSep := DEF_FSEP
  36.  
  37.       CLEAR SCREEN
  38.       @ 0, 0 TO MaxRow(), MaxCol()
  39.  
  40.       USE Tbdbf1
  41.       IF !File("tbdbf1.ntx")
  42.         INDEX ON Upper(Lname + Fname) TO Tbdbf1
  43.       ELSE
  44.         SET INDEX TO Tbdbf1
  45.       ENDIF
  46.  
  47. //      oTbr:addColumn(oTbcSelect)
  48.  
  49.       oTbr:addColumn(TBColumnNew("Record #", {|| Recno() }))
  50.  
  51.       oTbc1:colorBlock := {|| iif(Ascan(aSelected, RecNo()) > 0, ;
  52.                                  {2, 2}, {1, 2}) }
  53.       oTbr:addColumn(oTbc1)
  54.       oTbr:addColumn(oTbc2)
  55.       oTbr:addColumn(oTbc3)
  56.       oTbr:addColumn(oTbc4)
  57.       oTbr:addColumn(oTbc5)
  58.       oTbr:addColumn(oTbc6)
  59.  
  60.       FOR i := 2 TO oTbr:colCount
  61.         oTbr:getColumn(i):colorBlock := oTbc1:colorBlock
  62.       NEXT
  63.  
  64.       lExitRequested := .F.
  65.       DO WHILE !lExitRequested
  66.         FullStabilize(oTbr)
  67.         nKey := Inkey(0)
  68.         IF !StdMeth(nKey, oTbr)
  69.           DO CASE
  70.             CASE nKey == K_ENTER
  71.               RecSelect(aSelected, Recno())
  72.               oTbr:refreshCurrent()
  73.  
  74.             CASE nKey == K_ESC
  75.               lExitRequested := .T.
  76.  
  77.           ENDCASE
  78.         ENDIF
  79.       ENDDO
  80.  
  81.       CLEAR SCREEN
  82.       Aeval(aSelected, {|nRecNum| Qout(nRecNum) })
  83.  
  84.     RETURN NIL
  85.  
  86.  
  87.     FUNCTION RecSelect(aSelected, rNum)
  88.  
  89.     LOCAL nElem := Ascan(aSelected, rNum)
  90.  
  91.       IF nElem > 0
  92.         Adel(aSelected, nElem)
  93.         Asize(aSelected, Len(aSelected) - 1)
  94.       ELSE
  95.         Aadd(aSelected, rNum)
  96.       ENDIF
  97.       
  98.     RETURN NIL
  99.  
  100.