summaryrefslogtreecommitdiffstats
path: root/wizards/source/formwizard/tools.xba
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
commit940b4d1848e8c70ab7642901a68594e8016caffc (patch)
treeeb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /wizards/source/formwizard/tools.xba
parentInitial commit. (diff)
downloadlibreoffice-1ad18e38974bb28c3d98d0be8f7d8c18fc56de29.tar.xz
libreoffice-1ad18e38974bb28c3d98d0be8f7d8c18fc56de29.zip
Adding upstream version 1:7.0.4.upstream/1%7.0.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/formwizard/tools.xba')
-rw-r--r--wizards/source/formwizard/tools.xba363
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..35a2436e2
--- /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
+ &apos; Label
+ aPeerSize = GetPeerSize(oModel, oControl, LocText)
+ ElseIf CurControlType = cImageControl Then
+ GetPreferredWidth() = 2000
+ Exit Function
+ Else
+ aPeerSize = GetPeerSize(oModel, oControl)
+ End If
+ nWidth = aPeerSize.Width
+ &apos; We increase the preferred Width a bit so that the control does not become too small
+ &apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
+ GetPreferredWidth = (nWidth + 10) * XPixelFactor &apos; 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
+ &apos; Label
+ aPeerSize = GetPeerSize(oModel, oControl, LocText)
+ ElseIf CurControlType = cImageControl Then
+ GetPreferredHeight() = 2000
+ Exit Function
+ Else
+ aPeerSize = GetPeerSize(oModel, oControl)
+ End If
+ nHeight = aPeerSize.Height
+ &apos; We increase the preferred Height a bit so that the control does not become too small
+ &apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
+ GetPreferredHeight = (nHeight+1) * YPixelFactor &apos; 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(&quot;EffectiveMax&quot;) Then
+ If oControl.Model.EffectiveMax = 0 Then
+ &apos; 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 &gt; SBMAXTEXTSIZE Then
+ oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
+ Else
+ oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
+ End If
+ GetPeerSize() = oPeer.PreferredSize()
+ oControl.Text = &quot;&quot;
+ End If
+End Function
+
+
+Function TwipToCM(BYVAL nValue as long) as String
+ TwipToCM = trim(str(nValue / 567)) + &quot;cm&quot;
+End function
+
+
+Function TwipTo100telMM(BYVAL nValue as long) as long
+ TwipTo100telMM = nValue / 0.567
+End function
+
+
+Function TwipToPixel(BYVAL nValue as long) as long &apos; 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)
+
+&apos; PixelTo100thMM = nValue * 28 &apos; not an exact calculation
+End function
+
+
+Function PixelTo100thMMY(oControl as Object) as long
+ oPeer = oControl.GetPeer()
+ PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
+
+&apos; PixelTo100thMM = nValue * 28 &apos; 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 &lt;&gt; OldIndex Then
+ ToggleLayoutPage(False)
+ Dim sImportPath as String
+ sImportPath = Styles(CurIndex, 8)
+ bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
+ ControlCaptionsToStandardLayout()
+ ToggleLayoutPage(True, &quot;lstStyles&quot;)
+ End If
+WIZARDERROR:
+ If Err &lt;&gt; 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)
+&apos; 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
+&apos;Todo: oLocObject.DecimalAccuracy = ...
+ oLocObject.EffectiveDefault = CurDefaultValue
+&apos; Todo: HelpText???
+ End Select
+ If oLocObject.PropertySetinfo.HasPropertyByName(&quot;Width&quot;)Then &apos; Note: an Access AutoincrementField does not provide this property Width
+ oLocObject.Width = CurFieldLength + CurScale + 1
+ End If
+ If CurIsCurrency Then
+&apos;Todo: How do you set currencies?
+ End If
+ ElseIf CurControlType = cTextBox Then &apos;com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
+ If CurFieldLength = 0 Then &apos;Or oLocObject.MaxTextLen &gt; SBMAXTEXTSIZE
+ oLocObject.MaxTextLen = SBMAXTEXTSIZE
+ CurFieldLength = SBMAXTEXTSIZE
+ Else
+ oLocObject.MaxTextLen = CurFieldLength
+ End If
+ oLocObject.DefaultText = CurDefaultValue
+ ElseIf CurControlType = cDateBox Then
+&apos; Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue
+ ElseIf CurControlType = cTimeBox Then &apos; com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
+ oLocObject.DefaultTime = CurDefaultValue
+&apos; Todo: Property TimeFormat? from where?
+ ElseIf CurControlType = cCheckBox Then
+&apos; Todo Why does this not work?: oLocObject.DefaultState = CurDefaultValue
+ End If
+ If oLocObject.PropertySetInfo.HasPropertybyName(&quot;FormatKey&quot;) Then
+ On Local Error Resume Next
+ oLocObject.FormatKey = CurFormatKey
+ End If
+End Function
+
+
+&apos; 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 &gt; -2000 Then
+ oDrawPage.Remove(oShape)
+ End If
+ Next n
+End Sub
+
+
+&apos; 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 &lt; -2000 Then
+ oDrawPage.Remove(oShape)
+ End If
+ Next n
+End Sub
+
+
+
+&apos; Note: as Shapes cannot be removed from the DrawPage without destroying
+&apos; 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 &amp; 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(&quot;Template&quot;,&quot;../wizard/bitmap&quot;)
+ If FormPath &lt;&gt; &quot;&quot; Then
+ WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
+ If Wizardpath &lt;&gt; &quot;&quot; Then
+ TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;backgrounds/&quot;)
+ If TexturePath &lt;&gt; &quot;&quot; Then
+ WorkPath = GetPathSettings(&quot;Work&quot;)
+ If WorkPath &lt;&gt; &quot;&quot; Then
+ TempPath = GetPathSettings(&quot;Temp&quot;)
+ If TempPath &lt;&gt; &quot;&quot; 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(&quot;com.sun.star.document.FilterFactory&quot;)
+ oArgs() = oFactory.getByName(sApplicationKey)
+ MaxIndex = Ubound(oArgs())
+ For i = 0 to MaxIndex
+ If (oArgs(i).Name=&quot;UIName&quot;) Then
+ UIName = oArgs(i).Value
+ Exit For
+ End If
+ next i
+ GetFilterName() = UIName
+End Function
+</script:module>