home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB23.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  3.6 KB  |  161 lines
  1.     // Tb23.prg
  2.     //
  3.     // Browsing Nested arrays to 2 dimensions
  4.     //
  5.     // Compile with /a /m /n /w /dTEST
  6.     //
  7.     // Link with Tbutils, Dict
  8.     
  9.     #include "Inkey.ch"
  10.     #include "Tbutils.ch"
  11.     
  12.     #ifdef TEST
  13.       FUNCTION Tb23
  14.       
  15.       LOCAL aAddr := { ;
  16.                        {"Spence",   "Rick", "14 Sea Oaks Drive"}, ;
  17.                        {"Schwartz", "Phil"}, ;
  18.                        "Just an Element", ;
  19.                        {30,          70,     50} ;
  20.                      }
  21.     
  22.         CLEAR SCREEN
  23.         @ 4, 9 TO 21, 71
  24.         BrNest(5, 10, 20, 70, aAddr)
  25.     
  26.       RETURN NIL
  27.     #endif
  28.     
  29.     
  30.     FUNCTION BrNest(nTop, nLeft, nBottom, nRight, aVar)
  31.     
  32.     LOCAL oTbr := TBabrNest(aVar)
  33.     LOCAL lExitRequested := .F.
  34.     LOCAL nKey
  35.     
  36.       CLEAR SCREEN
  37.       oTbr:nTop    := 1
  38.       oTbr:nLeft   := 1
  39.       oTbr:nBottom := MaxRow() - 1
  40.       oTbr:nright  := MaxCol() - 1
  41.       @ 0, 0 TO MaxRow(), MaxCol()
  42.     
  43.       DO WHILE !lExitRequested
  44.         FullStabilize(oTbr)
  45.         IF !(ValType(aVar[oTbr:cargo]) == "A")
  46.           oTbr:deHilite()
  47.           oTbr:colPos := 1
  48.           FullStabilize(oTbr)
  49.         ELSEIF oTbr:colPos > Len(aVar[oTbr:cargo])
  50.           oTbr:deHilite()
  51.           oTbr:colPos := Len(aVar[oTbr:cargo])
  52.           FullStabilize(oTbr)
  53.         ENDIF
  54.         nKey := Inkey(0)
  55.         IF !StdMeth(nKey, oTbr)
  56.           lExitRequested := (nKey == K_ESC)
  57.         ENDIF
  58.       ENDDO
  59.     
  60.     RETURN NIL
  61.     
  62.     
  63.     FUNCTION TBabrNest(aVar)
  64.     
  65.     LOCAL oTbr := TBrowseNew()
  66.     LOCAL nTBColumns := 1
  67.     LOCAL i
  68.     LOCAL oTbc
  69.     
  70.       oTbr:cargo := 1
  71.     
  72.       Aeval(aVar, {|aElem| ;
  73.                     nTBColumns := iif(ValType(aElem) == "A",       ;
  74.                                       Max(Len(aElem), nTBColumns), ;
  75.                                       nTBColumns) })
  76.     
  77.       FOR i := 1 TO nTBColumns
  78.         oTbc := TBColumnNew(, Anest2Blk(oTbr, aVar, i))
  79.         oTbc:width := AnestWidth(aVar, i)
  80.         oTbr:addColumn(oTbc)
  81.       NEXT
  82.     
  83.       oTbr:goTopBlock    := {|| oTbr:cargo := 1 }
  84.       oTbr:goBottomBlock := {|| oTbr:cargo := Len(aVar) }
  85.       oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo, aVar)
  86.     
  87.     RETURN oTbr
  88.     
  89.     
  90.     FUNCTION Anest2Blk(oTbr, aVar, nCol)
  91.     
  92.     RETURN {|| ArrayDisplay(oTbr, aVar, nCol) }
  93.     
  94.     
  95.     FUNCTION ArrayDisplay(oTbr, aVar, nCol)
  96.     
  97.     LOCAL rVal
  98.     
  99.       IF !(ValType(aVar[oTbr:cargo]) == "A")
  100.         IF nCol > 1
  101.           rVal := ""
  102.         ELSE
  103.           rVal := aVar[oTbr:cargo]
  104.         ENDIF
  105.       ELSEIF nCol <= Len(aVar[oTbr:cargo])
  106.         rVal := aVar[oTbr:cargo, nCol]
  107.       ELSE
  108.         rVal := ""
  109.       ENDIF
  110.     
  111.     RETURN rVal
  112.     
  113.     
  114.     FUNCTION AnestWidth(aVar, nCol)
  115.     
  116.     LOCAL i
  117.     LOCAL nLen := Len(aVar)
  118.     LOCAL nLongest := 0
  119.     LOCAL xElem
  120.  
  121.       FOR i := 1 TO nLen
  122.         IF ValType(aVar[i]) == "A"
  123.           IF Len(aVar[i]) >= nCol
  124.             xElem := aVar[i, nCol]
  125.           ELSE
  126.             xElem := ""
  127.           ENDIF
  128.         ELSE
  129.           xElem := aVar[i]
  130.         ENDIF
  131.  
  132.         nLongest := Max(nLongest, DataLen(xElem))
  133.       NEXT
  134.  
  135.     RETURN nLongest
  136.  
  137.  
  138.     FUNCTION DataLen(xElem)
  139.  
  140.     LOCAL nLen
  141.     LOCAL cType := ValType(xElem)
  142.  
  143.       DO CASE
  144.         CASE cType $ "ACM"
  145.           nLen := Len(xElem)
  146.  
  147.         CASE cType == "N"
  148.           nLen := Len(Str(xElem))
  149.  
  150.         CASE cType == "L"
  151.           nLen := 1
  152.  
  153.         CASE cType == "D"
  154.           nLen := 8
  155.  
  156.         CASE cType == "U"   // Value NIL
  157.           nLen := 3
  158.       ENDCASE
  159.     
  160.     RETURN nLen
  161.