diff --git a/Redaction/Clean.xba b/Redaction/Clean.xba index 5a5e3ee..ff95c4a 100644 --- a/Redaction/Clean.xba +++ b/Redaction/Clean.xba @@ -1,6 +1,6 @@ -Sub mark36 +Sub mark37 End Sub @@ -624,7 +624,7 @@ Private Sub cleanFormatting 'Не должно быть пустых абзацев AskAndReplace("^$","") - convertFormattingToText() + convertFormattingToUserFields convertFontsToCharStyles() @@ -632,7 +632,7 @@ Private Sub cleanFormatting removeDirectFormatting() - convertFormattingFromText() + convertUserFieldsToFormatting End Sub @@ -1128,48 +1128,7 @@ Private Sub fromTextSparce 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 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 Function confirm(description) As Boolean If MsgBox (description, 4) =6 Then @@ -1328,4 +1287,355 @@ Function getVersion As String getVersion=oProduct.getByName("ooSetupVersion") End Function + + +Private Sub convertFormatToUserFields(identifier As String, styleNames, styleValues) + Dim leftField As String + Dim rightField As String + Dim i As Integer + leftField = "left" & identifier + rightField = "right" & identifier + Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue + For i = Lbound(styleNames) To Ubound(styleNames) + SrchAttributes(i).Name = styleNames(i) + Next i + For i = Lbound(styleValues) To Ubound(styleValues) + SrchAttributes(i).Value = styleValues(i) + Next i + SDesc = Thiscomponent.createSearchDescriptor() + SDesc.SearchAll = true + SDesc.SearchRegularExpression = true + SDesc.SearchString = "" + SDesc.searchStyles = false + SDesc.SetSearchAttributes(SrchAttributes) + found = Thiscomponent.findFirst(SDesc) + i = 0 + Do While not isNull(found) + If Len(found.String) <> 0 Then + insertUserField(found.End,rightField & i,"") + insertUserField(found.start,leftField & i,"") + EndIf + found = Thiscomponent.findNext(found.End, SDesc) + i = i + 1 + Loop +End Sub + +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 + 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() + i=i+1 + 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 \ No newline at end of file diff --git a/description.xml b/description.xml index 219c862..c3e487a 100644 --- a/description.xml +++ b/description.xml @@ -3,7 +3,7 @@ xmlns:dep="http://openoffice.org/extensions/description/2006" xmlns:xlink="http://www.w3.org/1999/xlink"> - + Cleaning and validation documents for publishing in html and epub with pagination