diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 09:06:44 +0000 |
commit | ed5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch) | |
tree | 7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/gimmicks/ReadDir.xba | |
parent | Initial commit. (diff) | |
download | libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.tar.xz libreoffice-ed5640d8b587fbcfed7dd7967f3de04b37a76f26.zip |
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/gimmicks/ReadDir.xba')
-rw-r--r-- | wizards/source/gimmicks/ReadDir.xba | 322 |
1 files changed, 322 insertions, 0 deletions
diff --git a/wizards/source/gimmicks/ReadDir.xba b/wizards/source/gimmicks/ReadDir.xba new file mode 100644 index 000000000..b60469508 --- /dev/null +++ b/wizards/source/gimmicks/ReadDir.xba @@ -0,0 +1,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 + +' 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> |