home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 2004 April / VPR0404.ISO / OPENOFFICE / INSTALL / f_0097 / ReadDir.xba < prev    next >
Extensible Markup Language  |  2002-10-16  |  10KB  |  305 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
  4. Public Const SBPAGEX = 800
  5. Public Const SBPAGEY = 800
  6. Public Const SBRELDIST = 1.3
  7.  
  8. ' Names of the second Dimension of the Array iLevelPos
  9. Public Const SBBASEX = 0
  10. Public Const SBBASEY = 1
  11.  
  12. Public Const SBOLDSTARTX = 2
  13. Public Const SBOLDSTARTY = 3
  14.  
  15. Public Const SBOLDENDX = 4
  16. Public Const SBOLDENDY = 5
  17.  
  18. Public Const SBNEWSTARTX = 6
  19. Public Const SBNEWSTARTY = 7
  20.  
  21. Public Const SBNEWENDX = 8
  22. Public Const SBNEWENDY = 9
  23.  
  24. Public ConnectLevel As Integer
  25. Public iLevelPos(1,9) As Long
  26. Public Source as String
  27. Public iCurLevel as Integer
  28. Public nConnectLevel as Integer
  29. Public nOldWidth, nOldHeight As Long
  30. Public nOldX, nOldY, nOldLevel As Integer
  31. Public oOldLeavingLine As Object
  32. Public oOldArrivingLine As Object
  33. Public DlgReadDir as Object
  34. Dim oProgressBar as Object
  35. Dim oDocument As Object
  36. Dim oPage As Object
  37.  
  38.  
  39. Sub Main()
  40. Dim oStandardTemplate as Object
  41.     BasicLibraries.LoadLibrary("Tools")
  42.     oDocument = CreateNewDocument("sdraw")
  43.     If Not IsNull(oDocument) Then
  44.         oPage = oDocument.DrawPages(0)
  45.         oStandardTemplate = oDocument.StyleFamilies.GetByName("graphics").GetByName("standard")
  46.         oStandardTemplate.CharHeight = 10
  47.         oStandardTemplate.TextLeftDistance = 100
  48.         oStandardTemplate.TextRightDistance = 100
  49.         oStandardTemplate.TextUpperDistance = 50
  50.         oStandardTemplate.TextLowerDistance = 50
  51.         DlgReadDir = LoadDialog("Gimmicks","ReadFolderDlg")
  52.         oProgressBar = DlgReadDir.Model.ProgressBar1
  53.         DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings("Work"))
  54.         DlgReadDir.Model.cmdGoOn.DefaultButton = True
  55.         DlgReadDir.GetControl("TextField1").SetFocus()
  56.         DlgReadDir.Execute
  57.     End If
  58. End Sub
  59.  
  60.  
  61. Sub TreeInfo()
  62. Dim oCurTextShape As Object
  63. Dim i as Integer
  64. Dim bStartUpRun As Boolean
  65. Dim CurFilename as String
  66. Dim BaseLevel as Integer
  67. Dim oController as Object
  68. Dim MaxFileIndex as Integer
  69. Dim FileNames() as String
  70.     ToggleDialogControls(False)
  71.     oProgressBar.ProgressValueMin = 0
  72.     oProgressBar.ProgressValueMax = 100
  73.     bStartUpRun  = True
  74.     nOldHeight = 200
  75.     nOldY = SBPAGEY
  76.     nOldX = SBPAGEX
  77.     nOldWidth = SBPAGEX
  78.     oController = oDocument.GetCurrentController
  79.     Source = ConvertToURL(DlgReadDir.Model.TextField1.Text)
  80.     BaseLevel = CountCharsInString(Source, "/", 1)
  81.     oProgressBar.ProgressValue = 5
  82.     DlgReadDir.Model.Label3.Enabled = True
  83.     FileNames() = ReadSourceDirectory(Source)
  84.     DlgReadDir.Model.Label4.Enabled = True
  85.     DlgReadDir.Model.Label3.Enabled = False
  86.     oProgressBar.ProgressValue = 12
  87.     FileNames() = BubbleSortList(FileNames())
  88.     DlgReadDir.Model.Label5.Enabled = True
  89.     DlgReadDir.Model.Label4.Enabled = False
  90.     oProgressBar.ProgressValue = 20
  91.     MaxFileIndex = Ubound(FileNames(),1)
  92.     For i = 0 To MaxFileIndex
  93.         oProgressBar.ProgressValue = 20 + (i/MaxFileIndex * 80)
  94.         CurFilename = FileNames(i,1)
  95.         SetNewLevels(FileNames(i,0), BaseLevel)
  96.         oCurTextShape = CreateTextShape(oPage, CurFilename)
  97.         CheckPageWidth(oCurTextShape.Size.Width)
  98.         iLevelPos(iCurLevel,SBBASEY) = oCurTextShape.Position.Y
  99.         If i = 0 Then
  100.             AdjustPageHeight(oCurTextShape.Size.Height, MaxFileIndex + 1)
  101.         End If
  102.         ' The Current TextShape has To be connected with a TextShape one Level higher
  103.         ' except for a TextShape In Level 0:
  104.         If Not bStartUpRun Then
  105.             ' A leaving Line Is only drawn when level is not 0
  106.             If iCurLevel<> 0 Then
  107.                 ' Determine the Coordinates of the arriving Line
  108.                 iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  109.                 iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  110.  
  111.                 iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX)
  112.                 iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  113.  
  114.                 oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage)
  115.  
  116.                 ' Determine the End-Coordinates of the last leaving Line
  117.                 iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  118.                 iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  119.             Else
  120.                 ' On Level 0 the last Leaving Line's Endpoint is the upper edge of the TextShape
  121.                 iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y
  122.                 iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  123.             End If
  124.             ' Draw the Connectors To the previous TextShapes
  125.             oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
  126.         Else
  127.             ' StartingPoint of the leaving Edge
  128.             bStartUpRun = FALSE
  129.         End If
  130.  
  131.         ' Determine the beginning Coordinates of the leaving Line
  132.         iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width
  133.         iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height
  134.  
  135.         ' Save the values For the Next run
  136.         nOldHeight = oCurTextShape.Size.Height
  137.         nOldX = oCurTextShape.Position.X
  138.         nOldWidth = oCurTextShape.Size.Width
  139.         nOldLevel = iCurLevel
  140.     Next i
  141.     ToggleDialogControls(True)
  142.     DlgReadDir.Model.cmdGoOn.Enabled = False    
  143. End Sub
  144.  
  145.  
  146. Function CreateTextShape(oPage as Object, Filename as String)
  147. Dim oTextShape As Object
  148. Dim aPoint As New com.sun.star.awt.Point
  149.  
  150.     aPoint.X = CalculateXPoint()
  151.     aPoint.Y = nOldY + SBRELDIST * nOldHeight
  152.     nOldY  = aPoint.Y
  153.  
  154.     oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape")
  155.     oTextShape.LineStyle = 1
  156.     oTextShape.Position = aPoint
  157.  
  158.     oPage.add(oTextShape)
  159.     oTextShape.TextAutoGrowWidth = TRUE
  160.     oTextShape.TextAutoGrowHeight = TRUE
  161.     oTextShape.String = FileName
  162.  
  163.     ' Configure Size And Position of the TextShape  according to its Scripting
  164.     aPoint.X = iLevelPos(iCurLevel,SBBASEX)
  165.     oTextShape.Position = aPoint
  166.     CreateTextShape() = oTextShape
  167. End Function
  168.  
  169.  
  170. Function CalculateXPoint()
  171.     ' The current level Is lower than the Old one
  172.     If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then
  173.     ' ClearArray(iLevelPos(),iCurLevel+1)
  174.     Elseif iCurLevel= 0 Then
  175.         iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
  176.     ' The current level Is higher than the old one
  177.     Elseif iCurLevel> nOldLevel Then
  178.         iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
  179.     End If
  180.     CalculateXPoint = iLevelPos(iCurLevel,SBBASEX)
  181. End Function
  182.  
  183.  
  184. Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object)
  185. Dim oConnect As Object
  186. Dim aPoint As New com.sun.star.awt.Point
  187. Dim aSize As New com.sun.star.awt.Size
  188.     aPoint.X = iLevelPos(nLevel,nStartX)
  189.     aPoint.Y = iLevelPos(nLevel,nStartY)
  190.     aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX)
  191.     aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY)
  192.     oConnect = oDocument.createInstance("com.sun.star.drawing.LineShape")
  193.     oConnect.Position = aPoint
  194.     oConnect.Size = aSize
  195.     oPage.Add(oConnect)
  196.     DrawLine() = oConnect
  197. End Function
  198.  
  199.  
  200. Sub GetSourceDirectory()
  201.     GetFolderName(DlgReadDir.Model.TextField1)
  202. End Sub
  203.  
  204.  
  205. Function ReadSourceDirectory(ByVal Source As String)
  206. Dim i as Integer
  207. Dim m as Integer
  208. Dim n as Integer
  209. Dim s as integer
  210. Dim FileName as string
  211. Dim FileNameList(100,1) as String
  212. Dim DirList(0) as String
  213. Dim oUCBobject as Object
  214. Dim DirContent() as String
  215. Dim SystemPath as String
  216. Dim PathSeparator as String
  217. Dim MaxFileIndex as Integer
  218.     PathSeparator = GetPathSeparator()
  219.     oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  220.     m = 0
  221.     s = 0
  222.     DirList(0) = Source
  223.     FileNameList(n,0) = Source
  224.     SystemPath = ConvertFromUrl(Source)
  225.     FileNameList(n,1) = FileNameoutofPath(SystemPath, PathSeparator)
  226.     n = 1
  227.     Do
  228.         Source = DirList(m)
  229.         m = m + 1
  230.         DirContent() = oUcbObject.GetFolderContents(Source,True)
  231.         If Ubound(DirContent()) <> -1 Then
  232.             MaxFileIndex  = Ubound(DirContent()) 
  233.             For i = 0 to MaxFileIndex
  234.                 FileName = DirContent(i)
  235.                 FileNameList(n,0) = FileName
  236.                 SystemPath = ConvertFromUrl(FileName)
  237.                 FileNameList(n,1) = FileNameOutofPath(SystemPath, PathSeparator)
  238.                 n = n + 1
  239.                 If n > Ubound(FileNameList(),1) Then
  240.                     ReDim Preserve FileNameList(n + 10,1) as String
  241.                 End If
  242.                 If oUcbObject.IsFolder(FileName) Then
  243.                     s = s + 1
  244.                     ReDim Preserve DirList(s) as String
  245.                     DirList(s) = FileName
  246.                 End If
  247.             Next i
  248.         End If
  249.     Loop Until m > Ubound(DirList()
  250.     ReDim Preserve FileNameList(n-1,1) as String
  251.     ReadSourceDirectory() = FileNameList()
  252. End Function
  253.  
  254.  
  255. Sub CloseDialog
  256.     DlgReadDir.EndExecute
  257. End Sub
  258.  
  259.  
  260. Sub    AdjustPageHeight(lShapeHeight, FileCount)
  261. Dim lNecHeight as Long
  262. Dim lBorders as Long
  263.     oDocument.LockControllers
  264.     lBorders = oPage.BorderTop + oPage.BorderBottom
  265.     lNecHeight = SBPAGEY + (FileCount * SBRELDIST * lShapeHeight)
  266.     If lNecHeight > (oPage.Height - lBorders) Then
  267.         oPage.Height = lNecHeight + lBorders + 500 
  268.     End If
  269.     oDocument.UnlockControllers    
  270. End Sub
  271.  
  272.  
  273. Sub SetNewLevels(FileName as String, BaseLevel as Integer)
  274.     iCurLevel= CountCharsInString(FileName, "/", 1) - BaseLevel
  275.     If iCurLevel <> 0 Then
  276.         nConnectLevel = iCurLevel- 1
  277.     Else
  278.         nConnectLevel = iCurLevel
  279.     End If
  280.     If iCurLevel > Ubound(iLevelPos(),1) Then
  281.         ReDim Preserve iLevelPos(iCurLevel,9) as Long
  282.     End If
  283. End Sub
  284.  
  285.  
  286. Sub CheckPageWidth(TextWidth as Long)
  287. Dim PageWidth as Long
  288. Dim BaseX as Long
  289.     PageWidth = oPage.Width
  290.     BaseX = iLevelPos(iCurLevel,SBBASEX)
  291.     If BaseX + TextWidth > PageWidth - 1000 Then
  292.         oPage.Width = 1000 + BaseX + TextWidth
  293.     End If
  294. End Sub
  295.  
  296.  
  297. Sub ToggleDialogControls(bDoEnable as Boolean)
  298.     With DlgReadDir.Model
  299.         .cmdGoOn.Enabled = bDoEnable
  300.         .cmdGetDir.Enabled = bDoEnable
  301.         .Label1.Enabled = bDoEnable
  302.         .Label2.Enabled = bDoEnable
  303.         .TextField1.Enabled = bDoEnable
  304.     End With
  305. End Sub</script:module>