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(100, 8) as String Public CurControlType as Integer Public CurFieldlength as Double Public CurFieldType as Integer Public CurFieldName as String Public CurControlName as String Public CurFormatKey as Long Public CurDefaultValue Public CurIsCurrency as Boolean Public CurScale as Integer Public CurHelpText as String Public FieldMetaValues(MaxFieldIndex, 8) ' Description of this List: ' CurFieldType = FieldMetaValues(Index,0) ' CurFieldLength = FieldMetaValues(Index,1) ' CurControlType = FieldMetaValues(Index,2) (ControlType eg. cLabel, cTextbox usw.) ' CurControlName = FieldMetaValues(Index,3) ' CurFormatKey = FieldMetaValues(Index,4) ' CurDefaultValue = FieldMetaValues(Index,5) ' CurIsCurrency = FieldMetaValues(Index,6) ' CurScale = FieldMetaValues(Index,7) ' CurHelpText = FieldMetaValues(Index,8) 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 RemoveShapes() End If ToggleLayoutPage(False) Select Case CurArrangement Case cTabled PositionGridControl(MaxIndex) Case Else PositionControls(MaxIndex) End Select ToggleLayoutPage(True) oProgressbar.End End Function Sub OpenFormDocument() Dim NoArgs() as new com.sun.star.beans.PropertyValue Dim oViewSettings as Object oDocument = CreateNewDocument("swriter") oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator() oProgressbar.Start("", 100) oDocument.ApplyFormDesignMode = False oController = oDocument.GetCurrentController oViewSettings = oDocument.CurrentController.ViewSettings oViewSettings.ShowTableBoundaries = False oViewSettings.ShowOnlineLayout = 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 aSize As New com.sun.star.awt.Size 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, aLabelSize) 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+1) * YPixelFactor aTBSize = GetPeerSize(oTBModel, oLocControl, "The quick brown fox...") nDBRefHeight = (aTBSize.Height+1) * YPixelFactor BasicLabelDiffHeight = Clng((nDBRefHeight - nTCHeight)/2) 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 Dim oGroupShape as Object Dim s as Integer If Not bDebug Then On Local Error GoTo WIZARDERROR End If oModel = oEvent.Source.Model SwitchBorderMode(Val(Right(oModel.Name,1))) ToggleLayoutPage(False) If CurArrangement = cTabled Then oGridModel.Border = CurBorderType Else If OldBorderType <> CurBorderType Then For i = 0 To MaxIndex If oDBShapeList(i).SupportsService("com.sun.star.drawing.GroupShape") Then oGroupShape = oDBShapeList(i) For s = 0 To oGroupShape.Count-1 oGroupShape(s).Control.Border = CurBorderType Next s Else If oDBModelList(i).PropertySetInfo.HasPropertyByName("Border") Then oDBModelList(i).Border = CurBorderType End If End If Next i End If End If ToggleLayoutPage(True) WIZARDERROR: If Err <> 0 Then Msgbox(sMsgErrMsg, 16, GetProductName()) Resume LOCERROR LOCERROR: DlgFormDB.Dispose() 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) 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 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 DialogModel.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 DialogModel .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 DialogModel 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) DialogModel.Enabled = bDoEnable If bDoEnable Then If Not bDebug Then oDocument.UnlockControllers() End If ToggleOptionButtons(DialogModel,(bWithBackGraphic = True)) ToggleAlignGroup(bDoEnable) ToggleBorderGroup(bDoEnable) Else If Not bDebug Then oDocument.LockControllers() End If 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