home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB312.PRG < prev    next >
Encoding:
Text File  |  1992-03-09  |  3.5 KB  |  153 lines
  1. // Tb312.prg
  2. //
  3. // Browsing database file names and their structures
  4. // Optimized version of tb311. Does not rebuild "structures" TBrowse
  5. // object each time. If the database changes, this version simply updates
  6. // the array reference, stored in cargo.
  7.  
  8. #include "Inkey.ch"
  9. #include "Dbstruct.ch"
  10. #include "Directry.ch"
  11. #include "Tbutils.ch"
  12.  
  13. FUNCTION Tb312
  14.  
  15. LOCAL aFiles := Directory("*.dbf")
  16. LOCAL aStru
  17. LOCAL nKey
  18.  
  19. // The TBrowse object to display the DBF file names
  20. LOCAL oTbrFiles
  21.  
  22. // The TBrowse object to display the current DBF's structure
  23. LOCAL oTbrStrus
  24. LOCAL lExitRequested := .F.
  25. LOCAL cLastDbf := ""
  26.  
  27.   SET CURSOR OFF
  28.   CLEAR SCREEN
  29.  
  30.   oTbrFiles := TBaH2dBrw(aFiles, ;
  31.                          {"Name", "      Size", ;
  32.                           "Date", "Time", "Attr"})
  33.  
  34.   oTbrFiles:nTop    := 1
  35.   oTbrFiles:nLeft   := 1
  36.   oTbrFiles:nBottom := MaxRow() - 1
  37.   oTbrFiles:nRight  := 39
  38.   TBFrame(oTbrFiles)
  39.  
  40.   USE (aFiles[oTbrFiles:cargo[1], F_NAME])
  41.   aStru := DbStruct()
  42.   CLOSE (aFiles[oTbrFiles:cargo[1], F_NAME])
  43.  
  44.   oTbrStrus := TBaH2dBrw(aStru, ;
  45.                          { "Name", "Type", ;
  46.                            "       Len", "       Dec" })
  47.  
  48.   oTbrStrus:nTop    := 1
  49.   oTbrStrus:nLeft   := 42
  50.   oTbrStrus:nBottom := MaxRow() - 1
  51.   oTbrStrus:nRight  := 78
  52.   TBFrame(oTbrStrus)
  53.  
  54.   DO WHILE !lExitRequested
  55.     FullStabilize(oTbrFiles)
  56.     IF !(cLastDbf == aFiles[oTbrFiles:cargo[1], F_NAME])
  57.       USE (aFiles[oTbrFiles:cargo[1], F_NAME])
  58.       aStru := DbStruct()
  59.       // Just update array reference directly
  60.       oTbrStrus:cargo[2] := aStru
  61.       CLOSE (aFiles[oTbrFiles:cargo[1], F_NAME])
  62.       oTbrStrus:refreshAll()
  63.       FullStabilize(oTbrStrus)
  64.       oTbrStrus:deHilite()
  65.     ENDIF
  66.     nKey := InKey(0)
  67.     IF !Stdmeth(nKey, oTbrFiles)
  68.       DO CASE
  69.         CASE nKey == K_ESC
  70.           lExitRequested := .T.
  71.       ENDCASE
  72.     ENDIF
  73.   ENDDO
  74.  
  75. RETURN NIL
  76.  
  77.  
  78. FUNCTION TBFrame(oTbr)
  79.  
  80.   @ oTbr:nTop - 1, oTbr:nLeft - 1 TO oTbr:nBottom + 1, oTbr:nRight + 1
  81.  
  82. RETURN NIL
  83.  
  84.  
  85. // As TBa2dBrw but allows headings. Column width is set to the larger
  86. // of the heading and the data width
  87.  
  88. FUNCTION TBaH2dBrw(aVar, aHeadings)
  89.  
  90. LOCAL oTbr  := TBrowseNew()
  91. LOCAL nCols := Len(aVar[1])
  92. LOCAL i
  93. LOCAL oTbc
  94.  
  95.   // We maintain cargo as a two element array, where the first element
  96.   // contains the row number, the second a reference to the array to
  97.   // browse
  98.   oTbr:cargo := {1, aVar}
  99.   oTbr:goTopBlock    := {||  oTbr:cargo[1] := 1 }
  100.   oTbr:goBottomBlock := {||  oTbr:cargo[1] := Len(aVar) }
  101.   oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo[1], oTbr:cargo[2])
  102.  
  103.   FOR i := 1 TO nCols
  104.     oTbc := TBColumnNew(aHeadings[i], A2DBlock(oTbr, i))
  105.     // Find width for column here ...
  106.     oTbc:width := Max(A2dWidth(aVar, i), Len(aHeadings[i]))
  107.     oTbr:addColumn(oTbc)
  108.   NEXT
  109.  
  110. RETURN oTbr
  111.  
  112.  
  113. FUNCTION A2dBlock(oTbr, nCol)
  114.  
  115. RETURN {|| oTbr:cargo[2, oTbr:cargo[1], nCol] }
  116.  
  117. FUNCTION A2dwidth(aVar, nCol)
  118.  
  119. LOCAL i
  120. LOCAL nLen := Len(aVar)
  121. LOCAL nLongest := 0
  122.  
  123.   FOR i := 1 TO nLen
  124.     nLongest := Max(nLongest, DataLen(aVar[i, nCol]))
  125.   NEXT
  126.  
  127. RETURN nLongest
  128.  
  129.  
  130. FUNCTION DataLen(xElem)
  131.  
  132. LOCAL nLen
  133. LOCAL cType := ValType(xElem)
  134.  
  135.   DO CASE
  136.     CASE cType $ "ACM"
  137.       nLen := Len(xElem)
  138.  
  139.     CASE cType == "N"
  140.       nLen := Len(Str(xElem))
  141.  
  142.     CASE cType == "L"
  143.       nLen := 1
  144.  
  145.     CASE cType == "D"
  146.       nLen := 8
  147.  
  148.     CASE cType == "U"   // Value NIL
  149.       nLen := 3
  150.   ENDCASE
  151.     
  152. RETURN nLen
  153.