REM ***** BASIC ***** Option Explicit Function SetProgressValue(iValue as Integer) If iValue = 0 Then oProgressbar.End End If ProgressValue = iValue oProgressbar.Value = iValue End Function Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText) Dim aPeerSize as new com.sun.star.awt.Size Dim nWidth as Integer Dim oControl as Object ' Todo: Wie geht das mit ImageControls ' kann nur fest verdrahtet werden If Not IsMissing(LocText) Then aPeerSize = GetPeerSize(oModel, oControl, LocText) Else aPeerSize = GetPeerSize(oModel, oControl End If nWidth = aPeerSize.Width GetPreferredWidth = PixelTo100thmm(nWidth) End Function Function GetPreferredHeight(oModel as Object, Optional LocText) Dim aPeerSize as new com.sun.star.awt.Size Dim nHeight as Integer Dim oControl as Object ' Todo: Wie geht das mit ImageControls If Not IsMissing(LocText) Then aPeerSize = GetPeerSize(oModel, oControl, LocText) Else aPeerSize = GetPeerSize(oModel, oControl) End If nHeight = aPeerSize.Height GetPreferredHeight = PixelTo100thmm(nHeight) End Function Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText) Dim oPeer as Object Dim aPeerSize as new com.sun.star.awt.Size oControl = oController.GetControl(oModel) oPeer = oControl.GetPeer() If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then ' Todo: Remove this Hack due to Bug #88391 oControl.Model.EffectiveValue = oControl.Model.EffectiveMax aPeerSize = oPeer.PreferredSize() ElseIf Not IsMissing(LocText) Then oControl.Text = LocText aPeerSize = oPeer.PreferredSize() Else oControl.Text = "2222222222" aPeerSize = oPeer.PreferredSize() oControl.Text = "" End If GetPeerSize = aPeerSize End Function Function TwipToCM(BYVAL nValue as long) as String TwipToCM = trim(str(nValue / 567)) + "cm" End function Function TwipTo100telMM(BYVAL nValue as long) as long TwipTo100telMM = nValue / 0.567 End function Function TwipToPixel(BYVAL nValue as long) as long ' nur ungefaehre Berechnung TwipToPixel = nValue / 15 End function Function PixelTo100thMM(BYVAL nValue as long) as long PixelTo100thMM = nValue * 28 ' nur ungefähre Berechnung End function Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point Dim aPoint as New com.sun.star.awt.Point aPoint.X = xPos aPoint.Y = yPos GetPoint() = aPoint End Function Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size Dim aSize As New com.sun.star.awt.Size aSize.Width = iWidth aSize.Height = iHeight GetSize() = aSize End Function Sub ImportStyles() Dim CurIndex as Integer Dim sImportPath as String Dim bWithBackGraphic as Boolean ' oDocument.LockControllers CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8) sImportPath = Styles(8,CurIndex) bWithBackGraphic = LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath) ControlCaptionsToStandardLayout() ToggleOptionButtons(oDialogModel, bWithBackGraphic) ConfigurePageStyle() ' oDocument.UnlockControllers End Sub Function SetNumerics(ByVal oLocObject as Object) as Object ' Todo: FS fragen, ob dies alles richtig ist ' Todo: Es sollte in der Hilfe darauf hingewiesen werden, dass der untere Wertbereich negativ ist. Select Case CurFieldType Case com.sun.star.sdbc.DataType.BIGINT oLocObOject.EffectiveMax = 2147483647 * 2147483647 oLocbject.EffectiveMin = -(-2147483648 * -2147483648) Case com.sun.star.sdbc.DataType.INTEGER oLocObject.EffectiveMax = 2147483647 oLocObject.EffectiveMin = -2147483648 Case com.sun.star.sdbc.DataType.SMALLINT oLocObject.EffectiveMax = 32767 oLocObject.EffectiveMin = -32768 Case com.sun.star.sdbc.DataType.TINYINT oLocObject.EffectiveMax = 127 oLocObject.EffectiveMin = -128 Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC ' Todo: Hier sollte der Numberformatter angeworfen werden um die Nachkommastellen ' festzulegen ' oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen End Select End Function ' Destroy all Shapes in Nirwana Sub RemoveShapes() Dim n as Integer Dim oControl as Object Dim oShape as Object For n = oDrawPage.Count-1 To 0 Step -1 oShape = oDrawPage(n) If oShape.Position.Y > -2000 Then oDrawPage.Remove(oShape) End If Next n End Sub ' Note as Shapes cannot be removed from the DrawPage without destroying ' the object we have to park them somewhere in Nirwana Sub ShapesToNirwana() Dim n as Integer Dim oControl as Object For n = 0 To oDrawPage.Count-1 oDrawPage(n).Position = GetPoint(-20, -10000) Next n End Sub Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String Dim nPostfix as Integer Dim sReturn as String nPostfix = 2 sReturn = sBaseName while (oContainer.hasByName(sReturn)) sReturn = sBaseName & nPostfix nPostfix = nPostfix + 1 Wend CalcUniqueContentName = sReturn End Function Function AddListtoList(FirstArray(), SecondArray(), Optional StarIndex) Dim n as Integer Dim m as Integer Dim MaxIndex as Integer MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1 If MaxIndex > -1 Then Dim ResultArray(MaxIndex) For m = 0 To Ubound(FirstArray()) ResultArray(m) = FirstArray(m) Next m For n = 0 To Ubound(SecondArray()) ResultArray(m) = SecondArray(n) m = m + 1 Next n AddListToList() = ResultArray() Else Dim NullArray() AddListToList() = NullArray() End If End Function Function CountItemsInArray(BigArray(), SearchItem) Dim i as Integer Dim MaxIndex as Integer Dim ResCount as Integer ResCount = 0 MaxIndex = Ubound(BigArray()) For i = 0 To MaxIndex If SearchItem = BigArray(i) Then ResCount = ResCount + 1 End If Next i CountItemsInArray() = ResCount End Function