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