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 ***** 4Option Explicit 5 6 7Sub SetBulletGraphics(sBulletUrl as String) 8Dim i as Integer 9Dim 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 18End Sub 19 20 21Sub ChangeBulletURL(sBulletUrl as String, oBookMarkCursor as Object) 22Dim n, m as Integer 23Dim oLevel() 24Dim oRules 25Dim bDoReplace as Boolean 26Dim oSize as New com.sun.star.awt.Size 27Dim oNumberingBuffer(0) as New com.sun.star.beans.PropertyValue 28Dim 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 52End Sub 53 54 55Sub BulletUrlsToSavePath(SavePath as String) 56Dim n as Integer 57Dim m as Integer 58Dim i as Integer 59Dim sNewBulletUrl as String 60Dim oLevel() 61Dim oRules 62Dim bIsFirstRun as Boolean 63Dim oNewBuffer()' as New com.sun.star.beans.PropertyValue 64Dim bDoReplace as Boolean 65Dim 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 86End Sub 87 88 89Function ChangeBulletUrlToSavePath(SavePath as String, oLevel(), bIsFirstRun as Boolean, bDoReplace as Boolean) 90Dim MaxIndex as Integer 91Dim i as Integer 92Dim BulletName as String 93Dim 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() 117End Function</script:module>