63c508e3e8
118568: switch to using ucpp
Patch contributed by Juergen Schmidt
http://svn.apache.org/viewvc?view=revision&revision=1209396
366 lines
11 KiB
XML
366 lines
11 KiB
XML
<?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? 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>
|