wizards/source/formwizard/tools.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <!--
   4  * This file is part of the LibreOffice project.
   5  *
   6  * This Source Code Form is subject to the terms of the Mozilla Public
   7  * License, v. 2.0. If a copy of the MPL was not distributed with this
   8  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
   9  *
  10  * This file incorporates work covered by the following license notice:
  11  *
  12  *   Licensed to the Apache Software Foundation (ASF) under one or more
  13  *   contributor license agreements. See the NOTICE file distributed
  14  *   with this work for additional information regarding copyright
  15  *   ownership. The ASF licenses this file to you under the Apache
  16  *   License, Version 2.0 (the "License"); you may not use this file
  17  *   except in compliance with the License. You may obtain a copy of
  18  *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  19 -->
  20 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM  *****  BASIC  *****
  21 Option Explicit
  22 Public Const SBMAXTEXTSIZE = 50
  23
  24
  25 Function SetProgressValue(iValue as Integer)
  26         If iValue = 0 Then
  27                 oProgressbar.End
  28         End If
  29         ProgressValue = iValue
  30         oProgressbar.Value = iValue
  31 End Function
  32
  33
  34 Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
  35 Dim aPeerSize as new com.sun.star.awt.Size
  36 Dim nWidth as Integer
  37 Dim oControl as Object
  38         If Not IsMissing(LocText) Then
  39                 &apos; Label
  40                 aPeerSize = GetPeerSize(oModel, oControl, LocText)
  41         ElseIf CurControlType = cImageControl Then
  42                 GetPreferredWidth() = 2000
  43                 Exit Function
  44         Else
  45                 aPeerSize = GetPeerSize(oModel, oControl)
  46         End If
  47         nWidth = aPeerSize.Width
  48         &apos; We increase the preferred Width a bit so that the control does not become too small
  49         &apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
  50         GetPreferredWidth = (nWidth + 10) * XPixelFactor        &apos; PixelTo100thmm(nWidth)
  51 End Function
  52
  53
  54 Function GetPreferredHeight(oModel as Object, Optional LocText)
  55 Dim aPeerSize as new com.sun.star.awt.Size
  56 Dim nHeight as Integer
  57 Dim oControl as Object
  58         If Not IsMissing(LocText) Then
  59                 &apos; Label
  60                 aPeerSize = GetPeerSize(oModel, oControl, LocText)
  61         ElseIf CurControlType = cImageControl Then
  62                 GetPreferredHeight() = 2000
  63                 Exit Function
  64         Else
  65                 aPeerSize = GetPeerSize(oModel, oControl)
  66         End If
  67         nHeight = aPeerSize.Height
  68         &apos; We increase the preferred Height a bit so that the control does not become too small
  69         &apos; when we change the border from &quot;3D&quot; to &quot;Flat&quot;
  70         GetPreferredHeight = (nHeight+1) * YPixelFactor         &apos; PixelTo100thmm(nHeight)
  71 End Function
  72
  73
  74 Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
  75 Dim oPeer as Object
  76 Dim aPeerSize as new com.sun.star.awt.Size
  77 Dim NullValue
  78         oControl = oController.GetControl(oModel)
  79         oPeer = oControl.GetPeer()
  80         If oControl.Model.PropertySetInfo.HasPropertybyName(&quot;EffectiveMax&quot;) Then
  81                 If oControl.Model.EffectiveMax = 0 Then
  82                         &apos; This is relevant for decimal fields
  83                         oControl.Model.EffectiveValue = 999.9999
  84                 Else
  85                         oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
  86                 End If
  87                 GetPeerSize() = oPeer.PreferredSize()
  88                 oControl.Model.EffectiveValue = NullValue
  89         ElseIf Not IsMissing(LocText) Then
  90                 oControl.Text = LocText
  91                 GetPeerSize() = oPeer.PreferredSize()
  92         ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
  93                 GetPeerSize() = oPeer.PreferredSize()
  94         ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
  95                 GetPeerSize() = oPeer.PreferredSize()
  96         ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
  97                 oControl.Model.Date = Date
  98                 GetPeerSize() = oPeer.PreferredSize()
  99                 oControl.Model.Date = NullValue
 100         ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
 101                 oControl.Time = Time
 102                 GetPeerSize() = oPeer.PreferredSize()
 103                 oControl.Time = NullValue
 104         Else
 105                 If oControl.MaxTextLen &gt; SBMAXTEXTSIZE Then
 106                         oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
 107                 Else
 108                         oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
 109                 End If
 110                 GetPeerSize() = oPeer.PreferredSize()
 111                 oControl.Text = &quot;&quot;
 112         End If
 113 End Function
 114
 115
 116 Function TwipToCM(ByVal nValue as long) as String
 117         TwipToCM = trim(str(nValue / 567)) + &quot;cm&quot;
 118 End function
 119
 120
 121 Function TwipTo100telMM(ByVal nValue as long) as long
 122          TwipTo100telMM = nValue / 0.567
 123 End function
 124
 125
 126 Function TwipToPixel(ByVal nValue as long) as long &apos; not an exact calculation
 127         TwipToPixel = nValue / 15
 128 End function
 129
 130
 131 Function PixelTo100thMMX(oControl as Object) as long
 132         oPeer = oControl.GetPeer()
 133         PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
 134
 135 &apos;   PixelTo100thMM = nValue * 28                                   &apos; not an exact calculation
 136 End function
 137
 138
 139 Function PixelTo100thMMY(oControl as Object) as long
 140         oPeer = oControl.GetPeer()
 141         PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
 142
 143 &apos;   PixelTo100thMM = nValue * 28                                   &apos; not an exact calculation
 144 End function
 145
 146
 147 Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
 148 Dim aPoint as New com.sun.star.awt.Point
 149         aPoint.X = xPos
 150         aPoint.Y = yPos
 151         GetPoint() = aPoint
 152 End Function
 153
 154
 155 Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
 156 Dim aSize As New com.sun.star.awt.Size
 157         aSize.Width = iWidth
 158         aSize.Height = iHeight
 159         GetSize() = aSize
 160 End Function
 161
 162
 163 Sub     ImportStyles()
 164 Dim OldIndex as Integer
 165         If Not bDebug Then
 166                 On Local Error GoTo WIZARDERROR
 167         End If
 168         OldIndex = CurIndex
 169         CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
 170         If CurIndex &lt;&gt; OldIndex Then
 171                 ToggleLayoutPage(False)
 172                 Dim sImportPath as String
 173                 sImportPath = Styles(CurIndex, 8)
 174                 bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
 175                 ControlCaptionsToStandardLayout()
 176                 ToggleLayoutPage(True, &quot;lstStyles&quot;)
 177         End If
 178 WIZARDERROR:
 179         If Err &lt;&gt; 0 Then
 180                 Msgbox(sMsgErrMsg, 16, GetProductName())
 181                 Resume LOCERROR
 182                 LOCERROR:
 183         End If
 184 End Sub
 185
 186
 187
 188 Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
 189         If CurControlType = cNumericBox Then
 190                 oLocObject.TreatAsNumber = True
 191                 Select Case iLocFieldType
 192                         Case com.sun.star.sdbc.DataType.BIGINT
 193                                 oLocObject.EffectiveMax = 2147483647 * 2147483647
 194                                 oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
 195 &apos;                          oLocObject.DecimalAccuracy = 0
 196                         Case com.sun.star.sdbc.DataType.INTEGER
 197                                 oLocObject.EffectiveMax = 2147483647
 198                                 oLocObject.EffectiveMin = -2147483648
 199                         Case com.sun.star.sdbc.DataType.SMALLINT
 200                                 oLocObject.EffectiveMax = 32767
 201                                 oLocObject.EffectiveMin = -32768
 202                         Case com.sun.star.sdbc.DataType.TINYINT
 203                                 oLocObject.EffectiveMax = 127
 204                                 oLocObject.EffectiveMin = -128
 205                         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
 206 &apos;Todo:                     oLocObject.DecimalAccuracy = ...
 207                                 oLocObject.EffectiveDefault = CurDefaultValue
 208 &apos; Todo: HelpText???
 209                 End Select
 210                 If oLocObject.PropertySetinfo.HasPropertyByName(&quot;Width&quot;)Then &apos; Note: an Access AutoincrementField does not provide this property Width
 211                         oLocObject.Width = CurFieldLength + CurScale + 1
 212                 End If
 213                 If CurIsCurrency Then
 214 &apos;Todo: How do you set currencies?
 215                 End If
 216         ElseIf CurControlType = cTextBox Then   &apos;com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
 217                 If CurFieldLength = 0 Then                       &apos;Or oLocObject.MaxTextLen &gt; SBMAXTEXTSIZE
 218                         oLocObject.MaxTextLen = SBMAXTEXTSIZE
 219                         CurFieldLength = SBMAXTEXTSIZE
 220                 Else
 221                         oLocObject.MaxTextLen = CurFieldLength
 222                 End If
 223                 oLocObject.DefaultText = CurDefaultValue
 224         ElseIf CurControlType = cDateBox Then
 225 &apos; Todo Why does this not work?:            oLocObject.DefaultDate = CurDefaultValue
 226         ElseIf CurControlType = cTimeBox Then   &apos; com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
 227                 oLocObject.DefaultTime = CurDefaultValue
 228 &apos; Todo: Property TimeFormat? from where?
 229         ElseIf CurControlType = cCheckBox Then
 230 &apos; Todo Why does this not work?:            oLocObject.DefaultState = CurDefaultValue
 231         End If
 232         If oLocObject.PropertySetInfo.HasPropertybyName(&quot;FormatKey&quot;) Then
 233                 On Local Error Resume Next
 234                 oLocObject.FormatKey = CurFormatKey
 235         End If
 236 End Function
 237
 238
 239 &apos; Destroy all Shapes in Nirwana
 240 Sub RemoveShapes()
 241 Dim n as Integer
 242 Dim oControl as Object
 243 Dim oShape as Object
 244         For n = oDrawPage.Count-1 To 0 Step -1
 245                 oShape = oDrawPage(n)
 246                 If oShape.Position.Y &gt; -2000 Then
 247                         oDrawPage.Remove(oShape)
 248                 End If
 249         Next n
 250 End Sub
 251
 252
 253 &apos; Destroy all Shapes in Nirwana
 254 Sub RemoveNirwanaShapes()
 255 Dim n as Integer
 256 Dim oControl as Object
 257 Dim oShape as Object
 258         For n = oDrawPage.Count-1 To 0 Step -1
 259                 oShape = oDrawPage(n)
 260                 If oShape.Position.Y &lt; -2000 Then
 261                         oDrawPage.Remove(oShape)
 262                 End If
 263         Next n
 264 End Sub
 265
 266
 267
 268 &apos; Note: as Shapes cannot be removed from the DrawPage without destroying
 269 &apos; the object we have to park them somewhere beyond the visible area of the page
 270 Sub ShapesToNirwana()
 271 Dim n as Integer
 272 Dim oControl as Object
 273         For n = 0 To oDrawPage.Count-1
 274                 oDrawPage(n).Position = GetPoint(-20, -10000)
 275         Next n
 276 End Sub
 277
 278
 279 Function CalcUniqueContentName(ByVal oContainer as Object, sBaseName as String) as String
 280
 281 Dim nPostfix as Integer
 282 Dim sReturn as String
 283         nPostfix = 2
 284         sReturn = sBaseName
 285         while (oContainer.hasByName(sReturn))
 286                 sReturn = sBaseName &amp; nPostfix
 287                 nPostfix = nPostfix + 1
 288         Wend
 289         CalcUniqueContentName = sReturn
 290 End Function
 291
 292
 293 Function CountItemsInArray(BigArray(), SearchItem)
 294 Dim i as Integer
 295 Dim MaxIndex as Integer
 296 Dim ResCount as Integer
 297         ResCount = 0
 298         MaxIndex = Ubound(BigArray())
 299         For i = 0 To MaxIndex
 300                 If SearchItem = BigArray(i) Then
 301                         ResCount = ResCount + 1
 302                 End If
 303         Next i
 304         CountItemsInArray() = ResCount
 305 End Function
 306
 307
 308 Function GetDBHeight(oDBModel as Object)
 309         If CurControlType = cImageControl Then
 310                 nDBHeight = 2000
 311         Else
 312                 If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
 313                         oDBModel.MultiLine = True
 314                         nDBHeight = nDBRefHeight * 4
 315                 Else
 316                         nDBHeight = nDBRefHeight
 317                 End If
 318         End If
 319         GetDBHeight() = nDBHeight
 320 End Function
 321
 322
 323 Function GetFormWizardPaths() as Boolean
 324         FormPath = GetOfficeSubPath(&quot;Template&quot;,&quot;../wizard/bitmap&quot;)
 325         If FormPath &lt;&gt; &quot;&quot; Then
 326                 WizardPath = GetOfficeSubPath(&quot;Template&quot;,&quot;wizard/&quot;)
 327                 If Wizardpath &lt;&gt; &quot;&quot; Then
 328                         TexturePath = GetOfficeSubPath(&quot;Gallery&quot;, &quot;backgrounds/&quot;)
 329                         If TexturePath &lt;&gt; &quot;&quot; Then
 330                                 WorkPath = GetPathSettings(&quot;Work&quot;)
 331                                 If WorkPath &lt;&gt; &quot;&quot; Then
 332                                         TempPath = GetPathSettings(&quot;Temp&quot;)
 333                                         If TempPath &lt;&gt; &quot;&quot; Then
 334                                                 GetFormWizardPaths = True
 335                                                 Exit Function
 336                                         End If
 337                                 End If
 338                         End If
 339                 End If
 340         End  If
 341         DisposeDocument(oDocument)
 342         GetFormWizardPaths() = False
 343 End Function
 344
 345
 346 Function GetFilterName(sApplicationKey as String) as String
 347 Dim oArgs()
 348 Dim oFactory
 349 Dim i as Integer
 350 Dim Maxindex as Integer
 351 Dim UIName as String
 352         oFactory  = createUnoService(&quot;com.sun.star.document.FilterFactory&quot;)
 353         oArgs() = oFactory.getByName(sApplicationKey)
 354         MaxIndex = Ubound(oArgs())
 355         For i = 0 to MaxIndex
 356                 If (oArgs(i).Name=&quot;UIName&quot;) Then
 357                     UIName = oArgs(i).Value
 358                     Exit For
 359                 End If
 360         next i
 361         GetFilterName() = UIName
 362 End Function
 363 </script:module>