home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / DirGraph249778202001.psc / DrawTree.bas < prev    next >
Encoding:
BASIC Source File  |  2001-06-03  |  6.8 KB  |  143 lines
  1. Attribute VB_Name = "modDrawTree"
  2. Option Explicit
  3. Const micBackCol     As Long = &HE0E0E0
  4. Const micDirCol      As Long = &HFFFFFF
  5. Const micFileCol     As Long = &HF0F0F0
  6. Const micLineCol     As Long = &H0
  7. Const micFileTextCol As Long = &H666666
  8.  
  9. '
  10. ' Draw the given tree in the given picturebox
  11. ' iTop and iBottom are adhered to as limits
  12. ' iLeft and iRight are used for top level object only
  13. ' [will be moves iRight-iLeft to the right each level]
  14. '
  15. Public Sub DrawTree(oDir As iDirObj, iMaxDepth As Long, oPic As PictureBox, iLeft As Currency, iRight As Currency, iTop As Currency, iBottom As Currency)
  16.  
  17. Dim sName        As String
  18. Dim sSize        As String
  19. Dim bCanFit2Rows As Boolean
  20. Dim bTooLong    As Boolean
  21.  
  22. Dim oSubDir       As iDirObj
  23. Dim iSubLeft      As Currency
  24. Dim iSubRight     As Currency
  25. Dim iSubTop       As Currency
  26. Dim iSubBottom    As Currency
  27. Dim iSubDisplayed As Currency
  28. Dim iSubSkipped   As Currency
  29. Dim iSubSkippedF  As Currency
  30. Dim oDateSkippedA As clsChkDate
  31. Dim oDateSkippedC As clsChkDate
  32.     
  33.     ' draw own box
  34.     oPic.Line (iLeft, iTop)-(iRight, iBottom), micDirCol, BF
  35.     oPic.Line (iLeft, iTop)-(iRight, iBottom), micLineCol, B
  36.     If GetSetting("DJS", App.Title, gcsRegColour, gcsDefColour) > 0 And iBottom - iTop > 3 Then
  37.         oPic.Line (iLeft + 2, iTop + 2)-(iRight - 2, iBottom - 2), oDir.Colour, B
  38.     End If
  39.     
  40.     ' print name
  41.     If iBottom - iTop > oPic.TextHeight(sName) * 2 + 2 Then
  42.         oPic.CurrentY = iTop + (iBottom - iTop - oPic.TextHeight(sName) * 2) / 2
  43.         bCanFit2Rows = True
  44.     Else
  45.         oPic.CurrentY = iTop + (iBottom - iTop - oPic.TextHeight(sName)) / 2
  46.         bCanFit2Rows = False
  47.     End If
  48.     sName = oDir.Name
  49.     bTooLong = False
  50.     If Not bCanFit2Rows Then
  51.         sName = sName & " " & FormatSize(oDir.TotalSize)
  52.         Do While oPic.TextWidth(sName) > (iRight - iLeft - 8)
  53.             sName = Right(sName, Len(sName) - 1)
  54.             bTooLong = True
  55.         Loop
  56.         If bTooLong Then
  57.             sName = "..." & sName
  58.             Do While oPic.TextWidth(sName) > (iRight - iLeft - 8)
  59.                 sName = Left(sName, Len(sName) - 1)
  60.                 bTooLong = True
  61.             Loop
  62.         End If
  63.     Else
  64.         Do While oPic.TextWidth(sName) > (iRight - iLeft - 8)
  65.             sName = Left(sName, Len(sName) - 1)
  66.             bTooLong = True
  67.         Loop
  68.         If bTooLong Then
  69.             sName = sName & "..."
  70.             Do While oPic.TextWidth(sName) > (iRight - iLeft - 8)
  71.                 sName = Left(sName, Len(sName) - 4) & "..."
  72.                 bTooLong = True
  73.             Loop
  74.         End If
  75.     End If
  76.     oPic.ForeColor = micLineCol
  77.     oPic.CurrentX = iLeft + (iRight - iLeft - oPic.TextWidth(sName)) / 2
  78.     oPic.Print sName
  79.     
  80.     ' get size
  81.     If bCanFit2Rows Then
  82.         sSize = FormatSize(oDir.TotalSize)
  83.         If oPic.TextWidth(sSize) > (iRight - iLeft - 8) Then
  84.             sSize = "."
  85.         End If
  86.         oPic.CurrentX = iLeft + (iRight - iLeft - oPic.TextWidth(sSize)) / 2
  87.         oPic.ForeColor = micLineCol
  88.         oPic.Print sSize
  89.     End If
  90.     
  91.     ' init
  92.     iSubDisplayed = 0
  93.     iSubSkipped = 0
  94.     Set oDateSkippedA = New clsChkDate
  95.     Set oDateSkippedC = New clsChkDate
  96.     oDateSkippedA.ResetCount
  97.     oDateSkippedC.ResetCount
  98.     
  99.     ' do subdirs and files
  100.     If iMaxDepth > 0 Then
  101.         iSubLeft = iLeft + (iRight - iLeft)
  102.         iSubRight = iRight + (iRight - iLeft)
  103.         For Each oSubDir In oDir.Children
  104.             If oSubDir.TotalSize * (iBottom - iTop) / oDir.TotalSize > oPic.TextHeight("text") + 2 Then
  105.                 'Debug.Print "*" & oSubDir.Name, FormatSize(oSubDir.TotalSize), FormatSize(oDir.TotalSize), Int(CDbl(oSubDir.TotalSize) / CDbl(oDir.TotalSize) * (iBottom - iTop)), oPic.TextHeight("text") * 2
  106.                 ' display sub dir
  107.                 iSubTop = (iBottom - iTop) / oDir.TotalSize * iSubDisplayed + iTop
  108.                 iSubDisplayed = iSubDisplayed + oSubDir.TotalSize
  109.                 iSubBottom = (iBottom - iTop) / oDir.TotalSize * iSubDisplayed + iTop
  110.                 DrawTree oSubDir, iMaxDepth - 1, oPic, iSubLeft, iSubRight, iSubTop, iSubBottom
  111.             Else
  112.                 'Debug.Print oSubDir.Name, FormatSize(oSubDir.TotalSize), FormatSize(oDir.TotalSize), Int(CDbl(oSubDir.TotalSize) / CDbl(oDir.TotalSize) * (iBottom - iTop)), oPic.TextHeight("text") * 2
  113.                 ' skip: is too small to fix text so will group with other smalls later
  114.                 iSubSkipped = iSubSkipped + oSubDir.TotalSize
  115.                 iSubSkippedF = iSubSkippedF + oSubDir.OwnSize
  116.                 oDateSkippedA.AddDate oSubDir.MostRecentDateAccess
  117.                 oDateSkippedC.AddDate oSubDir.MostRecentDateChange
  118.             End If
  119.         Next
  120.         ' now a box for the skipped dirs, if 'small dirs summary' option is on
  121.         If GetSetting("DJS", App.Title, gcsRegIncludeSmall, gcsDefIncSmall) <> 0 Then
  122.             iSubTop = (iBottom - iTop) / oDir.TotalSize * iSubDisplayed + iTop
  123.             iSubDisplayed = iSubDisplayed + iSubSkipped
  124.             iSubBottom = (iBottom - iTop) / oDir.TotalSize * iSubDisplayed + iTop
  125.             If iSubBottom - iSubTop > 1 Then
  126.                 oPic.Line (iSubLeft, iSubTop)-(iSubRight, iSubBottom), micDirCol, BF
  127.                 oPic.Line (iSubLeft, iSubTop)-(iSubRight, iSubBottom), micLineCol, B
  128.                 If GetSetting("DJS", App.Title, gcsRegColour, gcsDefColour) > 0 And iSubBottom - iSubTop > 3 Then
  129.                     If GetSetting("DJS", App.Title, gcsRegColour, gcsDefColour) = 1 Then
  130.                         oPic.Line (iSubLeft + 2, iSubTop + 2)-(iSubRight - 2, iSubBottom - 2), oDateSkippedC.Colour, B
  131.                     ElseIf GetSetting("DJS", App.Title, gcsRegColour, gcsDefColour) = 2 Then
  132.                         oPic.Line (iSubLeft + 2, iSubTop + 2)-(iSubRight - 2, iSubBottom - 2), oDateSkippedA.Colour, B
  133.                     End If
  134.                 End If
  135.                 NavAdd iSubLeft, iSubRight, iSubTop, iSubBottom, "Small dirs in " & oDir.Path & ": " & FormatSize(iSubSkipped) & " (total)", Nothing
  136.                 If iSubBottom - iSubTop > oPic.TextHeight("M") + 2 Then
  137.                     sSize = "(" & FormatSize(iSubSkipped) & ")"
  138.                     oPic.CurrentX = iSubLeft + (((iSubRight - iSubLeft) - oPic.TextWidth(sSize)) / 2)
  139.                     oPic.CurrentY = iSubTop + (((iSubBottom - iSubTop) - oPic.TextHeight(sf iMaxDepth > 0 Then
  140.         iSubLeft.o
  141. oPic.TSize = "(" & FormatSiDttr.MostRecentDateChange
  142.       & Foour, gcsDefCoBnge
  143.       & Foour, gcsDefCoBmr) > 0 LLLLLLLLLLLLLLLLLLLLLLLlgcsDir.Tht, iSubTop, iSubBottom, "Small dirs in " & oDir.Path & ": " & FormatSize5ize = "(" & FormatSiDop)  ' get  2)-(iSutr.Tht, iSubTop, iSubeaurrency
  144. rLLlgcsDir.Tht, )eT- - oPic.TextHeight(sf iMaxefCoietHeight(sf iMaxefCoietHeil
  145.