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