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 4Public Const SBPAGEX = 800 5Public Const SBPAGEY = 800 6Public Const SBRELDIST = 1.3 7 8' Names of the second Dimension of the Array iLevelPos 9Public Const SBBASEX = 0 10Public Const SBBASEY = 1 11 12Public Const SBOLDSTARTX = 2 13Public Const SBOLDSTARTY = 3 14 15Public Const SBOLDENDX = 4 16Public Const SBOLDENDY = 5 17 18Public Const SBNEWSTARTX = 6 19Public Const SBNEWSTARTY = 7 20 21Public Const SBNEWENDX = 8 22Public Const SBNEWENDY = 9 23 24Public ConnectLevel As Integer 25Public iLevelPos(1,9) As Long 26Public Source as String 27Public iCurLevel as Integer 28Public nConnectLevel as Integer 29Public nOldWidth, nOldHeight As Long 30Public nOldX, nOldY, nOldLevel As Integer 31Public oOldLeavingLine As Object 32Public oOldArrivingLine As Object 33Public DlgReadDir as Object 34Dim oProgressBar as Object 35Dim oDocument As Object 36Dim oPage As Object 37 38 39Sub Main() 40Dim 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 58End Sub 59 60 61Sub TreeInfo() 62Dim oCurTextShape As Object 63Dim i as Integer 64Dim bStartUpRun As Boolean 65Dim CurFilename as String 66Dim BaseLevel as Integer 67Dim oController as Object 68Dim MaxFileIndex as Integer 69Dim 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 143End Sub 144 145 146Function CreateTextShape(oPage as Object, Filename as String) 147Dim oTextShape As Object 148Dim 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 167End Function 168 169 170Function 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) 181End Function 182 183 184Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object) 185Dim oConnect As Object 186Dim aPoint As New com.sun.star.awt.Point 187Dim 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 197End Function 198 199 200Sub GetSourceDirectory() 201 GetFolderName(DlgReadDir.Model.TextField1) 202End Sub 203 204 205Function ReadSourceDirectory(ByVal Source As String) 206Dim i as Integer 207Dim m as Integer 208Dim n as Integer 209Dim s as integer 210Dim FileName as string 211Dim FileNameList(100,1) as String 212Dim DirList(0) as String 213Dim oUCBobject as Object 214Dim DirContent() as String 215Dim SystemPath as String 216Dim PathSeparator as String 217Dim 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() 252End Function 253 254 255Sub CloseDialog 256 DlgReadDir.EndExecute 257End Sub 258 259 260Sub AdjustPageHeight(lShapeHeight, FileCount) 261Dim lNecHeight as Long 262Dim 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 270End Sub 271 272 273Sub 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 283End Sub 284 285 286Sub CheckPageWidth(TextWidth as Long) 287Dim PageWidth as Long 288Dim 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 294End Sub 295 296 297Sub 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 305End Sub</script:module>