diff options
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/formwizard/tools.xba | 363 |
1 files changed, 363 insertions, 0 deletions
diff --git a/wizards/source/formwizard/tools.xba b/wizards/source/formwizard/tools.xba new file mode 100644 index 000000000..881552717 --- /dev/null +++ b/wizards/source/formwizard/tools.xba @@ -0,0 +1,363 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<!-- + * This file is part of the LibreOffice project. + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, v. 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + * + * This file incorporates work covered by the following license notice: + * + * 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 . +--> +<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? from where? + ElseIf CurControlType = cCheckBox Then +' Todo Why does this not work?: oLocObject.DefaultState = 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 + WizardPath = GetOfficeSubPath("Template","wizard/") + If Wizardpath <> "" Then + TexturePath = GetOfficeSubPath("Gallery", "backgrounds/") + 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 + 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> |