| <?xml version="1.0" encoding="UTF-8"?> |
| <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> |
| <!--*********************************************************** |
| * |
| * Licensed to the Apache Software Foundation (ASF) under one |
| * or more contributor license agreements. See the NOTICE file |
| * distributed with this work for additional information |
| * regarding copyright ownership. The ASF licenses this file |
| * to you under the Apache License, Version 2.0 (the |
| * "License"); you may not use this file except in compliance |
| * with the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, |
| * software distributed under the License is distributed on an |
| * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| * KIND, either express or implied. See the License for the |
| * specific language governing permissions and limitations |
| * under the License. |
| * |
| ***********************************************************--> |
| <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit |
| Public Const SBPAGEX = 800 |
| Public Const SBPAGEY = 800 |
| Public Const SBRELDIST = 1.3 |
| |
| ' Names of the second Dimension of the Array iLevelPos |
| Public Const SBBASEX = 0 |
| Public Const SBBASEY = 1 |
| |
| Public Const SBOLDSTARTX = 2 |
| Public Const SBOLDSTARTY = 3 |
| |
| Public Const SBOLDENDX = 4 |
| Public Const SBOLDENDY = 5 |
| |
| Public Const SBNEWSTARTX = 6 |
| Public Const SBNEWSTARTY = 7 |
| |
| Public Const SBNEWENDX = 8 |
| Public Const SBNEWENDY = 9 |
| |
| Public ConnectLevel As Integer |
| Public iLevelPos(1,9) As Long |
| Public Source as String |
| Public iCurLevel as Integer |
| Public nConnectLevel as Integer |
| Public nOldWidth, nOldHeight As Long |
| Public nOldX, nOldY, nOldLevel As Integer |
| Public oOldLeavingLine As Object |
| Public oOldArrivingLine As Object |
| Public DlgReadDir as Object |
| Dim oProgressBar as Object |
| Dim oDocument As Object |
| Dim oPage As Object |
| |
| |
| Sub Main() |
| Dim oStandardTemplate as Object |
| BasicLibraries.LoadLibrary("Tools") |
| oDocument = CreateNewDocument("sdraw") |
| If Not IsNull(oDocument) Then |
| oPage = oDocument.DrawPages(0) |
| oStandardTemplate = oDocument.StyleFamilies.GetByName("graphics").GetByName("standard") |
| oStandardTemplate.CharHeight = 10 |
| oStandardTemplate.TextLeftDistance = 100 |
| oStandardTemplate.TextRightDistance = 100 |
| oStandardTemplate.TextUpperDistance = 50 |
| oStandardTemplate.TextLowerDistance = 50 |
| DlgReadDir = LoadDialog("Gimmicks","ReadFolderDlg") |
| oProgressBar = DlgReadDir.Model.ProgressBar1 |
| DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings("Work")) |
| DlgReadDir.Model.cmdGoOn.DefaultButton = True |
| DlgReadDir.GetControl("TextField1").SetFocus() |
| DlgReadDir.Execute |
| End If |
| End Sub |
| |
| |
| Sub TreeInfo() |
| Dim oCurTextShape As Object |
| Dim i as Integer |
| Dim bStartUpRun As Boolean |
| Dim CurFilename as String |
| Dim BaseLevel as Integer |
| Dim oController as Object |
| Dim MaxFileIndex as Integer |
| Dim FileNames() as String |
| ToggleDialogControls(False) |
| oProgressBar.ProgressValueMin = 0 |
| oProgressBar.ProgressValueMax = 100 |
| bStartUpRun = True |
| nOldHeight = 200 |
| nOldY = SBPAGEY |
| nOldX = SBPAGEX |
| nOldWidth = SBPAGEX |
| oController = oDocument.GetCurrentController |
| Source = ConvertToURL(DlgReadDir.Model.TextField1.Text) |
| BaseLevel = CountCharsInString(Source, "/", 1) |
| oProgressBar.ProgressValue = 5 |
| DlgReadDir.Model.Label3.Enabled = True |
| FileNames() = ReadSourceDirectory(Source) |
| DlgReadDir.Model.Label4.Enabled = True |
| DlgReadDir.Model.Label3.Enabled = False |
| oProgressBar.ProgressValue = 12 |
| FileNames() = BubbleSortList(FileNames()) |
| DlgReadDir.Model.Label5.Enabled = True |
| DlgReadDir.Model.Label4.Enabled = False |
| oProgressBar.ProgressValue = 20 |
| MaxFileIndex = Ubound(FileNames(),1) |
| For i = 0 To MaxFileIndex |
| oProgressBar.ProgressValue = 20 + (i/MaxFileIndex * 80) |
| CurFilename = FileNames(i,1) |
| SetNewLevels(FileNames(i,0), BaseLevel) |
| oCurTextShape = CreateTextShape(oPage, CurFilename) |
| CheckPageWidth(oCurTextShape.Size.Width) |
| iLevelPos(iCurLevel,SBBASEY) = oCurTextShape.Position.Y |
| If i = 0 Then |
| AdjustPageHeight(oCurTextShape.Size.Height, MaxFileIndex + 1) |
| End If |
| ' The Current TextShape has To be connected with a TextShape one Level higher |
| ' except for a TextShape In Level 0: |
| If Not bStartUpRun Then |
| ' A leaving Line Is only drawn when level is not 0 |
| If iCurLevel<> 0 Then |
| ' Determine the Coordinates of the arriving Line |
| iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX) |
| iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height |
| |
| iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX) |
| iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height |
| |
| oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage) |
| |
| ' Determine the End-Coordinates of the last leaving Line |
| iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX) |
| iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height |
| Else |
| ' On Level 0 the last Leaving Line's Endpoint is the upper edge of the TextShape |
| iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y |
| iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX) |
| End If |
| ' Draw the Connectors To the previous TextShapes |
| oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage) |
| Else |
| ' StartingPoint of the leaving Edge |
| bStartUpRun = FALSE |
| End If |
| |
| ' Determine the beginning Coordinates of the leaving Line |
| iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width |
| iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height |
| |
| ' Save the values For the Next run |
| nOldHeight = oCurTextShape.Size.Height |
| nOldX = oCurTextShape.Position.X |
| nOldWidth = oCurTextShape.Size.Width |
| nOldLevel = iCurLevel |
| Next i |
| ToggleDialogControls(True) |
| DlgReadDir.Model.cmdGoOn.Enabled = False |
| End Sub |
| |
| |
| Function CreateTextShape(oPage as Object, Filename as String) |
| Dim oTextShape As Object |
| Dim aPoint As New com.sun.star.awt.Point |
| |
| aPoint.X = CalculateXPoint() |
| aPoint.Y = nOldY + SBRELDIST * nOldHeight |
| nOldY = aPoint.Y |
| |
| oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape") |
| oTextShape.LineStyle = 1 |
| oTextShape.Position = aPoint |
| |
| oPage.add(oTextShape) |
| oTextShape.TextAutoGrowWidth = TRUE |
| oTextShape.TextAutoGrowHeight = TRUE |
| oTextShape.String = FileName |
| |
| ' Configure Size And Position of the TextShape according to its Scripting |
| aPoint.X = iLevelPos(iCurLevel,SBBASEX) |
| oTextShape.Position = aPoint |
| CreateTextShape() = oTextShape |
| End Function |
| |
| |
| Function CalculateXPoint() |
| ' The current level Is lower than the Old one |
| If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then |
| ' ClearArray(iLevelPos(),iCurLevel+1) |
| Elseif iCurLevel= 0 Then |
| iLevelPos(iCurLevel,SBBASEX) = SBPAGEX |
| ' The current level Is higher than the old one |
| Elseif iCurLevel> nOldLevel Then |
| iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100 |
| End If |
| CalculateXPoint = iLevelPos(iCurLevel,SBBASEX) |
| End Function |
| |
| |
| Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object) |
| Dim oConnect As Object |
| Dim aPoint As New com.sun.star.awt.Point |
| Dim aSize As New com.sun.star.awt.Size |
| aPoint.X = iLevelPos(nLevel,nStartX) |
| aPoint.Y = iLevelPos(nLevel,nStartY) |
| aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX) |
| aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY) |
| oConnect = oDocument.createInstance("com.sun.star.drawing.LineShape") |
| oConnect.Position = aPoint |
| oConnect.Size = aSize |
| oPage.Add(oConnect) |
| DrawLine() = oConnect |
| End Function |
| |
| |
| Sub GetSourceDirectory() |
| GetFolderName(DlgReadDir.Model.TextField1) |
| End Sub |
| |
| |
| Function ReadSourceDirectory(ByVal Source As String) |
| Dim i as Integer |
| Dim m as Integer |
| Dim n as Integer |
| Dim s as integer |
| Dim FileName as string |
| Dim FileNameList(100,1) as String |
| Dim DirList(0) as String |
| Dim oUCBobject as Object |
| Dim DirContent() as String |
| Dim SystemPath as String |
| Dim PathSeparator as String |
| Dim MaxFileIndex as Integer |
| PathSeparator = GetPathSeparator() |
| oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess") |
| m = 0 |
| s = 0 |
| DirList(0) = Source |
| FileNameList(n,0) = Source |
| SystemPath = ConvertFromUrl(Source) |
| FileNameList(n,1) = FileNameoutofPath(SystemPath, PathSeparator) |
| n = 1 |
| Do |
| Source = DirList(m) |
| m = m + 1 |
| DirContent() = oUcbObject.GetFolderContents(Source,True) |
| If Ubound(DirContent()) <> -1 Then |
| MaxFileIndex = Ubound(DirContent()) |
| For i = 0 to MaxFileIndex |
| FileName = DirContent(i) |
| FileNameList(n,0) = FileName |
| SystemPath = ConvertFromUrl(FileName) |
| FileNameList(n,1) = FileNameOutofPath(SystemPath, PathSeparator) |
| n = n + 1 |
| If n > Ubound(FileNameList(),1) Then |
| ReDim Preserve FileNameList(n + 10,1) as String |
| End If |
| If oUcbObject.IsFolder(FileName) Then |
| s = s + 1 |
| ReDim Preserve DirList(s) as String |
| DirList(s) = FileName |
| End If |
| Next i |
| End If |
| Loop Until m > Ubound(DirList() |
| ReDim Preserve FileNameList(n-1,1) as String |
| ReadSourceDirectory() = FileNameList() |
| End Function |
| |
| |
| Sub CloseDialog |
| DlgReadDir.EndExecute |
| End Sub |
| |
| |
| Sub AdjustPageHeight(lShapeHeight, FileCount) |
| Dim lNecHeight as Long |
| Dim lBorders as Long |
| oDocument.LockControllers |
| lBorders = oPage.BorderTop + oPage.BorderBottom |
| lNecHeight = SBPAGEY + (FileCount * SBRELDIST * lShapeHeight) |
| If lNecHeight > (oPage.Height - lBorders) Then |
| oPage.Height = lNecHeight + lBorders + 500 |
| End If |
| oDocument.UnlockControllers |
| End Sub |
| |
| |
| Sub SetNewLevels(FileName as String, BaseLevel as Integer) |
| iCurLevel= CountCharsInString(FileName, "/", 1) - BaseLevel |
| If iCurLevel <> 0 Then |
| nConnectLevel = iCurLevel- 1 |
| Else |
| nConnectLevel = iCurLevel |
| End If |
| If iCurLevel > Ubound(iLevelPos(),1) Then |
| ReDim Preserve iLevelPos(iCurLevel,9) as Long |
| End If |
| End Sub |
| |
| |
| Sub CheckPageWidth(TextWidth as Long) |
| Dim PageWidth as Long |
| Dim BaseX as Long |
| PageWidth = oPage.Width |
| BaseX = iLevelPos(iCurLevel,SBBASEX) |
| If BaseX + TextWidth > PageWidth - 1000 Then |
| oPage.Width = 1000 + BaseX + TextWidth |
| End If |
| End Sub |
| |
| |
| Sub ToggleDialogControls(bDoEnable as Boolean) |
| With DlgReadDir.Model |
| .cmdGoOn.Enabled = bDoEnable |
| .cmdGetDir.Enabled = bDoEnable |
| .Label1.Enabled = bDoEnable |
| .Label2.Enabled = bDoEnable |
| .TextField1.Enabled = bDoEnable |
| End With |
| End Sub</script:module> |
