epublishing/ePublishing/Books.xba

444 lines
No EOL
14 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="Books" script:language="StarBasic" script:moduleType="normal">Sub markBooks7
End Sub
Sub setUniqPageStyles
Dim pageStyleBreaks As Variant
Dim filteredDupStyles As Variant
pageStyleBreaks = getPageStyleBreaks()
Dim pageCount As Integer
Dim pageStyleNames() As String
Dim pageNumbers() As Integer
Dim pageStarts() As Object
Dim pageCounter As Integer
pageStyleNames = pageStyleBreaks(0)
pageNumbers = pageStyleBreaks(1)
pageStarts = pageStyleBreaks(2)
&apos;Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
pageCount = thiscomponent.currentController.pageCount
Dim fullChain(pageCount - 1) As String
Dim dupNames() As String
Dim dupCounters() As Integer
Dim chainNum As Integer
Dim pageStyleFamily As Object
Dim pageStyle As Object
pageStyleFamily = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
chainNum = 0
For pageCounter = 1 To pageCount
If pageNumbers(chainNum) = pageCounter Then
fullChain(pageCounter - 1) = pageStyleNames(chainNum)
If Ubound(pageNumbers) &gt; chainNum Then
chainNum = chainNum + 1
EndIf
Else
pageStyle = pageStyleFamily.getByName(fullChain(pageCounter - 1 - 1))
fullChain(pageCounter - 1) = pageStyle.FollowStyle
EndIf
Dim dupPosition As Integer
dupPosition = getIndex(dupNames, fullChain(pageCounter - 1) )
If dupPosition = -1 Then
addToArray(dupNames, fullChain(pageCounter - 1))
addToArray(dupCounters, 1)
Else
dupCounters(dupPosition) = dupCounters(dupPosition) + 1
EndIf
Next pageCounter
filteredDupStyles = filterPageStyleNames(dupNames,dupCounters)
filteredDupStyles = createDupNames(filteredDupStyles)
Dim duplicateNames() As String
Dim initNames() As String
Dim dupName As String
duplicateNames = filteredDupStyles(2)
initNames = filteredDupStyles(0)
createPageStyleClones(filteredDupStyles)
chainNum = 0
Dim curName As String
Dim pageStart As Object
Dim prevPageStyle As Object
Dim index As Integer
For pageCounter = 1 To pageCount
If pageNumbers(chainNum) = pageCounter Then
index = getIndex(initNames, pageStyleNames(chainNum))
If index &gt; -1 Then
pageStart = pageStarts(chainNum)
dupName = getDuplicate(duplicateNames(index))
pageStart.pageDescName = dupName
fullChain(pageCounter - 1) = dupName
EndIf
If Ubound(pageNumbers) &gt; chainNum Then
chainNum = chainNum + 1
EndIf
Else
curName = fullChain(pageCounter - 1)
index = getIndex(initNames, curName)
If index &gt; -1 Then
dupName = getDuplicate(duplicateNames(index))
prevPageStyle = pageStyleFamily.getByName(fullChain(pageCounter - 1 - 1))
prevPageStyle.FollowStyle = dupName
fullChain(pageCounter - 1) = dupName
EndIf
EndIf
Next pageCounter
MsgBox getTranslation(&quot;allPagesHaveUniqPageStyle&quot;)
End Sub
Function getDuplicate(duplicateNames() As String) As String
Dim index As Integer
Dim dupName As String
For index = LBound(duplicateNames) To Ubound(duplicateNames)
dupName = duplicateNames(index)
If dupName &lt;&gt; &quot;&quot; Then
getDuplicate = dupName
duplicateNames(index) = &quot;&quot;
Exit Function
EndIf
Next index
End Function
Sub createPageStyleClones(filteredDupStyles As Variant)
&apos;Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
Dim oViewCursor As Object
Dim initialNames() As String
Dim dupNames() As Variant
Dim initialName As String
Dim style As Object
initialNames = filteredDupStyles(0)
dupNames = filteredDupStyles(2)
Dim pageStyleFamily As Object
pageStyleFamily = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.goToEnd(False)
Dim index As Integer
Dim dupInedx As Integer
insertPageBreak()
Dim duplicates() As String
Dim duplicate As String
Dim pageStyleOriginals As Integer
Dim newStyle As Object
For index = LBound(initialNames) To Ubound(initialNames)
initialName = initialNames(index)
style = pageStyleFamily.getByName(initialName)
oViewCursor.PageDescName = style.Name
duplicates = dupNames(index)
For dupIndex = LBound(duplicates) To Ubound(duplicates)
duplicate = duplicates(dupIndex)
createPageStyleByExample(duplicate)
newStyle = pageStyleFamily.getByName(duplicate)
newStyle.FollowStyle = style.Name
Next
Next
backspace
End Sub
Function createDupNames(dupStyles As Variant) As Variant
Dim newDupStyles(2) As Variant
Dim counters() As Integer
Dim initNames() As String
Dim initName As String
initNames = dupStyles(0)
counters = dupStyles(1)
Dim newDupNames() As Variant
Dim i As Integer
Dim nameIt As Integer
For i = LBound(counters) To UBound(counters)
ReDim newNames(counters(i) - 1) As String
addToArray(newDupNames, newNames)
initName = initNames(i)
For nameIt = LBound(newNames) To UBound(newNames)
newNames(nameIt) = createDupName(initName, newDupNames)
newDupNames(UBound(newDupNames)) = newNames
Next nameIt
Next i
newDupStyles(0) = initNames
newDupStyles(1) = counters
newDupStyles(2) = newDupNames
createDupNames = newDupStyles
End Function
Function createDupName(initName As String, newDupNames As Variant )
Dim pageStyleFamily As Object
pageStyleFamily = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
Dim proposeName As String
Dim i As Integer
Dim postfix As String
Dim prefixName As String
prefixName = getPrefixName(initName)
For i = 1 To 10000
proposeName = prefixName &amp; i
If NOT pageStyleFamily.hasByName(proposeName) And Not IsInArrays(newDupNames, proposeName) Then
createDupName = proposeName
Exit Function
EndIf
Next i
End Function
Function getPrefixName(initName As String) As String
Dim num As Long
Dim tmpName As String
tmpName = Trim(initName)
If tmpName = &quot;&quot; Then
getPrefixName = &quot;&quot;
Exit Function
EndIf
num = Asc(Right(tmpName, 1))
Do while num &gt;= 48 AND num &lt;= 57
tmpName = Trim(Left(tmpName, Len(tmpName) - 1))
If tmpName = &quot;&quot; Then
getPrefixName = &quot;&quot;
Exit Function
EndIf
num = Asc(Right(tmpName, 1))
Loop
If tmpName = &quot;Статья&quot; Then
Dim result As String
result = Trim(initName) &amp; &quot; стр.&quot;
getPrefixName = result
Exit Function
EndIf
If Len(tmpName) &gt; 4 AND Right(tmpName,4) = &quot;стр.&quot; Then
getPrefixName = tmpName
Exit Function
EndIf
getPrefixName = tmpName &amp; &quot; &quot;
End Function
Function IsInArrays(newDupNames As Variant, proposeName As String) As Boolean
&apos;Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
Dim i As Integer
Dim names() As String
For i = LBound(newDupNames) To Ubound(newDupNames)
names = newDupNames(i)
If getIndex(names, proposeName) &gt; -1 Then
IsInArrays = True
Exit Function
EndIf
Next i
IsInArrays = False
End Function
Function filterPageStyleNames(names() As String, counters() As Integer) As Variant
Dim i As Integer
Dim filteredNames() As String
Dim filteredCounters() As Integer
For i=Lbound(counters) To Ubound(counters)
If counters(i) &gt; 1 Then
addToArray(filteredNames, names(i))
addToArray(filteredCounters, counters(i))
EndIf
Next i
Dim filteredDups(1) As Variant
filteredDups(0) = filteredNames
filteredDups(1) = filteredCounters
filterPageStyleNames = filteredDups
End Function
Function getPageStyleBreaks()
Dim enum1 As Object
Dim enum1Element As Object
Dim pageStyleName As String
Dim pageNumber As Integer
Dim pageName As String
Dim oViewCursor As Object
Dim anchor As Object
Dim oSavePosition As Object
Dim pageStyleBreaks(2) As Variant
Dim pageStyleNames() As String
Dim pageNumbers() As Integer
Dim pageStarts() As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
enum1 = ThisComponent.Text.createEnumeration()
&apos; Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
Dim i As Integer
i = 0
Dim first As Boolean
first = true
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) OR enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
&apos; MRi enum1Element
If NOT isEmpty(enum1Element.PageDescName) And enum1Element.PageDescName &lt;&gt; &quot;&quot; Then
pageStyleName = enum1Element.PageStyleName
addToArray(pageStyleNames(),pageStyleName)
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
oViewCursor.goToRange(enum1Element.Anchor,false)
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
oViewCursor.goToRange(enum1Element.getCellByPosition(0,0).getStart(),false)
EndIf
addToArray(pageNumbers(),CInt(oViewCursor.Page))
addToArray(pageStarts(),enum1Element)
first = false
ElseIf first Then
addToArray(pageStyleNames(), enum1Element.PageStyleName)
addToArray(pageNumbers(),1)
addToArray(pageStarts(),enum1Element)
first = false
EndIf
EndIf
i = i + 1
Wend
pageStyleBreaks(0) = pageStyleNames
pageStyleBreaks(1) = pageNumbers
pageStyleBreaks(2) = pageStarts
getPageStyleBreaks = pageStyleBreaks
End Function
Sub setUniqPageStylesDEPRECATED
Dim prevPageName As String
Dim firstPageName As String
Dim pageName As String
Dim curPageNum As Integer
Dim prevPageNum As String
Dim leftPageNum As Long
Dim docPages As Long
Dim articlePages As Long
Dim previousPageStyle As Object
Dim pageStyles As Object
Dim curPageStyle As Object
Dim curPageStyleName As String
Dim nextStyle As Object
Dim clonedStyle As Object
Dim clonedStyleName As String
Dim oViewCursor As Object
Dim pageNum As Integer
Dim page As Integer
oViewCursor = ThisComponent.CurrentController.getViewCursor()
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageNum = 1
pageName = &quot;Страница издания&quot;
If NOT hasPageStyleWith(pageName) Then
MsgBox &quot;Ошибка. Стиль страниц &lt;&quot; &amp; pageName &amp; &quot;&gt; не найден.&quot;
Exit Sub
EndIf
page = findFirstPageNumberWithStyle(pageName)
firstPage = page
oViewCursor.jumpToPage(page)
curPageStyleName = oViewCursor.PageStyleName
Do While StrComp(curPageStyleName,pageName,1) = 0
If pageNum = 1 Then
oViewCursor.jumpToPreviousPage()
prevPageName = oViewCursor.PageStyleName
previousPageStyle = pageStyles.getByName(prevPageName)
tmpName = pageName + &quot; &quot;
If InStr(prevPageName, tmpName) = 1 Then
startNum = Right(prevPageName,Len(prevPageName) - Len(tmpName))
pageNum = CInt(startNum) + 1
EndIf
oViewCursor.jumpToNextPage()
EndIf
newPageName = pageName + &quot; &quot; + pageNum
createPageStyleByExample(newPageName)
If pageNum = 1 Then
oTextCursor = oViewCursor.Text.CreateTextCursorByRange(oViewCursor)
oViewCursor.PageDescName = newPageName
Else
previousPageStyle.FollowStyle = newPageName
EndIf
curPageStyle = pageStyles.getByName(newPageName)
&apos;Установим стиль следующей страницы в стандартное значение
curPageStyle.FollowStyle = pageName
previousPageStyle = curPageStyle
oViewCursor.jumpToNextPage()
curPageStyleName = getNextPageStyleName()
pageNum = pageNum + 1
Loop
End Sub
Function hasPageStyleWith(pageStyleName As String) As Boolean
Dim enum1 As Object
Dim enum1Element As Object
Dim curPage As String
Dim curStyleName As String
Dim pageName As String
Dim oViewCursor As Object
Dim anchor As Object
enum1 = ThisComponent.Text.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) OR enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
If NOT IsMissing(enum1Element.PageDescName) AND NOT IsNull(enum1Element.PageDescName) Then
pageName = CStr(enum1Element.PageDescName)
If pageStyleName = pageName Then
hasPageStyleWith = true
Exit Function
EndIf
EndIf
EndIf
Wend
hasPageStyleWith = false
End Function
Function findFirstPageNumberWithStyle(pageStyleName As String) As Integer
Dim enum1 As Object
Dim enum1Element As Object
Dim curPage As String
Dim curStyleName As String
Dim pageName As String
Dim oViewCursor As Object
Dim anchor As Object
Dim oSavePosition As Object
Dim curPageStyleName As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
enum1 = ThisComponent.Text.createEnumeration()
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) OR enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
If NOT IsMissing(enum1Element.PageDescName) AND NOT IsNull(enum1Element.PageDescName) Then
pageName = CStr(enum1Element.PageDescName)
If pageStyleName = pageName Then
anchor = enum1Element.getAnchor()
oViewCursor.gotoRange(anchor,false)
findFirstPageNumberWithStyle = oViewCursor.getPage()
oViewCursor.goToRange(oSavePosition, false)
Exit Function
EndIf
EndIf
EndIf
Wend
findFirstPageNumberWithStyle = -1
End Function
sub testStyleCopy
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = &quot;Param&quot;
args1(0).Value = &quot;alb2&quot;
args1(1).Name = &quot;Family&quot;
args1(1).Value = 8
dispatcher.executeDispatch(document, &quot;.uno:StyleNewByExample&quot;, &quot;&quot;, 0, args1())
end sub
</script:module>