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