home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #3 / K-CD_2002-03.iso / OpenOffice / f_0018 / tools.xba < prev   
Extensible Markup Language  |  2001-10-12  |  8KB  |  253 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.  
  6. Function SetProgressValue(iValue as Integer)    
  7.     If iValue = 0 Then
  8.         oProgressbar.End
  9.     End If
  10.     ProgressValue = iValue
  11.     oProgressbar.Value = iValue
  12. End Function
  13.  
  14.  
  15. Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
  16. Dim aPeerSize as new com.sun.star.awt.Size
  17. Dim nWidth as Integer
  18. Dim oControl as Object
  19.     If CurControlType = cImageControl Then
  20.         GetPreferredWidth() = 2000
  21.     Else        
  22.         If Not IsMissing(LocText) Then
  23.             aPeerSize = GetPeerSize(oModel, oControl, LocText)
  24.         Else
  25.             aPeerSize = GetPeerSize(oModel, oControl)
  26.         End If
  27.         nWidth = aPeerSize.Width
  28.         GetPreferredWidth = (nWidth + 4) * XPixelFactor    ' PixelTo100thmm(nWidth)
  29.     End If
  30. End Function
  31.  
  32.  
  33. Function GetPreferredHeight(oModel as Object, Optional LocText)
  34. Dim aPeerSize as new com.sun.star.awt.Size
  35. Dim nHeight as Integer
  36. Dim oControl as Object
  37. ' Todo: Wie geht das mit ImageControls
  38.     If Not IsMissing(LocText) Then
  39.         aPeerSize = GetPeerSize(oModel, oControl, LocText)
  40.     Else
  41.         aPeerSize = GetPeerSize(oModel, oControl)
  42.     End If
  43.     nHeight = aPeerSize.Height
  44.     GetPreferredHeight = nHeight * YPixelFactor     ' PixelTo100thmm(nHeight)
  45. End Function
  46.  
  47.  
  48. Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)    
  49. Dim oPeer as Object
  50. Dim aPeerSize as new com.sun.star.awt.Size
  51.     oControl = oController.GetControl(oModel)
  52.     oPeer = oControl.GetPeer()
  53.     If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
  54.         If oControl.Model.EffectiveMax = 0 Then
  55.             ' This is relevant for decimal fields
  56.             oControl.Model.EffectiveValue = 999.9999            
  57.         Else
  58.             oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
  59.         End If
  60.     ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
  61.         aPeerSize = oPeer.PreferredSize
  62.     ElseIf Not IsMissing(LocText) Then
  63.         oControl.Text = LocText
  64.     ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
  65.         oControl.Model.Date = Date
  66.     ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
  67.         oControl.Time = Time
  68.     Else
  69. '        oControl.Text = Mid(SBSIZETEXT,1,CurFieldLength)
  70.         aPeerSize = oPeer.PreferredSize()    
  71.         GetPeerSize() = aPeerSize
  72.         Exit Function
  73.     End If
  74.     aPeerSize = oPeer.PreferredSize()    
  75.     GetPeerSize = aPeerSize
  76. End Function
  77.  
  78.  
  79. Function TwipToCM(BYVAL nValue as long) as String
  80.     TwipToCM = trim(str(nValue / 567)) + "cm"
  81. End function
  82.  
  83.  
  84. Function TwipTo100telMM(BYVAL nValue as long) as long
  85.      TwipTo100telMM = nValue / 0.567
  86. End function
  87.  
  88.  
  89. Function TwipToPixel(BYVAL nValue as long) as long ' nur ungefaehre Berechnung
  90.     TwipToPixel = nValue / 15
  91. End function
  92.  
  93.  
  94. Function PixelTo100thMMX(oControl as Object) as long
  95.     oPeer = oControl.GetPeer()
  96.     PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
  97.  
  98. '     PixelTo100thMM = nValue * 28                    ' nur ungef├ñhre Berechnung 
  99. End function
  100.  
  101.  
  102. Function PixelTo100thMMY(oControl as Object) as long
  103.     oPeer = oControl.GetPeer()
  104.     PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
  105.  
  106. '     PixelTo100thMM = nValue * 28                    ' nur ungef├ñhre Berechnung 
  107. End function
  108.  
  109.  
  110. Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
  111. Dim aPoint as New com.sun.star.awt.Point
  112.     aPoint.X = xPos
  113.     aPoint.Y = yPos
  114.     GetPoint() = aPoint
  115. End Function
  116.  
  117.  
  118. Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
  119. Dim aSize As New com.sun.star.awt.Size
  120.     aSize.Width = iWidth
  121.     aSize.Height = iHeight
  122.     GetSize() = aSize
  123. End Function
  124.  
  125.  
  126. Sub    ImportStyles()
  127. Dim CurIndex as Integer
  128. Dim sImportPath as String
  129.     ToggleLayoutPage(False)
  130.     oDocument.LockControllers
  131.     CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
  132.     sImportPath = Styles(8,CurIndex)
  133.     bWithBackGraphic = LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
  134.     ControlCaptionsToStandardLayout()
  135.     ToggleOptionButtons(oDialogModel, bWithBackGraphic)    
  136.     ConfigurePageStyle()    
  137.     oDocument.UnlockControllers
  138.     ToggleLayoutPage(True, "lstStyles")    
  139. End Sub
  140.  
  141.  
  142. Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object    
  143.     ' Todo: FS fragen, ob dies alles richtig ist
  144.     ' Todo: Es sollte in der Hilfe darauf hingewiesen werden, dass der untere Wertbereich negativ ist.
  145.     Select Case iLocFieldType
  146.         Case com.sun.star.sdbc.DataType.BIGINT
  147.             oLocObOject.EffectiveMax = 2147483647 * 2147483647 
  148.             oLocbject.EffectiveMin = -(-2147483648 * -2147483648)
  149.             oLocObject.DecimalAccuracy = 0
  150.         Case com.sun.star.sdbc.DataType.INTEGER
  151.             oLocObject.EffectiveMax = 2147483647 
  152.             oLocObject.EffectiveMin = -2147483648
  153.         Case  com.sun.star.sdbc.DataType.SMALLINT
  154.             oLocObject.EffectiveMax = 32767 
  155.             oLocObject.EffectiveMin = -32768
  156.             oLocObject.DecimalAccuracy = 0
  157.         Case com.sun.star.sdbc.DataType.TINYINT
  158.             oLocObject.EffectiveMax = 127
  159.             oLocObject.EffectiveMin = -128
  160.             oLocObject.DecimalAccuracy = 0
  161.         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
  162. '        oLocObject.Scale = 0
  163.         ' Todo: Hier sollte die Property "Scale" zusammen mit der Precision abgefragt werden, um die Nachkommastellen richtig darzustellen,
  164.         ' da ein EffectiveMax/EffectiveMin hier keinen Sinn macht
  165. '            oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen
  166.         Case com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
  167.             If oLocObject.MaxTextLen = 0 Or oLocObject.MaxTextLen > 30 Then
  168.                 oLocObject.MaxTextLen = 30
  169.                 CurFieldLength = 30
  170.             Else
  171.                 oLocObject.MaxTextLen = CurFieldLength            
  172.             End If
  173.             oLocObject.DefaultText = Mid(SBSIZETEXT,1,CurFieldLength)
  174.         Case com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
  175.             oLocObject.MaxTextLen = CurFieldLength
  176.     End Select
  177.     
  178. End Function
  179.  
  180.  
  181. ' Destroy all Shapes in Nirwana
  182. Sub RemoveShapes()
  183. Dim n as Integer
  184. Dim oControl as Object
  185. Dim oShape as Object
  186.     For n = oDrawPage.Count-1 To 0 Step -1
  187.         oShape = oDrawPage(n)
  188.         If oShape.Position.Y > -2000 Then
  189.             oDrawPage.Remove(oShape)
  190.         End If
  191.     Next n
  192. End Sub
  193.  
  194. ' Note as Shapes cannot be removed from the DrawPage without destroying
  195. ' the object we have to park them somewhere in Nirwana
  196. Sub ShapesToNirwana()
  197. Dim n as Integer
  198. Dim oControl as Object
  199.     For n = 0 To oDrawPage.Count-1
  200.         oDrawPage(n).Position = GetPoint(-20, -10000)
  201.     Next n
  202. End Sub
  203.  
  204.  
  205. Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String
  206. Dim nPostfix as Integer
  207. Dim sReturn as String
  208.     nPostfix = 2
  209.     sReturn = sBaseName
  210.  
  211.     while (oContainer.hasByName(sReturn))
  212.         sReturn = sBaseName & nPostfix
  213.         nPostfix = nPostfix + 1
  214.     Wend
  215.     CalcUniqueContentName = sReturn
  216. End Function
  217.  
  218.  
  219. Function CountItemsInArray(BigArray(), SearchItem)
  220. Dim i as Integer
  221. Dim MaxIndex as Integer
  222. Dim ResCount as Integer
  223.     ResCount = 0
  224.     MaxIndex = Ubound(BigArray())
  225.     For i = 0 To MaxIndex
  226.         If SearchItem = BigArray(i) Then
  227.             ResCount = ResCount + 1
  228.         End If
  229.     Next i
  230.     CountItemsInArray() = ResCount
  231. End Function
  232.  
  233.  
  234. Function GetDBHeight(oDBModel as Object)
  235.     If CurControlType = cImageControl Then
  236.         nDBWidth = 2000
  237.     Else
  238.         If bIsVeryFirstValueField Then
  239.             ' Todo: Hier wird vereinfachend davon ausgegangen, dass alle DB-Feldern immer die selbe H├╢he wie Textfelder haben
  240.             nDBRefHeight = GetPreferredHeight(oDBModel)
  241.             bIsVeryFirstValueField = False
  242.         End If
  243.         'Todo: Vielleicht k├╢nnte man dieses Feld auch noch tiefer machen
  244.         If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
  245.             oDBModel.MultiLine = True
  246.             nDBHeight = nDBRefHeight * 4
  247.         Else
  248.             nDBHeight = nDBRefHeight
  249.         End If
  250.     End If
  251.     GetDBHeight() = nDBHeight
  252. End Function
  253. </script:module>