fileView/server/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/ReadDir.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   Licensed to the Apache Software Foundation (ASF) under one or more
 *   contributor license agreements. See the NOTICE file distributed
 *   with this work for additional information regarding copyright
 *   ownership. The ASF licenses this file to you under the Apache
 *   License, Version 2.0 (the "License"); you may not use this file
 *   except in compliance with the License. You may obtain a copy of
 *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
Public Const SBPAGEX = 800
Public Const SBPAGEY = 800
Public Const SBRELDIST = 1.3

&apos; 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(&quot;Tools&quot;)
	oDocument = CreateNewDocument(&quot;sdraw&quot;)
	If Not IsNull(oDocument) Then
		oPage = oDocument.DrawPages(0)
		oStandardTemplate = oDocument.StyleFamilies.GetByName(&quot;graphics&quot;).GetByName(&quot;standard&quot;)
		oStandardTemplate.CharHeight = 10
		oStandardTemplate.TextLeftDistance = 100
		oStandardTemplate.TextRightDistance = 100
		oStandardTemplate.TextUpperDistance = 50
		oStandardTemplate.TextLowerDistance = 50
		DlgReadDir = LoadDialog(&quot;Gimmicks&quot;,&quot;ReadFolderDlg&quot;)
		oProgressBar = DlgReadDir.Model.ProgressBar1
		DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings(&quot;Work&quot;))
		DlgReadDir.Model.cmdGoOn.DefaultButton = True
		DlgReadDir.GetControl(&quot;TextField1&quot;).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, &quot;/&quot;, 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
		&apos; The Current TextShape has To be connected with a TextShape one Level higher
		&apos; except for a TextShape In Level 0:
		If Not bStartUpRun Then
			&apos; A leaving Line Is only drawn when level is not 0
			If iCurLevel&lt;&gt; 0 Then
				&apos; 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)

				&apos; 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
				&apos; On Level 0 the last Leaving Line&apos;s Endpoint is the upper edge of the TextShape
				iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y
				iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
			End If
			&apos; Draw the Connectors To the previous TextShapes
			oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
		Else
			&apos; StartingPoint of the leaving Edge
			bStartUpRun = FALSE
		End If

		&apos; 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

		&apos; 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(&quot;com.sun.star.drawing.TextShape&quot;)
	oTextShape.LineStyle = 1
	oTextShape.Position = aPoint

	oPage.add(oTextShape)
	oTextShape.TextAutoGrowWidth = TRUE
	oTextShape.TextAutoGrowHeight = TRUE
	oTextShape.String = FileName

	&apos; 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()
	&apos; The current level Is lower than the Old one
	If (iCurLevel&lt; nOldLevel) And (iCurLevel&lt;&gt; 0) Then
	&apos; ClearArray(iLevelPos(),iCurLevel+1)
	Elseif iCurLevel= 0 Then
		iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
	&apos; The current level Is higher than the old one
	Elseif iCurLevel&gt; 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(&quot;com.sun.star.drawing.LineShape&quot;)
	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(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	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()) &lt;&gt; -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 &gt; 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 &gt; 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 &gt; (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, &quot;/&quot;, 1) - BaseLevel
	If iCurLevel &lt;&gt; 0 Then
		nConnectLevel = iCurLevel- 1
	Else
		nConnectLevel = iCurLevel
	End If
	If iCurLevel &gt; 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 &gt; 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</script:module>