diff options
| author | Michael Stahl <mstahl@redhat.com> | 2012-01-28 20:52:45 +0100 |
|---|---|---|
| committer | Michael Stahl <mstahl@redhat.com> | 2012-01-28 20:52:45 +0100 |
| commit | 2e626373db2412ac22e8c5c27a60d11cd29e875b (patch) | |
| tree | 9e9f67205cd5b72f1031721273e1534a3a1e5b0f /wizards/source/tools | |
| parent | f7ee7bbd5174b084f018c2ec94d8c70c98ee04da (diff) | |
replace obsolete "master" branch with README that points at new repoHEADmaster-deletedmaster
Diffstat (limited to 'wizards/source/tools')
| -rw-r--r-- | wizards/source/tools/Debug.xba | 236 | ||||
| -rw-r--r-- | wizards/source/tools/DlgOverwriteAll.xdl | 17 | ||||
| -rw-r--r-- | wizards/source/tools/Listbox.xba | 353 | ||||
| -rw-r--r-- | wizards/source/tools/Misc.xba | 821 | ||||
| -rw-r--r-- | wizards/source/tools/ModuleControls.xba | 370 | ||||
| -rw-r--r-- | wizards/source/tools/Strings.xba | 452 | ||||
| -rw-r--r-- | wizards/source/tools/UCB.xba | 294 | ||||
| -rw-r--r-- | wizards/source/tools/delzip | 0 | ||||
| -rw-r--r-- | wizards/source/tools/dialog.xlb | 5 | ||||
| -rw-r--r-- | wizards/source/tools/script.xlb | 10 |
10 files changed, 0 insertions, 2558 deletions
diff --git a/wizards/source/tools/Debug.xba b/wizards/source/tools/Debug.xba deleted file mode 100644 index 4ba60ffb8..000000000 --- a/wizards/source/tools/Debug.xba +++ /dev/null @@ -1,236 +0,0 @@ -<?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="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 <> "Standard" 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 = "private:factory/swriter" - oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs) - oLocText = oLocDocument.text - oLocCursor = oLocText.createTextCursor() - oLocCursor.gotoStart(False) - If Vartype(LocObject) = 9 then ' an Object Variable - For n = 0 To 2 - sProperties() = ArrayoutofString(sObjectStrings(n),";", 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 ' a String Variable - oLocText.insertString(oLocCursor,LocObject,False) - ElseIf Vartype(LocObject) = 1 Then - Msgbox("Variable is Null!", 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 = "private:factory/swriter" - oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",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 ' a String Variable - Msgbox LocObject - ElseIf Vartype(LocObject) = 0 Then - Msgbox("Variable is Null!", 16, GetProductName()) - Else - Msgbox("Type of Variable: " & Typename(LocObject), 48, GetProductName()) - End If -End Sub - - -Sub ShowArray(LocArray()) -Dim i as integer -Dim msgstring - msgstring = "" - 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 = "" - For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties) - Propname = oLocObject.PropertySetInfo.Properties(i).Name - sValues = sValues & PropName & chr(13) & " = " & oLocObject.GetPropertyValue(PropName) & chr(13) - Next i - Msgbox(sValues , 64, GetProductName()) - Exit Sub - -NOPROPERTYSETINFO: - Msgbox("Sorry, No PropertySetInfo attached to the object", 16, GetProductName()) - Resume LEAVEPROC - LEAVEPROC: -End Sub - - -Sub ShowNameValuePair(Pair()) -Dim i as Integer -Dim ShowString as String - ShowString = "" - On Local Error Resume Next - For i = 0 To Ubound(Pair()) - ShowString = ShowString & Pair(i).Name & " = " - ShowString = ShowString & Pair(i).Value & chr(13) - Next i - Msgbox ShowString -End Sub - - -' Retrieves all the Elements of aSequence of an object, with the -' possibility to define a filter(sfilter <> "") -Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String) -Dim i as Integer -Dim NameString as String - NameString = "" - For i = 0 To Ubound(oLocElements()) - If Not IsMissIng(sFilterName) Then - If Instr(1, oLocElements(i), sFilterName) Then - NameString = NameString & oLocElements(i) & chr(13) - End If - Else - NameString = NameString & oLocElements(i) & chr(13) - End If - Next i - Msgbox(NameString, 64, GetProductName()) -End Sub - - -' Retrieves all the supported servicenames of an object, with the -' possibility to define a filter(sfilter <> "") -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("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName()) - Resume LEAVEPROC - LEAVEPROC: -End Sub - - -' Retrieves all the available Servicenames of an object, with the -' possibility to define a filter(sfilter <> "") -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("Sorry, No 'AvailableServiceNames' - Property attached to the object", 16, GetProductName()) - Resume LEAVEPROC - LEAVEPROC: -End Sub - - -Sub ShowCommands(oLocObject as Object) - On Local Error Goto NOCOMMANDS - ShowElementNames(oLocObject.QueryCommands) - Exit Sub - NOCOMMANDS: - Msgbox("Sorry, No 'QueryCommands' - Property attached to the object", 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 = "scalc" 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( "Do you want to protect all sheets of this document?",35, GetProductName()) - If iResult = 6 Then - ProtectSheets(oDocument.Sheets) - End If - End If - End If -End Sub - - -Sub FillDocument() - oMyReport = createUNOService("com.sun.star.wizards.report.CallReportWizard") - oMyReport.trigger("fill") -End Sub - -</script:module>
\ No newline at end of file diff --git a/wizards/source/tools/DlgOverwriteAll.xdl b/wizards/source/tools/DlgOverwriteAll.xdl deleted file mode 100644 index 5208ead79..000000000 --- a/wizards/source/tools/DlgOverwriteAll.xdl +++ /dev/null @@ -1,17 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!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="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&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&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&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 deleted file mode 100644 index 01e62e7d6..000000000 --- a/wizards/source/tools/Listbox.xba +++ /dev/null @@ -1,353 +0,0 @@ -<?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="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 - - -' 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 > -1 Then - iOldSourceSelect = SourceListbox.SelectedItems(0) - If Ubound(TargetListbox.SelectedItems()) > -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()) > -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()) <> -1 Then - NewSourceList(m) = SearchString - m = m + 1 - ElseIf IndexinArray(SearchString, SourceList()) <> -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 > -1 Then - For n = 0 To MaxSelected - CurIndex = oListbox.SelectedItems(n) - LocItemList(CurIndex) = "" - Next n - If MaxIndex > 0 Then - ReDim ResultArray(MaxIndex - MaxSelected - 1) - m = 0 - For n = 0 To MaxIndex - CurItem = LocItemList(n) - If CurItem <> "" 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 > -1 AND iLastSelection > -1 Then - If iLastSelection > 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 -' .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 - - -' Enable or disable the buttons used for moving the available -' 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()) <> -1 - FieldCount = Ubound(oDialogModel.lstFields.StringItemList()) + 1 - bSelectSelected = Ubound(oDialogModel.lstSelFields.SelectedItems()) > -1 - SelectCount = Ubound(oDialogModel.lstSelFields.StringItemList()) + 1 - oDialogModel.cmdRemoveAll.Enabled = SelectCount>=1 - oDialogModel.cmdRemoveSelected.Enabled = bSelectSelected - oDialogModel.cmdMoveAll.Enabled = FieldCount >=1 - oDialogModel.cmdMoveSelected.Enabled = bIsFieldSelected - oDialogModel.cmdGoOn.Enabled = SelectCount>=1 - ' This flag is set to '1' 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) -' 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 <> -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 - - -' Note: When using this Sub it must be ensured that the -' 'RemoveItem' appears only 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()) <> -1 Then - If MaxIndex > 0 Then - a = 0 - Dim NewList(MaxIndex -1) - For i = 0 To MaxIndex - If RemoveItem <> 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>
\ No newline at end of file diff --git a/wizards/source/tools/Misc.xba b/wizards/source/tools/Misc.xba deleted file mode 100644 index faa0f802f..000000000 --- a/wizards/source/tools/Misc.xba +++ /dev/null @@ -1,821 +0,0 @@ -<?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="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)' as String - PropList(0,0) = "URL" - PropList(0,1) = "sdbc:odbc:Erica_Test_Unicode" - PropList(1,0) = "User" - PropList(1,1) = "extra" - PropList(2,0) = "Password" - PropList(2,1) = "extra" - PropList(3,0) = "IsPasswordRequired" - 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("com.sun.star.sdb.DatabaseContext") - oDataSource = createUnoService("com.sun.star.sdb.DataSource") - 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 - - -' 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 -' On Local Error Goto NOCONNECTION - oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") - If oDBContext.HasbyName(DSName) Then - oDBSource = oDBContext.GetByName(DSName) - ConnectToDatabase = oDBSource.GetConnection(UserID, Password) - Else - If Not IsMissing(Namelist()) Then - If Not IsMissing(DriverProperties()) Then - RegisterNewDataSource(DSName, PropertyList(), DriverProperties()) - Else - RegisterNewDataSource(DSName, PropertyList()) - End If - oDBSource = oDBContext.GetByName(DSName) - ConnectToDatabase = oDBSource.GetConnection(UserID, Password) - Else - Msgbox("DataSource " & DSName & " is not registered" , 16, GetProductname()) - ConnectToDatabase() = NULL - End If - End If -NOCONNECTION: - If Err <> 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("org.openoffice.Setup/L10N/") - sLocale = oMasterKey.getByName("ooLocale") - sLocaleList() = ArrayoutofString(sLocale, "-") - aLocLocale.Language = sLocaleList(0) - If Ubound(sLocaleList()) > 0 Then - aLocLocale.Country = sLocaleList(1) - 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("com.sun.star.configuration.ConfigurationProvider") - aNodePath(0).Name = "nodepath" - aNodePath(0).Value = sKeyName - If IsMissing(bForUpdate) Then - GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) - Else - If bForUpdate Then - GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath()) - Else - GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) - End If - End If -End Function - - -Function GetProductname() as String -Dim oProdNameAccess as Object -Dim sVersion as String -Dim sProdName as String - oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") - sProdName = oProdNameAccess.getByName("ooName") - sVersion = oProdNameAccess.getByName("ooSetupVersion") - GetProductName = sProdName & sVersion -End Function - - -' Opens a Document, checks beforehand, wether it has to be loaded -' or wether it is already on the desktop. -' If the parameter bDisposable is set to False then then returned document -' 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 - ' Search if one of the active Components ist the one that you search for - oComponents = StarDesktop.Components.CreateEnumeration - While oComponents.HasmoreElements - oComponent = oComponents.NextElement - If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") 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,"_default",0,Args()) -End Function - - -Function TaskonDesktop(DocPath as String) as Boolean -Dim oComponents as Object -Dim oComponent as Object - ' Search if one of the active Components ist the one that you search for - oComponents = StarDesktop.Components.CreateEnumeration - While oComponents.HasmoreElements - oComponent = oComponents.NextElement - If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then - If UCase(oComponent.URL) = UCase(DocPath) then - TaskonDesktop = True - Exit Function - End If - End If - Wend - TaskonDesktop = False -End Function - - -' 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,"/",MaxArrIndex) - RetrieveFileName = LocURLArray(MaxArrIndex) -End Function - - -' 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("com.sun.star.util.PathSettings") - - 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 - ' Share and User-Directory - If Instr(1,sPath,";") <> 0 Then - PathList = ArrayoutofString(sPath,";", MaxIndex) - If ListIndex <= MaxIndex Then - sPath = PathList(ListIndex) - Else - Msgbox("String Cannot be analyzed!" & sPath , 16, GetProductName()) - End If - End If - End If - If Instr(1, sPath, ";") = 0 Then - GetPathSettings = ConvertToUrl(sPath) - Else - GetPathSettings = sPath - End If - -End Function - - - -' Gets the fully qualified path to a subdirectory of the -' Template Directory, e. g. with the parameter "wizard/bitmap" -' The parameter must be passed over in Url-scription -' The return-Value is in Urlscription -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("com.sun.star.ucb.SimpleFileAccess") - sOfficeString = GetPathSettings(sOfficePath) - If Right(sSubDir,1) <> "/" Then - sSubDir = sSubDir & "/" - End If - sOfficeList() = ArrayoutofString(sOfficeString,";", MaxIndex) - For i = 0 To MaxIndex - sOfficeDir = ConvertToUrl(sOfficeList(i)) - If Right(sOfficeDir,1) <> "/" Then - sOfficeDir = sOfficeDir & "/" - End If - sBigDir = sOfficeDir & sSubDir - If oUcb.Exists(sBigDir) Then - GetOfficeSubPath() = sBigDir - Exit Function - End If - Next i - ShowNoOfficePathError() - GetOfficeSubPath = "" -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("Tools", "com") Then - ProductName = GetProductName() - sError = GetResText(1006) - sError = ReplaceString(sError, ProductName, "%PRODUCTNAME") - sError = ReplaceString(sError, chr(13), "<BR>") - MsgBox(sError, 16, ProductName) - End If - If bResObjectexists Then - oResSrv = oLocResSrv - End If - -End Sub - - -Function InitResources(Description, ShortDescription as String) as boolean -Dim xResource as Object -Dim aArgs(0) as String - On Error Goto ErrorOcurred - aArgs(0) = ShortDescription - oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") - xResource = getProcessServiceManager().createInstanceWithArguments( "org.libreoffice.resource.ResourceIndexAccess", aArgs() ) - If (IsNull(xResource)) then - InitResources = FALSE - MsgBox("could not initialize ResourceIndexAccess") - Else - InitResources = TRUE - oResSrv = xResource.getByName( "String" ) - End If - Exit Function -ErrorOcurred: - Dim nSolarVer - InitResources = FALSE - nSolarVer = GetSolarVersion() - MsgBox("Resource file missing (" & ShortDescription & trim(str(nSolarVer)) + "*.res)", 16, GetProductName()) - Resume CLERROR - CLERROR: -End Function - - -Function GetResText( nID as integer ) As string - On Error Goto ErrorOcurred - If Not IsNull(oResSrv) Then - GetResText = oResSrv.getByIndex( nID ) - Else - GetResText = "" - End If - Exit Function -ErrorOcurred: - GetResText = "" - MsgBox("Resource with ID =" + str( nID ) + " not found!", 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 > 60 Then - FileName = FileNameoutofPath(sViewPath, "/") - iFileLen = Len(FileName) - If iFileLen < 44 Then - sViewPath = Left(sViewPath,57-iFileLen-10) & "..." & Right(sViewPath,iFileLen + 10) - Else - sViewPath = Left(sViewPath,27) & " ... " & Right(sViewPath,28) - End If - End If - CutPathView = sViewPath -End Function - - -' Deletes the content of all cells that are softformatted according -' to the 'InputStyleName' -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) <> 0 Then - Call ReplaceRangeValues(oRange, "") - End If - Wend -End Sub - - -' Inserts a certain String to all cells of a Range that ist passed over -' 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 - ' Get the Range out of the Rangename - oCellRange = oSheet.GetCellRangeByName(Range) - Else - ' The range is passed over 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 - - -' 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 - - -' 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 - - -' 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 - - -' 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 = "=Value(" & """" & ValueString & """" & ")" - CellValue = oCell.Value - oCell.Formula = "" - oCell.Value = CellValue -End Sub - - -Function GetDocumentType(oDocument) - On Local Error GoTo NODOCUMENTTYPE -' ShowSupportedServiceNames(oDocument) - If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then - GetDocumentType() = "scalc" - ElseIf oDocument.SupportsService("com.sun.star.text.TextDocument") Then - GetDocumentType() = "swriter" - ElseIf oDocument.SupportsService("com.sun.star.drawing.DrawingDocument") Then - GetDocumentType() = "sdraw" - ElseIf oDocument.SupportsService("com.sun.star.presentation.PresentationDocument") Then - GetDocumentType() = "simpress" - ElseIf oDocument.SupportsService("com.sun.star.formula.FormulaProperties") Then - GetDocumentType() = "smath" - End If - NODOCUMENTTYPE: - If Err <> 0 Then - GetDocumentType = "" - 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 <> 0 Then - Msgbox("Numberformat of Object is not available!", 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("") - 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("") - 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 - ' 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 <> 0 Then - ' Test if renaming failed - Count = 2 - Do While oSheet.Name <> NewName - NewName = BasicSheetName & "_" & Count - oSheet.Name = NewName - Count = Count + 1 - Loop - Resume CL_ERROR -CL_ERROR: - End If - CopySheetbyName = oSheet -End Function - - -' 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("com.sun.star.i18n.CharacterClassification") - 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, "", nContFlags, " ") - iResultPos = oResult.EndPos - If iResultPos < iSheetNameLength Then - WrongChar = Mid(SheetName, iResultPos+1,1) - SheetName = ReplaceString(SheetName,"_", 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) & "_" & 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 Integer -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 - - -' Note To set a one lined frame you have to set the inner width to 0 -' In the API all Units that refer to pt-Heights are "1/100mm" -' 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 = "EventType" - PropValue(0).Value = "StarBasic" - PropValue(1).Name = "Script" - PropValue(1).Value = "macro:///" & 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 <> -1 Then - If Vartype(TargetProperties(a).Value) <> 9 Then - If TargetProperties(a).Value <> 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("com.sun.star.util.URLTransformer") - oUrl.Complete = "slot:" & CStr(SlotID) - oTrans.parsestrict(oUrl) - oDisp = StarDesktop.ActiveFrame.queryDispatch(oUrl, "_self", 0) - oDisp.dispatch(oUrl, oArg()) -End Sub - - -'returns the type of the office application -'FatOffice = 0, WebTop = 1 -'This routine has to be changed if the Product Name is being changed! -Function IsFatOffice() As Boolean - If sProductname = "" Then - sProductname = GetProductname() - End If - IsFatOffice = TRUE - 'The following line has to include the current productname - If Instr(1,sProductname,"WebTop",1) <> 0 Then - IsFatOffice = FALSE - End If -End Function - - -Function GetLocale(sLanguage as String, sCountry as String) -Dim oLocale as New com.sun.star.lang.Locale - oLocale.Language = sLanguage - oLocale.Country = sCountry - GetLocale = oLocale -End Function - - -Sub ToggleDesignMode(oDocument as Object) -Dim aSwitchMode as new com.sun.star.util.URL - aSwitchMode.Complete = ".uno:SwitchControlDesignMode" - aTransformer = createUnoService("com.sun.star.util.URLTransformer") - 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( "DisplayBackgroundColor" ) - myRed = Red (UIColor) - myGreen = Green (UIColor) - myBlue = Blue (UIColor) - myLuminance = (( myBlue*28 + myGreen*151 + myRed*77 ) / 256 ) - isHighContrast = false - If myLuminance <= 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 = "private:factory/" & sType - oDocument = StarDesktop.LoadComponentFromURL(sUrl,"_default",0, NoArgs()) -NOMODULEINSTALLED: - If (Err <> 0) OR IsNull(oDocument) Then - If InitResources("", "com") Then - Select Case sType - Case "swriter" - ErrMsg = GetResText(1001) - Case "scalc" - ErrMsg = GetResText(1002) - Case "simpress" - ErrMsg = GetResText(1003) - Case "sdraw" - ErrMsg = GetResText(1004) - Case "smath" - ErrMsg = GetResText(1005) - Case Else - ErrMsg = "Invalid Document Type!" - End Select - ErrMsg = ReplaceString(ErrMsg, chr(13), "<BR>") - If Not IsMissing(sAddMsg) Then - ErrMsg = ErrMsg & chr(13) & sAddMsg - End If - Msgbox(ErrMsg, 48, GetProductName()) - End If - If Err <> 0 Then - Resume GOON - End If - End If -GOON: - CreateNewDocument = oDocument -End Function - - -' This Sub has been used in order to ensure that after disposing a document -' from the backing window it is returned to the backing window, so the -' office won'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("com.sun.star.util.URLTransformer") - url.Complete = ".uno:CloseDoc" - parser.parseStrict(url) - oFrame = oDocument.CurrentController.Frame - disp = oFrame.queryDispatch(url,"_self", com.sun.star.util.SearchFlags.NORM_WORD_ONLY) - disp.dispatch(url, NoArgs()) - End If -End Sub - -'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 <> 0) Or (iYear Mod 400 = 0))) -End Function -</script:module> diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba deleted file mode 100644 index dc5ef02a5..000000000 --- a/wizards/source/tools/ModuleControls.xba +++ /dev/null @@ -1,370 +0,0 @@ -<?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="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 - - - -' Accepts the name of a control and returns the respective control model as object -' The Container can either be a whole document or a specific sheet of a Calc-Document -' 'CName' 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("No Control with the name '" & CName & "' found" , 16, GetProductName()) -End Function - - - -' Gets the Shape of a Control( e. g. to reset the size or Position of the control -' Parameters: -' The 'oContainer' is the Document or a specific sheet of a Calc - Document -' 'CName' 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, "com.sun.star.drawing.XControlShape") then - If ashape.Control.Name = CName then - GetControlShape = aShape - exit Function - End If - End If - Next -End Function - - -' Returns the View of a Control -' Parameters: -' The 'oContainer' is the Document or a specific sheet of a Calc - Document -' The 'oController' is always directly attached to the Document -' 'CName' 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("No Control with the name '" & CName & "' found" , 16, GetProductName()) -End Function - - - -' Parameters: -' The 'oContainer' is the Document or a specific sheet of a Calc - Document -' 'CName' 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 - - -' Returns a sequence of a group of controls like option buttons or checkboxes -' The 'oContainer' is the Document or a specific sheet of a Calc - Document -' 'sGroupName' 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("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName()) -End Function - - -' Returns the Referencevalue of a group of e.g. option buttons or check boxes -' 'oControlGroup' is a sequence of the Control objects -Function GetRefValue(oControlGroup() as Object) -Dim i as Integer - For i = 0 To Ubound(oControlGroup()) -' 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 - 'Note: The following services have to be called in the following order - ' because otherwise Basic does not remove the FileDialog Service - oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker") - oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") - InitPath = ConvertToUrl(oRefModel.Text) - If InitPath = "" Then - InitPath = GetPathSettings("Work") - 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 -'Dim ListAny(0) - 'Note: The following services have to be called in the following order - ' because otherwise Basic does not remove the FileDialog Service - oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") - oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") - 'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE - 'oFileDialog.initialize(ListAny()) - AddFiltersToDialog(FilterNames(), oFileDialog) - InitPath = ConvertToUrl(oRefModel.Text) - If InitPath = "" Then - InitPath = GetPathSettings("Work") - 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("com.sun.star.ui.dialogs.FilePicker") - 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 = "" Then - ' Todo: Catch the case that a document that has to be overwritten is writeportected (e.g. it is open) - oDocument.StoreAsUrl(sPath, NoArgs()) - Else - oStoreProperties(0).Name = "FilterName" - oStoreProperties(0).Value = FilterName - oDocument.StoreAsUrl(sPath, oStoreProperties()) - End If - End If - oStoreDialog.dispose() - StoreDocument() = sPath - Exit Function -NOSAVING: - If Err <> 0 Then -' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName()) - sPath = "" - 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("org.openoffice.Setup/Product") - sProdName = oProdNameAccess.getByName("ooName") - MaxIndex = Ubound(FilterNames(), 1) - For i = 0 To MaxIndex - Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%") - 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("com.sun.star.awt.Pointer") - 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(), "dbw") Then - QueryString = GetResText(507) - QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), "<PATH>") - If Len(QueryString) > 190 Then - QueryString = DeleteStr(QueryString, ".<BR>") - End If - QueryString = ReplaceString(QueryString, chr(13), "<BR>") - lblYes = GetResText(508) - lblYesToAll = GetResText(509) - lblNo = GetResText(510) - lblCancel = GetResText(511) - DlgOverwrite = LoadDialog("Tools", "DlgOverwriteAll") - 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("cmdNo").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>
\ No newline at end of file diff --git a/wizards/source/tools/Strings.xba b/wizards/source/tools/Strings.xba deleted file mode 100644 index a2a8907e0..000000000 --- a/wizards/source/tools/Strings.xba +++ /dev/null @@ -1,452 +0,0 @@ -<?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="Strings" script:language="StarBasic">Option Explicit -Public sProductname as String - - -' Deletes out of a String 'BigString' all possible PartStrings, that are summed up -' in the Array 'ElimArray' -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 - - -' Deletes out of a String 'BigString' a possible Partstring 'CompString' -Function DeleteStr(ByVal BigString,CompString as String) as String -Dim i%, CompLen%, BigLen% - CompLen = Len(CompString) - i = 1 - While i <> 0 - i = Instr(i, BigString,CompString) - If i <> 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 - - -' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString' -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 <> 0 Then - PreLen = Len(PreString) - EndPos = Instr(StartPos + PreLen,BigString,PostString) - If EndPos <> 0 Then - BigLen = Len(BigString) - PostLen = Len(PostString) - FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen)) - SearchPos = EndPos + PostLen - Else - Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName()) - FindPartString = "" - End If - Else - FindPartString = "" - End If -End Function - - -' Note iCompare = 0 (Binary comparison) -' 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) <> 0 Then - PartStringInArray() = i - Exit Function - End If - Next i - PartStringInArray() = -1 -End Function - - -' Deletes the String 'SmallString' out of the String 'BigString' -' in case SmallString'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) <> 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 - - -' Deletes the Char 'CompChar' out of the String 'BigString' -' in case CompChar'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 > 1 Then - If Left(BigString,1) = CompChar then - BigString = Mid(BigString,2,BigLen-1) - End If - ElseIf BigLen = 1 Then - BigString = "" - End If - LTrimChar = BigString -End Function - - -' Retrieves an Array out of a String. -' The fields of the Array are separated by the parameter 'Separator', that is contained -' in the Array -' 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 - - -' Deletes all fieldvalues in one-dimensional Array -Sub ClearArray(BigArray) -Dim i as integer - For i = Lbound(BigArray()) to Ubound(BigArray()) - BigArray(i) = "" - Next -End Sub - - -' 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) = "" - Next m - Next n -End Sub - - -' Checks if a Field (LocField) is already defined in an Array -' Returns 'True' or 'False' -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 - - -' Checks if a Field (LocField) is already defined in an Array -' Returns 'True' or 'False' -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 - - -' Retrieves the Index of the delivered String 'SearchString' in -' the Array LocList()' -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) <> "" Then - oListbox.AddItem(ValList(i, iDim-1), a) - a = a + 1 - End If - Next -End Sub - - -' Searches for a String in a two-dimensional Array by querying all Searchindexex of the second dimension -' 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() = "" -End Function - - -' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension -' 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 - - -' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension -' 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) > 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 - - -' Replaces the string "OldReplace" through the String "NewReplace" in the String -' 'BigString' -Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String - ReplaceString=join(split(BigString,OldReplace),NewReplace) -End Function - - -' Retrieves the second value for a next to 'SearchString' in -' 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 - - -' raises a base to a certain power -Function Power(Basis as Double, Exponent as Double) as Double - Power = Exp(Exponent*Log(Basis)) -End Function - - -' 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 - - -'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,".", 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,".", MaxIndex) - GetFileNameWithoutExtension = RTrimStr(FileName, "." & 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 & 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 <> 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) -'This function bubble sorts an array of maximum 2 dimensions. -'The default sorting order is the first dimension -'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 <> 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) > SortList(t+1) Then - DisplayDummy = SortList(t) - SortList(t) = SortList(t+1) - SortList(t+1) = DisplayDummy - End If - Case 2 - If SortList(t,sortvalue) > 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 > -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 <> 0 Then - CheckDouble() = 0 - Resume NoErr: - End If -NOERR: -End Function -</script:module>
\ No newline at end of file diff --git a/wizards/source/tools/UCB.xba b/wizards/source/tools/UCB.xba deleted file mode 100644 index 524afe60c..000000000 --- a/wizards/source/tools/UCB.xba +++ /dev/null @@ -1,294 +0,0 @@ -<?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="UCB" script:language="StarBasic">'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) = "*" - ReadDirectories("file:///space", LocsfileContent(), True, False, false) -End Sub - -' 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 - ' Todo: Is the last separator valid? - DirIndex = 0 - sDirArray(iDirIndex) = AnchorDir - iDirCount = 1 - oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties") - oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") - 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()) <> -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 <> "" Then - ' Retrieve the Index in the Array, where a Filename is positioned - If Not IsMissing(sFileContent()) Then - If (FieldinArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then - ' The extension of the current file passes the filter and is therefor admitted to the - ' fileList - If Not IsMissing(sExtension) Then - If sExtension <> "" Then - ' Consider that some Formats like old StarOffice Templates with the extension ".vor" can only be - ' 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 >= iDirCount - If CurIndex > -1 Then - ReDim Preserve sFileArray(CurIndex,1) as String - Else - ReDim sFileArray() as String - End If - Else - Msgbox("Directory '" & ConvertFromUrl(AnchorDir) & "' does not exist!", 16, GetProductName()) - End If - ReadDirectories() = sFileArray() - Exit Function - - FILESYSTEMPROBLEM: - Msgbox("Sorry, Filesystem Problem") - 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) - ' 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 <> 0 Then - RetrieveDocTitle = "" - RESUME CLR_ERROR - End If - CLR_ERROR: - If sDocTitle = "" Then - sDocTitle = GetFileNameWithoutExtension(sFilename, "/") - End If - RetrieveDocTitle = sDocTitle -End Function - - -' Retrieves The Filecontent of a Document by extracting the content -' from the Header of the document -Function GetRealFileContent(FileName as String) As String - On Local Error Goto NOFILE - oTypeDetect = createUnoService("com.sun.star.document.TypeDetection") - GetRealFileContent = oTypeDetect.queryTypeByURL(FileName) - NOFILE: - If Err <> 0 Then - GetRealFileContent = "" - 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,"/") - TargetDir = DeleteStr(TargetFile, TargetFileName) - CreateFolder(TargetDir) - CopyRecursively() = TargetFile -End Function - - -' 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("org.openoffice.Office.Common/Help") - sSystem = oSystemNode.GetByName("System") - oLanguageNode = GetRegistryKeyContent("org.openoffice.Setup/L10N/") - sLocale = oLanguageNode.getByName("ooLocale") - sLocaleList() = ArrayoutofString(sLocale, "-") - sLanguage = sLocaleList(0) - sHelpUrl = "vnd.sun.star.help://" & sDocType & "/" & HelpID & "?Language=" & sLanguage & "&System=" & sSystem - StarDesktop.LoadComponentfromUrl(sHelpUrl, "OFFICE_HELP", 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) & CHR(10) - 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 - - -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("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) - While Not oInputStream.IsEOF - i = i + 1 - If i > MaxIndex Then - MaxIndex = MaxIndex + 10 - Redim Preserve DataList(MaxIndex) - End If - DataList(i) = oInputStream.ReadLine - Wend - If i > -1 And i <> 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("com.sun.star.ucb.SimpleFileAccess") - On Local Error Goto NOSPACEONDRIVE - If Not oUcb.Exists(sNewFolder) Then - oUcb.CreateFolder(sNewFolder) - End If - CreateFolder = True -NOSPACEONDRIVE: - If Err <> 0 Then - If InitResources("", "dbw") Then - ErrMsg = GetResText(500) - ErrMsg = ReplaceString(ErrMsg, chr(13), "<BR>") - ErrMsg = ReplaceString(ErrMsg, sNewFolder, "%1") - Msgbox(ErrMsg, 48, GetProductName()) - End If - CreateFolder = False - Resume GOON - End If -GOON: -End Function -</script:module> diff --git a/wizards/source/tools/delzip b/wizards/source/tools/delzip deleted file mode 100644 index e69de29bb..000000000 --- a/wizards/source/tools/delzip +++ /dev/null diff --git a/wizards/source/tools/dialog.xlb b/wizards/source/tools/dialog.xlb deleted file mode 100644 index dc8dfbda2..000000000 --- a/wizards/source/tools/dialog.xlb +++ /dev/null @@ -1,5 +0,0 @@ -<?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 deleted file mode 100644 index fe4d74d60..000000000 --- a/wizards/source/tools/script.xlb +++ /dev/null @@ -1,10 +0,0 @@ -<?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 |