diff options
Diffstat (limited to 'wizards/source/formwizard/tools.xba')
-rw-r--r-- | wizards/source/formwizard/tools.xba | 349 |
1 files changed, 0 insertions, 349 deletions
diff --git a/wizards/source/formwizard/tools.xba b/wizards/source/formwizard/tools.xba deleted file mode 100644 index 8b40b8379..000000000 --- a/wizards/source/formwizard/tools.xba +++ /dev/null @@ -1,349 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> -<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC ***** -Option Explicit -Public Const SBMAXTEXTSIZE = 50 - - -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 - If Not IsMissing(LocText) Then - ' Label - aPeerSize = GetPeerSize(oModel, oControl, LocText) - ElseIf CurControlType = cImageControl Then - GetPreferredWidth() = 2000 - Exit Function - Else - aPeerSize = GetPeerSize(oModel, oControl) - End If - nWidth = aPeerSize.Width - ' We increase the preferred Width a bit so that the control does not become too small - ' when we change the border from "3D" to "Flat" - GetPreferredWidth = (nWidth + 10) * XPixelFactor ' 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 - If Not IsMissing(LocText) Then - ' Label - aPeerSize = GetPeerSize(oModel, oControl, LocText) - ElseIf CurControlType = cImageControl Then - GetPreferredHeight() = 2000 - Exit Function - Else - aPeerSize = GetPeerSize(oModel, oControl) - End If - nHeight = aPeerSize.Height - ' We increase the preferred Height a bit so that the control does not become too small - ' when we change the border from "3D" to "Flat" - GetPreferredHeight = (nHeight+1) * YPixelFactor ' 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 -Dim NullValue - oControl = oController.GetControl(oModel) - oPeer = oControl.GetPeer() - If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then - If oControl.Model.EffectiveMax = 0 Then - ' This is relevant for decimal fields - oControl.Model.EffectiveValue = 999.9999 - Else - oControl.Model.EffectiveValue = oControl.Model.EffectiveMax - End If - GetPeerSize() = oPeer.PreferredSize() - oControl.Model.EffectiveValue = NullValue - ElseIf Not IsMissing(LocText) Then - oControl.Text = LocText - GetPeerSize() = oPeer.PreferredSize() - ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then - GetPeerSize() = oPeer.PreferredSize() - ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then - GetPeerSize() = oPeer.PreferredSize() - ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then - oControl.Model.Date = Date - GetPeerSize() = oPeer.PreferredSize() - oControl.Model.Date = NullValue - ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then - oControl.Time = Time - GetPeerSize() = oPeer.PreferredSize() - oControl.Time = NullValue - Else - If oControl.MaxTextLen > SBMAXTEXTSIZE Then - oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE) - Else - oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen) - End If - GetPeerSize() = oPeer.PreferredSize() - oControl.Text = "" - End If -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 ' not an exact calculation - TwipToPixel = nValue / 15 -End function - - -Function PixelTo100thMMX(oControl as Object) as long - oPeer = oControl.GetPeer() - PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000) - -' PixelTo100thMM = nValue * 28 ' not an exact calculation -End function - - -Function PixelTo100thMMY(oControl as Object) as long - oPeer = oControl.GetPeer() - PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000) - -' PixelTo100thMM = nValue * 28 ' not an exact calculation -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 OldIndex as Integer - If Not bDebug Then - On Local Error GoTo WIZARDERROR - End If - OldIndex = CurIndex - CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8) - If CurIndex <> OldIndex Then - ToggleLayoutPage(False) - Dim sImportPath as String - sImportPath = Styles(CurIndex, 8) - bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath) - ControlCaptionsToStandardLayout() - ToggleLayoutPage(True, "lstStyles") - End If -WIZARDERROR: - If Err <> 0 Then - Msgbox(sMsgErrMsg, 16, GetProductName()) - Resume LOCERROR - LOCERROR: - End If -End Sub - - - -Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object - If CurControlType = cNumericBox Then - oLocObject.TreatAsNumber = True - Select Case iLocFieldType - Case com.sun.star.sdbc.DataType.BIGINT - oLocObject.EffectiveMax = 2147483647 * 2147483647 - oLocObject.EffectiveMin = -(-2147483648 * -2147483648) -' oLocObject.DecimalAccuracy = 0 - 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: oLocObject.DecimalAccuracy = ... - oLocObject.EffectiveDefault = CurDefaultValue -' Todo: HelpText??? - End Select - If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width - oLocObject.Width = CurFieldLength + CurScale + 1 - End If - If CurIsCurrency Then -'Todo: How do you set currencies? - End If - ElseIf CurControlType = cTextBox Then 'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR - If CurFieldLength = 0 Then 'Or oLocObject.MaxTextLen > SBMAXTEXTSIZE - oLocObject.MaxTextLen = SBMAXTEXTSIZE - CurFieldLength = SBMAXTEXTSIZE - Else - oLocObject.MaxTextLen = CurFieldLength - End If - oLocObject.DefaultText = CurDefaultValue - ElseIf CurControlType = cDateBox Then -' Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue - ElseIf CurControlType = cTimeBox Then ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME - oLocObject.DefaultTime = CurDefaultValue -' Todo: Property TimeFormat? frome where? - ElseIf CurControlType = cCheckBox Then -' Todo Why does this not work?: oLocObject.DefautState = CurDefaultValue - End If - If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then - On Local Error Resume Next - oLocObject.FormatKey = CurFormatKey - End If -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 - - -' Destroy all Shapes in Nirwana -Sub RemoveNirwanaShapes() -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 beyond the visible area of the page -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 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 - - -Function GetDBHeight(oDBModel as Object) - If CurControlType = cImageControl Then - nDBHeight = 2000 - Else - If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then - oDBModel.MultiLine = True - nDBHeight = nDBRefHeight * 4 - Else - nDBHeight = nDBRefHeight - End If - End If - GetDBHeight() = nDBHeight -End Function - - -Function GetFormWizardPaths() as Boolean - FormPath = GetOfficeSubPath("Template","../wizard/bitmap") - If FormPath <> "" Then - WebWizardPath = GetOfficeSubPath("Template","wizard/web") - If WebWizardPath <> "" Then - WizardPath = GetOfficeSubPath("Template","wizard/") - If Wizardpath <> "" Then - TexturePath = GetOfficeSubPath("Gallery", "www-back/") - If TexturePath <> "" Then - WorkPath = GetPathSettings("Work") - If WorkPath <> "" Then - TempPath = GetPathSettings("Temp") - If TempPath <> "" Then - GetFormWizardPaths = True - Exit Function - End If - End If - End If - End If - End If - End If - DisposeDocument(oDocument) - GetFormWizardPaths() = False -End Function - - -Function GetFilterName(sApplicationKey as String) as String -Dim oArgs() -Dim oFactory -Dim i as Integer -Dim Maxindex as Integer -Dim UIName as String - oFactory = createUnoService("com.sun.star.document.FilterFactory") - oArgs() = oFactory.getByName(sApplicationKey) - MaxIndex = Ubound(oArgs()) - For i = 0 to MaxIndex - If (oArgs(i).Name="UIName") Then - UIName = oArgs(i).Value - Exit For - End If - next i - GetFilterName() = UIName -End Function -</script:module> |