home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB24.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  5.4 KB  |  206 lines
  1.     // Tb24.prg
  2.     //
  3.     // Browsing Nested arrays to any depth
  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 Tb24
  14.     
  15.       LOCAL aRepMenu := { ;
  16.                           {"Reports 1", "Select Reports 1" }, ;
  17.                           {"Reports 2", "Select Reports 2" }, ;
  18.                           {"Reports 3", "Select Reports 3" }, ;
  19.                           {"Reports 4", "Select Reports 4" }  ;
  20.                         }
  21.     
  22.       LOCAL aPayMenu := { ;
  23.                           {"Payables 1", "Select Payables 1" }, ;
  24.                           {"Payables 2", "Select Payables 2" }, ;
  25.                           {"Payables 3", "Select Payables 3" }, ;
  26.                           {"Payables 2", "Select Payables 4" }  ;
  27.                         }
  28.                     
  29.       LOCAL aRecMenu := { ;
  30.                           {"Receivables 1", "Select Receivables 1" }, ;
  31.                           {"Receivables 2", aRepMenu               }, ;
  32.                           {"Receivables 3", "Select Receivables 3" }, ;
  33.                           {"Receivables 2", aRepMenu               }  ;
  34.                         }
  35.     
  36.     
  37.       LOCAL aMenu1 := { ;
  38.                         {"Payables",    aPaymenu }, ;
  39.                         {"Receivables", aRecmenu }, ;
  40.                         {"Reports",     aRepmenu }  ;
  41.                       }
  42.     
  43.     
  44.         CLEAR SCREEN
  45.         @ 4, 9 TO 21, 71
  46.         ? BrNest(5, 10, 20, 70, aMenu1)
  47.     
  48.       RETURN NIL
  49.     #endif
  50.     
  51.     
  52.     FUNCTION BrNest(nTop, nLeft, nBottom, nRight, aVar)
  53.     
  54.     LOCAL oTbr := TBabrNest(aVar)
  55.     LOCAL lExitRequested := .F.
  56.     LOCAL nKey
  57.     LOCAL cSaveScr
  58.     
  59.       oTbr:nTop    := nTop + 1
  60.       oTbr:nLeft   := nLeft + 1
  61.       oTbr:nBottom := nBottom - 1
  62.       oTbr:nright  := nRight - 1
  63.     
  64.       CLEAR SCREEN
  65.       @ nTop, nLeft TO nBottom, nRight
  66.     
  67.       DO WHILE !lExitRequested
  68.         FullStabilize(oTbr)
  69.         IF !(ValType(aVar[oTbr:cargo]) == "A")
  70.           oTbr:deHilite()
  71.           oTbr:colPos := 1
  72.           FullStabilize(oTbr)
  73.         ELSEIF oTbr:colPos > Len(aVar[oTbr:cargo])
  74.           oTbr:deHilite()
  75.           oTbr:colPos := Len(aVar[oTbr:cargo])
  76.           FullStabilize(oTbr)
  77.         ENDIF
  78.         nKey := Inkey(0)
  79.         IF !StdMeth(nKey, oTbr)
  80.           DO CASE
  81.             CASE nKey == K_ESC
  82.               lExitRequested := .T.
  83.     
  84.             CASE nKey == K_ENTER
  85.               IF ValType(aVar[oTbr:cargo]) == "A" .AND. ;
  86.                  ValType(aVar[oTbr:cargo, oTbr:colPos]) == "A"
  87.                 cSaveScr := SaveScreen(nTop, nLeft, nBottom, nRight)
  88.                 @ nTop, nLeft CLEAR TO nBottom, nRight
  89.                 BrNest(nTop, nLeft, nBottom, nRight, ;
  90.                        aVar[oTbr:cargo, oTbr:colPos])
  91.                 RestScreen(nTop, nLeft, nBottom, nRight, cSaveScr)
  92.               ENDIF
  93.           ENDCASE
  94.           lExitRequested := (nKey == K_ESC)
  95.         ENDIF
  96.     
  97.       ENDDO
  98.     
  99.     RETURN NIL
  100.     
  101.     
  102.     FUNCTION TBabrNest(aVar)
  103.     
  104.     LOCAL oTbr := TBrowseNew()
  105.     LOCAL nTBColumns := 1
  106.     LOCAL i
  107.     LOCAL oTbc
  108.     
  109.       oTbr:cargo := 1
  110.     
  111.       Aeval(aVar, {|aElem| ;
  112.                     nTBColumns := iif(ValType(aElem) == "A",       ;
  113.                                       Max(Len(aElem), nTBColumns), ;
  114.                                       nTBColumns) })
  115.     
  116.       FOR i := 1 TO nTBColumns
  117.         oTbc := TBColumnNew(, Anest2Blk(oTbr, aVar, i))
  118.         oTbc:width := AnestWidth(aVar, i)
  119.         oTbr:addColumn(oTbc)
  120.       NEXT
  121.     
  122.       oTbr:goTopBlock    := {|| oTbr:cargo := 1 }
  123.       oTbr:goBottomBlock := {|| oTbr:cargo := Len(aVar) }
  124.       oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo, aVar)
  125.     
  126.     RETURN oTbr
  127.     
  128.     
  129.     FUNCTION Anest2Blk(oTbr, aVar, nCol)
  130.     
  131.     RETURN {|| ArrayDisplay(oTbr, aVar, nCol) }
  132.     
  133.     
  134.     FUNCTION AnestWidth(aVar, nCol)
  135.  
  136.     LOCAL i
  137.     LOCAL nLen := Len(aVar)
  138.     LOCAL nLongest := 0
  139.     LOCAL xElem
  140.  
  141.       FOR i := 1 TO nLen
  142.         IF ValType(aVar[i]) == "A"
  143.           IF Len(aVar[i]) >= nCol
  144.             xElem := aVar[i, nCol]
  145.             IF ValType(xElem) == "A"
  146.               xElem := "Array"
  147.             ENDIF
  148.           ELSE
  149.             xElem := ""
  150.           ENDIF
  151.         ELSE
  152.           xElem := aVar[i]
  153.         ENDIF
  154.  
  155.         nLongest := Max(nLongest, DataLen(xElem))
  156.       NEXT
  157.  
  158.     RETURN nLongest
  159.  
  160.  
  161.     FUNCTION DataLen(xElem)
  162.  
  163.     LOCAL nLen
  164.     LOCAL cType := ValType(xElem)
  165.  
  166.       DO CASE
  167.         CASE cType $ "ACM"
  168.           nLen := Len(xElem)
  169.  
  170.         CASE cType == "N"
  171.           nLen := Len(Str(xElem))
  172.  
  173.         CASE cType == "L"
  174.           nLen := 1
  175.  
  176.         CASE cType == "D"
  177.           nLen := 8
  178.  
  179.         CASE cType == "U"   // Value NIL
  180.           nLen := 3
  181.       ENDCASE
  182.     
  183.     RETURN nLen
  184.     
  185.     FUNCTION ArrayDisplay(oTbr, aVar, nCol)
  186.     
  187.     LOCAL rVal
  188.     
  189.       IF !(ValType(aVar[oTbr:cargo]) == "A")
  190.         IF nCol > 1
  191.           rVal := ""
  192.         ELSE
  193.           rVal := aVar[oTbr:cargo]
  194.         ENDIF
  195.       ELSEIF nCol <= Len(aVar[oTbr:cargo])
  196.         IF ValType(aVar[oTbr:cargo, nCol]) == "A"
  197.           rVal := "Array"
  198.         ELSE
  199.           rVal := aVar[oTbr:cargo, nCol]
  200.         ENDIF
  201.       ELSE
  202.         rVal := ""
  203.       ENDIF
  204.     
  205.     RETURN rVal
  206.