305 lines
No EOL
9.7 KiB
XML
305 lines
No EOL
9.7 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<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
|
|
|
|
' 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</script:module> |