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