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