path: root/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">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM  *****  BASIC  *****
Option Explicit

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
&apos; Todo: Wie geht das mit ImageControls
&apos; kann nur fest verdrahtet werden
	If Not IsMissing(LocText) Then
		aPeerSize = GetPeerSize(oModel, oControl, LocText)
	Else
		aPeerSize = GetPeerSize(oModel, oControl
	End If
	nWidth = aPeerSize.Width
	GetPreferredWidth = 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
&apos; Todo: Wie geht das mit ImageControls
	If Not IsMissing(LocText) Then
		aPeerSize = GetPeerSize(oModel, oControl, LocText)
	Else
		aPeerSize = GetPeerSize(oModel, oControl)
	End If
	nHeight = aPeerSize.Height
	GetPreferredHeight = 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
	oControl = oController.GetControl(oModel)
	oPeer = oControl.GetPeer()
	If oControl.Model.PropertySetInfo.HasPropertybyName(&quot;EffectiveMax&quot;) Then
&apos; Todo: Remove this Hack due to Bug #88391
		oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
		aPeerSize = oPeer.PreferredSize()
	ElseIf Not IsMissing(LocText) Then
		oControl.Text = LocText
		aPeerSize = oPeer.PreferredSize()
	Else
		oControl.Text = &quot;2222222222&quot;
		aPeerSize = oPeer.PreferredSize()
		oControl.Text = &quot;&quot;
	End If
	GetPeerSize = aPeerSize
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; nur ungefaehre Berechnung
	TwipToPixel = nValue / 15
End function


Function PixelTo100thMM(BYVAL nValue as long) as long
	 PixelTo100thMM = nValue * 28		&apos; nur ungefähre Berechnung 
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 CurIndex as Integer
Dim sImportPath as String
&apos;	oDocument.LockControllers
	CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
	sImportPath = Styles(8,CurIndex)
	LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
	ControlCaptionsToStandardLayout()
	ConfigurePageStyle()	
&apos;	oDocument.UnlockControllers
End Sub


Function SetNumerics(ByVal oLocObject as Object) as Object	
	&apos; Todo: FS fragen, ob dies alles richtig ist
	&apos; Todo: Es sollte in der Hilfe darauf hingewiesen werden, dass der untere Wertbereich negativ ist.
	Select Case CurFieldType
		Case com.sun.star.sdbc.DataType.BIGINT
			oLocObOject.EffectiveMax = 2147483647 * 2147483647 
			oLocbject.EffectiveMin = -(-2147483648 * -2147483648)
		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: Hier sollte der Numberformatter angeworfen werden um die Nachkommastellen
		&apos; festzulegen
&apos;			oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) &apos; Nachkommastellen
	End Select
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; Note as Shapes cannot be removed from the DrawPage without destroying
&apos; the object we have to park them somewhere in Nirwana
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 AddListtoList(FirstArray(), SecondArray(), Optional StarIndex)
Dim n as Integer
Dim m as Integer
Dim MaxIndex as Integer
	MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1
	If MaxIndex &gt; -1 Then
		Dim ResultArray(MaxIndex)
		For m = 0 To Ubound(FirstArray())
			ResultArray(m) = FirstArray(m)
		Next m
		For n = 0 To Ubound(SecondArray())
			ResultArray(m) = SecondArray(n)
			m = m + 1
		Next n
		AddListToList() = ResultArray()
	Else
		Dim NullArray()
		AddListToList() = NullArray()
	End If
End Function</script:module>