xref: /trunk/main/wizards/source/formwizard/tools.xba (revision 86e1cf34)
1<?xml version="1.0" encoding="UTF-8"?>
2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3<!--***********************************************************
4 *
5 * Licensed to the Apache Software Foundation (ASF) under one
6 * or more contributor license agreements.  See the NOTICE file
7 * distributed with this work for additional information
8 * regarding copyright ownership.  The ASF licenses this file
9 * to you under the Apache License, Version 2.0 (the
10 * "License"); you may not use this file except in compliance
11 * with the License.  You may obtain a copy of the License at
12 *
13 *   http://www.apache.org/licenses/LICENSE-2.0
14 *
15 * Unless required by applicable law or agreed to in writing,
16 * software distributed under the License is distributed on an
17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
18 * KIND, either express or implied.  See the License for the
19 * specific language governing permissions and limitations
20 * under the License.
21 *
22 ***********************************************************-->
23<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM  *****  BASIC  *****
24Option Explicit
25Public Const SBMAXTEXTSIZE = 50
26
27
28Function SetProgressValue(iValue as Integer)
29	If iValue = 0 Then
30		oProgressbar.End
31	End If
32	ProgressValue = iValue
33	oProgressbar.Value = iValue
34End Function
35
36
37Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
38Dim aPeerSize as new com.sun.star.awt.Size
39Dim nWidth as Integer
40Dim oControl as Object
41	If Not IsMissing(LocText) Then
42		&apos; Label
43		aPeerSize = GetPeerSize(oModel, oControl, LocText)
44	ElseIf CurControlType = cImageControl Then
45		GetPreferredWidth() = 2000
46		Exit Function
47	Else
48		aPeerSize = GetPeerSize(oModel, oControl)
49	End If
50	nWidth = aPeerSize.Width
51	&apos; We increase the preferred Width a bit so that the control does not become too small
52	&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
53	GetPreferredWidth = (nWidth + 10) * XPixelFactor	&apos; PixelTo100thmm(nWidth)
54End Function
55
56
57Function GetPreferredHeight(oModel as Object, Optional LocText)
58Dim aPeerSize as new com.sun.star.awt.Size
59Dim nHeight as Integer
60Dim oControl as Object
61	If Not IsMissing(LocText) Then
62		&apos; Label
63		aPeerSize = GetPeerSize(oModel, oControl, LocText)
64	ElseIf CurControlType = cImageControl Then
65		GetPreferredHeight() = 2000
66		Exit Function
67	Else
68		aPeerSize = GetPeerSize(oModel, oControl)
69	End If
70	nHeight = aPeerSize.Height
71	&apos; We increase the preferred Height a bit so that the control does not become too small
72	&apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
73	GetPreferredHeight = (nHeight+1) * YPixelFactor 	&apos; PixelTo100thmm(nHeight)
74End Function
75
76
77Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
78Dim oPeer as Object
79Dim aPeerSize as new com.sun.star.awt.Size
80Dim NullValue
81	oControl = oController.GetControl(oModel)
82	oPeer = oControl.GetPeer()
83	If oControl.Model.PropertySetInfo.HasPropertybyName(&quot;EffectiveMax&quot;) Then
84		If oControl.Model.EffectiveMax = 0 Then
85			&apos; This is relevant for decimal fields
86			oControl.Model.EffectiveValue = 999.9999
87		Else
88			oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
89		End If
90		GetPeerSize() = oPeer.PreferredSize()
91		oControl.Model.EffectiveValue = NullValue
92	ElseIf Not IsMissing(LocText) Then
93		oControl.Text = LocText
94		GetPeerSize() = oPeer.PreferredSize()
95	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
96		GetPeerSize() = oPeer.PreferredSize()
97	ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
98		GetPeerSize() = oPeer.PreferredSize()
99	ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
100		oControl.Model.Date = Date
101		GetPeerSize() = oPeer.PreferredSize()
102		oControl.Model.Date = NullValue
103	ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
104		oControl.Time = Time
105		GetPeerSize() = oPeer.PreferredSize()
106		oControl.Time = NullValue
107	Else
108		If oControl.MaxTextLen &gt; SBMAXTEXTSIZE Then
109			oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
110		Else
111			oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
112		End If
113		GetPeerSize() = oPeer.PreferredSize()
114		oControl.Text = &quot;&quot;
115	End If
116End Function
117
118
119Function TwipToCM(BYVAL nValue as long) as String
120	TwipToCM = trim(str(nValue / 567)) + &quot;cm&quot;
121End function
122
123
124Function TwipTo100telMM(BYVAL nValue as long) as long
125	 TwipTo100telMM = nValue / 0.567
126End function
127
128
129Function TwipToPixel(BYVAL nValue as long) as long &apos; not an exact calculation
130	TwipToPixel = nValue / 15
131End function
132
133
134Function PixelTo100thMMX(oControl as Object) as long
135	oPeer = oControl.GetPeer()
136	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
137
138&apos;	 PixelTo100thMM = nValue * 28					&apos; not an exact calculation
139End function
140
141
142Function PixelTo100thMMY(oControl as Object) as long
143	oPeer = oControl.GetPeer()
144	PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
145
146&apos;	 PixelTo100thMM = nValue * 28					&apos; not an exact calculation
147End function
148
149
150Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
151Dim aPoint as New com.sun.star.awt.Point
152	aPoint.X = xPos
153	aPoint.Y = yPos
154	GetPoint() = aPoint
155End Function
156
157
158Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
159Dim aSize As New com.sun.star.awt.Size
160	aSize.Width = iWidth
161	aSize.Height = iHeight
162	GetSize() = aSize
163End Function
164
165
166Sub	ImportStyles()
167Dim OldIndex as Integer
168	If Not bDebug Then
169		On Local Error GoTo WIZARDERROR
170	End If
171	OldIndex = CurIndex
172	CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
173	If CurIndex &lt;&gt; OldIndex Then
174		ToggleLayoutPage(False)
175		Dim sImportPath as String
176		sImportPath = Styles(CurIndex, 8)
177		bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
178		ControlCaptionsToStandardLayout()
179		ToggleLayoutPage(True, &quot;lstStyles&quot;)
180	End If
181WIZARDERROR:
182	If Err &lt;&gt; 0 Then
183		Msgbox(sMsgErrMsg, 16, GetProductName())
184		Resume LOCERROR
185		LOCERROR:
186	End If
187End Sub
188
189
190
191Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
192	If CurControlType = cNumericBox Then
193		oLocObject.TreatAsNumber = True
194		Select Case iLocFieldType
195			Case com.sun.star.sdbc.DataType.BIGINT
196				oLocObject.EffectiveMax = 2147483647 * 2147483647
197				oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
198&apos;				oLocObject.DecimalAccuracy = 0
199			Case com.sun.star.sdbc.DataType.INTEGER
200				oLocObject.EffectiveMax = 2147483647
201				oLocObject.EffectiveMin = -2147483648
202			Case com.sun.star.sdbc.DataType.SMALLINT
203				oLocObject.EffectiveMax = 32767
204				oLocObject.EffectiveMin = -32768
205			Case com.sun.star.sdbc.DataType.TINYINT
206				oLocObject.EffectiveMax = 127
207				oLocObject.EffectiveMin = -128
208			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
209&apos;Todo:			oLocObject.DecimalAccuracy = ...
210	 			oLocObject.EffectiveDefault = CurDefaultValue
211&apos; Todo: HelpText???
212		End Select
213		If oLocObject.PropertySetinfo.HasPropertyByName(&quot;Width&quot;)Then &apos; Note: an Access AutoincrementField does not provide this property Width
214			oLocObject.Width = CurFieldLength + CurScale + 1
215		End If
216		If CurIsCurrency Then
217&apos;Todo: How do you set currencies?
218		End If
219	ElseIf CurControlType = cTextBox Then	&apos;com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
220		If CurFieldLength = 0 Then			 &apos;Or oLocObject.MaxTextLen &gt; SBMAXTEXTSIZE
221			oLocObject.MaxTextLen = SBMAXTEXTSIZE
222			CurFieldLength = SBMAXTEXTSIZE
223		Else
224			oLocObject.MaxTextLen = CurFieldLength
225		End If
226		oLocObject.DefaultText = CurDefaultValue
227	ElseIf CurControlType = cDateBox Then
228&apos; Todo Why does this not work?:		oLocObject.DefaultDate = CurDefaultValue
229	ElseIf CurControlType = cTimeBox Then	&apos; com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
230		oLocObject.DefaultTime = CurDefaultValue
231&apos; Todo: Property TimeFormat? from where?
232	ElseIf CurControlType = cCheckBox Then
233&apos; Todo Why does this not work?:		oLocObject.DefautState = CurDefaultValue
234	End If
235	If oLocObject.PropertySetInfo.HasPropertybyName(&quot;FormatKey&quot;) Then
236		On Local Error Resume Next
237		oLocObject.FormatKey = CurFormatKey
238	End If
239End Function
240
241
242&apos; Destroy all Shapes in Nirwana
243Sub RemoveShapes()
244Dim n as Integer
245Dim oControl as Object
246Dim oShape as Object
247	For n = oDrawPage.Count-1 To 0 Step -1
248		oShape = oDrawPage(n)
249		If oShape.Position.Y &gt; -2000 Then
250			oDrawPage.Remove(oShape)
251		End If
252	Next n
253End Sub
254
255
256&apos; Destroy all Shapes in Nirwana
257Sub RemoveNirwanaShapes()
258Dim n as Integer
259Dim oControl as Object
260Dim oShape as Object
261	For n = oDrawPage.Count-1 To 0 Step -1
262		oShape = oDrawPage(n)
263		If oShape.Position.Y &lt; -2000 Then
264			oDrawPage.Remove(oShape)
265		End If
266	Next n
267End Sub
268
269
270
271&apos; Note: as Shapes cannot be removed from the DrawPage without destroying
272&apos; the object we have to park them somewhere beyond the visible area of the page
273Sub ShapesToNirwana()
274Dim n as Integer
275Dim oControl as Object
276	For n = 0 To oDrawPage.Count-1
277		oDrawPage(n).Position = GetPoint(-20, -10000)
278	Next n
279End Sub
280
281
282Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String
283
284Dim nPostfix as Integer
285Dim sReturn as String
286	nPostfix = 2
287	sReturn = sBaseName
288	while (oContainer.hasByName(sReturn))
289		sReturn = sBaseName &amp; nPostfix
290		nPostfix = nPostfix + 1
291	Wend
292	CalcUniqueContentName = sReturn
293End Function
294
295
296Function CountItemsInArray(BigArray(), SearchItem)
297Dim i as Integer
298Dim MaxIndex as Integer
299Dim ResCount as Integer
300	ResCount = 0
301	MaxIndex = Ubound(BigArray())
302	For i = 0 To MaxIndex
303		If SearchItem = BigArray(i) Then
304			ResCount = ResCount + 1
305		End If
306	Next i
307	CountItemsInArray() = ResCount
308End Function
309
310
311Function GetDBHeight(oDBModel as Object)
312	If CurControlType = cImageControl Then
313		nDBHeight = 2000
314	Else
315		If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
316			oDBModel.MultiLine = True
317			nDBHeight = nDBRefHeight * 4
318		Else
319			nDBHeight = nDBRefHeight
320		End If
321	End If
322	GetDBHeight() = nDBHeight
323End Function
324
325
326Function GetFormWizardPaths() as Boolean
327	FormPath = GetOfficeSubPath(&quot;Template&quot;,&quot;../wizard/bitmap&quot;)
328	If FormPath &lt;&gt; &quot;&quot; Then
329		WebWizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/web&quot;)
330		If WebWizardPath &lt;&gt; &quot;&quot; Then
331			WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
332			If Wizardpath &lt;&gt; &quot;&quot; Then
333				TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;www-back/&quot;)
334				If TexturePath &lt;&gt; &quot;&quot; Then
335					WorkPath = GetPathSettings(&quot;Work&quot;)
336					If WorkPath &lt;&gt; &quot;&quot; Then
337						TempPath = GetPathSettings(&quot;Temp&quot;)
338						If TempPath &lt;&gt; &quot;&quot; Then
339							GetFormWizardPaths = True
340							Exit Function
341						End If
342					End If
343				End If
344			End If
345		End If
346	End  If
347	DisposeDocument(oDocument)
348	GetFormWizardPaths() = False
349End Function
350
351
352Function GetFilterName(sApplicationKey as String) as String
353Dim oArgs()
354Dim oFactory
355Dim i as Integer
356Dim Maxindex as Integer
357Dim UIName as String
358	oFactory  = createUnoService(&quot;com.sun.star.document.FilterFactory&quot;)
359	oArgs() = oFactory.getByName(sApplicationKey)
360	MaxIndex = Ubound(oArgs())
361	For i = 0 to MaxIndex
362		If (oArgs(i).Name=&quot;UIName&quot;) Then
363		    UIName = oArgs(i).Value
364		    Exit For
365	  	End If
366	next i
367	GetFilterName() = UIName
368End Function
369</script:module>
370