home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 2004 June
/
VPR0406.ISO
/
STARSUITE7
/
EVALUATION
/
windows
/
office7
/
f_0114
/
ReadDir.xba
< prev
next >
Wrap
Extensible Markup Language
|
2002-10-16
|
10KB
|
305 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
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>