1 <?xml version=
"1.0" encoding=
"UTF-8"?>
2 <!DOCTYPE script:module PUBLIC
"-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
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 .
20 <script:module xmlns:
script=
"http://openoffice.org/2000/script" script:
name=
"develop" script:
language=
"StarBasic">REM ***** BASIC *****
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
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
&, nYTCPos
&, nXDBPos
&, nYDBPos
&, nTCHeight
&, nTCWidth
&, nDBHeight
&, nDBWidth
&
37 Dim iReduceWidth as Integer
39 Function PositionControls(Maxindex as Integer)
40 Dim oTCModel as Object
41 Dim oDBModel as Object
45 bIsVeryFirstRun = True
50 If CurArrangement = cLeftJustified Or cTopJustified Then
51 DialogModel.optAlign0.State =
1
54 GetCurrentMetaValues(i)
55 oTCModel = InsertTextControl(i)
56 If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
57 InsertTimeStampShape(i)
60 bIsVeryFirstRun = False
61 oDBModelList(i).LabelControl = oTCModel
63 GetLabelDiffHeight(i+
1)
65 oProgressbar.Value = i
67 ControlCaptionstoStandardLayout()
68 bControlsareCreated = True
72 Sub ResetPosSizes(LastIndex as Integer)
73 Select Case CurArrangement
75 nYDBPos = nYDBPos + nDBHeight + cVertDistance
76 If (nYDBPos
> cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then
77 RepositionColumnarLeftControls(LastIndex)
78 nXTCPos = nMaxColRightX +
2 * cHoriDistance
79 nXDBPos = nXTCPos + cHoriDistance + nMaxTCWidth
82 StartA = LastIndex +
1
87 nYTCPos = nYDBPos + LABELDIFFHEIGHT
89 nYTCPos = nYDBPos + nDBHeight + cVertDistance
90 If nYTCPos
> cYOffset + nFormHeight Then
91 nXDBPos = nMaxColRightX + cHoriDistance
93 nYDBPos = cYOffset + nTCHeight + cVertDistance
96 StartA = LastIndex +
1
101 Case cLeftJustified,cTopJustified
102 If nMaxColRightX
> cXOffset + nFormWidth Then
103 Dim nOldYTCPos as Long
105 CheckJustifiedPosition()
107 nXTCPos = nMaxColRightX + CHoriDistance
108 If CurArrangement = cLeftJustified Then
109 nYTCPos = nYDBPos + LabelDiffHeight
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
121 aSize = GetSize(nMaxTCWidth, nTCHeight)
123 For i = StartA To LastIndex
125 nXTCPos = oTCShapeList(i).Position.X
126 nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance
128 ResetDBShape(oDBShapeList(i), nXDBPos)
129 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
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)
145 Sub InitializePosSizes()
149 nDBHeight = nDBRefHeight
151 Select Case CurArrangement
152 Case cColumnarLeft, cLeftJustified
153 GetLabelDiffHeight(
0)
154 nYTCPos = cYOffset + LABELDIFFHEIGHT
155 nXDBPos = cXOffset +
3050
157 Case cColumnarTop, cTopJustified
164 Function InsertTextControl(i as Integer) 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)
175 nTCWidth = oShape.Size.Width
177 oShape.Position = GetPoint(nXTCPos, nYTCPos)
178 If CurArrangement = cColumnarTop Then
179 oModel.Align = com.sun.star.awt.TextAlign.LEFT
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
192 nTCWidth = GetPreferredWidth(oModel, True, CurFieldName)
194 If CurArrangement = cColumnarLeft Then
195 ' Note This If Sequence must be called before retrieving the outer Points
197 nMaxTCWidth = nTCWidth
199 ElseIf nTCWidth
> nMaxTCWidth Then
200 nMaxTCWidth = nTCWidth
203 CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight, False)
204 Select Case CurArrangement
206 nXDBPos = nMaxColRightX
207 Case cColumnarTop,cTopJustified
208 oModel.Align = com.sun.star.awt.TextAlign.LEFT
210 nYDBPos = nYTCPos + nTCHeight
211 If CurFieldLength =
20 And nDBWidth
> 2 * nTCWidth Then
212 iReduceWidth = iReduceWidth +
1
215 oShape.SetSize(GetSize(nTCWidth,nTCHeight))
216 If CurHelpText
<> "" Then
217 oModel.HelpText = CurHelptext
219 InsertTextControl = oModel
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
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 =
""
239 oDBModelList(i).DataField = CurFieldName
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)
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
266 oGroupShape = oDocument.CreateInstance(
"com.sun.star.drawing.GroupShape
")
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(
"com.sun.star.form.component.DateField
")
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(
"com.sun.star.form.component.TimeField
")
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
292 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
293 InsertTimeStampShape() = oDBShapeList(i)
297 ' Note: on all Controls except for the checkbox the Label has to be set
298 ' 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
<= Ubound(FieldMetaValues()) Then
302 If FieldMetaValues(Index,
2) = cCheckBox Then
305 LabelDiffHeight = BasicLabelDiffHeight
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
< 0.5 * nRightDist and iReduceWidth
> 2 Then
322 ' 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
329 nYTCPos = nMaxRowY + cVertDistance
330 nYDBPos = nYTCPos + nTCHeight
337 Set oLocDBShape = oDBShapeList(a)
338 Set oLocTextShape = oTCShapeList(a)
339 If CurArrangement = cLeftJustified Then
340 If nYDBPos + nDBHeight = nMaxRowY Then
341 ' The last Control was the highes in the row
342 nYDBPos = nSecMaxRowY + cVertDistance
344 nYDBPos = nMaxRowY + cVertDistance
346 nYTCPos = nYDBPos + LABELDIFFHEIGHT
347 nXDBPos = cXOffset + nTCWidth
348 oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
349 oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos)
350 ' PosSizes for the next two Controls
351 nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
353 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
354 nXDBPos = nMaxColRightX + cHoriDistance
355 Else
' cTopJustified
356 If nYDBPos + nDBHeight = nMaxRowY Then
357 ' The last Control was the highest in the row
358 nYTCPos = nSecMaxRowY + cVertDistance
360 nYTCPos = nMaxRowY + cVertDistance
362 nYDBPos = nYTCPOS + nTCHeight
365 oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
366 oLocDBShape.Position = GetPoint(cXOffset, nYDBPos)
368 If nDBWidth
> nTCWidth Then
369 CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
371 CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight, True)
373 nXTCPos = nMaxColRightX + cHoriDistance
376 AdjustLineWidth(StartA, a-
1, nRightDist,
1)
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
> 0 Then
387 ShapeCount = EndIndex-StartIndex +
1
389 ShapeCount = iReduceWidth
391 GetCorrWidth() = (nDist)/ShapeCount
395 Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor 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)
405 iLocTCPosX = cXOffset
406 For i = StartIndex To EndIndex
407 Set oLocDBShape = oDBShapeList(i)
408 Set oLocTCShape = oTCShapeList(i)
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)
415 oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight)
420 If CDbl(FieldMetaValues(i,
1))
> 20 or WidthFactor
> 0 Then
421 If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width
> oLocDBShape.Size.Width) Then
422 oLocDBShape.Size = GetSize(oLocTCShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
424 oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
427 iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
428 If CurArrangement = cTopJustified Then
429 If oLocTCShape.Size.Width
> oLocDBShape.Size.Width Then
430 iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance
437 Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean)
438 Dim nColRightX as Long
440 Dim nOldMaxRowY as Long
441 If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then
443 ' Only at DBControls you can measure the Value of nMaxRowY
445 nMaxRowY = nYPos + nHeight
446 nSecMaxRowY = nMaxRowY
448 nRowY = nYPos + nHeight
449 If nRowY
>= nMaxRowY Then
450 nOldMaxRowY = nMaxRowY
451 nSecMaxRowY = nOldMaxRowY
457 ' Find the outer right point
459 nMaxColRightX = nXPos + nWidth
462 nColRightX = nXPos + nWidth
463 If nColRightX
> nMaxColRightX Then
464 nMaxColRightX = nColRightX
470 Function PositionGridControl(MaxIndex as Integer)
471 Dim oControl as Object
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
479 oGridModel = CreateUnoService(oModelService(cGridControl))
480 oGridModel.Name =
"Grid1
"
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,
"DateField
", False, com.sun.star.sdbc.DataType.DATE, CurFieldName
& " " & sDateAppendix)
489 oColumn = SetupGridColumn(oGridModel,
"TimeField
", False, com.sun.star.sdbc.DataType.TIME, CurFieldName
& " " & sTimeAppendix)
491 If CurControlType = cImageControl Then
492 oColumn = SetupGridColumn(oGridModel,
"TextField
", True, CurFieldType, CurFieldName)
494 oColumn = SetupGridColumn(oGridModel, CurControlName, False, CurFieldType, CurFieldName)
497 oProgressbar.Value = n
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 ' Width of column is adjusted to Columname
512 oGridModel.insertByName(oColumn.Name, oColumn)
516 Sub ControlCaptionstoStandardLayout()
518 Dim iBorderType as Integer
519 Dim oCurModel as Object
521 Dim iStandardColor as Long
522 If CurArrangement
<> cTabled Then
523 oStyle = oDocument.StyleFamilies.GetByName(
"ParagraphStyles
").GetByName(
"Standard
")
524 iStandardColor = oStyle.CharColor
525 For i =
0 To MaxIndex
526 oCurModel = oTCShapeList(i).GetControl
528 If oCurModel.TextColor = iStandardColor Then
532 oCurModel.TextColor = iStandardColor
538 Sub GroupShapesTogether()
540 If CurArrangement
<> cTabled Then
541 For i =
0 To MaxIndex
542 oGroupShapeList(i) = CreateUnoService(
"com.sun.star.drawing.ShapeCollection
")
543 oGroupShapeList(i).Add(oTCShapeList(i))
544 oGroupShapeList(i).Add(oDBShapeList(i))
545 oDrawPage.Group(oGroupShapeList(i))
548 RemoveNirwanaShapes()
550 End Sub
</script:module>