2185 lines
No EOL
80 KiB
XML
2185 lines
No EOL
80 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="Clean" script:language="StarBasic">Sub mark95
|
||
|
||
End Sub
|
||
|
||
Dim DocumentLoaded as Boolean
|
||
|
||
Sub cleanButton
|
||
Dim config As Object
|
||
config = initRedactionConfiguration()
|
||
If ThisComponent.isReadonly Then
|
||
MsgBox(getTranslation("documentIsReadOnly"))
|
||
Exit Sub
|
||
EndIf
|
||
If config.getPropertyValue("predefined_template") = "false" Then
|
||
configureStyleFileDialog()
|
||
EndIf
|
||
If config.getPropertyValue("complexity") = "user" then
|
||
quietStartDialog()
|
||
Else
|
||
makerUpMenu()
|
||
EndIf
|
||
End Sub
|
||
|
||
Dim advancedCleaningDialog As Object
|
||
|
||
Private Sub makerUpMenu
|
||
DialogLibraries.LoadLibrary("Redaction")
|
||
advancedCleaningDialog = CreateUnoDialog(DialogLibraries.Redaction.CleaningDialog)
|
||
advancedCleaningDialog.getControl("fontsInStyles").Label = getTranslation("advancedMenuReplaceFontsInStyles")
|
||
advancedCleaningDialog.getControl("symbolsConversion").Label = getTranslation("advancedMenuSymbolsConversion")
|
||
advancedCleaningDialog.getControl("cleanFormatting").Label = getTranslation("advancedMenuCleanFormatting")
|
||
advancedCleaningDialog.getControl("replaceWhiteBackground").Label = getTranslation("advancedMenuReplaceWhiteBackground")
|
||
advancedCleaningDialog.getControl("removeUnusedStyles").Label = getTranslation("advancedMenuRemoveUnusedStyles")
|
||
advancedCleaningDialog.getControl("removeLinks").Label = getTranslation("advancedMenuRemoveLinks")
|
||
advancedCleaningDialog.getControl("removeAllFields").Label = getTranslation("advancedMenuRemoveAllFields")
|
||
advancedCleaningDialog.getControl("removeBookmarks").Label = getTranslation("advancedMenuRemoveBookmarks")
|
||
advancedCleaningDialog.getControl("configTables").Label = getTranslation("advancedMenuConfigTables")
|
||
advancedCleaningDialog.getControl("configAnchors").Label = getTranslation("advancedMenuConfigAnchors")
|
||
advancedCleaningDialog.getControl("fixMistakes").Label = getTranslation("advancedMenuFixMistakes")
|
||
advancedCleaningDialog.getControl("fixDOI").Label = getTranslation("advancedMenuFixDOI")
|
||
advancedCleaningDialog.getControl("replaceNumHyphen").Label = getTranslation("replaceNumHyphen")
|
||
advancedCleaningDialog.getControl("removeInitPageBreak").Label = getTranslation("advancedMenuRemoveInitPageBreak")
|
||
advancedCleaningDialog.getControl("removePageStyles").Label = getTranslation("advancedMenuRemovePageStyles")
|
||
advancedCleaningDialog.getControl("loadStandardStyles").Label = getTranslation("advancedMenuLoadStandardStyles")
|
||
advancedCleaningDialog.getControl("removeManualPageBreaks").Label = getTranslation("advancedMenuRemoveManualPageBreaks")
|
||
advancedCleaningDialog.getControl("removeBasic").Label = getTranslation("advancedMenuRemoveBasic")
|
||
advancedCleaningDialog.getControl("resetChapterNumberingRules").Label = getTranslation("advancedMenuResetChapterNumberingRules")
|
||
advancedCleaningDialog.getControl("convertFontsToCharStyles").Label = getTranslation("advancedMenuconvertFontsToCharStyles")
|
||
advancedCleaningDialog.getControl("fixBrokenCharBackTransparent").Label = getTranslation("fixBrokenCharBackTransparentMenuItem")
|
||
advancedCleaningDialog.getControl("removeNotTransparentBackgrounds").Label = getTranslation("removeNotTransparentBackgrounds")
|
||
advancedCleaningDialog.getControl("fixDiacriticKerning").Label = getTranslation("fixDiacriticKerning")
|
||
advancedCleaningDialog.getControl("Cancel").Label = getTranslation("buttonCancel")
|
||
advancedCleaningDialog.getControl("OK").Label = getTranslation("buttonOK")
|
||
advancedCleaningDialog.getControl("buttonLoad").Label = getTranslation("buttonLoad")
|
||
advancedCleaningDialog.Title = getTranslation("advancedMenuDialogTitle")
|
||
setAdvancedDialogDescription()
|
||
advancedCleaningDialog.setVisible(true)
|
||
Select Case advancedCleaningDialog.Execute()
|
||
Case 1
|
||
cleanAccordingTo(advancedCleaningDialog)
|
||
Case 0
|
||
End Select
|
||
advancedCleaningDialog.dispose()
|
||
Exit sub
|
||
End Sub
|
||
|
||
Private Sub cleanAccordingTo(dialog As Object)
|
||
Dim statusIndicator as Object
|
||
Dim openTrackChanges As Boolean
|
||
openTrackChanges = false
|
||
dialog.setVisible(false)
|
||
saveDocument
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start(getTranslation("statusStarted"),100)
|
||
doNotTrack
|
||
If dialog.getControl("loadStandardStyles").state = 1 Then
|
||
statusIndicator.Start(getTranslation("resaving"),100)
|
||
saveAsDocAndBackToODT
|
||
EndIf
|
||
If dialog.getControl("fontsInStyles").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusReplaceFontsInStyles"),100)
|
||
replaceStyleFonts
|
||
EndIf
|
||
If dialog.getControl("symbolsConversion").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusConvertSymbolsInTargetFonts"),100)
|
||
unicodeSymbolsConversion
|
||
EndIf
|
||
If dialog.getControl("cleanFormatting").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusCleaningManualFormatting"),100)
|
||
cleanFormatting
|
||
EndIf
|
||
If dialog.getControl("replaceWhiteBackground").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusReplaceWhiteBackground"),100)
|
||
replaceWhiteBackgroundWithTransparent
|
||
EndIf
|
||
If dialog.getControl("removeUnusedStyles").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemovedUnusedStyles"),100)
|
||
removeUnusedStyles
|
||
EndIf
|
||
If dialog.getControl("removeLinks").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemoveLinks"),100)
|
||
removeHyperlinks
|
||
EndIf
|
||
If dialog.getControl("removeAllFields").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemoveAllFields"),100)
|
||
removeAllFields
|
||
EndIf
|
||
If dialog.getControl("removeBookmarks").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemoveBookmarks"),100)
|
||
disposeAllBookmarks
|
||
EndIf
|
||
If dialog.getControl("configTables").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusConfigureTables"),100)
|
||
fixTableWidth
|
||
EndIf
|
||
If dialog.getControl("configAnchors").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusConfigureImagesAnchors"),100)
|
||
fixDrawingAnchors
|
||
EndIf
|
||
If dialog.getControl("fixMistakes").state = 1 Then
|
||
saveAndreload()
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start(getTranslation("statusFixFrequentMistakes"),100)
|
||
fixFrequentMistakes
|
||
EndIf
|
||
If dialog.getControl("fixDOI").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusFixingDOI"),100)
|
||
openTrackChanges = true
|
||
fixDOI
|
||
EndIf
|
||
If dialog.getControl("replaceNumHyphen").state = 1 Then
|
||
statusIndicator.Start(getTranslation("replaceNumHyphenStatus"),100)
|
||
openTrackChanges = true
|
||
replaceNumHyphen
|
||
EndIf
|
||
If dialog.getControl("removeInitPageBreak").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemovePageBreakAtStart"),100)
|
||
removeFirstElementPageBreak
|
||
EndIf
|
||
If dialog.getControl("removePageStyles").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusRemoveCustomPageStyles"),100)
|
||
removeUserPageStyles
|
||
EndIf
|
||
If dialog.getControl("loadStandardStyles").state = 1 Then
|
||
statusIndicator.Start(getTranslation("statusLoadingStylesFromTemplate"),100)
|
||
loadArticleStyles
|
||
EndIf
|
||
If dialog.getControl("removeManualPageBreaks").state = 1 Then
|
||
removeManualPageBreaks
|
||
EndIf
|
||
If dialog.getControl("removeBasic").state = 1 Then
|
||
removeLibs
|
||
EndIf
|
||
If dialog.getControl("resetChapterNumberingRules").state = 1 Then
|
||
resetChapterNumberingRules
|
||
EndIf
|
||
If dialog.getControl("convertFontsToCharStyles").state = 1 Then
|
||
convertFontsToCharStyles()
|
||
EndIf
|
||
If dialog.getControl("fixBrokenCharBackTransparent").state = 1 Then
|
||
fixBrokenCharBackTransparent()
|
||
EndIf
|
||
If dialog.getControl("removeNotTransparentBackgrounds").state = 1 Then
|
||
fixColoredBackgroundInDoc()
|
||
EndIf
|
||
If dialog.getControl("fixDiacriticKerning").state = 1 Then
|
||
fixDiacriticKerning()
|
||
EndIf
|
||
|
||
statusIndicator.end()
|
||
saveAndreload()
|
||
MsgBox getTranslation("cleaningFinished")
|
||
If openTrackChanges Then
|
||
showTrackedChanges
|
||
Endif
|
||
|
||
End Sub
|
||
|
||
Private Sub removeLibs
|
||
Dim docBasic as Object
|
||
docBasic = ThisComponent.BasicLibraries
|
||
Dim libs() As String
|
||
libs = docBasic.getElementNames()
|
||
Dim libName As String
|
||
Dim i As Integer
|
||
For i = LBound(libs) To UBound(libs)
|
||
libName = libs(i)
|
||
docBasic.removeLibrary(libName)
|
||
Next i
|
||
End Sub
|
||
|
||
Private Sub quietCleaning
|
||
Dim description As String
|
||
Dim statusIndicator As Object
|
||
DocumentLoaded = false
|
||
saveDocument
|
||
saveAsDocAndBackToODT
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start(getTranslation("statusStarted"),100)
|
||
doNotTrack
|
||
statusIndicator.Start(getTranslation("statusReplaceFontsInStyles"),100)
|
||
replaceStyleFonts
|
||
statusIndicator.Start(getTranslation("statusConvertSymbolsInTargetFonts"),100)
|
||
saveAndreload()
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
unicodeSymbolsConversion
|
||
statusIndicator.Start(getTranslation("statusFixingDiacriticCharactersKerning"),100)
|
||
fixDiacriticKerning
|
||
statusIndicator.Start(getTranslation("statusCleaningManualFormatting"),100)
|
||
cleanFormatting
|
||
statusIndicator.Start(getTranslation("statusReplaceWhiteBackground"),100)
|
||
replaceWhiteBackgroundWithTransparent
|
||
statusIndicator.Start(getTranslation("statusRemovedUnusedStyles"),100)
|
||
removeUnusedStyles
|
||
statusIndicator.Start(getTranslation("statusRemoveLinks"),100)
|
||
removeHyperlinks
|
||
statusIndicator.Start(getTranslation("statusRemoveBookmarks"),100)
|
||
disposeAllBookmarks
|
||
statusIndicator.Start(getTranslation("statusConfigureTables"),100)
|
||
fixTableWidth
|
||
statusIndicator.Start(getTranslation("statusConfigureImagesAnchors"),100)
|
||
fixDrawingAnchors
|
||
saveAndreload()
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start(getTranslation("statusFixFrequentMistakes"),100)
|
||
fixFrequentMistakes
|
||
statusIndicator.Start(getTranslation("statusRemovePageBreakAtStart"),100)
|
||
removeFirstElementPageBreak
|
||
statusIndicator.Start(getTranslation("statusRemoveCustomPageStyles"),100)
|
||
removeUserPageStyles
|
||
statusIndicator.Start(getTranslation("statusLoadingStylesFromTemplate"),100)
|
||
loadArticleStyles
|
||
removeLibs
|
||
resetChapterNumberingRules
|
||
addTimeStampToProperties
|
||
saveCleanedVersion("Standard cleaning")
|
||
statusIndicator.end()
|
||
saveAndreload()
|
||
MsgBox getTranslation("cleaningFinished")
|
||
End Sub
|
||
|
||
'Sub RegisterListener (ThisComponent)
|
||
' oListener = CreateUnoListener( "DocumentListener_","com.sun.star.document.XEventListener" )
|
||
' ThisComponent.com_sun_star_document_XEventBroadcaster_addEventListener( oListener )
|
||
'End Sub
|
||
|
||
'Sub DocumentListener_notifyEvent( o as object )
|
||
' If o.EventName = "OnLoad" Then
|
||
' DocumentLoaded = true
|
||
' EndIf
|
||
'end sub
|
||
|
||
'Sub DocumentListener_disposing()
|
||
'End Sub
|
||
|
||
Private Sub removeFirstElementPageBreak
|
||
Dim enum1 As Object
|
||
Dim enum1Element As Object
|
||
enum1 = ThisComponent.Text.createEnumeration
|
||
If enum1.hasMoreElements Then
|
||
enum1Element = enum1.nextElement
|
||
If enum1Element.supportsService("com.sun.star.text.Paragraph") OR enum1Element.supportsService("com.sun.star.text.TextTable") Then
|
||
If enum1Element.BreakType <> com.sun.star.style.BreakType.NONE Then
|
||
enum1Element.PageDescName = ""
|
||
enum1Element.BreakType = com.sun.star.style.BreakType.NONE
|
||
EndIf
|
||
EndIf
|
||
EndIf
|
||
End Sub
|
||
|
||
Private Sub replaceStyleFonts
|
||
' Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
|
||
replaceFontsInStyles("IPH Lib Serif","IPH Astra Serif")
|
||
replaceFontsInStyles("Liberation Serif","IPH Astra Serif")
|
||
replaceFontsInStyles("PTSerif","IPH Astra Serif")
|
||
replaceFontsInStyles("PT Serif","IPH Astra Serif")
|
||
replaceFontsInStyles("ArabicD","IPH Astra Serif")
|
||
replaceFontsInStyles("Palatino Linotype Greek","Tinos")
|
||
End Sub
|
||
|
||
Private Sub replaceFontsInStyles(oldFontStart As String,newFontName As String)
|
||
Dim propertySetInfo As Object
|
||
Dim oPositionOfMatch As Long
|
||
Dim oFamilies As Object
|
||
Dim sElements As Object
|
||
Dim oFamily As Object
|
||
Dim oStyle As Object
|
||
Dim fontName As String
|
||
oFamilies = Thiscomponent.StyleFamilies
|
||
sElements() = oFamilies.getElementNames()
|
||
For i = 0 to oFamilies.count -1
|
||
oFamily = oFamilies.getByName(sElements(i))
|
||
For j = 0 to oFamily.getCount -1
|
||
oStyle = oFamily.getByIndex(j)
|
||
propertySetInfo = oStyle.getPropertySetInfo()
|
||
If propertySetInfo.hasPropertyByName("CharFontName") Then
|
||
fontName = oStyle.getPropertyValue("CharFontName")
|
||
oPositionOfMatch = InStr(fontName, oldFontStart)
|
||
If oPositionOfMatch = 1 Then
|
||
oStyle.CharFontName = newFontName
|
||
If propertySetInfo.hasPropertyByName("CharFontNameComplex") Then
|
||
oStyle.CharFontNameComplex = newFontName
|
||
EndIf
|
||
If propertySetInfo.hasPropertyByName("CharFontNameAsian") Then
|
||
oStyle.CharFontNameAsian = newFontName
|
||
EndIf
|
||
|
||
EndIf
|
||
EndIf
|
||
Next
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub unicodeSymbolsConversion
|
||
|
||
convertWLLatin2IPHAstra
|
||
convertSymbol
|
||
Dim sharedMarksRegExp As String
|
||
sharedMarksRegExp = "([\u0020-\u002f\u003a\u003b\u00A0\u2010\u2013\u2014]+)?"
|
||
Dim newFontName As String
|
||
newFontName = "IPH Astra Serif"
|
||
Dim RAtts(2) as new com.sun.star.beans.PropertyValue
|
||
RAtts(0).Name = "CharFontName"
|
||
RAtts(1).Name = "CharFontNameComplex"
|
||
RAtts(2).Name = "CharFontNameAsian"
|
||
|
||
'Basic Astra
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
'Letterlike Symbols 2100—214F
|
||
'Extended latin-1 0080—00FF
|
||
'Cyrillic unicode block range \u0400-\u04FF
|
||
'Basic Latin \u0020-\u007E
|
||
'Combining diacritical marks 0301 0304 0303 0323 032e 0331 035f
|
||
combiningDiacritic_Astra = "\u0301\u0303\u0304\u0308\u0323\u032e\u0331\u0341\u035f"
|
||
Dim extendedLatinA_Astra As String
|
||
extendedLatinA_Astra = "\u1e15\u1e17\u1e53\u0129\u0169"
|
||
'
|
||
'
|
||
'
|
||
'General Punctuation \u2000-\u206f
|
||
'Latin Extended A \u0100-\u017f
|
||
'\u02bb Modifier Letter Turned Comma is in IPH Astra
|
||
' unicodeConversionEverywhere("[\u0020-\u007F]+",RAtts)
|
||
unicodeConversionEverywhere("[\u0020-\u007f\u0080-\u00ff\u0400-\u04ff\u2000-\u206f\u2100-\u214f\u02bb\u0100-\u017f" & combiningDiacritic_Astra & extendedLatinA_Astra &"]+",RAtts)
|
||
'Arabic Scheherazade
|
||
'Arabic Presentation Forms-A fb50-fdff
|
||
'Arabic Presentation Forms-B fe70-feff
|
||
newFontName = "Scheherazade"
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
unicodeConversionEverywhere(sharedMarksRegExp & "[\u0600-\u06ff\ufb50-\ufdff\ufe70-\ufeff]+" & sharedMarksRegExp ,RAtts)
|
||
|
||
'Greek Tinos
|
||
newFontName = "Tinos"
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
'Greek and Coptic 0370—03FF
|
||
'Greek extended 1F00—1FFF
|
||
unicodeConversionEverywhere(sharedMarksRegExp & "[\u0370-\u03ff\u1f00-\u1fff]+" & sharedMarksRegExp,RAtts)
|
||
|
||
|
||
'DejaVu Sans Mathematical operators
|
||
newFontName = "DejaVu Sans"
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
'\u2200-\u22FF Mathematical operators
|
||
'\u2630-\u2637 Trigrams
|
||
'\u4DC0-\u4DFF Trigrams
|
||
unicodeConversionEverywhere("[\u2200-\u22ff\u2630-\u2637\u4DC0-\u4DFF]+",RAtts)
|
||
|
||
newFontName = "Noto Serif CJK JP"
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
'\u2200-\u22FF CJK Unified Ideographs
|
||
'\u21d2 двойная стрелка вправо
|
||
'3000—303F Символы и пунктуация ККЯ
|
||
|
||
unicodeConversionEverywhere(sharedMarksRegExp & "[\u21d2\u302b\uff00-\uffef]+" & sharedMarksRegExp,RAtts)
|
||
|
||
newFontName = "Noto Serif CJK SC"
|
||
RAtts(0).Value = newFontName
|
||
RAtts(1).Value = newFontName
|
||
RAtts(2).Value = newFontName
|
||
'\u2200-\u22FF CJK Unified Ideographs
|
||
'\u4e00—\u9fff Унифицированные идеограммы ККЯ
|
||
'\u3400-\u4db7\u4e00—\u9ff1 Найдены в Noto Sans CJK SC
|
||
'\u3000-\u302a\u302c-\u303f В Noto Sans CJK SC
|
||
unicodeConversionEverywhere(sharedMarksRegExp & "[\u3000-\u302a\u302c-\u303f\u3400-\u4db7\u4e00-\u9ff1]+" & sharedMarksRegExp,RAtts)
|
||
|
||
End Sub
|
||
|
||
Private Sub unicodeConversionEverywhere(searchPattern As String,rAtts)
|
||
setAttributesBySearchPattern(searchPattern,RAtts)
|
||
End Sub
|
||
|
||
|
||
'Replaces manual formatting text with font into character style with assigned font
|
||
Private Sub convertFontsToCharStyles
|
||
Dim oDoc As Object
|
||
Dim SDesc As Object
|
||
Dim founds As Object
|
||
Dim curFont As String
|
||
Dim srch(0) as new com.sun.star.beans.PropertyValue
|
||
oDoc = Thiscomponent
|
||
SDesc = Thiscomponent.createSearchDescriptor()
|
||
SDesc.SearchAll = true
|
||
SDesc.ValueSearch = false
|
||
SDesc.SearchStyles = false
|
||
SDesc.SearchRegularExpression = false
|
||
SDesc.SearchString = ""
|
||
srch(0).Name = "CharFontName"
|
||
SDesc.SetSearchAttributes(srch())
|
||
founds = Thiscomponent.findFirst(SDesc)
|
||
do while not isNull(founds)
|
||
curFont = founds.CharFontName
|
||
If IsEmpty(curFont) Then
|
||
curFont = "IPH Astra Serif"
|
||
EndIf
|
||
If curFont <> "IPH Astra Serif" AND curFont <> "" Then
|
||
If Not DocHasCharStyle(oDoc,curFont) Then
|
||
Dim oProps(2) As New com.sun.star.beans.PropertyValue
|
||
oProps(0).Name = "CharFontName"
|
||
oProps(1).Name = "CharFontNameComplex"
|
||
oProps(2).Name = "CharFontNameAsian"
|
||
oProps(0).Value = curFont
|
||
oProps(1).Value = curFont
|
||
oProps(2).Value = curFont
|
||
CreateCharacterStyle(curFont, oProps())
|
||
End If
|
||
founds.CharStyleNames = Array(curFont)
|
||
EndIf
|
||
founds = Thiscomponent.findNext(founds.getend, SDesc)
|
||
loop
|
||
End Sub
|
||
|
||
Private Sub removeUserPageStyles
|
||
Dim oStyles As Object
|
||
Dim oStyle As Object
|
||
Dim count As Long
|
||
Dim i As Long
|
||
oStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
|
||
count = oStyles.count - 1
|
||
|
||
For i = 0 to count
|
||
oStyle = oStyles.getByIndex(i)
|
||
If oStyle.isUserDefined Then
|
||
oStyles.removeByName(oStyle.getName)
|
||
count = oStyles.count - 1
|
||
'restart if style removed as sorting is unreliable
|
||
i = -1
|
||
EndIf
|
||
Next i
|
||
End Sub
|
||
|
||
Sub removeAllFields()
|
||
Dim fields As Object
|
||
Dim fieldEnum As Object
|
||
Dim field As Object
|
||
fields = ThisComponent.getTextFields()
|
||
fieldEnum = fields.createEnumeration()
|
||
While fieldEnum.hasMoreElements
|
||
field = fieldEnum.nextElement()
|
||
field.dispose()
|
||
Wend
|
||
End Sub
|
||
|
||
Public Const RX_Greek_letters = "\u0388-\u03ce"
|
||
Public Const RX_Latin_up_alphabet = "\u0041-\u005a"
|
||
Public Const RX_Latin_low_alphabet = "\u0061-\u007a"
|
||
Public Const RX_Cyrillic_alphabet = "\u0410-\u044f"
|
||
Public Const RX_Comma = "\u002c"
|
||
Public Const RX_Digits = "\u0030-\u0039"
|
||
Public Const RX_Roman_numbers = "MDCLXVI"
|
||
Public Const RX_Letters_Dash = "[" & RX_Latin_up_alphabet & RX_Latin_low_alphabet & RX_Cyrillic_alphabet & RX_Greek_letters & "]"
|
||
Public Const RX_Letters = "[" & RX_Latin_up_alphabet & RX_Latin_low_alphabet & RX_Cyrillic_alphabet & RX_Greek_letters & "]"
|
||
|
||
Private Sub fixFrequentMistakes
|
||
Dim config As Object
|
||
config = initRedactionConfiguration()
|
||
Dim NBSP As String
|
||
Dim space As String
|
||
|
||
NBSP = " "
|
||
space = " "
|
||
'Не должно быть символов табуляции
|
||
AskAndReplace("\t","")
|
||
'Не должно быть подряд больше одного пробела
|
||
AskAndReplace("(?<=[:space:])[:space:]+","")
|
||
'Не должно быть ни одного пробела в начале абзацев
|
||
AskAndReplace("^[:space:]+","")
|
||
'Не должно быть пробелов в конце абзацев
|
||
AskAndReplace("[:space:]+$","")
|
||
'Не должно быть пустых абзацев
|
||
AskAndReplace("^$","")
|
||
'Не должно быть пробелов перед знаками пунктуации .,;:?!)]}»¡¿”‘’
|
||
AskAndReplace("[:space:]+(?=[\.,;:?!\)\]\}»¡¿”’])","")
|
||
'Не должно быть пробелов после скобок [({ и кавычек «„
|
||
AskAndReplace("(?<=[\(\[\{«„])[:space:]","")
|
||
'Между буквами среднее или длинное тире должно быть замененено на среднее и обрамлено пробелами
|
||
AskAndReplace("(?<=" & RX_Letters_Dash & ")[—–]+(?=.)",NBSP & "–" & NBSP)
|
||
AskAndReplace("(?<=.)[—–]+(?=" & RX_Letters_Dash & ")",NBSP & "–" & NBSP)
|
||
'Между буквами дефисы-минусы, цифровые тире, средние тире и длинные тире заменяются на одно среднее тире
|
||
AskAndReplace("(?<=" & RX_Letters_Dash & "[:space:])[-‒—−–]+(?=[:space:].)","–")
|
||
AskAndReplace("(?<=.[:space:])[-‒—−–]+(?=[:space:]" & RX_Letters_Dash & ")","–")
|
||
'Между двумя цифрами и тире не долнжо быть пробелов. А также тире должно быть цифровым.
|
||
'Также проверяем, что перед искомым тире нет DOI
|
||
'''''AskAndReplace("(?<!DOI[0-9. /XVI:-‒–—−-]{1,50})(?<=[:digit:])(?:[:space:])?[-‒–—−](?:[:space:])?(?=[:digit:])","‒")
|
||
'Между двумя римскими цифрами и тире между ними не долнжо быть пробелов. А также тире должно быть средним
|
||
AskAndReplace("(?<=[" & RX_Roman_numbers & "])(?:[:space:])?[-‒–—−]+(?:[:space:])?(?=[" & RX_Roman_numbers & "])","–")
|
||
'Между буквой и угловой открывающейся скобкой должен быть пробел
|
||
AskAndReplace("(?<=" & RX_Letters & ")<(?=…>)",space & "<")
|
||
'Между угловой закрывающейся скобкой и буквой должен быть пробел
|
||
AskAndReplace("(?<=<…)>(?=" & RX_Letters & ")",">" & space)
|
||
|
||
If config.getPropertyValue("fixes_russian_iph") = "true" Then
|
||
'между N. Y. не должно быть пробела
|
||
AskAndReplace("(?<=N\.)[:space:](?=Y\.)","")
|
||
'Между словом том и цифрой должен быть неразрывный пробел, а не обычный
|
||
AskAndReplace("(?<=\b[тТ](ом|\.))\ (?=[:digit:])",NBSP)
|
||
'Между словом серия и цифрой должен быть неразрывный пробел, а не обычный
|
||
AskAndReplace("(?<=\b[сС](ерия|\.))\ +(?=[:digit:])",NBSP)
|
||
'Между словом часть и цифрой должен быть неразрывный пробел, а не обычный
|
||
AskAndReplace("(?<=\b[чЧ](асть|\.))\ +(?=[:digit:])",NBSP)
|
||
'Между числом и "г." должен быть неразрывный пробел, а не обычный
|
||
AskAndReplace("(?<=[0-9])[:space:]*г(?=\.)",NBSP & "г")
|
||
'Между инициалами и Фамилией должен быть неразрывный пробел, а не обычный
|
||
'А.[м/б пробел]А.Иванов -> А.[м/б пробел]А. Иванов
|
||
AskAndReplace("(?<=[:upper:]\.[:space:]?[:upper:])\.[:space:]?(?=[:upper:][:lower:]{1,30})","." & NBSP)
|
||
' А.[пробел]А.Иванов -> А.А. Иванов
|
||
AskAndReplace("(?<=[:upper:])\.[:space:](?=[:upper:]\.[:space:][:upper:][:lower:]{1,30})",".")
|
||
'Между Фамилией и инициалами должен быть неразрывный пробел, а не обычный
|
||
'Иванов А.[м/б пробел]А. -> Иванов А.А.
|
||
AskAndReplace("(?<=[:upper:][:lower:]{1,30}[:space:][:upper:])\.[:space:]?(?=[:upper:]\.)",".")
|
||
'Между "и" и "т." должен быть неразрывный пробел, а не обычный
|
||
AskAndReplace("(?<=\bи)\ (?=т\.)",NBSP)
|
||
'Между "т." и "е./н./д./п./к." не должно быть пробела
|
||
AskAndReplace("(?<=\bт)\.[:space:]?(?=[ендпк]\.)",".")
|
||
AskAndReplace("[ий][\u0306]+","й")
|
||
AskAndReplace("[ИЙ][\u0306]+","Й")
|
||
AskAndReplace("[её][\u0308]+","ё")
|
||
AskAndReplace("[ЕЁ][\u0308]+","Ё")
|
||
|
||
EndIf
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub loadArticleStyles
|
||
Dim dispatcher As Object
|
||
Dim filePath As String
|
||
Dim fileTest As Object
|
||
Dim predefined As String
|
||
Dim aArgs(0) As New com.sun.star.beans.PropertyValue
|
||
Dim config As Object
|
||
config = initRedactionConfiguration()
|
||
predefined = config.getPropertyValue("predefined_template")
|
||
filePath = getTemplateFile(predefined)
|
||
fileTest = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||
If NOT fileTest.exists(filePath) Then
|
||
configureStyleFileDialog()
|
||
predefined = config.getPropertyValue("predefined_template")
|
||
filePath = getTemplateFile(predefined)
|
||
If NOT fileTest.exists(filePath) Then
|
||
'MsgBox "Файл стилей " & fileName & " не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл."
|
||
Exit Sub
|
||
EndIf
|
||
EndIf
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
aArgs(0).Name = "OverwriteStyles"
|
||
aArgs(0).Value = True
|
||
ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() )
|
||
End Sub
|
||
|
||
Private Sub CreateCharacterStyle(sStyleName As String, oProps())
|
||
Dim i As Integer
|
||
Dim oFamilies As Object
|
||
Dim oStyle As Object
|
||
Dim oStyles As Object
|
||
oFamilies = ThisComponent.StyleFamilies
|
||
oStyles = oFamilies.getByName("CharacterStyles")
|
||
If oStyles.HasByName(sStyleName) Then
|
||
Exit Sub
|
||
End If
|
||
oStyle = ThisComponent.createInstance("com.sun.star.style.CharacterStyle")
|
||
For i=LBound(oProps) To UBound(oProps)
|
||
oStyle.setPropertyValue(oProps(i).Name, oProps(i).Value)
|
||
Next
|
||
oStyles.insertByName(sStyleName, oStyle)
|
||
End Sub
|
||
|
||
Private Function CreateProperty( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
|
||
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
|
||
If Not IsMissing( cName ) Then
|
||
oPropertyValue.Name = cName
|
||
EndIf
|
||
If Not IsMissing( uValue ) Then
|
||
oPropertyValue.Value = uValue
|
||
EndIf
|
||
CreateProperty() = oPropertyValue
|
||
End Function
|
||
|
||
Private Sub AskAndReplace(SearchString As String, oReplaceString As String)
|
||
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
|
||
End Sub
|
||
|
||
Private Function DocHasCharStyle(oDoc, sName$) As Boolean
|
||
Dim oStyles As Object
|
||
oStyles = oDoc.StyleFamilies.getByName("CharacterStyles")
|
||
DocHasCharStyle() = oStyles.hasByName(sName)
|
||
End Function
|
||
|
||
Private Function getTemplatePath() as String
|
||
Dim path as String
|
||
Dim settings As Object
|
||
Dim configProvider As Object
|
||
Dim params(0) As new com.sun.star.beans.PropertyValue
|
||
Dim convService As Object
|
||
|
||
configProvider = createUnoService( "com.sun.star.configuration.ConfigurationProvider" )
|
||
params(0).Name = "nodepath"
|
||
params(0).Value = "/org.openoffice.Office.Paths/Paths"
|
||
settings = configProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", params() )
|
||
path = settings.Template.WritePath
|
||
convService = CreateUnoService("com.sun.star.util.PathSubstitution")
|
||
path = convService.substituteVariables(path, true)
|
||
path = ConvertToUrl(path)
|
||
getTemplatePath = path
|
||
|
||
End Function
|
||
|
||
|
||
|
||
Private Sub removeHyperlinks()
|
||
Dim aNote As Object
|
||
Dim x As Long
|
||
removeHLInText(ThisComponent.Text)
|
||
For x = 0 to ThisComponent.FootNotes.Count -1
|
||
aNote = ThisComponent.FootNotes.getByIndex(x)
|
||
removeHLInText(aNote.Text)
|
||
Next
|
||
For x = 0 to ThisComponent.EndNotes.Count -1
|
||
aNote = ThisComponent.EndNotes.getByIndex(x)
|
||
removeHLInText(aNote.Text)
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub removeHLInText(textElement)
|
||
Dim enum1Element As Object
|
||
Dim enum1 As Object
|
||
Dim i As Integer
|
||
Dim cell As Object
|
||
Dim cellNames()
|
||
Dim cellText As Object
|
||
enum1 = textElement.createEnumeration()
|
||
While enum1.hasMoreElements
|
||
enum1Element = enum1.nextElement
|
||
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
|
||
removeHLInPara(enum1Element)
|
||
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then
|
||
cellNames = enum1Element.cellNames
|
||
For i = LBound(cellNames) To Ubound(cellNames)
|
||
cell = enum1Element.getCellByName(cellNames(i))
|
||
cellText = cell.getText()
|
||
removeHLInText(cellText)
|
||
Next i
|
||
Else
|
||
EndIf
|
||
Wend
|
||
End Sub
|
||
|
||
Private Sub removeHLInPara(para)
|
||
Dim enum1Element As Object
|
||
Dim enum1 As Object
|
||
Dim elPropertySetInfo As Object
|
||
Dim i As Integer
|
||
enum1 = para.createEnumeration()
|
||
While enum1.hasMoreElements
|
||
enum1Element = enum1.nextElement
|
||
elPropertySetInfo = enum1Element.getPropertySetInfo()
|
||
If elPropertySetInfo.hasPropertyByName("HyperLinkURL") Then
|
||
enum1Element.HyperLinkURL=""
|
||
EndIf
|
||
Wend
|
||
End Sub
|
||
Private Sub disposeAllBookmarks()
|
||
Dim bookmarks As Object
|
||
Dim elementName As String
|
||
elementName = ThisComponent.Links.ElementNames(6)
|
||
bookmarks = ThisComponent.Links.getByName(elementName)
|
||
While bookmarks.hasElements()
|
||
bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
|
||
bookmark.dispose()
|
||
Wend
|
||
End Sub
|
||
|
||
|
||
Private Sub removeManualPageBreaks
|
||
Dim oTextCursor As Object
|
||
Dim enum1 As Object
|
||
Dim enum1Element As Object
|
||
oTextCursor = ThisComponent.Text.CreateTextCursor()
|
||
enum1 = ThisComponent.Text.createEnumeration
|
||
While enum1.hasMoreElements
|
||
enum1Element = enum1.nextElement
|
||
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
|
||
If enum1Element.BreakType <> com.sun.star.style.BreakType.NONE Then
|
||
oTextCursor.goToRange(enum1Element.getAnchor(), false)
|
||
If NOT IsEmpty(oTextCursor.PageDescName) Then
|
||
oTextCursor.PageDescName = ""
|
||
End If
|
||
oTextCursor.BreakType = com.sun.star.style.BreakType.NONE
|
||
End If
|
||
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then
|
||
If NOT IsEmpty(enum1Element.PageDescName) Then
|
||
enum1Element.PageDescName = ""
|
||
End If
|
||
enum1Element.BreakType = com.sun.star.style.BreakType.NONE
|
||
EndIf
|
||
Wend
|
||
End Sub
|
||
|
||
Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optional SrchAttributes)
|
||
doNotTrack
|
||
dim stringValue1 As String
|
||
dim stringValue2 As String
|
||
Dim oSearch As Object
|
||
Dim oTextCursor As Object
|
||
Dim oViewCursor As Object
|
||
Dim replace As Boolean
|
||
Dim attrName As string
|
||
Dim attrValue As String
|
||
Dim oFound As Object
|
||
Dim i As Long
|
||
Dim j As Long
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
oSearch = ThisComponent.createSearchDescriptor()
|
||
oSearch.SearchString = searchPattern
|
||
' Mri oSearch
|
||
oSearch.SearchRegularExpression=True
|
||
oSearch.SearchAll = True
|
||
If Not IsMissing (SrchAttributes) Then
|
||
If Not IsEmpty(SrchAttributes(0).Value) Then
|
||
oSearch.searchStyles = true
|
||
oSearch.SetSearchAttributes(SrchAttributes())
|
||
End If
|
||
EndIf
|
||
oFound = ThisComponent.findFirst(oSearch)
|
||
Do While Not IsNull(oFound)
|
||
replace = true
|
||
If Not IsMissing(SrchAttributes) Then
|
||
For j = LBound(SrchAttributes) To Ubound(SrchAttributes)
|
||
If oFound.getPropertySetInfo.hasPropertyByName(SrchAttributes(j).Name) Then
|
||
stringValue1 = "" & oFound.getPropertyValue(SrchAttributes(j).Name)
|
||
stringValue2 = "" & SrchAttributes(j).Value
|
||
If stringValue1 <> stringValue2 Then
|
||
replace = replace AND False
|
||
EndIf
|
||
Else
|
||
replace = replace AND False
|
||
EndIf
|
||
Next j
|
||
EndIf
|
||
If replace then
|
||
For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
|
||
'If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
|
||
oFound.SetPropertyValue(ReplAttributes(i).Name, ReplAttributes(i).Value)
|
||
'EndIf
|
||
Next i
|
||
EndIf
|
||
oFound = ThisComponent.findNext(oFound.End, oSearch)
|
||
Loop
|
||
|
||
End Sub
|
||
|
||
Private Sub saveAndreload()
|
||
Dim document As Object
|
||
Dim dispatcher As Object
|
||
'Dim timeOut As Long
|
||
'timeOut = 0
|
||
'DocumentLoaded = false
|
||
document = ThisComponent.CurrentController.Frame
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
|
||
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())
|
||
Wait 1000
|
||
'RegisterListener (ThisComponent)
|
||
'Do while DocumentLoaded = false
|
||
' Wait 300
|
||
' timeOut = timeOut + 300
|
||
' If timeOut > 30000 Then
|
||
' MsgBox "Time out"
|
||
' Exit sub
|
||
' EndIf
|
||
'Loop
|
||
'DocumentLoaded = false
|
||
|
||
End Sub
|
||
|
||
Private Sub saveDocument()
|
||
Dim document As Object
|
||
Dim dispatcher As Object
|
||
document = ThisComponent.CurrentController.Frame
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
|
||
|
||
end Sub
|
||
|
||
Private Sub cleanFormatting
|
||
|
||
'Не должно быть символов табуляции
|
||
AskAndReplace("\t","")
|
||
'Не должно быть подряд больше одного пробела
|
||
AskAndReplace("(?<=[:space:])[:space:]+","")
|
||
'Не должно быть ни одного пробела в начале абзацев
|
||
AskAndReplace("^[:space:]+","")
|
||
'Не должно быть пустых абзацев
|
||
AskAndReplace("^$","")
|
||
|
||
convertFormattingToUserFields
|
||
|
||
convertFontsToCharStyles()
|
||
|
||
replaceBaseWithStandard()
|
||
|
||
resetFootnotesStyle
|
||
|
||
removeDirectFormatting()
|
||
|
||
saveAndreload()
|
||
|
||
convertUserFieldsToFormatting
|
||
|
||
End Sub
|
||
|
||
Private Sub fixTableWidth()
|
||
Dim table As Object
|
||
Dim tables As Object
|
||
Dim count As Long
|
||
Dim i As Long
|
||
tables = ThisComponent.TextTables
|
||
count = ThisComponent.TextTables.getCount()
|
||
For i = 0 To count - 1
|
||
table = tables.getByIndex(i)
|
||
If table.HoriOrient = 6 Then
|
||
table.HoriOrient = 2
|
||
EndIf
|
||
If table.RelativeWidth = 0 Then
|
||
table.RelativeWidth = 100
|
||
EndIf
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub fixDrawingAnchors()
|
||
Dim drawing As Object
|
||
Dim drawings As Object
|
||
drawings = ThisComponent.DrawPage
|
||
Dim count As Long
|
||
Dim i As Long
|
||
count = drawings.getCount()
|
||
For i = 0 To count - 1
|
||
drawing = drawings.getByIndex(i)
|
||
If drawing.AnchorType= com.sun.star.text.TextContentAnchorType.AT_PAGE Then
|
||
drawing.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
|
||
EndIf
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub replaceBaseWithStandard
|
||
replaceParaStyle("Базовый","Основной текст")
|
||
replaceParaStyle("Default Style","Text Body")
|
||
resetSearchSettings()
|
||
End Sub
|
||
|
||
Private Sub replaceParaStyle(oldStyleName,newStyleName)
|
||
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 = oldStyleName
|
||
args1(12).Name = "SearchItem.ReplaceString"
|
||
args1(12).Value = newStyleName
|
||
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 = 3
|
||
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
|
||
|
||
Private Sub resetSearchSettings()
|
||
Dim document as Object
|
||
Dim dispatcher as object
|
||
document = ThisComponent.CurrentController.Frame
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
dim args3(21) as new com.sun.star.beans.PropertyValue
|
||
args3(0).Name = "SearchItem.StyleFamily"
|
||
args3(0).Value = 2
|
||
args3(1).Name = "SearchItem.CellType"
|
||
args3(1).Value = 0
|
||
args3(2).Name = "SearchItem.RowDirection"
|
||
args3(2).Value = true
|
||
args3(3).Name = "SearchItem.AllTables"
|
||
args3(3).Value = false
|
||
args3(4).Name = "SearchItem.SearchFiltered"
|
||
args3(4).Value = false
|
||
args3(5).Name = "SearchItem.Backward"
|
||
args3(5).Value = false
|
||
args3(6).Name = "SearchItem.Pattern"
|
||
args3(6).Value = false
|
||
args3(7).Name = "SearchItem.Content"
|
||
args3(7).Value = false
|
||
args3(8).Name = "SearchItem.AsianOptions"
|
||
args3(8).Value = false
|
||
args3(9).Name = "SearchItem.AlgorithmType"
|
||
args3(9).Value = 0
|
||
args3(10).Name = "SearchItem.SearchFlags"
|
||
args3(10).Value = 65536
|
||
args3(11).Name = "SearchItem.SearchString"
|
||
args3(11).Value = ""
|
||
args3(12).Name = "SearchItem.ReplaceString"
|
||
args3(12).Value = ""
|
||
args3(13).Name = "SearchItem.Locale"
|
||
args3(13).Value = 255
|
||
args3(14).Name = "SearchItem.ChangedChars"
|
||
args3(14).Value = 2
|
||
args3(15).Name = "SearchItem.DeletedChars"
|
||
args3(15).Value = 2
|
||
args3(16).Name = "SearchItem.InsertedChars"
|
||
args3(16).Value = 2
|
||
args3(17).Name = "SearchItem.TransliterateFlags"
|
||
args3(17).Value = 1280
|
||
args3(18).Name = "SearchItem.Command"
|
||
args3(18).Value = 3
|
||
args3(19).Name = "SearchItem.SearchFormatted"
|
||
args3(19).Value = false
|
||
args3(20).Name = "SearchItem.AlgorithmType2"
|
||
args3(20).Value = 1
|
||
args3(21).Name = "Quiet"
|
||
args3(21).Value = true
|
||
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args3())
|
||
End Sub
|
||
Private Sub doNotTrack
|
||
Dim dispatcher As Object
|
||
Dim document As Object
|
||
Dim trackProperties(0) as new com.sun.star.beans.PropertyValue
|
||
Dim args1(0) as new com.sun.star.beans.PropertyValue
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
document = ThisComponent.CurrentController.Frame
|
||
trackProperties(0).Name = "TrackChanges"
|
||
trackProperties(0).Value = false
|
||
dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties())
|
||
args1(0).Name = "ShowTrackedChanges"
|
||
args1(0).Value = true
|
||
dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args1())
|
||
End Sub
|
||
|
||
Private Sub removeDirectFormatting
|
||
Dim oDescriptor As Object
|
||
Dim dispatcher as Object
|
||
Dim document as Object
|
||
Dim x As Integer
|
||
Dim endNotes As Object
|
||
Dim aNote As Object
|
||
Dim endNoteText As Object
|
||
Dim oViewCursor As Object
|
||
Dim oTextCursor As Object
|
||
Dim footNotes As Object
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
document = ThisComponent.CurrentController.Frame
|
||
oViewCursor = ThisComponent.CurrentController.getViewCursor()
|
||
oViewCursor.jumpToFirstPage()
|
||
oViewCursor.gotoStart(false)
|
||
oViewCursor.gotoEnd(true)
|
||
dispatcher.executeDispatch(document, ".uno:ResetAttributes", "", 0, Array())
|
||
footNotes = thisComponent.Footnotes
|
||
For x = 0 to footNotes.Count -1
|
||
aNote = footNotes.getByIndex(x)
|
||
footNoteText = aNote.getText()
|
||
oTextcursor = footNoteText.createTextCursor()
|
||
oViewCursor.gotoRange(oTextcursor.getStart(),false)
|
||
oViewCursor.gotoEnd(true)
|
||
dispatcher.executeDispatch(document, ".uno:ResetAttributes", "", 0, Array())
|
||
Next
|
||
endNotes = thisComponent.Endnotes
|
||
for x = 0 to endNotes.Count -1
|
||
aNote = endNotes.getByIndex(x)
|
||
endNoteText = aNote.getText()
|
||
oTextcursor = endNoteText.createTextCursor()
|
||
oViewCursor.gotoRange(oTextcursor.getStart(),false)
|
||
oViewCursor.gotoEnd(true)
|
||
dispatcher.executeDispatch(document, ".uno:ResetAttributes", "", 0, Array())
|
||
next
|
||
oViewCursor.gotoStart(false)
|
||
End Sub
|
||
|
||
Private Sub resetFootnotesStyle
|
||
Dim oDescriptor As Object
|
||
Dim dispatcher as Object
|
||
Dim document As Object
|
||
Dim oViewCursor As Object
|
||
Dim allNotes As Object
|
||
Dim x As Integer
|
||
Dim aNote As Object
|
||
Dim oEnum As Object
|
||
Dim oCurPar As Object
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
document = ThisComponent.CurrentController.Frame
|
||
oViewCursor = ThisComponent.CurrentController.getViewCursor()
|
||
allNotes= thisComponent.FootNotes
|
||
for x = 0 to allNotes.Count -1
|
||
aNote = allNotes.getByIndex(x)
|
||
aNote.Anchor.CharStyleName="Footnote anchor"
|
||
oEnum = aNote.Text.createEnumeration()
|
||
Do While oEnum.hasMoreElements()
|
||
oCurPar = oEnum.nextElement()
|
||
oCurPar.ParaStyleName = "Footnote"
|
||
Loop
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub removeUnusedStyles
|
||
Dim sElements() as String
|
||
Dim oFamilies As Object
|
||
Dim oFamily As Object
|
||
Dim i As Integer
|
||
Dim oDoc as object
|
||
oDoc = ThisComponent
|
||
oFamilies = thiscomponent.StyleFamilies
|
||
sElements() = oFamilies.getElementNames()
|
||
For i = 0 to uBound(sElements()) -2
|
||
oFamily = oFamilies.getByName(sElements(i))
|
||
removeUnusedStyle(oFamily,sElements(i),True)
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub removeUnusedStyle(oFamily ,sFamily as string, bAsk as Boolean)
|
||
Dim i As Integer
|
||
Dim sUsed() as String
|
||
sUsed() = getStyleNames(oFamily,bLocalized:=True,bUsed:=False,bUserDef:=true)
|
||
If uBound(sUsed()) > -1 then
|
||
For i = 0 to uBound(sUsed())
|
||
oFamily.removeByName(sUsed(i))
|
||
Next
|
||
EndIf
|
||
End Sub
|
||
|
||
Private Sub convertFormatToEnclosure(identifier As String, styleNames, styleValues)
|
||
Dim leftEnclosure As String
|
||
Dim rightEnclosure As String
|
||
Dim oTextCursor As Object
|
||
Dim startTextRange As Object
|
||
Dim endTextRange As Object
|
||
Dim foundString As String
|
||
Dim SDesc As Object
|
||
Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
|
||
Dim i As Integer
|
||
Dim found As Object
|
||
|
||
leftEnclosure = compileLeftEnclosure(identifier)
|
||
rightEnclosure = compileRightEnclosure(identifier)
|
||
For i = 0 To Ubound(styleNames)
|
||
SrchAttributes(i).Name = styleNames(i)
|
||
SrchAttributes(i).Value = styleValues(i)
|
||
Next i
|
||
SDesc = Thiscomponent.createSearchDescriptor()
|
||
SDesc.SearchAll = true
|
||
SDesc.SearchRegularExpression = true
|
||
SDesc.SearchString = ""
|
||
SDesc.searchStyles = false
|
||
SDesc.SetSearchAttributes(SrchAttributes)
|
||
found = Thiscomponent.findFirst(SDesc)
|
||
Do While not isNull(found)
|
||
oTextCursor = found.Text.createTextCursor()
|
||
oTextCursor.goToRange(found.Start, false)
|
||
oTextCursor.goToRange(found.End, true)
|
||
For i = 0 To Ubound(styleNames)
|
||
oTextCursor.setPropertyToDefault(styleNames(i))
|
||
Next i
|
||
foundString = found.getString()
|
||
If Len(foundString) <> 0 Then
|
||
oTextCursor.collapseToEnd()
|
||
oTextCursor.String = rightEnclosure
|
||
endTextRange = oTextCursor.getEnd()
|
||
oTextCursor.goToRange(found.start,false)
|
||
oTextCursor.String = leftEnclosure
|
||
EndIf
|
||
found = Thiscomponent.findNext(found.End, SDesc)
|
||
Loop
|
||
End Sub
|
||
|
||
Private Sub convertEnclosuresToFormat(identifier As String, styleNames, styleValues)
|
||
Dim oTextCursor As Object
|
||
Dim startTextRange As Object
|
||
Dim endTextRange As Object
|
||
Dim leftEnclosure As String
|
||
Dim rightEnclosure As String
|
||
Dim SDesc As Object
|
||
Dim found As Object
|
||
|
||
leftEnclosure = compileLeftEnclosure(identifier)
|
||
rightEnclosure = compileRightEnclosure(identifier)
|
||
SDesc = Thiscomponent.createSearchDescriptor()
|
||
SDesc.SearchAll = true
|
||
SDesc.SearchRegularExpression = true
|
||
SDesc.SearchString = leftEnclosure + "([^" + identifier+ "]*)" + rightEnclosure
|
||
|
||
found = Thiscomponent.findFirst(SDesc)
|
||
Do While not isNull(found)
|
||
oTextCursor = found.Text.createTextCursor()
|
||
oTextCursor.goToRange(found.Start, false)
|
||
oTextCursor.goToRange(found.End, true)
|
||
oTextCursor.setPropertyValues(styleNames, styleValues)
|
||
oTextCursor.collapseToEnd()
|
||
oTextCursor.goLeft(Len(rightEnclosure), true)
|
||
oTextCursor.String = ""
|
||
endTextRange = oTextCursor.getEnd()
|
||
oTextCursor.goToRange(found.start,false)
|
||
oTextCursor.goRight(Len(leftEnclosure), true)
|
||
oTextCursor.String = ""
|
||
found = Thiscomponent.findNext(endTextRange, SDesc)
|
||
Loop
|
||
End Sub
|
||
|
||
|
||
Private Function compileSearchString(identifier) As String
|
||
compileSearchString = "<" & identifier & ">" & "(.*?)" & "</" & identifier & ">"
|
||
End Function
|
||
|
||
Private Function compileLeftEnclosure(identifier) As String
|
||
compileLeftEnclosure = "<" & identifier & ">"
|
||
End Function
|
||
|
||
Private Function compileRightEnclosure(identifier) As String
|
||
compileRightEnclosure = "</" & identifier & ">"
|
||
End Function
|
||
|
||
|
||
Private Sub toTextBold
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharWeight")
|
||
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
|
||
convertFormatToEnclosure(CHR(867), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextBold
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharWeight")
|
||
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
|
||
convertEnclosuresToFormat(CHR(867), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextItalic
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharPosture")
|
||
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
|
||
convertFormatToEnclosure(CHR(868), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextItalic
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharPosture")
|
||
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
|
||
convertEnclosuresToFormat(CHR(868), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextStrikeout
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharStrikeout")
|
||
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
|
||
convertFormatToEnclosure(CHR(869), styleNames, styleValues)
|
||
|
||
End Sub
|
||
|
||
Private Sub fromTextStrikeout
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharStrikeout")
|
||
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
|
||
convertEnclosuresToFormat(CHR(869), styleNames, styleValues)
|
||
End Sub
|
||
|
||
|
||
Private Sub toTextUnderline
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharUnderline")
|
||
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
|
||
convertFormatToEnclosure(CHR(870), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextUnderline
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharUnderline")
|
||
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
|
||
convertEnclosuresToFormat(CHR(870), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextSuperscript
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,14000)
|
||
convertFormatToEnclosure(CHR(871), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextSuperscript
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,14000)
|
||
convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextSubscript
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-14000)
|
||
convertFormatToEnclosure(CHR(872), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextSubscript
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-14000)
|
||
convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextSuperscriptOld
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,101)
|
||
convertFormatToEnclosure(CHR(871), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextSuperscriptOld
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,101)
|
||
convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextSubscriptOld
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-101)
|
||
convertFormatToEnclosure(CHR(872), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub fromTextSubscriptOld
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-101)
|
||
convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub toTextSparce
|
||
Dim i As Integer
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharKerning")
|
||
For i=70 To 70
|
||
styleValues = Array(i)
|
||
convertFormatToEnclosure(CHR(873) & i, styleNames, styleValues)
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub fromTextSparce
|
||
Dim i As Integer
|
||
Dim styleNames As Variant
|
||
Dim StyleValues As Variant
|
||
styleNames = Array("CharKerning")
|
||
For i=70 To 70
|
||
styleValues = Array(i)
|
||
convertEnclosuresToFormat(CHR(873) & i, styleNames, styleValues)
|
||
Next
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
Private Function confirm(description) As Boolean
|
||
If MsgBox (description, 4) =6 Then
|
||
confirm = true
|
||
Else
|
||
confirm = false
|
||
EndIf
|
||
End Function
|
||
|
||
Private Sub ReplaceFormatting(SearchString As String ,oReplaceString As String ,SrchAttributes,ReplAttributes, searchStyles)
|
||
Dim oReplace As Object
|
||
oReplace = ThisComponent.createReplaceDescriptor()
|
||
oReplace.SearchString = SearchString
|
||
oReplace.ReplaceString = oReplaceString
|
||
oReplace.SearchRegularExpression=True
|
||
oReplace.SearchCaseSensitive = True
|
||
|
||
oReplace.searchAll=True
|
||
If Not IsEmpty(SrchAttributes(0).Value) Then
|
||
oReplace.SetSearchAttributes(SrchAttributes())
|
||
oReplace.searchStyles = searchStyles
|
||
End If
|
||
If Not IsEmpty(ReplAttributes(0).Value) Then
|
||
oReplace.SetReplaceAttributes(ReplAttributes())
|
||
End If
|
||
ThisComponent.replaceAll(oReplace)
|
||
End Sub
|
||
|
||
Private Function getStyleNames(oFamily,bLocalized as Boolean, optional bUsed, optional bUserDef)
|
||
Dim oStyle As Object
|
||
Dim i As Long
|
||
Dim sNames() As Variant
|
||
Dim sName As String
|
||
Dim chkUse as Boolean
|
||
Dim chkUDef as Boolean
|
||
For i = 0 to oFamily.getCount -1
|
||
oStyle = oFamily.getByIndex(i)
|
||
If bLocalized then
|
||
sName = oStyle.DisplayName
|
||
Else
|
||
sName = oStyle.getName
|
||
Endif
|
||
If (vartype(bUsed) = 11)then
|
||
chkUse = (bUsed EQV oStyle.isInUse)
|
||
Else
|
||
chkUse = True
|
||
Endif
|
||
If (vartype(bUserDef) = 11) then
|
||
chkUDef = (bUserDef EQV oStyle.isUserDefined)
|
||
Else
|
||
chkUDef = True
|
||
EndIf
|
||
If sName = "Автор" Or sName = "Автор по-английски" Or sName = "Ключевые слова" Or sName = "Текст списка литературы" Or sName = "Эпиграф" or sName = "Цитирование" or sName = "Сведения об авторе" or sName = "Аннотация" Then
|
||
chkUse = False
|
||
Endif
|
||
If chkUse AND chkUDef then
|
||
bas_Pusharray sNames(),sName
|
||
Endif
|
||
Next
|
||
getStyleNames = sNames()
|
||
End Function
|
||
|
||
Sub bas_PushArray(xArray(),vNextElement)
|
||
Dim iUB As Long
|
||
Dim iLB As Long
|
||
iLB = lBound(xArray())
|
||
iUB = uBound(xArray())
|
||
If iLB > iUB then
|
||
iUB = iLB
|
||
redim xArray(iLB To iUB)
|
||
Else
|
||
iUB = iUB +1
|
||
redim preserve xArray(iLB To iUB)
|
||
Endif
|
||
xArray(iUB) = vNextElement
|
||
End Sub
|
||
|
||
Private Sub replaceWhiteBackgroundWithTransparent
|
||
Dim description As String
|
||
Dim searchPattern As String
|
||
Dim SrchAttributes(1) as new com.sun.star.beans.PropertyValue
|
||
Dim ReplAttributes(1) as new com.sun.star.beans.PropertyValue
|
||
Dim statusIndicator As Object
|
||
searchPattern = ""
|
||
statusIndicator = ThisComponent.getCurrentController.statusIndicator
|
||
statusIndicator.Start("Замена белого фона на прозрачный начата",100)
|
||
|
||
SrchAttributes(0).Name = "CharBackTransparent"
|
||
SrchAttributes(0).Value = False
|
||
SrchAttributes(1).Name = "CharBackColor"
|
||
SrchAttributes(1).Value = 16777215
|
||
ReplAttributes(0).Name = "CharBackTransparent"
|
||
ReplAttributes(0).Value = True
|
||
ReplAttributes(1).Name = "CharBackColor"
|
||
ReplAttributes(1).Value = -1
|
||
setAttributesBySearchPattern(searchPattern,ReplAttributes,SrchAttributes)
|
||
statusIndicator.end()
|
||
End Sub
|
||
|
||
|
||
Sub convertSymbol
|
||
Dim newFontName As String
|
||
Dim oSearchString As String
|
||
Dim oReplaceString As String
|
||
'newFontName = "IPH Astra Serif"
|
||
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
SrchAttributes(0).Name = "CharFontName"
|
||
SrchAttributes(0).Value = "Symbol"
|
||
ReplAttributes(0).Name = "CharFontName"
|
||
ReplAttributes(0).Value = "Noto Serif CJK JP"
|
||
|
||
oSearchString = "\uF0DE"
|
||
oReplaceString = "⇒"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
oSearchString = "\uF0DB"
|
||
oReplaceString = "⇔"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
|
||
'replaceFontsInStyles( "WL LatinAllIn1Goth", newFontName)
|
||
End Sub
|
||
|
||
Private Sub convertWLLatin2IPHAstra
|
||
Dim newFontName As String
|
||
Dim oSearchString As String
|
||
Dim oReplaceString As String
|
||
'newFontName = "IPH Astra Serif"
|
||
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
SrchAttributes(0).Name = "CharFontName"
|
||
'SrchAttributes(0).Value = "WL LatinAllIn1Goth"
|
||
ReplAttributes(0).Name = "CharFontName"
|
||
'ReplAttributes(0).Value = newFontName
|
||
|
||
SrchAttributes(0).Value = Empty
|
||
ReplAttributes(0).Value = Empty
|
||
'Replace macron below
|
||
oSearchString = "(.)(\uF0D4)+"
|
||
oReplaceString = "$1̱"
|
||
'from WL
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
oSearchString = "(.)\u0331"
|
||
'from unicode to remove direct formatting
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
|
||
'Replace dot below
|
||
oSearchString = "(.)(\uF0D6)+"
|
||
oReplaceString = "$1̣"
|
||
'from WL
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
'from unicode to remove direct formatting
|
||
oSearchString = "(.)\u0323"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
|
||
'replace macron
|
||
oSearchString = "(.)(\uF0F4)+"
|
||
oReplaceString = "$1̄"
|
||
'from WL
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
'from unicode to remove direct formatting
|
||
oSearchString = "(.)\u0304"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
'replace space
|
||
|
||
oSearchString = "\uF020"
|
||
oReplaceString = " "
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
'replace comma
|
||
oSearchString = "\uF02C"
|
||
oReplaceString = ","
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
|
||
'replace accent
|
||
oSearchString = "(.)(\uF0F1)+"
|
||
oReplaceString = "$1́"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
'from unicode to remove direct formatting
|
||
oSearchString = "(.)\u0341"
|
||
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
|
||
|
||
replaceFontsInStyles( "WL LatinAllIn1Goth", newFontName)
|
||
End Sub
|
||
|
||
Function getVersion As String
|
||
GlobalScope.BasicLibraries.LoadLibrary("Tools")
|
||
Dim oProduct As Object
|
||
oProduct=GetRegistryKeyContent("org.openoffice.Setup/Product")
|
||
getVersion=oProduct.getByName("ooSetupVersion")
|
||
End Function
|
||
|
||
Function getFullVersion As String
|
||
GlobalScope.BasicLibraries.LoadLibrary("Tools")
|
||
Dim oProduct As Object
|
||
oProduct=GetRegistryKeyContent("org.openoffice.Setup/Product")
|
||
getFullVersion=oProduct.getByName("ooSetupVersionAboutBox")
|
||
End Function
|
||
|
||
|
||
|
||
Private Sub convertFormatToUserFields(identifier As String, styleNames, styleValues)
|
||
Dim maxLength As Integer
|
||
maxLength = getMaxLength(identifier)
|
||
Dim leftField As String
|
||
Dim rightField As String
|
||
Dim i As Integer
|
||
Dim found As Object
|
||
leftField = "left" & identifier
|
||
rightField = "right" & identifier
|
||
Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
|
||
For i = Lbound(styleNames) To Ubound(styleNames)
|
||
SrchAttributes(i).Name = styleNames(i)
|
||
Next i
|
||
For i = Lbound(styleValues) To Ubound(styleValues)
|
||
SrchAttributes(i).Value = styleValues(i)
|
||
Next i
|
||
SDesc = Thiscomponent.createSearchDescriptor()
|
||
SDesc.SearchAll = true
|
||
SDesc.SearchRegularExpression = true
|
||
SDesc.SearchString = ""
|
||
SDesc.searchStyles = true
|
||
SDesc.SetSearchAttributes(SrchAttributes)
|
||
found = Thiscomponent.findFirst(SDesc)
|
||
i = 0
|
||
Do While not isNull(found)
|
||
If Len(found.String) <> 0 AND NOT IsNull(found.Text) Then
|
||
If maxLength < 0 Or Len(found.String) < maxLength Then
|
||
insertUserField(found.End,rightField & i,"")
|
||
insertUserField(found.start,leftField & i,"")
|
||
i = i + 1
|
||
EndIf
|
||
EndIf
|
||
found = Thiscomponent.findNext(found.End, SDesc)
|
||
|
||
Loop
|
||
End Sub
|
||
|
||
Function getMaxLength(identifier As String) As Integer
|
||
Dim config As Object
|
||
config = initRedactionConfiguration()
|
||
If identifier = "SubScript" Then
|
||
getMaxLength = CInt(config.getPropertyValue("subscript_max_length"))
|
||
Exit Function
|
||
EndIf
|
||
If identifier = "SuperScript" Then
|
||
getMaxLength = CInt(config.getPropertyValue("superscript_max_length"))
|
||
Exit Function
|
||
EndIf
|
||
getMaxLength = -1
|
||
End Function
|
||
|
||
Private Sub convertUserFieldsToFormat(identifier As String, styleNames , styleValues)
|
||
Dim oTextCursor As Object
|
||
Dim oMasters As Object
|
||
Dim endTextRange As Object
|
||
Dim leftFieldName As String
|
||
Dim rightFieldName As String
|
||
Dim leftFieldMaster As Object
|
||
Dim rightFieldMaster As Object
|
||
Dim leftField As Object
|
||
Dim rightField As Object
|
||
Dim leftAnchor As Object
|
||
Dim rightAnchor As Object
|
||
Dim i As Integer
|
||
oMasters = ThisComponent.getTextFieldMasters()
|
||
i = 0
|
||
Do
|
||
leftFieldName = "com.sun.star.text.FieldMaster.User" & "." & "left" & identifier & i
|
||
rightFieldName = "com.sun.star.text.FieldMaster.User" & "." & "right" & identifier & i
|
||
If oMasters.hasByName(leftFieldName) AND oMasters.hasByName(rightFieldName) Then
|
||
i=i+1
|
||
leftFieldMaster = oMasters.getByName(leftFieldName)
|
||
leftField = leftFieldMaster.DependentTextFields(0)
|
||
leftAnchor = leftField.getAnchor()
|
||
rightFieldMaster = oMasters.getByName(rightFieldName)
|
||
rightField = rightFieldMaster.DependentTextFields(0)
|
||
rightAnchor = rightField.getAnchor()
|
||
oTextCursor = leftAnchor.Text.createTextCursor()
|
||
oTextCursor.goToRange(leftAnchor.Start, false)
|
||
oTextCursor.goToRange(rightAnchor.End, true)
|
||
oTextCursor.setPropertyValues(styleNames, styleValues)
|
||
leftField.dispose()
|
||
leftFieldMaster.dispose()
|
||
rightField.dispose()
|
||
rightFieldMaster.dispose()
|
||
Else
|
||
Exit sub
|
||
EndIf
|
||
Loop
|
||
End Sub
|
||
|
||
|
||
Private Sub formatToUserFieldsBold
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharWeight")
|
||
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
|
||
convertFormatToUserFields("Bold", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatBold
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharWeight")
|
||
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
|
||
convertUserFieldsToFormat("Bold", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsItalic
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharPosture")
|
||
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
|
||
convertFormatToUserFields("Italic", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatItalic
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharPosture")
|
||
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
|
||
convertUserFieldsToFormat("Italic", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsStrikeout
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharStrikeout")
|
||
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
|
||
convertFormatToUserFields("StrikeOut", styleNames, styleValues)
|
||
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatStrikeout
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharStrikeout")
|
||
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
|
||
convertUserFieldsToFormat("StrikeOut", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsUnderline
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharUnderline")
|
||
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
|
||
convertFormatToUserFields("UnderLine", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatUnderline
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharUnderline")
|
||
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
|
||
convertUserFieldsToFormat("UnderLine", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsSuperscript
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,14000)
|
||
convertFormatToUserFields("SuperScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatSuperscript
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,14000)
|
||
convertUserFieldsToFormat("SuperScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsSubscript
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-14000)
|
||
convertFormatToUserFields("SubScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatSubscript
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-14000)
|
||
convertUserFieldsToFormat("SubScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsSuperscriptOld
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,101)
|
||
convertFormatToUserFields("SuperScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatSuperscriptOld
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,101)
|
||
convertUserFieldsToFormat("SuperScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsSubscriptOld
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-101)
|
||
convertFormatToUserFields("SubScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatSubscriptOld
|
||
Dim styleValues(1) As Integer
|
||
Dim styleNames(1) As String
|
||
styleNames = Array("CharEscapementHeight","CharEscapement")
|
||
styleValues = Array(58,-101)
|
||
convertUserFieldsToFormat("SubScript", styleNames, styleValues)
|
||
End Sub
|
||
|
||
Private Sub formatToUserFieldsSparce
|
||
Dim i As Integer
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharKerning")
|
||
i = 18
|
||
styleValues = Array(i)
|
||
convertFormatToUserFields(i & "Kerning" , styleNames, styleValues)
|
||
i = 35
|
||
styleValues = Array(i)
|
||
convertFormatToUserFields(i & "Kerning" , styleNames, styleValues)
|
||
i = 53
|
||
styleValues = Array(i)
|
||
convertFormatToUserFields(i & "Kerning" , styleNames, styleValues)
|
||
i = 70
|
||
styleValues = Array(i)
|
||
convertFormatToUserFields(i & "Kerning" , styleNames, styleValues)
|
||
|
||
End Sub
|
||
|
||
Private Sub userFieldsToFormatSparce
|
||
Dim i As Integer
|
||
Dim styleValues(0) As Integer
|
||
Dim styleNames(0) As String
|
||
styleNames = Array("CharKerning")
|
||
i = 18
|
||
styleValues = Array(i)
|
||
convertUserFieldsToFormat(i & "Kerning", styleNames, styleValues)
|
||
i = 35
|
||
styleValues = Array(i)
|
||
convertUserFieldsToFormat(i & "Kerning", styleNames, styleValues)
|
||
i = 53
|
||
styleValues = Array(i)
|
||
convertUserFieldsToFormat(i & "Kerning", styleNames, styleValues)
|
||
i = 70
|
||
styleValues = Array(i)
|
||
convertUserFieldsToFormat(i & "Kerning", styleNames, styleValues)
|
||
|
||
End Sub
|
||
|
||
Private Sub convertFormattingToText
|
||
Dim version As String
|
||
Dim smallNum As String
|
||
Dim bigNum As String
|
||
version = Trim(getVersion())
|
||
bigNum = Left(version, 1)
|
||
smallNum = Right(version, 1)
|
||
toTextBold()
|
||
toTextItalic()
|
||
toTextStrikeout()
|
||
toTextUnderline()
|
||
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
|
||
toTextSuperscriptOld()
|
||
toTextSubscriptOld()
|
||
Else
|
||
toTextSuperscript()
|
||
toTextSubscript()
|
||
EndIf
|
||
toTextSparce()
|
||
End Sub
|
||
|
||
Private Sub convertFormattingToUserFields
|
||
Dim version As String
|
||
Dim smallNum As String
|
||
Dim bigNum As String
|
||
version = Trim(getVersion())
|
||
bigNum = Left(version, 1)
|
||
smallNum = Right(version, 1)
|
||
formatToUserFieldsBold
|
||
formatToUserFieldsItalic
|
||
formatToUserFieldsStrikeout
|
||
formatToUserFieldsUnderline
|
||
|
||
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
|
||
formatToUserFieldsSuperscriptOld
|
||
formatToUserFieldsSubscriptOld
|
||
Else
|
||
formatToUserFieldsSuperscript
|
||
formatToUserFieldsSubscript
|
||
EndIf
|
||
|
||
formatToUserFieldsSparce
|
||
End Sub
|
||
|
||
Private Sub convertFormattingFromText
|
||
Dim version As String
|
||
version = Trim(getVersion())
|
||
Dim smallNum As String
|
||
Dim bigNum As String
|
||
version = Trim(getVersion())
|
||
bigNum = Left(version, 1)
|
||
smallNum = Right(version, 1)
|
||
fromTextSparce()
|
||
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
|
||
fromTextSuperscriptOld()
|
||
fromTextSubscriptOld()
|
||
Else
|
||
fromTextSuperscript()
|
||
fromTextSubscript()
|
||
EndIf
|
||
fromTextUnderline()
|
||
fromTextStrikeout()
|
||
fromTextItalic()
|
||
fromTextBold()
|
||
End Sub
|
||
|
||
Private Sub convertUserFieldsToFormatting
|
||
Dim version As String
|
||
version = Trim(getVersion())
|
||
Dim smallNum As String
|
||
Dim bigNum As String
|
||
version = Trim(getVersion())
|
||
bigNum = Left(version, 1)
|
||
smallNum = Right(version, 1)
|
||
userFieldsToFormatSparce
|
||
|
||
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
|
||
userFieldsToFormatSuperscriptOld
|
||
userFieldsToFormatSubscriptOld
|
||
Else
|
||
userFieldsToFormatSuperscript
|
||
userFieldsToFormatSubscript
|
||
EndIf
|
||
userFieldsToFormatUnderline
|
||
userFieldsToFormatStrikeout
|
||
userFieldsToFormatItalic
|
||
userFieldsToFormatBold
|
||
End Sub
|
||
|
||
Private Function insertUserField(cursor As Object,fieldName As String,fieldValue As String)
|
||
Dim oField As Object 'Field to insert
|
||
Dim oFieldMaster As Object
|
||
Dim oMasters As Object
|
||
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)
|
||
cursor.Text.insertTextContent(cursor, oField, False)
|
||
oField.IsVisible = false
|
||
End Function
|
||
|
||
sub saveAsDocAndBackToODT
|
||
dim document as object
|
||
dim dispatcher as object
|
||
Dim path As String
|
||
Dim tmpName As String
|
||
Dim oldName As String
|
||
'Dim timeOut As Long
|
||
'timeOut = 0
|
||
'DocumentLoaded = false
|
||
|
||
document = ThisComponent.CurrentController.Frame
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
oldName = ThisComponent.getURL()
|
||
tmpName = oldName & "--tmp" & ".doc"
|
||
dim args1(1) as new com.sun.star.beans.PropertyValue
|
||
args1(0).Name = "URL"
|
||
args1(0).Value = tmpName
|
||
args1(1).Name = "FilterName"
|
||
args1(1).Value = "MS Word 97"
|
||
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
|
||
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())
|
||
args1(0).Value = oldName
|
||
args1(1).Value = "writer8"
|
||
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
|
||
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())
|
||
'RegisterListener (ThisComponent)
|
||
'Do while DocumentLoaded = false
|
||
' Wait 300
|
||
' timeOut = timeOut + 300
|
||
' If timeOut > 30000 Then
|
||
' MsgBox "Time out"
|
||
' Exit sub
|
||
' EndIf
|
||
'Loop
|
||
'DocumentLoaded = false
|
||
|
||
If FileExists(tmpName) Then
|
||
Kill(tmpName)
|
||
End If
|
||
end Sub
|
||
|
||
Sub addTimeStampToProperties
|
||
Dim docProps As Object
|
||
Dim userProps As Object
|
||
Dim curTime As String
|
||
On Error Goto exceptionHandlerProps
|
||
curTime = Now()
|
||
docProps = ThisComponent.getDocumentProperties()
|
||
userProps = docProps.UserDefinedProperties()
|
||
userProps.addProperty(curTime ,128,"Cleaned by" & getUserName() & " with " & redactionExtensionVersion & " LO " & getFullVersion() )
|
||
exceptionHandlerProps:
|
||
Resume Next
|
||
End Sub
|
||
|
||
Function getUserName() As String
|
||
Dim oCP As Object
|
||
Dim oCUA As Object
|
||
Dim aProps(0) As New com.sun.star.beans.PropertyValue
|
||
oCP = GetProcessServiceManager().createInstance( "com.sun.star.configuration.ConfigurationProvider" )
|
||
aProps(0).Name = "nodepath"
|
||
aProps(0).Value = "/org.openoffice.UserProfile/Data"
|
||
oCUA = oCP.createInstanceWithArguments( "com.sun.star.configuration.ConfigurationUpdateAccess", aProps )
|
||
getUserName = " " & oCUA.getByName("givenname") & " " & oCUA.getByName("sn")
|
||
End Function
|
||
|
||
sub saveCleanedVersion(comment)
|
||
dim document as object
|
||
dim dispatcher as object
|
||
document = ThisComponent.CurrentController.Frame
|
||
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
|
||
dim args1(0) as new com.sun.star.beans.PropertyValue
|
||
args1(0).Name = "VersionComment"
|
||
args1(0).Value = comment
|
||
dispatcher.executeDispatch(document, ".uno:Save", "", 0, args1())
|
||
end Sub
|
||
|
||
Sub resetChapterNumberingRules
|
||
Dim chapNumRules As Object
|
||
Dim numRulesProps As Variant
|
||
Dim numRuleProperty As Variant
|
||
Dim i As Integer
|
||
chapNumRules = ThisComponent.ChapterNumberingRules
|
||
For i = 0 To chapNumRules.Count - 1
|
||
numRulesProps = chapNumRules.getByIndex(i)
|
||
For n = LBound(numRulesProps) To UBound(numRulesProps)
|
||
numRuleProperty = numRulesProps(n)
|
||
If (numRuleProperty.Name = "Prefix") Then
|
||
numRuleProperty.Value = ""
|
||
End If
|
||
If (numRuleProperty.Name = "Suffix") Then
|
||
numRuleProperty.Value = ""
|
||
End If
|
||
If (numRuleProperty.Name = "CharStyleName") Then
|
||
numRuleProperty.Value = "Standard"
|
||
End If
|
||
numRulesProps(n) = numRuleProperty
|
||
Next n
|
||
chapNumRules.replaceByIndex(i,numRulesProps)
|
||
Next i
|
||
End Sub
|
||
|
||
Private Sub replaceNumHyphen
|
||
StartTracking
|
||
replaceNumHyphenRegExp
|
||
StopTracking
|
||
End Sub
|
||
|
||
|
||
Sub replaceNumHyphenRegExp
|
||
AskAndReplace("(?<!DOI[0-9. /XVI:-‒–—−-]{1,50})(?<=[:digit:])(?:[:space:])?[-‒–—−](?:[:space:])?(?=[:digit:])","‒")
|
||
End sub
|
||
|
||
Sub fixBrokenCharBackTransparent
|
||
Dim footNotes As Object
|
||
Dim endNotes As Object
|
||
Dim i As Integer
|
||
Dim oStyles As Object
|
||
Dim pageStyles As Object
|
||
Dim pageStyle As Object
|
||
footNotes = thisComponent.footNotes
|
||
For i = 0 to footNotes.Count -1
|
||
setDefaultBackColorInText(footNotes.getByIndex(i).Text)
|
||
Next i
|
||
endNotes = thisComponent.footNotes
|
||
For i = 0 to footNotes.Count -1
|
||
setDefaultBackColorInText(endNotes.getByIndex(i).Text)
|
||
Next i
|
||
oStyles = ThisComponent.StyleFamilies
|
||
pageStyles = oStyles.getByName(oStyles.elementNames(2))
|
||
For i = 0 to pageStyles.Count -1
|
||
pageStyle = pageStyles.getByIndex(i)
|
||
If Not IsEmpty(pageStyle.FooterText) Then
|
||
setDefaultBackColorInText(pageStyle.FooterText)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.FooterTextFirst) Then
|
||
setDefaultBackColorInText(pageStyle.FooterTextFirst)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.FooterTextRight) Then
|
||
setDefaultBackColorInText(pageStyle.FooterTextRight)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.FooterTextLeft) Then
|
||
setDefaultBackColorInText(pageStyle.FooterTextLeft)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.HeaderText) Then
|
||
setDefaultBackColorInText(pageStyle.HeaderText)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.HeaderTextFirst) Then
|
||
setDefaultBackColorInText(pageStyle.HeaderTextFirst)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.HeaderTextRight) Then
|
||
setDefaultBackColorInText(pageStyle.HeaderTextRight)
|
||
EndIf
|
||
If Not IsEmpty(pageStyle.HeaderTextLeft) Then
|
||
setDefaultBackColorInText(pageStyle.HeaderTextLeft)
|
||
EndIf
|
||
Next i
|
||
setDefaultBackColorInText(ThisComponent.Text)
|
||
End Sub
|
||
|
||
Sub setDefaultBackColorInText(oText As Object)
|
||
If IsMissing(oText) Then
|
||
Exit sub
|
||
End If
|
||
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 count As Integer
|
||
Dim cell As Object
|
||
Dim cellText As Object
|
||
|
||
enum1 = oText.Text.createEnumeration
|
||
While enum1.hasMoreElements
|
||
enum1Element = enum1.nextElement
|
||
If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
|
||
If enum1Element.CharBackTransparent = false Then
|
||
enum1Element.setPropertyToDefault("CharBackTransparent")
|
||
EndIf
|
||
ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then
|
||
cellNames = enum1Element.cellNames
|
||
For i = LBound(cellNames) To Ubound(cellNames)
|
||
cell = enum1Element.getCellByName(cellNames(i))
|
||
cellText = cell.getText()
|
||
setDefaultBackColorInText(cellText)
|
||
Next i
|
||
EndIf
|
||
Wend
|
||
End Sub
|
||
|
||
|
||
Function fixColoredBackgroundInDoc() As Boolean
|
||
Dim founds As Object
|
||
Dim sDesc As Object
|
||
Dim i As Long
|
||
Dim foundObjects() As Object
|
||
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
|
||
SrchAttributes(0).Name = "CharBackTransparent"
|
||
SrchAttributes(0).Value = False
|
||
sDesc = Thiscomponent.createSearchDescriptor()
|
||
sDesc.SearchAll = true
|
||
sDesc.ValueSearch = false
|
||
sDesc.SearchRegularExpression = true
|
||
sDesc.searchStyles = true
|
||
sDesc.SetSearchAttributes(SrchAttributes())
|
||
founds = Thiscomponent.findAll(sDesc)
|
||
If founds.count <> 0 Then
|
||
foundObjects = convertXIndexAccessToArray(founds)
|
||
For i = LBound(foundObjects) To UBound(foundObjects)
|
||
foundObjects(i).CharBackTransparent = false
|
||
foundObjects(i).CharBackColor = -1
|
||
Next i
|
||
EndIf
|
||
|
||
End Function
|
||
|
||
|
||
Sub fixDiacriticKerning
|
||
Dim oSearch As Object
|
||
Dim oFound As Object
|
||
Dim oPara As Object
|
||
turnOffTracking()
|
||
oSearch = ThisComponent.createSearchDescriptor()
|
||
oSearch.SearchString = "[\u0300-\u036F]"
|
||
oSearch.SearchRegularExpression=True
|
||
oSearch.searchAll=True
|
||
oFound = ThisComponent.findFirst(oSearch)
|
||
Do While Not IsNull(oFound)
|
||
oPara = oFound.TextParagraph
|
||
fixDiacriticKerningInPara(oPara)
|
||
oFound = ThisComponent.findNext(oFound.End, oSearch)
|
||
Loop
|
||
End Sub
|
||
|
||
Sub fixDiacriticKerningInPara(oPara As Object)
|
||
Dim paraEnum As Object
|
||
Dim portion As Object
|
||
Dim prevPortion As Object
|
||
paraEnum = oPara.createEnumeration
|
||
If paraEnum.hasMoreElements Then
|
||
prevPortion = paraEnum.nextElement
|
||
While paraEnum.hasMoreElements
|
||
portion = paraEnum.nextElement
|
||
While isFirstCharDiacritic(portion)
|
||
moveFirstCharacter(portion, prevPortion)
|
||
Wend
|
||
prevPortion = portion
|
||
Wend
|
||
EndIf
|
||
End Sub
|
||
|
||
Function isFirstCharDiacritic(portion As Object) As Boolean
|
||
isFirstCharDiacritic = false
|
||
Dim portionText As String
|
||
Dim diaLowBound As Long
|
||
Dim diaHighBound As Long
|
||
Dim charNum As Long
|
||
diaLowBound = 768
|
||
diaHighBound = 879
|
||
portionText = portion.String
|
||
If Len(portionText) = 0 Then
|
||
Exit Function
|
||
EndIf
|
||
charNum = Asc(portionText)
|
||
If charNum >= diaLowBound And charNum <= diaHighBound Then
|
||
isFirstCharDiacritic = true
|
||
EndIf
|
||
End Function
|
||
|
||
Sub moveFirstCharacter(portion As Object, prevPortion As Object)
|
||
prevPortion.String = prevPortion.String & Left(portion.String,1)
|
||
portion.String = Right(portion.String,Len(portion.String) - 1)
|
||
End Sub
|
||
|
||
</script:module> |