2019-10-16 15:42:48 +03:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
2021-05-06 16:08:21 +02:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark81
2019-10-30 16:14:31 +03:00
2019-10-29 16:17:08 +03:00
End Sub
2021-01-15 20:03:04 +01:00
Dim DocumentLoaded as Boolean
2019-10-29 16:17:08 +03:00
Sub cleanButton
2020-03-05 20:23:54 +01:00
Dim config As Object
config = initRedactionConfiguration()
2020-07-02 17:54:23 +02:00
If ThisComponent.isReadonly Then
2020-07-02 17:59:56 +02:00
MsgBox(getTranslation("documentIsReadOnly"))
2020-07-02 17:54:23 +02:00
Exit Sub
EndIf
2020-03-05 20:23:54 +01:00
If config.getPropertyValue("complexity") = "user" then
2020-04-23 14:15:18 +02:00
quietStartDialog()
2020-03-05 20:23:54 +01:00
Else
makerUpMenu()
2020-03-06 11:04:22 +01:00
EndIf
End Sub
Private Sub makerUpMenu
Dim dialog As Object
DialogLibraries.LoadLibrary("Redaction")
dialog = CreateUnoDialog(DialogLibraries.Redaction.CleaningDialog)
2020-05-04 14:28:39 +02:00
dialog.getControl("fontsInStyles").Label = getTranslation("advancedMenuReplaceFontsInStyles")
dialog.getControl("symbolsConversion").Label = getTranslation("advancedMenuSymbolsConversion")
dialog.getControl("cleanFormatting").Label = getTranslation("advancedMenuCleanFormatting")
dialog.getControl("replaceWhiteBackground").Label = getTranslation("advancedMenuReplaceWhiteBackground")
dialog.getControl("removeUnusedStyles").Label = getTranslation("advancedMenuRemoveUnusedStyles")
dialog.getControl("removeLinks").Label = getTranslation("advancedMenuRemoveLinks")
2020-09-24 10:40:52 +02:00
dialog.getControl("removeAllFields").Label = getTranslation("advancedMenuRemoveAllFields")
2020-05-04 14:28:39 +02:00
dialog.getControl("removeBookmarks").Label = getTranslation("advancedMenuRemoveBookmarks")
dialog.getControl("configTables").Label = getTranslation("advancedMenuConfigTables")
dialog.getControl("configAnchors").Label = getTranslation("advancedMenuConfigAnchors")
dialog.getControl("fixMistakes").Label = getTranslation("advancedMenuFixMistakes")
2020-12-09 12:00:05 +01:00
dialog.getControl("fixDOI").Label = getTranslation("advancedMenuFixDOI")
2021-02-01 10:30:08 +01:00
dialog.getControl("replaceNumHyphen").Label = getTranslation("replaceNumHyphen")
2020-05-04 14:28:39 +02:00
dialog.getControl("removeInitPageBreak").Label = getTranslation("advancedMenuRemoveInitPageBreak")
dialog.getControl("removePageStyles").Label = getTranslation("advancedMenuRemovePageStyles")
dialog.getControl("loadStandardStyles").Label = getTranslation("advancedMenuLoadStandardStyles")
dialog.getControl("removeManualPageBreaks").Label = getTranslation("advancedMenuRemoveManualPageBreaks")
dialog.getControl("removeBasic").Label = getTranslation("advancedMenuRemoveBasic")
2021-01-12 01:07:00 +01:00
dialog.getControl("resetChapterNumberingRules").Label = getTranslation("advancedMenuResetChapterNumberingRules")
2021-04-30 14:13:32 +02:00
dialog.getControl("convertFontsToCharStyles").Label = getTranslation("advancedMenuconvertFontsToCharStyles")
2020-05-04 14:28:39 +02:00
dialog.getControl("Cancel").Label = getTranslation("buttonCancel")
dialog.getControl("OK").Label = getTranslation("buttonOK")
dialog.getControl("buttonLoad").Label = getTranslation("buttonLoad")
dialog.Title = getTranslation("advancedMenuDialogTitle")
2020-03-06 11:04:22 +01:00
dialog.setVisible(true)
Select Case dialog.Execute()
Case 1
cleanAccordingTo(dialog)
Case 0
End Select
dialog.dispose()
Exit sub
2020-03-05 20:23:54 +01:00
End Sub
2020-03-21 11:55:13 +01:00
Private Sub cleanAccordingTo(dialog As Object)
2020-03-06 11:04:22 +01:00
Dim statusIndicator as Object
2021-02-01 11:35:27 +01:00
Dim openTrackChanges As Boolean
openTrackChanges = false
2020-03-06 11:04:22 +01:00
dialog.setVisible(false)
saveDocument
2020-12-14 12:39:13 +01:00
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusStarted"),100)
2020-03-06 11:04:22 +01:00
doNotTrack
2020-06-18 15:26:48 +02:00
If dialog.getControl("loadStandardStyles").state = 1 Then
statusIndicator.Start(getTranslation("resaving"),100)
saveAsDocAndBackToODT
EndIf
2020-03-06 11:04:22 +01:00
If dialog.getControl("fontsInStyles").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusReplaceFontsInStyles"),100)
2020-03-06 11:04:22 +01:00
replaceStyleFonts
EndIf
If dialog.getControl("symbolsConversion").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConvertSymbolsInTargetFonts"),100)
2020-03-06 11:04:22 +01:00
unicodeSymbolsConversion
EndIf
If dialog.getControl("cleanFormatting").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusCleaningManualFormatting"),100)
2020-03-06 11:04:22 +01:00
cleanFormatting
EndIf
2020-03-13 10:27:26 +01:00
If dialog.getControl("replaceWhiteBackground").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusReplaceWhiteBackground"),100)
2020-03-13 10:27:26 +01:00
replaceWhiteBackgroundWithTransparent
EndIf
2020-03-06 14:17:06 +01:00
If dialog.getControl("removeUnusedStyles").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemovedUnusedStyles"),100)
2020-03-06 14:17:06 +01:00
removeUnusedStyles
EndIf
2020-03-06 11:04:22 +01:00
If dialog.getControl("removeLinks").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveLinks"),100)
2020-03-06 11:04:22 +01:00
removeHyperlinks
EndIf
2020-09-24 10:40:52 +02:00
If dialog.getControl("removeAllFields").state = 1 Then
statusIndicator.Start(getTranslation("statusRemoveAllFields"),100)
removeAllFields
EndIf
2020-03-06 11:04:22 +01:00
If dialog.getControl("removeBookmarks").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveBookmarks"),100)
2020-03-06 14:17:06 +01:00
disposeAllBookmarks
2020-03-06 11:04:22 +01:00
EndIf
If dialog.getControl("configTables").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConfigureTables"),100)
2020-03-06 14:17:06 +01:00
fixTableWidth
2020-03-06 11:04:22 +01:00
EndIf
If dialog.getControl("configAnchors").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConfigureImagesAnchors"),100)
2020-03-06 11:04:22 +01:00
fixDrawingAnchors
EndIf
If dialog.getControl("fixMistakes").state = 1 Then
2020-12-14 12:39:13 +01:00
saveAndreload()
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusFixFrequentMistakes"),100)
2020-03-06 11:04:22 +01:00
fixFrequentMistakes
EndIf
2020-12-09 12:00:05 +01:00
If dialog.getControl("fixDOI").state = 1 Then
statusIndicator.Start(getTranslation("statusFixingDOI"),100)
2021-02-01 11:35:27 +01:00
openTrackChanges = true
2020-12-09 12:00:05 +01:00
fixDOI
EndIf
2021-02-01 10:30:08 +01:00
If dialog.getControl("replaceNumHyphen").state = 1 Then
statusIndicator.Start(getTranslation("replaceNumHyphenStatus"),100)
2021-02-01 11:35:27 +01:00
openTrackChanges = true
2021-02-01 10:30:08 +01:00
replaceNumHyphen
EndIf
2020-03-06 11:04:22 +01:00
If dialog.getControl("removeInitPageBreak").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemovePageBreakAtStart"),100)
2020-03-06 11:04:22 +01:00
removeFirstElementPageBreak
EndIf
If dialog.getControl("removePageStyles").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveCustomPageStyles"),100)
2020-03-06 11:04:22 +01:00
removeUserPageStyles
EndIf
If dialog.getControl("loadStandardStyles").state = 1 Then
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusLoadingStylesFromTemplate"),100)
2020-03-06 11:04:22 +01:00
loadArticleStyles
EndIf
2020-03-06 14:50:48 +01:00
If dialog.getControl("removeManualPageBreaks").state = 1 Then
removeManualPageBreaks
EndIf
2020-04-14 13:40:29 +02:00
If dialog.getControl("removeBasic").state = 1 Then
removeLibs
EndIf
2021-01-12 01:07:00 +01:00
If dialog.getControl("resetChapterNumberingRules").state = 1 Then
resetChapterNumberingRules
EndIf
2021-04-30 14:13:32 +02:00
If dialog.getControl("convertFontsToCharStyles").state = 1 Then
convertFontsToCharStyles()
EndIf
2020-03-06 14:50:48 +01:00
2020-03-06 11:04:22 +01:00
statusIndicator.end()
saveAndreload()
2020-05-04 14:28:39 +02:00
MsgBox getTranslation("cleaningFinished")
2021-02-01 11:35:27 +01:00
If openTrackChanges Then
showTrackedChanges
Endif
2020-03-06 11:04:22 +01:00
2020-03-05 20:55:14 +01:00
End Sub
2020-04-14 13:40:29 +02:00
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
2020-03-05 20:23:54 +01:00
Private Sub quietCleaning
2019-10-16 15:42:48 +03:00
Dim description As String
2020-03-21 12:37:32 +01:00
Dim statusIndicator As Object
2021-01-15 20:03:04 +01:00
DocumentLoaded = false
2019-10-16 22:38:09 +03:00
saveDocument
2020-06-18 15:26:48 +02:00
saveAsDocAndBackToODT
2020-12-14 12:39:13 +01:00
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusStarted"),100)
2019-10-16 22:38:09 +03:00
doNotTrack
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusReplaceFontsInStyles"),100)
2020-01-31 14:35:45 +01:00
replaceStyleFonts
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConvertSymbolsInTargetFonts"),100)
2020-12-14 18:26:35 +01:00
saveAndreload()
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-02-04 11:23:35 +01:00
unicodeSymbolsConversion
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusCleaningManualFormatting"),100)
2019-10-16 22:38:09 +03:00
cleanFormatting
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusReplaceWhiteBackground"),100)
replaceWhiteBackgroundWithTransparent
statusIndicator.Start(getTranslation("statusRemovedUnusedStyles"),100)
2020-03-06 14:17:06 +01:00
removeUnusedStyles
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveLinks"),100)
2019-11-21 14:11:59 +03:00
removeHyperlinks
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveBookmarks"),100)
2019-10-16 23:13:24 +03:00
disposeAllBookmarks
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConfigureTables"),100)
2019-10-17 00:11:21 +03:00
fixTableWidth
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusConfigureImagesAnchors"),100)
2019-10-17 00:11:21 +03:00
fixDrawingAnchors
2020-12-14 12:39:13 +01:00
saveAndreload()
statusIndicator = ThisComponent.getCurrentController.statusIndicator
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusFixFrequentMistakes"),100)
2019-10-17 10:19:50 +03:00
fixFrequentMistakes
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemovePageBreakAtStart"),100)
2019-11-05 15:52:56 +03:00
removeFirstElementPageBreak
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusRemoveCustomPageStyles"),100)
2019-11-05 00:40:28 +03:00
removeUserPageStyles
2020-05-04 15:02:31 +02:00
statusIndicator.Start(getTranslation("statusLoadingStylesFromTemplate"),100)
2019-10-17 00:11:21 +03:00
loadArticleStyles
2020-04-14 13:40:29 +02:00
removeLibs
2021-01-12 01:07:00 +01:00
resetChapterNumberingRules
2020-07-01 18:41:01 +02:00
addTimeStampToProperties
2020-07-12 14:54:28 +02:00
saveCleanedVersion("Standard cleaning")
2019-10-16 15:42:48 +03:00
statusIndicator.end()
saveAndreload()
2020-05-04 14:28:39 +02:00
MsgBox getTranslation("cleaningFinished")
2019-10-16 15:42:48 +03:00
End Sub
2021-01-15 20:03:04 +01:00
'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
2019-11-05 15:52:56 +03:00
Private Sub removeFirstElementPageBreak
2020-03-21 11:55:13 +01:00
Dim enum1 As Object
Dim enum1Element As Object
2019-11-05 15:52:56 +03:00
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
2020-01-31 14:35:45 +01:00
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
2020-03-21 11:55:13 +01:00
Private Sub replaceFontsInStyles(oldFontStart As String,newFontName As String)
2020-01-31 14:35:45 +01:00
Dim propertySetInfo As Object
Dim oPositionOfMatch As Long
2020-03-21 11:55:13 +01:00
Dim oFamilies As Object
Dim sElements As Object
Dim oFamily As Object
Dim oStyle As Object
Dim fontName As String
2020-01-31 14:35:45 +01:00
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
2020-03-21 11:55:13 +01:00
EndIf
2020-01-31 14:35:45 +01:00
If propertySetInfo.hasPropertyByName("CharFontNameAsian") Then
oStyle.CharFontNameAsian = newFontName
2020-03-21 11:55:13 +01:00
EndIf
2020-01-31 14:35:45 +01:00
EndIf
EndIf
Next
Next
End Sub
2019-10-30 16:14:31 +03:00
Private Sub unicodeSymbolsConversion
2020-01-31 14:35:45 +01:00
convertWLLatin2IPHAstra
2020-11-05 09:37:01 +01:00
convertSymbol
2021-04-30 13:55:27 +02:00
Dim sharedMarksRegExp As String
sharedMarksRegExp = "([\u0020-\u002f\u003a\u003b\u00A0\u2010\u2013\u2014]+)?"
2019-10-30 16:14:31 +03:00
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
2020-01-27 09:53:35 +01:00
'Letterlike Symbols 2100—214F
'Extended latin-1 0080—00FF
2019-10-30 16:14:31 +03:00
'Cyrillic unicode block range \u0400-\u04FF
'Basic Latin \u0020-\u007E
'Combining diacritical marks 0301 0304 0323 032e 0331 035f
'General Punctuation \u2000-\u206f
2020-02-08 18:16:31 +01:00
'Latin Extended A \u0100-\u017f
'\u02bb Modifier Letter Turned Comma is in IPH Astra
2020-01-31 14:35:45 +01:00
' unicodeConversionEverywhere("[\u0020-\u007F]+",RAtts)
2020-04-18 13:56:03 +02:00
unicodeConversionEverywhere("[\u0020-\u007f\u0080-\u00ff\u0400-\u04ff\u2000-\u206f\u2100-\u214f\u0301\u0304\u0323\u032e\u0331\u0341\u035f\u02bb\u0100-\u017f]+",RAtts)
2019-10-30 16:14:31 +03:00
'Arabic Scheherazade
2020-02-08 18:16:31 +01:00
'Arabic Presentation Forms-A fb50-fdff
'Arabic Presentation Forms-B fe70-feff
2019-10-30 16:14:31 +03:00
newFontName = "Scheherazade"
RAtts(0).Value = newFontName
RAtts(1).Value = newFontName
RAtts(2).Value = newFontName
2021-04-30 13:55:27 +02:00
unicodeConversionEverywhere(sharedMarksRegExp & "[\u0600-\u06ff\ufb50-\ufdff\ufe70-\ufeff]+" & sharedMarksRegExp ,RAtts)
2019-10-30 16:14:31 +03:00
'Greek Tinos
newFontName = "Tinos"
RAtts(0).Value = newFontName
RAtts(1).Value = newFontName
RAtts(2).Value = newFontName
2020-01-31 14:35:45 +01:00
'Greek and Coptic 0370—03FF
'Greek extended 1F00—1FFF
2021-04-30 13:55:27 +02:00
unicodeConversionEverywhere(sharedMarksRegExp & "[\u0370-\u03ff\u1f00-\u1fff]+" & sharedMarksRegExp,RAtts)
2020-01-31 14:35:45 +01:00
2019-10-30 16:14:31 +03:00
'DejaVu Sans Mathematical operators
newFontName = "DejaVu Sans"
RAtts(0).Value = newFontName
RAtts(1).Value = newFontName
RAtts(2).Value = newFontName
'\u2200-\u22FF Mathematical operators
2021-01-15 14:13:20 +01:00
'\u2630-\u2637 Trigrams
'\u4DC0-\u4DFF Trigrams
unicodeConversionEverywhere("[\u2200-\u22ff\u2630-\u2637\u4DC0-\u4DFF]+",RAtts)
2019-10-30 16:14:31 +03:00
2020-04-18 14:05:45 +02:00
newFontName = "Noto Serif CJK JP"
2020-04-18 13:56:03 +02:00
RAtts(0).Value = newFontName
RAtts(1).Value = newFontName
RAtts(2).Value = newFontName
'\u2200-\u22FF CJK Unified Ideographs
2020-11-05 09:37:01 +01:00
'\u21d2 двойная стрелка вправо
2020-04-18 13:56:03 +02:00
'3000—303F Символы и пунктуация ККЯ
2021-04-30 13:55:27 +02:00
unicodeConversionEverywhere(sharedMarksRegExp & "[\u21d2\u302b\uff00-\uffef]+" & sharedMarksRegExp,RAtts)
2020-04-18 13:56:03 +02:00
2020-04-18 14:05:45 +02:00
newFontName = "Noto Serif CJK SC"
2020-04-18 13:56:03 +02:00
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 В
2021-04-30 13:55:27 +02:00
unicodeConversionEverywhere(sharedMarksRegExp & "[\u3000-\u302a\u302c-\u303f\u3400-\u4db7\u4e00-\u9ff1]+" & sharedMarksRegExp,RAtts)
2020-04-18 13:56:03 +02:00
2019-10-30 16:14:31 +03:00
End Sub
2020-03-21 11:55:13 +01:00
Private Sub unicodeConversionEverywhere(searchPattern As String,rAtts)
2019-10-30 16:14:31 +03:00
setAttributesBySearchPattern(searchPattern,RAtts)
End Sub
2019-10-29 15:05:22 +03:00
'Replaces manual formatting text with font into character style with assigned font
Private Sub convertFontsToCharStyles
2020-03-21 11:55:13 +01:00
Dim oDoc As Object
Dim SDesc As Object
Dim founds As Object
Dim curFont As String
2019-10-29 15:05:22 +03:00
Dim srch(0) as new com.sun.star.beans.PropertyValue
2020-03-21 11:55:13 +01:00
oDoc = Thiscomponent
2019-10-29 15:05:22 +03:00
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
2019-12-04 21:10:44 +03:00
If IsEmpty(curFont) Then
curFont = "IPH Astra Serif"
EndIf
2019-11-06 12:45:01 +03:00
If curFont <> "IPH Astra Serif" AND curFont <> "" Then
If Not DocHasCharStyle(oDoc,curFont) Then
2020-01-31 14:35:45 +01:00
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
2019-11-06 12:45:01 +03:00
CreateCharacterStyle(curFont, oProps())
End If
founds.CharStyleNames = Array(curFont)
EndIf
2019-10-29 15:05:22 +03:00
founds = Thiscomponent.findNext(founds.getend, SDesc)
loop
End Sub
2019-11-05 00:40:28 +03:00
Private Sub removeUserPageStyles
Dim oStyles As Object
Dim oStyle As Object
Dim count As Long
2020-03-21 11:55:13 +01:00
Dim i As Long
oStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
2019-11-05 00:40:28 +03:00
count = oStyles.count - 1
2020-03-21 11:55:13 +01:00
2019-11-05 00:40:28 +03:00
For i = 0 to count
2020-03-21 12:37:32 +01:00
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
2019-11-05 00:40:28 +03:00
Next i
End Sub
2020-09-24 10:40:52 +02:00
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
2019-10-17 10:19:50 +03:00
Private Sub fixFrequentMistakes
2020-05-18 17:16:20 +02:00
Dim config As Object
config = initRedactionConfiguration()
2019-10-17 10:19:50 +03:00
Dim NBSP As String
Dim space As String
2021-04-30 13:55:27 +02:00
Dim latinPlusCyrillicLettersRegExp As String
latinPlusCyrillicLettersRegExp = "[\u0041-\u005a\u0061-\u007a\u0410-\u044f]"
2019-10-17 10:19:50 +03:00
NBSP = " "
space = " "
'Н е
AskAndReplace("\t","")
'Н е
AskAndReplace("(?<=[:space:])[:space:]+","")
'Н е
AskAndReplace("^[:space:]+","")
'Н е
AskAndReplace("[:space:]+$","")
'Н е
AskAndReplace("^$","")
'Н е
2020-12-15 13:14:28 +01:00
AskAndReplace("[:space:]+(?=[\.,;:?!\)\]\}»¡¿”’])","")
2020-05-18 17:16:20 +02:00
'Н е
2019-10-17 10:19:50 +03:00
AskAndReplace("(?<=[\(\[\{«„])[:space:]","")
2020-05-18 17:16:20 +02:00
'Между буквами среднее тире должно обрамляться пробелами
2021-04-30 13:55:27 +02:00
AskAndReplace("(?<=" & latinPlusCyrillicLettersRegExp & ")– –
2019-10-17 10:19:50 +03:00
'Между буквами дефис-минус, цифровое тире и длинное тире заменяется на среднее тире
2021-04-30 13:55:27 +02:00
AskAndReplace("(?<=" & latinPlusCyrillicLettersRegExp & "[:space:])[-‒—−](?=[:space:]" & latinPlusCyrillicLettersRegExp & ")","–
2020-12-08 13:35:23 +01:00
'Между двумя цифрами и тире не долнжо быть пробелов. А
'Также проверяем, что перед искомым тире нет DOI
2020-12-14 12:39:13 +01:00
'''''AskAndReplace("(?<!DOI[0-9. /XVI:-‒–—−-]{1,50})(?<=[:digit:])(?:[:space:])?[-‒–—−](?:[:space:])?(?=[:digit:])","‒
2019-10-17 10:19:50 +03:00
'Между двумя римскими цифрами и тире между ними не долнжо быть пробелов. А
2020-11-08 15:06:54 +01:00
AskAndReplace("(?<=[MDCLXVI])(?:[:space:])?[-‒–—−](?:[:space:])?(?=[MDCLXVI])","–
2019-10-17 10:19:50 +03:00
'Между буквой и угловой открывающейся скобкой должен быть пробел
2021-04-30 13:55:27 +02:00
AskAndReplace("(?<=" & latinPlusCyrillicLettersRegExp & ")<(?=…>)",space & "<")
2019-10-17 10:19:50 +03:00
'Между угловой закрывающейся скобкой и буквой должен быть пробел
2021-04-30 13:55:27 +02:00
AskAndReplace("(?<=<…)>(?=" & latinPlusCyrillicLettersRegExp & ")",">" & space)
2020-05-18 17:16:20 +02:00
If config.getPropertyValue("fixes_russian_iph") = "true" Then
'между N. Y. не должно быть пробела
AskAndReplace("(?<=N\.)[:space:](?=Y\.)","")
'Между словом том и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[тТ](ом|\.))\ (?=[:digit:])",NBSP)
'Между словом серия и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[с С
'Между словом часть и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[чЧ](асть|\.))\ +(?=[:digit:])",NBSP)
'Между числом и "г а
AskAndReplace("(?<=[0-9])[:space:]*г г
'Между инициалами и Фамилией должен быть неразрывный пробел, а
'А б А А б А
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
2019-10-17 10:19:50 +03:00
End Sub
2020-11-08 15:06:54 +01:00
2019-10-17 00:11:21 +03:00
Private Sub loadArticleStyles
2020-03-21 11:55:13 +01:00
Dim dispatcher As Object
Dim filePath As String
Dim fileTest As Object
Dim fileName As String
Dim aArgs(0) As New com.sun.star.beans.PropertyValue
2020-04-23 14:15:18 +02:00
Dim config As Object
config = initRedactionConfiguration()
fileName = config.getPropertyValue("defaultTemplate")
2020-03-21 11:55:13 +01:00
filePath = getTemplatePath() & "/" & fileName
fileTest = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
If NOT fileTest.exists(filePath) Then
2020-04-23 14:15:18 +02:00
noStylesFileDialog()
fileName = config.getPropertyValue("defaultTemplate")
filePath = getTemplatePath() & "/" & fileName
If NOT fileTest.exists(filePath) Then
'MsgBox "Файл стилей " & fileName & " не добавлен в Мои шаблоны. Н е
Exit Sub
EndIf
2020-03-21 11:55:13 +01:00
EndIf
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
2019-10-17 00:11:21 +03:00
aArgs(0).Name = "OverwriteStyles"
aArgs(0).Value = True
ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() )
End Sub
2020-03-21 11:55:13 +01:00
Private Sub CreateCharacterStyle(sStyleName As String, oProps())
Dim i As Integer
Dim oFamilies As Object
Dim oStyle As Object
Dim oStyles As Object
2019-10-17 00:36:33 +03:00
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
2019-10-17 00:31:08 +03:00
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
2020-03-21 11:55:13 +01:00
Private Sub AskAndReplace(SearchString As String, oReplaceString As String)
2019-10-17 00:11:21 +03:00
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
2019-10-17 00:31:08 +03:00
Private Function DocHasCharStyle(oDoc, sName$) As Boolean
2020-03-21 11:55:13 +01:00
Dim oStyles As Object
2019-10-17 00:31:08 +03:00
oStyles = oDoc.StyleFamilies.getByName("CharacterStyles")
DocHasCharStyle() = oStyles.hasByName(sName)
End Function
2019-10-17 00:11:21 +03:00
Private Function getTemplatePath() as String
2020-03-21 12:37:32 +01:00
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
2019-10-17 00:11:21 +03:00
End Function
2019-11-21 14:11:59 +03:00
Private Sub removeHyperlinks()
Dim aNote As Object
2020-07-03 16:48:29 +02:00
Dim x As Long
2019-11-21 14:11:59 +03:00
removeHLInText(ThisComponent.Text)
2020-07-03 16:48:29 +02:00
For x = 0 to ThisComponent.FootNotes.Count -1
2019-11-21 14:11:59 +03:00
aNote = ThisComponent.FootNotes.getByIndex(x)
removeHLInText(aNote.Text)
Next
2020-07-03 16:48:29 +02:00
For x = 0 to ThisComponent.EndNotes.Count -1
2019-11-21 14:11:59 +03:00
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
2020-03-21 12:19:15 +01:00
Dim cellNames()
Dim cellText As Object
2019-11-21 14:11:59 +03:00
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
2019-10-16 23:13:24 +03:00
End Sub
2019-11-21 14:11:59 +03:00
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
2019-10-16 23:13:24 +03:00
Private Sub disposeAllBookmarks()
Dim bookmarks As Object
Dim elementName As String
elementName = ThisComponent.Links.ElementNames(6)
bookmarks = ThisComponent.Links.getByName(elementName)
While bookmarks.hasElements()
2020-03-21 11:55:13 +01:00
bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
bookmark.dispose()
2019-10-16 23:13:24 +03:00
Wend
End Sub
2020-03-06 14:50:48 +01:00
Private Sub removeManualPageBreaks
2020-03-21 11:55:13 +01:00
Dim oTextCursor As Object
Dim enum1 As Object
Dim enum1Element As Object
2019-10-16 23:13:24 +03:00
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
2019-10-30 16:14:31 +03:00
Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optional SrchAttributes)
2019-10-30 16:47:57 +03:00
doNotTrack
2019-10-30 16:14:31 +03:00
dim stringValue1 As String
dim stringValue2 As String
2020-03-21 11:55:13 +01:00
Dim oSearch As Object
2019-10-16 23:13:24 +03:00
Dim oTextCursor As Object
Dim oViewCursor As Object
2019-10-30 16:14:31 +03:00
Dim replace As Boolean
2020-01-31 14:35:45 +01:00
Dim attrName As string
Dim attrValue As String
2020-03-21 11:55:13 +01:00
Dim oFound As Object
Dim i As Long
Dim j As Long
2019-10-16 23:13:24 +03:00
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oSearch = ThisComponent.createSearchDescriptor()
oSearch.SearchString = searchPattern
2020-01-31 14:35:45 +01:00
' Mri oSearch
2019-10-16 23:13:24 +03:00
oSearch.SearchRegularExpression=True
oSearch.SearchAll = True
2019-10-30 16:14:31 +03:00
If Not IsMissing (SrchAttributes) Then
If Not IsEmpty(SrchAttributes(0).Value) Then
2020-01-31 14:35:45 +01:00
oSearch.searchStyles = true
2019-10-30 16:14:31 +03:00
oSearch.SetSearchAttributes(SrchAttributes())
End If
EndIf
2019-10-16 23:13:24 +03:00
oFound = ThisComponent.findFirst(oSearch)
Do While Not IsNull(oFound)
2019-10-30 16:14:31 +03:00
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
2019-10-29 16:17:08 +03:00
replace = replace AND False
EndIf
2019-10-30 16:14:31 +03:00
Next j
EndIf
2019-10-29 16:17:08 +03:00
If replace then
For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
2020-02-08 18:16:31 +01:00
'If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
2020-02-04 11:23:35 +01:00
oFound.SetPropertyValue(ReplAttributes(i).Name, ReplAttributes(i).Value)
2020-02-08 18:16:31 +01:00
'EndIf
2019-10-29 16:17:08 +03:00
Next i
EndIf
oFound = ThisComponent.findNext(oFound.End, oSearch)
2019-10-16 23:13:24 +03:00
Loop
End Sub
2019-10-16 22:38:09 +03:00
Private Sub saveAndreload()
2020-03-21 11:55:13 +01:00
Dim document As Object
Dim dispatcher As Object
2021-01-15 20:03:04 +01:00
'Dim timeOut As Long
'timeOut = 0
'DocumentLoaded = false
2019-10-16 22:38:09 +03:00
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
2020-11-05 09:37:01 +01:00
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())
2021-01-15 20:03:04 +01:00
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
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub saveDocument()
2020-03-21 11:55:13 +01:00
Dim document As Object
Dim dispatcher As Object
2019-10-16 22:38:09 +03:00
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
end Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub cleanFormatting
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
'Н е
AskAndReplace("\t","")
'Н е
AskAndReplace("(?<=[:space:])[:space:]+","")
'Н е
AskAndReplace("^[:space:]+","")
'Н е
AskAndReplace("^$","")
2019-10-16 15:42:48 +03:00
2020-04-03 12:09:34 +02:00
convertFormattingToUserFields
2019-10-16 22:38:09 +03:00
2020-03-21 11:55:13 +01:00
convertFontsToCharStyles()
2019-12-04 21:59:12 +03:00
2020-03-21 11:55:13 +01:00
replaceBaseWithStandard()
2019-10-16 22:38:09 +03:00
2020-04-03 12:39:54 +02:00
resetFootnotesStyle
2020-03-21 11:55:13 +01:00
removeDirectFormatting()
2019-10-16 22:38:09 +03:00
2020-04-17 20:35:40 +02:00
saveAndreload()
2020-04-03 12:09:34 +02:00
convertUserFieldsToFormatting
2020-03-13 09:12:47 +01:00
2019-10-16 15:42:48 +03:00
End Sub
2019-10-17 00:11:21 +03:00
Private Sub fixTableWidth()
2019-10-16 23:33:42 +03:00
Dim table As Object
Dim tables As Object
Dim count As Long
2020-03-21 11:55:13 +01:00
Dim i As Long
2020-03-21 12:19:15 +01:00
tables = ThisComponent.TextTables
2019-10-16 23:33:42 +03:00
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
2019-10-17 00:11:21 +03:00
Private Sub fixDrawingAnchors()
Dim drawing As Object
Dim drawings As Object
drawings = ThisComponent.DrawPage
Dim count As Long
2020-03-21 11:55:13 +01:00
Dim i As Long
2019-10-17 00:11:21 +03:00
count = drawings.getCount()
For i = 0 To count - 1
drawing = drawings.getByIndex(i)
If drawing.AnchorType= com.sun.star.text.TextContentAnchorType.AT_PAGE Then
2020-03-21 12:19:15 +01:00
drawing.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
2019-10-17 00:11:21 +03:00
EndIf
Next
End Sub
2019-10-16 22:38:09 +03:00
Private Sub replaceBaseWithStandard
2019-10-16 22:42:02 +03:00
replaceParaStyle("Базовый","Основной текст")
replaceParaStyle("Default Style","Text Body")
2020-03-24 15:04:42 +01:00
resetSearchSettings()
2019-10-16 22:42:02 +03:00
End Sub
Private Sub replaceParaStyle(oldStyleName,newStyleName)
2020-03-21 12:19:15 +01:00
Dim document as Object
Dim dispatcher as object
2019-10-16 22:38:09 +03:00
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
2020-03-21 12:19:15 +01:00
Dim args1(21) as new com.sun.star.beans.PropertyValue
2019-10-16 22:38:09 +03:00
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"
2019-10-16 22:42:02 +03:00
args1(11).Value = oldStyleName
2019-10-16 22:38:09 +03:00
args1(12).Name = "SearchItem.ReplaceString"
2019-10-16 22:42:02 +03:00
args1(12).Value = newStyleName
2019-10-16 22:38:09 +03:00
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())
2019-10-16 15:42:48 +03:00
End Sub
2020-03-24 15:04:42 +01:00
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
2019-10-16 22:38:09 +03:00
Private Sub doNotTrack
2020-03-21 12:19:15 +01:00
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
2019-10-16 22:38:09 +03:00
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())
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub removeDirectFormatting
2020-03-21 12:19:15 +01:00
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
2020-03-24 15:04:42 +01:00
Dim footNotes As Object
2019-10-16 22:38:09 +03:00
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
document = ThisComponent.CurrentController.Frame
oViewCursor = ThisComponent.CurrentController.getViewCursor()
2019-10-17 00:11:21 +03:00
oViewCursor.jumpToFirstPage()
2019-10-16 22:38:09 +03:00
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)
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub resetFootnotesStyle
2020-03-21 12:19:15 +01:00
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
2019-10-16 22:38:09 +03:00
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
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub removeUnusedStyles
2020-03-21 12:19:15 +01:00
Dim sElements() as String
Dim oFamilies As Object
Dim oFamily As Object
Dim i As Integer
2019-10-16 22:38:09 +03:00
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
2019-10-16 15:42:48 +03:00
End Sub
2020-03-21 12:19:15 +01:00
Private Sub removeUnusedStyle(oFamily ,sFamily as string, bAsk as Boolean)
Dim i As Integer
Dim sUsed() as String
2019-10-16 22:38:09 +03:00
sUsed() = getStyleNames(oFamily,bLocalized:=True,bUsed:=False,bUserDef:=true)
If uBound(sUsed()) > -1 then
2020-03-21 12:19:15 +01:00
For i = 0 to uBound(sUsed())
oFamily.removeByName(sUsed(i))
Next
2019-10-16 22:38:09 +03:00
EndIf
End Sub
2019-10-16 15:42:48 +03:00
2020-03-21 12:19:15 +01:00
Private Sub convertFormatToEnclosure(identifier As String, styleNames, styleValues)
Dim leftEnclosure As String
Dim rightEnclosure As String
2019-10-16 22:38:09 +03:00
Dim oTextCursor As Object
Dim startTextRange As Object
Dim endTextRange As Object
Dim foundString As String
2020-03-21 12:19:15 +01:00
Dim SDesc As Object
2019-10-16 22:38:09 +03:00
Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
2020-03-21 12:19:15 +01:00
Dim i As Integer
Dim found As Object
leftEnclosure = compileLeftEnclosure(identifier)
rightEnclosure = compileRightEnclosure(identifier)
2019-10-16 22:38:09 +03:00
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
2019-10-16 15:42:48 +03:00
End Sub
2020-03-21 12:19:15 +01:00
Private Sub convertEnclosuresToFormat(identifier As String, styleNames, styleValues)
2019-10-16 22:38:09 +03:00
Dim oTextCursor As Object
Dim startTextRange As Object
Dim endTextRange As Object
Dim leftEnclosure As String
Dim rightEnclosure As String
2020-03-21 12:19:15 +01:00
Dim SDesc As Object
Dim found As Object
2020-07-02 15:40:01 +02:00
2019-10-16 22:38:09 +03:00
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
2019-10-16 15:42:48 +03:00
End Sub
2020-03-21 12:19:15 +01:00
Private Function compileSearchString(identifier) As String
compileSearchString = "<" & identifier & ">" & "(.*?)" & "</" & identifier & ">"
2019-10-16 22:38:09 +03:00
End Function
2019-10-16 15:42:48 +03:00
2020-03-21 12:19:15 +01:00
Private Function compileLeftEnclosure(identifier) As String
compileLeftEnclosure = "<" & identifier & ">"
2019-10-16 15:42:48 +03:00
End Function
2020-03-21 12:19:15 +01:00
Private Function compileRightEnclosure(identifier) As String
compileRightEnclosure = "</" & identifier & ">"
2019-10-16 22:38:09 +03:00
End Function
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextBold
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharWeight")
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
convertFormatToEnclosure(CHR(867), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextBold
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharWeight")
styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
convertEnclosuresToFormat(CHR(867), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextItalic
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharPosture")
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
convertFormatToEnclosure(CHR(868), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextItalic
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharPosture")
styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
convertEnclosuresToFormat(CHR(868), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextStrikeout
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharStrikeout")
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
convertFormatToEnclosure(CHR(869), styleNames, styleValues)
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextStrikeout
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharStrikeout")
styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
convertEnclosuresToFormat(CHR(869), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextUnderline
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharUnderline")
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
convertFormatToEnclosure(CHR(870), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextUnderline
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharUnderline")
styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
convertEnclosuresToFormat(CHR(870), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextSuperscript
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharEscapementHeight","CharEscapement")
2020-02-04 15:33:56 +01:00
styleValues = Array(58,14000)
2019-10-16 22:38:09 +03:00
convertFormatToEnclosure(CHR(871), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextSuperscript
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharEscapementHeight","CharEscapement")
2020-02-04 15:33:56 +01:00
styleValues = Array(58,14000)
2019-10-16 22:38:09 +03:00
convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextSubscript
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharEscapementHeight","CharEscapement")
2020-02-04 15:33:56 +01:00
styleValues = Array(58,-14000)
2019-10-16 22:38:09 +03:00
convertFormatToEnclosure(CHR(872), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextSubscript
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharEscapementHeight","CharEscapement")
2020-02-04 15:33:56 +01:00
styleValues = Array(58,-14000)
2019-10-16 22:38:09 +03:00
convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
End Sub
2019-10-16 15:42:48 +03:00
2020-02-04 16:51:57 +01:00
Private Sub toTextSuperscriptOld
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2020-02-04 16:51:57 +01:00
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,101)
convertFormatToEnclosure(CHR(871), styleNames, styleValues)
End Sub
Private Sub fromTextSuperscriptOld
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2020-02-04 16:51:57 +01:00
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,101)
convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
End Sub
Private Sub toTextSubscriptOld
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2020-02-04 16:51:57 +01:00
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,-101)
convertFormatToEnclosure(CHR(872), styleNames, styleValues)
End Sub
Private Sub fromTextSubscriptOld
2020-03-21 12:19:15 +01:00
Dim styleNames As Variant
Dim StyleValues As Variant
2020-02-04 16:51:57 +01:00
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,-101)
convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
End Sub
2019-10-16 22:38:09 +03:00
Private Sub toTextSparce
2020-03-21 12:19:15 +01:00
Dim i As Integer
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharKerning")
For i=70 To 70
styleValues = Array(i)
convertFormatToEnclosure(CHR(873) & i, styleNames, styleValues)
Next
End Sub
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub fromTextSparce
2020-03-21 12:19:15 +01:00
Dim i As Integer
Dim styleNames As Variant
Dim StyleValues As Variant
2019-10-16 22:38:09 +03:00
styleNames = Array("CharKerning")
For i=70 To 70
styleValues = Array(i)
convertEnclosuresToFormat(CHR(873) & i, styleNames, styleValues)
Next
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
2020-03-21 12:19:15 +01:00
Private Function confirm(description) As Boolean
2019-10-16 22:38:09 +03:00
If MsgBox (description, 4) =6 Then
confirm = true
Else
confirm = false
2019-10-16 15:42:48 +03:00
EndIf
2019-10-16 22:38:09 +03:00
End Function
2020-03-21 12:19:15 +01:00
Private Sub ReplaceFormatting(SearchString As String ,oReplaceString As String ,SrchAttributes,ReplAttributes, searchStyles)
Dim oReplace As Object
2019-10-16 22:38:09 +03:00
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
2020-03-21 12:19:15 +01:00
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
2019-10-16 22:38:09 +03:00
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 = "Сведения о б
chkUse = False
Endif
If chkUse AND chkUDef then
bas_Pusharray sNames(),sName
Endif
Next
getStyleNames = sNames()
End Function
2020-03-21 12:19:15 +01:00
Sub bas_PushArray(xArray(),vNextElement)
Dim iUB As Long
Dim iLB As Long
2019-10-16 22:38:09 +03:00
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
2019-10-16 15:42:48 +03:00
End Sub
2020-01-31 14:35:45 +01:00
2020-03-13 10:27:26 +01:00
Private Sub replaceWhiteBackgroundWithTransparent
Dim description As String
Dim searchPattern As String
2020-03-21 12:19:15 +01:00
Dim SrchAttributes(1) as new com.sun.star.beans.PropertyValue
Dim ReplAttributes(1) as new com.sun.star.beans.PropertyValue
Dim statusIndicator As Object
2020-03-13 10:27:26 +01:00
searchPattern = ""
statusIndicator = ThisComponent.getCurrentController.statusIndicator
statusIndicator.Start("Замена белого фона на прозрачный начата",100)
2020-03-21 12:19:15 +01:00
2020-03-13 10:27:26 +01:00
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
2020-01-31 14:35:45 +01:00
2020-11-05 09:37:01 +01:00
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
2020-01-31 14:35:45 +01:00
Private Sub convertWLLatin2IPHAstra
Dim newFontName As String
2020-03-21 12:19:15 +01:00
Dim oSearchString As String
Dim oReplaceString As String
2020-02-04 07:55:33 +01:00
'newFontName = "IPH Astra Serif"
2020-01-31 14:35:45 +01:00
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
SrchAttributes(0).Name = "CharFontName"
2020-02-04 07:55:33 +01:00
'SrchAttributes(0).Value = "WL LatinAllIn1Goth"
2020-01-31 14:35:45 +01:00
ReplAttributes(0).Name = "CharFontName"
2020-02-04 07:55:33 +01:00
'ReplAttributes(0).Value = newFontName
2020-01-31 14:35:45 +01:00
2020-02-04 07:55:33 +01:00
SrchAttributes(0).Value = Empty
ReplAttributes(0).Value = Empty
'Replace macron below
2020-12-14 18:26:35 +01:00
oSearchString = "(.)(\uF0D4)+"
2020-02-04 07:55:33 +01:00
oReplaceString = "$1̱"
'from WL
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
oSearchString = "(.)\u0331"
'from unicode to remove direct formatting
2020-02-04 11:23:35 +01:00
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
2020-01-31 14:35:45 +01:00
2020-02-04 07:55:33 +01:00
'Replace dot below
2020-12-14 18:26:35 +01:00
oSearchString = "(.)(\uF0D6)+"
2020-02-04 07:55:33 +01:00
oReplaceString = "$1̣"
'from WL
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
'from unicode to remove direct formatting
oSearchString = "(.)\u0323"
2020-02-04 11:23:35 +01:00
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
2020-02-04 07:55:33 +01:00
'replace macron
2020-12-14 18:26:35 +01:00
oSearchString = "(.)(\uF0F4)+"
2020-02-04 07:55:33 +01:00
oReplaceString = "$1̄"
'from WL
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
'from unicode to remove direct formatting
oSearchString = "(.)\u0304"
2020-02-04 11:23:35 +01:00
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
2020-12-14 18:26:35 +01:00
'replace space
oSearchString = "\uF020"
oReplaceString = " "
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
'replace comma
oSearchString = "\uF02C"
oReplaceString = ","
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
2020-02-04 07:55:33 +01:00
'replace accent
2020-12-14 18:26:35 +01:00
oSearchString = "(.)(\uF0F1)+"
2020-02-04 07:55:33 +01:00
oReplaceString = "$1́"
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
'from unicode to remove direct formatting
oSearchString = "(.)\u0341"
2020-02-04 11:23:35 +01:00
ReplaceFormatting(oSearchString,oReplaceString,SrchAttributes,ReplAttributes, false)
2020-01-31 14:35:45 +01:00
replaceFontsInStyles( "WL LatinAllIn1Goth", newFontName)
End Sub
2020-02-04 15:33:56 +01:00
2020-03-21 12:19:15 +01:00
Function getVersion As String
2020-02-04 16:51:57 +01:00
GlobalScope.BasicLibraries.LoadLibrary("Tools")
Dim oProduct As Object
oProduct=GetRegistryKeyContent("org.openoffice.Setup/Product")
getVersion=oProduct.getByName("ooSetupVersion")
End Function
2020-02-04 15:33:56 +01:00
2020-11-07 21:20:08 +01:00
Function getFullVersion As String
GlobalScope.BasicLibraries.LoadLibrary("Tools")
Dim oProduct As Object
oProduct=GetRegistryKeyContent("org.openoffice.Setup/Product")
getFullVersion=oProduct.getByName("ooSetupVersionAboutBox")
End Function
2020-04-03 12:09:34 +02:00
Private Sub convertFormatToUserFields(identifier As String, styleNames, styleValues)
2021-01-23 20:36:09 +01:00
Dim maxLength As Integer
maxLength = getMaxLength(identifier)
2020-04-03 12:09:34 +02:00
Dim leftField As String
Dim rightField As String
Dim i As Integer
2020-07-02 15:40:01 +02:00
Dim found As Object
2020-04-03 12:09:34 +02:00
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 = ""
2020-06-25 11:50:45 +02:00
SDesc.searchStyles = true
2020-04-03 12:09:34 +02:00
SDesc.SetSearchAttributes(SrchAttributes)
found = Thiscomponent.findFirst(SDesc)
i = 0
Do While not isNull(found)
2020-07-02 15:40:01 +02:00
If Len(found.String) <> 0 AND NOT IsNull(found.Text) Then
2021-01-23 20:36:09 +01:00
If maxLength < 0 Or Len(found.String) < maxLength Then
2020-04-03 12:09:34 +02:00
insertUserField(found.End,rightField & i,"")
insertUserField(found.start,leftField & i,"")
2020-04-17 20:35:40 +02:00
i = i + 1
2021-01-23 20:36:09 +01:00
EndIf
2020-04-03 12:09:34 +02:00
EndIf
found = Thiscomponent.findNext(found.End, SDesc)
2020-04-17 20:35:40 +02:00
2020-04-03 12:09:34 +02:00
Loop
End Sub
2021-01-23 20:36:09 +01:00
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
2020-04-03 12:09:34 +02:00
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
2020-04-17 20:35:40 +02:00
i=i+1
2020-04-03 12:09:34 +02:00
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
2020-06-18 15:26:48 +02:00
sub saveAsDocAndBackToODT
dim document as object
dim dispatcher as object
Dim path As String
Dim tmpName As String
Dim oldName As String
2021-01-15 20:03:04 +01:00
'Dim timeOut As Long
'timeOut = 0
'DocumentLoaded = false
2020-06-18 15:26:48 +02:00
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())
2021-01-15 20:03:04 +01:00
'RegisterListener (ThisComponent)
'Do while DocumentLoaded = false
' Wait 300
' timeOut = timeOut + 300
' If timeOut > 30000 Then
' MsgBox "Time out"
' Exit sub
' EndIf
'Loop
'DocumentLoaded = false
2020-06-18 15:26:48 +02:00
If FileExists(tmpName) Then
Kill(tmpName)
End If
2020-07-01 18:41:01 +02:00
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()
2020-11-07 21:27:02 +01:00
userProps.addProperty(curTime ,128,"Cleaned by" & getUserName() & " with " & redactionExtensionVersion & " LO " & getFullVersion() )
2020-07-01 18:41:01 +02:00
exceptionHandlerProps:
Resume Next
End Sub
2020-07-12 14:54:28 +02:00
2020-11-07 21:20:08 +01:00
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
2020-07-12 14:54:28 +02:00
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())
2021-01-12 01:07:00 +01:00
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
2021-05-06 16:08:21 +02:00
numRuleProperty.Value = "Standard"
2021-01-12 01:07:00 +01:00
End If
numRulesProps(n) = numRuleProperty
Next n
chapNumRules.replaceByIndex(i,numRulesProps)
Next i
End Sub
2021-02-01 10:30:08 +01:00
Private Sub replaceNumHyphen
StartTracking
replaceNumHyphenRegExp
StopTracking
End Sub
Sub replaceNumHyphenRegExp
AskAndReplace("(?<!DOI[0-9. /XVI:-‒–—−-]{1,50})(?<=[:digit:])(?:[:space:])?[-‒–—−](?:[:space:])?(?=[:digit:])","‒
End sub
2020-04-23 14:15:18 +02:00
</script:module>
