xref: /trunk/main/wizards/source/tools/Misc.xba (revision d219bd27)
1cdf0e10cSrcweir<?xml version="1.0" encoding="UTF-8"?>
2cdf0e10cSrcweir<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
33e02b54dSAndrew Rist<!--***********************************************************
43e02b54dSAndrew Rist *
53e02b54dSAndrew Rist * Licensed to the Apache Software Foundation (ASF) under one
63e02b54dSAndrew Rist * or more contributor license agreements.  See the NOTICE file
73e02b54dSAndrew Rist * distributed with this work for additional information
83e02b54dSAndrew Rist * regarding copyright ownership.  The ASF licenses this file
93e02b54dSAndrew Rist * to you under the Apache License, Version 2.0 (the
103e02b54dSAndrew Rist * "License"); you may not use this file except in compliance
113e02b54dSAndrew Rist * with the License.  You may obtain a copy of the License at
123e02b54dSAndrew Rist *
133e02b54dSAndrew Rist *   http://www.apache.org/licenses/LICENSE-2.0
143e02b54dSAndrew Rist *
153e02b54dSAndrew Rist * Unless required by applicable law or agreed to in writing,
163e02b54dSAndrew Rist * software distributed under the License is distributed on an
173e02b54dSAndrew Rist * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
183e02b54dSAndrew Rist * KIND, either express or implied.  See the License for the
193e02b54dSAndrew Rist * specific language governing permissions and limitations
203e02b54dSAndrew Rist * under the License.
213e02b54dSAndrew Rist *
223e02b54dSAndrew Rist ***********************************************************-->
23cdf0e10cSrcweir<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Misc" script:language="StarBasic">REM  *****  BASIC  *****
24cdf0e10cSrcweir
25cdf0e10cSrcweirConst SBSHARE = 0
26cdf0e10cSrcweirConst SBUSER = 1
27cdf0e10cSrcweirDim Taskindex as Integer
28cdf0e10cSrcweirDim oResSrv as Object
29cdf0e10cSrcweir
30cdf0e10cSrcweirSub Main()
31cdf0e10cSrcweirDim PropList(3,1)&apos; as String
32cdf0e10cSrcweir	PropList(0,0) = &quot;URL&quot;
33cdf0e10cSrcweir	PropList(0,1) = &quot;sdbc:odbc:Erica_Test_Unicode&quot;
34cdf0e10cSrcweir	PropList(1,0) = &quot;User&quot;
35cdf0e10cSrcweir	PropList(1,1) = &quot;extra&quot;
36cdf0e10cSrcweir	PropList(2,0) = &quot;Password&quot;
37cdf0e10cSrcweir	PropList(2,1) = &quot;extra&quot;
38cdf0e10cSrcweir	PropList(3,0) = &quot;IsPasswordRequired&quot;
39cdf0e10cSrcweir	PropList(3,1) = True
40cdf0e10cSrcweirEnd Sub
41cdf0e10cSrcweir
42cdf0e10cSrcweir
43cdf0e10cSrcweirFunction RegisterNewDataSource(DSName as  String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
44cdf0e10cSrcweirDim oDataSource as Object
45cdf0e10cSrcweirDim oDBContext as Object
46cdf0e10cSrcweirDim oPropInfo as Object
47cdf0e10cSrcweirDim i as Integer
48cdf0e10cSrcweir    oDBContext = createUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
49cdf0e10cSrcweir    oDataSource = createUnoService(&quot;com.sun.star.sdb.DataSource&quot;)
50cdf0e10cSrcweir	For i = 0 To Ubound(PropertyList(), 1)
51cdf0e10cSrcweir		sPropName = PropertyList(i,0)
52cdf0e10cSrcweir		sPropValue = PropertyList(i,1)
53cdf0e10cSrcweir		oDataSource.SetPropertyValue(sPropName,sPropValue)
54cdf0e10cSrcweir	Next i
55cdf0e10cSrcweir	If Not IsMissing(DriverProperties()) Then
56cdf0e10cSrcweir		oDataSource.Info() = DriverProperties()
57cdf0e10cSrcweir	End If
58cdf0e10cSrcweir    oDBContext.RegisterObject(DSName, oDataSource)
59cdf0e10cSrcweir	RegisterNewDataSource () = oDataSource
60cdf0e10cSrcweirEnd Function
61cdf0e10cSrcweir
62cdf0e10cSrcweir
63cdf0e10cSrcweir&apos; Connects to a registered Database
64cdf0e10cSrcweirFunction ConnecttoDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
65cdf0e10cSrcweirDim oDBContext as Object
66cdf0e10cSrcweirDim oDBSource as Object
67cdf0e10cSrcweir&apos;	On Local Error Goto NOCONNECTION
68cdf0e10cSrcweir	oDBContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
69cdf0e10cSrcweir	If oDBContext.HasbyName(DSName) Then
70cdf0e10cSrcweir		oDBSource = oDBContext.GetByName(DSName)
71cdf0e10cSrcweir		ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
72cdf0e10cSrcweir	Else
73cdf0e10cSrcweir		If Not IsMissing(Namelist()) Then
74cdf0e10cSrcweir			If Not IsMissing(DriverProperties()) Then
75cdf0e10cSrcweir				RegisterNewDataSource(DSName, PropertyList(), DriverProperties())
76cdf0e10cSrcweir			Else
77cdf0e10cSrcweir				RegisterNewDataSource(DSName, PropertyList())
78cdf0e10cSrcweir			End If
79cdf0e10cSrcweir			oDBSource = oDBContext.GetByName(DSName)
80cdf0e10cSrcweir			ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
81cdf0e10cSrcweir		Else
82cdf0e10cSrcweir			Msgbox(&quot;DataSource &quot; &amp; DSName &amp; &quot; is not registered&quot; , 16, GetProductname())
83cdf0e10cSrcweir			ConnectToDatabase() = NULL
84cdf0e10cSrcweir		End If
85cdf0e10cSrcweir	End If
86cdf0e10cSrcweirNOCONNECTION:
87cdf0e10cSrcweir	If Err &lt;&gt; 0 Then
88cdf0e10cSrcweir		Msgbox(Error$, 16, GetProductName())
89cdf0e10cSrcweir		Resume LEAVESUB
90cdf0e10cSrcweir		LEAVESUB:
91cdf0e10cSrcweir	End If
92cdf0e10cSrcweirEnd Function
93cdf0e10cSrcweir
94cdf0e10cSrcweir
95cdf0e10cSrcweirFunction GetStarOfficeLocale() as New com.sun.star.lang.Locale
96cdf0e10cSrcweirDim aLocLocale As New com.sun.star.lang.Locale
97cdf0e10cSrcweirDim sLocale as String
98cdf0e10cSrcweirDim sLocaleList(1)
99cdf0e10cSrcweirDim oMasterKey
100cdf0e10cSrcweir	oMasterKey = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
101cdf0e10cSrcweir	sLocale = oMasterKey.getByName(&quot;ooLocale&quot;)
102cdf0e10cSrcweir	sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
103cdf0e10cSrcweir	aLocLocale.Language = sLocaleList(0)
104cdf0e10cSrcweir	If Ubound(sLocaleList()) &gt; 0 Then
105cdf0e10cSrcweir		aLocLocale.Country = sLocaleList(1)
106cdf0e10cSrcweir	End If
107cdf0e10cSrcweir	GetStarOfficeLocale() = aLocLocale
108cdf0e10cSrcweirEnd Function
109cdf0e10cSrcweir
110cdf0e10cSrcweir
111cdf0e10cSrcweirFunction GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean)
112cdf0e10cSrcweirDim oConfigProvider as Object
113cdf0e10cSrcweirDim aNodePath(0) as new com.sun.star.beans.PropertyValue
114cdf0e10cSrcweir	oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
115cdf0e10cSrcweir	aNodePath(0).Name = &quot;nodepath&quot;
116cdf0e10cSrcweir	aNodePath(0).Value = sKeyName
117cdf0e10cSrcweir	If IsMissing(bForUpdate) Then
118cdf0e10cSrcweir		GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
119cdf0e10cSrcweir	Else
120cdf0e10cSrcweir		If bForUpdate Then
121cdf0e10cSrcweir			GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
122cdf0e10cSrcweir		Else
123cdf0e10cSrcweir			GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
124cdf0e10cSrcweir		End If
125cdf0e10cSrcweir	End If
126cdf0e10cSrcweirEnd Function
127cdf0e10cSrcweir
128cdf0e10cSrcweir
129cdf0e10cSrcweirFunction GetProductname() as String
130cdf0e10cSrcweirDim oProdNameAccess as Object
131cdf0e10cSrcweirDim sVersion as String
132cdf0e10cSrcweirDim sProdName as String
133cdf0e10cSrcweir	oProdNameAccess = GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
134cdf0e10cSrcweir	sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
135cdf0e10cSrcweir	sVersion = oProdNameAccess.getByName(&quot;ooSetupVersion&quot;)
136*d219bd27SBidouille	GetProductName = sProdName &amp; &quot; &quot; &amp; sVersion
137cdf0e10cSrcweirEnd Function
138cdf0e10cSrcweir
139cdf0e10cSrcweir
14074cbd1f1SMatthias Seidel&apos; Opens a Document, checks beforehand, whether it has to be loaded
14174cbd1f1SMatthias Seidel&apos; or whether it is already on the desktop.
142cdf0e10cSrcweir&apos; If the parameter bDisposable is set to False then then returned document
143cdf0e10cSrcweir&apos; should not be disposed afterwards, because it is already opened.
144cdf0e10cSrcweirFunction OpenDocument(DocPath as String, Args(), Optional bDisposable as Boolean)
145cdf0e10cSrcweirDim oComponents as Object
146cdf0e10cSrcweirDim oComponent as Object
147cdf0e10cSrcweir	&apos; Search if one of the active Components ist the one that you search for
148cdf0e10cSrcweir	oComponents = StarDesktop.Components.CreateEnumeration
149cdf0e10cSrcweir	While oComponents.HasmoreElements
150cdf0e10cSrcweir		oComponent = oComponents.NextElement
151cdf0e10cSrcweir		If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
152cdf0e10cSrcweir			If UCase(oComponent.URL) = UCase(DocPath) then
153cdf0e10cSrcweir				OpenDocument() = oComponent
154cdf0e10cSrcweir				If Not IsMissing(bDisposable) Then
155cdf0e10cSrcweir					bDisposable = False
156cdf0e10cSrcweir				End If
157cdf0e10cSrcweir				Exit Function
158cdf0e10cSrcweir			End If
159cdf0e10cSrcweir		End If
160cdf0e10cSrcweir	Wend
161cdf0e10cSrcweir	If Not IsMissing(bDisposable) Then
162cdf0e10cSrcweir		bDisposable = True
163cdf0e10cSrcweir	End If
164cdf0e10cSrcweir	OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,&quot;_default&quot;,0,Args())
165cdf0e10cSrcweirEnd Function
166cdf0e10cSrcweir
167cdf0e10cSrcweir
168cdf0e10cSrcweirFunction TaskonDesktop(DocPath as String) as Boolean
169cdf0e10cSrcweirDim oComponents as Object
170cdf0e10cSrcweirDim oComponent as Object
171cdf0e10cSrcweir	&apos; Search if one of the active Components ist the one that you search for
172cdf0e10cSrcweir	oComponents = StarDesktop.Components.CreateEnumeration
173cdf0e10cSrcweir	While oComponents.HasmoreElements
174cdf0e10cSrcweir		oComponent = oComponents.NextElement
175cdf0e10cSrcweir  	  	If hasUnoInterfaces(oComponent,&quot;com.sun.star.frame.XModel&quot;) then
176cdf0e10cSrcweir			If UCase(oComponent.URL) = UCase(DocPath) then
177cdf0e10cSrcweir				TaskonDesktop = True
178cdf0e10cSrcweir				Exit Function
179cdf0e10cSrcweir			End If
180cdf0e10cSrcweir		End If
181cdf0e10cSrcweir	Wend
182cdf0e10cSrcweir	TaskonDesktop = False
183cdf0e10cSrcweirEnd Function
184cdf0e10cSrcweir
185cdf0e10cSrcweir
186cdf0e10cSrcweir&apos; Retrieves a FileName out of a StarOffice-Document
187cdf0e10cSrcweirFunction RetrieveFileName(LocDoc as Object)
188cdf0e10cSrcweirDim LocURL as String
189cdf0e10cSrcweirDim LocURLArray() as String
190cdf0e10cSrcweirDim MaxArrIndex as integer
191cdf0e10cSrcweir
192cdf0e10cSrcweir	LocURL = LocDoc.Url
193cdf0e10cSrcweir	LocURLArray() = ArrayoutofString(LocURL,&quot;/&quot;,MaxArrIndex)
194cdf0e10cSrcweir	RetrieveFileName = LocURLArray(MaxArrIndex)
195cdf0e10cSrcweirEnd Function
196cdf0e10cSrcweir
197cdf0e10cSrcweir
198cdf0e10cSrcweir&apos; Gets a special configured PathSetting
199cdf0e10cSrcweirFunction GetPathSettings(sPathType as String,  Optional bshowall as Boolean, Optional ListIndex as integer) as String
200cdf0e10cSrcweirDim oSettings, oPathSettings as Object
201cdf0e10cSrcweirDim sPath as String
202cdf0e10cSrcweirDim PathList() as String
203cdf0e10cSrcweirDim MaxIndex as Integer
204cdf0e10cSrcweirDim oPS as Object
205cdf0e10cSrcweir
206cdf0e10cSrcweir	oPS = createUnoService(&quot;com.sun.star.util.PathSettings&quot;)
207cdf0e10cSrcweir
208cdf0e10cSrcweir  	If Not IsMissing(bShowall) Then
209cdf0e10cSrcweir		If bShowAll Then
210cdf0e10cSrcweir			ShowPropertyValues(oPS)
211cdf0e10cSrcweir			Exit Function
212cdf0e10cSrcweir		End If
213cdf0e10cSrcweir	End If
214cdf0e10cSrcweir 	sPath = oPS.getPropertyValue(sPathType)
215cdf0e10cSrcweir	If Not IsMissing(ListIndex) Then
216cdf0e10cSrcweir		&apos; Share and User-Directory
217cdf0e10cSrcweir		If Instr(1,sPath,&quot;;&quot;) &lt;&gt; 0 Then
218cdf0e10cSrcweir			PathList = ArrayoutofString(sPath,&quot;;&quot;, MaxIndex)
219cdf0e10cSrcweir			If ListIndex &lt;= MaxIndex Then
220cdf0e10cSrcweir				sPath = PathList(ListIndex)
221cdf0e10cSrcweir			Else
222cdf0e10cSrcweir				Msgbox(&quot;String Cannot be analyzed!&quot; &amp; sPath , 16, GetProductName())
223cdf0e10cSrcweir			End If
224cdf0e10cSrcweir		End If
225cdf0e10cSrcweir	End If
226cdf0e10cSrcweir	If Instr(1, sPath, &quot;;&quot;) = 0 Then
227cdf0e10cSrcweir		GetPathSettings = ConvertToUrl(sPath)
228cdf0e10cSrcweir	Else
229cdf0e10cSrcweir		GetPathSettings = sPath
230cdf0e10cSrcweir	End If
231cdf0e10cSrcweir
232cdf0e10cSrcweirEnd Function
233cdf0e10cSrcweir
234cdf0e10cSrcweir
235cdf0e10cSrcweir
236cdf0e10cSrcweir&apos; Gets the fully qualified path to a subdirectory of the
237cdf0e10cSrcweir&apos; Template Directory, e. g. with the parameter &quot;wizard/bitmap&quot;
238cdf0e10cSrcweir&apos; The parameter must be passed over in Url-scription
239cdf0e10cSrcweir&apos; The return-Value is in Urlscription
240cdf0e10cSrcweirFunction GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String)
241cdf0e10cSrcweirDim sOfficeString as String
242cdf0e10cSrcweirDim sOfficeList() as String
243cdf0e10cSrcweirDim sOfficeDir as String
244cdf0e10cSrcweirDim sBigDir as String
245cdf0e10cSrcweirDim i as Integer
246cdf0e10cSrcweirDim MaxIndex as Integer
247cdf0e10cSrcweirDim oUcb as Object
248cdf0e10cSrcweir	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
249cdf0e10cSrcweir	sOfficeString = GetPathSettings(sOfficePath)
250cdf0e10cSrcweir	If Right(sSubDir,1) &lt;&gt; &quot;/&quot; Then
251cdf0e10cSrcweir		sSubDir = sSubDir &amp; &quot;/&quot;
252cdf0e10cSrcweir	End If
253cdf0e10cSrcweir	sOfficeList() = ArrayoutofString(sOfficeString,&quot;;&quot;, MaxIndex)
254cdf0e10cSrcweir	For i = 0 To MaxIndex
255cdf0e10cSrcweir		sOfficeDir = ConvertToUrl(sOfficeList(i))
256cdf0e10cSrcweir		If Right(sOfficeDir,1) &lt;&gt; &quot;/&quot; Then
257cdf0e10cSrcweir			sOfficeDir = sOfficeDir &amp; &quot;/&quot;
258cdf0e10cSrcweir		End If
259cdf0e10cSrcweir		sBigDir = sOfficeDir &amp; sSubDir
260cdf0e10cSrcweir		If oUcb.Exists(sBigDir) Then
261cdf0e10cSrcweir			GetOfficeSubPath() = sBigDir
262cdf0e10cSrcweir			Exit Function
263cdf0e10cSrcweir		End If
264cdf0e10cSrcweir	Next i
265cdf0e10cSrcweir	ShowNoOfficePathError()
266cdf0e10cSrcweir	GetOfficeSubPath = &quot;&quot;
267cdf0e10cSrcweirEnd Function
268cdf0e10cSrcweir
269cdf0e10cSrcweir
270cdf0e10cSrcweirSub ShowNoOfficePathError()
271cdf0e10cSrcweirDim ProductName as String
272cdf0e10cSrcweirDim sError as String
273cdf0e10cSrcweirDim bResObjectexists as Boolean
274cdf0e10cSrcweirDim oLocResSrv as Object
275cdf0e10cSrcweir	bResObjectexists = not IsNull(oResSrv)
276cdf0e10cSrcweir	If bResObjectexists Then
277cdf0e10cSrcweir		oLocResSrv = oResSrv
278cdf0e10cSrcweir	End If
279cdf0e10cSrcweir	If InitResources(&quot;Tools&quot;, &quot;com&quot;) Then
280cdf0e10cSrcweir		ProductName = GetProductName()
281cdf0e10cSrcweir		sError = GetResText(1006)
282cdf0e10cSrcweir		sError = ReplaceString(sError, ProductName, &quot;%PRODUCTNAME&quot;)
283cdf0e10cSrcweir		sError = ReplaceString(sError, chr(13), &quot;&lt;BR&gt;&quot;)
284cdf0e10cSrcweir		MsgBox(sError, 16, ProductName)
285cdf0e10cSrcweir	End If
286cdf0e10cSrcweir	If bResObjectexists Then
287cdf0e10cSrcweir		oResSrv = oLocResSrv
288cdf0e10cSrcweir	End If
289cdf0e10cSrcweir
290cdf0e10cSrcweirEnd Sub
291cdf0e10cSrcweir
292cdf0e10cSrcweir
293cdf0e10cSrcweirFunction InitResources(Description, ShortDescription as String) as boolean
294cdf0e10cSrcweir	On Error Goto ErrorOcurred
295cdf0e10cSrcweir	oResSrv = createUnoService( &quot;com.sun.star.resource.VclStringResourceLoader&quot; )
296cdf0e10cSrcweir	If (IsNull(oResSrv)) then
297cdf0e10cSrcweir		InitResources = FALSE
298cdf0e10cSrcweir		MsgBox( Description &amp; &quot;: No resource loader found&quot;, 16, GetProductName())
299cdf0e10cSrcweir	Else
300cdf0e10cSrcweir		InitResources = TRUE
301cdf0e10cSrcweir		oResSrv.FileName = ShortDescription
302cdf0e10cSrcweir	End If
303cdf0e10cSrcweir	Exit Function
304cdf0e10cSrcweirErrorOcurred:
305cdf0e10cSrcweir	Dim nSolarVer
306cdf0e10cSrcweir	InitResources = FALSE
307cdf0e10cSrcweir	nSolarVer = GetSolarVersion()
308cdf0e10cSrcweir	MsgBox(&quot;Resource file missing (&quot; &amp; ShortDescription  &amp; trim(str(nSolarVer)) + &quot;*.res)&quot;, 16, GetProductName())
309cdf0e10cSrcweir	Resume CLERROR
310cdf0e10cSrcweir	CLERROR:
311cdf0e10cSrcweirEnd Function
312cdf0e10cSrcweir
313cdf0e10cSrcweir
314cdf0e10cSrcweirFunction GetResText( nID as integer ) As string
315cdf0e10cSrcweir	On Error Goto ErrorOcurred
316cdf0e10cSrcweir	If Not IsNull(oResSrv) Then
317cdf0e10cSrcweir		GetResText = oResSrv.getString( nID )
318cdf0e10cSrcweir	Else
319cdf0e10cSrcweir		GetResText = &quot;&quot;
320cdf0e10cSrcweir	End If
321cdf0e10cSrcweir	Exit Function
322cdf0e10cSrcweirErrorOcurred:
323cdf0e10cSrcweir	GetResText = &quot;&quot;
324cdf0e10cSrcweir	MsgBox(&quot;Resource with ID =&quot; + str( nID ) + &quot; not found!&quot;, 16, GetProductName())
325cdf0e10cSrcweir	Resume CLERROR
326cdf0e10cSrcweir	CLERROR:
327cdf0e10cSrcweirEnd Function
328cdf0e10cSrcweir
329cdf0e10cSrcweir
330cdf0e10cSrcweirFunction CutPathView(sDocUrl as String, Optional PathLen as Integer)
331cdf0e10cSrcweirDim sViewPath as String
332cdf0e10cSrcweirDim FileName as String
333cdf0e10cSrcweirDim iFileLen as Integer
334cdf0e10cSrcweir	sViewPath = ConvertfromURL(sDocURL)
335cdf0e10cSrcweir	iViewPathLen = Len(sViewPath)
336cdf0e10cSrcweir	If iViewPathLen &gt; 60 Then
337cdf0e10cSrcweir		FileName = FileNameoutofPath(sViewPath, &quot;/&quot;)
338cdf0e10cSrcweir		iFileLen = Len(FileName)
339cdf0e10cSrcweir		If iFileLen &lt; 44 Then
340cdf0e10cSrcweir			sViewPath = Left(sViewPath,57-iFileLen-10) &amp; &quot;...&quot; &amp; Right(sViewPath,iFileLen + 10)
341cdf0e10cSrcweir		Else
342cdf0e10cSrcweir			sViewPath = Left(sViewPath,27) &amp; &quot; ... &quot; &amp; Right(sViewPath,28)
343cdf0e10cSrcweir		End If
344cdf0e10cSrcweir	End If
345cdf0e10cSrcweir	CutPathView = sViewPath
346cdf0e10cSrcweirEnd Function
347cdf0e10cSrcweir
348cdf0e10cSrcweir
349cdf0e10cSrcweir&apos; Deletes the content of all cells that are softformatted according
350cdf0e10cSrcweir&apos; to the &apos;InputStyleName&apos;
351cdf0e10cSrcweirSub DeleteInputCells(oSheet as Object, InputStyleName as String)
352cdf0e10cSrcweirDim oRanges as Object
353cdf0e10cSrcweirDim oRange as Object
354cdf0e10cSrcweir	oRanges = oSheet.CellFormatRanges.createEnumeration
355cdf0e10cSrcweir	While oRanges.hasMoreElements
356cdf0e10cSrcweir		oRange = oRanges.NextElement
357cdf0e10cSrcweir		If Instr(1,oRange.CellStyle, InputStyleName) &lt;&gt; 0 Then
358cdf0e10cSrcweir			Call ReplaceRangeValues(oRange, &quot;&quot;)
359cdf0e10cSrcweir		End If
360cdf0e10cSrcweir	Wend
361cdf0e10cSrcweirEnd Sub
362cdf0e10cSrcweir
363cdf0e10cSrcweir
364cdf0e10cSrcweir&apos; Inserts a certain String to all cells of a Range that ist passed over
365cdf0e10cSrcweir&apos; either as an object or as the RangeName
366cdf0e10cSrcweirSub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String)
367cdf0e10cSrcweirDim oCellRange as Object
368cdf0e10cSrcweir	If Vartype(Range) = 8 Then
369cdf0e10cSrcweir		&apos; Get the Range out of the Rangename
370cdf0e10cSrcweir		oCellRange = oSheet.GetCellRangeByName(Range)
371cdf0e10cSrcweir	Else
372cdf0e10cSrcweir		&apos; The range is passed over as an object
373cdf0e10cSrcweir		Set oCellRange = Range
374cdf0e10cSrcweir	End If
375cdf0e10cSrcweir	If IsMissing(StyleName) Then
376cdf0e10cSrcweir		ReplaceRangeValues(oCellRange, ReplaceValue)
377cdf0e10cSrcweir	Else
378cdf0e10cSrcweir		If Instr(1,oCellRange.CellStyle,StyleName) Then
379cdf0e10cSrcweir			ReplaceRangeValues(oCellRange, ReplaceValue)
380cdf0e10cSrcweir		End If
381cdf0e10cSrcweir	End If
382cdf0e10cSrcweirEnd Sub
383cdf0e10cSrcweir
384cdf0e10cSrcweir
385cdf0e10cSrcweirSub ReplaceRangeValues(oRange as Object, ReplaceValue)
386cdf0e10cSrcweirDim oRangeAddress as Object
387cdf0e10cSrcweirDim ColCount as Integer
388cdf0e10cSrcweirDim RowCount as Integer
389cdf0e10cSrcweirDim i as Integer
390cdf0e10cSrcweir	oRangeAddress = oRange.RangeAddress
391cdf0e10cSrcweir	ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn
392cdf0e10cSrcweir	RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow
393cdf0e10cSrcweir	Dim FillArray(RowCount) as Variant
394cdf0e10cSrcweir	Dim sLine(ColCount) as Variant
395cdf0e10cSrcweir	For i = 0 To ColCount
396cdf0e10cSrcweir		sLine(i) = ReplaceValue
397cdf0e10cSrcweir	Next i
398cdf0e10cSrcweir	For i = 0 To RowCount
399cdf0e10cSrcweir		FillArray(i) = sLine()
400cdf0e10cSrcweir	Next i
401cdf0e10cSrcweir	oRange.DataArray = FillArray()
402cdf0e10cSrcweirEnd Sub
403cdf0e10cSrcweir
404cdf0e10cSrcweir
405cdf0e10cSrcweir&apos; Returns the Value of the first cell of a Range
406cdf0e10cSrcweirFunction GetValueofCellbyName(oSheet as Object, sCellName as String)
407cdf0e10cSrcweirDim oCell as Object
408cdf0e10cSrcweir	oCell = GetCellByName(oSheet, sCellName)
409cdf0e10cSrcweir	GetValueofCellbyName = oCell.Value
410cdf0e10cSrcweirEnd Function
411cdf0e10cSrcweir
412cdf0e10cSrcweir
413cdf0e10cSrcweirFunction DuplicateRow(oSheet as Object, RangeName as String)
414cdf0e10cSrcweirDim oRange as Object
415cdf0e10cSrcweirDim oCell as Object
416cdf0e10cSrcweirDim oCellAddress as New com.sun.star.table.CellAddress
417cdf0e10cSrcweirDim oRangeAddress as New com.sun.star.table.CellRangeAddress
418cdf0e10cSrcweir	oRange = oSheet.GetCellRangeByName(RangeName)
419cdf0e10cSrcweir	oRangeAddress = oRange.RangeAddress
420cdf0e10cSrcweir	oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow)
421cdf0e10cSrcweir	oCellAddress = oCell.CellAddress
422cdf0e10cSrcweir	oSheet.Rows.InsertByIndex(oCellAddress.Row,1)
423cdf0e10cSrcweir	oRangeAddress = oRange.RangeAddress
424cdf0e10cSrcweir	oSheet.CopyRange(oCellAddress, oRangeAddress)
425cdf0e10cSrcweir	DuplicateRow = oRangeAddress.StartRow-1
426cdf0e10cSrcweirEnd Function
427cdf0e10cSrcweir
428cdf0e10cSrcweir
429cdf0e10cSrcweir&apos; Returns the String of the first cell of a Range
430cdf0e10cSrcweirFunction GetStringofCellbyName(oSheet as Object, sCellName as String)
431cdf0e10cSrcweirDim oCell as Object
432cdf0e10cSrcweir	oCell = GetCellByName(oSheet, sCellName)
433cdf0e10cSrcweir	GetStringofCellbyName = oCell.String
434cdf0e10cSrcweirEnd Function
435cdf0e10cSrcweir
436cdf0e10cSrcweir
437cdf0e10cSrcweir&apos; Returns a named Cell
438cdf0e10cSrcweirFunction GetCellByName(oSheet as Object, sCellName as String) as Object
439cdf0e10cSrcweirDim oCellRange as Object
440cdf0e10cSrcweirDim oCellAddress as Object
441cdf0e10cSrcweir	oCellRange = oSheet.GetCellRangeByName(sCellName)
442cdf0e10cSrcweir	oCellAddress = oCellRange.RangeAddress
443cdf0e10cSrcweir	GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
444cdf0e10cSrcweirEnd Function
445cdf0e10cSrcweir
446cdf0e10cSrcweir
447cdf0e10cSrcweir&apos; Changes the numeric Value of a cell by transmitting the String of the numeric Value
448cdf0e10cSrcweirSub ChangeCellValue(oCell as Object, ValueString as String)
449cdf0e10cSrcweirDim CellValue
450cdf0e10cSrcweir	oCell.Formula = &quot;=Value(&quot; &amp; &quot;&quot;&quot;&quot; &amp; ValueString &amp; &quot;&quot;&quot;&quot; &amp; &quot;)&quot;
451cdf0e10cSrcweir	CellValue = oCell.Value
452cdf0e10cSrcweir	oCell.Formula = &quot;&quot;
453cdf0e10cSrcweir	oCell.Value = CellValue
454cdf0e10cSrcweirEnd Sub
455cdf0e10cSrcweir
456cdf0e10cSrcweir
457cdf0e10cSrcweirFunction GetDocumentType(oDocument)
458cdf0e10cSrcweir	On Local Error GoTo NODOCUMENTTYPE
459cdf0e10cSrcweir&apos;	ShowSupportedServiceNames(oDocument)
460cdf0e10cSrcweir	If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
461cdf0e10cSrcweir		GetDocumentType() = &quot;scalc&quot;
462cdf0e10cSrcweir	ElseIf oDocument.SupportsService(&quot;com.sun.star.text.TextDocument&quot;) Then
463cdf0e10cSrcweir		GetDocumentType() = &quot;swriter&quot;
464cdf0e10cSrcweir	ElseIf oDocument.SupportsService(&quot;com.sun.star.drawing.DrawingDocument&quot;) Then
465cdf0e10cSrcweir		GetDocumentType() = &quot;sdraw&quot;
466cdf0e10cSrcweir	ElseIf oDocument.SupportsService(&quot;com.sun.star.presentation.PresentationDocument&quot;) Then
467cdf0e10cSrcweir		GetDocumentType() = &quot;simpress&quot;
468cdf0e10cSrcweir	ElseIf oDocument.SupportsService(&quot;com.sun.star.formula.FormulaProperties&quot;) Then
469cdf0e10cSrcweir		GetDocumentType() = &quot;smath&quot;
470cdf0e10cSrcweir	End If
471cdf0e10cSrcweir	NODOCUMENTTYPE:
472cdf0e10cSrcweir	If Err &lt;&gt; 0 Then
473cdf0e10cSrcweir		GetDocumentType = &quot;&quot;
474cdf0e10cSrcweir		Resume GOON
475cdf0e10cSrcweir		GOON:
476cdf0e10cSrcweir	End If
477cdf0e10cSrcweirEnd Function
478cdf0e10cSrcweir
479cdf0e10cSrcweir
480cdf0e10cSrcweirFunction GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer
481cdf0e10cSrcweirDim ThisFormatKey as Long
482cdf0e10cSrcweirDim oObjectFormat as Object
483cdf0e10cSrcweir	On Local Error Goto NOFORMAT
484cdf0e10cSrcweir	ThisFormatKey = oFormatObject.NumberFormat
485cdf0e10cSrcweir	oObjectFormat = oDocFormats.GetByKey(ThisFormatKey)
486cdf0e10cSrcweir	GetNumberFormatType = oObjectFormat.Type
487cdf0e10cSrcweir	NOFORMAT:
488cdf0e10cSrcweir	If Err &lt;&gt; 0 Then
489cdf0e10cSrcweir		Msgbox(&quot;Numberformat of Object is not available!&quot;, 16, GetProductName())
490cdf0e10cSrcweir		GetNumberFormatType = 0
491cdf0e10cSrcweir		GOTO NOERROR
492cdf0e10cSrcweir	End If
493cdf0e10cSrcweir	NOERROR:
494cdf0e10cSrcweir	On Local Error Goto 0
495cdf0e10cSrcweirEnd Function
496cdf0e10cSrcweir
497cdf0e10cSrcweir
498cdf0e10cSrcweirSub ProtectSheets(Optional oSheets as Object)
499cdf0e10cSrcweirDim i as Integer
500cdf0e10cSrcweirDim oDocSheets as Object
501cdf0e10cSrcweir	If IsMissing(oSheets) Then
502cdf0e10cSrcweir		oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
503cdf0e10cSrcweir	Else
504cdf0e10cSrcweir		Set oDocSheets = oSheets
505cdf0e10cSrcweir	End If
506cdf0e10cSrcweir
507cdf0e10cSrcweir	For i = 0 To oDocSheets.Count-1
508cdf0e10cSrcweir		oDocSheets(i).Protect(&quot;&quot;)
509cdf0e10cSrcweir	Next i
510cdf0e10cSrcweirEnd Sub
511cdf0e10cSrcweir
512cdf0e10cSrcweir
513cdf0e10cSrcweirSub UnprotectSheets(Optional oSheets as Object)
514cdf0e10cSrcweirDim i as Integer
515cdf0e10cSrcweirDim oDocSheets as Object
516cdf0e10cSrcweir	If IsMissing(oSheets) Then
517cdf0e10cSrcweir		oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
518cdf0e10cSrcweir	Else
519cdf0e10cSrcweir		Set oDocSheets = oSheets
520cdf0e10cSrcweir	End If
521cdf0e10cSrcweir
522cdf0e10cSrcweir	For i = 0 To oDocSheets.Count-1
523cdf0e10cSrcweir		oDocSheets(i).Unprotect(&quot;&quot;)
524cdf0e10cSrcweir	Next i
525cdf0e10cSrcweirEnd Sub
526cdf0e10cSrcweir
527cdf0e10cSrcweir
528cdf0e10cSrcweirFunction GetRowIndex(oSheet as Object, RowName as String)
529cdf0e10cSrcweirDim oRange as Object
530cdf0e10cSrcweir	oRange = oSheet.GetCellRangeByName(RowName)
531cdf0e10cSrcweir	GetRowIndex = oRange.RangeAddress.StartRow
532cdf0e10cSrcweirEnd Function
533cdf0e10cSrcweir
534cdf0e10cSrcweir
535cdf0e10cSrcweirFunction GetColumnIndex(oSheet as Object, ColName as String)
536cdf0e10cSrcweirDim oRange as Object
537cdf0e10cSrcweir	oRange = oSheet.GetCellRangeByName(ColName)
538cdf0e10cSrcweir	GetColumnIndex = oRange.RangeAddress.StartColumn
539cdf0e10cSrcweirEnd Function
540cdf0e10cSrcweir
541cdf0e10cSrcweir
542cdf0e10cSrcweirFunction CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object
543cdf0e10cSrcweirDim oSheet as Object
544cdf0e10cSrcweirDim Count as Integer
545cdf0e10cSrcweirDim BasicSheetName as String
546cdf0e10cSrcweir
547cdf0e10cSrcweir	BasicSheetName = NewName
548cdf0e10cSrcweir	&apos; Copy the last table. Assumption: The last table is the template
549cdf0e10cSrcweir	On Local Error Goto RENAMESHEET
550cdf0e10cSrcweir	oSheets.CopybyName(OldName, NewName, DestPos)
551cdf0e10cSrcweir
552cdf0e10cSrcweirRENAMESHEET:
553cdf0e10cSrcweir	oSheet = oSheets(DestPos)
554cdf0e10cSrcweir	If Err &lt;&gt; 0 Then
555cdf0e10cSrcweir		&apos; Test if renaming failed
556cdf0e10cSrcweir		Count = 2
557cdf0e10cSrcweir		Do While oSheet.Name &lt;&gt; NewName
558cdf0e10cSrcweir			NewName = BasicSheetName &amp; &quot;_&quot; &amp; Count
559cdf0e10cSrcweir			oSheet.Name = NewName
560cdf0e10cSrcweir			Count = Count + 1
561cdf0e10cSrcweir		Loop
562cdf0e10cSrcweir		Resume CL_ERROR
563cdf0e10cSrcweirCL_ERROR:
564cdf0e10cSrcweir	End If
565cdf0e10cSrcweir	CopySheetbyName = oSheet
566cdf0e10cSrcweirEnd Function
567cdf0e10cSrcweir
568cdf0e10cSrcweir
569cdf0e10cSrcweir&apos; Dis-or enables a Window and adjusts the mousepointer accordingly
570cdf0e10cSrcweirSub ToggleWindow(bDoEnable as Boolean)
571cdf0e10cSrcweirDim oWindow as Object
572cdf0e10cSrcweir	oWindow = StarDesktop.CurrentFrame.ComponentWindow
573cdf0e10cSrcweir	oWindow.Enable = bDoEnable
574cdf0e10cSrcweirEnd Sub
575cdf0e10cSrcweir
576cdf0e10cSrcweir
577cdf0e10cSrcweirFunction CheckNewSheetname(oSheets as Object, Sheetname as String, Optional oLocale) as String
578cdf0e10cSrcweirDim nStartFlags as Long
579cdf0e10cSrcweirDim nContFlags as Long
580cdf0e10cSrcweirDim oCharService as Object
581cdf0e10cSrcweirDim iSheetNameLength as Integer
582cdf0e10cSrcweirDim iResultPos as Integer
583cdf0e10cSrcweirDim WrongChar as String
584cdf0e10cSrcweirDim oResult as Object
585cdf0e10cSrcweir	nStartFlags = com.sun.star.i18n.KParseTokens.ANY_LETTER_OR_NUMBER + com.sun.star.i18n.KParseTokens.ASC_UNDERSCORE
586cdf0e10cSrcweir	nContFlags = nStartFlags
587cdf0e10cSrcweir	oCharService = CreateUnoService(&quot;com.sun.star.i18n.CharacterClassification&quot;)
588cdf0e10cSrcweir	iSheetNameLength = Len(SheetName)
589cdf0e10cSrcweir	If IsMissing(oLocale) Then
590cdf0e10cSrcweir		oLocale = ThisComponent.CharLocale
591cdf0e10cSrcweir	End If
592cdf0e10cSrcweir	Do
593cdf0e10cSrcweir		oResult =oCharService.parsePredefinedToken(com.sun.star.i18n.KParseType.IDENTNAME, SheetName, 0, oLocale, nStartFlags, &quot;&quot;, nContFlags, &quot; &quot;)
594cdf0e10cSrcweir		iResultPos = oResult.EndPos
595cdf0e10cSrcweir		If iResultPos &lt; iSheetNameLength Then
596cdf0e10cSrcweir			WrongChar = Mid(SheetName, iResultPos+1,1)
597cdf0e10cSrcweir			SheetName = ReplaceString(SheetName,&quot;_&quot;, WrongChar)
598cdf0e10cSrcweir		End If
599cdf0e10cSrcweir	Loop Until iResultPos = iSheetNameLength
600cdf0e10cSrcweir	CheckNewSheetname = SheetName
601cdf0e10cSrcweirEnd Function
602cdf0e10cSrcweir
603cdf0e10cSrcweir
604cdf0e10cSrcweirSub AddNewSheetName(oSheets as Object, ByVal SheetName as String)
605cdf0e10cSrcweirDim Count as Integer
606cdf0e10cSrcweirDim bSheetIsThere as Boolean
607cdf0e10cSrcweirDim iSheetNameLength as Integer
608cdf0e10cSrcweir	iSheetNameLength = Len(SheetName)
609cdf0e10cSrcweir	Count = 2
610cdf0e10cSrcweir	Do
611cdf0e10cSrcweir		bSheetIsThere = oSheets.HasByName(SheetName)
612cdf0e10cSrcweir		If bSheetIsThere Then
613cdf0e10cSrcweir			SheetName = Right(SheetName,iSheetNameLength) &amp; &quot;_&quot; &amp; Count
614cdf0e10cSrcweir			Count = Count + 1
615cdf0e10cSrcweir		End If
616cdf0e10cSrcweir	Loop Until Not bSheetIsThere
617cdf0e10cSrcweir	AddNewSheetname = SheetName
618cdf0e10cSrcweirEnd Sub
619cdf0e10cSrcweir
620cdf0e10cSrcweir
621cdf0e10cSrcweirFunction GetSheetIndex(oSheets, sName) as Integer
622cdf0e10cSrcweirDim i as Integer
623cdf0e10cSrcweir	For i = 0 To oSheets.Count-1
624cdf0e10cSrcweir		If oSheets(i).Name = sName Then
625cdf0e10cSrcweir			GetSheetIndex = i
626cdf0e10cSrcweir			exit Function
627cdf0e10cSrcweir		End If
628cdf0e10cSrcweir	Next i
629cdf0e10cSrcweir	GetSheetIndex = -1
630cdf0e10cSrcweirEnd Function
631cdf0e10cSrcweir
632cdf0e10cSrcweir
633cdf0e10cSrcweirFunction GetLastUsedRow(oSheet as Object) as Integer
634cdf0e10cSrcweirDim oCell As Object
635cdf0e10cSrcweirDim oCursor As Object
636cdf0e10cSrcweirDim aAddress As Variant
637cdf0e10cSrcweir	oCell = oSheet.GetCellbyPosition(0, 0)
638cdf0e10cSrcweir	oCursor = oSheet.createCursorByRange(oCell)
639cdf0e10cSrcweir	oCursor.GotoEndOfUsedArea(True)
640cdf0e10cSrcweir	aAddress = oCursor.RangeAddress
641cdf0e10cSrcweir	GetLastUsedRow = aAddress.EndRow
642cdf0e10cSrcweirEnd Function
643cdf0e10cSrcweir
644cdf0e10cSrcweir
645cdf0e10cSrcweir&apos; Note To set a one lined frame you have to set the inner width to 0
646cdf0e10cSrcweir&apos; In the API all Units that refer to pt-Heights are &quot;1/100mm&quot;
647cdf0e10cSrcweir&apos; The convert factor from 1pt to 1/100 mm is approximately 35
648cdf0e10cSrcweirFunction ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer)
649cdf0e10cSrcweirDim aBorder as New com.sun.star.table.BorderLine
650cdf0e10cSrcweir	aBorder = oStyleBorder
651cdf0e10cSrcweir	aBorder.InnerLineWidth = iInnerLineWidth
652cdf0e10cSrcweir	aBorder.OuterLineWidth = iOuterLineWidth
653cdf0e10cSrcweir	ModifyBorderLineWidth = aBorder
654cdf0e10cSrcweirEnd Function
655cdf0e10cSrcweir
656cdf0e10cSrcweir
657cdf0e10cSrcweirSub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String)
658cdf0e10cSrcweirDim PropValue(1) as new com.sun.star.beans.PropertyValue
659cdf0e10cSrcweir	PropValue(0).Name = &quot;EventType&quot;
660cdf0e10cSrcweir	PropValue(0).Value = &quot;StarBasic&quot;
661cdf0e10cSrcweir	PropValue(1).Name = &quot;Script&quot;
662cdf0e10cSrcweir	PropValue(1).Value = &quot;macro:///&quot; &amp; SubPath
663cdf0e10cSrcweir	oDocument.Events.ReplaceByName(EventName, PropValue())
664cdf0e10cSrcweirEnd Sub
665cdf0e10cSrcweir
666cdf0e10cSrcweir
667cdf0e10cSrcweir
668cdf0e10cSrcweirFunction ModifyPropertyValue(oContent() as New com.sun.star.beans.PropertyValue, TargetProperties() as New com.sun.star.beans.PropertyValue)
669cdf0e10cSrcweirDim MaxIndex as Integer
670cdf0e10cSrcweirDim i as Integer
671cdf0e10cSrcweirDim a as Integer
672cdf0e10cSrcweir	MaxIndex = Ubound(oContent())
673cdf0e10cSrcweir	bDoReplace = False
674cdf0e10cSrcweir	For i = 0 To MaxIndex
675cdf0e10cSrcweir		a = GetPropertyValueIndex(oContent(i).Name, TargetProperties())
676cdf0e10cSrcweir		If a &lt;&gt; -1 Then
677cdf0e10cSrcweir			If Vartype(TargetProperties(a).Value) &lt;&gt; 9 Then
678cdf0e10cSrcweir				If TargetProperties(a).Value &lt;&gt; oContent(i).Value Then
679cdf0e10cSrcweir					oContent(i).Value = TargetProperties(a).Value
680cdf0e10cSrcweir					bDoReplace = True
681cdf0e10cSrcweir				End If
682cdf0e10cSrcweir			Else
683cdf0e10cSrcweir				If Not EqualUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then
684cdf0e10cSrcweir					oContent(i).Value = TargetProperties(a).Value
685cdf0e10cSrcweir					bDoReplace = True
686cdf0e10cSrcweir				End If
687cdf0e10cSrcweir			End If
688cdf0e10cSrcweir		End If
689cdf0e10cSrcweir	Next i
690cdf0e10cSrcweir	ModifyPropertyValue() = bDoReplace
691cdf0e10cSrcweirEnd Function
692cdf0e10cSrcweir
693cdf0e10cSrcweir
694cdf0e10cSrcweirFunction GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue ) as Integer
695cdf0e10cSrcweirDim i as Integer
696cdf0e10cSrcweir	For i = 0 To Ubound(TargetProperties())
697cdf0e10cSrcweir		If Searchname = TargetProperties(i).Name Then
698cdf0e10cSrcweir			GetPropertyValueIndex = i
699cdf0e10cSrcweir			Exit Function
700cdf0e10cSrcweir		End If
701cdf0e10cSrcweir	Next i
702cdf0e10cSrcweir	GetPropertyValueIndex() = -1
703cdf0e10cSrcweirEnd Function
704cdf0e10cSrcweir
705cdf0e10cSrcweir
706cdf0e10cSrcweirSub DispatchSlot(SlotID as Integer)
707cdf0e10cSrcweirDim oArg() as new com.sun.star.beans.PropertyValue
708cdf0e10cSrcweirDim oUrl as new com.sun.star.util.URL
709cdf0e10cSrcweirDim oTrans as Object
710cdf0e10cSrcweirDim oDisp as Object
711cdf0e10cSrcweir	oTrans = createUNOService(&quot;com.sun.star.util.URLTransformer&quot;)
712cdf0e10cSrcweir	oUrl.Complete = &quot;slot:&quot; &amp; CStr(SlotID)
713cdf0e10cSrcweir	oTrans.parsestrict(oUrl)
714cdf0e10cSrcweir	oDisp = StarDesktop.ActiveFrame.queryDispatch(oUrl, &quot;_self&quot;, 0)
715cdf0e10cSrcweir	oDisp.dispatch(oUrl, oArg())
716cdf0e10cSrcweirEnd Sub
717cdf0e10cSrcweir
718cdf0e10cSrcweir
719cdf0e10cSrcweir&apos;returns the type of the office application
720cdf0e10cSrcweir&apos;FatOffice = 0, WebTop = 1
721cdf0e10cSrcweir&apos;This routine has to be changed if the Product Name is being changed!
722cdf0e10cSrcweirFunction IsFatOffice() As Boolean
723cdf0e10cSrcweir  If sProductname = &quot;&quot; Then
724cdf0e10cSrcweir    sProductname = GetProductname()
725cdf0e10cSrcweir  End If
726cdf0e10cSrcweir  IsFatOffice = TRUE
727cdf0e10cSrcweir  &apos;The following line has to include the current productname
728cdf0e10cSrcweir  If Instr(1,sProductname,&quot;WebTop&quot;,1) &lt;&gt; 0 Then
729cdf0e10cSrcweir    IsFatOffice = FALSE
730cdf0e10cSrcweir  End If
731cdf0e10cSrcweirEnd Function
732cdf0e10cSrcweir
733cdf0e10cSrcweir
734cdf0e10cSrcweirFunction GetLocale(sLanguage as String, sCountry as String)
735cdf0e10cSrcweirDim oLocale as New com.sun.star.lang.Locale
736cdf0e10cSrcweir	oLocale.Language = sLanguage
737cdf0e10cSrcweir	oLocale.Country = sCountry
738cdf0e10cSrcweir	GetLocale = oLocale
739cdf0e10cSrcweirEnd Function
740cdf0e10cSrcweir
741cdf0e10cSrcweir
742cdf0e10cSrcweirSub ToggleDesignMode(oDocument as Object)
743cdf0e10cSrcweirDim aSwitchMode as new com.sun.star.util.URL
744cdf0e10cSrcweir	aSwitchMode.Complete = &quot;.uno:SwitchControlDesignMode&quot;
745cdf0e10cSrcweir	aTransformer = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
746cdf0e10cSrcweir	aTransformer.parseStrict(aSwitchMode)
747cdf0e10cSrcweir	oFrame = oDocument.currentController.Frame
748cdf0e10cSrcweir	oDispatch = oFrame.queryDispatch(aSwitchMode, oFrame.Name, 63)
749cdf0e10cSrcweir        Dim aEmptyArgs() as New com.sun.star.bean.PropertyValue
750cdf0e10cSrcweir	oDispatch.dispatch(aSwitchMode, aEmptyArgs())
751cdf0e10cSrcweir	Erase aSwitchMode
752cdf0e10cSrcweirEnd Sub
753cdf0e10cSrcweir
754cdf0e10cSrcweir
755cdf0e10cSrcweirFunction isHighContrast(oPeer as Object)
756cdf0e10cSrcweir	Dim UIColor as Long
757cdf0e10cSrcweir	Dim myRed as Integer
758cdf0e10cSrcweir	Dim myGreen as Integer
759cdf0e10cSrcweir	Dim myBlue as Integer
760cdf0e10cSrcweir	Dim myLuminance as Double
761cdf0e10cSrcweir
762cdf0e10cSrcweir	UIColor = oPeer.getProperty( &quot;DisplayBackgroundColor&quot; )
763cdf0e10cSrcweir	myRed = Red (UIColor)
764cdf0e10cSrcweir	myGreen = Green (UIColor)
765cdf0e10cSrcweir	myBlue = Blue (UIColor)
766cdf0e10cSrcweir	myLuminance = (( myBlue*28 + myGreen*151 + myRed*77 ) / 256	)
767cdf0e10cSrcweir	isHighContrast = false
768cdf0e10cSrcweir	If myLuminance &lt;= 25 Then isHighContrast = true
769cdf0e10cSrcweirEnd Function
770cdf0e10cSrcweir
771cdf0e10cSrcweir
772cdf0e10cSrcweirFunction CreateNewDocument(sType as String, Optional sAddMsg as String) as Object
773cdf0e10cSrcweirDim NoArgs() as new com.sun.star.beans.PropertyValue
774cdf0e10cSrcweirDim oDocument as Object
775cdf0e10cSrcweirDim sUrl as String
776cdf0e10cSrcweirDim ErrMsg as String
777cdf0e10cSrcweir	On Local Error Goto NOMODULEINSTALLED
778cdf0e10cSrcweir	sUrl = &quot;private:factory/&quot; &amp; sType
779cdf0e10cSrcweir	oDocument = StarDesktop.LoadComponentFromURL(sUrl,&quot;_default&quot;,0, NoArgs())
780cdf0e10cSrcweirNOMODULEINSTALLED:
781cdf0e10cSrcweir	If (Err &lt;&gt; 0) OR IsNull(oDocument) Then
782cdf0e10cSrcweir		If InitResources(&quot;&quot;, &quot;com&quot;) Then
783cdf0e10cSrcweir			Select Case sType
784cdf0e10cSrcweir				Case &quot;swriter&quot;
785cdf0e10cSrcweir					ErrMsg = GetResText(1001)
786cdf0e10cSrcweir				Case &quot;scalc&quot;
787cdf0e10cSrcweir					ErrMsg = GetResText(1002)
788cdf0e10cSrcweir				Case &quot;simpress&quot;
789cdf0e10cSrcweir					ErrMsg = GetResText(1003)
790cdf0e10cSrcweir				Case &quot;sdraw&quot;
791cdf0e10cSrcweir					ErrMsg = GetResText(1004)
792cdf0e10cSrcweir				Case &quot;smath&quot;
793cdf0e10cSrcweir					ErrMsg = GetResText(1005)
794cdf0e10cSrcweir				Case Else
795cdf0e10cSrcweir					ErrMsg = &quot;Invalid Document Type!&quot;
796cdf0e10cSrcweir			End Select
797cdf0e10cSrcweir			ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
798cdf0e10cSrcweir			If Not IsMissing(sAddMsg) Then
799cdf0e10cSrcweir				ErrMsg = ErrMsg &amp; chr(13) &amp; sAddMsg
800cdf0e10cSrcweir			End If
801cdf0e10cSrcweir			Msgbox(ErrMsg, 48, GetProductName())
802cdf0e10cSrcweir		End If
803cdf0e10cSrcweir		If Err &lt;&gt; 0 Then
804cdf0e10cSrcweir			Resume GOON
805cdf0e10cSrcweir		End If
806cdf0e10cSrcweir	End If
807cdf0e10cSrcweirGOON:
808cdf0e10cSrcweir	CreateNewDocument = oDocument
809cdf0e10cSrcweirEnd Function
810cdf0e10cSrcweir
811cdf0e10cSrcweir
812cdf0e10cSrcweir&apos; This Sub has been used in order to ensure that after disposing a document
813cdf0e10cSrcweir&apos; from the backing window it is returned to the backing window, so the
814cdf0e10cSrcweir&apos; office won&apos;t be closed
815cdf0e10cSrcweirSub DisposeDocument(oDocument as Object)
816cdf0e10cSrcweirDim dispatcher as Object
817cdf0e10cSrcweirDim parser as Object
818cdf0e10cSrcweirDim disp as Object
819cdf0e10cSrcweirDim url	as new com.sun.star.util.URL
820cdf0e10cSrcweirDim NoArgs() as New com.sun.star.beans.PropertyValue
821cdf0e10cSrcweirDim oFrame as Object
822cdf0e10cSrcweir	If Not IsNull(oDocument) Then
823cdf0e10cSrcweir		oDocument.setModified(false)
824cdf0e10cSrcweir		parser   = createUnoService(&quot;com.sun.star.util.URLTransformer&quot;)
825cdf0e10cSrcweir		url.Complete = &quot;.uno:CloseDoc&quot;
826cdf0e10cSrcweir		parser.parseStrict(url)
827cdf0e10cSrcweir		oFrame = oDocument.CurrentController.Frame
828cdf0e10cSrcweir		disp = oFrame.queryDispatch(url,&quot;_self&quot;, com.sun.star.util.SearchFlags.NORM_WORD_ONLY)
829cdf0e10cSrcweir		disp.dispatch(url, NoArgs())
830cdf0e10cSrcweir	End If
831cdf0e10cSrcweirEnd Sub
832cdf0e10cSrcweir
833cdf0e10cSrcweir&apos;Function to calculate if the year is a leap year
834cdf0e10cSrcweirFunction CalIsLeapYear(ByVal iYear as Integer) as Boolean
835cdf0e10cSrcweir        CalIsLeapYear = ((iYear Mod 4 = 0) And ((iYear Mod 100 &lt;&gt; 0) Or (iYear Mod 400 = 0)))
836cdf0e10cSrcweirEnd Function
8373e02b54dSAndrew Rist</script:module>
838