office-gobmx/wizards/source/formwizard/tools.xba

<?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="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? from 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>