AOO410/main/wizards/source/formwizard/tools.xba - openoffice - Git at Google

 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
 <!--***********************************************************
  *
  * 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
  *
  * Unless required by applicable law or agreed to in writing,
  * software distributed under the License is distributed on an
  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  * KIND, either express or implied.  See the License for the
  * specific language governing permissions and limitations
  * under the License.
  *
  ***********************************************************-->
 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM  *****  BASIC  *****
 Option Explicit
 Public Const SBMAXTEXTSIZE = 50


 Function SetProgressValue(iValue as Integer)
 	If iValue = 0 Then
 		oProgressbar.End
 	End If
 	ProgressValue = iValue
 	oProgressbar.Value = iValue
 End Function


 Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
 Dim aPeerSize as new com.sun.star.awt.Size
 Dim nWidth as Integer
 Dim oControl as Object
 	If Not IsMissing(LocText) Then
 		&apos; Label
 		aPeerSize = GetPeerSize(oModel, oControl, LocText)
 	ElseIf CurControlType = cImageControl Then
 		GetPreferredWidth() = 2000
 		Exit Function
 	Else
 		aPeerSize = GetPeerSize(oModel, oControl)
 	End If
 	nWidth = aPeerSize.Width
 	&apos; We increase the preferred Width a bit so that the control does not become too small
 	&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
 	GetPreferredWidth = (nWidth + 10) * XPixelFactor	&apos; PixelTo100thmm(nWidth)
 End Function


 Function GetPreferredHeight(oModel as Object, Optional LocText)
 Dim aPeerSize as new com.sun.star.awt.Size
 Dim nHeight as Integer
 Dim oControl as Object
 	If Not IsMissing(LocText) Then
 		&apos; Label
 		aPeerSize = GetPeerSize(oModel, oControl, LocText)
 	ElseIf CurControlType = cImageControl Then
 		GetPreferredHeight() = 2000
 		Exit Function
 	Else
 		aPeerSize = GetPeerSize(oModel, oControl)
 	End If
 	nHeight = aPeerSize.Height
 	&apos; We increase the preferred Height a bit so that the control does not become too small
 	&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
 	GetPreferredHeight = (nHeight+1) * YPixelFactor 	&apos; PixelTo100thmm(nHeight)
 End Function


 Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
 Dim oPeer as Object
 Dim aPeerSize as new com.sun.star.awt.Size
 Dim NullValue
 	oControl = oController.GetControl(oModel)
 	oPeer = oControl.GetPeer()
 	If oControl.Model.PropertySetInfo.HasPropertybyName(&quot;EffectiveMax&quot;) Then
 		If oControl.Model.EffectiveMax = 0 Then
 			&apos; This is relevant for decimal fields
 			oControl.Model.EffectiveValue = 999.9999
 		Else
 			oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
 		End If
 		GetPeerSize() = oPeer.PreferredSize()
 		oControl.Model.EffectiveValue = NullValue
 	ElseIf Not IsMissing(LocText) Then
 		oControl.Text = LocText
 		GetPeerSize() = oPeer.PreferredSize()
 	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
 		GetPeerSize() = oPeer.PreferredSize()
 	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
 		GetPeerSize() = oPeer.PreferredSize()
 	ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
 		oControl.Model.Date = Date
 		GetPeerSize() = oPeer.PreferredSize()
 		oControl.Model.Date = NullValue
 	ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
 		oControl.Time = Time
 		GetPeerSize() = oPeer.PreferredSize()
 		oControl.Time = NullValue
 	Else
 		If oControl.MaxTextLen &gt; SBMAXTEXTSIZE Then
 			oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
 		Else
 			oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
 		End If
 		GetPeerSize() = oPeer.PreferredSize()
 		oControl.Text = &quot;&quot;
 	End If
 End Function


 Function TwipToCM(BYVAL nValue as long) as String
 	TwipToCM = trim(str(nValue / 567)) + &quot;cm&quot;
 End function


 Function TwipTo100telMM(BYVAL nValue as long) as long
 	 TwipTo100telMM = nValue / 0.567
 End function


 Function TwipToPixel(BYVAL nValue as long) as long &apos; not an exact calculation
 	TwipToPixel = nValue / 15
 End function


 Function PixelTo100thMMX(oControl as Object) as long
 	oPeer = oControl.GetPeer()
 	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)

 &apos;	 PixelTo100thMM = nValue * 28					&apos; not an exact calculation
 End function


 Function PixelTo100thMMY(oControl as Object) as long
 	oPeer = oControl.GetPeer()
 	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)

 &apos;	 PixelTo100thMM = nValue * 28					&apos; not an exact calculation
 End function


 Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
 Dim aPoint as New com.sun.star.awt.Point
 	aPoint.X = xPos
 	aPoint.Y = yPos
 	GetPoint() = aPoint
 End Function


 Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
 Dim aSize As New com.sun.star.awt.Size
 	aSize.Width = iWidth
 	aSize.Height = iHeight
 	GetSize() = aSize
 End Function


 Sub	ImportStyles()
 Dim OldIndex as Integer
 	If Not bDebug Then
 		On Local Error GoTo WIZARDERROR
 	End If
 	OldIndex = CurIndex
 	CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
 	If CurIndex &lt;&gt; OldIndex Then
 		ToggleLayoutPage(False)
 		Dim sImportPath as String
 		sImportPath = Styles(CurIndex, 8)
 		bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
 		ControlCaptionsToStandardLayout()
 		ToggleLayoutPage(True, &quot;lstStyles&quot;)
 	End If
 WIZARDERROR:
 	If Err &lt;&gt; 0 Then
 		Msgbox(sMsgErrMsg, 16, GetProductName())
 		Resume LOCERROR
 		LOCERROR:
 	End If
 End Sub


 Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
 	If CurControlType = cNumericBox Then
 		oLocObject.TreatAsNumber = True
 		Select Case iLocFieldType
 			Case com.sun.star.sdbc.DataType.BIGINT
 				oLocObject.EffectiveMax = 2147483647 * 2147483647
 				oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
 &apos;				oLocObject.DecimalAccuracy = 0
 			Case com.sun.star.sdbc.DataType.INTEGER
 				oLocObject.EffectiveMax = 2147483647
 				oLocObject.EffectiveMin = -2147483648
 			Case com.sun.star.sdbc.DataType.SMALLINT
 				oLocObject.EffectiveMax = 32767
 				oLocObject.EffectiveMin = -32768
 			Case com.sun.star.sdbc.DataType.TINYINT
 				oLocObject.EffectiveMax = 127
 				oLocObject.EffectiveMin = -128
 			Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
 &apos;Todo:			oLocObject.DecimalAccuracy = ...
 	 			oLocObject.EffectiveDefault = CurDefaultValue
 &apos; Todo: HelpText???
 		End Select
 		If oLocObject.PropertySetinfo.HasPropertyByName(&quot;Width&quot;)Then &apos; Note: an Access AutoincrementField does not provide this property Width
 			oLocObject.Width = CurFieldLength + CurScale + 1
 		End If
 		If CurIsCurrency Then
 &apos;Todo: How do you set currencies?
 		End If
 	ElseIf CurControlType = cTextBox Then	&apos;com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
 		If CurFieldLength = 0 Then			 &apos;Or oLocObject.MaxTextLen &gt; SBMAXTEXTSIZE
 			oLocObject.MaxTextLen = SBMAXTEXTSIZE
 			CurFieldLength = SBMAXTEXTSIZE
 		Else
 			oLocObject.MaxTextLen = CurFieldLength
 		End If
 		oLocObject.DefaultText = CurDefaultValue
 	ElseIf CurControlType = cDateBox Then
 &apos; Todo Why does this not work?:		oLocObject.DefaultDate = CurDefaultValue
 	ElseIf CurControlType = cTimeBox Then	&apos; com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
 		oLocObject.DefaultTime = CurDefaultValue
 &apos; Todo: Property TimeFormat? frome where?
 	ElseIf CurControlType = cCheckBox Then
 &apos; Todo Why does this not work?:		oLocObject.DefautState = CurDefaultValue
 	End If
 	If oLocObject.PropertySetInfo.HasPropertybyName(&quot;FormatKey&quot;) Then
 		On Local Error Resume Next
 		oLocObject.FormatKey = CurFormatKey
 	End If
 End Function


 &apos; Destroy all Shapes in Nirwana
 Sub RemoveShapes()
 Dim n as Integer
 Dim oControl as Object
 Dim oShape as Object
 	For n = oDrawPage.Count-1 To 0 Step -1
 		oShape = oDrawPage(n)
 		If oShape.Position.Y &gt; -2000 Then
 			oDrawPage.Remove(oShape)
 		End If
 	Next n
 End Sub


 &apos; Destroy all Shapes in Nirwana
 Sub RemoveNirwanaShapes()
 Dim n as Integer
 Dim oControl as Object
 Dim oShape as Object
 	For n = oDrawPage.Count-1 To 0 Step -1
 		oShape = oDrawPage(n)
 		If oShape.Position.Y &lt; -2000 Then
 			oDrawPage.Remove(oShape)
 		End If
 	Next n
 End Sub


 &apos; Note: as Shapes cannot be removed from the DrawPage without destroying
 &apos; the object we have to park them somewhere beyond the visible area of the page
 Sub ShapesToNirwana()
 Dim n as Integer
 Dim oControl as Object
 	For n = 0 To oDrawPage.Count-1
 		oDrawPage(n).Position = GetPoint(-20, -10000)
 	Next n
 End Sub


 Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String

 Dim nPostfix as Integer
 Dim sReturn as String
 	nPostfix = 2
 	sReturn = sBaseName
 	while (oContainer.hasByName(sReturn))
 		sReturn = sBaseName &amp; nPostfix
 		nPostfix = nPostfix + 1
 	Wend
 	CalcUniqueContentName = sReturn
 End Function


 Function CountItemsInArray(BigArray(), SearchItem)
 Dim i as Integer
 Dim MaxIndex as Integer
 Dim ResCount as Integer
 	ResCount = 0
 	MaxIndex = Ubound(BigArray())
 	For i = 0 To MaxIndex
 		If SearchItem = BigArray(i) Then
 			ResCount = ResCount + 1
 		End If
 	Next i
 	CountItemsInArray() = ResCount
 End Function


 Function GetDBHeight(oDBModel as Object)
 	If CurControlType = cImageControl Then
 		nDBHeight = 2000
 	Else
 		If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
 			oDBModel.MultiLine = True
 			nDBHeight = nDBRefHeight * 4
 		Else
 			nDBHeight = nDBRefHeight
 		End If
 	End If
 	GetDBHeight() = nDBHeight
 End Function


 Function GetFormWizardPaths() as Boolean
 	FormPath = GetOfficeSubPath(&quot;Template&quot;,&quot;../wizard/bitmap&quot;)
 	If FormPath &lt;&gt; &quot;&quot; Then
 		WebWizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/web&quot;)
 		If WebWizardPath &lt;&gt; &quot;&quot; Then
 			WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
 			If Wizardpath &lt;&gt; &quot;&quot; Then
 				TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;www-back/&quot;)
 				If TexturePath &lt;&gt; &quot;&quot; Then
 					WorkPath = GetPathSettings(&quot;Work&quot;)
 					If WorkPath &lt;&gt; &quot;&quot; Then
 						TempPath = GetPathSettings(&quot;Temp&quot;)
 						If TempPath &lt;&gt; &quot;&quot; Then
 							GetFormWizardPaths = True
 							Exit Function
 						End If
 					End If
 				End If
 			End If
 		End If
 	End  If
 	DisposeDocument(oDocument)
 	GetFormWizardPaths() = False
 End Function


 Function GetFilterName(sApplicationKey as String) as String
 Dim oArgs()
 Dim oFactory
 Dim i as Integer
 Dim Maxindex as Integer
 Dim UIName as String
 	oFactory  = createUnoService(&quot;com.sun.star.document.FilterFactory&quot;)
 	oArgs() = oFactory.getByName(sApplicationKey)
 	MaxIndex = Ubound(oArgs())
 	For i = 0 to MaxIndex
 		If (oArgs(i).Name=&quot;UIName&quot;) Then
 		    UIName = oArgs(i).Value
 		    Exit For
 	  	End If
 	next i
 	GetFilterName() = UIName
 End Function
 </script:module>
	<?xml version="1.0" encoding="UTF-8"?>
	<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
	<!--***********************************************************
	*
	* 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
	*
	* Unless required by applicable law or agreed to in writing,
	* software distributed under the License is distributed on an
	* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	* KIND, either express or implied. See the License for the
	* specific language governing permissions and limitations
	* under the License.
	*
	***********************************************************-->
	<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM *** BASIC ***
	Option Explicit
	Public Const SBMAXTEXTSIZE = 50


	Function SetProgressValue(iValue as Integer)
	If iValue = 0 Then
	oProgressbar.End
	End If
	ProgressValue = iValue
	oProgressbar.Value = iValue
	End Function


	Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
	Dim aPeerSize as new com.sun.star.awt.Size
	Dim nWidth as Integer
	Dim oControl as Object
	If Not IsMissing(LocText) Then
	' Label
	aPeerSize = GetPeerSize(oModel, oControl, LocText)
	ElseIf CurControlType = cImageControl Then
	GetPreferredWidth() = 2000
	Exit Function
	Else
	aPeerSize = GetPeerSize(oModel, oControl)
	End If
	nWidth = aPeerSize.Width
	' We increase the preferred Width a bit so that the control does not become too small
	' when we change the border from "3D" to "Flat"
	GetPreferredWidth = (nWidth + 10) * XPixelFactor ' PixelTo100thmm(nWidth)
	End Function


	Function GetPreferredHeight(oModel as Object, Optional LocText)
	Dim aPeerSize as new com.sun.star.awt.Size
	Dim nHeight as Integer
	Dim oControl as Object
	If Not IsMissing(LocText) Then
	' Label
	aPeerSize = GetPeerSize(oModel, oControl, LocText)
	ElseIf CurControlType = cImageControl Then
	GetPreferredHeight() = 2000
	Exit Function
	Else
	aPeerSize = GetPeerSize(oModel, oControl)
	End If
	nHeight = aPeerSize.Height
	' We increase the preferred Height a bit so that the control does not become too small
	' when we change the border from "3D" to "Flat"
	GetPreferredHeight = (nHeight+1) * YPixelFactor ' PixelTo100thmm(nHeight)
	End Function


	Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
	Dim oPeer as Object
	Dim aPeerSize as new com.sun.star.awt.Size
	Dim NullValue
	oControl = oController.GetControl(oModel)
	oPeer = oControl.GetPeer()
	If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
	If oControl.Model.EffectiveMax = 0 Then
	' This is relevant for decimal fields
	oControl.Model.EffectiveValue = 999.9999
	Else
	oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
	End If
	GetPeerSize() = oPeer.PreferredSize()
	oControl.Model.EffectiveValue = NullValue
	ElseIf Not IsMissing(LocText) Then
	oControl.Text = LocText
	GetPeerSize() = oPeer.PreferredSize()
	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
	GetPeerSize() = oPeer.PreferredSize()
	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
	GetPeerSize() = oPeer.PreferredSize()
	ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
	oControl.Model.Date = Date
	GetPeerSize() = oPeer.PreferredSize()
	oControl.Model.Date = NullValue
	ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
	oControl.Time = Time
	GetPeerSize() = oPeer.PreferredSize()
	oControl.Time = NullValue
	Else
	If oControl.MaxTextLen > SBMAXTEXTSIZE Then
	oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
	Else
	oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
	End If
	GetPeerSize() = oPeer.PreferredSize()
	oControl.Text = ""
	End If
	End Function


	Function TwipToCM(BYVAL nValue as long) as String
	TwipToCM = trim(str(nValue / 567)) + "cm"
	End function


	Function TwipTo100telMM(BYVAL nValue as long) as long
	TwipTo100telMM = nValue / 0.567
	End function


	Function TwipToPixel(BYVAL nValue as long) as long ' not an exact calculation
	TwipToPixel = nValue / 15
	End function


	Function PixelTo100thMMX(oControl as Object) as long
	oPeer = oControl.GetPeer()
	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)

	' PixelTo100thMM = nValue * 28 ' not an exact calculation
	End function


	Function PixelTo100thMMY(oControl as Object) as long
	oPeer = oControl.GetPeer()
	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)

	' PixelTo100thMM = nValue * 28 ' not an exact calculation
	End function


	Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
	Dim aPoint as New com.sun.star.awt.Point
	aPoint.X = xPos
	aPoint.Y = yPos
	GetPoint() = aPoint
	End Function


	Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
	Dim aSize As New com.sun.star.awt.Size
	aSize.Width = iWidth
	aSize.Height = iHeight
	GetSize() = aSize
	End Function


	Sub ImportStyles()
	Dim OldIndex as Integer
	If Not bDebug Then
	On Local Error GoTo WIZARDERROR
	End If
	OldIndex = CurIndex
	CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
	If CurIndex <> OldIndex Then
	ToggleLayoutPage(False)
	Dim sImportPath as String
	sImportPath = Styles(CurIndex, 8)
	bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
	ControlCaptionsToStandardLayout()
	ToggleLayoutPage(True, "lstStyles")
	End If
	WIZARDERROR:
	If Err <> 0 Then
	Msgbox(sMsgErrMsg, 16, GetProductName())
	Resume LOCERROR
	LOCERROR:
	End If
	End Sub



	Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
	If CurControlType = cNumericBox Then
	oLocObject.TreatAsNumber = True
	Select Case iLocFieldType
	Case com.sun.star.sdbc.DataType.BIGINT
	oLocObject.EffectiveMax = 2147483647 * 2147483647
	oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
	' oLocObject.DecimalAccuracy = 0
	Case com.sun.star.sdbc.DataType.INTEGER
	oLocObject.EffectiveMax = 2147483647
	oLocObject.EffectiveMin = -2147483648
	Case com.sun.star.sdbc.DataType.SMALLINT
	oLocObject.EffectiveMax = 32767
	oLocObject.EffectiveMin = -32768
	Case com.sun.star.sdbc.DataType.TINYINT
	oLocObject.EffectiveMax = 127
	oLocObject.EffectiveMin = -128
	Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
	'Todo: oLocObject.DecimalAccuracy = ...
	oLocObject.EffectiveDefault = CurDefaultValue
	' Todo: HelpText???
	End Select
	If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width
	oLocObject.Width = CurFieldLength + CurScale + 1
	End If
	If CurIsCurrency Then
	'Todo: How do you set currencies?
	End If
	ElseIf CurControlType = cTextBox Then 'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
	If CurFieldLength = 0 Then 'Or oLocObject.MaxTextLen > SBMAXTEXTSIZE
	oLocObject.MaxTextLen = SBMAXTEXTSIZE
	CurFieldLength = SBMAXTEXTSIZE
	Else
	oLocObject.MaxTextLen = CurFieldLength
	End If
	oLocObject.DefaultText = CurDefaultValue
	ElseIf CurControlType = cDateBox Then
	' Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue
	ElseIf CurControlType = cTimeBox Then ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
	oLocObject.DefaultTime = CurDefaultValue
	' Todo: Property TimeFormat? frome where?
	ElseIf CurControlType = cCheckBox Then
	' Todo Why does this not work?: oLocObject.DefautState = CurDefaultValue
	End If
	If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then
	On Local Error Resume Next
	oLocObject.FormatKey = CurFormatKey
	End If
	End Function


	' Destroy all Shapes in Nirwana
	Sub RemoveShapes()
	Dim n as Integer
	Dim oControl as Object
	Dim oShape as Object
	For n = oDrawPage.Count-1 To 0 Step -1
	oShape = oDrawPage(n)
	If oShape.Position.Y > -2000 Then
	oDrawPage.Remove(oShape)
	End If
	Next n
	End Sub


	' Destroy all Shapes in Nirwana
	Sub RemoveNirwanaShapes()
	Dim n as Integer
	Dim oControl as Object
	Dim oShape as Object
	For n = oDrawPage.Count-1 To 0 Step -1
	oShape = oDrawPage(n)
	If oShape.Position.Y < -2000 Then
	oDrawPage.Remove(oShape)
	End If
	Next n
	End Sub



	' Note: as Shapes cannot be removed from the DrawPage without destroying
	' the object we have to park them somewhere beyond the visible area of the page
	Sub ShapesToNirwana()
	Dim n as Integer
	Dim oControl as Object
	For n = 0 To oDrawPage.Count-1
	oDrawPage(n).Position = GetPoint(-20, -10000)
	Next n
	End Sub


	Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String

	Dim nPostfix as Integer
	Dim sReturn as String
	nPostfix = 2
	sReturn = sBaseName
	while (oContainer.hasByName(sReturn))
	sReturn = sBaseName & nPostfix
	nPostfix = nPostfix + 1
	Wend
	CalcUniqueContentName = sReturn
	End Function


	Function CountItemsInArray(BigArray(), SearchItem)
	Dim i as Integer
	Dim MaxIndex as Integer
	Dim ResCount as Integer
	ResCount = 0
	MaxIndex = Ubound(BigArray())
	For i = 0 To MaxIndex
	If SearchItem = BigArray(i) Then
	ResCount = ResCount + 1
	End If
	Next i
	CountItemsInArray() = ResCount
	End Function


	Function GetDBHeight(oDBModel as Object)
	If CurControlType = cImageControl Then
	nDBHeight = 2000
	Else
	If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
	oDBModel.MultiLine = True
	nDBHeight = nDBRefHeight * 4
	Else
	nDBHeight = nDBRefHeight
	End If
	End If
	GetDBHeight() = nDBHeight
	End Function


	Function GetFormWizardPaths() as Boolean
	FormPath = GetOfficeSubPath("Template","../wizard/bitmap")
	If FormPath <> "" Then
	WebWizardPath = GetOfficeSubPath("Template","wizard/web")
	If WebWizardPath <> "" Then
	WizardPath = GetOfficeSubPath("Template","wizard/")
	If Wizardpath <> "" Then
	TexturePath = GetOfficeSubPath("Gallery", "www-back/")
	If TexturePath <> "" Then
	WorkPath = GetPathSettings("Work")
	If WorkPath <> "" Then
	TempPath = GetPathSettings("Temp")
	If TempPath <> "" Then
	GetFormWizardPaths = True
	Exit Function
	End If
	End If
	End If
	End If
	End If
	End If
	DisposeDocument(oDocument)
	GetFormWizardPaths() = False
	End Function


	Function GetFilterName(sApplicationKey as String) as String
	Dim oArgs()
	Dim oFactory
	Dim i as Integer
	Dim Maxindex as Integer
	Dim UIName as String
	oFactory = createUnoService("com.sun.star.document.FilterFactory")
	oArgs() = oFactory.getByName(sApplicationKey)
	MaxIndex = Ubound(oArgs())
	For i = 0 to MaxIndex
	If (oArgs(i).Name="UIName") Then
	UIName = oArgs(i).Value
	Exit For
	End If
	next i
	GetFilterName() = UIName
	End Function
	</script:module>