diff options
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 | 817 | ||||
| -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/makefile.mk | 45 | ||||
| -rw-r--r-- | wizards/source/tools/script.xlb | 10 |
11 files changed, 2599 insertions, 0 deletions
diff --git a/wizards/source/tools/Debug.xba b/wizards/source/tools/Debug.xba new file mode 100644 index 000000000000..4ba60ffb8d95 --- /dev/null +++ b/wizards/source/tools/Debug.xba @@ -0,0 +1,236 @@ +<?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 new file mode 100644 index 000000000000..5208ead799d6 --- /dev/null +++ b/wizards/source/tools/DlgOverwriteAll.xdl @@ -0,0 +1,17 @@ +<?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 new file mode 100644 index 000000000000..01e62e7d6715 --- /dev/null +++ b/wizards/source/tools/Listbox.xba @@ -0,0 +1,353 @@ +<?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 new file mode 100644 index 000000000000..7eca46671f12 --- /dev/null +++ b/wizards/source/tools/Misc.xba @@ -0,0 +1,817 @@ +<?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 + On Error Goto ErrorOcurred + oResSrv = createUnoService( "com.sun.star.resource.VclStringResourceLoader" ) + If (IsNull(oResSrv)) then + InitResources = FALSE + MsgBox( Description & ": No resource loader found", 16, GetProductName()) + Else + InitResources = TRUE + oResSrv.FileName = ShortDescription + 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.getString( 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>
\ No newline at end of file diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba new file mode 100644 index 000000000000..dc5ef02a5b7f --- /dev/null +++ b/wizards/source/tools/ModuleControls.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"> +<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 new file mode 100644 index 000000000000..a2a8907e02f2 --- /dev/null +++ b/wizards/source/tools/Strings.xba @@ -0,0 +1,452 @@ +<?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 new file mode 100644 index 000000000000..524afe60c4d9 --- /dev/null +++ b/wizards/source/tools/UCB.xba @@ -0,0 +1,294 @@ +<?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 new file mode 100644 index 000000000000..e69de29bb2d1 --- /dev/null +++ b/wizards/source/tools/delzip diff --git a/wizards/source/tools/dialog.xlb b/wizards/source/tools/dialog.xlb new file mode 100644 index 000000000000..dc8dfbda2701 --- /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/makefile.mk b/wizards/source/tools/makefile.mk new file mode 100644 index 000000000000..801db34b4c3f --- /dev/null +++ b/wizards/source/tools/makefile.mk @@ -0,0 +1,45 @@ +#************************************************************************* +# +# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +# +# Copyright 2000, 2010 Oracle and/or its affiliates. +# +# OpenOffice.org - a multi-platform office productivity suite +# +# This file is part of OpenOffice.org. +# +# OpenOffice.org is free software: you can redistribute it and/or modify +# it under the terms of the GNU Lesser General Public License version 3 +# only, as published by the Free Software Foundation. +# +# OpenOffice.org is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Lesser General Public License version 3 for more details +# (a copy is included in the LICENSE file that accompanied this code). +# +# You should have received a copy of the GNU Lesser General Public License +# version 3 along with OpenOffice.org. If not, see +# <http://www.openoffice.org/license.html> +# for a copy of the LGPLv3 License. +# +#************************************************************************* +PRJ=..$/.. + +PRJNAME=wizards +TARGET=tools + +# --- Settings ----------------------------------------------------- + +.INCLUDE : settings.mk +.INCLUDE : $(PRJ)$/util$/target.pmk + +# --- Files -------------------------------------------------------- + +ZIP1TARGET = $(TOOLS_ALL_TARGET) +ZIP1LIST = *.xdl *.xba *.xlb + +# --- Targets ------------------------------------------------------ + +.INCLUDE : target.mk + diff --git a/wizards/source/tools/script.xlb b/wizards/source/tools/script.xlb new file mode 100644 index 000000000000..fe4d74d60332 --- /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 |