office-gobmx/wizards/source/webwizard/Bullets.xba
2003-03-27 16:59:30 +00:00

117 lines
No EOL
3.8 KiB
XML

<?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(&quot;NumberingRules&quot;) 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 = &quot;NumberingType&quot;
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 = &quot;GraphicURL&quot;
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()&apos; 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(&quot;NumberingRules&quot;) 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 = &quot;GraphicURL&quot; Then
bDoReplace = True
BulletName = FileNameoutofPath(oLevel(i).Value)
If bIsFirstRun Then
If oUcb.exists(SavePath &amp; Bulletname) Then
FileCopy(oLevel(i).Value, SavePath &amp; BulletName)
End If
End If
oNewBuffer(i).Value = BulletName
&apos; ElseIf oLevel(i).Name = &quot;GraphicSize&quot; Then
&apos;&apos; Todo: Get the original Size of the Bullet (see Bug #86196)
&apos; oSize.Height = 300
&apos; oSize.Width = 300
&apos; oNewBuffer(i).Value = oSize
Else
oNewBuffer(i).Value = oLevel(i).Value
End If
Next i
ChangeBulletUrlToSavePath() = oNewBuffer()
End Function</script:module>