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