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">
2020-03-11 21:15:31 +01:00
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub mark30
2019-10-30 16:14:31 +03:00
2019-10-29 16:17:08 +03:00
End Sub
Sub cleanButton
2020-03-05 20:23:54 +01:00
Dim config As Object
config = initRedactionConfiguration()
If config.getPropertyValue("complexity") = "user" then
quietCleaning()
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)
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-06 11:04:22 +01:00
Private Sub cleanAccordingTo(dialog)
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
dialog.setVisible(false)
saveDocument
statusIndicator.Start("Чистка документа начата, подождите",100)
doNotTrack
If dialog.getControl("fontsInStyles").state = 1 Then
statusIndicator.Start("Заменяем шрифты в стилях",100)
replaceStyleFonts
EndIf
If dialog.getControl("symbolsConversion").state = 1 Then
statusIndicator.Start("Конвертируем символы в целевые шрифты",100)
unicodeSymbolsConversion
EndIf
If dialog.getControl("cleanFormatting").state = 1 Then
statusIndicator.Start("Чистим ручное форматирование",100)
cleanFormatting
EndIf
2020-03-06 14:17:06 +01:00
If dialog.getControl("removeUnusedStyles").state = 1 Then
removeUnusedStyles
EndIf
2020-03-06 11:04:22 +01:00
If dialog.getControl("removeLinks").state = 1 Then
statusIndicator.Start("Удаляем гиперссылки",100)
removeHyperlinks
EndIf
If dialog.getControl("removeBookmarks").state = 1 Then
2020-03-06 14:17:06 +01:00
statusIndicator.Start("Удаляем закладки",100)
disposeAllBookmarks
2020-03-06 11:04:22 +01:00
EndIf
If dialog.getControl("configTables").state = 1 Then
2020-03-06 14:17:06 +01:00
statusIndicator.Start("Настраиваем таблицы",100)
fixTableWidth
2020-03-06 11:04:22 +01:00
EndIf
If dialog.getControl("configAnchors").state = 1 Then
statusIndicator.Start("Настраиваем привязку изображений",100)
fixDrawingAnchors
EndIf
If dialog.getControl("fixMistakes").state = 1 Then
statusIndicator.Start("Исправляем часто встречающиеся ошибки",100)
fixFrequentMistakes
EndIf
If dialog.getControl("removeInitPageBreak").state = 1 Then
statusIndicator.Start("Удаляем разрыв страницы, если он задан в начале документа",100)
removeFirstElementPageBreak
EndIf
If dialog.getControl("removePageStyles").state = 1 Then
statusIndicator.Start("Удаляем пользовательские стили страниц",100)
removeUserPageStyles
EndIf
If dialog.getControl("loadStandardStyles").state = 1 Then
statusIndicator.Start("Загружаем стили из шаблона",100)
loadArticleStyles
EndIf
2020-03-06 14:50:48 +01:00
If dialog.getControl("removeManualPageBreaks").state = 1 Then
removeManualPageBreaks
EndIf
2020-03-06 11:04:22 +01:00
statusIndicator.end()
saveAndreload()
MsgBox "Чистка завершена."
2020-03-05 20:55:14 +01:00
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
2019-10-16 22:38:09 +03:00
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
description = "Вы уверены, что хотите выполнить чистку документа?"
2019-10-16 15:42:48 +03:00
If NOT confirm(description) Then
Exit Sub
EndIf
2019-10-16 22:38:09 +03:00
saveDocument
2020-02-04 11:23:35 +01:00
statusIndicator.Start("Чистка документа начата, подождите",100)
2019-10-16 22:38:09 +03:00
doNotTrack
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Заменяем шрифты в стилях",100)
2020-01-31 14:35:45 +01:00
replaceStyleFonts
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Конвертируем символы в целевые шрифты",100)
2020-02-04 11:23:35 +01:00
unicodeSymbolsConversion
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Чистим ручное форматирование",100)
2019-10-16 22:38:09 +03:00
cleanFormatting
2020-03-06 14:17:06 +01:00
removeUnusedStyles
2020-02-13 18:37:01 +01:00
statusIndicator.Start("Удаляем гиперссылки",100)
2019-11-21 14:11:59 +03:00
removeHyperlinks
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Удаляем закладки",100)
2019-10-16 23:13:24 +03:00
disposeAllBookmarks
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Настраиваем таблицы",100)
2019-10-17 00:11:21 +03:00
fixTableWidth
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Настраиваем привязку изображений",100)
2019-10-17 00:11:21 +03:00
fixDrawingAnchors
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Исправляем часто встречающиеся ошибки",100)
2019-10-17 10:19:50 +03:00
fixFrequentMistakes
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Удаляем разрыв страницы, если он задан в начале документа",100)
2019-11-05 15:52:56 +03:00
removeFirstElementPageBreak
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Удаляем пользовательские стили страниц",100)
2019-11-05 00:40:28 +03:00
removeUserPageStyles
2020-02-04 13:48:30 +01:00
statusIndicator.Start("Загружаем стили из шаблона",100)
2019-10-17 00:11:21 +03:00
loadArticleStyles
2019-10-16 15:42:48 +03:00
statusIndicator.end()
saveAndreload()
2020-03-05 20:23:54 +01:00
MsgBox "Чистка завершена."
2019-10-16 15:42:48 +03:00
End Sub
2019-11-05 15:52:56 +03:00
Private Sub removeFirstElementPageBreak
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
Private Sub replaceFontsInStyles(oldFontStart,newFontName)
' Substitutes font names starts with oldFont value with newFont value
Dim oDoc as Object
Dim propertySetInfo As Object
Dim oPositionOfMatch As Long
oDoc = ThisComponent
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
2019-10-30 16:14:31 +03:00
Private Sub unicodeSymbolsConversion
2020-01-31 14:35:45 +01:00
convertWLLatin2IPHAstra
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-02-11 11:01:36 +01:00
unicodeConversionEverywhere("[\u2100-\u214f\u0020-\u007f\u0080-\u00ff\u0400-\u04ff\u2000-\u206f\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
2020-02-09 18:46:38 +01:00
unicodeConversionEverywhere("[\u0600-\u06ff\ufb50-\ufdff\ufe70-\ufeff]+",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
2020-02-09 18:46:38 +01:00
unicodeConversionEverywhere("[\u0370-\u03ff\u1f00-\u1fff]+",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
2020-02-08 18:16:31 +01:00
unicodeConversionEverywhere("[\u2200-\u22ff]+",RAtts)
2019-10-30 16:14:31 +03:00
End Sub
Private Sub unicodeConversionEverywhere(searchPattern,rAtts)
'in text
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
Dim oDoc
oDoc = Thiscomponent
Dim srch(0) as new com.sun.star.beans.PropertyValue
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
oStyles = ThisComponent.StyleFamilies.getByName("PageStyles")
Dim count As Long
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
2019-10-17 10:19:50 +03:00
Private Sub fixFrequentMistakes
Dim NBSP As String
Dim space As String
NBSP = " "
space = " "
'Н е
AskAndReplace("\t","")
'Н е
AskAndReplace("(?<=[:space:])[:space:]+","")
'Н е
AskAndReplace("^[:space:]+","")
'Н е
AskAndReplace("[:space:]+$","")
'Н е
AskAndReplace("^$","")
'Н е
AskAndReplace("[:space:]+(?=[\.,;:?!\)\]\}»¡¿”‘’])","")
'Между словом том и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[тТ](ом|\.))\ (?=[:digit:])",NBSP)
'Между словом серия и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[с С
'Между словом часть и цифрой должен быть неразрывный пробел, а
AskAndReplace("(?<=\b[чЧ](асть|\.))\ +(?=[:digit:])",NBSP)
'Между числом и "г а
AskAndReplace("(?<=[0-9])[:space:]*г г
'Между инициалами и Фамилией должен быть неразрывный пробел, а
AskAndReplace("(?<=[:upper:]\.[:space:][:upper:]\.)\ (?=[:upper:][:lower:]+)",NBSP)
'Между Фамилией и инициалами должен быть неразрывный пробел, а
AskAndReplace("(?<=[:upper:][:lower:]{1,30})\ (?=[:upper:]\.[:space:][:upper:]\.)",NBSP)
'Н е
AskAndReplace("(?<=[\(\[\{«„])[:space:]","")
'Между "и" и "т." должен быть неразрывный пробел, а
AskAndReplace("(?<=\bи)\ (?=т\.)",NBSP)
'Между "т." и "е а
AskAndReplace("(?<=\bт)\.\ ?(?=[ендпк]\.)","." & NBSP)
'Между буквами среднее тире должно обрамляться пробелами
AskAndReplace("(?<=[:alpha:])– –
'Между буквами дефис-минус, цифровое тире и длинное тире заменяется на среднее тире
AskAndReplace("(?<=[:alpha:][:space:])[-‒—](?=[:space:][:alpha:])","–
'Между двумя цифрами и тире между ними не долнжо быть пробелов. А
AskAndReplace("(?<=[:digit:])(?:[:space:])?[-‒–—](?:[:space:])?(?=[:digit:])","‒
'Между двумя римскими цифрами и тире между ними не долнжо быть пробелов. А
AskAndReplace("(?<=[MDCLXVI])(?:[:space:])?[-‒–—](?:[:space:])?(?=[MDCLXVI])","–
'Между буквой и угловой открывающейся скобкой должен быть пробел
AskAndReplace("(?<=[:alpha:])<(?=…>)",space & "<")
'Между угловой закрывающейся скобкой и буквой должен быть пробел
AskAndReplace("(?<=<…)>(?=[:alpha:])",">" & space)
2020-02-25 17:29:26 +01:00
AskAndReplace("[ий][\u0306]+","й")
2020-03-05 18:13:14 +01:00
AskAndReplace("[ИЙ][\u0306]+","Й")
AskAndReplace("[её][\u0308]+","ё")
AskAndReplace("[ЕЁ][\u0308]+","Ё")
2019-10-17 10:19:50 +03:00
End Sub
2019-10-17 00:11:21 +03:00
Private Sub loadArticleStyles
Dim dispatcher as object
Dim fileePath As String
Dim fileTest As Object
Dim fileName As String
Dim aArgs(0) As New com.sun.star.beans.PropertyValue
fileName = "Статья.ott"
filePath = getTemplatePath() & "/" & fileName
fileTest = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
If NOT fileTest.exists(filePath) Then
MsgBox "Файл стилей " & fileName & " не добавлен в Мои шаблоны. Н е
Exit Sub
EndIf
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
aArgs(0).Name = "OverwriteStyles"
aArgs(0).Value = True
ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() )
End Sub
2019-10-17 00:36:33 +03:00
Private Sub CreateCharacterStyle(sStyleName$, oProps())
Dim i%
Dim oFamilies
Dim oStyle
Dim oStyles
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
2019-10-17 00:11:21 +03:00
Private Sub AskAndReplace(SearchString, oReplaceString)
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
Dim oStyles
oStyles = oDoc.StyleFamilies.getByName("CharacterStyles")
DocHasCharStyle() = oStyles.hasByName(sName)
End Function
2019-10-17 00:11:21 +03:00
Private Function getTemplatePath() as String
Dim ath 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
2019-11-21 14:11:59 +03:00
Private Sub removeHyperlinks()
2020-02-04 07:55:33 +01:00
2019-11-21 14:11:59 +03:00
Dim aNote As Object
2020-02-04 07:55:33 +01:00
2019-11-21 14:11:59 +03:00
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
2020-02-04 07:55:33 +01:00
2019-11-21 14:11:59 +03:00
End Sub
Private Sub removeHLInText(textElement)
Dim enum1Element As Object
Dim enum1 As Object
Dim i As Integer
Dim cell 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
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()
bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
bookmark.dispose()
Wend
End Sub
2020-03-06 14:50:48 +01:00
Private Sub removeManualPageBreaks
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
2019-10-16 23:13:24 +03:00
Dim oSearch
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
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()
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
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())
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub saveDocument()
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
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())
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
2019-10-16 22:38:09 +03:00
convertFormattingToText
2019-12-04 21:44:26 +03:00
convertFontsToCharStyles
2019-10-16 22:38:09 +03:00
2019-12-04 21:59:12 +03:00
replaceBaseWithStandard
2019-10-16 22:38:09 +03:00
removeDirectFormatting
convertFormattingFromText
resetFootnotesStyle
2020-03-06 14:17:06 +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
tables = ThisComponent.TextTables
Dim count As Long
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
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
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")
End Sub
Private Sub replaceParaStyle(oldStyleName,newStyleName)
2019-10-16 22:38:09 +03:00
dim document as Object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(21) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = true
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 65536
args1(11).Name = "SearchItem.SearchString"
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
2019-10-16 22:38:09 +03:00
Private Sub doNotTrack
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
document = ThisComponent.CurrentController.Frame
dim trackProperties(0) as new com.sun.star.beans.PropertyValue
trackProperties(0).Name = "TrackChanges"
trackProperties(0).Value = false
dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties())
dim args1(0) as new com.sun.star.beans.PropertyValue
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
Dim oDescriptor 'The search descriptor
dim dispatcher as Object
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim document as Object
document = ThisComponent.CurrentController.Frame
Dim oViewCursor As Object 'View cursor
oViewCursor = ThisComponent.CurrentController.getViewCursor()
2020-02-04 11:23:35 +01:00
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
Dim oDescriptor 'The search descriptor
dim dispatcher as Object
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim document as Object
document = ThisComponent.CurrentController.Frame
Dim oViewCursor As Object 'View cursor
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
'calls: RemoveUnusedStyles
Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
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
2019-10-16 22:38:09 +03:00
Private Sub removeUnusedStyle(oFamily,sFamily as string, bAsk as Boolean)
'calls: getStyleNames
Dim sUsed() as String, sMsg$,iAnswer%, bStop as boolean
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
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub convertFormatToEnclosure(identifier, styleNames, styleValues)
leftEnclosure = compileLeftEnclosure(identifier)
rightEnclosure = compileRightEnclosure(identifier)
Dim oTextCursor As Object
Dim startTextRange As Object
Dim endTextRange As Object
Dim foundString As String
Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
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
2019-10-16 22:38:09 +03:00
Private Sub convertEnclosuresToFormat(identifier, styleNames, styleValues)
Dim oTextCursor As Object
Dim startTextRange As Object
Dim endTextRange As Object
Dim leftEnclosure As String
Dim rightEnclosure As String
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
2019-10-16 22:38:09 +03:00
Private Function compileSearchString(identifier)
compileSearchString = "<"+identifier+">"+"(.*?)"+"</"+identifier+">"
End Function
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Function compileLeftEnclosure(identifier)
compileLeftEnclosure = "<"+identifier+">"
2019-10-16 15:42:48 +03:00
End Function
2019-10-16 22:38:09 +03:00
Private Function compileRightEnclosure(identifier)
compileRightEnclosure = "</"+identifier+">"
End Function
2019-10-16 15:42:48 +03:00
2019-10-16 22:38:09 +03:00
Private Sub toTextBold
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
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
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
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
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
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
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
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
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
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
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
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
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,101)
convertFormatToEnclosure(CHR(871), styleNames, styleValues)
End Sub
Private Sub fromTextSuperscriptOld
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,101)
convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
End Sub
Private Sub toTextSubscriptOld
styleNames = Array("CharEscapementHeight","CharEscapement")
styleValues = Array(58,-101)
convertFormatToEnclosure(CHR(872), styleNames, styleValues)
End Sub
Private Sub fromTextSubscriptOld
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
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
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
Private Sub convertFormattingToText
2020-02-04 16:51:57 +01:00
Dim version As String
Dim smallNum As String
Dim bigNum As String
version = Trim(getVersion())
bigNum = Left(version, 1)
smallNum = Right(version, 1)
2019-10-16 22:38:09 +03:00
toTextBold
toTextItalic
toTextStrikeout
toTextUnderline
2020-02-04 16:51:57 +01:00
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
toTextSuperscriptOld
toTextSubscriptOld
Else
toTextSuperscript
toTextSubscript
EndIf
2019-10-16 22:38:09 +03:00
toTextSparce
2019-10-16 15:42:48 +03:00
End Sub
2019-10-16 22:38:09 +03:00
Private Sub convertFormattingFromText
2020-02-04 16:51:57 +01:00
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)
2019-10-16 22:38:09 +03:00
fromTextSparce
2020-02-04 16:51:57 +01:00
If CInt(bigNum) < 6 OR (CInt(bigNum) = 6 AND CInt(smallNum < 3) ) Then
fromTextSuperscriptOld
fromTextSubscriptOld
Else
fromTextSuperscript
fromTextSubscript
EndIf
2019-10-16 22:38:09 +03:00
fromTextUnderline
fromTextStrikeout
fromTextItalic
fromTextBold
End Sub
Private Function confirm(description)
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
Private Sub ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, searchStyles)
Dim oReplace
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,i%,sNames$(),sName$,chkUse as Boolean, 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 = "Сведения о б
chkUse = False
Endif
If chkUse AND chkUDef then
bas_Pusharray sNames(),sName
Endif
Next
getStyleNames = sNames()
End Function
'very simple routine appending some element to an array which can be undimensioned (LBound > UBound)
Sub bas_PushArray(xArray(),vNextElement)
Dim iUB%,iLB%
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
Private Sub convertWLLatin2IPHAstra
Dim newFontName 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
oSearchString = "(.)\uF0D4"
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
oSearchString = "(.)\uF0D6"
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
oSearchString = "(.)\uF0F4"
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-01-31 14:35:45 +01:00
2020-02-04 07:55:33 +01:00
'replace accent
oSearchString = "(.)\uF0F1"
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-02-04 16:51:57 +01:00
Function getVersion
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-02-25 17:29:26 +01:00
</script:module>
