wizards/source/formwizard/develop.xba

   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  *****
   4 Option Explicit
   5
   6 Public oDBShapeList() as Object
   7 Public oTCShapeList() as Object
   8 Public oDBModelList() as Object
   9 Public oGroupShapeList() as Object
  10
  11 Public oGridShape as Object
  12 Public a as Integer
  13 Public StartA as Integer
  14 Public bIsFirstRun as Boolean
  15 Public bIsVeryFirstRun as Boolean
  16 Public bControlsareCreated as Boolean
  17 Public nDBRefHeight as Long
  18 Public nXTCPos&amp;, nYTCPos&amp;, nXDBPos&amp;, nYDBPos&amp;, nTCHeight&amp;, nTCWidth&amp;, nDBHeight&amp;, nDBWidth&amp;
  19
  20 Dim iReduceWidth as Integer
  21
  22 Function PositionControls(Maxindex as Integer)
  23 Dim oTCModel as Object
  24 Dim oDBModel as Object
  25 Dim 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
  52 End Function
  53
  54
  55 Sub ResetPosSizes(LastIndex as Integer)
  56         Select Case CurArrangement
  57                 Case cColumnarLeft
  58                         nYDBPos = nYDBPos  + nDBHeight + cVertDistance
  59                         If (nYDBPos &gt; 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 &gt; 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 &gt; 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
  97 End Sub
  98
  99
 100 Sub     RepositionColumnarLeftControls(LastIndex as Integer)
 101 Dim aSize As New com.sun.star.awt.Size
 102 Dim aPoint As New com.sun.star.awt.Point
 103 Dim 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
 114 End Sub
 115
 116
 117 Sub ResetDBShape(oLocDBShape as Object, iXPos as Long)
 118 Dim aSize As New com.sun.star.awt.Size
 119 Dim 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)
 125 End Sub
 126
 127
 128 Sub 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
 144 End Sub
 145
 146
 147 Function InsertTextControl(i as Integer) as Object
 148 Dim oShape as Object
 149 Dim oModel as Object
 150 Dim aPoint as New com.sun.star.awt.Point
 151 Dim 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                 &apos; 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 &gt; 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 &gt; 2 * nTCWidth Then
 195                                 iReduceWidth = iReduceWidth + 1
 196                         End If
 197         End Select
 198         oShape.SetSize(GetSize(nTCWidth,nTCHeight))
 199         If CurHelpText &lt;&gt; &quot;&quot; Then
 200                 oModel.HelpText = CurHelptext
 201         End If
 202         InsertTextControl = oModel
 203 End Function
 204
 205
 206 Sub InsertDBControl(i as Integer)
 207 Dim aPoint as New com.sun.star.awt.Point
 208 Dim aSize As New com.sun.star.awt.Size
 209 Dim oControl as Object
 210 Dim 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 = &quot;&quot;
 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)
 229 End Sub
 230
 231
 232 Function InsertTimeStampShape(i as Integer) as Object
 233 Dim oDateModel as Object
 234 Dim oTimeModel as Object
 235 Dim oDateShape as Object
 236 Dim oTimeShape as Object
 237 Dim oDateTimeShape as Object
 238 Dim aPoint as New com.sun.star.awt.Point
 239 Dim aSize as New com.sun.star.awt.Size
 240 Dim nDateWidth as Long
 241 Dim nTimeWidth as Long
 242 Dim 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(&quot;com.sun.star.drawing.GroupShape&quot;)
 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(&quot;com.sun.star.form.component.DateField&quot;)
 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(&quot;com.sun.star.form.component.TimeField&quot;)
 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)
 277 End Function
 278
 279
 280 &apos; Note: on all Controls except for the checkbox the Label has to be set
 281 &apos; a bit under the DBControl because its Height is also smaller
 282 Sub GetLabelDiffHeight(Index as Integer)
 283         If (CurArrangement = cLeftJustified) Or (CurArrangement = cColumnarLeft) Then
 284                 If Index &lt;= 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
 292 End Sub
 293
 294
 295 Sub CheckJustifiedPosition()
 296 Dim nLeftDist as Long
 297 Dim nRightDist as Long
 298 Dim oLocDBShape as Object
 299 Dim oLocTextShape as Object
 300 Dim nBaseWidth as Long
 301         nBaseWidth = nFormWidth + cXOffset
 302         nLeftDist = nMaxColRightX - nBaseWidth
 303         nRightDist = nBaseWidth - nXTCPos + cHoriDistance
 304         If nLeftDist &lt; 0.5 * nRightDist and iReduceWidth &gt; 2 Then
 305                 &apos; 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                                 &apos; 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                         &apos; 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            &apos; cTopJustified
 339                         If nYDBPos + nDBHeight = nMaxRowY Then
 340                                 &apos; 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 &gt; 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
 363 End Sub
 364
 365
 366
 367 Function GetCorrWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) as Integer
 368 Dim ShapeCount as Integer
 369         If WidthFactor &gt; 0 Then
 370                 ShapeCount = EndIndex-StartIndex + 1
 371         Else
 372                 ShapeCount = iReduceWidth
 373         End If
 374         GetCorrWidth() = (nDist)/ShapeCount
 375 End Function
 376
 377
 378 Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer)
 379 Dim i as Integer
 380 Dim oLocDBShape as Object
 381 Dim oLocTCShape as Object
 382 Dim CorrWidth as Integer
 383 Dim bAdjustPos as Boolean
 384 Dim iLocTCPosX as Long
 385 Dim 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)) &gt; 20 or WidthFactor &gt; 0 Then
 404                         If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width &gt; 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 &gt; oLocDBShape.Size.Width Then
 413                                 iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance
 414                         End If
 415                 End If
 416         Next i
 417 End Sub
 418
 419
 420 Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean)
 421 Dim nColRightX as Long
 422 Dim nRowY as Long
 423 Dim nOldMaxRowY as Long
 424         If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then
 425                 If bIsDBField Then
 426                         &apos; 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 &gt;= nMaxRowY Then
 433                                         nOldMaxRowY = nMaxRowY
 434                                         nSecMaxRowY = nOldMaxRowY
 435                                         nMaxRowY = nRowY
 436                                 End If
 437                         End If
 438                 End If
 439         End If
 440         &apos; 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 &gt; nMaxColRightX Then
 447                         nMaxColRightX = nColRightX
 448                 End If
 449         End If
 450 End Sub
 451
 452
 453 Function PositionGridControl(MaxIndex as Integer)
 454 Dim oControl as Object
 455 Dim n as Integer
 456 Dim oColumn as Object
 457 Dim aPoint as New com.sun.star.awt.Point
 458 Dim 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 = &quot;Grid1&quot;
 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,&quot;DateField&quot;, False, com.sun.star.sdbc.DataType.DATE, CurFieldName &amp; &quot; &quot; &amp; sDateAppendix)
 472                         oColumn = SetupGridColumn(oGridModel,&quot;TimeField&quot;, False, com.sun.star.sdbc.DataType.TIME, CurFieldName &amp; &quot; &quot; &amp; sTimeAppendix)
 473             Else
 474                         If CurControlType = cImageControl Then
 475                                 oColumn = SetupGridColumn(oGridModel,&quot;TextField&quot;, 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
 482 End Function
 483
 484
 485 Function SetupGridColumn(oGridModel as Object, ControlName as String, bHidden as Boolean, iLocFieldType as Integer, ColName as String) as Object
 486 Dim 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       &apos; Width of column is adjusted to Columname
 495         oGridModel.insertByName(oColumn.Name, oColumn)
 496 End Function
 497
 498
 499 Sub ControlCaptionstoStandardLayout()
 500 Dim i as Integer
 501 Dim iBorderType as Integer
 502 Dim oCurModel as Object
 503 Dim oStyle as Object
 504 Dim iStandardColor as Long
 505         If CurArrangement &lt;&gt; cTabled Then
 506                 oStyle = oDocument.StyleFamilies.GetByName(&quot;ParagraphStyles&quot;).GetByName(&quot;Standard&quot;)
 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
 518 End Sub
 519
 520
 521 Sub GroupShapesTogether()
 522 Dim i as Integer
 523         If CurArrangement &lt;&gt; cTabled Then
 524                 For i = 0 To MaxIndex
 525                         oGroupShapeList(i) = CreateUnoService(&quot;com.sun.star.drawing.ShapeCollection&quot;)
 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
 533 End Sub</script:module>