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