home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #3 / K-CD_2002-03.iso / OpenOffice / f_0198 / Bullets.xba next >
Extensible Markup Language  |  2001-08-15  |  4KB  |  120 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="Bullets" script:language="StarBasic">REM  *****  BASIC  *****
  4. Option Explicit
  5.  
  6.  
  7. Sub    SetBulletGraphics(sBulletUrl as String)
  8. Dim i as Integer
  9. Dim oBookMarkCursor as Object
  10.     oBookmarks = oBaseDocument.BookMarks
  11.     For i = 0 To oBookmarks.Count - 1
  12.         oBookMark = oBookmarks.GetbyIndex(i)
  13.         oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
  14.         If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then
  15.             ChangeBulletURL(sBulletUrl, oBookMarkCursor)
  16.         End If
  17.     Next i
  18. End Sub
  19.  
  20.  
  21. Sub    ChangeBulletURL(sBulletUrl as String, oBookMarkCursor as Object)
  22. Dim n, m as Integer
  23. Dim oLevel()
  24. Dim oRules
  25. Dim bDoReplace as Boolean
  26. Dim oSize as New com.sun.star.awt.Size
  27. Dim oNumberingBuffer(0) as New com.sun.star.beans.PropertyValue
  28. Dim oNewBuffer(0) as New com.sun.star.beans.PropertyValue
  29.     oRules = oBookMarkCursor.NumberingRules
  30.     If Vartype(oRules()) = 9 Then
  31.         oNumberingBuffer(0).Name = "NumberingType"
  32.         oNumberingBuffer(0).Value = com.sun.star.style.NumberingType.BITMAP
  33.         For n = 0 To oRules.Count - 1
  34.             oLevel() = oRules.GetByIndex(n)
  35.             bDoReplace = ModifyPropertyValue(oLevel(), oNumberingBuffer())
  36.             If bDoReplace Then
  37.                 oRules.ReplaceByIndex(n, oNumberingBuffer())
  38.             End If
  39.         Next n
  40.         oBookmarkCursor.NumberingRules = oRules
  41.         oNewBuffer(0).Name = "GraphicURL"
  42.         oNewBuffer(0).Value = sBulletUrl
  43. '        oNewBuffer(1).Name = "GraphicSize"
  44. ' Todo: Get the original Size of the Bullet (see Bug #86196)
  45. '        oSize.Height = 300
  46. '        oSize.Width = 300
  47. '        oNewBuffer(1).Value = oSize
  48.         For n = 0 To oRules.Count - 1
  49.             oLevel() = oRules.GetByIndex(0)
  50.             bDoReplace = ModifyPropertyValue(oLevel(), oNewBuffer())
  51.             If bDoReplace Then
  52.                 oRules.ReplaceByIndex(n, oNewBuffer())
  53.             End If
  54.         Next n
  55.         oBookmarkCursor.NumberingRules = oRules
  56.     End If
  57. End Sub
  58.  
  59.  
  60. Sub    BulletUrlsToSavePath(SavePath as String)
  61. Dim n as Integer
  62. Dim m as Integer
  63. Dim i as Integer
  64. Dim sNewBulletUrl as String
  65. Dim oLevel()
  66. Dim oRules
  67. Dim bIsFirstRun as Boolean
  68. Dim oNewBuffer()' as New com.sun.star.beans.PropertyValue
  69. Dim bDoReplace as Boolean
  70. Dim oBookmarkCursor as Object
  71.     bIsFirstRun = True
  72.     oBookmarks = oBaseDocument.BookMarks
  73.     For i = 0 To oBookmarks.Count - 1
  74.         oBookMark = oBookmarks.GetbyIndex(i)
  75.         oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
  76.         If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then
  77.             oRules = oBookMarkCursor.NumberingRules
  78.             If Vartype(oRules()) = 9 Then
  79.                 For n = 0 To oRules.Count - 1
  80.                     oLevel() = oRules.GetByIndex(n)
  81.                     oNewBuffer() = ChangeBulletUrlToSavePath(SavePath, oLevel(), bIsFirstRun, bDoReplace)
  82.                     If bDoReplace Then
  83.                         bIsFirstRun = False
  84.                         oRules.ReplaceByIndex(n, oNewBuffer())
  85.                     End If
  86.                 Next n
  87.                 oBookmarkCursor.NumberingRules = oRules
  88.             End If
  89.         End If
  90.     Next i
  91. End Sub
  92.  
  93.  
  94. Function ChangeBulletUrlToSavePath(SavePath as String, oLevel(), bIsFirstRun as Boolean, bDoReplace as Boolean)            
  95. Dim MaxIndex as Integer
  96. Dim i as Integer
  97. Dim BulletName as String
  98. Dim oSize as New com.sun.star.awt.Size
  99.     MaxIndex = Ubound(oLevel())
  100.     Dim oNewBuffer(MaxIndex) as New com.sun.star.beans.PropertyValue
  101.     For i = 0 To MaxIndex
  102.         oNewBuffer(i).Name = oLevel(i).Name
  103.         If oLevel(i).Name = "GraphicURL" Then
  104.             bDoReplace = True
  105.             BulletName = FileNameoutofPath(oLevel(i).Value)
  106.             If bIsFirstRun Then
  107.                 FileCopy(oLevel(i).Value, SavePath & BulletName)
  108.             End If
  109.             oNewBuffer(i).Value = BulletName
  110. '        ElseIf oLevel(i).Name = "GraphicSize" Then
  111. '' Todo: Get the original Size of the Bullet (see Bug #86196)
  112. '            oSize.Height = 300
  113. '            oSize.Width = 300
  114. '            oNewBuffer(i).Value = oSize
  115.         Else
  116.             oNewBuffer(i).Value = oLevel(i).Value                    
  117.         End If
  118.     Next i
  119.     ChangeBulletUrlToSavePath() = oNewBuffer()
  120. End Function</script:module>