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