wizards/source/gimmicks/ReadDir.xba

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