path: root/wizards/source/gimmicks/ReadDir.xba

<?xml version="1.0" encoding="UTF-8"?>

<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
&apos; Verzeichnis StarOne überprüfen (letzte beiden Dateien)
&apos; Ordnung nach Verzeichnis und dann die Dateien ( indem &quot;AAAA&quot; vor den Verzeichnisnamen gesetzt wird).
&apos; Nicht-Verzeichnisnamen abfangen
Const SBBASEWIDTH = 8000
Const SBBASEHEIGHT = 1000
Const SBPAGEX = 800
Const SBPAGEY = 800
Const SBBASECHARHEIGHT = 12
Const SBRELDIST = 1.1

REM Names of the second Dimension of the Array iLevelPos
Const SBBASEX = 0
Const SBBASEY = 1

Const SBOLDSTARTX = 2
Const SBOLDSTARTY = 3

Const SBOLDENDX = 4
Const SBOLDENDY = 5

Const SBNEWSTARTX = 6
Const SBNEWSTARTY = 7

Const SBNEWENDX = 8
Const SBNEWENDY = 9

Public ConnectLevel As Integer
Public iLevelPos(10,9) As Integer
Public Source as String
Public iCurLevel, nConnectLevel as Integer
Public nOldWidth, nOldHeight As Integer
Public nOldX, nOldY, nOldLevel As Integer
Public oOldLeavingLine As Object
Public oOldArrivingLine As Object


Sub Main
	LoadLibrary(&quot;tools&quot;)
	LoadLibrary(&quot;template&quot;)
	ReadDirDlg.Load
	ReadDirDlg.Show
End Sub


Sub TreeInfo()
Dim oCurTextShape As Object
Dim oDesktop As Object
Dim oDocument As Object
Dim iCurPage As Integer
Dim oPage As Object
Dim oOldPage As Object
Dim i, n, s  as Integer
Dim bStartUpRun As Boolean
Dim FileNames(600,2) as String 
Dim CurFile as String
Dim BaseLevel as Integer
Dim oController as Object
Dim FileCount as Integer
Dim oStatusline as Object
	ReadDirDlg.Unload
	bStartUpRun  = TRUE
	nOldHeight = 200
	nOldY = SBPAGEY
	nOldX = SBPAGEX
	nOldWidth = SBPAGEX
	iCurPage = 0
	
	oDesktop = createUnoService(&quot;com.sun.star.frame.Desktop&quot;)
	oDocument = StarDesktop.ActiveFrame.Controller.Model
	oPage = oDocument.DrawPages(iCurPage)
	oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator
	oStatusLine.Start(&quot;Fortschritt:&quot;,100)
	oController = oDocument.GetCurrentController
	Source = ConvertToURL(ReadDirdlg.Textbox1.Text) 
	BaseLevel = CountCharsInString(Source, &quot;/&quot;, 1)

	oStatusline.SetValue(2)	
	FileNames() = ReadSourceDirectory(Source)
	oStatusline.SetValue(8)
	FileNames() = BubbleSortList(FileNames())
	oStatusline.SetValue(10)
	
	FileCount = Val(FileNames(0,0))
	For i = 1 To FileCount
		oStatusLine.SetValue(10 + i/FileCount * 90) 
		CurFile = FileNames(i,1)
		iCurLevel= CountCharsInString(FileNames(i,0), &quot;/&quot;, 1) - BaseLevel
		If iCurLevel &lt;&gt; 0 Then
			nConnectLevel = iCurLevel- 1
		Else
			nConnectLevel = iCurLevel
		End If

REM	 Add New page If necessary
REM	ck	IF nOldY + nOldHeight * 1/SBRELDIST &gt; oPage.Height - SBPAGEY Then
		IF nOldY + (nOldHeight + SBBASECHARHEIGHT) * 1.5 &gt; oPage.Height - SBPAGEY Then
			iCurPage = iCurPage + 1
			oDocument.getDrawPages.InsertNewbyIndex(iCurPage)

			oPage = oDocument.DrawPages(iCurPage)
			oController.SetCurrentPage (oPage)

			For n = 0 To nConnectLevel
				iLevelPos(n,SBNEWENDY) = nOldY + nOldHeight REM oOldPage.Height
				oOldLeavingLine = DrawLine(n, SBNEWSTARTX, SBNEWSTARTY, SBNEWSTARTX, SBNEWENDY, oOldPage)
REM	ck			                           SBNEWENDX, SBNEWENDY)
			Next
			For n = 0 To nConnectLevel
				iLevelPos(n,SBNEWSTARTY) = SBPAGEY
			Next
			nOldY = SBPAGEY
		End If
		oCurTextShape = CreateTextShape(oPage, CurFile)

