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