home *** CD-ROM | disk | FTP | other *** search
/ Freelog 52 / Freelog052.iso / Dossier / OpenOffice / f_0175 / tools.xba < prev   
Extensible Markup Language  |  2003-03-27  |  11KB  |  343 lines

  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.         ' 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)
  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.         ' 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)
  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("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.DATE Then
  78.         oControl.Model.Date = Date
  79.         GetPeerSize() = oPeer.PreferredSize()
  80.         oControl.Model.Date = NullValue
  81.     ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
  82.         oControl.Time = Time
  83.         GetPeerSize() = oPeer.PreferredSize()
  84.         oControl.Time = NullValue
  85.     Else
  86.         If oControl.MaxTextLen > SBMAXTEXTSIZE Then
  87.             oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
  88.         Else
  89.             oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
  90.         End If        
  91.         GetPeerSize() = oPeer.PreferredSize()
  92.         oControl.Text = ""
  93.     End If
  94. End Function
  95.  
  96.  
  97. Function TwipToCM(BYVAL nValue as long) as String
  98.     TwipToCM = trim(str(nValue / 567)) + "cm"
  99. End function
  100.  
  101.  
  102. Function TwipTo100telMM(BYVAL nValue as long) as long
  103.      TwipTo100telMM = nValue / 0.567
  104. End function
  105.  
  106.  
  107. Function TwipToPixel(BYVAL nValue as long) as long ' not an exact calculation
  108.     TwipToPixel = nValue / 15
  109. End function
  110.  
  111.  
  112. Function PixelTo100thMMX(oControl as Object) as long
  113.     oPeer = oControl.GetPeer()
  114.     PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
  115.  
  116. '     PixelTo100thMM = nValue * 28                    ' not an exact calculation
  117. End function
  118.  
  119.  
  120. Function PixelTo100thMMY(oControl as Object) as long
  121.     oPeer = oControl.GetPeer()
  122.     PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
  123.  
  124. '     PixelTo100thMM = nValue * 28                    ' not an exact calculation 
  125. End function
  126.  
  127.  
  128. Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
  129. Dim aPoint as New com.sun.star.awt.Point
  130.     aPoint.X = xPos
  131.     aPoint.Y = yPos
  132.     GetPoint() = aPoint
  133. End Function
  134.  
  135.  
  136. Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
  137. Dim aSize As New com.sun.star.awt.Size
  138.     aSize.Width = iWidth
  139.     aSize.Height = iHeight
  140.     GetSize() = aSize
  141. End Function
  142.  
  143.  
  144. Sub    ImportStyles()
  145. Dim OldIndex as Integer
  146.     If Not bDebug Then
  147.         On Local Error GoTo WIZARDERROR
  148.     End If
  149.     OldIndex = CurIndex
  150.     CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
  151.     If CurIndex <> OldIndex Then    
  152.         ToggleLayoutPage(False)
  153.         Dim sImportPath as String
  154.         sImportPath = Styles(CurIndex, 8)
  155.         bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
  156.         ControlCaptionsToStandardLayout()
  157.         ToggleLayoutPage(True, "lstStyles")    
  158.     End If
  159. WIZARDERROR:
  160.     If Err <> 0 Then    
  161.         Msgbox(sMsgErrMsg, 16, GetProductName())
  162.         Resume LOCERROR
  163.         LOCERROR:        
  164.     End If
  165. End Sub
  166.  
  167.  
  168.  
  169. Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object    
  170.     If CurControlType = cNumericBox Then
  171.         oLocObject.TreatAsNumber = True
  172.         Select Case iLocFieldType
  173.             Case com.sun.star.sdbc.DataType.BIGINT
  174.                 oLocObject.EffectiveMax = 2147483647 * 2147483647
  175.                 oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
  176. '                oLocObject.DecimalAccuracy = 0
  177.             Case com.sun.star.sdbc.DataType.INTEGER
  178.                 oLocObject.EffectiveMax = 2147483647
  179.                 oLocObject.EffectiveMin = -2147483648
  180.             Case com.sun.star.sdbc.DataType.SMALLINT
  181.                 oLocObject.EffectiveMax = 32767
  182.                 oLocObject.EffectiveMin = -32768
  183.             Case com.sun.star.sdbc.DataType.TINYINT
  184.                 oLocObject.EffectiveMax = 127
  185.                 oLocObject.EffectiveMin = -128
  186.             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
  187. 'Todo:            oLocObject.DecimalAccuracy = ...
  188.                  oLocObject.EffectiveDefault = CurDefaultValue
  189. ' Todo: HelpText???
  190.         End Select
  191.         If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width
  192.             oLocObject.Width = CurFieldLength + CurScale + 1
  193.         End If
  194.         If CurIsCurrency Then
  195. 'Todo: How do you set currencies?
  196.         End If
  197.     ElseIf CurControlType = cTextBox Then    'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
  198.         If CurFieldLength = 0 Then             'Or oLocObject.MaxTextLen > SBMAXTEXTSIZE
  199.             oLocObject.MaxTextLen = SBMAXTEXTSIZE
  200.             CurFieldLength = SBMAXTEXTSIZE
  201.         Else
  202.             oLocObject.MaxTextLen = CurFieldLength
  203.         End If
  204.         oLocObject.DefaultText = CurDefaultValue
  205.     ElseIf CurControlType = cDateBox Then
  206. ' Todo Why does this not work?:        oLocObject.DefaultDate = CurDefaultValue
  207.     ElseIf CurControlType = cTimeBox Then    ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
  208.         oLocObject.DefaultTime = CurDefaultValue
  209. ' Todo: Property TimeFormat? frome where?
  210.     ElseIf CurControlType = cCheckBox Then
  211. ' Todo Why does this not work?:        oLocObject.DefautState = CurDefaultValue
  212.     End If
  213.     If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then
  214.         On Local Error Resume Next
  215.         oLocObject.FormatKey = CurFormatKey
  216.     End If
  217. End Function
  218.  
  219.  
  220. ' Destroy all Shapes in Nirwana
  221. Sub RemoveShapes()
  222. Dim n as Integer
  223. Dim oControl as Object
  224. Dim oShape as Object
  225.     For n = oDrawPage.Count-1 To 0 Step -1
  226.         oShape = oDrawPage(n)
  227.         If oShape.Position.Y > -2000 Then
  228.             oDrawPage.Remove(oShape)
  229.         End If
  230.     Next n
  231. End Sub
  232.  
  233.  
  234. ' Destroy all Shapes in Nirwana
  235. Sub RemoveNirwanaShapes()
  236. Dim n as Integer
  237. Dim oControl as Object
  238. Dim oShape as Object
  239.     For n = oDrawPage.Count-1 To 0 Step -1
  240.         oShape = oDrawPage(n)
  241.         If oShape.Position.Y < -2000 Then
  242.             oDrawPage.Remove(oShape)
  243.         End If
  244.     Next n
  245. End Sub
  246.  
  247.  
  248.  
  249. ' Note: as Shapes cannot be removed from the DrawPage without destroying
  250. ' the object we have to park them somewhere beyond the visible area of the page
  251. Sub ShapesToNirwana()
  252. Dim n as Integer
  253. Dim oControl as Object
  254.     For n = 0 To oDrawPage.Count-1
  255.         oDrawPage(n).Position = GetPoint(-20, -10000)
  256.     Next n
  257. End Sub
  258.  
  259.  
  260. Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String
  261.  
  262. Dim nPostfix as Integer
  263. Dim sReturn as String
  264.     nPostfix = 2
  265.     sReturn = sBaseName
  266.     while (oContainer.hasByName(sReturn))
  267.         sReturn = sBaseName & nPostfix
  268.         nPostfix = nPostfix + 1
  269.     Wend
  270.     CalcUniqueContentName = sReturn
  271. End Function
  272.  
  273.  
  274. Function CountItemsInArray(BigArray(), SearchItem)
  275. Dim i as Integer
  276. Dim MaxIndex as Integer
  277. Dim ResCount as Integer
  278.     ResCount = 0
  279.     MaxIndex = Ubound(BigArray())
  280.     For i = 0 To MaxIndex
  281.         If SearchItem = BigArray(i) Then
  282.             ResCount = ResCount + 1
  283.         End If
  284.     Next i
  285.     CountItemsInArray() = ResCount
  286. End Function
  287.  
  288.  
  289. Function GetDBHeight(oDBModel as Object)
  290.     If CurControlType = cImageControl Then
  291.         nDBHeight = 2000
  292.     Else
  293.         If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
  294.             oDBModel.MultiLine = True
  295.             nDBHeight = nDBRefHeight * 4
  296.         Else
  297.             nDBHeight = nDBRefHeight
  298.         End If
  299.     End If
  300.     GetDBHeight() = nDBHeight
  301. End Function
  302.  
  303.  
  304. Function GetFormWizardPaths() as Boolean
  305.     FormPath = GetOfficeSubPath("Template","wizard/bitmap")
  306.     If FormPath <> "" Then
  307.         WebWizardPath = GetOfficeSubPath("Template","wizard/web")
  308.         If WebWizardPath <> "" Then
  309.             WizardPath = GetOfficeSubPath("Template","wizard/")
  310.             If Wizardpath <> "" Then
  311.                 TexturePath = GetOfficeSubPath("Gallery", "www-back/")
  312.                 If TexturePath <> "" Then
  313.                     WorkPath = GetPathSettings("Work")
  314.                     If WorkPath <> "" Then
  315.                         GetFormWizardPaths = True
  316.                         Exit Function
  317.                     End If
  318.                 End If
  319.             End If
  320.         End If
  321.     End  If
  322.     DisposeDocument(oDocument)
  323.     GetFormWizardPaths() = False
  324. End Function
  325.  
  326.  
  327. Function GetFilterName(sApplicationKey as String) as String
  328. Dim oArgs()
  329. Dim oFactory
  330. Dim i as Integer
  331. Dim Maxindex as Integer
  332. Dim UIName as String
  333.     oFactory  = createUnoService("com.sun.star.document.FilterFactory")
  334.     oArgs() = oFactory.getByName(sApplicationKey)
  335.     MaxIndex = Ubound(oArgs())
  336.     For i = 0 to MaxIndex
  337.         If (oArgs(i).Name="UIName") Then
  338.             UIName = oArgs(i).Value
  339.             Exit For
  340.           End If
  341.     next i
  342.     GetFilterName() = UIName
  343. End Function</script:module>