home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 2004 April
/
VPR0404.ISO
/
OPENOFFICE
/
INSTALL
/
f_0106
/
Bullets.xba
next >
Wrap
Extensible Markup Language
|
2003-03-27
|
4KB
|
117 lines
<?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>