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