home *** CD-ROM | disk | FTP | other *** search
/ com!online 2001 December / COMCD1201.iso / openoffice / f_0177 / ReadDir.xba < prev    next >
Encoding:
Extensible Markup Language  |  2001-04-25  |  9.1 KB  |  299 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2.  
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
  4. ' Verzeichnis StarOne ├╝berpr├╝fen (letzte beiden Dateien)
  5. ' Ordnung nach Verzeichnis und dann die Dateien ( indem "AAAA" vor den Verzeichnisnamen gesetzt wird).
  6. ' Nicht-Verzeichnisnamen abfangen
  7. Const SBBASEWIDTH = 8000
  8. Const SBBASEHEIGHT = 1000
  9. Const SBPAGEX = 800
  10. Const SBPAGEY = 800
  11. Const SBBASECHARHEIGHT = 12
  12. Const SBRELDIST = 1.1
  13.  
  14. REM Names of the second Dimension of the Array iLevelPos
  15. Const SBBASEX = 0
  16. Const SBBASEY = 1
  17.  
  18. Const SBOLDSTARTX = 2
  19. Const SBOLDSTARTY = 3
  20.  
  21. Const SBOLDENDX = 4
  22. Const SBOLDENDY = 5
  23.  
  24. Const SBNEWSTARTX = 6
  25. Const SBNEWSTARTY = 7
  26.  
  27. Const SBNEWENDX = 8
  28. Const SBNEWENDY = 9
  29.  
  30. Public ConnectLevel As Integer
  31. Public iLevelPos(10,9) As Integer
  32. Public Source as String
  33. Public iCurLevel, nConnectLevel as Integer
  34. Public nOldWidth, nOldHeight As Integer
  35. Public nOldX, nOldY, nOldLevel As Integer
  36. Public oOldLeavingLine As Object
  37. Public oOldArrivingLine As Object
  38.  
  39.  
  40. Sub Main
  41.         BasicLibraries.LoadLibrary("Tools")
  42.         BasicLibraries.LoadLibrary("Template")
  43.     ReadDirDlg.Load
  44.     ReadDirDlg.Show
  45. End Sub
  46.  
  47.  
  48. Sub TreeInfo()
  49. Dim oCurTextShape As Object
  50. Dim oDesktop As Object
  51. Dim oDocument As Object
  52. Dim iCurPage As Integer
  53. Dim oPage As Object
  54. Dim oOldPage As Object
  55. Dim i, n, s  as Integer
  56. Dim bStartUpRun As Boolean
  57. Dim FileNames(600,2) as String
  58. Dim CurFile as String
  59. Dim BaseLevel as Integer
  60. Dim oController as Object
  61. Dim FileCount as Integer
  62. Dim oStatusline as Object
  63.     ReadDirDlg.Unload
  64.     bStartUpRun  = TRUE
  65.     nOldHeight = 200
  66.     nOldY = SBPAGEY
  67.     nOldX = SBPAGEX
  68.     nOldWidth = SBPAGEX
  69.     iCurPage = 0
  70.  
  71.     oDesktop = createUnoService("com.sun.star.frame.Desktop")
  72.     oDocument = StarDesktop.ActiveFrame.Controller.Model
  73.     oPage = oDocument.DrawPages(iCurPage)
  74.     oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator
  75.     oStatusLine.Start("Fortschritt:",100)
  76.     oController = oDocument.GetCurrentController
  77.     Source = ConvertToURL(ReadDirdlg.Textbox1.Text)
  78.     BaseLevel = CountCharsInString(Source, "/", 1)
  79.  
  80.     oStatusline.SetValue(2)
  81.     FileNames() = ReadSourceDirectory(Source)
  82.     oStatusline.SetValue(8)
  83.     FileNames() = BubbleSortList(FileNames())
  84.     oStatusline.SetValue(10)
  85.  
  86.     FileCount = Val(FileNames(0,0))
  87.     For i = 1 To FileCount
  88.         oStatusLine.SetValue(10 + i/FileCount * 90)
  89.         CurFile = FileNames(i,1)
  90.         iCurLevel= CountCharsInString(FileNames(i,0), "/", 1) - BaseLevel
  91.         If iCurLevel <> 0 Then
  92.             nConnectLevel = iCurLevel- 1
  93.         Else
  94.             nConnectLevel = iCurLevel
  95.         End If
  96.  
  97. REM     Add New page If necessary
  98. REM    ck    IF nOldY + nOldHeight * 1/SBRELDIST > oPage.Height - SBPAGEY Then
  99.         IF nOldY + (nOldHeight + SBBASECHARHEIGHT) * 1.5 > oPage.Height - SBPAGEY Then
  100.             iCurPage = iCurPage + 1
  101.             oDocument.getDrawPages.InsertNewbyIndex(iCurPage)
  102.  
  103.             oPage = oDocument.DrawPages(iCurPage)
  104.             oController.SetCurrentPage (oPage)
  105.  
  106.             For n = 0 To nConnectLevel
  107.                 iLevelPos(n,SBNEWENDY) = nOldY + nOldHeight REM oOldPage.Height
  108.                 oOldLeavingLine = DrawLine(n, SBNEWSTARTX, SBNEWSTARTY, SBNEWSTARTX, SBNEWENDY, oOldPage)
  109. REM    ck                                       SBNEWENDX, SBNEWENDY)
  110.             Next
  111.             For n = 0 To nConnectLevel
  112.                 iLevelPos(n,SBNEWSTARTY) = SBPAGEY
  113.             Next
  114.             nOldY = SBPAGEY
  115.         End If
  116.         oCurTextShape = CreateTextShape(oPage, CurFile)
  117.  
  118. REM     The Current TextShape has To be connected with a TextShape
  119. REM  one Level higher
  120. REM     - except For a TextShape In Level 0
  121.  
  122. REM     Line Coordinates
  123.         If Not bStartUpRun Then
  124.  
  125. REM     A leaving Line Is only drawn when level is not 0
  126.             If iCurLevel<> 0 Then
  127. REM     Determine the Coordinates of the arriving Line
  128.                 iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  129.                 iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  130.  
  131.                 iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX)
  132.                 iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  133.  
  134.                 oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage)
  135.  
  136. REM     Determine the End-Coordinates of the last leaving Line
  137.                 iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  138.                 iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
  139.             Else
  140. REM    On Level 0 the last Leaving Line's endpoint
  141. REM is the upper edge of the textShape
  142.                 iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y
  143.                 iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
  144.             End If
  145. REM     Draw the Connectors To the previous TextShapes
  146.             oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
  147.         Else
  148. REM     StartingPoint of the leaving edge
  149.             bStartUpRun = FALSE
  150.         End If
  151.  
  152. REM     Determine the beginning Coordinates of the leaving Line
  153.         iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width
  154.         iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height
  155.  
  156. REM    Save the values For the Next run
  157.         nOldHeight = oCurTextShape.Size.Height
  158.         nOldX = oCurTextShape.Position.X
  159.         nOldWidth = oCurTextShape.Size.Width
  160.         nOldLevel = iCurLevel
  161.         Set oOldPage = oPage
  162.     Next i
  163.     oStatusLine.End
  164.     Exit Sub
  165. ErrorHandler:
  166.     MsgBox error, 0,"Error in Line" & erl
  167. End Sub
  168.  
  169.  
  170.  
  171. Function CreateTextShape(oPage as Object, Filename as String)
  172. Dim oTextShape As Object
  173. Dim PageWidth, BaseX, TextWidth
  174. Dim aPoint As New com.sun.star.awt.Point
  175. Dim aSize As New com.sun.star.awt.Size
  176.  
  177.     aSize.Width = SBBASEWIDTH
  178.     aSize.Height = SBBASEHEIGHT
  179.  
  180.     aPoint.x = CalculateXPoint()
  181.     aPoint.y = nOldY + SBRELDIST * nOldHeight
  182.     nOldY  = aPoint.y
  183.  
  184.     oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape")
  185.     oTextShape.Size = aSize
  186.     oTextShape.Position = aPoint
  187.  
  188.     oPage.add(oTextShape)
  189.     oTextShape.LineStyle = 1
  190.     oTextShape.Charheight = SBBASECHARHEIGHT
  191.     oTextShape.TextAutoGrowWidth = TRUE
  192.     oTextShape.TextAutoGrowHeight = TRUE
  193.     oTextShape.String = FileName
  194.  
  195. REM     Configure Size And Position of the TextShape  according to its Scripting
  196.     aPoint.x = iLevelPos(iCurLevel,SBBASEX)
  197.     oTextShape.Position = aPoint
  198.     aSize.Height = SBRELDIST * oTextShape.CharHeight
  199.     aSize.Width = SBRELDIST * oTextShape.Size.Width
  200.  
  201.     PageWidth = oPage.Width
  202.     TextWidth = aSize.Width
  203.     BaseX = aPoint.x
  204.     If BaseX + TextWidth > PageWidth - 1000 Then
  205.         oPage.Width = 1000 + BaseX + TextWidth
  206.     End If
  207.     oTextShape.Size = aSize
  208.     iLevelPos(iCurLevel,SBBASEY) = oTextShape.Position.Y
  209.     CreateTextShape = oTextShape
  210. End Function
  211.  
  212.  
  213.  
  214. Function CalculateXPoint()
  215.  
  216. REM     The current level Is lower than the Old one
  217.     If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then
  218. REM        ClearArray(iLevelPos(),iCurLevel+1)
  219.     Elseif iCurLevel= 0 Then
  220.         iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
  221. REM     The current level Is higher than the old one
  222.     Elseif iCurLevel> nOldLevel Then
  223.         iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
  224.     End If
  225.     CalculateXPoint = iLevelPos(iCurLevel,SBBASEX)
  226. End Function
  227.  
  228.  
  229.  
  230. Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object)
  231. Dim oConnect As Object
  232.  
  233.     aPoint.X = iLevelPos(nLevel,nStartX)
  234.     aPoint.Y = iLevelPos(nLevel,nStartY)
  235.     aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX)
  236.     aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY)
  237.  
  238.     oConnect = oDocument.createInstance("com.sun.star.drawing.LineShape")
  239.  
  240.     oConnect.Position = aPoint
  241.     oConnect.Size = aSize
  242.     oPage.Add(oConnect)
  243.  
  244.     DrawLine = oConnect
  245. End Function
  246.  
  247.  
  248. Sub SourceSearchDialog()
  249.     Source = Application.FileDialog( "P", "W├ñhlen Sie ein Verzeichnis", "D:\Arbeitsverzeichnis" )  ' "W├ñhlen Sie ein Verzeichnis"
  250.     If Len( Source ) > 0 Then
  251.         ReadDirDlg.Textbox1.Text = Source
  252.     End If
  253. End Sub
  254.  
  255.  
  256.  
  257. Function ReadSourceDirectory(ByVal Source As String)
  258. Dim i, m, n, s as integer
  259. Dim FileCount As Integer
  260. Dim FileCountinDir as Integer
  261. Dim FileName as string
  262. Dim FileNameList(2000,1) as String
  263. Dim DirList(200) as String
  264. Dim oUCBobject as Object
  265.  
  266.     oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  267.     'isfolder
  268.     m = 0
  269.     s = 1
  270.     DirList(0) = Source
  271.     FileNameList(1,0) = Source
  272.     FileNameList(1,1) = GetFileNameoutofPath(Source)
  273.     n = 2
  274.     Do
  275.         Source = DirList(m)
  276.         m = m + 1
  277.  
  278.         DirContent = oUcbObject.GetFolderContents(Source,True)
  279.  
  280.         If Ubound(DirContent()) <> -1 Then
  281.             FileCountinDir = Ubound(DirContent()) + 1
  282.             For i = 0 to FilecountinDir -1
  283.                 FileName = DirContent(i)
  284.                 FilenameList(n,0) = FileName
  285.                 FileNameList(n,1) = GetFileNameOutofPath(FileName)
  286.                 n = n + 1
  287.                 If oUcbObject.IsFolder(FileName) Then
  288.                     DirList(s) = FileName
  289.                     DirList(0) = CStr(s)
  290.                     s = s + 1
  291.                 End If
  292.             Next i
  293.         End If
  294.     Loop Until m  = cInt(DirList(0))+ 1
  295.     FileNameList(0,0) = n - 1
  296.     ReadSourceDirectory = FileNameList()
  297. End Function
  298. </script:module>
  299.