bump product version to 5.0.4.1
[LibreOffice.git] / wizards / source / formwizard / develop.xba
blob238ac15545358c5536506c305e59d5c485931231
1 <?xml version="1.0" encoding="UTF-8"?>
2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3 <!--
4 * This file is part of the LibreOffice project.
6 * This Source Code Form is subject to the terms of the Mozilla Public
7 * License, v. 2.0. If a copy of the MPL was not distributed with this
8 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
10 * This file incorporates work covered by the following license notice:
12 * Licensed to the Apache Software Foundation (ASF) under one or more
13 * contributor license agreements. See the NOTICE file distributed
14 * with this work for additional information regarding copyright
15 * ownership. The ASF licenses this file to you under the Apache
16 * License, Version 2.0 (the "License"); you may not use this file
17 * except in compliance with the License. You may obtain a copy of
18 * the License at http://www.apache.org/licenses/LICENSE-2.0 .
19 -->
20 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="develop" script:language="StarBasic">REM ***** BASIC *****
21 Option Explicit
23 Public oDBShapeList() as Object
24 Public oTCShapeList() as Object
25 Public oDBModelList() as Object
26 Public oGroupShapeList() as Object
28 Public oGridShape as Object
29 Public a as Integer
30 Public StartA as Integer
31 Public bIsFirstRun as Boolean
32 Public bIsVeryFirstRun as Boolean
33 Public bControlsareCreated as Boolean
34 Public nDBRefHeight as Long
35 Public nXTCPos&amp;, nYTCPos&amp;, nXDBPos&amp;, nYDBPos&amp;, nTCHeight&amp;, nTCWidth&amp;, nDBHeight&amp;, nDBWidth&amp;
37 Dim iReduceWidth as Integer
39 Function PositionControls(Maxindex as Integer)
40 Dim oTCModel as Object
41 Dim oDBModel as Object
42 Dim i as Integer
43 InitializePosSizes()
44 bIsFirstRun = True
45 bIsVeryFirstRun = True
46 a = 0
47 StartA = 0
48 nMaxRowY = 0
49 nSecMaxRowY = 0
50 If CurArrangement = cLeftJustified Or cTopJustified Then
51 DialogModel.optAlign0.State = 1
52 End If
53 For i = 0 To MaxIndex
54 GetCurrentMetaValues(i)
55 oTCModel = InsertTextControl(i)
56 If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
57 InsertTimeStampShape(i)
58 Else
59 InsertDBControl(i)
60 bIsVeryFirstRun = False
61 oDBModelList(i).LabelControl = oTCModel
62 End If
63 GetLabelDiffHeight(i+1)
64 ResetPosSizes(i)
65 oProgressbar.Value = i
66 Next i
67 ControlCaptionstoStandardLayout()
68 bControlsareCreated = True
69 End Function
72 Sub ResetPosSizes(LastIndex as Integer)
73 Select Case CurArrangement
74 Case cColumnarLeft
75 nYDBPos = nYDBPos + nDBHeight + cVertDistance
76 If (nYDBPos &gt; cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then
77 RepositionColumnarLeftControls(LastIndex)
78 nXTCPos = nMaxColRightX + 2 * cHoriDistance
79 nXDBPos = nXTCPos + cHoriDistance + nMaxTCWidth
80 nYDBPos = cYOffset
81 bIsFirstRun = True
82 StartA = LastIndex + 1
83 a = 0
84 Else
85 a = a + 1
86 End If
87 nYTCPos = nYDBPos + LABELDIFFHEIGHT
88 Case cColumnarTop
89 nYTCPos = nYDBPos + nDBHeight + cVertDistance
90 If nYTCPos &gt; cYOffset + nFormHeight Then
91 nXDBPos = nMaxColRightX + cHoriDistance
92 nXTCPos = nXDBPos
93 nYDBPos = cYOffset + nTCHeight + cVertDistance
94 nYTCPos = cYOffset
95 bIsFirstRun = True
96 StartA = LastIndex + 1
97 a = 0
98 Else
99 a = a + 1
100 End If
101 Case cLeftJustified,cTopJustified
102 If nMaxColRightX &gt; cXOffset + nFormWidth Then
103 Dim nOldYTCPos as Long
104 nOldYTCPos = nYTCPos
105 CheckJustifiedPosition()
106 Else
107 nXTCPos = nMaxColRightX + CHoriDistance
108 If CurArrangement = cLeftJustified Then
109 nYTCPos = nYDBPos + LabelDiffHeight
110 End If
111 End If
112 a = a + 1
113 End Select
114 End Sub
117 Sub RepositionColumnarLeftControls(LastIndex as Integer)
118 Dim aSize As New com.sun.star.awt.Size
119 Dim aPoint As New com.sun.star.awt.Point
120 Dim i as Integer
121 aSize = GetSize(nMaxTCWidth, nTCHeight)
122 bIsFirstRun = True
123 For i = StartA To LastIndex
124 If i = StartA Then
125 nXTCPos = oTCShapeList(i).Position.X
126 nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance
127 End If
128 ResetDBShape(oDBShapeList(i), nXDBPos)
129 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
130 Next i
131 End Sub
134 Sub ResetDBShape(oLocDBShape as Object, iXPos as Long)
135 Dim aSize As New com.sun.star.awt.Size
136 Dim aPoint As New com.sun.star.awt.Point
137 nYDBPos = oLocDBShape.Position.Y
138 nDBWidth = oLocDBShape.Size.Width
139 nDBHeight = oLocDBShape.Size.Height
140 aPoint = GetPoint(iXPos,nYDBPos)
141 oLocDBShape.SetPosition(aPoint)
142 End Sub
145 Sub InitializePosSizes()
146 nXTCPos = cXOffset
147 nTCWidth = 2000
148 nDBWidth = 2000
149 nDBHeight = nDBRefHeight
150 iReduceWidth = 0
151 Select Case CurArrangement
152 Case cColumnarLeft, cLeftJustified
153 GetLabelDiffHeight(0)
154 nYTCPos = cYOffset + LABELDIFFHEIGHT
155 nXDBPos = cXOffset + 3050
156 nYDBPos = cYOffset
157 Case cColumnarTop, cTopJustified
158 nXDBPos = cXOffset
159 nYTCPos = cYOffset
160 End Select
161 End Sub
164 Function InsertTextControl(i as Integer) as Object
165 Dim oShape as Object
166 Dim oModel as Object
167 Dim aPoint as New com.sun.star.awt.Point
168 Dim aSize As New com.sun.star.awt.Size
169 If bControlsareCreated Then
170 Set oShape = oTCShapeList(i)
171 Set oModel = oShape.GetControl
172 If CurArrangement = cLeftJustified Then
173 nTCWidth = GetPreferredWidth(oModel, True, CurFieldname)
174 Else
175 nTCWidth = oShape.Size.Width
176 End If
177 oShape.Position = GetPoint(nXTCPos, nYTCPos)
178 If CurArrangement = cColumnarTop Then
179 oModel.Align = com.sun.star.awt.TextAlign.LEFT
180 End If
181 Else
182 oModel = CreateUnoService(oModelService(cLabel))
183 aPoint = GetPoint(nXTCPos, nYTCPos)
184 aSize = GetSize(nTCWidth,nTCHeight)
185 Set oShape = InsertControl(oDrawPage, oModel, aPoint, aSize)
186 Set oTCShapeList(i)= oShape
187 If bIsVeryFirstRun Then
188 If CurArrangement = cColumnarTop Then
189 nYDBPos = nYTCPos + nTCHeight
190 End If
191 End If
192 nTCWidth = GetPreferredWidth(oModel, True, CurFieldName)
193 End If
194 If CurArrangement = cColumnarLeft Then
195 &apos; Note This If Sequence must be called before retrieving the outer Points
196 If bIsFirstRun Then
197 nMaxTCWidth = nTCWidth
198 bIsFirstRun = False
199 ElseIf nTCWidth &gt; nMaxTCWidth Then
200 nMaxTCWidth = nTCWidth
201 End If
202 End If
203 CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight, False)
204 Select Case CurArrangement
205 Case cLeftJustified
206 nXDBPos = nMaxColRightX
207 Case cColumnarTop,cTopJustified
208 oModel.Align = com.sun.star.awt.TextAlign.LEFT
209 nXDBPos = nXTCPos
210 nYDBPos = nYTCPos + nTCHeight
211 If CurFieldLength = 20 And nDBWidth &gt; 2 * nTCWidth Then
212 iReduceWidth = iReduceWidth + 1
213 End If
214 End Select
215 oShape.SetSize(GetSize(nTCWidth,nTCHeight))
216 If CurHelpText &lt;&gt; &quot;&quot; Then
217 oModel.HelpText = CurHelptext
218 End If
219 InsertTextControl = oModel
220 End Function
223 Sub InsertDBControl(i as Integer)
224 Dim aPoint as New com.sun.star.awt.Point
225 Dim aSize As New com.sun.star.awt.Size
226 Dim oControl as Object
227 Dim iColRightX as Long
229 aPoint = GetPoint(nXDBPos, nYDBPos)
230 If bControlsAreCreated Then
231 oDBShapeList(i).Position = aPoint
232 Else
233 oDBModelList(i) = CreateUnoService(oModelService(CurControlType))
234 oDBShapeList(i) = InsertControl(oDrawPage, oDBModelList(i), aPoint, aSize)
235 SetNumerics(oDBModelList(i), CurFieldType)
236 If CurControlType = cCheckBox Then
237 oDBModelList(i).Label = &quot;&quot;
238 End If
239 oDBModelList(i).DataField = CurFieldName
240 End If
241 nDBHeight = GetDBHeight(oDBModelList(i))
242 nDBWidth = GetPreferredWidth(oDBModelList(i),True)
243 aSize = GetSize(nDBWidth,nDBHeight)
244 oDBShapeList(i).SetSize(aSize)
245 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
246 End Sub
249 Function InsertTimeStampShape(i as Integer) as Object
250 Dim oDateModel as Object
251 Dim oTimeModel as Object
252 Dim oDateShape as Object
253 Dim oTimeShape as Object
254 Dim oDateTimeShape as Object
255 Dim aPoint as New com.sun.star.awt.Point
256 Dim aSize as New com.sun.star.awt.Size
257 Dim nDateWidth as Long
258 Dim nTimeWidth as Long
259 Dim oGroupShape as Object
260 aPoint = GetPoint(nXDBPos, nYDBPos)
261 If bControlsAreCreated Then
262 oDBShapeList(i).Position = aPoint
263 nDBWidth = oDBShapeList(i).Size.Width
264 nDBHeight = oDBShapeList(i).Size.Height
265 Else
266 oGroupShape = oDocument.CreateInstance(&quot;com.sun.star.drawing.GroupShape&quot;)
267 oGroupShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
268 oDrawPage.Add(oGroupShape)
269 CurFieldType = com.sun.star.sdbc.DataType.DATE
270 oDateModel = CreateUnoService(&quot;com.sun.star.form.component.DateField&quot;)
271 oDateModel.DataField = CurFieldName
272 oDateShape = InsertControl(oGroupShape, oDateModel, aPoint, aSize)
273 SetNumerics(oDateModel, CurFieldType)
274 nDBHeight = GetDBHeight(oDateModel)
275 nDateWidth = GetPreferredWidth(oDateModel,True)
276 aSize = GetSize(nDateWidth,nDBHeight)
277 oDateShape.SetSize(aSize)
279 CurFieldType = com.sun.star.sdbc.DataType.TIME
280 oTimeModel = CreateUnoService(&quot;com.sun.star.form.component.TimeField&quot;)
281 oTimeModel.DataField = CurFieldName
282 oTimeShape = InsertControl(oGroupShape, oTimeModel, aPoint, aSize)
283 oTimeShape.Position = GetPoint(nXDBPos + 10 + nDateWidth,nYDBPos)
284 nTimeWidth = GetPreferredWidth(oTimeModel)
285 aSize = GetSize(nTimeWidth,nDBHeight)
286 oTimeShape.SetSize(aSize)
287 nDBWidth = nDateWidth + nTimeWidth + 10
288 oGroupShape.Position = aPoint
289 oGroupShape.Size = GetSize(nDBWidth, nDBHeight)
290 Set oDBShapeList(i)= oGroupShape
291 End If
292 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
293 InsertTimeStampShape() = oDBShapeList(i)
294 End Function
297 &apos; Note: on all Controls except for the checkbox the Label has to be set
298 &apos; a bit under the DBControl because its Height is also smaller
299 Sub GetLabelDiffHeight(Index as Integer)
300 If (CurArrangement = cLeftJustified) Or (CurArrangement = cColumnarLeft) Then
301 If Index &lt;= Ubound(FieldMetaValues()) Then
302 If FieldMetaValues(Index,2) = cCheckBox Then
303 LabelDiffHeight = 0
304 Else
305 LabelDiffHeight = BasicLabelDiffHeight
306 End If
307 End If
308 End If
309 End Sub
312 Sub CheckJustifiedPosition()
313 Dim nLeftDist as Long
314 Dim nRightDist as Long
315 Dim oLocDBShape as Object
316 Dim oLocTextShape as Object
317 Dim nBaseWidth as Long
318 nBaseWidth = nFormWidth + cXOffset
319 nLeftDist = nMaxColRightX - nBaseWidth
320 nRightDist = nBaseWidth - nXTCPos + cHoriDistance
321 If nLeftDist &lt; 0.5 * nRightDist and iReduceWidth &gt; 2 Then
322 &apos; Fieldwidths in the line can be made smaller
323 AdjustLineWidth(StartA, a, nLeftDist, - 1)
324 If CurArrangement = cLeftjustified Then
325 nYDBPos = nMaxRowY + cVertDistance
326 nYTCPos = nYDBPos + LABELDIFFHEIGHT
327 nXTCPos = cXOffset
328 Else
329 nYTCPos = nMaxRowY + cVertDistance
330 nYDBPos = nYTCPos + nTCHeight
331 nXTCPos = cXOffset
332 nXDBPos = cXOffset
333 End If
334 bIsFirstRun = True
335 StartA = a + 1
336 Else
337 Set oLocDBShape = oDBShapeList(a)
338 Set oLocTextShape = oTCShapeList(a)
339 If CurArrangement = cLeftJustified Then
340 If nYDBPos + nDBHeight = nMaxRowY Then
341 &apos; The last Control was the highes in the row
342 nYDBPos = nSecMaxRowY + cVertDistance
343 Else
344 nYDBPos = nMaxRowY + cVertDistance
345 End If
346 nYTCPos = nYDBPos + LABELDIFFHEIGHT
347 nXDBPos = cXOffset + nTCWidth
348 oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
349 oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos)
350 &apos; PosSizes for the next two Controls
351 nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
352 bIsFirstRun = True
353 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
354 nXDBPos = nMaxColRightX + cHoriDistance
355 Else &apos; cTopJustified
356 If nYDBPos + nDBHeight = nMaxRowY Then
357 &apos; The last Control was the highest in the row
358 nYTCPos = nSecMaxRowY + cVertDistance
359 Else
360 nYTCPos = nMaxRowY + cVertDistance
361 End If
362 nYDBPos = nYTCPOS + nTCHeight
363 nXDBPos = cXOffset
364 nXTCPos = cXOffset
365 oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
366 oLocDBShape.Position = GetPoint(cXOffset, nYDBPos)
367 bIsFirstRun = True
368 If nDBWidth &gt; nTCWidth Then
369 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
370 Else
371 CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight, True)
372 End If
373 nXTCPos = nMaxColRightX + cHoriDistance
374 nXDBPos = nXTCPos
375 End If
376 AdjustLineWidth(StartA, a-1, nRightDist, 1)
377 StartA = a
378 End If
379 iReduceWidth = 0
380 End Sub
384 Function GetCorrWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) as Integer
385 Dim ShapeCount as Integer
386 If WidthFactor &gt; 0 Then
387 ShapeCount = EndIndex-StartIndex + 1
388 Else
389 ShapeCount = iReduceWidth
390 End If
391 GetCorrWidth() = (nDist)/ShapeCount
392 End Function
395 Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer)
396 Dim i as Integer
397 Dim oLocDBShape as Object
398 Dim oLocTCShape as Object
399 Dim CorrWidth as Integer
400 Dim bAdjustPos as Boolean
401 Dim iLocTCPosX as Long
402 Dim iLocDBPosX as Long
403 CorrWidth = GetCorrWidth(StartIndex, EndIndex, nDist, Widthfactor)
404 bAdjustPos = False
405 iLocTCPosX = cXOffset
406 For i = StartIndex To EndIndex
407 Set oLocDBShape = oDBShapeList(i)
408 Set oLocTCShape = oTCShapeList(i)
409 If bAdjustPos Then
410 oLocTCShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y)
411 If CurArrangement = cLeftJustified Then
412 iLocDBPosX = oLocTCShape.Position.X + oLocTCShape.Size.Width
413 oLocDBShape.Position = GetPoint(iLocDBPosX, oLocDBShape.Position.Y)
414 Else
415 oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight)
416 End If
417 Else
418 bAdjustPos = True
419 End If
420 If CDbl(FieldMetaValues(i,1)) &gt; 20 or WidthFactor &gt; 0 Then
421 If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width &gt; oLocDBShape.Size.Width) Then
422 oLocDBShape.Size = GetSize(oLocTCShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
423 Else
424 oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
425 End If
426 End If
427 iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
428 If CurArrangement = cTopJustified Then
429 If oLocTCShape.Size.Width &gt; oLocDBShape.Size.Width Then
430 iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance
431 End If
432 End If
433 Next i
434 End Sub
437 Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean)
438 Dim nColRightX as Long
439 Dim nRowY as Long
440 Dim nOldMaxRowY as Long
441 If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then
442 If bIsDBField Then
443 &apos; Only at DBControls you can measure the Value of nMaxRowY
444 If bIsFirstRun Then
445 nMaxRowY = nYPos + nHeight
446 nSecMaxRowY = nMaxRowY
447 Else
448 nRowY = nYPos + nHeight
449 If nRowY &gt;= nMaxRowY Then
450 nOldMaxRowY = nMaxRowY
451 nSecMaxRowY = nOldMaxRowY
452 nMaxRowY = nRowY
453 End If
454 End If
455 End If
456 End If
457 &apos; Find the outer right point
458 If bIsFirstRun Then
459 nMaxColRightX = nXPos + nWidth
460 bIsFirstRun = False
461 Else
462 nColRightX = nXPos + nWidth
463 If nColRightX &gt; nMaxColRightX Then
464 nMaxColRightX = nColRightX
465 End If
466 End If
467 End Sub
470 Function PositionGridControl(MaxIndex as Integer)
471 Dim oControl as Object
472 Dim n as Integer
473 Dim oColumn as Object
474 Dim aPoint as New com.sun.star.awt.Point
475 Dim aSize as New com.sun.star.awt.Size
476 If bControlsareCreated Then
477 ShapesToNirwana()
478 End If
479 oGridModel = CreateUnoService(oModelService(cGridControl))
480 oGridModel.Name = &quot;Grid1&quot;
481 aPoint = GetPoint(cXOffset, cYOffset)
482 aSize = GetSize(nFormWidth, nFormHeight)
483 oDBForm.InsertByName (oGridModel.Name, oGridModel)
484 oGridShape = InsertControl(oDrawPage, oGridModel, aPoint, aSize)
485 For n = 0 to MaxIndex
486 GetCurrentMetaValues(n)
487 If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
488 oColumn = SetupGridColumn(oGridModel,&quot;DateField&quot;, False, com.sun.star.sdbc.DataType.DATE, CurFieldName &amp; &quot; &quot; &amp; sDateAppendix)
489 oColumn = SetupGridColumn(oGridModel,&quot;TimeField&quot;, False, com.sun.star.sdbc.DataType.TIME, CurFieldName &amp; &quot; &quot; &amp; sTimeAppendix)
490 Else
491 If CurControlType = cImageControl Then
492 oColumn = SetupGridColumn(oGridModel,&quot;TextField&quot;, True, CurFieldType, CurFieldName)
493 Else
494 oColumn = SetupGridColumn(oGridModel, CurControlName, False, CurFieldType, CurFieldName)
495 End If
496 End If
497 oProgressbar.Value = n
498 next n
499 End Function
502 Function SetupGridColumn(oGridModel as Object, ControlName as String, bHidden as Boolean, iLocFieldType as Integer, ColName as String) as Object
503 Dim oColumn as Object
504 CurControlName = ControlName
505 oColumn = oGridModel.CreateColumn(CurControlName)
506 oColumn.Name = CalcUniqueContentName(oGridModel, CurControlName)
507 oColumn.Hidden = bHidden
508 SetNumerics(oColumn, iLocFieldType)
509 oColumn.DataField = CurFieldName
510 oColumn.Label = ColName
511 oColumn.Width = 0 &apos; Width of column is adjusted to Columname
512 oGridModel.insertByName(oColumn.Name, oColumn)
513 End Function
516 Sub ControlCaptionstoStandardLayout()
517 Dim i as Integer
518 Dim iBorderType as Integer
519 Dim oCurModel as Object
520 Dim oStyle as Object
521 Dim iStandardColor as Long
522 If CurArrangement &lt;&gt; cTabled Then
523 oStyle = oDocument.StyleFamilies.GetByName(&quot;ParagraphStyles&quot;).GetByName(&quot;Standard&quot;)
524 iStandardColor = oStyle.CharColor
525 For i = 0 To MaxIndex
526 oCurModel = oTCShapeList(i).GetControl
527 If i = 0 Then
528 If oCurModel.TextColor = iStandardColor Then
529 Exit Sub
530 End If
531 End If
532 oCurModel.TextColor = iStandardColor
533 Next i
534 End If
535 End Sub
538 Sub GroupShapesTogether()
539 Dim i as Integer
540 If CurArrangement &lt;&gt; cTabled Then
541 For i = 0 To MaxIndex
542 oGroupShapeList(i) = CreateUnoService(&quot;com.sun.star.drawing.ShapeCollection&quot;)
543 oGroupShapeList(i).Add(oTCShapeList(i))
544 oGroupShapeList(i).Add(oDBShapeList(i))
545 oDrawPage.Group(oGroupShapeList(i))
546 Next i
547 Else
548 RemoveNirwanaShapes()
549 End If
550 End Sub</script:module>