#92590# New Basic Dialogs inserterted; Language Modules removed
This commit is contained in:
Behrend Cornelius
@@ -1,21 +1,38 @@
|
||||
<?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="AutoText" script:language="StarBasic">' BASIC
|
||||
Option Explicit
|
||||
Dim oDocument as Object
|
||||
Dim sDocumentTitle as String
|
||||
|
||||
' Todo: Problem mit der Spaltenbreite lösen
|
||||
' Internationale Vorlage für Überschrift
|
||||
Sub Main
|
||||
Dim oDocument, oTable, oRows, oDocuText, oTitleCursor as Object
|
||||
Dim oAutoTextContainer, oAutogroup, oAutoText as Object
|
||||
Dim oCharStyles, oContentStyle, oHeaderStyle, oGroupTitleStyle as Object
|
||||
Sub Main()
|
||||
Dim oTable as Object
|
||||
Dim oRows as Object
|
||||
Dim oDocuText as Object
|
||||
Dim oAutoTextCursor as Object
|
||||
Dim oAutoTextContainer as Object
|
||||
Dim oAutogroup as Object
|
||||
Dim oAutoText as Object
|
||||
Dim oCharStyles as Object
|
||||
Dim oContentStyle as Object
|
||||
Dim oHeaderStyle as Object
|
||||
Dim oGroupTitleStyle as Object
|
||||
Dim n, m, iAutoCount as Integer
|
||||
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
LoadLanguage(StarDesktop.ISOLocale.Language)
|
||||
Dim oLocale as New com.sun.star.lang.Locale
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
oLocale = GetStarOfficeLocale()
|
||||
strHeading1 = "Überschrift 1"
|
||||
strGroup = "Bereich:"
|
||||
strBlockName = "Name des Bausteins"
|
||||
strBlockShortName = "Kürzel"
|
||||
strColumnWidth = "13cm"
|
||||
sDocumentTitle = "Installierte Autotextbausteine"
|
||||
|
||||
' Open a new empty document
|
||||
oDocument = StarDesktop.LoadComponentFromURL("staroffice:factory/swriter","_blank",0,NoArgs)
|
||||
oDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter","_blank",0,NoArgs)
|
||||
oDocument.DocumentInfo.Title = sDocumentTitle
|
||||
oDocuText = oDocument.Text
|
||||
|
||||
' Create The Character-templates
|
||||
@@ -23,14 +40,15 @@ Dim n, m, iAutoCount as Integer
|
||||
|
||||
' The Characterstyle for the Header that describes the Title of Autotextgroups
|
||||
oGroupTitleStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oGroupTitleStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oGroupTitleStyle.CharHeight = 14
|
||||
oCharStyles.InsertbyName("AutoTextGroupTitle", oGroupTitleStyle)
|
||||
|
||||
oGroupTitleStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oGroupTitleStyle.CharHeight = 14
|
||||
|
||||
' The Characterstyle for the Header that describes the Title of Autotextgroups
|
||||
oHeaderStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oCharStyles.InsertbyName("AutoTextHeading", oHeaderStyle)
|
||||
oHeaderStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
|
||||
' "Ordinary" Table Content
|
||||
oContentStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
@@ -38,23 +56,24 @@ Dim n, m, iAutoCount as Integer
|
||||
|
||||
oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer")
|
||||
|
||||
oTitleCursor = oDocuText.CreateTextCursor()
|
||||
oTitleCursor.CharStyle = "AutoTextGroupTitle"
|
||||
oAutoTextCursor = oDocuText.CreateTextCursor()
|
||||
|
||||
oAutoTextCursor.CharStyleName = "AutoTextGroupTitle"
|
||||
' Link the Title with the following table
|
||||
oTitleCursor.ParaKeepTogether = True
|
||||
oAutoTextCursor.ParaKeepTogether = True
|
||||
|
||||
For n = 0 To oAutoTextContainer.Count - 1
|
||||
oAutoGroup = oAutoTextContainer.GetByIndex(n)
|
||||
|
||||
oTitleCursor.SetString(oAutoGroup.Title)
|
||||
oTitleCursor.CollapseToEnd()
|
||||
oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oAutoTextCursor.SetString(oAutoGroup.Title)
|
||||
oAutoTextCursor.CollapseToEnd()
|
||||
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oTable = oDocument.CreateInstance("com.sun.star.text.TextTable")
|
||||
' Divide the table if necessary
|
||||
oTable.Split = True
|
||||
' oTable.KeepTogether = False
|
||||
oTable.RepeatHeadLine = True
|
||||
oTitleCursor.Text.InsertTextContent(oCursor,oTable,False)
|
||||
oAutoTextCursor.Text.InsertTextContent(oAutoTextCursor,oTable,False)
|
||||
InsertStringToCell("AutoText-Title",oTable.GetCellbyPosition(0,0), "AutoTextHeading")
|
||||
InsertStringToCell("AutoText-Name",oTable.GetCellbyPosition(1,0), "AutoTextHeading")
|
||||
' Insert one row at the bottom of the table
|
||||
@@ -69,8 +88,8 @@ Dim n, m, iAutoCount as Integer
|
||||
oRows.InsertbyIndex(m + 2,1)
|
||||
End If
|
||||
Next m
|
||||
oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oCursor.CollapseToEnd()
|
||||
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oAutoTextCursor.CollapseToEnd()
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
@@ -78,6 +97,7 @@ End Sub
|
||||
Sub InsertStringToCell(sCellString as String, oCell as Object, sCellStyle as String)
|
||||
Dim oCellCursor as Object
|
||||
oCellCursor = oCell.CreateTextCursor()
|
||||
oCellCursor.CharStyle = sCellStyle
|
||||
oCellCursor.CharStyleName = sCellStyle
|
||||
oCell.Text.insertString(oCellCursor,sCellString,False)
|
||||
End Sub</script:module>
|
||||
oDocument.CurrentController.Select(oCellCursor)
|
||||
End Sub</script:module>
|
||||
@@ -1,5 +1,5 @@
|
||||
<?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="ChangeAllChars" script:language="StarBasic">' This macro replaces all characters in a writer-documet through "x" or "X" signs.
|
||||
' It works on the currently activated document.
|
||||
Private const UPPERREPLACECHAR = "X"
|
||||
@@ -15,14 +15,16 @@ Dim i as Integer
|
||||
Const MBYES = 6
|
||||
Const MBABORT = 2
|
||||
Const MBNO = 7
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
Call SetLanguage
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?"
|
||||
WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
|
||||
|
||||
On Local Error GoTo NODOCUMENT
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
NODOCUMENT:
|
||||
If Err <> 0 Then
|
||||
Msgbox("This Macro extracts all Data of a displayed Writer-Document." & chr(13) & "Activate a Writer-Document!" , 16, "StarOffice 5.2")
|
||||
Msgbox("This Macro extracts all Data of a displayed Writer-Document." & chr(13) & "Activate a Writer-Document!" , 16, GetProductName())
|
||||
Exit Sub
|
||||
End If
|
||||
On Local Error Goto 0
|
||||
@@ -45,11 +47,11 @@ Const MBNO = 7
|
||||
End If
|
||||
|
||||
Select Case sDocType
|
||||
Case "sWriter"
|
||||
Case "swriter"
|
||||
ReplaceAllStrings(oDocument)
|
||||
|
||||
Case Else
|
||||
Msgbox("This Macro only works with Writer-Documents!", 16, "StarOffice 5.2")
|
||||
Msgbox("This Macro only works with Writer-Documents!", 16, GetProductName())
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
@@ -70,61 +72,4 @@ Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString as Strin
|
||||
oReplaceDesc.Searchstring = sSearchString
|
||||
oReplaceDesc.ReplaceString = sReplaceString
|
||||
oReplCount = oContainer.ReplaceAll(oReplaceDesc)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetLanguage
|
||||
Dim ISOLanguage as String
|
||||
ISOLanguage = StarDesktop.ISOLocale.Language
|
||||
|
||||
Select Case ISOLanguage
|
||||
|
||||
Case "en"
|
||||
MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?"
|
||||
WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
|
||||
|
||||
Case "fr"
|
||||
MSGBOXTITLE = "Remplacer tous les caractères par '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "Le document a été modifé, la macro remplacera tous les caractères par '" & UPPERREPLACECHAR & "'. Enregistrer avant de procéder?"
|
||||
WARNING = "La macro remplacera tous les caractères et nombres par '" & UPPERREPLACECHAR & "' dans le document."
|
||||
|
||||
Case "it"
|
||||
MSGBOXTITLE = "Sostituire tutti i caratteri '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "Il documento è stato modificato, la macro sostituerà tutti i caratteri con '" & UPPERREPLACECHAR & "'. Salvare il documento prima di procedere?"
|
||||
WARNING = "La macro sostituirà tutti i caratteri e numeri con '" & UPPERREPLACECHAR & "' nel documento attivo."
|
||||
|
||||
Case "es"
|
||||
MSGBOXTITLE = "Sustituir todos los caracteres por '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "Este documento fue cambiado: todos los caracteres fueron sustituidos por " & UPPERREPLACECHAR & "'. Desea guardar el documento?"
|
||||
WARNING = "Esta macro sustitue todos los caracteres y números en este documento por '" & UPPERREPLACECHAR & "'."
|
||||
|
||||
Case "pt"
|
||||
MSGBOXTITLE = "Substituir todos os caracteres por '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "Este documento foi modificado: todos os caracteres foram substituídos por " & UPPERREPLACECHAR & "'. Deseja guardar o documento?"
|
||||
WARNING = "Esta macro substitui todos os caracteres e números neste documento por '" & UPPERREPLACECHAR & "'."
|
||||
|
||||
Case "nl"
|
||||
MSGBOXTITLE = "Verander alle tekens in een'" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "Dit document is veranderd. Alle tekens zijn veranderd in een " & UPPERREPLACECHAR & "'. Wilt u het document nu opslaan?"
|
||||
WARNING = "Dit macro verandert alle tekens en cijfers in een '" & UPPERREPLACECHAR & "' in dit document."
|
||||
|
||||
Case "sv"
|
||||
MSGBOXTITLE = "Byt ut alla bokstäver mot en '" & UPPERREPLACECHAR & "' "
|
||||
NOTSAVEDTEXT = "Dokumentet har ändrats, med detta makro kommer alla bokstäver att bytas ut mot en '" & UPPERREPLACECHAR & "' . Ska dokumentet säkras/sparas innan?"
|
||||
WARNING = "Makrot ersätter alla bokstäver och tal i detta dokument med en '" & UPPERREPLACECHAR & "'."
|
||||
|
||||
' Case "da"
|
||||
|
||||
' Case "pl"
|
||||
|
||||
' Case "ru"
|
||||
|
||||
' English & fallback/default
|
||||
Case Else
|
||||
MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?"
|
||||
WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
|
||||
End Select
|
||||
End Sub
|
||||
</script:module>
|
||||
End Sub</script:module>
|
||||
@@ -1,5 +1,5 @@
|
||||
<?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="GetTexts" script:language="StarBasic">Option Explicit
|
||||
' Option für doppelte Strings
|
||||
' Alternativtexte, Namen usw für HTML-Seiten--> ist Anbindung an StarOfficeAPI geplant?
|
||||
@@ -27,35 +27,34 @@ Sub Main
|
||||
Dim sDocType as String
|
||||
Dim oHyperCursor as Object
|
||||
Dim oCharStyles as Object
|
||||
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
On Local Error GoTo NODOCUMENT
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
sDocType = GetDocumentType(oDocument)
|
||||
NODOCUMENT:
|
||||
If Err <> 0 Then
|
||||
Msgbox("This Macro extracts all Data of the displayed Writer-, Calc or Draw-Documents." & chr(13) &_
|
||||
"To start this macro you have to activate a Document first!" , 16, "StarOffice 5.2")
|
||||
"To start this macro you have to activate a Document first!" , 16, GetProductName)
|
||||
Exit Sub
|
||||
End If
|
||||
On Local Error Goto 0
|
||||
|
||||
' Open a new document where all the texts are inserted
|
||||
oLogDocument = StarDesktop.LoadComponentFromURL( "staroffice:factory/swriter","_blank",0,NoArgs())
|
||||
oLogDocument = StarDesktop.LoadComponentFromURL( "private:factory/swriter","_blank",0,NoArgs())
|
||||
oLogText = oLogDocument.Text
|
||||
|
||||
' create and define the character styles of the Log-document
|
||||
oCharStyles = oLogDocument.StyleFamilies.GetByName("CharacterStyles")
|
||||
oLogHeaderStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("LogHeaderText", oLogHeaderStyle)
|
||||
|
||||
oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oLogBodyTextStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("LogHeading", oLogHeaderStyle)
|
||||
oCharStyles.InsertbyName("LogBodyText", oLogBodyTextStyle)
|
||||
|
||||
' Insert the title of the activated document as a hyperlink
|
||||
oHyperCursor = oLogText.createTextCursor()
|
||||
oHyperCursor.charWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oHyperCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oHyperCursor.gotoStart(False)
|
||||
oHyperCursor.HyperLinkURL = oDocument.URL
|
||||
oHyperCursor.HyperLinkTarget = oDocument.URL
|
||||
@@ -77,14 +76,14 @@ Dim oCharStyles as Object
|
||||
GetDocumentInfo()
|
||||
|
||||
Select Case sDocType
|
||||
Case "sWriter"
|
||||
Case "swriter"
|
||||
GetWriterStrings()
|
||||
Case "sCalc"
|
||||
Case "scalc"
|
||||
GetCalcStrings()
|
||||
Case "sDraw"
|
||||
Case "sdraw"
|
||||
GetDrawStrings()
|
||||
Case Else
|
||||
Msgbox("This Macro only works with Writer-, Calc or Draw/Impress-Documents!", 16, "StarOffice 5.2")
|
||||
Msgbox("This Macro only works with Writer-, Calc or Draw/Impress-Documents!", 16, GetProductName())
|
||||
End Select
|
||||
|
||||
End Sub
|
||||
@@ -134,7 +133,7 @@ Dim BigRange, BigEnum, oCell as Object
|
||||
BigEnum = BigRange.GetCells.CreateEnumeration
|
||||
While BigEnum.hasmoreElements
|
||||
oCell = BigEnum.NextElement
|
||||
If (oCell.Type = com.sun.star.util.NumberFormat.TEXT) AND (oCell.String <> "") then
|
||||
If oCell.String <> "" And Val(oCell.String) = 0then
|
||||
WriteStringtoLogFile(oCell.String)
|
||||
End If
|
||||
Wend
|
||||
@@ -382,7 +381,7 @@ Dim oPage, oPageElement, oShape as Object
|
||||
For s = 0 To oPageElement.Count - 1
|
||||
WriteStringToLogFile(oPageElement.GetByIndex(s).String)
|
||||
Next s
|
||||
Else
|
||||
ElseIf HasUnoInterfaces(oPageElement, "com.sun.star.text.XText") Then
|
||||
WriteStringtoLogFile(oPageElement.String)
|
||||
End If
|
||||
Next
|
||||
@@ -512,8 +511,6 @@ End Sub
|
||||
' ***********************************************LogDocument**************************************************
|
||||
|
||||
Sub WriteStringtoLogFile( sString as String)
|
||||
|
||||
' Schreibt den String in ein Array
|
||||
If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then
|
||||
LogArray(LogIndex) = sString
|
||||
LogIndex = LogIndex + 1
|
||||
@@ -524,89 +521,9 @@ End Sub
|
||||
|
||||
|
||||
Sub MakeLogHeadLine(HeadText as String)
|
||||
oLogCursor.CharStyle = "LogHeading"
|
||||
oLogCursor.CharStyleName = "LogHeaderText"
|
||||
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oLogText.insertString(oLogCursor,HeadText,False)
|
||||
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oLogCursor.CharStyle = "LogBodyText"
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
'Sub GetHTMLStrings(SearchString as String)
|
||||
'Dim i,AsciiCount as integer
|
||||
'Dim AsciiLocChar as string
|
||||
'Dim TTString,AddString as String
|
||||
'Dim oTextCursor as object
|
||||
'Dim LeaveLoop as Boolean
|
||||
|
||||
' oSearchDesc = oDocument.createSearchDescriptor()
|
||||
' oSearchDesc.SearchRegularExpression = True
|
||||
' oSearchDesc.Searchstring = SearchString & """" & "*" & """"
|
||||
' oFoundall = oDocument.FindAll(oSearchDesc)
|
||||
|
||||
' For i = 0 to oFoundAll.Count-1
|
||||
' oFound = oFoundall(i)
|
||||
' oTextCursor = oDocument.text.CreateTextCursorbyRange(oFound)
|
||||
' oTextCursor.GotoNextWord(false)
|
||||
' oTextCursor.GotoStartofWord(True)
|
||||
' oTextCursor.GoRight(1,True)
|
||||
' TTString = oTextCursor.String
|
||||
' If Left(TTString,1) = """" Then
|
||||
' LeaveLoop = False
|
||||
' oTextCursor.GoRight(1,True)
|
||||
' Do
|
||||
' oTextCursor.GoRight(1,True)
|
||||
' TTString = TTString + Right(oTextCursor.String,1)
|
||||
' If Right(oTextCursor.String,1) = """" Then
|
||||
' TTString = ReplaceString(TTString,"","""")
|
||||
' LeaveLoop = True
|
||||
' End If
|
||||
' Loop Until LeaveLoop = True
|
||||
'
|
||||
' End If
|
||||
'
|
||||
' If TTString <> "" then
|
||||
' TTString = ReplaceHTMLChars(TTString)
|
||||
' WriteStringtoLogFile(TTString)
|
||||
' End if
|
||||
' Next i
|
||||
'
|
||||
'End Sub
|
||||
|
||||
' If sDocMimeType = "text/html" then
|
||||
' FileProperties(0).Name = "FilterName"
|
||||
' FileProperties(0).Value = "swriter: TEXT"
|
||||
' FilePath = oDocument.URL
|
||||
' oDocument.Dispose
|
||||
'
|
||||
' oDocument = OpenDocument(FilePath,FileProperties(),StarDesktop) '!!!!!!!
|
||||
'
|
||||
' MakeLogHeadLine("Alternativtexte")
|
||||
' GetHTMLStrings("ALT=")
|
||||
'
|
||||
' MakeLogHeadLine("Referenzen")
|
||||
' GetHTMLStrings("HREF=")
|
||||
'
|
||||
' MakeLogHeadLine("Namen")
|
||||
' GetHTMLStrings("NAME=")
|
||||
' Else
|
||||
|
||||
|
||||
Sub LoadLibrary(sLibname as String)
|
||||
Dim oArg(0) as new com.sun.star.beans.PropertyValue
|
||||
Dim oUrl as new com.sun.star.util.URL
|
||||
Dim oTrans as Object
|
||||
Dim oDisp as Object
|
||||
|
||||
oArg(0).Name = "LibraryName"
|
||||
oArg(0).Value = sLibname
|
||||
|
||||
oTrans = createUNOService("com.sun.star.util.URLTransformer")
|
||||
oUrl.Complete = "slot:6517"
|
||||
oTrans.parsestrict(oUrl)
|
||||
|
||||
oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)
|
||||
oDisp.dispatch(oUrl, oArg())
|
||||
End Sub
|
||||
</script:module>
|
||||
oLogCursor.CharStyleName = "LogBodyText"
|
||||
End Sub</script:module>
|
||||
@@ -1,130 +1,114 @@
|
||||
<?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
|
||||
Const SBBASEWIDTH = 8000
|
||||
Const SBBASEHEIGHT = 1000
|
||||
Const SBPAGEX = 800
|
||||
Const SBPAGEY = 800
|
||||
Const SBBASECHARHEIGHT = 12
|
||||
Const SBRELDIST = 1.1
|
||||
'Public Const SBBASEWIDTH = 8000
|
||||
'Public Const SBBASEHEIGHT = 1000
|
||||
Public Const SBPAGEX = 800
|
||||
Public Const SBPAGEY = 800
|
||||
Public Const SBRELDIST = 1.3
|
||||
|
||||
REM Names of the second Dimension of the Array iLevelPos
|
||||
Const SBBASEX = 0
|
||||
Const SBBASEY = 1
|
||||
' Names of the second Dimension of the Array iLevelPos
|
||||
Public Const SBBASEX = 0
|
||||
Public Const SBBASEY = 1
|
||||
|
||||
Const SBOLDSTARTX = 2
|
||||
Const SBOLDSTARTY = 3
|
||||
Public Const SBOLDSTARTX = 2
|
||||
Public Const SBOLDSTARTY = 3
|
||||
|
||||
Const SBOLDENDX = 4
|
||||
Const SBOLDENDY = 5
|
||||
Public Const SBOLDENDX = 4
|
||||
Public Const SBOLDENDY = 5
|
||||
|
||||
Const SBNEWSTARTX = 6
|
||||
Const SBNEWSTARTY = 7
|
||||
Public Const SBNEWSTARTX = 6
|
||||
Public Const SBNEWSTARTY = 7
|
||||
|
||||
Const SBNEWENDX = 8
|
||||
Const SBNEWENDY = 9
|
||||
Public Const SBNEWENDX = 8
|
||||
Public Const SBNEWENDY = 9
|
||||
|
||||
Public ConnectLevel As Integer
|
||||
Public iLevelPos(10,9) As Integer
|
||||
Public iLevelPos(1,9) As Long
|
||||
Public Source as String
|
||||
Public iCurLevel, nConnectLevel as Integer
|
||||
Public nOldWidth, nOldHeight As Integer
|
||||
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
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
BasicLibraries.LoadLibrary("Template")
|
||||
ReadDirDlg.Load
|
||||
ReadDirDlg.Show
|
||||
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","ReadDirDlg")
|
||||
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 oDesktop As Object
|
||||
Dim oDocument As Object
|
||||
Dim iCurPage As Integer
|
||||
Dim oPage As Object
|
||||
Dim oOldPage As Object
|
||||
Dim i, n, s as Integer
|
||||
Dim i as Integer
|
||||
Dim bStartUpRun As Boolean
|
||||
Dim FileNames(600,2) as String
|
||||
Dim CurFile as String
|
||||
Dim CurFilename as String
|
||||
Dim BaseLevel as Integer
|
||||
Dim oController as Object
|
||||
Dim FileCount as Integer
|
||||
Dim oStatusline as Object
|
||||
ReadDirDlg.Unload
|
||||
bStartUpRun = TRUE
|
||||
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
|
||||
iCurPage = 0
|
||||
|
||||
oDesktop = createUnoService("com.sun.star.frame.Desktop")
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
oPage = oDocument.DrawPages(iCurPage)
|
||||
oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator
|
||||
oStatusLine.Start("Fortschritt:",100)
|
||||
oController = oDocument.GetCurrentController
|
||||
Source = ConvertToURL(ReadDirdlg.Textbox1.Text)
|
||||
Source = ConvertToURL(DlgReadDir.Model.TextField1.Text)
|
||||
BaseLevel = CountCharsInString(Source, "/", 1)
|
||||
|
||||
oStatusline.SetValue(2)
|
||||
oProgressBar.ProgressValue = 5
|
||||
DlgReadDir.Model.Label3.Enabled = True
|
||||
FileNames() = ReadSourceDirectory(Source)
|
||||
oStatusline.SetValue(8)
|
||||
DlgReadDir.Model.Label4.Enabled = True
|
||||
DlgReadDir.Model.Label3.Enabled = False
|
||||
oProgressBar.ProgressValue = 12
|
||||
FileNames() = BubbleSortList(FileNames())
|
||||
oStatusline.SetValue(10)
|
||||
|
||||
FileCount = Val(FileNames(0,0))
|
||||
For i = 1 To FileCount
|
||||
oStatusLine.SetValue(10 + i/FileCount * 90)
|
||||
CurFile = FileNames(i,1)
|
||||
iCurLevel= CountCharsInString(FileNames(i,0), "/", 1) - BaseLevel
|
||||
If iCurLevel <> 0 Then
|
||||
nConnectLevel = iCurLevel- 1
|
||||
Else
|
||||
nConnectLevel = iCurLevel
|
||||
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
|
||||
|
||||
REM Add New page If necessary
|
||||
REM ck IF nOldY + nOldHeight * 1/SBRELDIST > oPage.Height - SBPAGEY Then
|
||||
IF nOldY + (nOldHeight + SBBASECHARHEIGHT) * 1.5 > oPage.Height - SBPAGEY Then
|
||||
iCurPage = iCurPage + 1
|
||||
oDocument.getDrawPages.InsertNewbyIndex(iCurPage)
|
||||
|
||||
oPage = oDocument.DrawPages(iCurPage)
|
||||
oController.SetCurrentPage (oPage)
|
||||
|
||||
For n = 0 To nConnectLevel
|
||||
iLevelPos(n,SBNEWENDY) = nOldY + nOldHeight REM oOldPage.Height
|
||||
oOldLeavingLine = DrawLine(n, SBNEWSTARTX, SBNEWSTARTY, SBNEWSTARTX, SBNEWENDY, oOldPage)
|
||||
REM ck SBNEWENDX, SBNEWENDY)
|
||||
Next
|
||||
For n = 0 To nConnectLevel
|
||||
iLevelPos(n,SBNEWSTARTY) = SBPAGEY
|
||||
Next
|
||||
nOldY = SBPAGEY
|
||||
End If
|
||||
oCurTextShape = CreateTextShape(oPage, CurFile)
|
||||
|
||||
REM The Current TextShape has To be connected with a TextShape
|
||||
REM one Level higher
|
||||
REM - except For a TextShape In Level 0
|
||||
|
||||
REM Line Coordinates
|
||||
' The Current TextShape has To be connected with a TextShape one Level higher
|
||||
' except for a TextShape In Level 0:
|
||||
If Not bStartUpRun Then
|
||||
|
||||
REM A leaving Line Is only drawn when level is not 0
|
||||
' A leaving Line Is only drawn when level is not 0
|
||||
If iCurLevel<> 0 Then
|
||||
REM Determine the Coordinates of the arriving Line
|
||||
' Determine the Coordinates of the arriving Line
|
||||
iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
|
||||
iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
|
||||
|
||||
@@ -133,92 +117,66 @@ REM Determine the Coordinates of the arriving Line
|
||||
|
||||
oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage)
|
||||
|
||||
REM Determine the End-Coordinates of the last leaving Line
|
||||
' 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
|
||||
REM On Level 0 the last Leaving Line's endpoint
|
||||
REM is the upper edge of the textShape
|
||||
' 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
|
||||
REM Draw the Connectors To the previous TextShapes
|
||||
' Draw the Connectors To the previous TextShapes
|
||||
oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
|
||||
Else
|
||||
REM StartingPoint of the leaving edge
|
||||
' StartingPoint of the leaving Edge
|
||||
bStartUpRun = FALSE
|
||||
End If
|
||||
|
||||
REM Determine the beginning Coordinates of the leaving Line
|
||||
' 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
|
||||
|
||||
REM Save the values For the Next run
|
||||
' Save the values For the Next run
|
||||
nOldHeight = oCurTextShape.Size.Height
|
||||
nOldX = oCurTextShape.Position.X
|
||||
nOldWidth = oCurTextShape.Size.Width
|
||||
nOldLevel = iCurLevel
|
||||
Set oOldPage = oPage
|
||||
Next i
|
||||
oStatusLine.End
|
||||
Exit Sub
|
||||
ErrorHandler:
|
||||
MsgBox error, 0,"Error in Line" & erl
|
||||
ToggleDialogControls(True)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function CreateTextShape(oPage as Object, Filename as String)
|
||||
Dim oTextShape As Object
|
||||
Dim PageWidth, BaseX, TextWidth
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
|
||||
aSize.Width = SBBASEWIDTH
|
||||
aSize.Height = SBBASEHEIGHT
|
||||
|
||||
aPoint.x = CalculateXPoint()
|
||||
aPoint.y = nOldY + SBRELDIST * nOldHeight
|
||||
nOldY = aPoint.y
|
||||
aPoint.X = CalculateXPoint()
|
||||
aPoint.Y = nOldY + SBRELDIST * nOldHeight
|
||||
nOldY = aPoint.Y
|
||||
|
||||
oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape")
|
||||
oTextShape.Size = aSize
|
||||
oTextShape.LineStyle = 1
|
||||
oTextShape.Position = aPoint
|
||||
|
||||
oPage.add(oTextShape)
|
||||
oTextShape.LineStyle = 1
|
||||
oTextShape.Charheight = SBBASECHARHEIGHT
|
||||
oTextShape.TextAutoGrowWidth = TRUE
|
||||
oTextShape.TextAutoGrowHeight = TRUE
|
||||
oTextShape.String = FileName
|
||||
|
||||
REM Configure Size And Position of the TextShape according to its Scripting
|
||||
aPoint.x = iLevelPos(iCurLevel,SBBASEX)
|
||||
' Configure Size And Position of the TextShape according to its Scripting
|
||||
aPoint.X = iLevelPos(iCurLevel,SBBASEX)
|
||||
oTextShape.Position = aPoint
|
||||
aSize.Height = SBRELDIST * oTextShape.CharHeight
|
||||
aSize.Width = SBRELDIST * oTextShape.Size.Width
|
||||
|
||||
PageWidth = oPage.Width
|
||||
TextWidth = aSize.Width
|
||||
BaseX = aPoint.x
|
||||
If BaseX + TextWidth > PageWidth - 1000 Then
|
||||
oPage.Width = 1000 + BaseX + TextWidth
|
||||
End If
|
||||
oTextShape.Size = aSize
|
||||
iLevelPos(iCurLevel,SBBASEY) = oTextShape.Position.Y
|
||||
CreateTextShape = oTextShape
|
||||
CreateTextShape() = oTextShape
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function CalculateXPoint()
|
||||
|
||||
REM The current level Is lower than the Old one
|
||||
' The current level Is lower than the Old one
|
||||
If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then
|
||||
REM ClearArray(iLevelPos(),iCurLevel+1)
|
||||
' ClearArray(iLevelPos(),iCurLevel+1)
|
||||
Elseif iCurLevel= 0 Then
|
||||
iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
|
||||
REM The current level Is higher than the old one
|
||||
' The current level Is higher than the old one
|
||||
Elseif iCurLevel> nOldLevel Then
|
||||
iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
|
||||
End If
|
||||
@@ -226,73 +184,125 @@ REM The current level Is higher than the old one
|
||||
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
|
||||
DrawLine() = oConnect
|
||||
End Function
|
||||
|
||||
|
||||
Sub SourceSearchDialog()
|
||||
Source = Application.FileDialog( "P", "Wählen Sie ein Verzeichnis", "D:\Arbeitsverzeichnis" ) ' "Wählen Sie ein Verzeichnis"
|
||||
If Len( Source ) > 0 Then
|
||||
ReadDirDlg.Textbox1.Text = Source
|
||||
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
|
||||
|
||||
Function ReadSourceDirectory(ByVal Source As String)
|
||||
Dim i, m, n, s as integer
|
||||
Dim FileCount As Integer
|
||||
Dim FileCountinDir as Integer
|
||||
Dim FileName as string
|
||||
Dim FileNameList(2000,1) as String
|
||||
Dim DirList(200) as String
|
||||
Dim oUCBobject as Object
|
||||
|
||||
oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
'isfolder
|
||||
m = 0
|
||||
s = 1
|
||||
DirList(0) = Source
|
||||
FileNameList(1,0) = Source
|
||||
FileNameList(1,1) = GetFileNameoutofPath(Source)
|
||||
n = 2
|
||||
Do
|
||||
Source = DirList(m)
|
||||
m = m + 1
|
||||
|
||||
DirContent = oUcbObject.GetFolderContents(Source,True)
|
||||
|
||||
If Ubound(DirContent()) <> -1 Then
|
||||
FileCountinDir = Ubound(DirContent()) + 1
|
||||
For i = 0 to FilecountinDir -1
|
||||
FileName = DirContent(i)
|
||||
FilenameList(n,0) = FileName
|
||||
FileNameList(n,1) = GetFileNameOutofPath(FileName)
|
||||
n = n + 1
|
||||
If oUcbObject.IsFolder(FileName) Then
|
||||
DirList(s) = FileName
|
||||
DirList(0) = CStr(s)
|
||||
s = s + 1
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
Loop Until m = cInt(DirList(0))+ 1
|
||||
FileNameList(0,0) = n - 1
|
||||
ReadSourceDirectory = FileNameList()
|
||||
End Function
|
||||
</script:module>
|
||||
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>
|
||||
@@ -1,7 +1,49 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="UserfieldDlg" dlg:style-id="0">
|
||||
<dlg:styles>
|
||||
<dlg:style dlg:style-id="0"/>
|
||||
</dlg:styles>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="UserfieldDlg" dlg:title="Modify Userfields" dlg:left="161" dlg:top="57" dlg:width="281" dlg:height="214">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="Label1" dlg:tab-index="0" dlg:left="6" dlg:top="48" dlg:width="57" dlg:height="8" dlg:value="Label1"/>
|
||||
<dlg:text dlg:id="Label2" dlg:tab-index="1" dlg:left="6" dlg:top="64" dlg:width="57" dlg:height="8" dlg:value="Label2"/>
|
||||
<dlg:text dlg:id="Label3" dlg:tab-index="2" dlg:left="6" dlg:top="80" dlg:width="57" dlg:height="8" dlg:value="Label3"/>
|
||||
<dlg:text dlg:id="Label4" dlg:tab-index="3" dlg:left="6" dlg:top="96" dlg:width="57" dlg:height="8" dlg:value="Label4"/>
|
||||
<dlg:text dlg:id="Label5" dlg:tab-index="4" dlg:left="6" dlg:top="112" dlg:width="57" dlg:height="8" dlg:value="Label5"/>
|
||||
<dlg:text dlg:id="Label6" dlg:tab-index="5" dlg:left="6" dlg:top="128" dlg:width="57" dlg:height="8" dlg:value="Label6"/>
|
||||
<dlg:text dlg:id="Label7" dlg:tab-index="6" dlg:left="6" dlg:top="144" dlg:width="57" dlg:height="8" dlg:value="Label7"/>
|
||||
<dlg:text dlg:id="Label8" dlg:tab-index="7" dlg:left="6" dlg:top="160" dlg:width="57" dlg:height="8" dlg:value="Label8"/>
|
||||
<dlg:text dlg:id="Label9" dlg:tab-index="8" dlg:left="6" dlg:top="176" dlg:width="57" dlg:height="8" dlg:value="Label9"/>
|
||||
<dlg:textfield dlg:id="TextField1" dlg:tab-index="9" dlg:left="65" dlg:top="46" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField2" dlg:tab-index="10" dlg:left="65" dlg:top="62" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField3" dlg:tab-index="11" dlg:left="65" dlg:top="78" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField4" dlg:tab-index="12" dlg:left="65" dlg:top="94" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField5" dlg:tab-index="13" dlg:left="65" dlg:top="110" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField6" dlg:tab-index="14" dlg:left="65" dlg:top="126" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField7" dlg:tab-index="15" dlg:left="65" dlg:top="142" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField8" dlg:tab-index="16" dlg:left="65" dlg:top="158" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField9" dlg:tab-index="17" dlg:left="65" dlg:top="174" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:scrollbar dlg:id="ScrollBar1" dlg:tab-index="18" dlg:left="263" dlg:top="46" dlg:width="12" dlg:height="140" dlg:align="vertical">
|
||||
<script:event script:event-name="on-mouseup" script:location="application" script:macro-name="Gimmicks.Userfields.ScrollControls" script:language="StarBasic"/>
|
||||
</dlg:scrollbar>
|
||||
<dlg:button dlg:id="cmdQuit" dlg:tab-index="19" dlg:left="6" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Quit Macro" dlg:value="Quit">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.StopMacro" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdSave" dlg:tab-index="20" dlg:left="45" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Save all Data of all users to file" dlg:value="~Save">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.SaveSettings" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdTakeOver" dlg:tab-index="21" dlg:left="84" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Insert current User Data into Office Application" dlg:value="Se~lect">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.SelectCurrentFields" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdNextUser" dlg:tab-index="22" dlg:left="162" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="1" dlg:help-text="Show Data of Next User" dlg:value="Next >>">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.StepToRecord" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdPrevUser" dlg:tab-index="23" dlg:left="123" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="-1" dlg:help-text="Show Data of Previous User" dlg:value="<<Previous">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.StepToRecord" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="CommandButton1" dlg:tab-index="24" dlg:left="201" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Add new User" dlg:value="~New">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.AddRecord" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="Label10" dlg:tab-index="25" dlg:left="6" dlg:top="6" dlg:width="269" dlg:height="34" dlg:value="This Macro offers the opportunity to administrate several user Data in a simple way.
The User data of several users may be stored in an own file in the directory <ConfigDir> from where they can be inserted as the main user data into the office." dlg:multiline="true"/>
|
||||
<dlg:button dlg:id="cmdDelete" dlg:tab-index="26" dlg:left="240" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="Delete Data of current User" dlg:value="Delete">
|
||||
<script:event script:event-name="on-performaction" script:location="application" script:macro-name="Gimmicks.Userfields.DeleteCurrentSettings" script:language="StarBasic"/>
|
||||
</dlg:button>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -1,196 +1,274 @@
|
||||
<?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="Userfields" script:language="StarBasic">Option Explicit
|
||||
'Todo: Controlling Scrollbar via Keyboard
|
||||
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Userfields" script:language="StarBasic">
|
||||
Public iUserFieldCount as integer
|
||||
Public LabelArray(10) as Object
|
||||
Public EditArray(10) as Object
|
||||
Public UserFieldName(255) as String
|
||||
Public UserFieldValue(255) as String
|
||||
Public Const SBMAXFIELDINDEX = 14
|
||||
|
||||
Public DlgUserFields as Object
|
||||
Public oDocument as Object
|
||||
Public aTextField as Object
|
||||
Public aTextFieldEnum as Object
|
||||
Public const MAXFIELDCOUNT = 9
|
||||
Public UserFieldDataType(14) as String
|
||||
Public UserFieldDataType(SBMAXFIELDINDEX,1) as String
|
||||
Public ScrollBarValue as Integer
|
||||
Public UserFieldFamily(0, SBMAXfIELDINDEX) as String
|
||||
Public Const SBTBCOUNT = 9
|
||||
Public oUserDataAccess as Object
|
||||
Public CurFieldIndex as Integer
|
||||
Public FilePath as String
|
||||
|
||||
Sub StartChangesUserfields
|
||||
Dim a as Integer
|
||||
Dim CurElement, TFMaster as Object
|
||||
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
LoadLanguage(StarDesktop.ISOLocale.Language)
|
||||
Dim SystemPath as String
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
UserFieldDatatype(0,0) = "COMPANY"
|
||||
UserFieldDatatype(0,1) = "o"
|
||||
UserFieldDatatype(1,0) = "FIRSTNAME"
|
||||
UserFieldDatatype(1,1) = "givenname"
|
||||
UserFieldDatatype(2,0) = "NAME"
|
||||
UserFieldDatatype(2,1) = "sn"
|
||||
UserFieldDatatype(3,0) = "SHORTCUT"
|
||||
UserFieldDatatype(3,1) = "initials"
|
||||
UserFieldDatatype(4,0) = "STREET"
|
||||
UserFieldDatatype(4,1) = "street"
|
||||
UserFieldDatatype(5,0) = "COUNTRY"
|
||||
UserFieldDatatype(5,1) = "c"
|
||||
UserFieldDatatype(6,0) = "ZIP"
|
||||
UserFieldDatatype(6,1) = "postalcode"
|
||||
UserFieldDatatype(7,0) = "CITY"
|
||||
UserFieldDatatype(7,1) = "l"
|
||||
UserFieldDatatype(8,0) = "TITLE"
|
||||
UserFieldDatatype(8,1) = "title"
|
||||
UserFieldDatatype(9,0) = "POSITION"
|
||||
UserFieldDatatype(9,1) = "position"
|
||||
UserFieldDatatype(10,0) = "PHONE_PRIVATE"
|
||||
UserFieldDatatype(10,1) = "homephone"
|
||||
UserFieldDatatype(11,0) = "PHONE_COMPANY"
|
||||
UserFieldDatatype(11,1) = "telephonenumber"
|
||||
UserFieldDatatype(12,0) = "FAX"
|
||||
UserFieldDatatype(12,1) = "facsimiletelephonenumber"
|
||||
UserFieldDatatype(13,0) = "EMAIL"
|
||||
UserFieldDatatype(13,1) = "mail"
|
||||
UserFieldDatatype(14,0) = "STATE"
|
||||
UserFieldDatatype(14,1) = "st"
|
||||
FilePath = GetPathSettings("Config", False) & "/" & "UserData.dat"
|
||||
DlgUserFields = LoadDialog("Gimmicks","UserfieldDlg")
|
||||
SystemPath = ConvertFromUrl(FilePath)
|
||||
DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, "'" & SystemPath & "'", "<ConfigDir>")
|
||||
ScrollBarValue = 0
|
||||
UserFieldDatatype(0) = "COMPANY"
|
||||
UserFieldDatatype(1) = "FIRSTNAME"
|
||||
UserFieldDatatype(2) = "NAME"
|
||||
UserFieldDatatype(3) = "SHORTCUT"
|
||||
UserFieldDatatype(4) = "STREET"
|
||||
UserFieldDatatype(5) = "COUNTRY"
|
||||
UserFieldDatatype(6) = "ZIP"
|
||||
UserFieldDatatype(7) = "CITY"
|
||||
UserFieldDatatype(8) = "TITLE"
|
||||
UserFieldDatatype(9) = "POSITION"
|
||||
UserFieldDatatype(10) = "PHONE_PRIVATE"
|
||||
UserFieldDatatype(11) = "PHONE_COMPANY"
|
||||
UserFieldDatatype(12) = "FAX"
|
||||
UserFieldDatatype(13) = "EMAIL"
|
||||
UserFieldDatatype(14) = "STATE"
|
||||
|
||||
On Local Error GoTo NODOCUMENT
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
NODOCUMENT:
|
||||
If Err <> 0 Then
|
||||
Msgbox(Error$ & "This Macro gives you the opportunity to change all Userfields of a displayed Document." & chr(13) &_
|
||||
"To start this macro you have to activate a Document first!" , 16, "StarOffice 5.2")
|
||||
Exit Sub
|
||||
End If
|
||||
On Local Error Goto 0
|
||||
|
||||
' Define TextFields
|
||||
aTextfield = oDocument.getTextfields
|
||||
aTextFieldEnum = aTextField.CreateEnumeration
|
||||
a = 0
|
||||
While aTextFieldEnum.hasmoreElements
|
||||
CurElement = aTextFieldEnum.NextElement
|
||||
If Not IsNull(CurElement) Then
|
||||
If CurElement.PropertySetInfo.hasPropertybyName("Content") Then
|
||||
TFMaster = CurElement.TextFieldMaster
|
||||
a = a + 1
|
||||
If a >= 255 Then
|
||||
MsgBox ErrorMsg1, 0 + 16, ErrorHeader
|
||||
Exit Sub
|
||||
End If
|
||||
UserFieldName(a) = UserFieldDataType(CurElement.UserDataType)
|
||||
UserFieldValue(a) = CurElement.Content
|
||||
End If
|
||||
End If
|
||||
Wend
|
||||
iUserFieldCount = a
|
||||
If iUserFieldCount = 0 Then
|
||||
MsgBox ErrorMsg2, 0+48, ErrorHeader
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
UserfieldDlg.Load
|
||||
|
||||
Call SetControlArray()
|
||||
Call FillDialog()
|
||||
|
||||
UserFieldDlg.Show
|
||||
oUserDataAccess = GetRegistryKeyContent("org.openoffice.UserProfile/Data", True)
|
||||
InitializeUserFamily()
|
||||
FillDialog()
|
||||
DlgUserFields.Execute
|
||||
DlgUserFields.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub FillDialog()
|
||||
Dim a as Integer
|
||||
Call SetDialogText
|
||||
For a = 1 To MaxFieldCount
|
||||
If a <= iUserFieldCount Then
|
||||
LabelArray(a).Caption = UserFieldName(a)
|
||||
EditArray(a).Text = UserFieldValue(a)
|
||||
Else
|
||||
LabelArray(a).Caption = ""
|
||||
EditArray(a).Text = ""
|
||||
LabelArray(a).Enabled = False
|
||||
EditArray(a).Enabled = false
|
||||
End If
|
||||
Next a
|
||||
|
||||
If iUserFieldCount > MaxFieldCount Then
|
||||
UserfieldDlg.VScrollbar.Min = 0
|
||||
UserfieldDlg.VScrollbar.Max = iUserFieldCount-MaxFieldCount
|
||||
UserfieldDlg.VScrollbar.LargeChange = MaxFieldCount
|
||||
UserfieldDlg.VScrollbar.SmallChange = 1
|
||||
Else
|
||||
UserfieldDlg.VScrollbar.enabled = False
|
||||
End If
|
||||
|
||||
With DlgUserFields
|
||||
For a = 1 To SBTBCount
|
||||
.GetControl("Label" & a).Model.Label = UserFieldDataType(a-1,0)
|
||||
.GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, a-1)
|
||||
Next a
|
||||
.Model.ScrollBar1.ScrollValueMax = (SBMAXFIELDINDEX+1) - SBTBCOUNT
|
||||
.Model.ScrollBar1.BlockIncrement = SBTBCOUNT
|
||||
.Model.ScrollBar1.LineIncrement = 1
|
||||
.Model.ScrollBar1.ScrollValue = ScrollBarValue
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub Dlg_Scroll(ScrollValue)
|
||||
Call ChangeArray(ScrollBarValue)
|
||||
ScrollBarValue = UserfieldDlg.VScrollbar.Value
|
||||
If (ScrollBarValue + MaxFieldCount) > iUserFieldCount Then
|
||||
ScrollBarValue = iUserFieldCount - MaxFieldCount
|
||||
Sub ScrollControls()
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
ScrollBarValue = DlgUserFields.Model.ScrollBar1.ScrollValue
|
||||
If (ScrollBarValue + SBTBCOUNT) >= SBMAXFIELDINDEX + 1 Then
|
||||
ScrollBarValue = (SBMAXFIELDINDEX + 1) - SBTBCOUNT
|
||||
End If
|
||||
|
||||
For a = 1 To MaxFieldCount
|
||||
LabelArray(a).Caption = UserFieldName(a + ScrollBarValue)
|
||||
EditArray(a).Text = UserFieldValue(a + ScrollBarValue)
|
||||
Next a
|
||||
FillupTextFields()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChangeArray(ByVal ScrollBarValue)
|
||||
Sub ScrollTextFieldInfo(ByVal iScrollValue as Integer)
|
||||
Dim a as Integer
|
||||
For a = 1 To MaxFieldCount
|
||||
UserFieldValue(a + ScrollBarValue) = EditArray(a).Text
|
||||
Dim CurIndex as Integer
|
||||
For a = 1 To SBTBCOUNT
|
||||
CurIndex = (a-1) + iScrollValue
|
||||
UserFieldFamily(CurFieldIndex,CurIndex) = DlgUserFields.GetControl("TextField" & a).Model.Text
|
||||
Next a
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Cancel_Click
|
||||
UserfieldDlg.Hide
|
||||
Sub StopMacro()
|
||||
DlgUserFields.EndExecute
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Save_Click
|
||||
Sub SaveSettings()
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
ScrollTextFieldInfo(DlgUserFields.Model.ScrollBar1.ScrollValue)
|
||||
MaxIndex = Ubound(UserFieldFamily(), 1)
|
||||
Dim FileStrings(MaxIndex) as String
|
||||
For n = 0 To MaxIndex
|
||||
FileStrings(n) = ""
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
FileStrings(n) = FileStrings(n) & UserFieldFamily(n,m) & ";"
|
||||
Next m
|
||||
Next n
|
||||
SaveDataToFile(FilePath, FileStrings(), True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SaveDataToFile(FilePath as String, DataList() as String)
|
||||
Dim FileChannel as Integer
|
||||
Dim i as Integer
|
||||
Dim CurElement, TFMaster as Object
|
||||
Dim oFile as Object
|
||||
Dim oOutputStream as Object
|
||||
Dim oStreamString as Object
|
||||
Dim oUcb as Object
|
||||
Dim sCRLF as String
|
||||
|
||||
UserfieldDlg.CancelChanges.Enabled = false
|
||||
UserfieldDlg.SaveChanges.Enabled = false
|
||||
sCRLF = CHR(10) & CHR(13)
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
oOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
|
||||
If oUcb.Exists(FilePath) Then
|
||||
oUcb.Kill(FilePath)
|
||||
End If
|
||||
oFile = oUcb.OpenFileReadWrite(FilePath)
|
||||
oOutputStream.SetOutputStream(oFile.GetOutputStream)
|
||||
For i = 0 To Ubound(DataList())
|
||||
oOutputStream.WriteString(DataList(i) & sCRLF)
|
||||
Next i
|
||||
oOutputStream.CloseOutput()
|
||||
End Sub
|
||||
|
||||
ChangeArray(UserfieldDlg.VScrollbar.Value)
|
||||
|
||||
aTextfield = oDocument.getTextfields
|
||||
aTextFieldEnum = aTextField.CreateEnumeration
|
||||
i = 1
|
||||
While aTextFieldEnum.hasmoreElements
|
||||
CurElement = aTextFieldEnum.NextElement
|
||||
If Not IsNull(CurElement) Then
|
||||
If Curelement.PropertySetInfo.hasPropertybyName("Content") Then
|
||||
If CurElement.Content <> UserFieldValue(i) Then
|
||||
CurElement.Content = UserFieldValue(i)
|
||||
End If
|
||||
i = i + 1
|
||||
Sub ToggleButtons(ByVal Index as Integer)
|
||||
Dim i as Integer
|
||||
CurFieldIndex = Index
|
||||
DlgUserFields.Model.cmdNextUser.Enabled = CurFieldIndex <> Ubound(UserFieldFamily(), 1)
|
||||
DlgUserFields.Model.cmdPrevUser.Enabled = CurFieldIndex <> 0
|
||||
End Sub
|
||||
|
||||
|
||||
Function LoadDataFromFile(FilePath as String, DataList() as String) as Boolean
|
||||
Dim oInputStream as Object
|
||||
Dim i as Integer
|
||||
Dim oUcb as Object
|
||||
Dim oFile as Object
|
||||
Dim MaxIndex as Integer
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
If oUcb.Exists(FilePath) Then
|
||||
MaxIndex = 10
|
||||
oInputStream = createUnoService("com.sun.star.io.TextInputStream")
|
||||
oFile = oUcb.OpenFileReadWrite(FilePath)
|
||||
oInputStream.SetInputStream(oFile.GetInputStream)
|
||||
i = -1
|
||||
Redim Preserve DataList(MaxIndex) as String
|
||||
While Not oInputStream.IsEOF
|
||||
i = i + 1
|
||||
If i > MaxIndex Then
|
||||
MaxIndex = MaxIndex + 10
|
||||
Redim Preserve DataList(MaxIndex) as String
|
||||
End If
|
||||
DataList(i) = oInputStream.ReadLine
|
||||
Wend
|
||||
If i > -1 And i <> MaxIndex Then
|
||||
Redim Preserve DataList(i) as String
|
||||
End If
|
||||
Wend
|
||||
aTextField.Refresh
|
||||
UserfieldDlg.Hide
|
||||
LoadDataFromFile() = True
|
||||
oOutputStream.CloseInput()
|
||||
Else
|
||||
LoadDataFromFile() = False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub InitializeUserFamily()
|
||||
Dim FirstIndex as Integer
|
||||
Dim UserFieldstrings() as String
|
||||
Dim LocStrings() as String
|
||||
Dim bFileExists as Boolean
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
bFileExists = LoadDataFromFile(GetPathSettings("Config", False) & "/" & "UserData.dat", UserFieldStrings())
|
||||
If bFileExists Then
|
||||
FirstIndex = Ubound(UserFieldStrings())
|
||||
ReDim Preserve UserFieldFamily(FirstIndex, SBMAXFIELDINDEX) as String
|
||||
For n = 0 To FirstIndex
|
||||
LocStrings() = ArrayOutofString(UserFieldStrings(n), ";")
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(n,m) = LocStrings(m)
|
||||
Next m
|
||||
Next n
|
||||
Else
|
||||
ReDim Preserve UserFieldFamily(0,SBMAXFIELDINDEX) as String
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(0,m) = oUserDataAccess.GetByName(UserFieldDataType(m,1))
|
||||
Next m
|
||||
End If
|
||||
ToggleButtons(0)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub SetControlArray()
|
||||
Set LabelArray(1) = UserfieldDlg.Label1
|
||||
Set EditArray(1) = UserfieldDlg.Textbox1
|
||||
Set LabelArray(2) = UserfieldDlg.Label2
|
||||
Set EditArray(2) = UserfieldDlg.Textbox2
|
||||
Set LabelArray(3) = UserfieldDlg.Label3
|
||||
Set EditArray(3) = UserfieldDlg.Textbox3
|
||||
Set LabelArray(4) = UserfieldDlg.Label4
|
||||
Set EditArray(4) = UserfieldDlg.Textbox4
|
||||
Set LabelArray(5) = UserfieldDlg.Label5
|
||||
Set EditArray(5) = UserfieldDlg.Textbox5
|
||||
Set LabelArray(6) = UserfieldDlg.Label6
|
||||
Set EditArray(6) = UserfieldDlg.Textbox6
|
||||
Set LabelArray(7) = UserfieldDlg.Label7
|
||||
Set EditArray(7) = UserfieldDlg.Textbox7
|
||||
Set LabelArray(8) = UserfieldDlg.Label8
|
||||
Set EditArray(8) = UserfieldDlg.Textbox8
|
||||
Set LabelArray(9) = UserfieldDlg.Label9
|
||||
Set EditArray(9) = UserfieldDlg.Textbox9
|
||||
Sub AddRecord()
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
For i = 1 To SBTBCount
|
||||
DlgUserFields.GetControl("TextField" & i).Model.Text = ""
|
||||
Next i
|
||||
MaxIndex = Ubound(UserFieldFamily(),1)
|
||||
ReDim Preserve UserFieldFamily(MaxIndex + 1, SBMAXFIELDINDEX) as String
|
||||
ToggleButtons(MaxIndex + 1, 1)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetDialogText
|
||||
UserfieldDlg.caption = HeaderLabel
|
||||
UserfieldDlg.HeaderLabel.Caption = HeaderLabel
|
||||
UserfieldDlg.CancelChanges.Caption = CancelButton
|
||||
UserfieldDlg.SaveChanges.Caption = SaveButton
|
||||
Sub FillupTextFields()
|
||||
Dim a as Integer
|
||||
Dim CurIndex as Integer
|
||||
For a = 1 To SBTBCOUNT
|
||||
CurIndex = (a-1) + ScrollBarValue
|
||||
DlgUserFields.GetControl("Label" & a).Model.Label = UserFieldDataType(CurIndex,0)
|
||||
DlgUserFields.GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, CurIndex)
|
||||
Next a
|
||||
End Sub
|
||||
</script:module>
|
||||
|
||||
|
||||
Sub StepToRecord(aEvent as Object)
|
||||
Dim iStep as Integer
|
||||
iStep = CInt(aEvent.Source.Model.Tag)
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
ToggleButtons(CurFieldIndex + iStep)
|
||||
FillUpTextFields()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectCurrentFields()
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
MaxIndex = Ubound(UserFieldFamily(),2)
|
||||
For i = 0 To MaxIndex
|
||||
oUserDataAccess.ReplaceByName(UserFieldDataType(i,1), UserFieldFamily(CurFieldIndex, i))
|
||||
Next i
|
||||
oUserDataAccess.commitChanges()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DeleteCurrentSettings()
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(UserFieldFamily(),1)
|
||||
If CurFieldIndex < MaxIndex Then
|
||||
For n = CurFieldIndex To MaxIndex - 1
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(n,m) = UserFieldFamily(n + 1,m)
|
||||
Next m
|
||||
Next n
|
||||
Else
|
||||
CurFieldIndex = MaxIndex - 1
|
||||
End If
|
||||
ReDim Preserve UserFieldFamily(MaxIndex-1, SBMAXfIELDINDEX) as String
|
||||
FillupTextFields()
|
||||
ToggleButtons(CurFieldIndex)
|
||||
End Sub</script:module>
|
||||
Reference in New Issue
Block a user