summaryrefslogtreecommitdiffstats
path: root/wizards/source/tools
diff options
context:
space:
mode:
Diffstat (limited to 'wizards/source/tools')
-rw-r--r--wizards/source/tools/Debug.xba253
-rw-r--r--wizards/source/tools/DlgOverwriteAll.xdl34
-rw-r--r--wizards/source/tools/Listbox.xba370
-rw-r--r--wizards/source/tools/Misc.xba834
-rw-r--r--wizards/source/tools/ModuleControls.xba387
-rw-r--r--wizards/source/tools/Strings.xba469
-rw-r--r--wizards/source/tools/UCB.xba311
-rw-r--r--wizards/source/tools/dialog.xlb5
-rw-r--r--wizards/source/tools/script.xlb10
9 files changed, 2673 insertions, 0 deletions
diff --git a/wizards/source/tools/Debug.xba b/wizards/source/tools/Debug.xba
new file mode 100644
index 000000000..fe909c5b8
--- /dev/null
+++ b/wizards/source/tools/Debug.xba
@@ -0,0 +1,253 @@
+<?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="Debug" script:language="StarBasic">REM ***** BASIC *****
+
+Sub ActivateReadOnlyFlag()
+ SetBasicReadOnlyFlag(True)
+End Sub
+
+
+Sub DeactivateReadOnlyFlag()
+ SetBasicReadOnlyFlag(False)
+End Sub
+
+
+Sub SetBasicReadOnlyFlag(bReadOnly as Boolean)
+Dim i as Integer
+Dim LibName as String
+Dim BasicLibNames() as String
+ BasicLibNames() = BasicLibraries.ElementNames()
+ For i = 0 To Ubound(BasicLibNames())
+ LibName = BasicLibNames(i)
+ If LibName &lt;&gt; &quot;Standard&quot; Then
+ BasicLibraries.SetLibraryReadOnly(LibName, bReadOnly)
+ End If
+ Next i
+End Sub
+
+
+Sub WritedbgInfo(LocObject as Object)
+Dim locUrl as String
+Dim oLocDocument as Object
+Dim oLocText as Object
+Dim oLocCursor as Object
+Dim NoArgs()
+Dim sObjectStrings(2) as String
+Dim sProperties() as String
+Dim n as Integer
+Dim m as Integer
+Dim MaxIndex as Integer
+ sObjectStrings(0) = LocObject.dbg_Properties
+ sObjectStrings(1) = LocObject.dbg_Methods
+ sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
+ LocUrl = &quot;private:factory/swriter&quot;
+ oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_default&quot;,0,NoArgs)
+ oLocText = oLocDocument.text
+ oLocCursor = oLocText.createTextCursor()
+ oLocCursor.gotoStart(False)
+ If Vartype(LocObject) = 9 then &apos; an Object Variable
+ For n = 0 To 2
+ sProperties() = ArrayoutofString(sObjectStrings(n),&quot;;&quot;, MaxIndex)
+ For m = 0 To MaxIndex
+ oLocText.insertString(oLocCursor,sProperties(m),False)
+ oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
+ Next m
+ Next n
+ Elseif Vartype(LocObject) = 8 Then &apos; a String Variable
+ oLocText.insertString(oLocCursor,LocObject,False)
+ ElseIf Vartype(LocObject) = 1 Then
+ Msgbox(&quot;Variable is Null!&quot;, 16, GetProductName())
+ End If
+End Sub
+
+
+Sub WriteDbgString(LocString as string)
+Dim oLocDesktop as object
+Dim LocUrl as String
+Dim oLocDocument as Object
+Dim oLocCursor as Object
+Dim oLocText as Object
+
+ LocUrl = &quot;private:factory/swriter&quot;
+ oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,&quot;_default&quot;,0,NoArgs)
+ oLocText = oLocDocument.text
+ oLocCursor = oLocText.createTextCursor()
+ oLocCursor.gotoStart(False)
+ oLocText.insertString(oLocCursor,LocString,False)
+End Sub
+
+
+Sub printdbgInfo(LocObject)
+ If Vartype(LocObject) = 9 then
+ Msgbox LocObject.dbg_properties
+ Msgbox LocObject.dbg_methods
+ Msgbox LocObject.dbg_supportedinterfaces
+ Elseif Vartype(LocObject) = 8 Then &apos; a String Variable
+ Msgbox LocObject
+ ElseIf Vartype(LocObject) = 0 Then
+ Msgbox(&quot;Variable is Null!&quot;, 16, GetProductName())
+ Else
+ Msgbox(&quot;Type of Variable: &quot; &amp; Typename(LocObject), 48, GetProductName())
+ End If
+End Sub
+
+
+Sub ShowArray(LocArray())
+Dim i as integer
+Dim msgstring
+ msgstring = &quot;&quot;
+ For i = Lbound(LocArray()) to Ubound(LocArray())
+ msgstring = msgstring + LocArray(i) + chr(13)
+ Next
+ Msgbox msgstring
+End Sub
+
+
+Sub ShowPropertyValues(oLocObject as Object)
+Dim PropName as String
+Dim sValues as String
+ On Local Error Goto NOPROPERTYSETINFO:
+ sValues = &quot;&quot;
+ For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties)
+ Propname = oLocObject.PropertySetInfo.Properties(i).Name
+ sValues = sValues &amp; PropName &amp; chr(13) &amp; &quot; = &quot; &amp; oLocObject.GetPropertyValue(PropName) &amp; chr(13)
+ Next i
+ Msgbox(sValues , 64, GetProductName())
+ Exit Sub
+
+NOPROPERTYSETINFO:
+ Msgbox(&quot;Sorry, No PropertySetInfo attached to the object&quot;, 16, GetProductName())
+ Resume LEAVEPROC
+ LEAVEPROC:
+End Sub
+
+
+Sub ShowNameValuePair(Pair())
+Dim i as Integer
+Dim ShowString as String
+ ShowString = &quot;&quot;
+ On Local Error Resume Next
+ For i = 0 To Ubound(Pair())
+ ShowString = ShowString &amp; Pair(i).Name &amp; &quot; = &quot;
+ ShowString = ShowString &amp; Pair(i).Value &amp; chr(13)
+ Next i
+ Msgbox ShowString
+End Sub
+
+
+&apos; Retrieves all the Elements of aSequence of an object, with the
+&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
+Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
+Dim i as Integer
+Dim NameString as String
+ NameString = &quot;&quot;
+ For i = 0 To Ubound(oLocElements())
+ If Not IsMissIng(sFilterName) Then
+ If Instr(1, oLocElements(i), sFilterName) Then
+ NameString = NameString &amp; oLocElements(i) &amp; chr(13)
+ End If
+ Else
+ NameString = NameString &amp; oLocElements(i) &amp; chr(13)
+ End If
+ Next i
+ Msgbox(NameString, 64, GetProductName())
+End Sub
+
+
+&apos; Retrieves all the supported servicenames of an object, with the
+&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
+Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String)
+ On Local Error Goto NOSERVICENAMES
+ If IsMissing(sFilterName) Then
+ ShowElementNames(oLocobject.SupportedServiceNames())
+ Else
+ ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName)
+ End If
+ Exit Sub
+
+ NOSERVICENAMES:
+ Msgbox(&quot;Sorry, No &apos;SupportedServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
+ Resume LEAVEPROC
+ LEAVEPROC:
+End Sub
+
+
+&apos; Retrieves all the available Servicenames of an object, with the
+&apos; possibility to define a filter(sfilter &lt;&gt; &quot;&quot;)
+Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String)
+ On Local Error Goto NOSERVICENAMES
+ If IsMissing(sFilterName) Then
+ ShowElementNames(oLocobject.AvailableServiceNames)
+ Else
+ ShowElementNames(oLocobject.AvailableServiceNames, sFilterName)
+ End If
+ Exit Sub
+
+ NOSERVICENAMES:
+ Msgbox(&quot;Sorry, No &apos;AvailableServiceNames&apos; - Property attached to the object&quot;, 16, GetProductName())
+ Resume LEAVEPROC
+ LEAVEPROC:
+End Sub
+
+
+Sub ShowCommands(oLocObject as Object)
+ On Local Error Goto NOCOMMANDS
+ ShowElementNames(oLocObject.QueryCommands)
+ Exit Sub
+ NOCOMMANDS:
+ Msgbox(&quot;Sorry, No &apos;QueryCommands&apos; - Property attached to the object&quot;, 16, GetProductName())
+ Resume LEAVEPROC
+ LEAVEPROC:
+End Sub
+
+
+Sub ProtectCurrentSheets()
+Dim oDocument as Object
+Dim sDocType as String
+Dim iResult as Integer
+Dim oSheets as Object
+Dim i as Integer
+Dim bDoProtect as Boolean
+ oDocument = StarDesktop.ActiveFrame.Controller.Model
+ sDocType = GetDocumentType(oDocument)
+ If sDocType = &quot;scalc&quot; Then
+ oSheets = oDocument.Sheets
+ bDoProtect = False
+ For i = 0 To oSheets.Count-1
+ If Not oSheets(i).IsProtected Then
+ bDoProtect = True
+ End If
+ Next i
+ If bDoProtect Then
+ iResult = Msgbox( &quot;Do you want to protect all sheets of this document?&quot;,35, GetProductName())
+ If iResult = 6 Then
+ ProtectSheets(oDocument.Sheets)
+ End If
+ End If
+ End If
+End Sub
+
+
+Sub FillDocument()
+ oMyReport = createUNOService(&quot;com.sun.star.wizards.report.CallReportWizard&quot;)
+ oMyReport.trigger(&quot;fill&quot;)
+End Sub
+
+</script:module> \ No newline at end of file
diff --git a/wizards/source/tools/DlgOverwriteAll.xdl b/wizards/source/tools/DlgOverwriteAll.xdl
new file mode 100644
index 000000000..b241a9bcc
--- /dev/null
+++ b/wizards/source/tools/DlgOverwriteAll.xdl
@@ -0,0 +1,34 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.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 .
+-->
+<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DlgOverwriteAll" dlg:left="138" dlg:top="75" dlg:width="230" dlg:height="64" dlg:closeable="true" dlg:moveable="true">
+ <dlg:bulletinboard>
+ <dlg:text dlg:id="lblQueryforSave" dlg:tab-index="0" dlg:left="6" dlg:top="6" dlg:width="218" dlg:height="36" dlg:value="lblQueryforSave" dlg:multiline="true"/>
+ <dlg:button dlg:id="cmdYes" dlg:tab-index="1" dlg:left="6" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdYes">
+ <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToQuery?language=Basic&amp;location=application" script:language="Script"/>
+ </dlg:button>
+ <dlg:button dlg:id="cmdYesToAll" dlg:tab-index="2" dlg:left="62" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdYesToAll">
+ <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToAlways?language=Basic&amp;location=application" script:language="Script"/>
+ </dlg:button>
+ <dlg:button dlg:id="cmdNo" dlg:tab-index="3" dlg:left="118" dlg:top="43" dlg:width="50" dlg:height="14" dlg:default="true" dlg:value="cmdNo">
+ <script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToNever?language=Basic&amp;location=application" script:language="Script"/>
+ </dlg:button>
+ <dlg:button dlg:id="cmdCancel" dlg:tab-index="4" dlg:left="174" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdCancel" dlg:button-type="cancel"/>
+ </dlg:bulletinboard>
+</dlg:window>
diff --git a/wizards/source/tools/Listbox.xba b/wizards/source/tools/Listbox.xba
new file mode 100644
index 000000000..21f8f44c6
--- /dev/null
+++ b/wizards/source/tools/Listbox.xba
@@ -0,0 +1,370 @@
+<?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="Listbox" script:language="StarBasic">Option Explicit
+Dim OriginalList()
+Dim oDialogModel as Object
+
+
+Sub MergeList(SourceListBox() as Object, SecondList() as String)
+Dim i as Integer
+Dim MaxIndex as Integer
+ MaxIndex = Ubound(SecondList())
+ OriginalList() = AddListToList(OriginalList(), SecondList())
+ For i = 0 To MaxIndex
+ SourceListbox = AddSingleItemToListbox(SourceListbox, SecondList(i))
+ Next i
+ Call FormSetMoveRights()
+End Sub
+
+
+Sub RemoveListItems(SourceListbox as Object, TargetListbox as Object, RemoveList() as String)
+Dim i as Integer
+Dim s as Integer
+Dim MaxIndex as Integer
+Dim CopyList()
+ MaxIndex = Ubound(RemoveList())
+ For i = 0 To MaxIndex
+ RemoveListboxItemByName(SourceListbox, RemoveList(i))
+ RemoveListboxItemByName(TargetListbox, RemoveList(i))
+ Next i
+ CopyList() = OriginalList()
+ s = 0
+ MaxIndex = Ubound(CopyList())
+ For i = 0 To MaxIndex
+ If IndexInArray(CopyList(i),RemoveList())= -1 Then
+ OriginalList(s) = CopyList(i)
+ s = s + 1
+ End If
+ Next i
+ ReDim Preserve OriginalList(s-1)
+ Call FormSetMoveRights()
+End Sub
+
+
+&apos; Note Boolean Parameter
+Sub InitializeListboxProcedures(oModel as Object, SourceListbox as Object, TargetListbox as Object)
+Dim EmptyList()
+ Set oDialogModel = oModel
+ OriginalList()= SourceListbox.StringItemList()
+ TargetListbox.StringItemList() = EmptyList()
+End Sub
+
+
+Sub CopyListboxItems(SourceListbox as Object, TargetListbox As Object)
+Dim NullArray()
+ TargetListbox.StringItemList() = OriginalList()
+ SourceListbox.StringItemList() = NullArray()
+End Sub
+
+
+Sub FormMoveSelected()
+ Call MoveSelectedListBox(oDialogModel.lstFields, oDialogModel.lstSelFields)
+ Call FormSetMoveRights()
+ oDialogModel.lstSelFields.Tag = True
+End Sub
+
+
+Sub FormMoveAll()
+ Call CopyListboxItems(oDialogModel.lstFields, oDialogModel.lstSelFields)
+ Call FormSetMoveRights()
+ oDialogModel.lstSelFields.Tag = True
+End Sub
+
+
+Sub FormRemoveSelected()
+ Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, False)
+ Call FormSetMoveRights()
+ oDialogModel.lstSelFields.Tag = True
+End Sub
+
+
+Sub FormRemoveAll()
+ Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, True)
+ Call FormSetMoveRights()
+ oDialogModel.lstSelFields.Tag = 1
+End Sub
+
+
+Sub MoveSelectedListBox(SourceListbox as Object, TargetListbox as Object)
+Dim MaxCurTarget as Integer
+Dim MaxSourceSelected as Integer
+Dim n as Integer
+Dim m as Integer
+Dim CurIndex
+Dim iOldTargetSelect as Integer
+Dim iOldSourceSelect as Integer
+ MaxCurTarget = Ubound(TargetListbox.StringItemList())
+ MaxSourceSelected = Ubound(SourceListbox.SelectedItems())
+ Dim TargetList(MaxCurTarget+MaxSourceSelected+1)
+ If MaxSourceSelected &gt; -1 Then
+ iOldSourceSelect = SourceListbox.SelectedItems(0)
+ If Ubound(TargetListbox.SelectedItems()) &gt; -1 Then
+ iOldTargetSelect = TargetListbox.SelectedItems(0)
+ Else
+ iOldTargetSelect = -1
+ End If
+ For n = 0 To MaxCurTarget
+ TargetList(n) = TargetListbox.StringItemList(n)
+ Next n
+ For m = 0 To MaxSourceSelected
+ CurIndex = SourceListbox.SelectedItems(m)
+ TargetList(n) = SourceListbox.StringItemList(CurIndex)
+ n = n + 1
+ Next m
+ TargetListBox.StringItemList() = TargetList()
+ SourceListbox.StringItemList() = RemoveSelected (SourceListbox)
+ SetNewSelection(SourceListbox, iOldSourceSelect)
+ SetNewSelection(TargetListbox, iOldTargetSelect)
+ End If
+End Sub
+
+
+
+Sub MoveOrderedSelectedListbox(lstSource as Object, lstTarget as Object, bMoveAll as Boolean)
+Dim NullArray()
+Dim MaxSelected as Integer
+Dim MaxSourceIndex as Integer
+Dim MaxOriginalIndex as Integer
+Dim MaxNewIndex as Integer
+Dim n as Integer
+Dim m as Integer
+Dim CurIndex as Integer
+Dim SearchString as String
+Dim SourceList() as String
+Dim iOldTargetSelect as Integer
+Dim iOldSourceSelect as Integer
+ If bMoveAll Then
+ lstSource.StringItemList() = OriginalList()
+ lstTarget.StringItemList() = NullArray()
+ Else
+ MaxOriginalIndex = Ubound(OriginalList())
+ MaxSelected = Ubound(lstTarget.SelectedItems())
+ iOldTargetSelect = lstTarget.SelectedItems(0)
+ If Ubound(lstSource.SelectedItems()) &gt; -1 Then
+ iOldSourceSelect = lstSource.SelectedItems(0)
+ End If
+ Dim SelList(MaxSelected)
+ For n = 0 To MaxSelected
+ CurIndex = lstTarget.SelectedItems(n)
+ SelList(n) = lstTarget.StringItemList(CurIndex)
+ Next n
+ SourceList() = lstSource.StringItemList()
+ MaxSourceIndex = Ubound(lstSource.StringItemList())
+ MaxNewIndex = MaxSelected + MaxSourceIndex + 1
+ Dim NewSourceList(MaxNewIndex)
+ m = 0
+ For n = 0 To MaxOriginalIndex
+ SearchString = OriginalList(n)
+ If IndexInArray(SearchString, SelList()) &lt;&gt; -1 Then
+ NewSourceList(m) = SearchString
+ m = m + 1
+ ElseIf IndexInArray(SearchString, SourceList()) &lt;&gt; -1 Then
+ NewSourceList(m) = SearchString
+ m = m + 1
+ End If
+ Next n
+ lstSource.StringItemList() = NewSourceList()
+ lstTarget.StringItemList() = RemoveSelected(lstTarget)
+ End If
+ SetNewSelection(lstSource, iOldSourceSelect)
+ SetNewSelection(lstTarget, iOldTargetSelect)
+
+End Sub
+
+
+Function RemoveSelected(oListbox as Object)
+Dim MaxIndex as Integer
+Dim MaxSelected as Integer
+Dim n as Integer
+Dim m as Integer
+Dim CurIndex as Integer
+Dim CurItem as String
+Dim ResultArray()
+ MaxIndex = Ubound(oListbox.StringItemList())
+ MaxSelected = Ubound(oListbox.SelectedItems())
+ Dim LocItemList(MaxIndex)
+ LocItemList() = oListbox.StringItemList()
+ If MaxSelected &gt; -1 Then
+ For n = 0 To MaxSelected
+ CurIndex = oListbox.SelectedItems(n)
+ LocItemList(CurIndex) = &quot;&quot;
+ Next n
+ If MaxIndex &gt; 0 Then
+ ReDim ResultArray(MaxIndex - MaxSelected - 1)
+ m = 0
+ For n = 0 To MaxIndex
+ CurItem = LocItemList(n)
+ If CurItem &lt;&gt; &quot;&quot; Then
+ ResultArray(m) = CurItem
+ m = m + 1
+ End If
+ Next n
+ End If
+ RemoveSelected = ResultArray()
+ Else
+ RemoveSelected = oListbox.StringItemList()
+ End If
+End Function
+
+
+Sub SetNewSelection(oListBox as Object, iLastSelection as Integer)
+Dim MaxIndex as Integer
+Dim SelIndex as Integer
+Dim SelList(0) as Integer
+ MaxIndex = Ubound(oListBox.StringItemList())
+ If MaxIndex &gt; -1 AND iLastSelection &gt; -1 Then
+ If iLastSelection &gt; MaxIndex Then
+ Selindex = MaxIndex
+ Else
+ SelIndex = iLastSelection
+ End If
+ Sellist(0) = SelIndex
+ oListBox.SelectedItems() = SelList()
+ End If
+End Sub
+
+
+Sub ToggleListboxControls(oDialogModel as Object, bDoEnable as Boolean)
+ With oDialogModel
+ .lblFields.Enabled = bDoEnable
+ .lblSelFields.Enabled = bDoEnable
+&apos; .lstTables.Enabled = bDoEnable
+ .lstFields.Enabled = bDoEnable
+ .lstSelFields.Enabled = bDoEnable
+ .cmdRemoveAll.Enabled = bDoEnable
+ .cmdRemoveSelected.Enabled = bDoEnable
+ .cmdMoveAll.Enabled = bDoEnable
+ .cmdMoveSelected.Enabled = bDoEnable
+ End With
+ If bDoEnable Then
+ FormSetMoveRights()
+ End If
+End Sub
+
+
+&apos; Enable or disable the buttons used for moving the available
+&apos; fields between the two list boxes.
+Sub FormSetMoveRights()
+Dim bIsFieldSelected as Boolean
+Dim bSelectSelected as Boolean
+Dim FieldCount as Integer
+Dim SelectCount as Integer
+ bIsFieldSelected = Ubound(oDialogModel.lstFields.SelectedItems()) &lt;&gt; -1
+ FieldCount = Ubound(oDialogModel.lstFields.StringItemList()) + 1
+ bSelectSelected = Ubound(oDialogModel.lstSelFields.SelectedItems()) &gt; -1
+ SelectCount = Ubound(oDialogModel.lstSelFields.StringItemList()) + 1
+ oDialogModel.cmdRemoveAll.Enabled = SelectCount&gt;=1
+ oDialogModel.cmdRemoveSelected.Enabled = bSelectSelected
+ oDialogModel.cmdMoveAll.Enabled = FieldCount &gt;=1
+ oDialogModel.cmdMoveSelected.Enabled = bIsFieldSelected
+ oDialogModel.cmdGoOn.Enabled = SelectCount&gt;=1
+ &apos; This flag is set to &apos;1&apos; when the lstSelFields has been modified
+End Sub
+
+
+Function AddSingleItemToListbox(ByVal oListbox as Object, ListItem as String, Optional iSelIndex) as Object
+Dim MaxIndex as Integer
+Dim i as Integer
+
+ MaxIndex = Ubound(oListbox.StringItemList())
+Dim LocList(MaxIndex + 1)
+&apos; Todo: This goes faster with the Redim LocList(MaxIndex + 1) Preserve function
+ For i = 0 To MaxIndex
+ LocList(i) = oListbox.StringItemList(i)
+ Next i
+ LocList(MaxIndex + 1) = ListItem
+ oListbox.StringItemList() = LocList()
+ If Not IsMissing(iSelIndex) Then
+ SelectListboxItem(oListbox, iSelIndex)
+ End If
+ AddSingleItemToListbox() = oListbox
+End Function
+
+
+Sub EmptyListbox(oListbox as Object)
+Dim NullList() as String
+ oListbox.StringItemList() = NullList()
+End Sub
+
+
+Sub SelectListboxItem(oListbox as Object, iSelIndex as Integer)
+Dim LocSelList(0) as Integer
+ If iSelIndex &lt;&gt; -1 Then
+ LocSelList(0) = iSelIndex
+ oListbox.SelectedItems() = LocSelList()
+ End If
+End Sub
+
+
+Function GetSelectedListboxItems(oListbox as Object)
+Dim SelList(Ubound(oListBox.SelectedItems())) as String
+Dim i as Integer
+Dim CurIndex as Integer
+ For i = 0 To Ubound(oListbox.SelectedItems())
+ CurIndex = oListbox.SelectedItems(i)
+ SelList(i) = oListbox.StringItemList(CurIndex)
+ Next i
+ GetSelectedListboxItems() = SelList()
+End Function
+
+
+&apos; Note: When using this Sub it must be ensured that the
+&apos; &apos;RemoveItem&apos; appears only once in the Listbox
+Sub RemoveListboxItemByName(oListbox as Object, RemoveItem as String)
+Dim OldList() as String
+Dim NullList() as String
+Dim i as Integer
+Dim a as Integer
+Dim MaxIndex as Integer
+ OldList = oListbox.StringItemList()
+ MaxIndex = Ubound(OldList())
+ If IndexInArray(RemoveItem, OldList()) &lt;&gt; -1 Then
+ If MaxIndex &gt; 0 Then
+ a = 0
+ Dim NewList(MaxIndex -1)
+ For i = 0 To MaxIndex
+ If RemoveItem &lt;&gt; OldList(i) Then
+ NewList(a) = OldList(i)
+ a = a + 1
+ End If
+ Next i
+ oListbox.StringItemList() = NewList()
+ Else
+ oListBox.StringItemList() = NullList()
+ End If
+ End If
+End Sub
+
+
+Function GetItemPos(oListBox as Object, sItem as String)
+Dim ItemList()
+Dim MaxIndex as Integer
+Dim i as Integer
+ ItemList() = oListBox.StringItemList()
+ MaxIndex = Ubound(ItemList())
+ For i = 0 To MaxIndex
+ If sItem = ItemList(i) Then
+ GetItemPos() = i
+ Exit Function
+ End If
+ Next i
+ GetItemPos() = -1
+End Function
+</script:module>
diff --git a/wizards/source/tools/Misc.xba b/wizards/source/tools/Misc.xba
new file mode 100644
index 000000000..9aa6d2e2f
--- /dev/null
+++ b/wizards/source/tools/Misc.xba
@@ -0,0 +1,834 @@
+<?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="Misc" script:language="StarBasic">REM ***** BASIC *****
+
+Const SBSHARE = 0
+Const SBUSER = 1
+Dim Taskindex as Integer
+Dim oResSrv as Object
+
+Sub Main()
+Dim PropList(3,1)&apos; as String
+ PropList(0,0) = &quot;URL&quot;
+ PropList(0,1) = &quot;sdbc:odbc:Erica_Test_Unicode&quot;
+ PropList(1,0) = &quot;User&quot;
+ PropList(1,1) = &quot;extra&quot;
+ PropList(2,0) = &quot;Password&quot;
+ PropList(2,1) = &quot;extra&quot;
+ PropList(3,0) = &quot;IsPasswordRequired&quot;
+ PropList(3,1) = True
+End Sub
+
+
+Function RegisterNewDataSource(DSName as String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
+Dim oDataSource as Object
+Dim oDBContext as Object
+Dim oPropInfo as Object
+Dim i as Integer
+ oDBContext = createUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
+ oDataSource = createUnoService(&quot;com.sun.star.sdb.DataSource&quot;)
+ For i = 0 To Ubound(PropertyList(), 1)
+ sPropName = PropertyList(i,0)
+ sPropValue = PropertyList(i,1)
+ oDataSource.SetPropertyValue(sPropName,sPropValue)
+ Next i
+ If Not IsMissing(DriverProperties()) Then
+ oDataSource.Info() = DriverProperties()
+ End If
+ oDBContext.RegisterObject(DSName, oDataSource)
+ RegisterNewDataSource () = oDataSource
+End Function
+
+
+&apos; Connects to a registered Database
+Function ConnectToDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
+Dim oDBContext as Object
+Dim oDBSource as Object
+&apos; On Local Error Goto NOCONNECTION
+ oDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
+ If oDBContext.HasbyName(DSName) Then
+ oDBSource = oDBContext.GetByName(DSName)
+ ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
+ Else
+ If Not IsMissing(Propertylist()) Then
+ RegisterNewDataSource(DSName, PropertyList(), DriverProperties())
+ oDBSource = oDBContext.GetByName(DSName)
+ ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
+ Else
+ Msgbox(&quot;DataSource &quot; &amp; DSName &amp; &quot; is not registered&quot; , 16, GetProductname())
+ ConnectToDatabase() = NULL
+ End If
+ End If
+NOCONNECTION:
+ If Err &lt;&gt; 0 Then
+ Msgbox(Error$, 16, GetProductName())
+ Resume LEAVESUB
+ LEAVESUB:
+ End If
+End Function
+
+
+Function GetStarOfficeLocale() as New com.sun.star.lang.Locale
+Dim aLocLocale As New com.sun.star.lang.Locale
+Dim sLocale as String
+Dim sLocaleList(1)
+Dim oMasterKey
+ oMasterKey = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
+ sLocale = oMasterKey.getByName(&quot;ooLocale&quot;)
+ sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
+ aLocLocale.Language = sLocaleList(0)
+ If Ubound(sLocaleList()) &gt; 0 Then
+ aLocLocale.Country = sLocaleList(1)
+ End If
+ If Ubound(sLocaleList()) &gt; 1 Then
+ aLocLocale.Variant = sLocaleList(2)
+ End If
+ GetStarOfficeLocale() = aLocLocale
+End Function
+
+
+Function GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean)
+Dim oConfigProvider as Object
+Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
+ oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
+ aNodePath(0).Name = &quot;nodepath&quot;
+ aNodePath(0).Value = sKeyName
+ If IsMissing(bForUpdate) Then bForUpdate = False
+ If bForUpdate Then
+ GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
+ Else
+ GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
+ End If
+End Function
+
+
+Function GetProductname() as String
+Dim oProdNameAccess as Object
+Dim sVersion as String
+Dim sProdName as String
+ oProdNameAccess = GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
+ sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
+ sVersion = oProdNameAccess.getByName(&quot;ooSetupVersion&quot;)
+ GetProductName = sProdName &amp; sVersion
+End Function
+
+
+&apos; Opens a Document, checks beforehand, whether it has to be loaded
+&apos; or whether it is already on the desktop.
+&apos; If the parameter bDisposable is set to False then the returned document
+&apos; should not be disposed afterwards, because it is already opened.
+Function OpenDocument(DocPath as String, Args(), Optional bDisposable as Boolean)
+Dim oComponents as Object
+Dim oComponent as Object
+ &apos; Search if one of the active Components is the one that you search for
+ oComponents = StarDesktop.Components.CreateEnumeration
+ While oComponents.HasmoreElements
+ oComponent = oComponents.NextElement
+ If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
+ If UCase(oComponent.URL) = UCase(DocPath) then
+ OpenDocument() = oComponent
+ If Not IsMissing(bDisposable) Then
+ bDisposable = False
+ End If
+ Exit Function
+ End If
+ End If
+ Wend
+ If Not IsMissing(bDisposable) Then
+ bDisposable = True
+ End If
+ OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,&quot;_default&quot;,0,Args())
+End Function
+
+
+Function TaskonDesktop(DocPath as String) as Boolean
+Dim oComponents as Object
+Dim oComponent as Object
+ &apos; Search if one of the active Components is the one that you search for
+ oComponents = StarDesktop.Components.CreateEnumeration
+ While oComponents.HasmoreElements
+ oComponent = oComponents.NextElement
+ If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
+ If UCase(oComponent.URL) = UCase(DocPath) then
+ TaskonDesktop = True
+ Exit Function
+ End If
+ End If
+ Wend
+ TaskonDesktop = False
+End Function
+
+
+&apos; Retrieves a FileName out of a StarOffice-Document
+Function RetrieveFileName(LocDoc as Object)
+Dim LocURL as String
+Dim LocURLArray() as String
+Dim MaxArrIndex as integer
+
+ LocURL = LocDoc.Url
+ LocURLArray() = ArrayoutofString(LocURL,&quot;/&quot;,MaxArrIndex)
+ RetrieveFileName = LocURLArray(MaxArrIndex)
+End Function
+
+
+&apos; Gets a special configured PathSetting
+Function GetPathSettings(sPathType as String, Optional bshowall as Boolean, Optional ListIndex as integer) as String
+Dim oSettings, oPathSettings as Object
+Dim sPath as String
+Dim PathList() as String
+Dim MaxIndex as Integer
+Dim oPS as Object
+
+ oPS = createUnoService(&quot;com.sun.star.util.PathSettings&quot;)
+
+ If Not IsMissing(bShowall) Then
+ If bShowAll Then
+ ShowPropertyValues(oPS)
+ Exit Function
+ End If
+ End If
+ sPath = oPS.getPropertyValue(sPathType)
+ If Not IsMissing(ListIndex) Then
+ &apos; Share and User-Directory
+ If Instr(1,sPath,&quot;;&quot;) &lt;&gt; 0 Then
+ PathList = ArrayoutofString(sPath,&quot;;&quot;, MaxIndex)
+ If ListIndex &lt;= MaxIndex Then
+ sPath = PathList(ListIndex)
+ Else
+ Msgbox(&quot;String Cannot be analyzed!&quot; &amp; sPath , 16, GetProductName())
+ End If
+ End If
+ End If
+ If Instr(1, sPath, &quot;;&quot;) = 0 Then
+ GetPathSettings = ConvertToUrl(sPath)
+ Else
+ GetPathSettings = sPath
+ End If
+
+End Function
+
+
+
+&apos; Gets the fully qualified path to a subdirectory of the
+&apos; Template Directory, e. g. with the parameter &quot;wizard/bitmap&quot;
+&apos; The parameter must be passed in Url notation
+&apos; The return-Value is in Url notation
+Function GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String)
+Dim sOfficeString as String
+Dim sOfficeList() as String
+Dim sOfficeDir as String
+Dim sBigDir as String
+Dim i as Integer
+Dim MaxIndex as Integer
+Dim oUcb as Object
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ sOfficeString = GetPathSettings(sOfficePath)
+ If Right(sSubDir,1) &lt;&gt; &quot;/&quot; Then
+ sSubDir = sSubDir &amp; &quot;/&quot;
+ End If
+ sOfficeList() = ArrayoutofString(sOfficeString,&quot;;&quot;, MaxIndex)
+ For i = 0 To MaxIndex
+ sOfficeDir = ConvertToUrl(sOfficeList(i))
+ If Right(sOfficeDir,1) &lt;&gt; &quot;/&quot; Then
+ sOfficeDir = sOfficeDir &amp; &quot;/&quot;
+ End If
+ sBigDir = sOfficeDir &amp; sSubDir
+ If oUcb.Exists(sBigDir) Then
+ GetOfficeSubPath() = sBigDir
+ Exit Function
+ End If
+ Next i
+ ShowNoOfficePathError()
+ GetOfficeSubPath = &quot;&quot;
+End Function
+
+
+Sub ShowNoOfficePathError()
+Dim ProductName as String
+Dim sError as String
+Dim bResObjectexists as Boolean
+Dim oLocResSrv as Object
+ bResObjectexists = not IsNull(oResSrv)
+ If bResObjectexists Then
+ oLocResSrv = oResSrv
+ End If
+ If InitResources(&quot;Tools&quot;) Then
+ ProductName = GetProductName()
+ sError = GetResText(&quot;RID_COMMON_6&quot;)
+ sError = ReplaceString(sError, ProductName, &quot;%PRODUCTNAME&quot;)
+ sError = ReplaceString(sError, chr(13), &quot;&lt;BR&gt;&quot;)
+ MsgBox(sError, 16, ProductName)
+ End If
+ If bResObjectexists Then
+ oResSrv = oLocResSrv
+ End If
+
+End Sub
+
+
+Function InitResources(Description) as boolean
+Dim xResource as Object
+Dim sOfficeDir as String
+Dim aArgs(5) as Any
+ On Error Goto ErrorOccurred
+ sOfficeDir = &quot;$BRAND_BASE_DIR/$BRAND_SHARE_SUBDIR/wizards/&quot;
+ sOfficeDir = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.util.theMacroExpander&quot;).ExpandMacros(sOfficeDir)
+ aArgs(0) = sOfficeDir
+ aArgs(1) = true
+ aArgs(2) = GetStarOfficeLocale()
+ aArgs(3) = &quot;resources&quot;
+ aArgs(4) = &quot;&quot;
+ aArgs(5) = NULL
+ oResSrv = getProcessServiceManager().createInstanceWithArguments( &quot;com.sun.star.resource.StringResourceWithLocation&quot;, aArgs() )
+ If (IsNull(oResSrv)) then
+ InitResources = FALSE
+ MsgBox(&quot;could not initialize StringResourceWithLocation&quot;)
+ Else
+ InitResources = TRUE
+ End If
+ Exit Function
+ErrorOccurred:
+ Dim nSolarVer
+ InitResources = FALSE
+ nSolarVer = GetSolarVersion()
+ MsgBox(&quot;Resource file missing&quot;, 16, GetProductName())
+ Resume CLERROR
+ CLERROR:
+End Function
+
+
+Function GetResText( sID as String ) As string
+Dim sString as String
+ On Error Goto ErrorOccurred
+ If Not IsNull(oResSrv) Then
+ sString = oResSrv.resolveString(sID)
+ GetResText = ReplaceString(sString, GetProductname(), &quot;%PRODUCTNAME&quot;)
+ Else
+ GetResText = &quot;&quot;
+ End If
+ Exit Function
+ErrorOccurred:
+ GetResText = &quot;&quot;
+ MsgBox(&quot;Resource with ID =&quot; + sID + &quot; not found!&quot;, 16, GetProductName())
+ Resume CLERROR
+ CLERROR:
+End Function
+
+
+Function CutPathView(sDocUrl as String, Optional PathLen as Integer)
+Dim sViewPath as String
+Dim FileName as String
+Dim iFileLen as Integer
+ sViewPath = ConvertfromURL(sDocURL)
+ iViewPathLen = Len(sViewPath)
+ If iViewPathLen &gt; 60 Then
+ FileName = FileNameoutofPath(sViewPath, &quot;/&quot;)
+ iFileLen = Len(FileName)
+ If iFileLen &lt; 44 Then
+ sViewPath = Left(sViewPath,57-iFileLen-10) &amp; &quot;...&quot; &amp; Right(sViewPath,iFileLen + 10)
+ Else
+ sViewPath = Left(sViewPath,27) &amp; &quot; ... &quot; &amp; Right(sViewPath,28)
+ End If
+ End If
+ CutPathView = sViewPath
+End Function
+
+
+&apos; Deletes the content of all cells that are softformatted according
+&apos; to the &apos;InputStyleName&apos;
+Sub DeleteInputCells(oSheet as Object, InputStyleName as String)
+Dim oRanges as Object
+Dim oRange as Object
+ oRanges = oSheet.CellFormatRanges.createEnumeration
+ While oRanges.hasMoreElements
+ oRange = oRanges.NextElement
+ If Instr(1,oRange.CellStyle, InputStyleName) &lt;&gt; 0 Then
+ Call ReplaceRangeValues(oRange, &quot;&quot;)
+ End If
+ Wend
+End Sub
+
+
+&apos; Inserts a certain string to all cells of a range that is passed
+&apos; either as an object or as the RangeName
+Sub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String)
+Dim oCellRange as Object
+ If Vartype(Range) = 8 Then
+ &apos; Get the Range out of the Rangename
+ oCellRange = oSheet.GetCellRangeByName(Range)
+ Else
+ &apos; The range is passed as an object
+ Set oCellRange = Range
+ End If
+ If IsMissing(StyleName) Then
+ ReplaceRangeValues(oCellRange, ReplaceValue)
+ Else
+ If Instr(1,oCellRange.CellStyle,StyleName) Then
+ ReplaceRangeValues(oCellRange, ReplaceValue)
+ End If
+ End If
+End Sub
+
+
+Sub ReplaceRangeValues(oRange as Object, ReplaceValue)
+Dim oRangeAddress as Object
+Dim ColCount as Integer
+Dim RowCount as Integer
+Dim i as Integer
+ oRangeAddress = oRange.RangeAddress
+ ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn
+ RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow
+ Dim FillArray(RowCount) as Variant
+ Dim sLine(ColCount) as Variant
+ For i = 0 To ColCount
+ sLine(i) = ReplaceValue
+ Next i
+ For i = 0 To RowCount
+ FillArray(i) = sLine()
+ Next i
+ oRange.DataArray = FillArray()
+End Sub
+
+
+&apos; Returns the Value of the first cell of a Range
+Function GetValueofCellbyName(oSheet as Object, sCellName as String)
+Dim oCell as Object
+ oCell = GetCellByName(oSheet, sCellName)
+ GetValueofCellbyName = oCell.Value
+End Function
+
+
+Function DuplicateRow(oSheet as Object, RangeName as String)
+Dim oRange as Object
+Dim oCell as Object
+Dim oCellAddress as New com.sun.star.table.CellAddress
+Dim oRangeAddress as New com.sun.star.table.CellRangeAddress
+ oRange = oSheet.GetCellRangeByName(RangeName)
+ oRangeAddress = oRange.RangeAddress
+ oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow)
+ oCellAddress = oCell.CellAddress
+ oSheet.Rows.InsertByIndex(oCellAddress.Row,1)
+ oRangeAddress = oRange.RangeAddress
+ oSheet.CopyRange(oCellAddress, oRangeAddress)
+ DuplicateRow = oRangeAddress.StartRow-1
+End Function
+
+
+&apos; Returns the String of the first cell of a Range
+Function GetStringofCellbyName(oSheet as Object, sCellName as String)
+Dim oCell as Object
+ oCell = GetCellByName(oSheet, sCellName)
+ GetStringofCellbyName = oCell.String
+End Function
+
+
+&apos; Returns a named Cell
+Function GetCellByName(oSheet as Object, sCellName as String) as Object
+Dim oCellRange as Object
+Dim oCellAddress as Object
+ oCellRange = oSheet.GetCellRangeByName(sCellName)
+ oCellAddress = oCellRange.RangeAddress
+ GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
+End Function
+
+
+&apos; Changes the numeric Value of a cell by transmitting the String of the numeric Value
+Sub ChangeCellValue(oCell as Object, ValueString as String)
+Dim CellValue
+ oCell.Formula = &quot;=Value(&quot; &amp; &quot;&quot;&quot;&quot; &amp; ValueString &amp; &quot;&quot;&quot;&quot; &amp; &quot;)&quot;
+ CellValue = oCell.Value
+ oCell.Formula = &quot;&quot;
+ oCell.Value = CellValue
+End Sub
+
+
+Function GetDocumentType(oDocument)
+ On Local Error GoTo NODOCUMENTTYPE
+&apos; ShowSupportedServiceNames(oDocument)
+ If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
+ GetDocumentType() = &quot;scalc&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.text.TextDocument&quot;) Then
+ GetDocumentType() = &quot;swriter&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.drawing.DrawingDocument&quot;) Then
+ GetDocumentType() = &quot;sdraw&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.presentation.PresentationDocument&quot;) Then
+ GetDocumentType() = &quot;simpress&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
+ GetDocumentType() = &quot;smath&quot;
+ End If
+ NODOCUMENTTYPE:
+ If Err &lt;&gt; 0 Then
+ GetDocumentType = &quot;&quot;
+ Resume GOON
+ GOON:
+ End If
+End Function
+
+
+Function GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer
+Dim ThisFormatKey as Long
+Dim oObjectFormat as Object
+ On Local Error Goto NOFORMAT
+ ThisFormatKey = oFormatObject.NumberFormat
+ oObjectFormat = oDocFormats.GetByKey(ThisFormatKey)
+ GetNumberFormatType = oObjectFormat.Type
+ NOFORMAT:
+ If Err &lt;&gt; 0 Then
+ Msgbox(&quot;Numberformat of Object is not available!&quot;, 16, GetProductName())
+ GetNumberFormatType = 0
+ GOTO NOERROR
+ End If
+ NOERROR:
+ On Local Error Goto 0
+End Function
+
+
+Sub ProtectSheets(Optional oSheets as Object)
+Dim i as Integer
+Dim oDocSheets as Object
+ If IsMissing(oSheets) Then
+ oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
+ Else
+ Set oDocSheets = oSheets
+ End If
+
+ For i = 0 To oDocSheets.Count-1
+ oDocSheets(i).Protect(&quot;&quot;)
+ Next i
+End Sub
+
+
+Sub UnprotectSheets(Optional oSheets as Object)
+Dim i as Integer
+Dim oDocSheets as Object
+ If IsMissing(oSheets) Then
+ oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
+ Else
+ Set oDocSheets = oSheets
+ End If
+
+ For i = 0 To oDocSheets.Count-1
+ oDocSheets(i).Unprotect(&quot;&quot;)
+ Next i
+End Sub
+
+
+Function GetRowIndex(oSheet as Object, RowName as String)
+Dim oRange as Object
+ oRange = oSheet.GetCellRangeByName(RowName)
+ GetRowIndex = oRange.RangeAddress.StartRow
+End Function
+
+
+Function GetColumnIndex(oSheet as Object, ColName as String)
+Dim oRange as Object
+ oRange = oSheet.GetCellRangeByName(ColName)
+ GetColumnIndex = oRange.RangeAddress.StartColumn
+End Function
+
+
+Function CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object
+Dim oSheet as Object
+Dim Count as Integer
+Dim BasicSheetName as String
+
+ BasicSheetName = NewName
+ &apos; Copy the last table. Assumption: The last table is the template
+ On Local Error Goto RENAMESHEET
+ oSheets.CopybyName(OldName, NewName, DestPos)
+
+RENAMESHEET:
+ oSheet = oSheets(DestPos)
+ If Err &lt;&gt; 0 Then
+ &apos; Test if renaming failed
+ Count = 2
+ Do While oSheet.Name &lt;&gt; NewName
+ NewName = BasicSheetName &amp; &quot;_&quot; &amp; Count
+ oSheet.Name = NewName
+ Count = Count + 1
+ Loop
+ Resume CL_ERROR
+CL_ERROR:
+ End If
+ CopySheetbyName = oSheet
+End Function
+
+
+&apos; Dis-or enables a Window and adjusts the mousepointer accordingly
+Sub ToggleWindow(bDoEnable as Boolean)
+Dim oWindow as Object
+ oWindow = StarDesktop.CurrentFrame.ComponentWindow
+ oWindow.Enable = bDoEnable
+End Sub
+
+
+Function CheckNewSheetname(oSheets as Object, Sheetname as String, Optional oLocale) as String
+Dim nStartFlags as Long
+Dim nContFlags as Long
+Dim oCharService as Object
+Dim iSheetNameLength as Integer
+Dim iResultPos as Integer
+Dim WrongChar as String
+Dim oResult as Object
+ nStartFlags = com.sun.star.i18n.KParseTokens.ANY_LETTER_OR_NUMBER + com.sun.star.i18n.KParseTokens.ASC_UNDERSCORE
+ nContFlags = nStartFlags
+ oCharService = CreateUnoService(&quot;com.sun.star.i18n.CharacterClassification&quot;)
+ iSheetNameLength = Len(SheetName)
+ If IsMissing(oLocale) Then
+ oLocale = ThisComponent.CharLocale
+ End If
+ Do
+ oResult =oCharService.parsePredefinedToken(com.sun.star.i18n.KParseType.IDENTNAME, SheetName, 0, oLocale, nStartFlags, &quot;&quot;, nContFlags, &quot; &quot;)
+ iResultPos = oResult.EndPos
+ If iResultPos &lt; iSheetNameLength Then
+ WrongChar = Mid(SheetName, iResultPos+1,1)
+ SheetName = ReplaceString(SheetName,&quot;_&quot;, WrongChar)
+ End If
+ Loop Until iResultPos = iSheetNameLength
+ CheckNewSheetname = SheetName
+End Function
+
+
+Sub AddNewSheetName(oSheets as Object, ByVal SheetName as String)
+Dim Count as Integer
+Dim bSheetIsThere as Boolean
+Dim iSheetNameLength as Integer
+ iSheetNameLength = Len(SheetName)
+ Count = 2
+ Do
+ bSheetIsThere = oSheets.HasByName(SheetName)
+ If bSheetIsThere Then
+ SheetName = Right(SheetName,iSheetNameLength) &amp; &quot;_&quot; &amp; Count
+ Count = Count + 1
+ End If
+ Loop Until Not bSheetIsThere
+ AddNewSheetname = SheetName
+End Sub
+
+
+Function GetSheetIndex(oSheets, sName) as Integer
+Dim i as Integer
+ For i = 0 To oSheets.Count-1
+ If oSheets(i).Name = sName Then
+ GetSheetIndex = i
+ exit Function
+ End If
+ Next i
+ GetSheetIndex = -1
+End Function
+
+
+Function GetLastUsedRow(oSheet as Object) as Long
+Dim oCell As Object
+Dim oCursor As Object
+Dim aAddress As Variant
+ oCell = oSheet.GetCellbyPosition(0, 0)
+ oCursor = oSheet.createCursorByRange(oCell)
+ oCursor.GotoEndOfUsedArea(True)
+ aAddress = oCursor.RangeAddress
+ GetLastUsedRow = aAddress.EndRow
+End Function
+
+
+&apos; Note To set a one lined frame you have to set the inner width to 0
+&apos; In the API all Units that refer to pt-Heights are &quot;1/100mm&quot;
+&apos; The convert factor from 1pt to 1/100 mm is approximately 35
+Function ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer)
+Dim aBorder as New com.sun.star.table.BorderLine
+ aBorder = oStyleBorder
+ aBorder.InnerLineWidth = iInnerLineWidth
+ aBorder.OuterLineWidth = iOuterLineWidth
+ ModifyBorderLineWidth = aBorder
+End Function
+
+
+Sub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String)
+Dim PropValue(1) as new com.sun.star.beans.PropertyValue
+ PropValue(0).Name = &quot;EventType&quot;
+ PropValue(0).Value = &quot;StarBasic&quot;
+ PropValue(1).Name = &quot;Script&quot;
+ PropValue(1).Value = &quot;macro:///&quot; &amp; SubPath
+ oDocument.Events.ReplaceByName(EventName, PropValue())
+End Sub
+
+
+
+Function ModifyPropertyValue(oContent() as New com.sun.star.beans.PropertyValue, TargetProperties() as New com.sun.star.beans.PropertyValue)
+Dim MaxIndex as Integer
+Dim i as Integer
+Dim a as Integer
+ MaxIndex = Ubound(oContent())
+ bDoReplace = False
+ For i = 0 To MaxIndex
+ a = GetPropertyValueIndex(oContent(i).Name, TargetProperties())
+ If a &lt;&gt; -1 Then
+ If Vartype(TargetProperties(a).Value) &lt;&gt; 9 Then
+ If TargetProperties(a).Value &lt;&gt; oContent(i).Value Then
+ oContent(i).Value = TargetProperties(a).Value
+ bDoReplace = True
+ End If
+ Else
+ If Not EqualUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then
+ oContent(i).Value = TargetProperties(a).Value
+ bDoReplace = True
+ End If
+ End If
+ End If
+ Next i
+ ModifyPropertyValue() = bDoReplace
+End Function
+
+
+Function GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue ) as Integer
+Dim i as Integer
+ For i = 0 To Ubound(TargetProperties())
+ If Searchname = TargetProperties(i).Name Then
+ GetPropertyValueIndex = i
+ Exit Function
+ End If
+ Next i
+ GetPropertyValueIndex() = -1
+End Function
+
+
+Sub DispatchSlot(SlotID as Integer)
+Dim oArg() as new com.sun.star.beans.PropertyValue
+Dim oUrl as new com.sun.star.util.URL
+Dim oTrans as Object
+Dim oDisp as Object
+ oTrans = createUNOService(&quot;com.sun.star.util.URLTransformer&quot;)
+ oUrl.Complete = &quot;slot:&quot; &amp; CStr(SlotID)
+ oTrans.parsestrict(oUrl)
+ oDisp = StarDesktop.ActiveFrame.queryDispatch(oUrl, &quot;_self&quot;, 0)
+ oDisp.dispatch(oUrl, oArg())
+End Sub
+
+
+&apos;returns the type of the office application
+&apos;FatOffice = 0, WebTop = 1
+&apos;This routine has to be changed if the Product Name is being changed!
+Function IsFatOffice() As Boolean
+ If sProductname = &quot;&quot; Then
+ sProductname = GetProductname()
+ End If
+ IsFatOffice = TRUE
+ &apos;The following line has to include the current productname
+ If Instr(1,sProductname,&quot;WebTop&quot;,1) &lt;&gt; 0 Then
+ IsFatOffice = FALSE
+ End If
+End Function
+
+
+Sub ToggleDesignMode(oDocument as Object)
+Dim aSwitchMode as new com.sun.star.util.URL
+ aSwitchMode.Complete = &quot;.uno:SwitchControlDesignMode&quot;
+ aTransformer = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
+ aTransformer.parseStrict(aSwitchMode)
+ oFrame = oDocument.currentController.Frame
+ oDispatch = oFrame.queryDispatch(aSwitchMode, oFrame.Name, 63)
+ Dim aEmptyArgs() as New com.sun.star.bean.PropertyValue
+ oDispatch.dispatch(aSwitchMode, aEmptyArgs())
+ Erase aSwitchMode
+End Sub
+
+
+Function isHighContrast(oPeer as Object)
+ Dim UIColor as Long
+ Dim myRed as Integer
+ Dim myGreen as Integer
+ Dim myBlue as Integer
+ Dim myLuminance as Double
+
+ UIColor = oPeer.getProperty( &quot;DisplayBackgroundColor&quot; )
+ myRed = Red (UIColor)
+ myGreen = Green (UIColor)
+ myBlue = Blue (UIColor)
+ myLuminance = (( myBlue*28 + myGreen*151 + myRed*77 ) / 256 )
+ isHighContrast = false
+ If myLuminance &lt;= 25 Then isHighContrast = true
+End Function
+
+
+Function CreateNewDocument(sType as String, Optional sAddMsg as String) as Object
+Dim NoArgs() as new com.sun.star.beans.PropertyValue
+Dim oDocument as Object
+Dim sUrl as String
+Dim ErrMsg as String
+ On Local Error Goto NOMODULEINSTALLED
+ sUrl = &quot;private:factory/&quot; &amp; sType
+ oDocument = StarDesktop.LoadComponentFromURL(sUrl,&quot;_default&quot;,0, NoArgs())
+NOMODULEINSTALLED:
+ If (Err &lt;&gt; 0) OR IsNull(oDocument) Then
+ If InitResources(&quot;&quot;) Then
+ Select Case sType
+ Case &quot;swriter&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_1&quot;)
+ Case &quot;scalc&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_2&quot;)
+ Case &quot;simpress&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_3&quot;)
+ Case &quot;sdraw&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_4&quot;)
+ Case &quot;smath&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_5&quot;)
+ Case Else
+ ErrMsg = &quot;Invalid Document Type!&quot;
+ End Select
+ ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
+ If Not IsMissing(sAddMsg) Then
+ ErrMsg = ErrMsg &amp; chr(13) &amp; sAddMsg
+ End If
+ Msgbox(ErrMsg, 48, GetProductName())
+ End If
+ If Err &lt;&gt; 0 Then
+ Resume GOON
+ End If
+ End If
+GOON:
+ CreateNewDocument = oDocument
+End Function
+
+
+&apos; This Sub has been used in order to ensure that after disposing a document
+&apos; from the backing window it is returned to the backing window, so the
+&apos; office won&apos;t be closed
+Sub DisposeDocument(oDocument as Object)
+Dim dispatcher as Object
+Dim parser as Object
+Dim disp as Object
+Dim url as new com.sun.star.util.URL
+Dim NoArgs() as New com.sun.star.beans.PropertyValue
+Dim oFrame as Object
+ If Not IsNull(oDocument) Then
+ oDocument.setModified(false)
+ parser = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
+ url.Complete = &quot;.uno:CloseDoc&quot;
+ parser.parseStrict(url)
+ oFrame = oDocument.CurrentController.Frame
+ disp = oFrame.queryDispatch(url,&quot;_self&quot;, com.sun.star.util.SearchFlags.NORM_WORD_ONLY)
+ disp.dispatch(url, NoArgs())
+ End If
+End Sub
+
+&apos;Function to calculate if the year is a leap year
+Function CalIsLeapYear(ByVal iYear as Integer) as Boolean
+ CalIsLeapYear = ((iYear Mod 4 = 0) And ((iYear Mod 100 &lt;&gt; 0) Or (iYear Mod 400 = 0)))
+End Function
+</script:module>
diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba
new file mode 100644
index 000000000..059956cb1
--- /dev/null
+++ b/wizards/source/tools/ModuleControls.xba
@@ -0,0 +1,387 @@
+<?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="ModuleControls" script:language="StarBasic">Option Explicit
+
+Public DlgOverwrite as Object
+Public Const SBOVERWRITEUNDEFINED as Integer = 0
+Public Const SBOVERWRITECANCEL as Integer = 2
+Public Const SBOVERWRITEQUERY as Integer = 7
+Public Const SBOVERWRITEALWAYS as Integer = 6
+Public Const SBOVERWRITENEVER as Integer = 8
+Public iGeneralOverwrite as Integer
+
+
+
+&apos; Accepts the name of a control and returns the respective control model as object
+&apos; The Container can either be a whole document or a specific sheet of a Calc-Document
+&apos; &apos;CName&apos; is the name of the Control
+Function getControlModel(oContainer as Object, CName as String)
+Dim aForm, oForms as Object
+Dim i as Integer
+ oForms = oContainer.Drawpage.GetForms
+ For i = 0 To oForms.Count-1
+ aForm = oForms.GetbyIndex(i)
+ If aForm.HasByName(CName) Then
+ GetControlModel = aForm.GetbyName(CName)
+ Exit Function
+ End If
+ Next i
+ Msgbox(&quot;No Control with the name &apos;&quot; &amp; CName &amp; &quot;&apos; found&quot; , 16, GetProductName())
+End Function
+
+
+
+&apos; Gets the Shape of a Control( e. g. to reset the size or Position of the control
+&apos; Parameters:
+&apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
+&apos; &apos;CName&apos; is the Name of the Control
+Function GetControlShape(oContainer as Object,CName as String)
+Dim i as integer
+Dim aShape as Object
+ For i = 0 to oContainer.DrawPage.Count-1
+ aShape = oContainer.DrawPage(i)
+ If HasUnoInterfaces(aShape, &quot;com.sun.star.drawing.XControlShape&quot;) then
+ If ashape.Control.Name = CName then
+ GetControlShape = aShape
+ exit Function
+ End If
+ End If
+ Next
+End Function
+
+
+&apos; Returns the View of a Control
+&apos; Parameters:
+&apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
+&apos; The &apos;oController&apos; is always directly attached to the Document
+&apos; &apos;CName&apos; is the Name of the Control
+Function getControlView(oContainer , oController as Object, CName as String) as Object
+Dim aForm, oForms, oControlModel as Object
+Dim i as Integer
+ oForms = oContainer.DrawPage.Forms
+ For i = 0 To oForms.Count-1
+ aForm = oforms.GetbyIndex(i)
+ If aForm.HasByName(CName) Then
+ oControlModel = aForm.GetbyName(CName)
+ GetControlView = oController.GetControl(oControlModel)
+ Exit Function
+ End If
+ Next i
+ Msgbox(&quot;No Control with the name &apos;&quot; &amp; CName &amp; &quot;&apos; found&quot; , 16, GetProductName())
+End Function
+
+
+
+&apos; Parameters:
+&apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
+&apos; &apos;CName&apos; is the Name of the Control
+Function DisposeControl(oContainer as Object, CName as String) as Boolean
+Dim aControl as Object
+
+ aControl = GetControlModel(oContainer,CName)
+ If not IsNull(aControl) Then
+ aControl.Dispose()
+ DisposeControl = True
+ Else
+ DisposeControl = False
+ End If
+End Function
+
+
+&apos; Returns a sequence of a group of controls like option buttons or checkboxes
+&apos; The &apos;oContainer&apos; is the Document or a specific sheet of a Calc - Document
+&apos; &apos;sGroupName&apos; is the Name of the Controlgroup
+Function GetControlGroupModel(oContainer as Object, sGroupName as String )
+Dim aForm, oForms As Object
+Dim aControlModel() As Object
+Dim i as integer
+
+ oForms = oContainer.DrawPage.Forms
+ For i = 0 To oForms.Count-1
+ aForm = oForms(i)
+ If aForm.HasbyName(sGroupName) Then
+ aForm.GetGroupbyName(sGroupName,aControlModel)
+ GetControlGroupModel = aControlModel
+ Exit Function
+ End If
+ Next i
+ Msgbox(&quot;No Controlgroup with the name &apos;&quot; &amp; sGroupName &amp; &quot;&apos; found&quot; , 16, GetProductName())
+End Function
+
+
+&apos; Returns the Referencevalue of a group of e.g. option buttons or check boxes
+&apos; &apos;oControlGroup&apos; is a sequence of the Control objects
+Function GetRefValue(oControlGroup() as Object)
+Dim i as Integer
+ For i = 0 To Ubound(oControlGroup())
+&apos; oControlGroup(i).DefaultState = oControlGroup(i).State
+ If oControlGroup(i).State Then
+ GetRefValue = oControlGroup(i).RefValue
+ exit Function
+ End If
+ Next
+ GetRefValue() = -1
+End Function
+
+
+Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
+Dim oOptGroup() as Object
+Dim iRef as Integer
+ oOptGroup() = GetControlGroupModel(oContainer, GroupName)
+ iRef = GetRefValue(oOptGroup())
+ GetRefValueofControlGroup = iRef
+End Function
+
+
+Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
+Dim oRulesOptions() as Object
+ oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
+ GetOptionGroupValue = oRulesOptions(0).State
+End Function
+
+
+
+Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
+Dim bOptValue as Boolean
+Dim oCell as Object
+ bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
+ oCell = oSheet.GetCellByPosition(iCol, iRow)
+ oCell.SetValue(ABS(CInt(bOptValue)))
+ WriteOptValueToCell() = bOptValue
+End Function
+
+
+Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
+Dim oLib as Object
+Dim oLibDialog as Object
+Dim oRuntimeDialog as Object
+ If IsMissing(oLibContainer ) then
+ oLibContainer = DialogLibraries
+ End If
+ oLibContainer.LoadLibrary(LibName)
+ oLib = oLibContainer.GetByName(Libname)
+ oLibDialog = oLib.GetByName(DialogName)
+ oRuntimeDialog = CreateUnoDialog(oLibDialog)
+ LoadDialog() = oRuntimeDialog
+End Function
+
+
+Sub GetFolderName(oRefModel as Object)
+Dim oFolderDialog as Object
+Dim iAccept as Integer
+Dim sPath as String
+Dim InitPath as String
+Dim RefControlName as String
+Dim oUcb as object
+ &apos;Note: The following services have to be called in the following order
+ &apos; because otherwise Basic does not remove the FileDialog Service
+ oFolderDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FolderPicker&quot;)
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ InitPath = ConvertToUrl(oRefModel.Text)
+ If InitPath = &quot;&quot; Then
+ InitPath = GetPathSettings(&quot;Work&quot;)
+ End If
+ If oUcb.Exists(InitPath) Then
+ oFolderDialog.SetDisplayDirectory(InitPath)
+ End If
+ iAccept = oFolderDialog.Execute()
+ If iAccept = 1 Then
+ sPath = oFolderDialog.GetDirectory()
+ If oUcb.Exists(sPath) Then
+ oRefModel.Text = ConvertFromUrl(sPath)
+ End If
+ End If
+End Sub
+
+
+Sub GetFileName(oRefModel as Object, Filternames())
+Dim oFileDialog as Object
+Dim iAccept as Integer
+Dim sPath as String
+Dim InitPath as String
+Dim RefControlName as String
+Dim oUcb as object
+&apos;Dim ListAny(0)
+ &apos;Note: The following services have to be called in the following order
+ &apos; because otherwise Basic does not remove the FileDialog Service
+ oFileDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ &apos;ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
+ &apos;oFileDialog.initialize(ListAny())
+ AddFiltersToDialog(FilterNames(), oFileDialog)
+ InitPath = ConvertToUrl(oRefModel.Text)
+ If InitPath = &quot;&quot; Then
+ InitPath = GetPathSettings(&quot;Work&quot;)
+ End If
+ If oUcb.Exists(InitPath) Then
+ oFileDialog.SetDisplayDirectory(InitPath)
+ End If
+ iAccept = oFileDialog.Execute()
+ If iAccept = 1 Then
+ sPath = oFileDialog.Files(0)
+ If oUcb.Exists(sPath) Then
+ oRefModel.Text = ConvertFromUrl(sPath)
+ End If
+ End If
+ oFileDialog.Dispose()
+End Sub
+
+
+Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String
+Dim NoArgs() as New com.sun.star.beans.PropertyValue
+Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
+Dim oStoreDialog as Object
+Dim iAccept as Integer
+Dim sPath as String
+Dim ListAny(0) as Long
+Dim UIFilterName as String
+Dim FilterName as String
+Dim FilterIndex as Integer
+ ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
+ oStoreDialog = CreateUnoService(&quot;com.sun.star.ui.dialogs.FilePicker&quot;)
+ oStoreDialog.Initialize(ListAny())
+ AddFiltersToDialog(FilterNames(), oStoreDialog)
+ oStoreDialog.SetDisplayDirectory(DisplayDirectory)
+ oStoreDialog.SetDefaultName(DefaultName)
+ oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
+
+ iAccept = oStoreDialog.Execute()
+ If iAccept = 1 Then
+ sPath = oStoreDialog.Files(0)
+ UIFilterName = oStoreDialog.GetCurrentFilter()
+ FilterIndex = IndexInArray(UIFilterName, FilterNames())
+ FilterName = FilterNames(FilterIndex,2)
+ If Not IsMissing(iAddProcedure) Then
+ Select Case iAddProcedure
+ Case 1
+ CommitLastDocumentChanges(sPath)
+ End Select
+ End If
+ On Local Error Goto NOSAVING
+ If FilterName = &quot;&quot; Then
+ &apos; Todo: Catch the case that a document that has to be overwritten is writeprotected (e.g. it is open)
+ oDocument.StoreAsUrl(sPath, NoArgs())
+ Else
+ oStoreProperties(0).Name = &quot;FilterName&quot;
+ oStoreProperties(0).Value = FilterName
+ oDocument.StoreAsUrl(sPath, oStoreProperties())
+ End If
+ End If
+ oStoreDialog.dispose()
+ StoreDocument() = sPath
+ Exit Function
+NOSAVING:
+ If Err &lt;&gt; 0 Then
+&apos; Msgbox(&quot;Document cannot be saved under &apos;&quot; &amp; ConvertFromUrl(sPath) &amp; &quot;&apos;&quot;, 48, GetProductName())
+ sPath = &quot;&quot;
+ oStoreDialog.dispose()
+ Resume NOERROR
+ NOERROR:
+ End If
+End Function
+
+
+Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)
+Dim i as Integer
+Dim MaxIndex as Integer
+Dim ViewFiltername as String
+Dim oProdNameAccess as Object
+Dim sProdName as String
+ oProdNameAccess = GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
+ sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
+ MaxIndex = Ubound(FilterNames(), 1)
+ For i = 0 To MaxIndex
+ Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,&quot;%productname%&quot;)
+ oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
+ Next i
+ oDialog.SetCurrentFilter(FilterNames(0,0))
+End Sub
+
+
+Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
+Dim oWindowPointer as Object
+ oWindowPointer = CreateUnoService(&quot;com.sun.star.awt.Pointer&quot;)
+ If bDoEnable Then
+ oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
+ Else
+ oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
+ End If
+ oWindowPeer.SetPointer(oWindowPointer)
+End Sub
+
+
+Sub ShowOverwriteAllDialog(FilePath as String, sTitle as String)
+Dim QueryString as String
+Dim LocRetValue as Integer
+Dim lblYes as String
+Dim lblNo as String
+Dim lblYesToAll as String
+Dim lblCancel as String
+Dim OverwriteModel as Object
+ If InitResources(GetProductName()) Then
+ QueryString = GetResText(&quot;RID_COMMON_7&quot;)
+ QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), &quot;&lt;PATH&gt;&quot;)
+ If Len(QueryString) &gt; 190 Then
+ QueryString = DeleteStr(QueryString, &quot;.&lt;BR&gt;&quot;)
+ End If
+ QueryString = ReplaceString(QueryString, chr(13), &quot;&lt;BR&gt;&quot;)
+ lblYes = GetResText(&quot;RID_COMMON_8&quot;)
+ lblYesToAll = GetResText(&quot;RID_COMMON_9&quot;)
+ lblNo = GetResText(&quot;RID_COMMON_10&quot;)
+ lblCancel = GetResText(&quot;RID_COMMON_11&quot;)
+ DlgOverwrite = LoadDialog(&quot;Tools&quot;, &quot;DlgOverwriteAll&quot;)
+ DlgOverwrite.Title = sTitle
+ OverwriteModel = DlgOverwrite.Model
+ OverwriteModel.cmdYes.Label = lblYes
+ OverwriteModel.cmdYesToAll.Label = lblYesToAll
+ OverwriteModel.cmdNo.Label = lblNo
+ OverwriteModel.cmdCancel.Label = lblCancel
+ OverwriteModel.lblQueryforSave.Label = QueryString
+ OverwriteModel.cmdNo.DefaultButton = True
+ DlgOverwrite.GetControl(&quot;cmdNo&quot;).SetFocus()
+ iGeneralOverwrite = 999
+ LocRetValue = DlgOverwrite.execute()
+ If iGeneralOverwrite = 999 Then
+ iGeneralOverwrite = SBOVERWRITECANCEL
+ End If
+ DlgOverwrite.dispose()
+ Else
+ iGeneralOverwrite = SBOVERWRITECANCEL
+ End If
+End Sub
+
+
+Sub SetOVERWRITEToQuery()
+ iGeneralOverwrite = SBOVERWRITEQUERY
+ DlgOverwrite.EndExecute()
+End Sub
+
+
+Sub SetOVERWRITEToAlways()
+ iGeneralOverwrite = SBOVERWRITEALWAYS
+ DlgOverwrite.EndExecute()
+End Sub
+
+
+Sub SetOVERWRITEToNever()
+ iGeneralOverwrite = SBOVERWRITENEVER
+ DlgOverwrite.EndExecute()
+End Sub
+</script:module>
diff --git a/wizards/source/tools/Strings.xba b/wizards/source/tools/Strings.xba
new file mode 100644
index 000000000..bb1593a20
--- /dev/null
+++ b/wizards/source/tools/Strings.xba
@@ -0,0 +1,469 @@
+<?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="Strings" script:language="StarBasic">Option Explicit
+Public sProductname as String
+
+
+&apos; Deletes out of a String &apos;BigString&apos; all possible PartStrings, that are summed up
+&apos; in the Array &apos;ElimArray&apos;
+Function ElimChar(ByVal BigString as String, ElimArray() as String)
+Dim i% ,n%
+ For i = 0 to Ubound(ElimArray)
+ BigString = DeleteStr(BigString,ElimArray(i))
+ Next
+ ElimChar = BigString
+End Function
+
+
+&apos; Deletes out of a String &apos;BigString&apos; a possible Partstring &apos;CompString&apos;
+Function DeleteStr(ByVal BigString,CompString as String) as String
+Dim i%, CompLen%, BigLen%
+ CompLen = Len(CompString)
+ i = 1
+ While i &lt;&gt; 0
+ i = Instr(i, BigString,CompString)
+ If i &lt;&gt; 0 then
+ BigLen = Len(BigString)
+ BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen)
+ End If
+ Wend
+ DeleteStr = BigString
+End Function
+
+
+&apos; Finds a PartString, that is framed by the Strings &apos;Prestring&apos; and &apos;PostString&apos;
+Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String
+Dim StartPos%, EndPos%
+Dim BigLen%, PreLen%, PostLen%
+ StartPos = Instr(SearchPos,BigString,PreString)
+ If StartPos &lt;&gt; 0 Then
+ PreLen = Len(PreString)
+ EndPos = Instr(StartPos + PreLen,BigString,PostString)
+ If EndPos &lt;&gt; 0 Then
+ BigLen = Len(BigString)
+ PostLen = Len(PostString)
+ FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen))
+ SearchPos = EndPos + PostLen
+ Else
+ Msgbox(&quot;No final tag for &apos;&quot; &amp; PreString &amp; &quot;&apos; existing&quot;, 16, GetProductName())
+ FindPartString = &quot;&quot;
+ End If
+ Else
+ FindPartString = &quot;&quot;
+ End If
+End Function
+
+
+&apos; Note iCompare = 0 (Binary comparison)
+&apos; iCompare = 1 (Text comparison)
+Function PartStringInArray(BigArray(), SearchString as String, iCompare as Integer) as Integer
+Dim MaxIndex as Integer
+Dim i as Integer
+ MaxIndex = Ubound(BigArray())
+ For i = 0 To MaxIndex
+ If Instr(1, BigArray(i), SearchString, iCompare) &lt;&gt; 0 Then
+ PartStringInArray() = i
+ Exit Function
+ End If
+ Next i
+ PartStringInArray() = -1
+End Function
+
+
+&apos; Deletes the String &apos;SmallString&apos; out of the String &apos;BigString&apos;
+&apos; in case SmallString&apos;s Position in BigString is right at the end
+Function RTrimStr(ByVal BigString, SmallString as String) as String
+Dim SmallLen as Integer
+Dim BigLen as Integer
+ SmallLen = Len(SmallString)
+ BigLen = Len(BigString)
+ If Instr(1,BigString, SmallString) &lt;&gt; 0 Then
+ If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then
+ RTrimStr = Mid(BigString,1,BigLen - SmallLen)
+ Else
+ RTrimStr = BigString
+ End If
+ Else
+ RTrimStr = BigString
+ End If
+End Function
+
+
+&apos; Deletes the Char &apos;CompChar&apos; out of the String &apos;BigString&apos;
+&apos; in case CompChar&apos;s Position in BigString is right at the beginning
+Function LTRimChar(ByVal BigString as String,CompChar as String) as String
+Dim BigLen as integer
+ BigLen = Len(BigString)
+ If BigLen &gt; 1 Then
+ If Left(BigString,1) = CompChar then
+ BigString = Mid(BigString,2,BigLen-1)
+ End If
+ ElseIf BigLen = 1 Then
+ BigString = &quot;&quot;
+ End If
+ LTrimChar = BigString
+End Function
+
+
+&apos; Retrieves an Array out of a String.
+&apos; The fields of the Array are separated by the parameter &apos;Separator&apos;, that is contained
+&apos; in the Array
+&apos; The Array MaxIndex delivers the highest Index of this Array
+Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as Integer)
+Dim LocList() as String
+ LocList=Split(BigString,Separator)
+
+ If not isMissing(MaxIndex) then maxIndex=ubound(LocList())
+
+ ArrayOutOfString=LocList
+End Function
+
+
+&apos; Deletes all fieldvalues in one-dimensional Array
+Sub ClearArray(BigArray)
+Dim i as integer
+ For i = Lbound(BigArray()) to Ubound(BigArray())
+ BigArray(i) = &quot;&quot;
+ Next
+End Sub
+
+
+&apos; Deletes all fieldvalues in a multidimensional Array
+Sub ClearMultiDimArray(BigArray,DimCount as integer)
+Dim n%, m%
+ For n = Lbound(BigArray(),1) to Ubound(BigArray(),1)
+ For m = 0 to Dimcount - 1
+ BigArray(n,m) = &quot;&quot;
+ Next m
+ Next n
+End Sub
+
+
+&apos; Checks if a Field (LocField) is already defined in an Array
+&apos; Returns &apos;True&apos; or &apos;False&apos;
+Function FieldInArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean
+Dim i as integer
+ For i = Lbound(LocArray()) to MaxIndex
+ If UCase(LocArray(i)) = UCase(LocField) Then
+ FieldInArray = True
+ Exit Function
+ End if
+ Next
+ FieldInArray = False
+End Function
+
+
+&apos; Checks if a Field (LocField) is already defined in an Array
+&apos; Returns &apos;True&apos; or &apos;False&apos;
+Function FieldInList(LocField, BigList()) As Boolean
+Dim i as integer
+ For i = Lbound(BigList()) to Ubound(BigList())
+ If LocField = BigList(i) Then
+ FieldInList = True
+ Exit Function
+ End if
+ Next
+ FieldInList = False
+End Function
+
+
+&apos; Retrieves the Index of the delivered String &apos;SearchString&apos; in
+&apos; the Array LocList()&apos;
+Function IndexInArray(SearchString as String, LocList()) as Integer
+Dim i as integer
+ For i = Lbound(LocList(),1) to Ubound(LocList(),1)
+ If UCase(LocList(i,0)) = UCase(SearchString) Then
+ IndexInArray = i
+ Exit Function
+ End if
+ Next
+ IndexInArray = -1
+End Function
+
+
+Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer)
+Dim oListbox as Object
+Dim i as integer
+Dim a as Integer
+ a = 0
+ oListbox = oDialog.GetControl(ListboxName)
+ oListbox.RemoveItems(0, oListbox.GetItemCount)
+ For i = 0 to Ubound(ValList(), 1)
+ If ValList(i) &lt;&gt; &quot;&quot; Then
+ oListbox.AddItem(ValList(i, iDim-1), a)
+ a = a + 1
+ End If
+ Next
+End Sub
+
+
+&apos; Searches for a String in a two-dimensional Array by querying all Searchindexes of the second dimension
+&apos; and delivers the specific String of the ReturnIndex in the second dimension of the Searchlist()
+Function StringInMultiArray(SearchList(), SearchString as String, SearchIndex as Integer, ReturnIndex as Integer, Optional MaxIndex as Integer) as String
+Dim i as integer
+Dim CurFieldString as String
+ If IsMissing(MaxIndex) Then
+ MaxIndex = Ubound(SearchList(),1)
+ End If
+ For i = Lbound(SearchList()) to MaxIndex
+ CurFieldString = SearchList(i,SearchIndex)
+ If UCase(CurFieldString) = UCase(SearchString) Then
+ StringInMultiArray() = SearchList(i,ReturnIndex)
+ Exit Function
+ End if
+ Next
+ StringInMultiArray() = &quot;&quot;
+End Function
+
+
+&apos; Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension
+&apos; and delivers the Index where it is found.
+Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer
+Dim i as integer
+Dim MaxIndex as Integer
+Dim CurFieldValue
+ MaxIndex = Ubound(SearchList(),1)
+ For i = Lbound(SearchList()) to MaxIndex
+ CurFieldValue = SearchList(i,SearchIndex)
+ If CurFieldValue = SearchValue Then
+ GetIndexInMultiArray() = i
+ Exit Function
+ End if
+ Next
+ GetIndexInMultiArray() = -1
+End Function
+
+
+&apos; Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension
+&apos; and delivers the Index where the Searchvalue is found as a part string
+Function GetIndexForPartStringinMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer
+Dim i as integer
+Dim MaxIndex as Integer
+Dim CurFieldValue
+ MaxIndex = Ubound(SearchList(),1)
+ For i = Lbound(SearchList()) to MaxIndex
+ CurFieldValue = SearchList(i,SearchIndex)
+ If Instr(CurFieldValue, SearchValue) &gt; 0 Then
+ GetIndexForPartStringinMultiArray() = i
+ Exit Function
+ End if
+ Next
+ GetIndexForPartStringinMultiArray = -1
+End Function
+
+
+Function ArrayfromMultiArray(MultiArray as String, iDim as Integer)
+Dim MaxIndex as Integer
+Dim i as Integer
+ MaxIndex = Ubound(MultiArray())
+ Dim ResultArray(MaxIndex) as String
+ For i = 0 To MaxIndex
+ ResultArray(i) = MultiArray(i,iDim)
+ Next i
+ ArrayfromMultiArray() = ResultArray()
+End Function
+
+
+&apos; Replaces the string &quot;OldReplace&quot; through the String &quot;NewReplace&quot; in the String
+&apos; &apos;BigString&apos;
+Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String
+ ReplaceString=join(split(BigString,OldReplace),NewReplace)
+End Function
+
+
+&apos; Retrieves the second value for a next to &apos;SearchString&apos; in
+&apos; a two-dimensional string-Array
+Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String
+Dim i as Integer
+ For i = 0 To Ubound(TwoDimList,1)
+ If UCase(SearchString) = UCase(TwoDimList(i,0)) Then
+ FindSecondValue = TwoDimList(i,1)
+ Exit For
+ End If
+ Next
+End Function
+
+
+&apos; raises a base to a certain power
+Function Power(Basis as Double, Exponent as Double) as Double
+ Power = Exp(Exponent*Log(Basis))
+End Function
+
+
+&apos; rounds a Real to a given Number of Decimals
+Function Round(BaseValue as Double, Decimals as Integer) as Double
+Dim Multiplicator as Long
+Dim DblValue#, RoundValue#
+ Multiplicator = Power(10,Decimals)
+ RoundValue = Int(BaseValue * Multiplicator)
+ Round = RoundValue/Multiplicator
+End Function
+
+
+&apos;Retrieves the mere filename out of a whole path
+Function FileNameoutofPath(ByVal Path as String, Optional Separator as String) as String
+Dim i as Integer
+Dim SepList() as String
+ If IsMissing(Separator) Then
+ Path = ConvertFromUrl(Path)
+ Separator = GetPathSeparator()
+ End If
+ SepList() = ArrayoutofString(Path, Separator,i)
+ FileNameoutofPath = SepList(i)
+End Function
+
+
+Function GetFileNameExtension(ByVal FileName as String)
+Dim MaxIndex as Integer
+Dim SepList() as String
+ SepList() = ArrayoutofString(FileName,&quot;.&quot;, MaxIndex)
+ GetFileNameExtension = SepList(MaxIndex)
+End Function
+
+
+Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String)
+Dim MaxIndex as Integer
+Dim SepList() as String
+ If not IsMissing(Separator) Then
+ FileName = FileNameoutofPath(FileName, Separator)
+ End If
+ SepList() = ArrayoutofString(FileName,&quot;.&quot;, MaxIndex)
+ GetFileNameWithoutExtension = RTrimStr(FileName, &quot;.&quot; &amp; SepList(MaxIndex))
+End Function
+
+
+Function DirectoryNameoutofPath(sPath as String, Separator as String) as String
+Dim LocFileName as String
+ LocFileName = FileNameoutofPath(sPath, Separator)
+ DirectoryNameoutofPath = RTrimStr(sPath, Separator &amp; LocFileName)
+End Function
+
+
+Function CountCharsInString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer
+Dim LocCount%, LocPos%
+ LocCount = 0
+ Do
+ LocPos = Instr(StartPos,BigString,LocChar)
+ If LocPos &lt;&gt; 0 Then
+ LocCount = LocCount + 1
+ StartPos = LocPos+1
+ End If
+ Loop until LocPos = 0
+ CountCharsInString = LocCount
+End Function
+
+
+Function BubbleSortList(ByVal SortList(),optional sort2ndValue as Boolean)
+&apos;This function bubble sorts an array of maximum 2 dimensions.
+&apos;The default sorting order is the first dimension
+&apos;Only if sort2ndValue is True the second dimension is the relevant for the sorting order
+ Dim s as Integer
+ Dim t as Integer
+ Dim i as Integer
+ Dim k as Integer
+ Dim dimensions as Integer
+ Dim sortvalue as Integer
+ Dim DisplayDummy
+ dimensions = 2
+
+On Local Error Goto No2ndDim
+ k = Ubound(SortList(),2)
+ No2ndDim:
+ If Err &lt;&gt; 0 Then dimensions = 1
+
+ i = Ubound(SortList(),1)
+ If ismissing(sort2ndValue) then
+ sortvalue = 0
+ else
+ sortvalue = 1
+ end if
+
+ For s = 1 to i - 1
+ For t = 0 to i-s
+ Select Case dimensions
+ Case 1
+ If SortList(t) &gt; SortList(t+1) Then
+ DisplayDummy = SortList(t)
+ SortList(t) = SortList(t+1)
+ SortList(t+1) = DisplayDummy
+ End If
+ Case 2
+ If SortList(t,sortvalue) &gt; SortList(t+1,sortvalue) Then
+ For k = 0 to UBound(SortList(),2)
+ DisplayDummy = SortList(t,k)
+ SortList(t,k) = SortList(t+1,k)
+ SortList(t+1,k) = DisplayDummy
+ Next k
+ End If
+ End Select
+ Next t
+ Next s
+ BubbleSortList = SortList()
+End Function
+
+
+Function GetValueoutofList(SearchValue, BigList(), iDim as Integer, Optional ValueIndex)
+Dim i as Integer
+Dim MaxIndex as Integer
+ MaxIndex = Ubound(BigList(),1)
+ For i = 0 To MaxIndex
+ If BigList(i,0) = SearchValue Then
+ If Not IsMissing(ValueIndex) Then
+ ValueIndex = i
+ End If
+ GetValueOutOfList() = BigList(i,iDim)
+ End If
+ Next i
+End Function
+
+
+Function AddListtoList(ByVal FirstArray(), ByVal SecondArray(), Optional StartIndex)
+Dim n as Integer
+Dim m as Integer
+Dim MaxIndex as Integer
+ MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1
+ If MaxIndex &gt; -1 Then
+ Dim ResultArray(MaxIndex)
+ For m = 0 To Ubound(FirstArray())
+ ResultArray(m) = FirstArray(m)
+ Next m
+ For n = 0 To Ubound(SecondArray())
+ ResultArray(m) = SecondArray(n)
+ m = m + 1
+ Next n
+ AddListToList() = ResultArray()
+ Else
+ Dim NullArray()
+ AddListToList() = NullArray()
+ End If
+End Function
+
+
+Function CheckDouble(DoubleString as String)
+On Local Error Goto WRONGDATATYPE
+ CheckDouble() = CDbl(DoubleString)
+WRONGDATATYPE:
+ If Err &lt;&gt; 0 Then
+ CheckDouble() = 0
+ Resume NoErr:
+ End If
+NOERR:
+End Function
+</script:module>
diff --git a/wizards/source/tools/UCB.xba b/wizards/source/tools/UCB.xba
new file mode 100644
index 000000000..d849a2ea3
--- /dev/null
+++ b/wizards/source/tools/UCB.xba
@@ -0,0 +1,311 @@
+<?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="UCB" script:language="StarBasic">&apos;Option explicit
+Public oDocument
+Public oDocInfo as object
+Const SBMAXDIRCOUNT = 10
+Dim CurDirMaxCount as Integer
+Dim sDirArray(SBMAXDIRCOUNT-1) as String
+Dim DirIndex As Integer
+Dim iDirCount as Integer
+Public bInterruptSearch as Boolean
+Public NoArgs()as New com.sun.star.beans.PropertyValue
+
+Sub Main()
+Dim LocsfileContent(0) as String
+ LocsfileContent(0) = &quot;*&quot;
+ ReadDirectories(&quot;file:///space&quot;, LocsfileContent(), True, False, false)
+End Sub
+
+&apos; ReadDirectories( sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension)
+
+Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean, bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
+Dim i as integer
+Dim Status as Object
+Dim FileCountinDir as Integer
+Dim RealFileContent as String
+Dim FileName as string
+Dim oUcbObject as Object
+Dim DirContent()
+Dim CurIndex as Integer
+Dim MaxIndex as Integer
+Dim StartUbound as Integer
+Dim FileExtension as String
+ StartUbound = 5
+ MaxIndex = StartUBound
+ CurDirMaxCount = SBMAXDIRCOUNT
+Dim sFileArray(StartUbound,1) as String
+ On Local Error Goto FILESYSTEMPROBLEM:
+ CurIndex = -1
+ &apos; Todo: Is the last separator valid?
+ DirIndex = 0
+ sDirArray(iDirIndex) = AnchorDir
+ iDirCount = 1
+ oDocInfo = CreateUnoService(&quot;com.sun.star.document.DocumentProperties&quot;)
+ oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ If oUcbObject.Exists(AnchorDir) Then
+ Do
+ AnchorDir = sDirArray(DirIndex)
+ On Local Error Resume Next
+ DirContent() = oUcbObject.GetFolderContents(AnchorDir,True)
+ DirIndex = DirIndex + 1
+ On Local Error Goto 0
+ On Local Error Goto FILESYSTEMPROBLEM:
+ If Ubound(DirContent()) &lt;&gt; -1 Then
+ FileCountinDir = Ubound(DirContent())+ 1
+ For i = 0 to FilecountinDir -1
+ If bInterruptSearch = True Then
+ Exit Do
+ End If
+
+ Filename = DirContent(i)
+ If oUcbObject.IsFolder(FileName) Then
+ If brecursive Then
+ AddFoldertoList(FileName, DirIndex)
+ End If
+ Else
+ If bcheckFileType Then
+ RealFileContent = GetRealFileContent(FileName)
+ Else
+ RealFileContent = GetFileNameExtension(FileName)
+ End If
+ If RealFileContent &lt;&gt; &quot;&quot; Then
+ &apos; Retrieve the Index in the Array, where a Filename is positioned
+ If Not IsMissing(sFileContent()) Then
+ If (FieldInArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then
+ &apos; The extension of the current file passes the filter and is therefore admitted to the
+ &apos; fileList
+ If Not IsMissing(sExtension) Then
+ If sExtension &lt;&gt; &quot;&quot; Then
+ &apos; Consider that some Formats like old StarOffice Templates with the extension &quot;.vor&quot; can only be
+ &apos; precisely identified by their mimetype and their extension
+ FileExtension = GetFileNameExtension(FileName)
+ If FileExtension = sExtension Then
+ AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
+ End If
+ Else
+ AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
+ End If
+ Else
+ AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
+ End If
+ End If
+ Else
+ AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
+ End If
+ If CurIndex = MaxIndex Then
+ MaxIndex = MaxIndex + StartUbound
+ ReDim Preserve sFileArray(MaxIndex,1) as String
+ End If
+ End If
+ End If
+ Next i
+ End If
+ Loop Until DirIndex &gt;= iDirCount
+ If CurIndex &gt; -1 Then
+ ReDim Preserve sFileArray(CurIndex,1) as String
+ Else
+ ReDim sFileArray() as String
+ End If
+ Else
+ Msgbox(&quot;Directory &apos;&quot; &amp; ConvertFromUrl(AnchorDir) &amp; &quot;&apos; does not exist!&quot;, 16, GetProductName())
+ End If
+ ReadDirectories() = sFileArray()
+ Exit Function
+
+ FILESYSTEMPROBLEM:
+ Msgbox(&quot;Sorry, Filesystem Problem&quot;)
+ ReadDirectories() = sFileArray()
+ Resume LEAVEPROC
+ LEAVEPROC:
+End Function
+
+
+Sub AddFoldertoList(sDirURL as String, iDirIndex)
+ iDirCount = iDirCount + 1
+ If iDirCount = CurDirMaxCount Then
+ CurDirMaxCount = CurDirMaxCount + SBMAXDIRCOUNT
+ ReDim Preserve sDirArray(CurDirMaxCount) as String
+ End If
+ sDirArray(iDirCount-1) = sDirURL
+End Sub
+
+
+Sub AddFileNameToList(sFileArray(), FileName as String, FileContent as String, bGetByTitle as Boolean, CurIndex)
+Dim FileCount As Integer
+ CurIndex = CurIndex + 1
+ sFileArray(CurIndex,0) = FileName
+ If bGetByTitle Then
+ sFileArray(CurIndex,1) = RetrieveDocTitle(oDocInfo, FileName)
+ &apos; Add the documenttitles to the Filearray
+ Else
+ sFileArray(CurIndex,1) = FileContent
+ End If
+End Sub
+
+
+Function RetrieveDocTitle(oDocProps as Object, sFileName as String) As String
+Dim sDocTitle as String
+ On Local Error Goto NOFILE
+ oDocProps.loadFromMedium(sFileName, NoArgs())
+ sDocTitle = oDocProps.Title
+ NOFILE:
+ If Err &lt;&gt; 0 Then
+ RetrieveDocTitle = &quot;&quot;
+ RESUME CLR_ERROR
+ End If
+ CLR_ERROR:
+ If sDocTitle = &quot;&quot; Then
+ sDocTitle = GetFileNameWithoutExtension(sFilename, &quot;/&quot;)
+ End If
+ RetrieveDocTitle = sDocTitle
+End Function
+
+
+&apos; Retrieves The Filecontent of a Document by extracting the content
+&apos; from the Header of the document
+Function GetRealFileContent(FileName as String) As String
+ On Local Error Goto NOFILE
+ oTypeDetect = createUnoService(&quot;com.sun.star.document.TypeDetection&quot;)
+ GetRealFileContent = oTypeDetect.queryTypeByURL(FileName)
+ NOFILE:
+ If Err &lt;&gt; 0 Then
+ GetRealFileContent = &quot;&quot;
+ resume CLR_ERROR
+ End If
+ CLR_ERROR:
+End Function
+
+
+Function CopyRecursively(SourceFilePath as String, SourceStemDir as String, TargetStemDir as String)
+Dim TargetDir as String
+Dim TargetFile as String
+
+ TargetFile= ReplaceString(SourceFilePath, TargetStemDir, SourceStemDir)
+ TargetFileName = FileNameoutofPath(TargetFile,&quot;/&quot;)
+ TargetDir = DeleteStr(TargetFile, TargetFileName)
+ CreateFolder(TargetDir)
+ CopyRecursively() = TargetFile
+End Function
+
+
+&apos; Opens a help url referenced by a Help ID that is retrieved from the calling button tag
+Sub ShowHelperDialog(aEvent)
+Dim oSystemNode as Object
+Dim sSystem as String
+Dim oLanguageNode as Object
+Dim sLocale as String
+Dim sLocaleList() as String
+Dim sLanguage as String
+Dim sHelpUrl as String
+Dim sDocType as String
+ HelpID = aEvent.Source.Model.Tag
+ oLocDocument = StarDesktop.ActiveFrame.Controller.Model
+ sDocType = GetDocumentType(oLocDocument)
+ oSystemNode = GetRegistryKeyContent(&quot;org.openoffice.Office.Common/Help&quot;)
+ sSystem = oSystemNode.GetByName(&quot;System&quot;)
+ oLanguageNode = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
+ sLocale = oLanguageNode.getByName(&quot;ooLocale&quot;)
+ sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
+ sLanguage = sLocaleList(0)
+ sHelpUrl = &quot;vnd.sun.star.help://&quot; &amp; sDocType &amp; &quot;/&quot; &amp; HelpID &amp; &quot;?Language=&quot; &amp; sLanguage &amp; &quot;&amp;System=&quot; &amp; sSystem
+ StarDesktop.LoadComponentfromUrl(sHelpUrl, &quot;OFFICE_HELP&quot;, 63, NoArgs())
+End Sub
+
+
+Sub SaveDataToFile(FilePath as String, DataList())
+Dim FileChannel as Integer
+Dim i as Integer
+Dim oFile as Object
+Dim oOutputStream as Object
+Dim oStreamString as Object
+Dim oUcb as Object
+Dim sCRLF as String
+
+ sCRLF = CHR(13) &amp; CHR(10)
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ oOutputStream = createUnoService(&quot;com.sun.star.io.TextOutputStream&quot;)
+ 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) &amp; sCRLF)
+ Next i
+ oOutputStream.CloseOutput()
+End Sub
+
+
+Function LoadDataFromFile(FilePath as String, DataList()) as Boolean
+Dim oInputStream as Object
+Dim i as Integer
+Dim oUcb as Object
+Dim oFile as Object
+Dim MaxIndex as Integer
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ If oUcb.Exists(FilePath) Then
+ MaxIndex = 10
+ oInputStream = createUnoService(&quot;com.sun.star.io.TextInputStream&quot;)
+ oFile = oUcb.OpenFileReadWrite(FilePath)
+ oInputStream.SetInputStream(oFile.GetInputStream)
+ i = -1
+ Redim Preserve DataList(MaxIndex)
+ While Not oInputStream.IsEOF
+ i = i + 1
+ If i &gt; MaxIndex Then
+ MaxIndex = MaxIndex + 10
+ Redim Preserve DataList(MaxIndex)
+ End If
+ DataList(i) = oInputStream.ReadLine
+ Wend
+ If i &gt; -1 And i &lt;&gt; MaxIndex Then
+ Redim Preserve DataList(i)
+ End If
+ LoadDataFromFile() = True
+ oInputStream.CloseInput()
+ Else
+ LoadDataFromFile() = False
+ End If
+End Function
+
+
+Function CreateFolder(sNewFolder) as Boolean
+Dim oUcb as Object
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ On Local Error Goto NOSPACEONDRIVE
+ If Not oUcb.Exists(sNewFolder) Then
+ oUcb.CreateFolder(sNewFolder)
+ End If
+ CreateFolder = True
+NOSPACEONDRIVE:
+ If Err &lt;&gt; 0 Then
+ If InitResources(&quot;&quot;) Then
+ ErrMsg = GetResText(&quot;RID_COMMON_0&quot;)
+ ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
+ ErrMsg = ReplaceString(ErrMsg, sNewFolder, &quot;%1&quot;)
+ Msgbox(ErrMsg, 48, GetProductName())
+ End If
+ CreateFolder = False
+ Resume GOON
+ End If
+GOON:
+End Function
+</script:module>
diff --git a/wizards/source/tools/dialog.xlb b/wizards/source/tools/dialog.xlb
new file mode 100644
index 000000000..dc8dfbda2
--- /dev/null
+++ b/wizards/source/tools/dialog.xlb
@@ -0,0 +1,5 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
+<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Tools" library:readonly="true" library:passwordprotected="false">
+ <library:element library:name="DlgOverwriteAll"/>
+</library:library>
diff --git a/wizards/source/tools/script.xlb b/wizards/source/tools/script.xlb
new file mode 100644
index 000000000..fe4d74d60
--- /dev/null
+++ b/wizards/source/tools/script.xlb
@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
+<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Tools" library:readonly="true" library:passwordprotected="false">
+ <library:element library:name="ModuleControls"/>
+ <library:element library:name="Strings"/>
+ <library:element library:name="Misc"/>
+ <library:element library:name="UCB"/>
+ <library:element library:name="Listbox"/>
+ <library:element library:name="Debug"/>
+</library:library> \ No newline at end of file