home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 October / PCWorld_2004-10_cd.bin / akce / openoffice / f_0110 / Bullets.xba next >
Extensible Markup Language  |  2003-03-27  |  4KB  |  117 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.         For n = 0 To oRules.Count - 1
  44.             oLevel() = oRules.GetByIndex(0)
  45.             bDoReplace = ModifyPropertyValue(oLevel(), oNewBuffer())
  46.             If bDoReplace Then
  47.                 oRules.ReplaceByIndex(n, oNewBuffer())
  48.             End If
  49.         Next n
  50.         oBookmarkCursor.NumberingRules = oRules
  51.     End If
  52. End Sub
  53.  
  54.  
  55. Sub    BulletUrlsToSavePath(SavePath as String)
  56. Dim n as Integer
  57. Dim m as Integer
  58. Dim i as Integer
  59. Dim sNewBulletUrl as String
  60. Dim oLevel()
  61. Dim oRules
  62. Dim bIsFirstRun as Boolean
  63. Dim oNewBuffer()' as New com.sun.star.beans.PropertyValue
  64. Dim bDoReplace as Boolean
  65. Dim oBookmarkCursor as Object
  66.     bIsFirstRun = True
  67.     oBookmarks = oBaseDocument.BookMarks
  68.     For i = 0 To oBookmarks.Count - 1
  69.         oBookMark = oBookmarks.GetbyIndex(i)
  70.         oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor)
  71.         If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then
  72.             oRules = oBookMarkCursor.NumberingRules
  73.             If Vartype(oRules()) = 9 Then
  74.                 For n = 0 To oRules.Count - 1
  75.                     oLevel() = oRules.GetByIndex(n)
  76.                     oNewBuffer() = ChangeBulletUrlToSavePath(SavePath, oLevel(), bIsFirstRun, bDoReplace)
  77.                     If bDoReplace Then
  78.                         bIsFirstRun = False
  79.                         oRules.ReplaceByIndex(n, oNewBuffer())
  80.                     End If
  81.                 Next n
  82.                 oBookmarkCursor.NumberingRules = oRules
  83.             End If
  84.         End If
  85.     Next i
  86. End Sub
  87.  
  88.  
  89. Function ChangeBulletUrlToSavePath(SavePath as String, oLevel(), bIsFirstRun as Boolean, bDoReplace as Boolean)            
  90. Dim MaxIndex as Integer
  91. Dim i as Integer
  92. Dim BulletName as String
  93. Dim oSize as New com.sun.star.awt.Size
  94.     MaxIndex = Ubound(oLevel())
  95.     Dim oNewBuffer(MaxIndex) as New com.sun.star.beans.PropertyValue
  96.     For i = 0 To MaxIndex
  97.         oNewBuffer(i).Name = oLevel(i).Name
  98.         If oLevel(i).Name = "GraphicURL" Then
  99.             bDoReplace = True
  100.             BulletName = FileNameoutofPath(oLevel(i).Value)
  101.             If bIsFirstRun Then
  102.                 If oUcb.exists(SavePath & Bulletname) Then
  103.                     FileCopy(oLevel(i).Value, SavePath & BulletName)
  104.                 End If
  105.             End If
  106.             oNewBuffer(i).Value = BulletName
  107. '        ElseIf oLevel(i).Name = "GraphicSize" Then
  108. '' Todo: Get the original Size of the Bullet (see Bug #86196)
  109. '            oSize.Height = 300
  110. '            oSize.Width = 300
  111. '            oNewBuffer(i).Value = oSize
  112.         Else
  113.             oNewBuffer(i).Value = oLevel(i).Value                    
  114.         End If
  115.     Next i
  116.     ChangeBulletUrlToSavePath() = oNewBuffer()
  117. End Function</script:module>