summaryrefslogtreecommitdiff
path: root/wizards/source/gimmicks/ReadDir.xba
blob: b604695082b23394d531c8e3d9b2811c8168607e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
<?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>