Option Explicit Public oProgressbar as Object Public ProgressValue as Integer Public oDocument as Object Public oController as Object Public oForm as Object Public oDrawPage as Object Public oPageStyle as Object Public nMaxColRightX as Long Public nMaxTCWidth as Long Public nMaxRowRightX as Long Public nMaxRowY as Long Public nSecMaxRowY as Long Public MaxIndex as Integer Public CurIndex as Integer Public Const cVertDistance = 200 Public Const cHoriDistance = 300 Public nPageWidth as Long Public nPageHeight as Long Public nFormWidth as Long Public nFormHeight as Long Public nMaxHoriPos as Long Public nMaxVertPos as Long Public CONST SBALIGNLEFT = 0 Public CONST SBALIGNRIGHT = 2 Public Const SBNOBORDER = 0 Public Const SB3DBORDER = 1 Public Const SBSIMPLEBORDER = 2 Public CurArrangement as Integer Public CurBorderType as Integer Public CurAlignmode as Integer Public OldAlignMode as Integer Public OldBorderType as Integer Public OldArrangement as Integer Public Const cColumnarLeft = 1 Public Const cColumnarTop = 2 Public Const cTabled = 3 Public Const cLeftJustified = 4 Public Const cTopJustified = 5 Public Const cXOffset = 1000 Public Const cYOffset = 700 ' This is the viewed space that we lose because of the symbol bars Public Const cSymbolMargin = 2000 Public Const MaxFieldIndex = 200 Public Const cControlCollectionCount = 9 Public Const cLabel = 1 Public Const cTextBox = 2 Public Const cCheckBox = 3 Public Const cDateBox = 4 Public Const cTimeBox = 5 Public Const cNumericBox = 6 Public Const cCurrencyBox = 7 Public Const cGridControl = 8 Public Const cImageControl = 9 Public Styles(8, 50) as String Public FieldMetaValues(MaxFieldIndex,3) ' Description of this List: ' FieldMetaValues(0-MaxFieldIndex,0) (Datafieldtype) ' FieldMetaValues(0-MaxFieldIndex,1) (Datafieldlength) ' FieldMetaValues(0-MaxFieldIndex,2) (ControlType eg. cLabel, cTextbox usw.) Public FieldNames(MaxFieldIndex) as string Public oModelService(cControlCollectionCount) as String Public oGridModel as Object Function InsertControl(oContainer as Object, oControlObject as object, aPoint as Object, aSize as Object) Dim oShape as object oShape = oDocument.CreateInstance ("com.sun.star.drawing.ControlShape") oShape.Size = aSize oShape.Position = aPoint oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH oShape.control = oControlObject oContainer.Add(oShape) InsertControl() = oShape End Function Function ArrangeControls() Dim oShape as Object Dim i as Integer oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator oProgressbar.Start("", MaxIndex) If oDBForm.HasbyName("Grid1") Then oDBForm.GetByName("Grid1").Dispose End If ToggleLayoutPage(False) Select Case CurArrangement Case cTabled PositionGridControl(MaxIndex) Case Else oDocument.LockControllers() PositionControls(MaxIndex) oDocument.UnlockControllers() End Select ToggleLayoutPage(True) oProgressbar.End End Function Sub OpenFormDocument() Dim NoArgs() as new com.sun.star.beans.PropertyValue Dim oViewSettings as Object oDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 0, NoArgs()) oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator() oProgressbar.Start("", 100) oDocument.ApplyFormDesignMode = False oController = oDocument.GetCurrentController oViewSettings = oDocument.CurrentController.ViewSettings oViewSettings.ShowTableBoundaries = False oViewSettings.ShowTextBoundaries = False oViewSettings.ShowOnlineLayout = True oViewSettings.ShowHoriRuler = True oDrawPage = oDocument.DrawPage oPageStyle = oDocument.StyleFamilies.GetByName("PageStyles").GetByName("Standard") End Sub Sub InitializeLabelValues() Dim oLabelModel as Object Dim oTBModel as Object Dim oLabelShape as Object Dim oTBShape as Object Dim aTBSize As New com.sun.star.awt.Size Dim aLabelSize As New com.sun.star.awt.Size Dim aPoint As New com.sun.star.awt.Point Dim oLocControl as Object Dim oLocPeer as Object oLabelModel = CreateUnoService("com.sun.star.form.component.FixedText") oTBModel = CreateUnoService("com.sun.star.form.component.TextField") Set oLabelShape = InsertControl(oDrawPage, oLabelModel, aPoint, aSize) Set oTBShape = InsertControl(oDrawPage, oTBModel, aPoint, aSize) oLocPeer = oController.GetControl(oLabelModel).Peer XPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterX YPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterY aLabelSize = GetPeerSize(oLabelModel, oLocControl, "The quick brown fox...") nTCHeight = aLabelSize.Height * YPixelFactor aTBSize = GetPeerSize(oTBModel, oLocControl, "The quick brown fox...") nDBRefHeight = aTBSize.Height * YPixelFactor LabelDiffHeight = Clng((aTBSize.Height - aLabelSize.Height)/2) * YPixelFactor oDrawPage.Remove(oLabelShape) oDrawPage.Remove(oTBShape) End Sub Sub ConfigurePageStyle() Dim aPageSize As New com.sun.star.awt.Size Dim aSize As New com.sun.star.awt.Size oPageStyle.IsLandscape = True aPageSize = oPageStyle.Size nPageWidth = aPageSize.Width nPageHeight = aPageSize.Height aSize.Width = nPageHeight aSize.Height = nPageWidth oPageStyle.Size = aSize nPageWidth = nPageHeight nPageHeight = oPageStyle.Size.Height nFormWidth = nPageWidth - oPageStyle.RightMargin - oPageStyle.LeftMargin - 2 * cXOffset nFormHeight = nPageHeight - oPageStyle.TopMargin - oPageStyle.BottomMargin - 2 * cYOffset - cSymbolMargin End Sub ' Modify the Borders of the Controls Sub ChangeBorderLayouts(oEvent as Object) Dim oModel as Object Dim i as Integer Dim oCurModel as Object Dim sLocText as String If Not bDebug Then On Local Error GoTo WIZARDERROR End If oModel = oEvent.Source.Model SwitchBorderMode(Val(Right(oModel.Name,1))) ToggleLayoutPage(False) oDocument.LockControllers ' Todo: Auch unsichtbare Controls müssen eine neue Border bekommen ' Am besten wird hierbei das dynamische Array oDBShapeList() abgegriffen If CurArrangement = cTabled Then oGridModel.Border = CurBorderType Else If OldBorderType <> CurBorderType Then For i = 0 To MaxIndex oDBModelList(i).Border = CurBorderType Next i End If End If WIZARDERROR: If Err <> 0 Then Msgbox(sMsgErrMsg, 16, GetProductName()) Resume LOCERROR LOCERROR: End If End Sub Sub ChangeLabelAlignments(oEvent as Object) Dim i as Integer Dim oSize as New com.sun.star.awt.Size Dim oModel as Object If Not bDebug Then On Local Error GoTo WIZARDERROR End If oModel = oEvent.Source.Model SwitchAlignMode(Val(Right(oModel.Name,1))) ToggleLayoutPage(False) oDocument.LockControllers() If OldAlignMode <> CurAlignMode Then For i = 0 To MaxIndex oTCShapeList(i).GetControl.Align = CurAlignmode Next i End If If CurAlignmode = com.sun.star.awt.TextAlign.RIGHT Then For i = 0 To Ubound(oTCShapeList()) oSize = oTCShapeList(i).Size oSize.Width = oDBShapeList(i).Position.X - oTCShapeList(i).Position.X - cHoriDistance oTCShapeList(i).Size = oSize Next i End If WIZARDERROR: If Err <> 0 Then Msgbox(sMsgErrMsg, 16, GetProductName()) Resume LOCERROR LOCERROR: End If ' oDocument.UnlockControllers() ' ToggleLayoutPage(True) End Sub Sub ChangeArrangemode(oEvent as Object) Dim oModel as Object If Not bDebug Then On Local Error GoTo WIZARDERROR End If oModel = oEvent.Source.Model SwitchArrangementButtons(Val(Right(oModel.Name,1))) oModel.State = 1 DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0 If CurArrangement <> OldArrangement Then ArrangeControls() Select Case CurArrangement Case cTabled ToggleBorderGroup(False) ToggleAlignGroup(False) Case Else ' cColumnarTop,cLeftJustified, cTopJustified ToggleAlignGroup(CurArrangement = cColumnarLeft) If CurArrangement = cColumnarTop Then If CurAlignMode = com.sun.star.awt.TextAlign.RIGHT Then oDialogModel.optAlign0.State = 1 CurAlignMode = com.sun.star.awt.TextAlign.LEFT OldAlignMode = com.sun.star.awt.TextAlign.RIGHT End If End If ControlCaptionstoStandardLayout() oDBForm.Load End Select End If WIZARDERROR: If Err <> 0 Then Msgbox(sMsgErrMsg, 16, GetProductName()) Resume LOCERROR LOCERROR: End If End Sub Sub ToggleBorderGroup(bDoEnable as Boolean) With oDialogModel .hlnBorderLayout.Enabled = bDoEnable .optBorder0.Enabled = bDoEnable ' 0: No border .optBorder1.Enabled = bDoEnable ' 1: 3D border .optBorder2.Enabled = bDoEnable ' 2: simple border End With End Sub Sub ToggleAlignGroup(ByVal bDoEnable as Boolean) With oDialogModel If bDoEnable Then bDoEnable = CurArrangement = cColumnarLeft End If .hlnAlign.Enabled = bDoEnable .optAlign0.Enabled = bDoEnable .optAlign2.Enabled = bDoEnable End With End Sub Sub ToggleLayoutPage(bDoEnable as Boolean, Optional FocusControlName as String) oDialogModel.Enabled = bDoEnable If bDoEnable Then ToggleOptionButtons(oDialogModel,(bWithBackGraphic = True)) ToggleAlignGroup(bDoEnable) ToggleBorderGroup(bDoEnable) End If If Not IsMissing(FocusControlName) Then DlgFormDB.GetControl(FocusControlName).SetFocus() End If End Sub Sub DestroyControlShapes(oDrawPage as Object) Dim i as Integer Dim oShape as Object For i = oDrawPage.Count-1 To 0 Step -1 oShape = oDrawPage.GetByIndex(i) If oShape.ShapeType = "com.sun.star.drawing.ControlShape" Then oShape.Dispose() End If Next i End Sub Sub SwitchArrangementButtons(ByVal LocArrangement as Integer) OldArrangement = CurArrangement CurArrangement = LocArrangement If OldArrangement <> 0 Then DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0 End If DlgFormDB.GetControl("cmdArrange" & CurArrangement).Model.State = 1 End Sub Sub SwitchBorderMode(ByVal LocBorderType as Integer) OldBorderType = CurBorderType CurBorderType = LocBorderType End Sub Sub SwitchAlignMode(ByVal LocAlignMode as Integer) OldAlignMode = CurAlignMode CurAlignMode = LocAlignMode End Sub