PC World 2002 May/PCWorld_2002-05_cd.bin/Akce/install/f_0186/ReadDir.xba

Extensible Markup Language | 2001-10-15 | 10.3 KB | 309 lines

<?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
' Todo: Capitalization of ReadDirDlg for CVS
' Verzeichnis StarOne ├╝berpr├╝fen (letzte beiden Dateien)
' Ordnung nach Verzeichnis und dann die Dateien ( indem "AAAA" vor den Verzeichnisnamen gesetzt wird).
' Nicht-Verzeichnisnamen abfangen
'Public Const SBBASEWIDTH = 8000
'Public Const SBBASEHEIGHT = 1000
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 = StarDesktop.LoadComponentFromURL("private:factory/sdraw","_blank",0, NoArgs())
    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 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>