summaryrefslogtreecommitdiffstats
path: root/wizards/source/tools/Misc.xba
diff options
context:
space:
mode:
Diffstat (limited to 'wizards/source/tools/Misc.xba')
-rw-r--r--wizards/source/tools/Misc.xba841
1 files changed, 841 insertions, 0 deletions
diff --git a/wizards/source/tools/Misc.xba b/wizards/source/tools/Misc.xba
new file mode 100644
index 000000000..9b9e1dba6
--- /dev/null
+++ b/wizards/source/tools/Misc.xba
@@ -0,0 +1,841 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<!--
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+-->
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Misc" script:language="StarBasic">REM ***** BASIC *****
+
+Const SBSHARE = 0
+Const SBUSER = 1
+Dim Taskindex as Integer
+Dim oResSrv as Object
+
+Sub Main()
+Dim PropList(3,1)&apos; as String
+ PropList(0,0) = &quot;URL&quot;
+ PropList(0,1) = &quot;sdbc:odbc:Erica_Test_Unicode&quot;
+ PropList(1,0) = &quot;User&quot;
+ PropList(1,1) = &quot;extra&quot;
+ PropList(2,0) = &quot;Password&quot;
+ PropList(2,1) = &quot;extra&quot;
+ PropList(3,0) = &quot;IsPasswordRequired&quot;
+ PropList(3,1) = True
+End Sub
+
+
+Function RegisterNewDataSource(DSName as String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
+Dim oDataSource as Object
+Dim oDBContext as Object
+Dim oPropInfo as Object
+Dim i as Integer
+ oDBContext = createUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
+ oDataSource = createUnoService(&quot;com.sun.star.sdb.DataSource&quot;)
+ For i = 0 To Ubound(PropertyList(), 1)
+ sPropName = PropertyList(i,0)
+ sPropValue = PropertyList(i,1)
+ oDataSource.SetPropertyValue(sPropName,sPropValue)
+ Next i
+ If Not IsMissing(DriverProperties()) Then
+ oDataSource.Info() = DriverProperties()
+ End If
+ oDBContext.RegisterObject(DSName, oDataSource)
+ RegisterNewDataSource () = oDataSource
+End Function
+
+
+&apos; Connects to a registered Database
+Function ConnecttoDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
+Dim oDBContext as Object
+Dim oDBSource as Object
+&apos; On Local Error Goto NOCONNECTION
+ oDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
+ If oDBContext.HasbyName(DSName) Then
+ oDBSource = oDBContext.GetByName(DSName)
+ ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
+ Else
+ If Not IsMissing(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(&quot;DataSource &quot; &amp; DSName &amp; &quot; is not registered&quot; , 16, GetProductname())
+ ConnectToDatabase() = NULL
+ End If
+ End If
+NOCONNECTION:
+ If Err &lt;&gt; 0 Then
+ Msgbox(Error$, 16, GetProductName())
+ Resume LEAVESUB
+ LEAVESUB:
+ End If
+End Function
+
+
+Function GetStarOfficeLocale() as New com.sun.star.lang.Locale
+Dim aLocLocale As New com.sun.star.lang.Locale
+Dim sLocale as String
+Dim sLocaleList(1)
+Dim oMasterKey
+ oMasterKey = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
+ sLocale = oMasterKey.getByName(&quot;ooLocale&quot;)
+ sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
+ aLocLocale.Language = sLocaleList(0)
+ If Ubound(sLocaleList()) &gt; 0 Then
+ aLocLocale.Country = sLocaleList(1)
+ End If
+ If Ubound(sLocaleList()) &gt; 1 Then
+ aLocLocale.Variant = sLocaleList(2)
+ End If
+ GetStarOfficeLocale() = aLocLocale
+End Function
+
+
+Function GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean)
+Dim oConfigProvider as Object
+Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
+ oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
+ aNodePath(0).Name = &quot;nodepath&quot;
+ aNodePath(0).Value = sKeyName
+ If IsMissing(bForUpdate) Then
+ GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
+ Else
+ If bForUpdate Then
+ GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
+ Else
+ GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
+ End If
+ End If
+End Function
+
+
+Function GetProductname() as String
+Dim oProdNameAccess as Object
+Dim sVersion as String
+Dim sProdName as String
+ oProdNameAccess = GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
+ sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
+ sVersion = oProdNameAccess.getByName(&quot;ooSetupVersion&quot;)
+ GetProductName = sProdName &amp; sVersion
+End Function
+
+
+&apos; Opens a Document, checks beforehand, whether it has to be loaded
+&apos; or whether it is already on the desktop.
+&apos; If the parameter bDisposable is set to False then the returned document
+&apos; should not be disposed afterwards, because it is already opened.
+Function OpenDocument(DocPath as String, Args(), Optional bDisposable as Boolean)
+Dim oComponents as Object
+Dim oComponent as Object
+ &apos; Search if one of the active Components is the one that you search for
+ oComponents = StarDesktop.Components.CreateEnumeration
+ While oComponents.HasmoreElements
+ oComponent = oComponents.NextElement
+ If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
+ If UCase(oComponent.URL) = UCase(DocPath) then
+ OpenDocument() = oComponent
+ If Not IsMissing(bDisposable) Then
+ bDisposable = False
+ End If
+ Exit Function
+ End If
+ End If
+ Wend
+ If Not IsMissing(bDisposable) Then
+ bDisposable = True
+ End If
+ OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,&quot;_default&quot;,0,Args())
+End Function
+
+
+Function TaskonDesktop(DocPath as String) as Boolean
+Dim oComponents as Object
+Dim oComponent as Object
+ &apos; Search if one of the active Components is the one that you search for
+ oComponents = StarDesktop.Components.CreateEnumeration
+ While oComponents.HasmoreElements
+ oComponent = oComponents.NextElement
+ If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
+ If UCase(oComponent.URL) = UCase(DocPath) then
+ TaskonDesktop = True
+ Exit Function
+ End If
+ End If
+ Wend
+ TaskonDesktop = False
+End Function
+
+
+&apos; Retrieves a FileName out of a StarOffice-Document
+Function RetrieveFileName(LocDoc as Object)
+Dim LocURL as String
+Dim LocURLArray() as String
+Dim MaxArrIndex as integer
+
+ LocURL = LocDoc.Url
+ LocURLArray() = ArrayoutofString(LocURL,&quot;/&quot;,MaxArrIndex)
+ RetrieveFileName = LocURLArray(MaxArrIndex)
+End Function
+
+
+&apos; Gets a special configured PathSetting
+Function GetPathSettings(sPathType as String, Optional bshowall as Boolean, Optional ListIndex as integer) as String
+Dim oSettings, oPathSettings as Object
+Dim sPath as String
+Dim PathList() as String
+Dim MaxIndex as Integer
+Dim oPS as Object
+
+ oPS = createUnoService(&quot;com.sun.star.util.PathSettings&quot;)
+
+ If Not IsMissing(bShowall) Then
+ If bShowAll Then
+ ShowPropertyValues(oPS)
+ Exit Function
+ End If
+ End If
+ sPath = oPS.getPropertyValue(sPathType)
+ If Not IsMissing(ListIndex) Then
+ &apos; Share and User-Directory
+ If Instr(1,sPath,&quot;;&quot;) &lt;&gt; 0 Then
+ PathList = ArrayoutofString(sPath,&quot;;&quot;, MaxIndex)
+ If ListIndex &lt;= MaxIndex Then
+ sPath = PathList(ListIndex)
+ Else
+ Msgbox(&quot;String Cannot be analyzed!&quot; &amp; sPath , 16, GetProductName())
+ End If
+ End If
+ End If
+ If Instr(1, sPath, &quot;;&quot;) = 0 Then
+ GetPathSettings = ConvertToUrl(sPath)
+ Else
+ GetPathSettings = sPath
+ End If
+
+End Function
+
+
+
+&apos; Gets the fully qualified path to a subdirectory of the
+&apos; Template Directory, e. g. with the parameter &quot;wizard/bitmap&quot;
+&apos; The parameter must be passed in Url notation
+&apos; The return-Value is in Url notation
+Function GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String)
+Dim sOfficeString as String
+Dim sOfficeList() as String
+Dim sOfficeDir as String
+Dim sBigDir as String
+Dim i as Integer
+Dim MaxIndex as Integer
+Dim oUcb as Object
+ oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ sOfficeString = GetPathSettings(sOfficePath)
+ If Right(sSubDir,1) &lt;&gt; &quot;/&quot; Then
+ sSubDir = sSubDir &amp; &quot;/&quot;
+ End If
+ sOfficeList() = ArrayoutofString(sOfficeString,&quot;;&quot;, MaxIndex)
+ For i = 0 To MaxIndex
+ sOfficeDir = ConvertToUrl(sOfficeList(i))
+ If Right(sOfficeDir,1) &lt;&gt; &quot;/&quot; Then
+ sOfficeDir = sOfficeDir &amp; &quot;/&quot;
+ End If
+ sBigDir = sOfficeDir &amp; sSubDir
+ If oUcb.Exists(sBigDir) Then
+ GetOfficeSubPath() = sBigDir
+ Exit Function
+ End If
+ Next i
+ ShowNoOfficePathError()
+ GetOfficeSubPath = &quot;&quot;
+End Function
+
+
+Sub ShowNoOfficePathError()
+Dim ProductName as String
+Dim sError as String
+Dim bResObjectexists as Boolean
+Dim oLocResSrv as Object
+ bResObjectexists = not IsNull(oResSrv)
+ If bResObjectexists Then
+ oLocResSrv = oResSrv
+ End If
+ If InitResources(&quot;Tools&quot;) Then
+ ProductName = GetProductName()
+ sError = GetResText(&quot;RID_COMMON_6&quot;)
+ sError = ReplaceString(sError, ProductName, &quot;%PRODUCTNAME&quot;)
+ sError = ReplaceString(sError, chr(13), &quot;&lt;BR&gt;&quot;)
+ MsgBox(sError, 16, ProductName)
+ End If
+ If bResObjectexists Then
+ oResSrv = oLocResSrv
+ End If
+
+End Sub
+
+
+Function InitResources(Description) as boolean
+Dim xResource as Object
+Dim sOfficeDir as String
+Dim aArgs(5) as Any
+ On Error Goto ErrorOcurred
+ sOfficeDir = &quot;$BRAND_BASE_DIR/$BRAND_SHARE_SUBDIR/wizards/&quot;
+ sOfficeDir = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.util.theMacroExpander&quot;).ExpandMacros(sOfficeDir)
+ aArgs(0) = sOfficeDir
+ aArgs(1) = true
+ aArgs(2) = GetStarOfficeLocale()
+ aArgs(3) = &quot;resources&quot;
+ aArgs(4) = &quot;&quot;
+ aArgs(5) = NULL
+ oResSrv = getProcessServiceManager().createInstanceWithArguments( &quot;com.sun.star.resource.StringResourceWithLocation&quot;, aArgs() )
+ If (IsNull(oResSrv)) then
+ InitResources = FALSE
+ MsgBox(&quot;could not initialize StringResourceWithLocation&quot;)
+ Else
+ InitResources = TRUE
+ End If
+ Exit Function
+ErrorOcurred:
+ Dim nSolarVer
+ InitResources = FALSE
+ nSolarVer = GetSolarVersion()
+ MsgBox(&quot;Resource file missing&quot;, 16, GetProductName())
+ Resume CLERROR
+ CLERROR:
+End Function
+
+
+Function GetResText( sID as String ) As string
+Dim sString as String
+ On Error Goto ErrorOcurred
+ If Not IsNull(oResSrv) Then
+ sString = oResSrv.resolveString(sID)
+ GetResText = ReplaceString(sString, GetProductname(), &quot;%PRODUCTNAME&quot;)
+ Else
+ GetResText = &quot;&quot;
+ End If
+ Exit Function
+ErrorOcurred:
+ GetResText = &quot;&quot;
+ MsgBox(&quot;Resource with ID =&quot; + sID + &quot; not found!&quot;, 16, GetProductName())
+ Resume CLERROR
+ CLERROR:
+End Function
+
+
+Function CutPathView(sDocUrl as String, Optional PathLen as Integer)
+Dim sViewPath as String
+Dim FileName as String
+Dim iFileLen as Integer
+ sViewPath = ConvertfromURL(sDocURL)
+ iViewPathLen = Len(sViewPath)
+ If iViewPathLen &gt; 60 Then
+ FileName = FileNameoutofPath(sViewPath, &quot;/&quot;)
+ iFileLen = Len(FileName)
+ If iFileLen &lt; 44 Then
+ sViewPath = Left(sViewPath,57-iFileLen-10) &amp; &quot;...&quot; &amp; Right(sViewPath,iFileLen + 10)
+ Else
+ sViewPath = Left(sViewPath,27) &amp; &quot; ... &quot; &amp; Right(sViewPath,28)
+ End If
+ End If
+ CutPathView = sViewPath
+End Function
+
+
+&apos; Deletes the content of all cells that are softformatted according
+&apos; to the &apos;InputStyleName&apos;
+Sub DeleteInputCells(oSheet as Object, InputStyleName as String)
+Dim oRanges as Object
+Dim oRange as Object
+ oRanges = oSheet.CellFormatRanges.createEnumeration
+ While oRanges.hasMoreElements
+ oRange = oRanges.NextElement
+ If Instr(1,oRange.CellStyle, InputStyleName) &lt;&gt; 0 Then
+ Call ReplaceRangeValues(oRange, &quot;&quot;)
+ End If
+ Wend
+End Sub
+
+
+&apos; Inserts a certain string to all cells of a range that is passed
+&apos; either as an object or as the RangeName
+Sub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String)
+Dim oCellRange as Object
+ If Vartype(Range) = 8 Then
+ &apos; Get the Range out of the Rangename
+ oCellRange = oSheet.GetCellRangeByName(Range)
+ Else
+ &apos; The range is passed as an object
+ Set oCellRange = Range
+ End If
+ If IsMissing(StyleName) Then
+ ReplaceRangeValues(oCellRange, ReplaceValue)
+ Else
+ If Instr(1,oCellRange.CellStyle,StyleName) Then
+ ReplaceRangeValues(oCellRange, ReplaceValue)
+ End If
+ End If
+End Sub
+
+
+Sub ReplaceRangeValues(oRange as Object, ReplaceValue)
+Dim oRangeAddress as Object
+Dim ColCount as Integer
+Dim RowCount as Integer
+Dim i as Integer
+ oRangeAddress = oRange.RangeAddress
+ ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn
+ RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow
+ Dim FillArray(RowCount) as Variant
+ Dim sLine(ColCount) as Variant
+ For i = 0 To ColCount
+ sLine(i) = ReplaceValue
+ Next i
+ For i = 0 To RowCount
+ FillArray(i) = sLine()
+ Next i
+ oRange.DataArray = FillArray()
+End Sub
+
+
+&apos; Returns the Value of the first cell of a Range
+Function GetValueofCellbyName(oSheet as Object, sCellName as String)
+Dim oCell as Object
+ oCell = GetCellByName(oSheet, sCellName)
+ GetValueofCellbyName = oCell.Value
+End Function
+
+
+Function DuplicateRow(oSheet as Object, RangeName as String)
+Dim oRange as Object
+Dim oCell as Object
+Dim oCellAddress as New com.sun.star.table.CellAddress
+Dim oRangeAddress as New com.sun.star.table.CellRangeAddress
+ oRange = oSheet.GetCellRangeByName(RangeName)
+ oRangeAddress = oRange.RangeAddress
+ oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow)
+ oCellAddress = oCell.CellAddress
+ oSheet.Rows.InsertByIndex(oCellAddress.Row,1)
+ oRangeAddress = oRange.RangeAddress
+ oSheet.CopyRange(oCellAddress, oRangeAddress)
+ DuplicateRow = oRangeAddress.StartRow-1
+End Function
+
+
+&apos; Returns the String of the first cell of a Range
+Function GetStringofCellbyName(oSheet as Object, sCellName as String)
+Dim oCell as Object
+ oCell = GetCellByName(oSheet, sCellName)
+ GetStringofCellbyName = oCell.String
+End Function
+
+
+&apos; Returns a named Cell
+Function GetCellByName(oSheet as Object, sCellName as String) as Object
+Dim oCellRange as Object
+Dim oCellAddress as Object
+ oCellRange = oSheet.GetCellRangeByName(sCellName)
+ oCellAddress = oCellRange.RangeAddress
+ GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
+End Function
+
+
+&apos; Changes the numeric Value of a cell by transmitting the String of the numeric Value
+Sub ChangeCellValue(oCell as Object, ValueString as String)
+Dim CellValue
+ oCell.Formula = &quot;=Value(&quot; &amp; &quot;&quot;&quot;&quot; &amp; ValueString &amp; &quot;&quot;&quot;&quot; &amp; &quot;)&quot;
+ CellValue = oCell.Value
+ oCell.Formula = &quot;&quot;
+ oCell.Value = CellValue
+End Sub
+
+
+Function GetDocumentType(oDocument)
+ On Local Error GoTo NODOCUMENTTYPE
+&apos; ShowSupportedServiceNames(oDocument)
+ If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
+ GetDocumentType() = &quot;scalc&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.text.TextDocument&quot;) Then
+ GetDocumentType() = &quot;swriter&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.drawing.DrawingDocument&quot;) Then
+ GetDocumentType() = &quot;sdraw&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.presentation.PresentationDocument&quot;) Then
+ GetDocumentType() = &quot;simpress&quot;
+ ElseIf oDocument.SupportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
+ GetDocumentType() = &quot;smath&quot;
+ End If
+ NODOCUMENTTYPE:
+ If Err &lt;&gt; 0 Then
+ GetDocumentType = &quot;&quot;
+ Resume GOON
+ GOON:
+ End If
+End Function
+
+
+Function GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer
+Dim ThisFormatKey as Long
+Dim oObjectFormat as Object
+ On Local Error Goto NOFORMAT
+ ThisFormatKey = oFormatObject.NumberFormat
+ oObjectFormat = oDocFormats.GetByKey(ThisFormatKey)
+ GetNumberFormatType = oObjectFormat.Type
+ NOFORMAT:
+ If Err &lt;&gt; 0 Then
+ Msgbox(&quot;Numberformat of Object is not available!&quot;, 16, GetProductName())
+ GetNumberFormatType = 0
+ GOTO NOERROR
+ End If
+ NOERROR:
+ On Local Error Goto 0
+End Function
+
+
+Sub ProtectSheets(Optional oSheets as Object)
+Dim i as Integer
+Dim oDocSheets as Object
+ If IsMissing(oSheets) Then
+ oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
+ Else
+ Set oDocSheets = oSheets
+ End If
+
+ For i = 0 To oDocSheets.Count-1
+ oDocSheets(i).Protect(&quot;&quot;)
+ Next i
+End Sub
+
+
+Sub UnprotectSheets(Optional oSheets as Object)
+Dim i as Integer
+Dim oDocSheets as Object
+ If IsMissing(oSheets) Then
+ oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
+ Else
+ Set oDocSheets = oSheets
+ End If
+
+ For i = 0 To oDocSheets.Count-1
+ oDocSheets(i).Unprotect(&quot;&quot;)
+ Next i
+End Sub
+
+
+Function GetRowIndex(oSheet as Object, RowName as String)
+Dim oRange as Object
+ oRange = oSheet.GetCellRangeByName(RowName)
+ GetRowIndex = oRange.RangeAddress.StartRow
+End Function
+
+
+Function GetColumnIndex(oSheet as Object, ColName as String)
+Dim oRange as Object
+ oRange = oSheet.GetCellRangeByName(ColName)
+ GetColumnIndex = oRange.RangeAddress.StartColumn
+End Function
+
+
+Function CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object
+Dim oSheet as Object
+Dim Count as Integer
+Dim BasicSheetName as String
+
+ BasicSheetName = NewName
+ &apos; Copy the last table. Assumption: The last table is the template
+ On Local Error Goto RENAMESHEET
+ oSheets.CopybyName(OldName, NewName, DestPos)
+
+RENAMESHEET:
+ oSheet = oSheets(DestPos)
+ If Err &lt;&gt; 0 Then
+ &apos; Test if renaming failed
+ Count = 2
+ Do While oSheet.Name &lt;&gt; NewName
+ NewName = BasicSheetName &amp; &quot;_&quot; &amp; Count
+ oSheet.Name = NewName
+ Count = Count + 1
+ Loop
+ Resume CL_ERROR
+CL_ERROR:
+ End If
+ CopySheetbyName = oSheet
+End Function
+
+
+&apos; Dis-or enables a Window and adjusts the mousepointer accordingly
+Sub ToggleWindow(bDoEnable as Boolean)
+Dim oWindow as Object
+ oWindow = StarDesktop.CurrentFrame.ComponentWindow
+ oWindow.Enable = bDoEnable
+End Sub
+
+
+Function CheckNewSheetname(oSheets as Object, Sheetname as String, Optional oLocale) as String
+Dim nStartFlags as Long
+Dim nContFlags as Long
+Dim oCharService as Object
+Dim iSheetNameLength as Integer
+Dim iResultPos as Integer
+Dim WrongChar as String
+Dim oResult as Object
+ nStartFlags = com.sun.star.i18n.KParseTokens.ANY_LETTER_OR_NUMBER + com.sun.star.i18n.KParseTokens.ASC_UNDERSCORE
+ nContFlags = nStartFlags
+ oCharService = CreateUnoService(&quot;com.sun.star.i18n.CharacterClassification&quot;)
+ iSheetNameLength = Len(SheetName)
+ If IsMissing(oLocale) Then
+ oLocale = ThisComponent.CharLocale
+ End If
+ Do
+ oResult =oCharService.parsePredefinedToken(com.sun.star.i18n.KParseType.IDENTNAME, SheetName, 0, oLocale, nStartFlags, &quot;&quot;, nContFlags, &quot; &quot;)
+ iResultPos = oResult.EndPos
+ If iResultPos &lt; iSheetNameLength Then
+ WrongChar = Mid(SheetName, iResultPos+1,1)
+ SheetName = ReplaceString(SheetName,&quot;_&quot;, WrongChar)
+ End If
+ Loop Until iResultPos = iSheetNameLength
+ CheckNewSheetname = SheetName
+End Function
+
+
+Sub AddNewSheetName(oSheets as Object, ByVal SheetName as String)
+Dim Count as Integer
+Dim bSheetIsThere as Boolean
+Dim iSheetNameLength as Integer
+ iSheetNameLength = Len(SheetName)
+ Count = 2
+ Do
+ bSheetIsThere = oSheets.HasByName(SheetName)
+ If bSheetIsThere Then
+ SheetName = Right(SheetName,iSheetNameLength) &amp; &quot;_&quot; &amp; Count
+ Count = Count + 1
+ End If
+ Loop Until Not bSheetIsThere
+ AddNewSheetname = SheetName
+End Sub
+
+
+Function GetSheetIndex(oSheets, sName) as Integer
+Dim i as Integer
+ For i = 0 To oSheets.Count-1
+ If oSheets(i).Name = sName Then
+ GetSheetIndex = i
+ exit Function
+ End If
+ Next i
+ GetSheetIndex = -1
+End Function
+
+
+Function GetLastUsedRow(oSheet as Object) as Long
+Dim oCell As Object
+Dim oCursor As Object
+Dim aAddress As Variant
+ oCell = oSheet.GetCellbyPosition(0, 0)
+ oCursor = oSheet.createCursorByRange(oCell)
+ oCursor.GotoEndOfUsedArea(True)
+ aAddress = oCursor.RangeAddress
+ GetLastUsedRow = aAddress.EndRow
+End Function
+
+
+&apos; Note To set a one lined frame you have to set the inner width to 0
+&apos; In the API all Units that refer to pt-Heights are &quot;1/100mm&quot;
+&apos; The convert factor from 1pt to 1/100 mm is approximately 35
+Function ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer)
+Dim aBorder as New com.sun.star.table.BorderLine
+ aBorder = oStyleBorder
+ aBorder.InnerLineWidth = iInnerLineWidth
+ aBorder.OuterLineWidth = iOuterLineWidth
+ ModifyBorderLineWidth = aBorder
+End Function
+
+
+Sub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String)
+Dim PropValue(1) as new com.sun.star.beans.PropertyValue
+ PropValue(0).Name = &quot;EventType&quot;
+ PropValue(0).Value = &quot;StarBasic&quot;
+ PropValue(1).Name = &quot;Script&quot;
+ PropValue(1).Value = &quot;macro:///&quot; &amp; SubPath
+ oDocument.Events.ReplaceByName(EventName, PropValue())
+End Sub
+
+
+
+Function ModifyPropertyValue(oContent() as New com.sun.star.beans.PropertyValue, TargetProperties() as New com.sun.star.beans.PropertyValue)
+Dim MaxIndex as Integer
+Dim i as Integer
+Dim a as Integer
+ MaxIndex = Ubound(oContent())
+ bDoReplace = False
+ For i = 0 To MaxIndex
+ a = GetPropertyValueIndex(oContent(i).Name, TargetProperties())
+ If a &lt;&gt; -1 Then
+ If Vartype(TargetProperties(a).Value) &lt;&gt; 9 Then
+ If TargetProperties(a).Value &lt;&gt; oContent(i).Value Then
+ oContent(i).Value = TargetProperties(a).Value
+ bDoReplace = True
+ End If
+ Else
+ If Not EqualUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then
+ oContent(i).Value = TargetProperties(a).Value
+ bDoReplace = True
+ End If
+ End If
+ End If
+ Next i
+ ModifyPropertyValue() = bDoReplace
+End Function
+
+
+Function GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue ) as Integer
+Dim i as Integer
+ For i = 0 To Ubound(TargetProperties())
+ If Searchname = TargetProperties(i).Name Then
+ GetPropertyValueIndex = i
+ Exit Function
+ End If
+ Next i
+ GetPropertyValueIndex() = -1
+End Function
+
+
+Sub DispatchSlot(SlotID as Integer)
+Dim oArg() as new com.sun.star.beans.PropertyValue
+Dim oUrl as new com.sun.star.util.URL
+Dim oTrans as Object
+Dim oDisp as Object
+ oTrans = createUNOService(&quot;com.sun.star.util.URLTransformer&quot;)
+ oUrl.Complete = &quot;slot:&quot; &amp; CStr(SlotID)
+ oTrans.parsestrict(oUrl)
+ oDisp = StarDesktop.ActiveFrame.queryDispatch(oUrl, &quot;_self&quot;, 0)
+ oDisp.dispatch(oUrl, oArg())
+End Sub
+
+
+&apos;returns the type of the office application
+&apos;FatOffice = 0, WebTop = 1
+&apos;This routine has to be changed if the Product Name is being changed!
+Function IsFatOffice() As Boolean
+ If sProductname = &quot;&quot; Then
+ sProductname = GetProductname()
+ End If
+ IsFatOffice = TRUE
+ &apos;The following line has to include the current productname
+ If Instr(1,sProductname,&quot;WebTop&quot;,1) &lt;&gt; 0 Then
+ IsFatOffice = FALSE
+ End If
+End Function
+
+
+Sub ToggleDesignMode(oDocument as Object)
+Dim aSwitchMode as new com.sun.star.util.URL
+ aSwitchMode.Complete = &quot;.uno:SwitchControlDesignMode&quot;
+ aTransformer = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
+ aTransformer.parseStrict(aSwitchMode)
+ oFrame = oDocument.currentController.Frame
+ oDispatch = oFrame.queryDispatch(aSwitchMode, oFrame.Name, 63)
+ Dim aEmptyArgs() as New com.sun.star.bean.PropertyValue
+ oDispatch.dispatch(aSwitchMode, aEmptyArgs())
+ Erase aSwitchMode
+End Sub
+
+
+Function isHighContrast(oPeer as Object)
+ Dim UIColor as Long
+ Dim myRed as Integer
+ Dim myGreen as Integer
+ Dim myBlue as Integer
+ Dim myLuminance as Double
+
+ UIColor = oPeer.getProperty( &quot;DisplayBackgroundColor&quot; )
+ myRed = Red (UIColor)
+ myGreen = Green (UIColor)
+ myBlue = Blue (UIColor)
+ myLuminance = (( myBlue*28 + myGreen*151 + myRed*77 ) / 256 )
+ isHighContrast = false
+ If myLuminance &lt;= 25 Then isHighContrast = true
+End Function
+
+
+Function CreateNewDocument(sType as String, Optional sAddMsg as String) as Object
+Dim NoArgs() as new com.sun.star.beans.PropertyValue
+Dim oDocument as Object
+Dim sUrl as String
+Dim ErrMsg as String
+ On Local Error Goto NOMODULEINSTALLED
+ sUrl = &quot;private:factory/&quot; &amp; sType
+ oDocument = StarDesktop.LoadComponentFromURL(sUrl,&quot;_default&quot;,0, NoArgs())
+NOMODULEINSTALLED:
+ If (Err &lt;&gt; 0) OR IsNull(oDocument) Then
+ If InitResources(&quot;&quot;) Then
+ Select Case sType
+ Case &quot;swriter&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_1&quot;)
+ Case &quot;scalc&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_2&quot;)
+ Case &quot;simpress&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_3&quot;)
+ Case &quot;sdraw&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_4&quot;)
+ Case &quot;smath&quot;
+ ErrMsg = GetResText(&quot;RID_COMMON_5&quot;)
+ Case Else
+ ErrMsg = &quot;Invalid Document Type!&quot;
+ End Select
+ ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
+ If Not IsMissing(sAddMsg) Then
+ ErrMsg = ErrMsg &amp; chr(13) &amp; sAddMsg
+ End If
+ Msgbox(ErrMsg, 48, GetProductName())
+ End If
+ If Err &lt;&gt; 0 Then
+ Resume GOON
+ End If
+ End If
+GOON:
+ CreateNewDocument = oDocument
+End Function
+
+
+&apos; This Sub has been used in order to ensure that after disposing a document
+&apos; from the backing window it is returned to the backing window, so the
+&apos; office won&apos;t be closed
+Sub DisposeDocument(oDocument as Object)
+Dim dispatcher as Object
+Dim parser as Object
+Dim disp as Object
+Dim url as new com.sun.star.util.URL
+Dim NoArgs() as New com.sun.star.beans.PropertyValue
+Dim oFrame as Object
+ If Not IsNull(oDocument) Then
+ oDocument.setModified(false)
+ parser = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
+ url.Complete = &quot;.uno:CloseDoc&quot;
+ parser.parseStrict(url)
+ oFrame = oDocument.CurrentController.Frame
+ disp = oFrame.queryDispatch(url,&quot;_self&quot;, com.sun.star.util.SearchFlags.NORM_WORD_ONLY)
+ disp.dispatch(url, NoArgs())
+ End If
+End Sub
+
+&apos;Function to calculate if the year is a leap year
+Function CalIsLeapYear(ByVal iYear as Integer) as Boolean
+ CalIsLeapYear = ((iYear Mod 4 = 0) And ((iYear Mod 100 &lt;&gt; 0) Or (iYear Mod 400 = 0)))
+End Function
+</script:module>