| <?xml version="1.0" encoding="UTF-8"?> |
| <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> |
| <!--*********************************************************** |
| * |
| * Licensed to the Apache Software Foundation (ASF) under one |
| * or more contributor license agreements. See the NOTICE file |
| * distributed with this work for additional information |
| * regarding copyright ownership. The ASF licenses this file |
| * to you under the Apache License, Version 2.0 (the |
| * "License"); you may not use this file except in compliance |
| * with the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, |
| * software distributed under the License is distributed on an |
| * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| * KIND, either express or implied. See the License for the |
| * specific language governing permissions and limitations |
| * under the License. |
| * |
| ***********************************************************--> |
| <script:module xmlns:script="http://openoffice.org/2000/script" script:name="develop" script:language="StarBasic">REM ***** BASIC ***** |
| Option Explicit |
| |
| Public oDBShapeList() as Object |
| Public oTCShapeList() as Object |
| Public oDBModelList() as Object |
| Public oGroupShapeList() as Object |
| |
| Public oGridShape as Object |
| Public a as Integer |
| Public StartA as Integer |
| Public bIsFirstRun as Boolean |
| Public bIsVeryFirstRun as Boolean |
| Public bControlsareCreated as Boolean |
| Public nDBRefHeight as Long |
| Public nXTCPos&, nYTCPos&, nXDBPos&, nYDBPos&, nTCHeight&, nTCWidth&, nDBHeight&, nDBWidth& |
| |
| Dim iReduceWidth as Integer |
| |
| Function PositionControls(Maxindex as Integer) |
| Dim oTCModel as Object |
| Dim oDBModel as Object |
| Dim i as Integer |
| InitializePosSizes() |
| bIsFirstRun = True |
| bIsVeryFirstRun = True |
| a = 0 |
| StartA = 0 |
| nMaxRowY = 0 |
| nSecMaxRowY = 0 |
| If CurArrangement = cLeftJustified Or cTopJustified Then |
| DialogModel.optAlign0.State = 1 |
| End If |
| For i = 0 To MaxIndex |
| GetCurrentMetaValues(i) |
| oTCModel = InsertTextControl(i) |
| If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then |
| InsertTimeStampShape(i) |
| Else |
| InsertDBControl(i) |
| bIsVeryFirstRun = False |
| oDBModelList(i).LabelControl = oTCModel |
| End If |
| GetLabelDiffHeight(i+1) |
| ResetPosSizes(i) |
| oProgressbar.Value = i |
| Next i |
| ControlCaptionstoStandardLayout() |
| bControlsareCreated = True |
| End Function |
| |
| |
| Sub ResetPosSizes(LastIndex as Integer) |
| Select Case CurArrangement |
| Case cColumnarLeft |
| nYDBPos = nYDBPos + nDBHeight + cVertDistance |
| If (nYDBPos > cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then |
| RepositionColumnarLeftControls(LastIndex) |
| nXTCPos = nMaxColRightX + 2 * cHoriDistance |
| nXDBPos = nXTCPos + cHoriDistance + nMaxTCWidth |
| nYDBPos = cYOffset |
| bIsFirstRun = True |
| StartA = LastIndex + 1 |
| a = 0 |
| Else |
| a = a + 1 |
| End If |
| nYTCPos = nYDBPos + LABELDIFFHEIGHT |
| Case cColumnarTop |
| nYTCPos = nYDBPos + nDBHeight + cVertDistance |
| If nYTCPos > cYOffset + nFormHeight Then |
| nXDBPos = nMaxColRightX + cHoriDistance |
| nXTCPos = nXDBPos |
| nYDBPos = cYOffset + nTCHeight + cVertDistance |
| nYTCPos = cYOffset |
| bIsFirstRun = True |
| StartA = LastIndex + 1 |
| a = 0 |
| Else |
| a = a + 1 |
| End If |
| Case cLeftJustified,cTopJustified |
| If nMaxColRightX > cXOffset + nFormWidth Then |
| Dim nOldYTCPos as Long |
| nOldYTCPos = nYTCPos |
| CheckJustifiedPosition() |
| Else |
| nXTCPos = nMaxColRightX + CHoriDistance |
| If CurArrangement = cLeftJustified Then |
| nYTCPos = nYDBPos + LabelDiffHeight |
| End If |
| End If |
| a = a + 1 |
| End Select |
| End Sub |
| |
| |
| Sub RepositionColumnarLeftControls(LastIndex as Integer) |
| Dim aSize As New com.sun.star.awt.Size |
| Dim aPoint As New com.sun.star.awt.Point |
| Dim i as Integer |
| aSize = GetSize(nMaxTCWidth, nTCHeight) |
| bIsFirstRun = True |
| For i = StartA To LastIndex |
| If i = StartA Then |
| nXTCPos = oTCShapeList(i).Position.X |
| nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance |
| End If |
| ResetDBShape(oDBShapeList(i), nXDBPos) |
| CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True) |
| Next i |
| End Sub |
| |
| |
| Sub ResetDBShape(oLocDBShape as Object, iXPos as Long) |
| Dim aSize As New com.sun.star.awt.Size |
| Dim aPoint As New com.sun.star.awt.Point |
| nYDBPos = oLocDBShape.Position.Y |
| nDBWidth = oLocDBShape.Size.Width |
| nDBHeight = oLocDBShape.Size.Height |
| aPoint = GetPoint(iXPos,nYDBPos) |
| oLocDBShape.SetPosition(aPoint) |
| End Sub |
| |
| |
| Sub InitializePosSizes() |
| nXTCPos = cXOffset |
| nTCWidth = 2000 |
| nDBWidth = 2000 |
| nDBHeight = nDBRefHeight |
| iReduceWidth = 0 |
| Select Case CurArrangement |
| Case cColumnarLeft, cLeftJustified |
| GetLabelDiffHeight(0) |
| nYTCPos = cYOffset + LABELDIFFHEIGHT |
| nXDBPos = cXOffset + 3050 |
| nYDBPos = cYOffset |
| Case cColumnarTop, cTopJustified |
| nXDBPos = cXOffset |
| nYTCPos = cYOffset |
| End Select |
| End Sub |
| |
| |
| Function InsertTextControl(i as Integer) as Object |
| Dim oShape as Object |
| Dim oModel as Object |
| Dim aPoint as New com.sun.star.awt.Point |
| Dim aSize As New com.sun.star.awt.Size |
| If bControlsareCreated Then |
| Set oShape = oTCShapeList(i) |
| Set oModel = oShape.GetControl |
| If CurArrangement = cLeftJustified Then |
| nTCWidth = GetPreferredWidth(oModel, True, CurFieldname) |
| Else |
| nTCWidth = oShape.Size.Width |
| End If |
| oShape.Position = GetPoint(nXTCPos, nYTCPos) |
| If CurArrangement = cColumnarTop Then |
| oModel.Align = com.sun.star.awt.TextAlign.LEFT |
| End If |
| Else |
| oModel = CreateUnoService(oModelService(cLabel)) |
| aPoint = GetPoint(nXTCPos, nYTCPos) |
| aSize = GetSize(nTCWidth,nTCHeight) |
| Set oShape = InsertControl(oDrawPage, oModel, aPoint, aSize) |
| Set oTCShapeList(i)= oShape |
| If bIsVeryFirstRun Then |
| If CurArrangement = cColumnarTop Then |
| nYDBPos = nYTCPos + nTCHeight |
| End If |
| End If |
| nTCWidth = GetPreferredWidth(oModel, True, CurFieldName) |
| End If |
| If CurArrangement = cColumnarLeft Then |
| ' Note This If Sequence must be called before retrieving the outer Points |
| If bIsFirstRun Then |
| nMaxTCWidth = nTCWidth |
| bIsFirstRun = False |
| ElseIf nTCWidth > nMaxTCWidth Then |
| nMaxTCWidth = nTCWidth |
| End If |
| End If |
| CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight, False) |
| Select Case CurArrangement |
| Case cLeftJustified |
| nXDBPos = nMaxColRightX |
| Case cColumnarTop,cTopJustified |
| oModel.Align = com.sun.star.awt.TextAlign.LEFT |
| nXDBPos = nXTCPos |
| nYDBPos = nYTCPos + nTCHeight |
| If CurFieldLength = 20 And nDBWidth > 2 * nTCWidth Then |
| iReduceWidth = iReduceWidth + 1 |
| End If |
| End Select |
| oShape.SetSize(GetSize(nTCWidth,nTCHeight)) |
| If CurHelpText <> "" Then |
| oModel.HelpText = CurHelptext |
| End If |
| InsertTextControl = oModel |
| End Function |
| |
| |
| Sub InsertDBControl(i as Integer) |
| Dim aPoint as New com.sun.star.awt.Point |
| Dim aSize As New com.sun.star.awt.Size |
| Dim oControl as Object |
| Dim iColRightX as Long |
| |
| aPoint = GetPoint(nXDBPos, nYDBPos) |
| If bControlsAreCreated Then |
| oDBShapeList(i).Position = aPoint |
| Else |
| oDBModelList(i) = CreateUnoService(oModelService(CurControlType)) |
| oDBShapeList(i) = InsertControl(oDrawPage, oDBModelList(i), aPoint, aSize) |
| SetNumerics(oDBModelList(i), CurFieldType) |
| If CurControlType = cCheckBox Then |
| oDBModelList(i).Label = "" |
| End If |
| oDBModelList(i).DataField = CurFieldName |
| End If |
| nDBHeight = GetDBHeight(oDBModelList(i)) |
| nDBWidth = GetPreferredWidth(oDBModelList(i),True) |
| aSize = GetSize(nDBWidth,nDBHeight) |
| oDBShapeList(i).SetSize(aSize) |
| CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True) |
| End Sub |
| |
| |
| Function InsertTimeStampShape(i as Integer) as Object |
| Dim oDateModel as Object |
| Dim oTimeModel as Object |
| Dim oDateShape as Object |
| Dim oTimeShape as Object |
| Dim oDateTimeShape as Object |
| Dim aPoint as New com.sun.star.awt.Point |
| Dim aSize as New com.sun.star.awt.Size |
| Dim nDateWidth as Long |
| Dim nTimeWidth as Long |
| Dim oGroupShape as Object |
| aPoint = GetPoint(nXDBPos, nYDBPos) |
| If bControlsAreCreated Then |
| oDBShapeList(i).Position = aPoint |
| nDBWidth = oDBShapeList(i).Size.Width |
| nDBHeight = oDBShapeList(i).Size.Height |
| Else |
| oGroupShape = oDocument.CreateInstance("com.sun.star.drawing.GroupShape") |
| oGroupShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH |
| oDrawPage.Add(oGroupShape) |
| CurFieldType = com.sun.star.sdbc.DataType.DATE |
| oDateModel = CreateUnoService("com.sun.star.form.component.DateField") |
| oDateModel.DataField = CurFieldName |
| oDateShape = InsertControl(oGroupShape, oDateModel, aPoint, aSize) |
| SetNumerics(oDateModel, CurFieldType) |
| nDBHeight = GetDBHeight(oDateModel) |
| nDateWidth = GetPreferredWidth(oDateModel,True) |
| aSize = GetSize(nDateWidth,nDBHeight) |
| oDateShape.SetSize(aSize) |
| |
| CurFieldType = com.sun.star.sdbc.DataType.TIME |
| oTimeModel = CreateUnoService("com.sun.star.form.component.TimeField") |
| oTimeModel.DataField = CurFieldName |
| oTimeShape = InsertControl(oGroupShape, oTimeModel, aPoint, aSize) |
| oTimeShape.Position = GetPoint(nXDBPos + 10 + nDateWidth,nYDBPos) |
| nTimeWidth = GetPreferredWidth(oTimeModel) |
| aSize = GetSize(nTimeWidth,nDBHeight) |
| oTimeShape.SetSize(aSize) |
| nDBWidth = nDateWidth + nTimeWidth + 10 |
| oGroupShape.Position = aPoint |
| oGroupShape.Size = GetSize(nDBWidth, nDBHeight) |
| Set oDBShapeList(i)= oGroupShape |
| End If |
| CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True) |
| InsertTimeStampShape() = oDBShapeList(i) |
| End Function |
| |
| |
| ' Note: on all Controls except for the checkbox the Label has to be set |
| ' a bit under the DBControl because its Height is also smaller |
| Sub GetLabelDiffHeight(Index as Integer) |
| If (CurArrangement = cLeftJustified) Or (CurArrangement = cColumnarLeft) Then |
| If Index <= Ubound(FieldMetaValues()) Then |
| If FieldMetaValues(Index,2) = cCheckBox Then |
| LabelDiffHeight = 0 |
| Else |
| LabelDiffHeight = BasicLabelDiffHeight |
| End If |
| End If |
| End If |
| End Sub |
| |
| |
| Sub CheckJustifiedPosition() |
| Dim nLeftDist as Long |
| Dim nRightDist as Long |
| Dim oLocDBShape as Object |
| Dim oLocTextShape as Object |
| Dim nBaseWidth as Long |
| nBaseWidth = nFormWidth + cXOffset |
| nLeftDist = nMaxColRightX - nBaseWidth |
| nRightDist = nBaseWidth - nXTCPos + cHoriDistance |
| If nLeftDist < 0.5 * nRightDist and iReduceWidth > 2 Then |
| ' Fieldwidths in the line can be made smaller |
| AdjustLineWidth(StartA, a, nLeftDist, - 1) |
| If CurArrangement = cLeftjustified Then |
| nYDBPos = nMaxRowY + cVertDistance |
| nYTCPos = nYDBPos + LABELDIFFHEIGHT |
| nXTCPos = cXOffset |
| Else |
| nYTCPos = nMaxRowY + cVertDistance |
| nYDBPos = nYTCPos + nTCHeight |
| nXTCPos = cXOffset |
| nXDBPos = cXOffset |
| End If |
| bIsFirstRun = True |
| StartA = a + 1 |
| Else |
| Set oLocDBShape = oDBShapeList(a) |
| Set oLocTextShape = oTCShapeList(a) |
| If CurArrangement = cLeftJustified Then |
| If nYDBPos + nDBHeight = nMaxRowY Then |
| ' The last Control was the highes in the row |
| nYDBPos = nSecMaxRowY + cVertDistance |
| Else |
| nYDBPos = nMaxRowY + cVertDistance |
| End If |
| nYTCPos = nYDBPos + LABELDIFFHEIGHT |
| nXDBPos = cXOffset + nTCWidth |
| oLocTextShape.Position = GetPoint(cXOffset, nYTCPos) |
| oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos) |
| ' PosSizes for the next two Controls |
| nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance |
| bIsFirstRun = True |
| CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True) |
| nXDBPos = nMaxColRightX + cHoriDistance |
| Else ' cTopJustified |
| If nYDBPos + nDBHeight = nMaxRowY Then |
| ' The last Control was the highest in the row |
| nYTCPos = nSecMaxRowY + cVertDistance |
| Else |
| nYTCPos = nMaxRowY + cVertDistance |
| End If |
| nYDBPos = nYTCPOS + nTCHeight |
| nXDBPos = cXOffset |
| nXTCPos = cXOffset |
| oLocTextShape.Position = GetPoint(cXOffset, nYTCPos) |
| oLocDBShape.Position = GetPoint(cXOffset, nYDBPos) |
| bIsFirstRun = True |
| If nDBWidth > nTCWidth Then |
| CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True) |
| Else |
| CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight, True) |
| End If |
| nXTCPos = nMaxColRightX + cHoriDistance |
| nXDBPos = nXTCPos |
| End If |
| AdjustLineWidth(StartA, a-1, nRightDist, 1) |
| StartA = a |
| End If |
| iReduceWidth = 0 |
| End Sub |
| |
| |
| |
| Function GetCorrWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) as Integer |
| Dim ShapeCount as Integer |
| If WidthFactor > 0 Then |
| ShapeCount = EndIndex-StartIndex + 1 |
| Else |
| ShapeCount = iReduceWidth |
| End If |
| GetCorrWidth() = (nDist)/ShapeCount |
| End Function |
| |
| |
| Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) |
| Dim i as Integer |
| Dim oLocDBShape as Object |
| Dim oLocTCShape as Object |
| Dim CorrWidth as Integer |
| Dim bAdjustPos as Boolean |
| Dim iLocTCPosX as Long |
| Dim iLocDBPosX as Long |
| CorrWidth = GetCorrWidth(StartIndex, EndIndex, nDist, Widthfactor) |
| bAdjustPos = False |
| iLocTCPosX = cXOffset |
| For i = StartIndex To EndIndex |
| Set oLocDBShape = oDBShapeList(i) |
| Set oLocTCShape = oTCShapeList(i) |
| If bAdjustPos Then |
| oLocTCShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y) |
| If CurArrangement = cLeftJustified Then |
| iLocDBPosX = oLocTCShape.Position.X + oLocTCShape.Size.Width |
| oLocDBShape.Position = GetPoint(iLocDBPosX, oLocDBShape.Position.Y) |
| Else |
| oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight) |
| End If |
| Else |
| bAdjustPos = True |
| End If |
| If CDbl(FieldMetaValues(i,1)) > 20 or WidthFactor > 0 Then |
| If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width > oLocDBShape.Size.Width) Then |
| oLocDBShape.Size = GetSize(oLocTCShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height) |
| Else |
| oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height) |
| End If |
| End If |
| iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance |
| If CurArrangement = cTopJustified Then |
| If oLocTCShape.Size.Width > oLocDBShape.Size.Width Then |
| iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance |
| End If |
| End If |
| Next i |
| End Sub |
| |
| |
| Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean) |
| Dim nColRightX as Long |
| Dim nRowY as Long |
| Dim nOldMaxRowY as Long |
| If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then |
| If bIsDBField Then |
| ' Only at DBControls you can measure the Value of nMaxRowY |
| If bIsFirstRun Then |
| nMaxRowY = nYPos + nHeight |
| nSecMaxRowY = nMaxRowY |
| Else |
| nRowY = nYPos + nHeight |
| If nRowY >= nMaxRowY Then |
| nOldMaxRowY = nMaxRowY |
| nSecMaxRowY = nOldMaxRowY |
| nMaxRowY = nRowY |
| End If |
| End If |
| End If |
| End If |
| ' Find the outer right point |
| If bIsFirstRun Then |
| nMaxColRightX = nXPos + nWidth |
| bIsFirstRun = False |
| Else |
| nColRightX = nXPos + nWidth |
| If nColRightX > nMaxColRightX Then |
| nMaxColRightX = nColRightX |
| End If |
| End If |
| End Sub |
| |
| |
| Function PositionGridControl(MaxIndex as Integer) |
| Dim oControl as Object |
| Dim n as Integer |
| Dim oColumn as Object |
| Dim aPoint as New com.sun.star.awt.Point |
| Dim aSize as New com.sun.star.awt.Size |
| If bControlsareCreated Then |
| ShapesToNirwana() |
| End If |
| oGridModel = CreateUnoService(oModelService(cGridControl)) |
| oGridModel.Name = "Grid1" |
| aPoint = GetPoint(cXOffset, cYOffset) |
| aSize = GetSize(nFormWidth, nFormHeight) |
| oDBForm.InsertByName (oGridModel.Name, oGridModel) |
| oGridShape = InsertControl(oDrawPage, oGridModel, aPoint, aSize) |
| For n = 0 to MaxIndex |
| GetCurrentMetaValues(n) |
| If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then |
| oColumn = SetupGridColumn(oGridModel,"DateField", False, com.sun.star.sdbc.DataType.DATE, CurFieldName & " " & sDateAppendix) |
| oColumn = SetupGridColumn(oGridModel,"TimeField", False, com.sun.star.sdbc.DataType.TIME, CurFieldName & " " & sTimeAppendix) |
| Else |
| If CurControlType = cImageControl Then |
| oColumn = SetupGridColumn(oGridModel,"TextField", True, CurFieldType, CurFieldName) |
| Else |
| oColumn = SetupGridColumn(oGridModel, CurControlName, False, CurFieldType, CurFieldName) |
| End If |
| End If |
| oProgressbar.Value = n |
| next n |
| End Function |
| |
| |
| Function SetupGridColumn(oGridModel as Object, ControlName as String, bHidden as Boolean, iLocFieldType as Integer, ColName as String) as Object |
| Dim oColumn as Object |
| CurControlName = ControlName |
| oColumn = oGridModel.CreateColumn(CurControlName) |
| oColumn.Name = CalcUniqueContentName(oGridModel, CurControlName) |
| oColumn.Hidden = bHidden |
| SetNumerics(oColumn, iLocFieldType) |
| oColumn.DataField = CurFieldName |
| oColumn.Label = ColName |
| oColumn.Width = 0 ' Width of column is adjusted to Columname |
| oGridModel.insertByName(oColumn.Name, oColumn) |
| End Function |
| |
| |
| Sub ControlCaptionstoStandardLayout() |
| Dim i as Integer |
| Dim iBorderType as Integer |
| Dim oCurModel as Object |
| Dim oStyle as Object |
| Dim iStandardColor as Long |
| If CurArrangement <> cTabled Then |
| oStyle = oDocument.StyleFamilies.GetByName("ParagraphStyles").GetByName("Standard") |
| iStandardColor = oStyle.CharColor |
| For i = 0 To MaxIndex |
| oCurModel = oTCShapeList(i).GetControl |
| If i = 0 Then |
| If oCurModel.TextColor = iStandardColor Then |
| Exit Sub |
| End If |
| End If |
| oCurModel.TextColor = iStandardColor |
| Next i |
| End If |
| End Sub |
| |
| |
| Sub GroupShapesTogether() |
| Dim i as Integer |
| If CurArrangement <> cTabled Then |
| For i = 0 To MaxIndex |
| oGroupShapeList(i) = CreateUnoService("com.sun.star.drawing.ShapeCollection") |
| oGroupShapeList(i).Add(oTCShapeList(i)) |
| oGroupShapeList(i).Add(oDBShapeList(i)) |
| oDrawPage.Group(oGroupShapeList(i)) |
| Next i |
| Else |
| RemoveNirwanaShapes() |
| End If |
| End Sub</script:module> |
