home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB39.PRG < prev    next >
Encoding:
Text File  |  1992-03-12  |  2.6 KB  |  129 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("*.*")
  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  := MaxCol() - 1
  40.   TBFrame(oTbrFiles)
  41.  
  42.   DO WHILE !lExitRequested
  43.     FullStabilize(oTbrFiles)
  44.     nKey := InKey(0)
  45.     IF !Stdmeth(nKey, oTbrFiles)
  46.       DO CASE
  47.         CASE nKey == K_ESC
  48.           lExitRequested := .T.
  49.       ENDCASE
  50.     ENDIF
  51.   ENDDO
  52.  
  53. RETURN NIL
  54.  
  55.  
  56. FUNCTION TBFrame(oTbr)
  57.  
  58.   @ oTbr:nTop - 1, oTbr:nLeft - 1 TO oTbr:nBottom + 1, oTbr:nRight + 1
  59.  
  60. RETURN NIL
  61.  
  62.  
  63. // As TBa2dBrw but allows headings. Column width is set to the larger
  64. // of the heading and the data width
  65.  
  66. FUNCTION TBaH2dBrw(aVar, aHeadings)
  67.  
  68. LOCAL oTbr  := TBrowseNew()
  69. LOCAL nCols := Len(aVar[1])
  70. LOCAL i
  71. LOCAL oTbc
  72.  
  73.   oTbr:cargo := 1
  74.   oTbr:goTopBlock    := {||  oTbr:cargo := 1 }
  75.   oTbr:goBottomBlock := {||  oTbr:cargo := Len(aVar) }
  76.   oTbr:skipBlock     := ARRAY_SKIPPER(oTbr:cargo, aVar)
  77.  
  78.   FOR i := 1 TO nCols
  79.     oTbc := TBColumnNew(aHeadings[i], A2DBlock(oTbr, aVar, i))
  80.     // Find width for column here ...
  81.     oTbc:width := Max(A2dWidth(aVar, i), Len(aHeadings[i]))
  82.     oTbr:addColumn(oTbc)
  83.   NEXT
  84.  
  85. RETURN oTbr
  86.  
  87.  
  88. FUNCTION A2dBlock(oTbr, aVar, nCol)
  89.  
  90. RETURN {|| aVar[oTbr:cargo, nCol] }
  91.  
  92.  
  93. FUNCTION A2dwidth(aVar, nCol)
  94.  
  95. LOCAL i
  96. LOCAL nLen := Len(aVar)
  97. LOCAL nLongest := 0
  98.  
  99.   FOR i := 1 TO nLen
  100.     nLongest := Max(nLongest, DataLen(aVar[i, nCol]))
  101.   NEXT
  102.  
  103. RETURN nLongest
  104.  
  105.  
  106. FUNCTION DataLen(xElem)
  107.  
  108. LOCAL nLen
  109. LOCAL cType := ValType(xElem)
  110.  
  111.   DO CASE
  112.     CASE cType $ "ACM"
  113.       nLen := Len(xElem)
  114.  
  115.     CASE cType == "N"
  116.       nLen := Len(Str(xElem))
  117.  
  118.     CASE cType == "L"
  119.       nLen := 1
  120.  
  121.     CASE cType == "D"
  122.       nLen := 8
  123.  
  124.     CASE cType == "U"   // Value NIL
  125.       nLen := 3
  126.   ENDCASE
  127.     
  128. RETURN nLen
  129.