xref: /AOO42X/main/wizards/source/formwizard/tools.xba (revision a50a3c188f662ac107204b9ac3c4223bc01066b3)

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--***********************************************************
 *
 * 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
 *
 * Unless required by applicable law or agreed to in writing,
 * software distributed under the License is distributed on an
 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 * KIND, either express or implied.  See the License for the
 * specific language governing permissions and limitations
 * under the License.
 *
 ***********************************************************-->
<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.DefautState = 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
        WebWizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/web&quot;)
        If WebWizardPath &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;www-back/&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
    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>