2020-03-13 13:14:10 +01:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
2021-08-27 12:13:31 +02:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="journals" script:language="StarBasic">Private sub journalsMark35
2020-03-13 13:23:33 +01:00
End sub
2020-03-13 13:14:10 +01:00
Dim templateName As String
Dim EIFN As String
Dim PHA As String
Dim PQ As String
Dim imagesRelativePath As String
Dim allImagesRelativePath As String
Dim path As String
Dim sectionName As String
2020-03-13 13:23:33 +01:00
Private Sub makeUpIssue
2020-03-13 13:14:10 +01:00
turnOffTracking
Dim description As String
2020-03-21 16:35:38 +01:00
Dim i As Integer
Dim statusIndicator as Object
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim articleEndPosition As Object
Dim page As String
Dim firstPage As String
Dim tmp As String
Dim nSections As Long
2020-05-05 14:01:41 +02:00
description = getTranslation("complileJournalIssueConfirmation")
2020-03-13 13:14:10 +01:00
If NOT confirm(description) Then
Exit Sub
EndIf
EIFN = "ЭиФН"
PHA = "ФА"
PQ = "ВФ"
imagesRelativePath = "/Links/Header/"
allImagesRelativePath = "/Links/Header-icons/"
statusIndicator = ThisComponent.getCurrentController.StatusIndicator
oViewCursor = ThisComponent.CurrentController.getViewCursor()
sectionName = ""
oFilename = ThisComponent.Location
'Exit if no sections in document or document not saved
If oFilename = "" Then
2020-05-05 14:01:41 +02:00
MsgBox getTranslation("compileJournalIssueNoCurFilename")
2020-03-13 13:14:10 +01:00
Exit Sub
End If
templateName = ""
Dim docUserProperties As Object
docUserProperties = ThisComponent.DocumentProperties.UserDefinedProperties
If docUserProperties.getPropertySetInfo.hasPropertyByName("template") Then
templateName = docUserProperties.template
EndIf
GlobalScope.BasicLibraries.loadLibrary("Tools")
path=DirectoryNameoutofPath(ThisComponent.getURL(),"/")
' Add article for each section
'Go to article first page
2020-03-21 16:35:38 +01:00
page = findFirstPageNumberWithStyle("Первая страница статьи")
firstPage = page
oViewCursor.jumpToPage(page)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
2020-05-05 14:01:41 +02:00
statusIndicator.Start(getTranslation("compileJournalIssueStatusInProgerss"),30)
2020-10-26 08:54:43 +01:00
For i = 1 To 50
2020-03-13 13:14:10 +01:00
'Find section file
FilePath = findArticleFile(path,i)
If FilePath="" Then
Exit For
EndIF
'Add Article
If FileExists(FilePath) Then
oViewCursor.goToRange(oTextCursor,false)
'Вставить разрыв страницы, если е г о
oTextCursor.BreakType = 4
'Задать стиль первой страницы
If NOT IsEmpty(oTextCursor.NumberingRules) Then
noNumbering
EndIf
setArticlePageStyles(i)
setAritclePageHeaders(i)
page = oViewCursor.getPage()
InsertArticle(FilePath)
turnOffTracking
statusIndicator.setValue(i)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oViewCursor.Text.insertControlCharacter(oTextCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor.collapseToEnd()
'set page to next article page number
'oViewCursor.goToRange(oTextCursor,false)
End If
fileType = Right(FilePath, 3)
'Go to first page
oViewCursor.jumpToPage(page)
If fileType = "doc" Then
'Remove blank page at start
sendRM()
End If
sectionName = getSectionX(sectionName)
setArticleUniqPageStyles(i)
oViewCursor.jumpToPage(page)
setAtricleVars(i)
oViewCursor.jumpToPage(page)
takeWidowLinesIn()
oViewCursor.jumpToPage(page)
' takeWidowOrphans()
'Set section name
If templateName = "" Then
updateUserField("leftHeader" + i , sectionName )
ElseIf templateName = PHA Then
updateUserField("leftHeader" + i , sectionName )
ElseIf templateName = EIFN Then
updateUserField("rightHeader" + i , getArticleHeader() )
updateUserField("leftHeader" + i , getAuthor )
EndIf
Next i
statusIndicator.setValue(26)
'remove last empty page
oViewCursor.jumpToPage(page)
oViewCursor.jumpToPage(lastPageNum(i))
removeEmptyPage()
statusIndicator.setValue(28)
'Set pageNums
setPageNumbers()
statusIndicator.setValue(29)
'Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
' Mri oViewCursor
'Задать нумерацию сносок на каждую главу
'ThisComponent.FootnoteSettings.FootnoteCounting=1
'setHeadingsOutlineLevels
statusIndicator.end()
2020-05-05 14:01:41 +02:00
MsgBox getTranslation("compileJournalIssueFinished")
2020-03-13 13:14:10 +01:00
End Sub
2020-03-13 13:23:33 +01:00
Private Sub setPageNumbers()
2020-03-13 13:14:10 +01:00
updateLastPageFields()
End Sub
2020-03-13 13:23:33 +01:00
Private Sub setPageNumbersDeprecated()
2020-03-13 13:14:10 +01:00
Dim oVeiwCursor As Object
Dim pageNum as Integer
Dim firstPage as String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.jumpToFirstPage()
2020-03-13 16:36:45 +01:00
firstPage = findFirstPageNumberWithStyle("Статья 1 стр.1")
2020-03-13 13:14:10 +01:00
oViewCursor.jumpToPage(firstPage)
For i = 1 To 25
pageNum = lastPageNum(i)
'msgBox pageNum
If pageNum = -1 Then
Exit For
End If
updateUserField("article" + i + "LastPage", CStr(pageNum) )
Next i
End Sub
2020-03-21 16:35:38 +01:00
Private Sub setAtricleVars(i As Integer)
2020-03-13 13:14:10 +01:00
'updateUserField("article" + i + "LastPage", CStr(getArticleLastPage()) )
updateUserField("article" + i + "UDK", getUDK())
updateUserField("author" + i + "Copyright", getCopyright() )
'updateUserField("rightHeader" + i , getTitleHeader() )
End Sub
2020-03-21 16:35:38 +01:00
Private Function lastPageNum(i As Integer)
2020-03-13 13:14:10 +01:00
Dim docLastPage As Integer
Dim curPageNum As Integer
Dim oViewCursor As Object
curPageNum = -1
oViewCursor = ThisComponent.CurrentController.getViewCursor()
Dim oSavePosition As Object
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oViewCursor.jumpToLastPage()
oViewCursor.jumpToEndOfPage()
docLastPage = CInt(oViewCursor.getPage())
oViewCursor.goToRange(oSavePosition,false)
If CInt(oViewCursor.getPage()) = docLastPage Then
lastPageNum = -1
Exit Function
End If
Dim curPageStyleName As String
curPageStyleName = oViewCursor.PageStyleName
Do Until InStr(curPageStyleName,"Статья " + CStr(i)) = 0
curPageNum = CInt(oViewCursor.getPage())
If curPageNum = docLastPage Then
Exit Do
End If
If curPageNum = 0 Then
2020-05-05 14:01:41 +02:00
MsgBox getTranslation("lastPageNumNotFound")
2020-03-13 13:14:10 +01:00
Exit Do
End If
oViewCursor.jumpToNextPage()
curPageStyleName = getNextPageStyleName()
If InStr(curPageStyleName,"Статья " + CStr(i+1) + " стр.1") = 1 Then
Exit Do
End If
Loop
lastPageNum = curPageNum
End Function
2020-03-13 13:23:33 +01:00
Private Function getUDK()
2020-03-13 13:14:10 +01:00
'Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim title As String
Dim foundUDK As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oViewCursor.jumpToStartOfPage()
getFirstTextInStyle("УДК")
foundUDK = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
If foundUDK = "" Then
2020-05-05 14:01:41 +02:00
getUDK = getTranslation("compileJournalIssueSetUDKDummyText")
2020-03-13 13:14:10 +01:00
Else
getUDK = foundUDK
backspace
sendRM
End If
2021-07-12 18:04:20 +02:00
Thiscomponent.CurrentController.select(oSavePosition)
2020-03-13 13:14:10 +01:00
End Function
2020-03-13 13:23:33 +01:00
Private Function getCopyright()
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim authors As String
Dim finalName As String
Dim tmpStr As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
getFirstTextInStyle("Автор")
authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
If authors <> "" Then
finalName = Trim(authors)
If Len(finalName) >= 1 Then
If Right(finalName, 1) = "." Then
getCopyright = "© " + finalName
oViewCursor.goToRange(oSavePosition, false)
Exit Function
EndIf
EndIf
If Len(authors) >= 4 Then
leftSide = Right(authors,Len(authors)-4)
rightSide = Left(authors,4)
finalName = Trim(leftSide) + " " + rightSide
If Right(finalName, 1) <> "." Then
getCopyright = "© " + Trim(authors)
Else
getCopyright = "© " + finalName
EndIf
oViewCursor.goToRange(oSavePosition, false)
Exit Function
Else
2020-05-05 14:01:41 +02:00
getCopyright = getTranslation("compileJournalIssueCopyrightDummyText")
2020-03-13 13:14:10 +01:00
EndIf
End If
oViewCursor.goToRange(oSavePosition, false)
End Function
2020-03-13 13:23:33 +01:00
Private Function getAuthor()
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim authors As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
getFirstTextInStyle("Автор")
authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
If authors <> "" Then
getAuthor = authors
Else
2020-05-05 14:01:41 +02:00
getAuthor = getTranslation("compileJournalIssueAuthorDummyText")
2020-03-13 13:14:10 +01:00
End If
oViewCursor.goToRange(oSavePosition, false)
End Function
2020-03-13 13:23:33 +01:00
Private Function getArticleHeader()
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim authors As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
getFirstTextInStyle("Заголовок 2")
articleHeader = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
If articleHeader <> "" Then
getArticleHeader = articleHeader
Else
2020-05-05 14:01:41 +02:00
getArticleHeader = getTranslation("compileJournalIssueArticleTitleDummyText")
2020-03-13 13:14:10 +01:00
End If
oViewCursor.goToRange(oSavePosition, false)
End Function
2020-03-21 16:35:38 +01:00
Private Function getSectionX(section As String)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim startPage As String
Dim endPage As String
If section = "" Then
2020-05-05 14:01:41 +02:00
section = getTranslation("compileJournalIssueSectionDummyText")
2020-03-13 13:14:10 +01:00
End If
oViewCursor = ThisComponent.CurrentController.getViewCursor()
startPage = oViewcursor.getPage()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
getFirstTextInStyle("Заголовок 1")
endPage = oViewCursor.getPage()
If CInt(startPage) <= CInt(endPage) Then
If Len(oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()) > 1 Then
section = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
End If
section = UCase(Left(section, 1)) + LCase(Right(section,Len(section)-1))
End If
getSectionX = section
oViewCursor.goToRange(oSavePosition, false)
End Function
2020-03-13 13:23:33 +01:00
Private Function getTitleHeader()
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim title As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
getFirstTextInStyle("Автор")
authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
getFirstTextInStyle("Заголовок 2")
title = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()
getTitleHeader = authors + " " + title
oViewCursor.goToRange(oSavePosition, false)
getUDK = title
End Function
2020-03-21 16:35:38 +01:00
Private Sub setArticlePageStyles(i As Integer)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim oText As Object
Dim page As String
Dim pageNum As Long
Dim pageStyles As Object
Dim articleFirstPageStyle As Object
Dim newPageStyleName As String
Dim articleFirstPageStyleName As String
Dim curStyle As Object
Dim tmpStyleName As String
Dim firstName As String
Dim newName As String
Dim newFirstName As String
pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
firstName = "Первая страница статьи"
newName = "Статья " + CStr(i)
newFirstName = newName + " стр.1"
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'set starndard first page style name (need for cloning)
oTextCursor.PageDescName = firstName
'clone starndard first page style
createPageStyleByExample(newFirstName)
' set cloned style to first page
oTextCursor.PageDescName = newFirstName
'get current first page style name
curStyle = pageStyles.getByName(oViewCursor.pageStyleName)
setFirstPageMetadata(curStyle,i)
'1 left/right style
' create new para for next page
oTextCursor.Text.insertControlCharacter(oTextCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor.BreakType = 4
'clone 1 left/right style
createPageStyleByExample(newName)
'set followStyle to previous style
curStyle.FollowStyle = newName
'set new curStyle
curStyle = pageStyles.getByName(oViewCursor.pageStyleName)
oTextCursor.goLeft(1,true)
oTextCursor.String = ""
End Sub
2020-03-21 16:35:38 +01:00
Private Sub setFirstPageMetadata(curStyle As Object,i As Integer)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim savePageName As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
savePageName = oSavePosition.PageStyleName
oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oTextCursor.BreakType = 4
oTextCursor.PageDescName = savePageName
If templateName = "" Then
setDefaultFirstPageMetadata(curStyle,i)
ElseIf templateName = PHA Then
setPHAFirstPageMetadata(curStyle,i)
ElseIf templateName = EIFN Then
setEIFNFirstPageMetadata(curStyle,i)
EndIf
oViewCursor.goToRange(oSavePosition, false)
oViewCursor.jumpToPreviousPage()
sendRM()
End Sub
2020-03-21 16:35:38 +01:00
Private Sub setDefaultFirstPageMetadata(curStyle As Object,i As Integer)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oHeaderTable As Object
Dim oFooterTable As Object
Dim rightHeaderCell As Object
Dim leftHeaderCell As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
'curStyle.HeaderText
oHeaderTable = curStyle.HeaderText.CreateEnumeration().nextElement
'leftHeaderCell
leftHeaderCell = oHeaderTable.getCellByPosition(0,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
'go to page number place
oViewCursor.gotoEndOfLine(false)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
insertUserField(oViewCursor,"article" + i + "LastPage","00" )
oViewCursor.goright(1,false)
'Добавить УДК
insertUserField(oViewCursor,"article" + i + "UDK","УДК "+ i + "." + i)
'rightHeaderCell
rightHeaderCell = oHeaderTable.getCellByPosition(1,0).getStart()
oViewCursor.goToRange(rightHeaderCell, false)
'go to page number 1st place
oViewCursor.gotoEndOfLine(false)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
insertUserField(oViewCursor,"article" + i + "LastPage","00" )
' go to page number 2nd place
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
insertUserField(oViewCursor,"article" + i + "LastPage","00" )
'Footer without table
oViewCursor.goToRange(curStyle.FooterText.End, false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"author" + i + "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i )
2020-03-13 13:14:10 +01:00
End Sub
2020-03-21 16:35:38 +01:00
Private Sub setPHAFirstPageMetadata(curStyle As Object,i As Integer)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oHeader As Object
Dim oFooterTable As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oHeader = curStyle.HeaderText.CreateEnumeration().nextElement
If oHeader.supportsService("com.sun.star.text.TextTable") Then
oAnchor = oHeader.getCellByPosition(0,0).getStart()
Else
oAnchor = oHeader
EndIf
oViewCursor.goToRange(oAnchor, false)
'go to page number place
oViewCursor.gotoEndOfLine(false)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
insertUserField(oViewCursor,"article" + i + "LastPage","00" )
oViewCursor.goright(1,false)
'Добавить УДК
insertUserField(oViewCursor,"article" + i + "UDK","УДК "+ i + "." + i)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
insertUserField(oViewCursor,"article" + i + "LastPage","00" )
oViewCursor.goToRange(curStyle.FooterText.End, false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i )
2020-03-13 13:14:10 +01:00
End Sub
2020-03-13 13:23:33 +01:00
Private Sub setEIFNFirstPageMetadata(curStyle,i)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oHeaderTable As Object
Dim oFooterTable As Object
Dim rightHeaderCell As Object
Dim leftHeaderCell As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
'curStyle.HeaderText
oHeaderTable = curStyle.HeaderText.CreateEnumeration().nextElement
'leftHeaderCell
leftHeaderCell = oHeaderTable.getCellByPosition(0,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
'go to page number place
oViewCursor.gotoEndOfLine(false)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"article" & i & "LastPage","00" )
2020-03-13 13:14:10 +01:00
oViewCursor.goright(1,false)
'Добавить УДК
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"article" & i & "UDK","УДК "+ i + "." + i)
2020-03-13 13:14:10 +01:00
'rightHeaderCell
rightHeaderCell = oHeaderTable.getCellByPosition(1,0).getStart()
oViewCursor.goToRange(rightHeaderCell, false)
'go to page number 1st place
oViewCursor.gotoEndOfLine(false)
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"article" & i & "LastPage","00" )
2020-03-13 13:14:10 +01:00
' go to page number 2nd place
oViewCursor.goright(1,false)
oViewCursor.gotoEndOfLine(false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"article" & i * "Num","" & i )
2020-03-13 13:14:10 +01:00
oFooterTableLeft = curStyle.FooterTextLeft.CreateEnumeration().nextElement
rightHeaderCell = oFooterTableLeft.getCellByPosition(1,0).getStart()
oViewCursor.goToRange(rightHeaderCell, false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i )
2020-03-13 13:14:10 +01:00
'TODO!!!!SECOND PAGE
oFooterTableRight = curStyle.FooterTextRight.CreateEnumeration().nextElement
leftHeaderCell = oFooterTableRight.getCellByPosition(0,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
2020-05-05 14:01:41 +02:00
insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i )
2020-03-13 13:14:10 +01:00
End Sub
2020-03-13 13:23:33 +01:00
Private Sub setAritclePageHeaders(i)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oSavePosition As Object
Dim rightHeaderTable As Object
Dim leftHeaderTable As Object
Dim headerCell As Object
Dim leftHeaderCell As Object
Dim curStyleName As String
Dim curStyle As Object
2020-03-13 16:36:45 +01:00
Dim page As Integer
2020-03-13 13:14:10 +01:00
Dim pageStyles As Object
Dim articleStartPosition As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
2020-05-05 14:01:41 +02:00
page = findFirstPageNumberWithStyle("Статья " & i & " стр.1")
2020-03-13 13:14:10 +01:00
oViewCursor.jumpToPage(page)
articleStartPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'create new para for next page
oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'insert page break
oTextCursor.BreakType = 4
'create new para for next page
oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'insert page break
oTextCursor.BreakType = 4
If templateName <> PQ Then
If templateName = EIFN Then
copySectionIcon(i)
EndIf
curStyle = pageStyles.getByName(oViewCursor.pageStyleName)
rightHeaderTable = curStyle.HeaderTextRight.CreateEnumeration().nextElement
leftHeaderTable = curStyle.HeaderTextLeft.CreateEnumeration().nextElement
rightHeaderCell = rightHeaderTable.getCellByPosition(0,0).getStart()
oViewCursor.goToRange(rightHeaderCell, false)
If templateName = "" Then
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueAuthorDummyText") & " " & getTranslation("compileJournalIssueArticleTitleDummyText") & i )
2020-03-13 13:14:10 +01:00
ElseIf templateName = PHA Then
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueAuthorDummyText") & " " & getTranslation("compileJournalIssueArticleTitleDummyText") & i )
2020-03-13 13:14:10 +01:00
ElseIf templateName = EIFN Then
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueArticleTitleDummyText") & " " + i )
2020-03-13 13:14:10 +01:00
rightHeaderCell = rightHeaderTable.getCellByPosition(2,0).getStart()
oViewCursor.goToRange(rightHeaderCell, false)
insertLinkedImage(CStr(i),"headerImageRight")
oViewCursor.jumpToStartOfPage()
EndIf
If templateName = "" Then
leftHeaderCell = leftHeaderTable.getCellByPosition(1,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueSectionDummyText") & i )
2020-03-13 13:14:10 +01:00
ElseIf templateName = PHA Then
leftHeaderCell = leftHeaderTable.getCellByPosition(1,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueSectionDummyText") & i )
2020-03-13 13:14:10 +01:00
ElseIf templateName = EIFN Then
leftHeaderCell = leftHeaderTable.getCellByPosition(2,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
2020-05-05 14:20:11 +02:00
insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueInitialsAuthorDummyText") & i )
2020-03-13 13:14:10 +01:00
leftHeaderCell = leftHeaderTable.getCellByPosition(0,0).getStart()
oViewCursor.goToRange(leftHeaderCell, false)
insertLinkedImage(CStr(i),"headerImageLeft")
oViewCursor.jumpToStartOfPage()
EndIf
EndIf
oViewCursor.goToRange(articleStartPosition, false)
backspace()
backspace()
backspace()
oViewCursor.goToRange(oSavePosition, false)
End Sub
2020-03-13 13:23:33 +01:00
Private Sub setArticleUniqPageStyles(i)
2020-03-13 13:14:10 +01:00
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
2020-06-22 22:32:48 +02:00
Dim newPageName As String
2020-03-13 13:14:10 +01:00
oViewCursor = ThisComponent.CurrentController.getViewCursor()
pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
'Constants
articlePageNum = 1
pageName = "Статья " + CStr(i)
firstPageName = pageName + " стр.1"
curPageStyleName = oViewCursor.PageStyleName
Do Until InStr(curPageStyleName,pageName) = 0
newPageName = pageName + " стр." + articlePageNum
curPageNum = CInt(oViewCursor.getPage())
' Если мы находимся на первой странице статьи
If InStr(curPageStyleName, firstPageName) = 1 Then
curPageStyle = pageStyles.getByName(curPageStyleName)
previousPageStyle = curPageStyle
ElseIf InStr(curPageStyleName, pageName) = 1 Then
createPageStyleByExample(newPageName)
previousPageStyle.FollowStyle = newPageName
curPageStyle = pageStyles.getByName(newPageName)
curPageStyle.FollowStyle = pageName
previousPageStyle = curPageStyle
ElseIf oViewCursor.getPage() <> curPageNum Then
2020-05-05 14:20:11 +02:00
'Пришли в конец.
'MsgBox "Статья закончилась!"
2020-03-13 13:14:10 +01:00
Exit Sub
Else
Exit Sub
End If
'Iterate article page number
articlePageNum = articlePageNum + 1
'GO TO NEXT PAGE
2021-08-27 12:13:31 +02:00
If Not oViewCursor.jumpToNextPage() Then
MsgBox "setArticleUniqPageStyles failed"
End
EndIf
2020-03-13 13:14:10 +01:00
curPageStyleName = getNextPageStyleName()
Loop
End Sub
2020-03-13 13:23:33 +01:00
Private Sub takeWidowLinesIn
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
curPageStyleName = getNextPageStyleName()
Do Until InStr(curPageStyleName,"Статья") = 0
takeLineIn()
oViewCursor.jumpToNextPage()
curPageStyleName = getNextPageStyleName()
Loop
End Sub
2020-03-13 13:23:33 +01:00
Private Sub takeDownOrpahns
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
curPageStyleName = getNextPageStyleName()
Do Until InStr(curPageStyleName,"Статья") = 0
takeLineIn
oViewCursor.jumpToNextPage()
curPageStyleName = getNextPageStyleName()
Loop
End Sub
2020-03-13 13:23:33 +01:00
Private Sub takeLineIn
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim oTextCursor As Object
dim oEndPage As Object
Dim lineCounter As Integer
lineCounter = 0
oViewCursor = ThisComponent.CurrentController.getViewCursor()
'If page is less than 4 rows then shrink content
oViewCursor.jumpToEndOfPage()
oEnd = oViewCursor.getPosition()
oViewCursor.jumpToStartOfPage()
'Если в таблице - выходим
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
If NOT IsEmpty(oTextCursor.TextTable) Then
Exit Sub
End If
oViewCursor.jumpToStartOfPage()
' Идем конец строки, закончился ли параграф
lineCounter = lineCounter + 1
Do Until lineCounter = 4
'Test for empty line at 3 row
oViewCursor.goToEndOfLine(false)
If oEnd.X = oViewCursor.getPosition().X AND oEnd.Y = oViewCursor.getPosition().Y Then
shrinkPageContent()
Exit Sub
End If
oViewCursor.goRight(1,false)
'If empty para then remove it and shrink content
If oEnd.X = oViewCursor.getPosition().X AND oEnd.Y = oViewCursor.getPosition().Y Then
oViewCursor.goLeft(1,false)
'sendRM()
shrinkPageContent()
Exit Sub
End If
lineCounter = lineCounter + 1
Loop
'Count page lines
oViewCursor.jumpToStartOfPage()
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'If It is a start of paragraph then there is no line to take in
If oTextCursor.isStartOfParagraph() Then
'Nothing to Do
Exit Sub
End If
oViewCursor.goToEndOfLine(false)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'If it is a last line of paragraph
If oTextCursor.isEndOfParagraph() Then
shrinkPageContent()
Exit Sub
End If
oViewCursor.goToEndOfLine(false)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'If it is a last line of paragraph
If oTextCursor.isEndOfParagraph() Then
shrinkPageContent()
Exit Sub
End If
End Sub
2020-03-13 13:23:33 +01:00
Private Function getNextPageStyleName()
2020-03-13 13:14:10 +01:00
dim curPageStyleName as String
dim startPageStyleName as String
dim startPageStyle as Object
dim pageStyles as Object
dim followStyle as String
dim oViewCursor as Object
dim oTextCursor as Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
startPageStyleName = oViewCursor.PageStyleName
startPageStyle = pageStyles.getByName(startPageStyleName)
followStyle = startPageStyle.FollowStyle
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
If oTextCursor.isStartOfParagraph() Then
getNextPageStyleName = oViewCursor.PageStyleName
Exit Function
EndIf
oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oTextCursor.goRight(1,false)
oViewCursor.goToRange(oTextCursor,false)
getNextPageStyleName = oViewCursor.pageStyleName
oViewCursor.goLeft(1,false)
backspace()
End Function
2020-03-13 13:23:33 +01:00
Private Function findArticleFile(path,i)
Dim NextFile As String
Dim TestName As String
Dim endChars(2) As String
endChars(0) = "_"
endChars(1) = "."
endChars(2) = " "
Dim FoundPosition As Long
Dim EndChar As String
NextFile = Dir(path+"/", 0)
While NextFile <> ""
For j = LBound(endChars) To UBound(endChars)
TestName = CStr(i)+endChars(j)
FoundPosition = InStr(NextFile, TestName)
If FoundPosition = 1 Then
findArticleFile = path+"/"+NextFile
Exit Function
End If
Next
NextFile = Dir
Wend
findArticleFile = ""
2020-03-13 13:14:10 +01:00
End Function
2020-03-13 13:23:33 +01:00
Private Function InsertArticle(oFileName)
2020-03-13 13:14:10 +01:00
Dim document as Object
Dim dispatcher as object
Dim fileType as String
Dim oFilter as String
Dim args2(1) as new com.sun.star.beans.PropertyValue
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
fileType = Right(oFileName, 3)
If fileType = "odt" Then
oFilter = "writer8"
ElseIf fileType = "doc" Then
oFilter = "MS Word 97"
End If
args2(0).Name = "Name"
args2(0).Value = oFileName
args2(1).Name = "Filter"
args2(1).Value = oFilter
dispatcher.executeDispatch(document, ".uno:InsertDoc", "", 0, args2())
End Function
2020-03-13 13:23:33 +01:00
Private Sub getChapter
2020-03-13 13:14:10 +01:00
Dim testText As String
testText = getFirstTextInStyle("Заголовок 1")
End Sub
2020-03-13 13:23:33 +01:00
Private Function getFirstTextInStyle(styleName)
2020-03-13 13:14:10 +01:00
Dim oViewCursor As Object
Dim curPage As Long
Dim foundPage As Long
oViewCursor = ThisComponent.CurrentController.getViewCursor()
curPage = oViewCursor.getPage
getFirstTextInStyleDispatch(styleName)
foundPage = oViewCursor.getPage
If foundPage >= curPage Then
getFirstTextInStyle = oViewCursor.String
Exit Function
End If
getFirstTextInStyle = ""
End Function
2020-03-13 13:23:33 +01:00
Private Sub setHeadingsOutlineLevels
2020-03-13 13:14:10 +01:00
setHeadingOutlineLevel(1,"Заголовок 1")
setHeadingOutlineLevel(2,"Заголовок 2")
End Sub
Sub setHeadingOutlineLevel(num,targetStyleName)
Dim oViewCursor As Object
Dim oText As Object
Dim curText As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.jumpToFirstPage
getFirstTextInStyleDispatch(targetStyleName)
While True
curText = oViewCursor.Text.createTextCursorByRange(oViewCursor)
If IsNull(oText) Then
oText = curText
ElseIf oText.Text.compareRegionStarts(oText,curText) = 0 AND oText.Text.compareRegionEnds(oText,curText) = 0 Then
Exit Sub
End If
oViewCursor.OutlineLevel = num
getFirstTextInStyleDispatch(targetStyleName)
Wend
End Sub
2020-03-13 13:23:33 +01:00
Private sub getFirstTextInStyleDispatch(styleName)
2020-03-13 13:14:10 +01:00
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(21) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = true
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 65536
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = styleName
args1(12).Name = "SearchItem.ReplaceString"
args1(12).Value = styleName
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 1280
args1(18).Name = "SearchItem.Command"
args1(18).Value = 0
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 1
args1(21).Name = "Quiet"
args1(21).Value = true
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
end Sub
2020-03-13 13:23:33 +01:00
Private sub insertLinkedImage(articleNum,styleName)
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args2(3) as new com.sun.star.beans.PropertyValue
args2(0).Name = "FileName"
args2(0).Value = path + imagesRelativePath + articleNum + ".jpg"
args2(1).Name = "FilterName"
args2(1).Value = "<В с е
args2(2).Name = "AsLink"
args2(2).Value = true
args2(3).Name = "Style"
args2(3).Value = styleName
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args2())
2020-03-13 13:14:10 +01:00
end sub
2020-03-13 13:23:33 +01:00
Private Sub copySectionIcon(articleNum)
2020-03-13 13:14:10 +01:00
FileCopy( path + allImagesRelativePath + getImageFileName(), path + imagesRelativePath + articleNum + ".jpg")
End Sub
2020-03-13 13:23:33 +01:00
Private Function getImageFileName()
2020-03-13 13:14:10 +01:00
Select Case UCase(sectionName)
Case "АРХИВ"
getImageFileName = "ARCHIVE.jpg"
Case "СИТУАЦИОННЫЕ ИССЛЕДОВАНИЯ"
getImageFileName = "CASE_STUDIES.jpg"
Case "МЕЖДИСЦИПЛИНАРНЫЕ ИССЛЕДОВАНИЯ"
getImageFileName = "INTERDISCIPLINARY.jpg"
Case "ПАНЕЛЬНАЯ ДИСКУССИЯ"
getImageFileName = "PANEL_DISCUSSION.jpg"
Case "ОБЗОРЫ КНИГ"
getImageFileName = "BOOK_REVIEWS.jpg"
Case "РЕДАКЦИОННАЯ СТАТЬЯ"
getImageFileName = "EDITORIAL.jpg"
Case "ЯЗЫК И СОЗНАНИЕ"
getImageFileName = "LANGUAGE.jpg"
Case "ПЕРСПЕКТИВА"
getImageFileName = "VISTA.jpg"
Case "ЭПИСТЕМОЛОГИЯ И ПОЗНАНИЕ"
getImageFileName = "EPISTEMOLOGY.jpg"
Case Else
getImageFileName = "EDITORIAL.jpg"
End Select
End Function
2020-03-13 13:23:33 +01:00
Private sub noNumbering
2020-03-13 13:14:10 +01:00
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("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
Wait 500
dispatcher.executeDispatch(document, ".uno:RemoveBullets", "", 0, args1())
Wait 500
end sub
2020-03-13 13:23:33 +01:00
Private Sub updateLastPageFields
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim cell As Object
Dim cellEnum As Object
Dim cellEnum2 As Object
Dim pageStyleName As String
Dim articleName As String
Dim articleNamePrefix As String
Dim articleNamePostfix As String
Dim strPos As Integer
Dim articleNum As Integer
Dim curNum As Integer
2020-03-21 16:35:38 +01:00
Dim pageNum As String
2020-03-13 13:23:33 +01:00
Dim textCursor As Object
Dim lastPages%( 100 )
For i = 0 to 100
lastPages%(i) = 0
next i
articleNum = 0
articleName = "0"
articleNamePrefix = "Статья "
articleNamePostfix = " "
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-05-05 14:20:11 +02:00
statusIndicator.Start(getTranslation("compileJournalIssueStatusUpdateLastPageNumbers"),30)
2020-03-13 13:23:33 +01:00
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
pageStyleName = getPageStyleNameFromEnum(enum1Element)
If Len(pageStyleName) > 0 Then
strPos = InStr(pageStyleName, articleNamePrefix)
If strPos <> 0 Then
articleName = Right(pageStyleName, Len(pageStyleName)-Len(articleNamePrefix))
strPos = InStr(articleName, articleNamePostfix)
If strPos > 0 Then
articleName = Left(articleName,strPos)
EndIf
'If first article reached
If articleNum = 0 Then
articleNum = CInt(Trim(articleName))
EndIf
Else
articleName = "0"
EndIf
If articleNum > 0 Then
curNum = CInt(Trim(articleName))
If articleNum <> curNum Then
pageNum = getPageNumber(enum1Element.Start)
lastPages(articleNum) = CInt(pageNum) - 1
articleNum = curNum
EndIf
EndIf
EndIf
EndIf
'TODO:
'OR enum1Element.supportsService("com.sun.star.text.TextTable")
Wend
For i = LBound(lastPages) to UBound(lastPages)
If lastPages%(i) <> 0 Then
updateUserField("article" + i + "LastPage",lastPages%(i))
EndIf
next i
statusIndicator.end()
End Sub
2020-03-13 13:14:10 +01:00
2020-03-13 16:51:33 +01:00
Function insertUserField(cursor,fieldName,fieldValue)
Dim oField As Object 'Field to insert
Dim oFieldMaster As Object
Dim oMasters As Object
oTextCursor = cursor.Text.createTextCursorByRange(cursor.Start)
oField = ThisComponent.createInstance("com.sun.star.text.textfield.User")
oMasters = ThisComponent.getTextFieldMasters()
If oMasters.hasByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) Then
oFieldMaster = oMasters.getByName("com.sun.star.text.FieldMaster.User" & "." & fieldName)
oFieldMaster.Name = fieldName
oFieldMaster.Content = fieldValue
Else
oFieldMaster = ThisComponent.createInstance("com.sun.star.text.FieldMaster.User")
oFieldMaster.Name = fieldName
oFieldMaster.Content = fieldValue
EndIf
oField.attachTextFieldMaster(oFieldMaster)
oTextCursor.Text.insertTextContent(oTextCursor, oField, False)
End Function
2020-03-13 13:14:10 +01:00
2020-03-13 17:48:46 +01:00
Function updateUserField(fieldName,fieldValue)
Dim oFieldMaster As Object
Dim oMasters As Object
oMasters = ThisComponent.getTextFieldMasters()
If oMasters.hasByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) Then
oFieldMaster = oMasters.getByName("com.sun.star.text.FieldMaster.User" & "." & fieldName)
oFieldMaster.Content = fieldValue
EndIf
End Function
Sub createPageStyleByExample(newName)
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Param"
args1(0).Value = newName
args1(1).Name = "Family"
args1(1).Value = 8
dispatcher.executeDispatch(document, ".uno:StyleNewByExample", "", 0, args1())
end Sub
sub sendRM
dim document as Object
dim dispatcher as Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array())
end Sub
sub backspace
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:SwBackspace", "", 0, Array())
end Sub
2021-08-23 18:53:47 +02:00
2021-08-26 16:38:21 +02:00
Sub configureCursorPositionForContentShrink()
' Globalscope.BasicLibraries.LoadLibrary("MRILib")
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim curSelection As Object
Dim selectionTextRange
Dim nextChar As String
Dim prefChar As String
oViewCursor = ThisComponent.CurrentController.getViewCursor()
curSelection = ThisComponent.getCurrentSelection()
If Not curSelection.supportsService("com.sun.star.text.TextRanges") Then
selectionTextRange = curSelection.Anchor
oViewCursor.JumpToFirstPage(false)
oViewCursor.goToRange(selectionTextRange,false)
EndIf
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
'At start of Para
oTextCursor.collapseToEnd()
If oTextCursor.isStartOfParagraph() AND NOT oTextCursor.isEndOfParagraph() Then
oTextCursor.goLeft(1,false)
EndIf
oViewCursor.goToRange(oTextCursor,false)
End Sub
Function isShrinkPageSucceded(initPosition As Object,initPageNum As String) As Boolean
Dim oViewCursor As Object
Dim oTextCursor As Object
isShrinkPageSucceded = false
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.goToRange(initPosition,false)
If (oViewCursor.getPage <> initPageNum) Then
isShrinkPageSucceded = true
EndIf
End Function
2021-08-26 16:38:55 +02:00
Function breakParaAtCursor() As Object
2021-08-26 16:38:21 +02:00
Dim oViewCursor As Object
Dim oTextCursor As Object
2021-08-26 16:38:55 +02:00
Dim leftMargin As Long
2021-08-26 16:38:21 +02:00
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oTextCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor)
If NOT oTextCursor.isEndOfParagraph() Then
oTextCursor.goLeft(1,false)
oTextCursor.goRight(2,true)
2021-08-26 16:38:55 +02:00
insertHyphen(oTextCursor)
2021-08-26 16:38:21 +02:00
oTextCursor.goLeft(1,false)
oViewCursor.goToRange(oTextCursor,false)
2021-08-26 16:38:55 +02:00
leftMargin = oViewCursor.ParaLeftMargin
insertPara
oViewCursor.ParaFirstLineIndent = leftMargin
2021-08-26 16:38:21 +02:00
oTextCursor.goLeft(1,false)
oViewCursor.goToRange(oTextCursor,false)
2021-08-26 16:38:55 +02:00
breakParaAtCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor)
2021-08-26 16:38:21 +02:00
Else
oTextCursor.goRight(1,false)
oViewCursor.goToRange(oTextCursor,false)
oViewCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
oTextCursor.goLeft(1,false)
oViewCursor.goToRange(oTextCursor,false)
2021-08-26 16:38:55 +02:00
breakParaAtCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor)
2021-08-26 16:38:21 +02:00
EndIf
End Function
2021-08-26 16:38:55 +02:00
sub insertPara
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array())
end sub
2021-08-26 16:38:21 +02:00
Function canShrinkContent() As Boolean
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim oSavePosition As Object
Dim oStartPosition As Object
Dim initPageNum As Long
Dim startPageNum As Long
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
canShrinkContent = true
'In endntote footnote or table shrink is not possible
If oViewCursor.Text.supportsService("com.sun.star.text.Endnote") OR _
oViewCursor.Text.supportsService("com.sun.star.text.Footnote") OR _
oViewCursor.Text.supportsService("com.sun.star.text.CellProperties") Then
canShrinkContent = false
oViewCursor.goToRange(oSavePosition,false)
Exit Function
EndIf
'If current paragraph has page break before
If oSavePosition.BreakType <> 0 Then
canShrinkContent = false
oViewCursor.goToRange(oSavePosition,false)
Exit Function
EndIf
initPageNum = oViewcursor.getPage()
oViewCursor.JumpToPreviousPage(false)
oViewCursor.jumpToStartOfPage()
startPageNum = oViewcursor.getPage()
'No previous page exists
If startPageNum = initPageNum Then
oViewCursor.goToRange(oSavePosition,false)
canShrinkContent = false
Exit Function
EndIf
oViewCursor.goToRange(oSavePosition,false)
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
Do While oViewcursor.getPage() = initPageNum
oTextCursor.gotoPreviousParagraph(false)
oViewCursor.goToRange(oTextCursor,false)
If oTextCursor.BreakType <> 0 Then
canShrinkContent = false
oViewCursor.goToRange(oSavePosition,false)
Exit Function
EndIf
Loop
oViewCursor.goToRange(oSavePosition,false)
End Function
2021-08-26 16:38:55 +02:00
Function shrinkPageContent() As Boolean
2021-08-26 16:38:21 +02:00
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim initPosition As Object
Dim initPageNum As String
Dim oSaveEndSelection As Object
Dim oEnum As Variant
Dim oPar As Object
Dim startOfPara As Boolean
Dim targetContent() As Object
2021-08-26 16:38:55 +02:00
Dim delta As Double
Dim rounds As Integer
delta = 0.1
rounds = 3
Dim i As Integer
Dim j As Integer
shrinkPageContent = false
2021-08-26 16:38:21 +02:00
oViewCursor = ThisComponent.CurrentController.getViewCursor()
configureCursorPositionForContentShrink()
If Not canShrinkContent() Then
Exit Function
EndIf
initPageNum = oViewcursor.getPage()
2021-08-26 16:38:55 +02:00
initPosition = breakParaAtCursor()
2021-08-26 16:38:21 +02:00
oViewcursor.goToRange(initPosition,false)
oViewCursor.JumpToPreviousPage(false)
oViewCursor.jumpToStartOfPage()
startPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor)
targetContent = selectContentToShrink(initPosition,startPosition)
2021-08-27 15:26:46 +02:00
For i = LBound(targetContent) To Ubound(targetContent)
shrinkContentSpacing(targetContent(i))
If isShrinkPageSucceded(initPosition, initPageNum) Then
Exit Function
EndIf
Next i
2021-08-26 16:38:55 +02:00
'TODO: Уменьшая отступы каждого параграфа от и до следующего
' а
For j = 0 To rounds
For i = LBound(targetContent) To Ubound(targetContent)
If (j > 0) Then
decreaseContentCharHeight(targetContent(i), delta)
EndIf
If shrinkContentWithKerning(targetContent(i)) Then
balanceContentTail(targetContent(i))
EndIf
If isShrinkPageSucceded(initPosition, initPageNum) Then
Exit Function
EndIf
Next i
Next j
For i = LBound(targetContent) To Ubound(targetContent)
increaseContentCharHeight(targetContent(i), delta * rounds )
Next i
End Function
Sub decreaseContentCharHeight(oContent As Object, delta As double)
Dim contentEnum As Object'paragraph enumeration
Dim textContentElement As Object'current paragraph
Dim curHeight As Double
contentEnum = oContent.createEnumeration()
Do While contentEnum.hasMoreElements()
textContentElement = contentEnum.nextElement()
curHeight = textContentElement.charHeight
textContentElement.charHeight = roundHeight(curHeight) - delta
Loop
End Sub
Sub increaseContentCharHeight(oContent As Object, delta As double)
Dim contentEnum As Object'paragraph enumeration
Dim textContentElement As Object'current paragraph
Dim curHeight As Double
contentEnum = oContent.createEnumeration()
Do While contentEnum.hasMoreElements()
textContentElement = contentEnum.nextElement()
curHeight = textContentElement.charHeight
textContentElement.charHeight = roundHeight(curHeight) + delta
Loop
End Sub
Function roundHeight(nHeight) As Double
Dim lHeight As Double
Dim hHeight As Double
lHeight = Int(nHeight)
hHeight = Int(nHeight)
Dim i%
i=1
Do While lHeight < nHeight And hHeight < nHeight
lHeight = + i/10 + 0.001
hHeight = + (i+0.5)/10
i=i+1
Loop
roundHeight=lHeight
End Function
2021-08-26 16:38:21 +02:00
2021-08-26 16:38:55 +02:00
Function shrinkContentSpacing(oContent As Object) As Boolean
' Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
shrinkContentSpacing = false
If oContent.ParaTopMargin > MIN_SPACING_TO_SHRINK Then
oContent.ParaTopMargin = 0
EndIf
If oContent.ParaBottomMargin > MIN_SPACING_TO_SHRINK Then
oContent.ParaTopMargin = 0
EndIf
2021-08-26 16:38:21 +02:00
End Function
Function selectContentToShrink(initPosition As Object, startPosition As Object)
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim startPageNum As Long
Dim prevPageNum As Long
Dim savePosition As Object
2021-08-26 16:38:55 +02:00
Dim foundPrevPara As Boolean
2021-08-26 16:38:21 +02:00
Dim targetContent() As Variant
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewcursor.goToRange(startPosition,false)
prevPageNum = oViewcursor.getPage()
oViewcursor.goToRange(initPosition,false)
startPageNum = oViewcursor.getPage()
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
Do While startPageNum = oViewcursor.getPage() OR prevPageNum = oViewcursor.getPage()
savePosition = oTextCursor.getStart()
oTextCursor.gotoStartOfParagraph(true)
oViewCursor.goToRange(oTextCursor,false)
oViewCursor.collapseToStart()
If Len(oTextCursor.String) > 0 Then
If (startPageNum = oViewcursor.getPage() OR prevPageNum = oViewcursor.getPage()) Then
AddToArray(targetContent,oTextCursor.Text.createTextCursorByRange(oTextCursor))
Else
oTextCursor.goToRange(savePosition,false)
oViewCursor.goToRange(oTextCursor,false)
oViewCursor.JumpToStartOfPage(false)
oTextCursor.goToRange(oViewCursor,true)
AddToArray(targetContent,oTextCursor.Text.createTextCursorByRange(oTextCursor))
EndIf
EndIf
2021-08-26 16:38:55 +02:00
foundPrevPara = oTextCursor.gotoPreviousParagraph(false)
If (foundPrevPara = false) Then
Exit Do
EndIf
2021-08-26 16:38:21 +02:00
oTextCursor.gotoEndOfParagraph(false)
oViewCursor.goToRange(oTextCursor,false)
Loop
selectContentToShrink = targetContent
End Function
Sub insertPageBreak
2020-03-13 17:48:46 +01:00
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:InsertPagebreak", "", 0, Array())
End Sub
2021-08-26 16:38:55 +02:00
Sub insertHyphen(twoCharactersToHyphen As Object)
Dim oViewCursor As Object
Dim document as Object
Dim dispatcher as Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.goToRange(twoCharactersToHyphen,false)
2020-03-13 17:48:46 +01:00
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(21) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = false
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 1
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 71680
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = "([a-zA-Zа а
args1(12).Name = "SearchItem.ReplaceString"
2021-08-26 16:38:21 +02:00
' "$1 U+00AD $2"
2020-03-13 17:48:46 +01:00
args1(12).Value = "$1
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 1024
args1(18).Name = "SearchItem.Command"
args1(18).Value = 3
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 2
args1(21).Name = "Quiet"
args1(21).Value = true
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
end sub
sub saveCurrentVersion
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("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "VersionComment"
2020-05-05 14:20:11 +02:00
args1(0).Value = getTranslation("saveVersionCommentInsertPageBreak")
2020-03-13 17:48:46 +01:00
dispatcher.executeDispatch(document, ".uno:Save", "", 0, args1())
end sub
Sub removeEmptyPage
Dim oViewCursor As Object
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oViewCursor.jumpToStartOfPage()
Dim oTextCursor As Object
oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor)
oViewCursor.jumpToEndOfPage()
oViewCursor.goToRange(oTextCursor,true)
If oViewCursor.isCollapsed Then
oViewCursor.goLeft(1,false)
SendRM()
Else
oViewCursor.jumpToEndOfPage()
End If
oViewCursor.collapseToEnd()
End Sub
Function getPageStyleNameFromEnum(enumElement)
If enumElement.pageDescName = "" AND Not IsEmpty(enumElement.getPropertyValue("PageStyleName")) Then
getPageStyleNameFromEnum = enumElement.pageStyleName
Else
getPageStyleNameFromEnum = enumElement.pageDescName
EndIf
End Function
2020-03-21 16:35:38 +01:00
Function getPageNumber(cursor As Object) As String
Dim oField As Object
Dim oTextCursor As Object
2020-03-13 17:48:46 +01:00
oTextCursor = cursor.Text.createTextCursorByRange(cursor.Start)
oField = ThisComponent.createInstance("com.sun.star.text.textfield.PageNumber")
oField.NumberingType = 4
oField.SubType = com.sun.star.text.PageNumberType.CURRENT
oTextCursor.Text.insertTextContent(oTextCursor, oField, False)
2020-06-23 13:58:46 +02:00
oField.Anchor.CharHidden = False
oField.Anchor.CharHidden = True
2020-03-13 17:48:46 +01:00
getPageNumber = oField.getPresentation(false)
oTextCursor.Text.removeTextContent(oField)
End Function
2020-03-13 13:14:10 +01:00
2021-07-12 18:04:20 +02:00
</script:module>
