summaryrefslogtreecommitdiff
path: root/wizards/source/formwizard/tools.xba
blob: e715b07b9547cbda746e2874cf740cb125d714b2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
<?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
Dim bWithBackGraphic as Boolean
&apos;	oDocument.LockControllers
	CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
	sImportPath = Styles(8,CurIndex)
	bWithBackGraphic = LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
	ControlCaptionsToStandardLayout()
	ToggleOptionButtons(oDialogModel, bWithBackGraphic)	
	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


Function CountItemsInArray(BigArray(), SearchItem)
Dim i as Integer
Dim MaxIndex as Integer
Dim ResCount as Integer
	ResCount = 0
	For i = o To MaxIndex
		If SearchItem = BigArray(i) Then
			ResCount = ResCount + 1
		End If
	Next i
	CountItemsInArray() = ResCount
End Function					</script:module>