summaryrefslogtreecommitdiffstats
path: root/wizards/source/formwizard/tools.xba
blob: 881552717864993cc253899d70d3a4388806fe90 (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
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
<?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.DefaultState = 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
		WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
		If Wizardpath &lt;&gt; &quot;&quot; Then
			TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;backgrounds/&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
	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>