epublishing/ePublishing/Album.xba

422 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="Album" script:language="StarBasic" script:moduleType="normal">Sub albumMark6
End Sub
Sub rotatePageButton
Dim curPageStyleName As String
Dim pageStyles As Object
Dim pageStyle As Object
curPageStyleName = getCurPageStyleName()
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageStyle = pageStyles.getByName(curPageStyleName)
If pageStyle.IsLandScape Then
undoPageAlbum
Else
makePageAlbum
EndIf
End Sub
Sub makePageAlbum
Dim curPageStyleName As String
&apos;saveVersion(&quot;Перед выполнением макроса повоорта страницы в альбомную ориентацию&quot;)
curPageStyleName = getCurPageStyleName()
findBestAnchor()
If checkPageSettings(curPageStyleName) Then
MsgBox getTranslation(&quot;albumRotationCheckPageSettings&quot;)
Exit Sub
EndIf
rotatePageClockwise(curPageStyleName)
End Sub
Sub findBestAnchor()
Dim curPageStyleName As String
Dim oViewCursor As Object
Dim oTextCursor As Object
curPageStyleName = getCurPageStyleName()
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.jumpToStartOfPage()
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor.End)
If NOT oTextCursor.isStartOfParagraph Then
oTextCursor.goToNextParagraph(false)
oViewCursor.goToRange(oTextCursor,false)
EndIf
If curPageStyleName = getCurPageStyleName() Then
Exit Sub
EndIf
MsgBox getTranslation(&quot;unrecoverableError&quot;)
End Sub
Sub undoPageAlbum
Dim curPageStyleName As String
curPageStyleName = getCurPageStyleName()
applyPortraitPageStyle(curPageStyleName)
End Sub
sub applyPortraitPageStyle(pageStyleName As String)
Dim pageStyles As Object
Dim pageStyle As Object
Dim oViewCursor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageStyle = pageStyles.getByName(pageStyleName)
If NOT pageStyle.IsLandScape Then
MsgBox getTranslation(&quot;albumRotationPageIsAlreadyAlbum&quot;)
Exit sub
EndIf
If pageStyles.hasByName(&quot;portrait_&quot; &amp; pageStyleName) Then
replacePageStyleByPortrait(pageStyleName)
removeAlbumFrames(pageStyleName)
Else
MsgBox getTranslation(&quot;albumRotationBackupStyleNotFound1&quot;) &amp; &quot; portrait_&quot; &amp; pageStyleName &amp; &quot; &quot; &amp; getTranslation(&quot;albumRotationBackupStyleNotFound2&quot;)
EndIf
End Sub
Sub replacePageStyleByPortrait(pageStyleName As String)
Dim pageStyles As Object
Dim pageStyle As Object
Dim oldPageStyle As Object
Dim textEnumeration As Object
Dim enumerationElement As Object
Dim i As Integer
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
oldPageStyle = pageStyles.getByName(pageStyleName)
For i = 0 To pageStyles.getCount() - 1
pageStyle = pageStyles.getByIndex(i)
If pageStyle.FollowStyle = pageStyleName Then
pageStyle.FollowStyle = &quot;portrait_&quot; &amp; pageStyleName
EndIf
If pageStyle.getName() = &quot;portrait_&quot; &amp; pageStyleName Then
pageStyle.FollowStyle = oldPageStyle.FollowStyle
EndIf
Next i
pageStyle = pageStyles.getByName(&quot;portrait_&quot; &amp; pageStyleName)
pageStyle.Hidden = false
pageStyle.FollowStyle = oldPageStyle.FollowStyle
&apos;Replace in direct formatting
textEnumeration = ThisComponent.Text.createEnumeration
While textEnumeration.hasMoreElements
enumerationElement = textEnumeration.nextElement
If enumerationElement.pageDescName = pageStyleName Then
enumerationElement.pageDescName = &quot;portrait_&quot; &amp; pageStyleName
EndIf
Wend
&apos;Replace album style by portrait
If oldPageStyle.IsUserDefined() Then
pageStyles.removeByName(pageStyleName)
pageStyles.getByName(&quot;portrait_&quot; &amp; pageStyleName).setName(pageStyleName)
EndIf
End Sub
Sub removeAlbumFrames(pageStyleName As String)
Dim drawPagesEnum As Object
Dim drawPage As Object
drawPagesEnum = ThisComponent.DrawPage.CreateEnumeration()
While drawPagesEnum.hasMoreElements()
drawPage = drawPagesEnum.nextElement()
If drawPage.getName() = &quot;header_&quot; &amp; pageStyleName Or drawPage.getName() = &quot;footer_&quot; &amp; pageStyleName Then
drawPage.dispose()
EndIf
Wend
End Sub
sub savePortraitPageStyle(pageStyleName As String)
createPageStyleByExample(&quot;portrait_&quot; &amp; pageStyleName)
hidePageStyle(&quot;portrait_&quot; &amp; pageStyleName)
End Sub
Sub hidePageStyle(pageStyleName As String)
&apos;Globalscope.BasicLibraries.LoadLibrary(&quot;MRILib&quot;)
Dim pageStyles As Object
Dim pageStyle As Object
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageStyle = pageStyles.getByName(pageStyleName)
pageStyle.Hidden = true
End Sub
Sub rotatePageClockwise(pageStyleName As String)
Dim pageStyles As Object
Dim pageStyle As Object
Dim tmpDimension As Long
Dim frame As Object
Dim frameName As String
Dim oViewCursor As Object
Dim pageNumber As Long
Dim headerFrameW As Long
Dim headerFrameH As Long
Dim headerFrameYOffset As Long
Dim headerFrameXOffset As Long
Dim footerFrameW As Long
Dim footerFrameH As Long
Dim footerFrameYOffset As Long
Dim footerFrameXOffset As Long
Dim textElement As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
pageNumber = oViewCursor.getPage()
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageStyle = pageStyles.getByName(pageStyleName)
If pageStyle.IsLandScape Then
MsgBox getTranslation(&quot;albumRotationPageIsAlreadyAlbum&quot;)
Exit sub
EndIf
If NOT pageStyle.IsUserDefined() Then
pageStyleName = &quot;new&quot; &amp; pageStyleName
createPageStyleByExample(pageStyleName)
oViewCursor.pageDescName = pageStyleName
pageStyle = pageStyles.getByName(pageStyleName)
EndIf
savePortraitPageStyle(pageStyleName)
If pageStyle.HeaderIsOn Then
headerFrameW = pageStyle.HeaderHeight - pageStyle.HeaderBodyDistance
headerFrameH = pageStyle.Width - pageStyle.HeaderLeftMargin - pageStyle.HeaderRightMargin - pageStyle.LeftMargin - pageStyle.RightMargin
headerFrameYOffset = pageStyle.HeaderLeftMargin + pageStyle.LeftMargin
headerFrameXOffset = pageStyle.Height - pageStyle.TopMargin - (pageStyle.HeaderHeight - pageStyle.HeaderBodyDistance)
EndIf
If pageStyle.FooterIsOn Then
footerFrameW = pageStyle.FooterHeight - pageStyle.FooterBodyDistance
footerFrameH = pageStyle.Width - pageStyle.FooterLeftMargin - pageStyle.FooterRightMargin - pageStyle.LeftMargin - pageStyle.RightMargin
footerFrameYOffset = pageStyle.FooterLeftMargin + pageStyle.LeftMargin
footerFrameXOffset = pageStyle.BottomMargin
EndIf
rotatePageClockwiseMargins(pageStyle)
rotatePageOrientation(pageStyle)
If pageStyle.HeaderIsOn Then
If NOT pageStyle.FirstIsShared Then
textElement = pageStyle.HeaderTextFirst
ElseIf NOT pageStyle.HeaderIsShared Then
If pageNumber Mod 2 = 1 Then
textElement = pageStyle.HeaderTextRight
Else
textElement = pageStyle.HeaderTextLeft
EndIf
Else
textElement = pageStyle.HeaderText
EndIf
frameName = &quot;header_&quot; &amp; pageStyleName
copyTextToFrame(textElement,headerFrameXOffset,headerFrameYOffset,headerFrameW,headerFrameH,frameName)
EndIf
If pageStyle.FooterIsOn Then
If NOT pageStyle.FirstIsShared Then
textElement = pageStyle.FooterTextFirst
ElseIf NOT pageStyle.FooterIsShared Then
If pageNumber Mod 2 = 1 Then
textElement = pageStyle.FooterTextRight
Else
textElement = pageStyle.FooterTextLeft
EndIf
Else
textElement = pageStyle.FooterText
EndIf
frameName = &quot;footer_&quot; &amp; pageStyleName
copyTextToFrame(textElement,footerFrameXOffset,footerFrameYOffset,footerFrameW,footerFrameH,frameName)
EndIf
removePageHeader(pageStyle)
removePageFooter(pageStyle)
End Sub
Sub rotatePageClockwiseMargins(pageStyle)
Dim tmpDimension As Long
tmpDimension = pageStyle.LeftMargin
If pageStyle.FooterIsOn Then
pageStyle.LeftMargin = pageStyle.BottomMargin + pageStyle.FooterHeight
Else
pageStyle.LeftMargin = pageStyle.BottomMargin
EndIf
pageStyle.BottomMargin = pageStyle.RightMargin
If pageStyle.HeaderIsOn Then
pageStyle.RightMargin = pageStyle.TopMargin + pageStyle.HeaderHeight
Else
pageStyle.RightMargin = pageStyle.TopMargin
EndIf
pageStyle.TopMargin = tmpDimension
End Sub
Sub rotatePageOrientation(pageStyle)
Dim tmpDimension As Long
tmpDimension = pageStyle.Height
pageStyle.Height = pageStyle.Width
pageStyle.Width = tmpDimension
pageStyle.IsLandscape = Not pageStyle.IsLandscape
End Sub
Function checkPageSettings(pageStyleName As String) As Boolean
Dim pageStyles As Object
Dim pageStyle As Object
checkPageSettings = false
pageStyles = ThisComponent.StyleFamilies.getByName(&quot;PageStyles&quot;)
pageStyle = pageStyles.getByName(pageStyleName)
If pageStyle.HeaderIsOn Then
If pageStyle.HeaderIsDynamicHeight Then
checkPageSettings = true
pageStyle.HeaderIsDynamicHeight = false
MsgBox getTranslation(&quot;albumRotationDynamicHeaderHeight&quot;)
EndIf
If pageStyle.HeaderDynamicSpacing Then
checkPageSettings = true
pageStyle.HeaderDynamicSpacing = false
MsgBox getTranslation(&quot;albumRotationDynamicHeaderOffset&quot;)
EndIf
EndIf
If pageStyle.FooterIsOn Then
If pageStyle.FooterIsDynamicHeight Then
checkPageSettings = true
pageStyle.FooterIsDynamicHeight = false
MsgBox getTranslation(&quot;albumRotationDynamicFooterHeight&quot;)
EndIf
If pageStyle.FooterDynamicSpacing Then
checkPageSettings = true
pageStyle.FooterDynamicSpacing = false
MsgBox getTranslation(&quot;albumRotationDynamicFooterOffset&quot;)
EndIf
EndIf
&apos;Workaround to force Writer reread new page settings
If checkPageSettings Then
pageStyle.FirstIsShared = true
pageStyle.FirstIsShared = false
pageStyle.FirstIsShared = true
EndIf
End Function
Sub copyTextToFrame(textElement As Object,frameXOffset As Long,frameYOffset As Long,frameW As Long,frameH As Long,frameName As String)
Dim oViewCursor As Object
Dim initialCursorPosition As Object
Dim frame As Object
Dim enumeration As Object
Dim firstElement As Boolean
Dim element As Object
Dim cellNames() As String
Dim firstCellAnchor As Object
Dim lastCellAnchor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
initialCursorPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor.End)
frame = createFrame(frameXOffset,frameYOffset,frameW,frameH,frameName)
enumeration = textElement.CreateEnumeration()
firstElement = true
While enumeration.hasMoreElements
element = enumeration.nextElement()
If element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = element.getCellNames()
element.IsWidthRelative = false
firstCellAnchor = element.getCellByName(cellNames(LBound(cellNames))).getStart()
lastCellAnchor = element.getCellByName(cellNames(UBound(cellNames))).getEnd()
oViewCursor.goToRange(firstCellAnchor,false)
oViewCursor.goToRange(lastCellAnchor,true)
unoCopy()
oViewCursor.goToRange(frame.Text.End,false)
unoPaste()
If firstElement Then
frame.Text.CreateEnumeration().nextElement.dispose()
EndIf
ElseIf element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
oViewCursor.goToRange(element,false)
unoCopy()
oViewCursor.goToRange(frame.Text.End,false)
unoPaste()
EndIf
firstElement = false
Wend
oViewCursor.goToRange(initialCursorPosition,false)
End Sub
Sub removePageHeader(pageStyle As Object)
pageStyle.headerIsOn = false
End Sub
Sub removePageFooter(pageStyle As Object)
pageStyle.FooterIsOn = false
End Sub
Function getCurPageStyleName() As String
dim curPageStyleName as String
dim oViewCursor as Object
dim oTextCursor as Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
If Not oViewCursor.isAtEndOfLine() And Not oViewCursor.isAtStartOfLine() Then
oViewCursor.goToStartOfLine(false)
EndIf
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
If oTextCursor.isStartOfParagraph() Then
getCurPageStyleName = oViewCursor.PageStyleName
Exit Function
EndIf
If oTextCursor.isEndOfParagraph() Then
getCurPageStyleName = oViewCursor.PageStyleName
Exit Function
EndIf
oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oViewCursor.paraOrphans = 0
oViewCursor.paraWidows = 0
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oTextCursor.goRight(1,false)
oViewCursor.goToRange(oTextCursor,false)
getCurPageStyleName = oViewCursor.pageStyleName
oViewCursor.goLeft(1,false)
backspace()
End Function
Sub unoCopy
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dispatcher.executeDispatch(document, &quot;.uno:Copy&quot;, &quot;&quot;, 0, Array())
End Sub
sub unoPaste
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
dispatcher.executeDispatch(document, &quot;.uno:Paste&quot;, &quot;&quot;, 0, Array())
end sub
Function createFrame(posX As Long,posY As Long,width As Long,height As Long,frameName As String) As Object
Dim oViewCursor as Object
Dim oTextCursor as Object
Dim oText As Object
Dim frame As Object
Dim border As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oText = oViewCursor.Text
oTextCursor = oText.createTextCursorByRange(oViewCursor.End)
frame = ThisComponent.createInstance(&quot;com.sun.star.text.TextFrame&quot;)
frame.AnchorType = 2
frame.Height = height
frame.Width = width
frame.PageToggle = false
frame.BorderDistance = 0
frame.HoriOrient = 0
frame.HoriOrientRelation = 7
frame.HoriOrientPosition= posX
frame.VertOrient = 0
frame.VertOrientRelation = 7
frame.VertOrientPosition = posY
oText.insertTextContent(oTextCursor.Start, frame, false)
frame.FrameIsAutomaticHeight = false
border = frame.bottomBorder
border.OuterLineWidth = 0
border.LineWidth = 0
frame.bottomBorder = border
frame.topBorder = border
frame.leftBorder = border
frame.rightBorder = border
frame.WritingMode = 2
frame.PositionProtected = true
frame.Name = frameName
createFrame = frame
End Function
</script:module>