REM	 The Current TextShape has To be connected with a TextShape
REM  one Level higher
REM	 - except For a TextShape In Level 0 

REM	 Line Coordinates
		If Not bStartUpRun Then		
		
REM	 A leaving Line Is only drawn when level is not 0
			If iCurLevel&lt;&gt; 0 Then
REM	 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)

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

REM	 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
		
REM	Save the values For the Next run
		nOldHeight = oCurTextShape.Size.Height
		nOldX = oCurTextShape.Position.X
		nOldWidth = oCurTextShape.Size.Width
		nOldLevel = iCurLevel
		Set oOldPage = oPage
	Next i
	oStatusLine.End
	Exit Sub
ErrorHandler:
	MsgBox error, 0,&quot;Error in Line&quot; &amp; erl
End Sub



Function CreateTextShape(oPage as Object, Filename as String)
Dim oTextShape As Object
Dim PageWidth, BaseX, TextWidth
Dim aPoint As New com.sun.star.awt.Point
Dim aSize As New com.sun.star.awt.Size

	aSize.Width = SBBASEWIDTH  
	aSize.Height = SBBASEHEIGHT 

	aPoint.x = CalculateXPoint()
	aPoint.y = nOldY + SBRELDIST * nOldHeight  
	nOldY  = aPoint.y

	oTextShape = oDocument.createInstance(&quot;com.sun.star.drawing.TextShape&quot;)
	oTextShape.Size = aSize
	oTextShape.Position = aPoint

	oPage.add(oTextShape)
	oTextShape.LineStyle = 1
	oTextShape.Charheight = SBBASECHARHEIGHT 
	oTextShape.TextAutoGrowWidth = TRUE
	oTextShape.TextAutoGrowHeight = TRUE
	oTextShape.String = FileName

REM	 Configure Size And Position of the TextShape  according to its Scripting
	aPoint.x = iLevelPos(iCurLevel,SBBASEX)
	oTextShape.Position = aPoint
	aSize.Height = SBRELDIST * oTextShape.CharHeight
	aSize.Width = SBRELDIST * oTextShape.Size.Width

	PageWidth = oPage.Width
	TextWidth = aSize.Width
	BaseX = aPoint.x
	If BaseX + TextWidth &gt; PageWidth - 1000 Then
		oPage.Width = 1000 + BaseX + TextWidth
	End If
	oTextShape.Size = aSize
	iLevelPos(iCurLevel,SBBASEY) = oTextShape.Position.Y
	CreateTextShape = oTextShape	
End Function



Function CalculateXPoint()

REM	 The current level Is lower than the Old one
	If (iCurLevel&lt; nOldLevel) And (iCurLevel&lt;&gt; 0) Then
REM		ClearArray(iLevelPos(),iCurLevel+1)
	Elseif iCurLevel= 0 Then
		iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
REM	 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

	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 SourceSearchDialog()
	Source = Application.FileDialog( &quot;P&quot;, &quot;Wählen Sie ein Verzeichnis&quot;, &quot;D:\Arbeitsverzeichnis&quot; )  &apos; &quot;Wählen Sie ein Verzeichnis&quot;
	If Len( Source ) &gt; 0 Then
		ReadDirDlg.Textbox1.Text = Source
	End If
End Sub



Function ReadSourceDirectory(ByVal Source As String)
Dim i, m, n, s as integer
Dim FileCount As Integer
Dim FileCountinDir as Integer
Dim FileName as string
Dim FileNameList(2000,1) as String
Dim DirList(200) as String
Dim oUCBobject as Object
	
	oUcbobject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	&apos;isfolder
	m = 0
	s = 1
	DirList(0) = Source
	FileNameList(1,0) = Source 
	FileNameList(1,1) = GetFileNameoutofPath(Source) 
	n = 2
	Do
		Source = DirList(m)
		m = m + 1

		DirContent = oUcbObject.GetFolderContents(Source,True)

		If Ubound(DirContent()) &lt;&gt; -1 Then
			FileCountinDir = Ubound(DirContent()) + 1
			For i = 0 to FilecountinDir -1
				FileName = DirContent(i)
				FilenameList(n,0) = FileName
				FileNameList(n,1) = GetFileNameOutofPath(FileName)				
				n = n + 1
				If oUcbObject.IsFolder(FileName) Then
					DirList(s) = FileName
					DirList(0) = CStr(s)
					s = s + 1
				End If
			Next i
		End If
	Loop Until m  = cInt(DirList(0))+ 1
	FileNameList(0,0) = n - 1
	ReadSourceDirectory = FileNameList()
End Function
</script:module>