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 ***** 4Option Explicit 5Public Const SBMAXTEXTSIZE = 50 6 7 8Function SetProgressValue(iValue as Integer) 9 If iValue = 0 Then 10 oProgressbar.End 11 End If 12 ProgressValue = iValue 13 oProgressbar.Value = iValue 14End Function 15 16 17Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText) 18Dim aPeerSize as new com.sun.star.awt.Size 19Dim nWidth as Integer 20Dim oControl as Object 21 If Not IsMissing(LocText) Then 22 ' 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 ' We increase the preferred Width a bit so that the control does not become too small 32 ' when we change the border from "3D" to "Flat" 33 GetPreferredWidth = (nWidth + 10) * XPixelFactor ' PixelTo100thmm(nWidth) 34End Function 35 36 37Function GetPreferredHeight(oModel as Object, Optional LocText) 38Dim aPeerSize as new com.sun.star.awt.Size 39Dim nHeight 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 GetPreferredHeight() = 2000 46 Exit Function 47 Else 48 aPeerSize = GetPeerSize(oModel, oControl) 49 End If 50 nHeight = aPeerSize.Height 51 ' We increase the preferred Height a bit so that the control does not become too small 52 ' when we change the border from "3D" to "Flat" 53 GetPreferredHeight = (nHeight+1) * YPixelFactor ' PixelTo100thmm(nHeight) 54End Function 55 56 57Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText) 58Dim oPeer as Object 59Dim aPeerSize as new com.sun.star.awt.Size 60Dim NullValue 61 oControl = oController.GetControl(oModel) 62 oPeer = oControl.GetPeer() 63 If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then 64 If oControl.Model.EffectiveMax = 0 Then 65 ' 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 > 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 = "" 95 End If 96End Function 97 98 99Function TwipToCM(BYVAL nValue as long) as String 100 TwipToCM = trim(str(nValue / 567)) + "cm" 101End function 102 103 104Function TwipTo100telMM(BYVAL nValue as long) as long 105 TwipTo100telMM = nValue / 0.567 106End function 107 108 109Function TwipToPixel(BYVAL nValue as long) as long ' not an exact calculation 110 TwipToPixel = nValue / 15 111End function 112 113 114Function PixelTo100thMMX(oControl as Object) as long 115 oPeer = oControl.GetPeer() 116 PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000) 117 118' PixelTo100thMM = nValue * 28 ' not an exact calculation 119End function 120 121 122Function PixelTo100thMMY(oControl as Object) as long 123 oPeer = oControl.GetPeer() 124 PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000) 125 126' PixelTo100thMM = nValue * 28 ' not an exact calculation 127End function 128 129 130Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point 131Dim aPoint as New com.sun.star.awt.Point 132 aPoint.X = xPos 133 aPoint.Y = yPos 134 GetPoint() = aPoint 135End Function 136 137 138Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size 139Dim aSize As New com.sun.star.awt.Size 140 aSize.Width = iWidth 141 aSize.Height = iHeight 142 GetSize() = aSize 143End Function 144 145 146Sub ImportStyles() 147Dim 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 <> 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, "lstStyles") 160 End If 161WIZARDERROR: 162 If Err <> 0 Then 163 Msgbox(sMsgErrMsg, 16, GetProductName()) 164 Resume LOCERROR 165 LOCERROR: 166 End If 167End Sub 168 169 170 171Function 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' 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'Todo: oLocObject.DecimalAccuracy = ... 190 oLocObject.EffectiveDefault = CurDefaultValue 191' Todo: HelpText??? 192 End Select 193 If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width 194 oLocObject.Width = CurFieldLength + CurScale + 1 195 End If 196 If CurIsCurrency Then 197'Todo: How do you set currencies? 198 End If 199 ElseIf CurControlType = cTextBox Then 'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR 200 If CurFieldLength = 0 Then 'Or oLocObject.MaxTextLen > 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' Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue 209 ElseIf CurControlType = cTimeBox Then ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME 210 oLocObject.DefaultTime = CurDefaultValue 211' Todo: Property TimeFormat? frome where? 212 ElseIf CurControlType = cCheckBox Then 213' Todo Why does this not work?: oLocObject.DefautState = CurDefaultValue 214 End If 215 If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then 216 On Local Error Resume Next 217 oLocObject.FormatKey = CurFormatKey 218 End If 219End Function 220 221 222' Destroy all Shapes in Nirwana 223Sub RemoveShapes() 224Dim n as Integer 225Dim oControl as Object 226Dim oShape as Object 227 For n = oDrawPage.Count-1 To 0 Step -1 228 oShape = oDrawPage(n) 229 If oShape.Position.Y > -2000 Then 230 oDrawPage.Remove(oShape) 231 End If 232 Next n 233End Sub 234 235 236' Destroy all Shapes in Nirwana 237Sub RemoveNirwanaShapes() 238Dim n as Integer 239Dim oControl as Object 240Dim oShape as Object 241 For n = oDrawPage.Count-1 To 0 Step -1 242 oShape = oDrawPage(n) 243 If oShape.Position.Y < -2000 Then 244 oDrawPage.Remove(oShape) 245 End If 246 Next n 247End Sub 248 249 250 251' Note: as Shapes cannot be removed from the DrawPage without destroying 252' the object we have to park them somewhere beyond the visible area of the page 253Sub ShapesToNirwana() 254Dim n as Integer 255Dim oControl as Object 256 For n = 0 To oDrawPage.Count-1 257 oDrawPage(n).Position = GetPoint(-20, -10000) 258 Next n 259End Sub 260 261 262Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String 263 264Dim nPostfix as Integer 265Dim sReturn as String 266 nPostfix = 2 267 sReturn = sBaseName 268 while (oContainer.hasByName(sReturn)) 269 sReturn = sBaseName & nPostfix 270 nPostfix = nPostfix + 1 271 Wend 272 CalcUniqueContentName = sReturn 273End Function 274 275 276Function CountItemsInArray(BigArray(), SearchItem) 277Dim i as Integer 278Dim MaxIndex as Integer 279Dim 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 288End Function 289 290 291Function 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 303End Function 304 305 306Function GetFormWizardPaths() as Boolean 307 FormPath = GetOfficeSubPath("Template","../wizard/bitmap") 308 If FormPath <> "" Then 309 WebWizardPath = GetOfficeSubPath("Template","wizard/web") 310 If WebWizardPath <> "" Then 311 WizardPath = GetOfficeSubPath("Template","wizard/") 312 If Wizardpath <> "" Then 313 TexturePath = GetOfficeSubPath("Gallery", "www-back/") 314 If TexturePath <> "" Then 315 WorkPath = GetPathSettings("Work") 316 If WorkPath <> "" Then 317 TempPath = GetPathSettings("Temp") 318 If TempPath <> "" 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 329End Function 330 331 332Function GetFilterName(sApplicationKey as String) as String 333Dim oArgs() 334Dim oFactory 335Dim i as Integer 336Dim Maxindex as Integer 337Dim UIName as String 338 oFactory = createUnoService("com.sun.star.document.FilterFactory") 339 oArgs() = oFactory.getByName(sApplicationKey) 340 MaxIndex = Ubound(oArgs()) 341 For i = 0 to MaxIndex 342 If (oArgs(i).Name="UIName") Then 343 UIName = oArgs(i).Value 344 Exit For 345 End If 346 next i 347 GetFilterName() = UIName 348End Function 349</script:module> 350