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 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
   4 Public Const SBPAGEX = 800
   5 Public Const SBPAGEY = 800
   6 Public Const SBRELDIST = 1.3
   7
   8 &apos; Names of the second Dimension of the Array iLevelPos
   9 Public Const SBBASEX = 0
  10 Public Const SBBASEY = 1
  11
  12 Public Const SBOLDSTARTX = 2
  13 Public Const SBOLDSTARTY = 3
  14
  15 Public Const SBOLDENDX = 4
  16 Public Const SBOLDENDY = 5
  17
  18 Public Const SBNEWSTARTX = 6
  19 Public Const SBNEWSTARTY = 7
  20
  21 Public Const SBNEWENDX = 8
  22 Public Const SBNEWENDY = 9
  23
  24 Public ConnectLevel As Integer
  25 Public iLevelPos(1,9) As Long
  26 Public Source as String
  27 Public iCurLevel as Integer
  28 Public nConnectLevel as Integer
  29 Public nOldWidth, nOldHeight As Long
  30 Public nOldX, nOldY, nOldLevel As Integer
  31 Public oOldLeavingLine As Object
  32 Public oOldArrivingLine As Object
  33 Public DlgReadDir as Object
  34 Dim oProgressBar as Object
  35 Dim oDocument As Object
  36 Dim oPage As Object
  37
  38
  39 Sub Main()
  40 Dim oStandardTemplate as Object
  41         BasicLibraries.LoadLibrary(&quot;Tools&quot;)
  42         oDocument = CreateNewDocument(&quot;sdraw&quot;)
  43         If Not IsNull(oDocument) Then
  44                 oPage = oDocument.DrawPages(0)
  45                 oStandardTemplate = oDocument.StyleFamilies.GetByName(&quot;graphics&quot;).GetByName(&quot;standard&quot;)
  46                 oStandardTemplate.CharHeight = 10
  47                 oStandardTemplate.TextLeftDistance = 100
  48                 oStandardTemplate.TextRightDistance = 100
  49                 oStandardTemplate.TextUpperDistance = 50
  50                 oStandardTemplate.TextLowerDistance = 50
  51                 DlgReadDir = LoadDialog(&quot;Gimmicks&quot;,&quot;ReadFolderDlg&quot;)
  52                 oProgressBar = DlgReadDir.Model.ProgressBar1
  53                 DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings(&quot;Work&quot;))
  54                 DlgReadDir.Model.cmdGoOn.DefaultButton = True
  55                 DlgReadDir.GetControl(&quot;TextField1&quot;).SetFocus()
  56                 DlgReadDir.Execute
  57         End If
  58 End Sub
  59
  60
  61 Sub TreeInfo()
  62 Dim oCurTextShape As Object
  63 Dim i as Integer
  64 Dim bStartUpRun As Boolean
  65 Dim CurFilename as String
  66 Dim BaseLevel as Integer
  67 Dim oController as Object
  68 Dim MaxFileIndex as Integer
  69 Dim 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, &quot;/&quot;, 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                 &apos; The Current TextShape has To be connected with a TextShape one Level higher
 103                 &apos; except for a TextShape In Level 0:
 104                 If Not bStartUpRun Then
 105                         &apos; A leaving Line Is only drawn when level is not 0
 106                         If iCurLevel&lt;&gt; 0 Then
 107                                 &apos; 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                                 &apos; 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                                 &apos; On Level 0 the last Leaving Line&apos;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                         &apos; Draw the Connectors To the previous TextShapes
 125                         oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
 126                 Else
 127                         &apos; StartingPoint of the leaving Edge
 128                         bStartUpRun = FALSE
 129                 End If
 130
 131                 &apos; 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                 &apos; 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
 143 End Sub
 144
 145
 146 Function CreateTextShape(oPage as Object, Filename as String)
 147 Dim oTextShape As Object
 148 Dim 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(&quot;com.sun.star.drawing.TextShape&quot;)
 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         &apos; Configure Size And Position of the TextShape  according to its Scripting
 164         aPoint.X = iLevelPos(iCurLevel,SBBASEX)
 165         oTextShape.Position = aPoint
 166         CreateTextShape() = oTextShape
 167 End Function
 168
 169
 170 Function CalculateXPoint()
 171         &apos; The current level Is lower than the Old one
 172         If (iCurLevel&lt; nOldLevel) And (iCurLevel&lt;&gt; 0) Then
 173         &apos; ClearArray(iLevelPos(),iCurLevel+1)
 174         Elseif iCurLevel= 0 Then
 175                 iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
 176         &apos; The current level Is higher than the old one
 177         Elseif iCurLevel&gt; nOldLevel Then
 178                 iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
 179         End If
 180         CalculateXPoint = iLevelPos(iCurLevel,SBBASEX)
 181 End Function
 182
 183
 184 Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object)
 185 Dim oConnect As Object
 186 Dim aPoint As New com.sun.star.awt.Point
 187 Dim 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(&quot;com.sun.star.drawing.LineShape&quot;)
 193         oConnect.Position = aPoint
 194         oConnect.Size = aSize
 195         oPage.Add(oConnect)
 196         DrawLine() = oConnect
 197 End Function
 198
 199
 200 Sub GetSourceDirectory()
 201         GetFolderName(DlgReadDir.Model.TextField1)
 202 End Sub
 203
 204
 205 Function ReadSourceDirectory(ByVal Source As String)
 206 Dim i as Integer
 207 Dim m as Integer
 208 Dim n as Integer
 209 Dim s as integer
 210 Dim FileName as string
 211 Dim FileNameList(100,1) as String
 212 Dim DirList(0) as String
 213 Dim oUCBobject as Object
 214 Dim DirContent() as String
 215 Dim SystemPath as String
 216 Dim PathSeparator as String
 217 Dim MaxFileIndex as Integer
 218         PathSeparator = GetPathSeparator()
 219         oUcbobject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
 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()) &lt;&gt; -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 &gt; 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 &gt; Ubound(DirList()
 250         ReDim Preserve FileNameList(n-1,1) as String
 251         ReadSourceDirectory() = FileNameList()
 252 End Function
 253
 254
 255 Sub CloseDialog
 256         DlgReadDir.EndExecute
 257 End Sub
 258
 259
 260 Sub     AdjustPageHeight(lShapeHeight, FileCount)
 261 Dim lNecHeight as Long
 262 Dim lBorders as Long
 263         oDocument.LockControllers
 264         lBorders = oPage.BorderTop + oPage.BorderBottom
 265         lNecHeight = SBPAGEY + (FileCount * SBRELDIST * lShapeHeight)
 266         If lNecHeight &gt; (oPage.Height - lBorders) Then
 267                 oPage.Height = lNecHeight + lBorders + 500
 268         End If
 269         oDocument.UnlockControllers
 270 End Sub
 271
 272
 273 Sub SetNewLevels(FileName as String, BaseLevel as Integer)
 274         iCurLevel= CountCharsInString(FileName, &quot;/&quot;, 1) - BaseLevel
 275         If iCurLevel &lt;&gt; 0 Then
 276                 nConnectLevel = iCurLevel- 1
 277         Else
 278                 nConnectLevel = iCurLevel
 279         End If
 280         If iCurLevel &gt; Ubound(iLevelPos(),1) Then
 281                 ReDim Preserve iLevelPos(iCurLevel,9) as Long
 282         End If
 283 End Sub
 284
 285
 286 Sub CheckPageWidth(TextWidth as Long)
 287 Dim PageWidth as Long
 288 Dim BaseX as Long
 289         PageWidth = oPage.Width
 290         BaseX = iLevelPos(iCurLevel,SBBASEX)
 291         If BaseX + TextWidth &gt; PageWidth - 1000 Then
 292                 oPage.Width = 1000 + BaseX + TextWidth
 293         End If
 294 End Sub
 295
 296
 297 Sub 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
 305 End Sub</script:module>