PK dRC
CineWriterA4/PK
RC 1( ( CineWriterA4/Enc.xdl
PK
RC6a CineWriterA4/script.xlb
PK
RCL͝ CineWriterA4/dialog.xlb
PK
RCfF CineWriterA4/DocEvents.xba
Global oDocView As Object
Global oKeyHandler As Object
Public bKeyHandlers As Boolean
'Sub RunOnLoad
' If Right(ThisComponent.getUrl, 4) = ".doc" Then print "467457"
'End Sub
Sub RunKeyHandler
If BasicLibraries.hasByName("CineWriterA4") AND ThisComponent.DocumentProperties.TemplateName = "CW_A4" Then
RegisterKeyHandler
bKeyHandlers = True
End If
End Sub
Sub DocFileRepair
Dim oTC As Object
oTC = ThisComponent.Text.createTextCursor()
If NOT bKeyHandlers Then RunKeyHandler
Do
oTC.gotoEndOfParagraph(True)
' восстановление структуры для навигатора
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" AND oTC.OutlineLevel <> 1 Then oTC.OutlineLevel = 1
Loop While oTC.gotoNextParagraph(False)
End Sub
Sub RegisterKeyHandler
oDocView = ThisComponent.getCurrentController
oKeyHandler = createUnoListener("CineWriter_", "com.sun.star.awt.XKeyHandler")
oDocView.addKeyHandler(oKeyHandler)
End Sub
Sub UnregisterKeyHandler
oDocView.removeKeyHandler(oKeyHandler)
End Sub
Sub CineWriter_disposing(oEvt)
End Sub
Function CineWriter_KeyPressed(oEvt) As Boolean
Dim oText As Object
Dim oVC As Object, oTC As Object
Dim bTab As Boolean
oVC = oDocView.getViewCursor()
oText = oVC.getText()
oTC = oText.createTextCursorByRange(oVC.getEnd())
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" AND oEvt.KeyCode = 1280 Then ' RETURN - 1280
oTC.gotoStartOfParagraph(False)
oTC.gotoEndOfParagraph(True)
If oTC.OutlineLevel <> 1 Then oTC.OutlineLevel = 1
oTC.String = UCase(oTC.String)
oTC.gotoEndOfParagraph(False)
oText.insertControlCharacter(oTC.getEnd(),0, False) ' пустой абзац после, если нужен
oTC.OutlineLevel = 0
End If
If oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" AND Asc(oEvt.KeyChar) <> 0 Then
oTC.gotoStartOfParagraph(True)
If Len(oTC.String) = 4 Then
sInt = UCase(Mid(oTC.String, 1, 4))
If sInt = "ИНТ." OR sInt = "НАТ." OR sInt = "INT." OR sInt = "EXT." Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
If NOT oTC.isCollapsed() Then ' пустой абзац перед, если нужен
oTC.gotoNextParagraph(False)
oText.insertControlCharacter(oTC.getEnd(),0, False)
Else
oTC.gotoNextParagraph(False)
End If
oTC.gotoEndOfParagraph(True)
oTC.String = sInt
oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ"
End If
End If
End If
If oTC.ParaStyleName = "РЕМАРКА" AND oEvt.KeyCode = 1280 Then ' RETURN - 1280
oTC.gotoEndOfParagraph(False)
oVC.gotoRange(oTC, False)
End If
If oTC.ParaStyleName = "ИМЯ ГЕРОЯ" Then
If oTC.isStartOfParagraph() AND oEvt.KeyCode = 1283 Then ' BACKSPACE = 1283
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
Else
CineWriter_KeyPressed = False
End If
End If
If oTC.ParaStyleName = "РЕПЛИКА ГЕРОЯ" Then
If oEvt.KeyChar = "(" Then
If NOT oTC.isStartOfParagraph Then oText.insertControlCharacter(oTC.getEnd(),0, False)
oTC.ParaStyleName = "РЕМАРКА"
ElseIf oEvt.KeyCode = 1280 Then
oText.insertControlCharacter(oTC.getEnd(),0, False)
Else
CineWriter_KeyPressed = False
End If
End If
If oTC.ParaStyleName = "РЕМАРКА" Then
If oEvt.KeyCode = 1280 Then
oTC.gotoStartOfParagraph(False)
oTC.gotoEndOfParagraph(True)
If Left(oTC.String,1) <> "(" Then
oTC.gotoStartOfParagraph(False)
oText.insertString(oTC.getEnd(), "(", False)
oTC.gotoStartOfParagraph(False)
oTC.gotoEndOfParagraph(True)
End If
If Right(oTC.String,1) <> ")" Then
oTC.gotoEndOfParagraph(False)
oText.insertString(oTC.getEnd(), ")", False)
End If
oTC.gotoEndOfParagraph(False)
'oText.insertControlCharacter(oTC.getEnd(),0, False)
'oVC.gotoRange(oTC, False)
Else
CineWriter_KeyPressed = False
End If
End If
If oEvt.KeyCode = 1282 Then ' TAB - 1282
If oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" AND oTC.isStartOfParagraph Then
CineWriter_KeyPressed = True
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
If NOT oTC.isCollapsed() Then ' пустой абзац перед именем, если нужен
oTC.gotoNextParagraph(False)
oText.insertControlCharacter(oTC.getEnd(),0, False)
Else
oTC.gotoNextParagraph(False)
End If
oTC.ParaStyleName = "ИМЯ ГЕРОЯ"
End If
Else
CineWriter_KeyPressed = False
End If
End Function
Function CineWriter_KeyReleased(oEvt) As Boolean
CineWriter_KeyReleased = False
End Function
'==============================================================================
' KeyHandlers(oDoc As Object) НАЗНАЧЕНИЕ ОБРАБОТЧИКОВ И ЗАПИСЬ В ONLOAD
'==============================================================================
Sub KeyHandlers(oDoc As Object)
RunKeyHandler
' записать в OnLoad файла загрузку RunKeyHandler
Dim PropValue(1) as new com.sun.star.beans.PropertyValue
PropValue(0).Name = "EventType"
PropValue(0).Value = "Script"
PropValue(1).Name = "Script"
PropValue(1).Value = "vnd.sun.star.script:CineWriterA4.DocEvents.RunKeyHandler?language=Basic&location=application"
oDoc.Events.ReplaceByName("OnLoad", PropValue())
End Sub
PK
RC8 CineWriterA4/Numbers.xdl
PK
RCEA
CineWriterA4/Stat.xdl
PK
RCwm CineWriterA4/Adv.xba
Public oDialog As Object
'Public Const bEdit = True ' правка
Public Const bEdit = False ' дистрибуция
'###############################################################################
' AutoFormat АВТОФОРМАТ
'###############################################################################
Sub AutoFormat
Dim oEnum As Object
Dim nPars As Integer
Dim oDoc As Object
Dim oText As Object
Dim oSels As Object
Dim oVC As Object, oSC As Object
Dim oTC1 As Object, oTC2 As Object
Dim oTC As Object
Dim iMarg As Integer
Dim iBlName As Integer, iBlRem As Integer, iBlDial As Integer ' пробелы перед блоками
Dim iLimName As Integer, iLimRem As Integer, iLimDial As Integer ' границы блоков слева
Dim iSpaces As Integer, iTabs As Integer
Dim sStyle As String, sStr As String, sStrU As String
Dim iLimSp As Integer
Dim bEmptyPar As Boolean
Dim oCont As Object ' содержимое
oDoc = ThisComponent
oText = oDoc.getText()
nPars = 0
oVC = oDoc.CurrentController.getViewCursor()
oSC = oText.createTextCursorByRange(oVC)
oSels = oDoc.getCurrentSelection()
oTC1 = oText.createTextCursorByRange(oSels.getByIndex(0).getStart())
oTC2 = oText.createTextCursorByRange(oSels.getByIndex(0).getEnd())
'=========================================================================
If oText.compareRegionEnds(oTC1, oTC2) <> 0 Then ' есть выделение, продолжать
oTC1.gotoStartOfParagraph(False)
oTC2.gotoEndOfParagraph(False)
oTC1.gotoEndOfParagraph(True)
Do
nPars = nPars + 1
If nPars = 1 Then iBlName = Blanks(oTC1)
If nPars = 2 Then iBlDial = Blanks(oTC1)
If nPars = 3 Then
iBlRem = iBlDial
iBlDial = Blanks(oTC1)
End If
oTC1.gotoNextParagraph(False)
Loop While oText.compareRegionEnds(oTC1, oTC2) >= 0 AND nPars < 3
If nPars = 1 Then ' выделена одна строка
If MsgBox(" Для работы функции нужно, чтобы были выделены три строки: " & CHR$(10) & _
" ИМЯ ГЕРОЯ, РЕМАРКА и ДИАЛОГ. " & CHR$(10) & _
" Если в Вашем сценарии отсутствуют РЕМАРКИ, нужно выделить " & CHR$(10) & _
" две строки: ИМЯ ГЕРОЯ и ДИАЛОГ. " & CHR$(10) & _
" (Подробнее об этом - см. Справку). " & CHR$(10) & CHR$(10) _
, 0 OR 48, "Автоформат - Выделена только одна строка...") = 1 Then Exit Sub
ElseIf nPars = 3 OR nPars = 2 Then
If nPars = 2 Then iBlRem = iBlDial + (iBlName - iBlDial) \ 2
iLimDial = iBlDial \ 2
iLimRem = iBlDial + (iBlRem - iBlDial) \ 2
iLimName = iBlRem + (iBlName - iBlRem) \ 2
End If
'print iLimName
'print iLimRem
'print iLimDial
Else ' ничего не выделено
If MsgBox(" Для работы функции нужно, чтобы были выделены три строки: " & CHR$(10) & _
" ИМЯ ГЕРОЯ, РЕМАРКА и ДИАЛОГ. " & CHR$(10) & _
" Если в Вашем сценарии отсутствуют РЕМАРКИ, нужно выделить " & CHR$(10) & _
" две строки: ИМЯ ГЕРОЯ и ДИАЛОГ. " & CHR$(10) & _
" (Подробнее об этом - см. Справку). " & CHR$(10) & CHR$(10) _
, 0 OR 48, "Автоформат - Отсутствуют выделенные строки...") = 1 Then Exit Sub
End If
'=================================================================== загрузить шаблон
oDoc.CurrentController.Select(oText)
oCont = oDoc.CurrentController.getTransferable()
oVC.gotoRange(oSC, False)
If bEdit Then
oDoc = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, Array())
Else
oDoc = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, Array())
End If
oDoc.CurrentController.InsertTransferable(oCont)
oDoc.CurrentController.getViewCursor().jumpToFirstPage()
If oDoc.DocumentProperties.TemplateName <> "CW_A4" Then oDoc.DocumentProperties.TemplateName = "CW_A4"
If NOT bKeyHandlers Then KeyHandlers(oDoc) ' включение хоткеев
oText = oDoc.getText()
'===========================================================================
oBar = oDoc.CurrentController.StatusIndicator ' автоформат
oBar.start("Автоформат...", 100)
oBar.Value = 0
oBar.Text = "Автоформат..."
'===========================================================================
Dim oReplace As Object ' уд. пробелов в пустых абзацах
oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchString = "^[ \t]*$"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oReplace = oDoc.createReplaceDescriptor() ' разрыв строки
oReplace.SearchString = "\n"
oReplace.ReplaceString = "\n"
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oBar.Value = 3
numPars = 0
d = oDoc.ParagraphCount \ 90
n = d
bar = 5
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
bEmptyPar = False
Do
oTC.gotoEndOfParagraph(True)
sStyle = oTC.ParaStyleName
' восстановление структуры для навигатора
If sStyle = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" AND oTC.OutlineLevel <> 1 Then oTC.OutlineLevel = 1
If oTC.isCollapsed Then
If bEmptyPar Then
oTC.goLeft(1, True)
oTC.setString("")
End If
bEmptyPar = True
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
ElseIf sStyle <> "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" OR sStyle <> "ОПИСАНИЕ ДЕЙСТВИЯ" OR _
sStyle <> "ИМЯ ГЕРОЯ" OR sStyle <> "РЕМАРКА" OR sStyle <> "РЕПЛИКА ГЕРОЯ" Then
sStr = oTC.String
iLimSp = Blanks(oTC)
sStrU = UCase(sStr)
If InStr(sStrU, "ИНТ.") OR InStr(sStrU, "НАТ.") OR _
InStr(sStrU, "INT.") OR InStr(sStrU, "EXT.") Then
oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ"
oTC.String = sStrU
If NOT bEmptyPar Then
If oTC.gotoPreviousParagraph(False) Then
oTC.gotoEndOfParagraph(False)
oText.insertControlCharacter(oTC, _
com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
End If
End If
ElseIf iLimSp >= iLimName Then
oTC.ParaStyleName = "ИМЯ ГЕРОЯ"
oTC.String = sStrU
If NOT bEmptyPar Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(False)
oText.insertControlCharacter(oTC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
End If
ElseIf iLimSp >= iLimRem AND iLimSp <= iLimName AND (InStr(sStr, "(") OR InStr(sStr, ")")) Then
oTC.ParaStyleName = "РЕМАРКА"
If bEmptyPar Then
oTC.gotoStartOfParagraph(False)
oTC.goLeft(1, True)
oTC.setString("")
End If
ElseIf iLimSp >= iLimDial AND iLimSp <= iLimRem Then
oTC.ParaStyleName = "РЕПЛИКА ГЕРОЯ"
If bEmptyPar Then
oTC.gotoStartOfParagraph(False)
oTC.goLeft(1, True)
oTC.setString("")
End If
Else
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
If NOT bEmptyPar Then
oTC.gotoPreviousParagraph(False)
If oTC.ParaStyleName <> "ОПИСАНИЕ ДЕЙСТВИЯ" Then
oTC.gotoEndOfParagraph(False)
oText.insertControlCharacter(oTC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
End If
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
End If
End If
bEmptyPar = False
End If
If oTC.BreakType <> 0 Then oTC.BreakType = 0 ' разрыв страницы
If numPars = n Then
bar = bar + 1
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTC.gotoNextParagraph(False)
oReplace = oDoc.createReplaceDescriptor() ' пробелы и табы в начале
oReplace.SearchString = "^[ \t]*"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oReplace = oDoc.createReplaceDescriptor() ' в конце
oReplace.SearchString = "[ \t]*$"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oReplace = oDoc.createReplaceDescriptor() ' множественные пробелы
oReplace.SearchString = " +"
oReplace.ReplaceString = " "
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
'On Error Resume Next
oTC.gotoStart(False) ' весь текст курьер 12 и т.д.
oTC.gotoEnd(True)
oTC.CharFontName = "Courier New"
oTC.CharHeight = 12.0
'oTC.CharColor = 0 ' черный ' оставить пометки и выеления
'oTC.CharBackColor = 16777215 ' белый
oTC.CharShadowed = False
'oTC.CharUnderline = 0
'oTC.CharWeight = 100.00
'oTC.CharPosture = 0
oTC.CharRelief = 0
oTC.CharAutoKerning = False
oTC.CharCrossedOut = False
oTC.CharFlash = False
oTC.CharStrikeout = 0
oTC.CharEscapement = 0
'oTC.CharLocale.Language = "ru"
'oTC.CharLocale.Country = "RU"
UpFirstChars ' начало предложений с прописной
oBar.Value = 100
oBar.End
'print "OK"
End Sub
'###############################################################################
' Cleaning ОЧИСТКА
'###############################################################################
Sub Cleaning
'On Error Resume Next
Dim oDoc As Object
Dim oTC As Object
Dim numPars As Integer
Dim oReplace As Object
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
If oDoc.DocumentProperties.TemplateName <> "CW_A4" Then oDoc.DocumentProperties.TemplateName = "CW_A4"
If NOT bKeyHandlers Then KeyHandlers(oDoc) ' включение хоткеев
oBar = oDoc.CurrentController.StatusIndicator ' автоформат
oBar.start("Очистка...", 100)
oBar.Value = 0
oBar.Text = "Очистка..."
oReplace = oDoc.createReplaceDescriptor() ' уд. пробелов в пустых абзацах
oReplace.SearchString = "^[ \t]*$"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oReplace = oDoc.createReplaceDescriptor() ' разрыв строки
oReplace.SearchString = "\n"
oReplace.ReplaceString = "\n"
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oReplace = oDoc.createReplaceDescriptor() ' множественные пробелы
oReplace.SearchString = " +"
oReplace.ReplaceString = " "
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oDoc.replaceAll(oReplace)
oTC.gotoStart(False) ' весь текст курьер 12 и т.д.
oTC.gotoEnd(True)
oTC.CharFontName = "Courier New"
oTC.CharHeight = 12.0
oTC.CharColor = 0 ' черный
oTC.CharBackColor = 16777215 ' белый
oTC.CharShadowed = False
oTC.CharUnderline = 0
oTC.CharWeight = 100.00
oTC.CharPosture = 0
oTC.CharRelief = 0
oTC.CharAutoKerning = False
oTC.CharCrossedOut = False
oTC.CharFlash = False
oTC.CharStrikeout = 0
oTC.CharEscapement = 0
Dim aLocale As New com.sun.star.lang.Locale
aLocale.Language = "ru"
aLocale.Country = "RU"
oTC.gotoStart(False)
numPars = 0
d = oDoc.ParagraphCount \ 50
n = d
bar = 5
Do
oTC.gotoEndOfParagraph(True)
' восстановление структуры для навигатора
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" AND oTC.OutlineLevel <> 1 Then oTC.OutlineLevel = 1
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" OR oTC.ParaStyleName = "ИМЯ ГЕРОЯ" Then
oTC.String = UCase(oTC.String)
End If
oTC.CharLocale = aLocale
oTC.goRight(0, False)
If numPars = n Then
bar = bar + 1
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTC.gotoNextParagraph(False)
oBar.Value = 100
oBar.End
End Sub
'====================================================================================
' Blanks КОЛИЧЕСТВО ПРОБЕЛЬНЫХ СИМВОЛОВ В НАЧАЛЕ СТРОКИ
'====================================================================================
Function Blanks(oTC As Object) As Integer
oTC.gotoStartOfParagraph(False)
Dim iMarg As Integer, iSpaces As Integer, iTabs As Integer, c As Integer
iSpaces = 0
iTabs = 0
iMarg = (oTC.ParaFirstLineIndent + oTC.ParaLeftMargin) \ 250
oTC.goRight(1, True)
If oTC.String = Chr(9) Then iMarg = (iMarg \ 5) * 5 ' если Таб в начале, округляем отступ слева до кратного 5
oTC.gotoStartOfParagraph(False)
Do While True
oTC.goRight(1, True)
c = Asc(oTC.String)
If c = 32 Then iSpaces = iSpaces + 1
If c = 9 Then
iTabs = iTabs + 1
iSpaces = (iSpaces \ 5) * 5
End If
If c = 10 OR c > 32 Then Exit Do
oTC.collapseToEnd()
Loop
oTC.gotoStartOfParagraph(False)
oTC.gotoEndOfParagraph(True)
Blanks = iMarg + iSpaces + iTabs*5
End Function
'====================================================================================
' UpFirstChars НАЧАЛА ПРЕДЛОЖЕНИЙ ПРОПИСНЫМИ
'====================================================================================
Sub UpFirstChars
Dim Up(32) As String, Low(32) As String
Dim n As Long
Dim oDoc As Object, oReplace As Object
oDoc = ThisComponent
Low() = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", _
"м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
"щ", "ъ", "ы", "ь", "э", "ю", "я")
Up() = Array("А", "Б", "В", "Г", "Д", "Е", "Ё", "Ж", "З", "И", "Й", "К", "Л", _
"М", "Н", "О", "П", "Р", "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", _
"Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я")
oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchCaseSensitive = True
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
For n = LBound(Low()) To UBound(Low())
oReplace.SearchString = "^" & Low(n)
oReplace.ReplaceString = Up(n)
oDoc.ReplaceAll(oReplace)
Next n
For n = LBound(Low()) To UBound(Low())
oReplace.SearchString = "\. " & Low(n)
oReplace.ReplaceString = ". " & Up(n)
oDoc.ReplaceAll(oReplace)
Next n
End Sub
'###############################################################################
' StatShow ОКНО СТАТИСТИКИ
'###############################################################################
Sub StatShow
Dim oLibContainer As Object, oLib As Object
Dim oInputStreamProvider As Object
Const sLibName = "CineWriterA4"
Const sDialogName = "Stat"
oLibContainer = DialogLibraries
oLibContainer.loadLibrary(sLibName)
oLib = oLibContainer.getByName(sLibName)
oInputStreamProvider = oLib.getByName(sDialogName)
oDialog = CreateUnoDialog(oInputStreamProvider)
Dim oDoc As Object
Dim lChars As Long
Dim AvtList As Single
oDoc = ThisComponent
lChars = NonBlankChars
oDialog.Model.Chars.Label = lChars
oDialog.Model.CharsWS.Label = oDoc.CharacterCount
oDialog.Model.Words.Label = oDoc.WordCount
oDialog.Model.Lines.Label = oDoc.CurrentController.LineCount
oDialog.Model.Pars.Label = oDoc.ParagraphCount
oDialog.Model.Pages.Label = oDoc.CurrentController.PageCount
AvtList = lChars / 40000
oDialog.Model.ALists.Label = Format(AvtList, "##0.0")
Dim oFrame As Object
Dim CurPosSize As New com.sun.star.awt.Rectangle
oFrame = oDoc.getCurrentController().Frame
FramePosSize = oFrame.getComponentWindow.PosSize
xWindowPeer = oDialog.getPeer()
CurPosSize = oDialog.getPosSize()
WindowHeight = FramePosSize.Height
WindowWidth = FramePosSize.Width
DialogWidth = CurPosSize.Width
DialogHeight = CurPosSize.Height
iXPos = ((WindowWidth/2) - (DialogWidth/2))
iYPos = ((WindowHeight/2) - (DialogHeight/2))
oDialog.setPosSize(iXPos, iYPos, DialogWidth, DialogHeight, com.sun.star.awt.PosSize.POS)
oDialog.execute()
End Sub
'====================================================================================
' NonBlankChars КОЛИЧЕСТВО НЕПРОБЕЛЬНЫХ СИМВОЛОВ
'====================================================================================
Function NonBlankChars
Dim oDoc as Object
Dim oFound as Object
Dim nAllChars as Long
oDoc = ThisComponent
nAllChars = oDoc.CharacterCount
Dim i As Integer
Dim j As Long
Dim oSearch as Object
Dim sBlanks(5) as String
j = 0
sBlanks() = Array(Chr$(9), " ", Chr$(13), Chr$(10), Chr$(160), Chr$(173))
For i = 0 To 5
oSearch = oDoc.createSearchDescriptor
oSearch.SearchAll = True
oSearch.SearchCaseSensitive = False
oSearch.SearchRegularExpression = False
oSearch.SearchString = sBlanks(i)
oFound = oDoc.findAll(oSearch)
j = j + oFound.Count
Next
NonBlankChars = nAllChars - j
End Function
'###############################################################################
' HeaderToBold ВЫДЕЛИТЬ ЗАГОЛОВКИ СЦЕН ЖИРНЫМ
'###############################################################################
Sub HeaderToBold
Dim oDoc as Object
Dim oTC as Object
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
Do
oTC.gotoEndOfParagraph(True)
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
oTC.CharWeight = com.sun.star.awt.FontWeight.BOLD
End If
Loop While oTC.gotoNextParagraph(False)
End Sub
'###############################################################################
' HeaderToNormal УБРАТЬ ВЫДЕЛЕНИЕ ЗАГОЛОВКОВ СЦЕН ЖИРНЫМ
'###############################################################################
Sub HeaderToNormal
Dim oDoc as Object
Dim oTC as Object
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
Do
oTC.gotoEndOfParagraph(True)
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
oTC.CharWeight = com.sun.star.awt.FontWeight.NORMAL
End If
Loop While oTC.gotoNextParagraph(False)
End Sub
'###############################################################################
' NumbersShow ОКНО НОМЕРОВ СЦЕН
'###############################################################################
Sub NumbersShow
Dim oLibContainer As Object, oLib As Object
Dim oInputStreamProvider As Object
Const sLibName = "CineWriterA4"
Const sDialogName = "Numbers"
oLibContainer = DialogLibraries
oLibContainer.loadLibrary(sLibName)
oLib = oLibContainer.getByName(sLibName)
oInputStreamProvider = oLib.getByName(sDialogName)
oDialog = CreateUnoDialog(oInputStreamProvider)
Dim oDoc as Object
oDoc = ThisComponent
Dim oFrame As Object
Dim CurPosSize As New com.sun.star.awt.Rectangle
oFrame = oDoc.getCurrentController().Frame
FramePosSize = oFrame.getComponentWindow.PosSize
xWindowPeer = oDialog.getPeer()
CurPosSize = oDialog.getPosSize()
WindowHeight = FramePosSize.Height
WindowWidth = FramePosSize.Width
DialogWidth = CurPosSize.Width
DialogHeight = CurPosSize.Height
iXPos = ((WindowWidth/2) - (DialogWidth/2))
iYPos = ((WindowHeight/2) - (DialogHeight/2))
oDialog.setPosSize(iXPos, iYPos, DialogWidth, DialogHeight, com.sun.star.awt.PosSize.POS)
oDialog.execute()
End Sub
'====================================================================================
' NumbersAdd ДОБАВИТЬ НОМЕРА СЦЕН
'====================================================================================
Sub NumbersAdd
Dim sPrefix As String
Dim sSep1 As String
Dim iNumb As Integer
Dim sSep2 As String
Dim sPostfix As String
sPrefix = oDialog.getControl("Prefix").Text
sSep1 = oDialog.getControl("Sep1").Text
iNumb = oDialog.getControl("Numb").State
sSep2 = oDialog.getControl("Sep2").Text
sPostfix = oDialog.getControl("Postfix").Text
Dim oDoc As Object
Dim oTC As Object
Dim i As Integer
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
i = 1
Do
oTC.gotoEndOfParagraph(True)
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
If iNumb = 1 Then
oTC.String = sPrefix & sSep1 & i & sSep2 & sPostfix & " " & oTC.String
Else
oTC.String = sPrefix & sSep1 & sSep2 & sPostfix & " " & oTC.String
End If
i = i + 1
End If
Loop While oTC.gotoNextParagraph(False)
oDialog.endExecute()
End Sub
'###############################################################################
' NumbersClear УБРАТЬ НОМЕРА СЦЕН
'###############################################################################
Sub NumbersClear
If MsgBox(" Внимание! Эта операция удаляет начальную часть строки " & CHR$(10) & _
" заголовка сцены (""МЕСТО И ВРЕМЯ ДЕЙСТВИЯ""), " & CHR$(10) & _
" которая начинается с цифры и заканчивается пробелом. " & CHR$(10) & CHR$(10) & _
" Вы уверены в своих действиях? " & CHR$(10) & CHR$(10), _
1 OR 48, "Удаление нумерации сцен...") = 2 Then Exit Sub
Dim oDoc As Object
Dim oEnum As Object
Dim oReplace As Object
oDoc = ThisComponent
oEnum = oDoc.Text.createEnumeration()
Do While oEnum.hasMoreElements()
If oEnum.nextElement().ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchString = "^[0-9][^ ]* "
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
End If
Loop
If oDoc.replaceAll(oReplace) = False Then
MsgBox(" Нумерация сцен не найдена. " & CHR$(10) & CHR$(10), _
0 OR 64, "Удаление нумерации сцен...")
End If
End Sub
'###############################################################################
' HeroList ДОБАВИТЬ СПИСОК ПЕСОНАЖЕЙ ПОД ЗАГОЛОВКОМ СЦЕНЫ
'###############################################################################
Sub HeroList
Dim oDoc As Object
Dim oTC As Object
Dim names As String
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
oTC.gotoEnd(False)
names = ""
Do
oTC.gotoEndOfParagraph(True)
'##############################
If oTC.ParaStyleName = "ИМЯ ГЕРОЯ" Then
names = Trim(oTC.String) + "{" + names
ElseIf oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
If names <> "" Then
names = Left(names, Len(names)-1)
oTC.gotoNextParagraph(False)
oTC.String = DuplRemove(names) + CHR$(13)
oTC.gotoPreviousParagraph(False)
oTC.gotoPreviousParagraph(False)
End If
names = ""
End If
Loop While oTC.gotoPreviousParagraph(False)
End Sub
'====================================================================================
' DuplRemove(s$) As String УДАЛИТЬ ДУБЛИКАТЫ ИЗ МАССИВА
'====================================================================================
Function DuplRemove(s$) As String
Dim arr() As String
Dim i As Integer
Dim j As Integer
Dim chk As Boolean
Dim num As Integer
Dim str As String
arr = Split(s, "{")
Dim res(UBound(arr())) As String
res(0) = arr(0)
chk = False
num = 1
For i = 1 To UBound(arr())
For j = 0 To i
If arr(i) = res(j) Then
chk = True
Exit For
End If
Next j
If chk = False Then
res(num) = arr(i)
num = num + 1
End If
chk = False
Next i
ReDim Preserve res(0 To num-1) As String
DuplRemove = "(" + Join(res(), ", ") + ")"
End Function
'###############################################################################
' HeroListClear УДАЛИТЬ СПИСОК ПЕСОНАЖЕЙ ПОД ЗАГОЛОВКОМ СЦЕНЫ
'###############################################################################
Sub HeroListClear
If MsgBox(" Внимание! Эта операция удаляет списки персонажей " & CHR$(10) & _
" под заголовками сцен." & CHR$(10) & CHR$(10) & _
" Вы уверены в своих действиях? " & CHR$(10) & CHR$(10), _
1 OR 48, "Удаление списков персонажей...") = 2 Then Exit Sub
Dim oDoc As Object
Dim oTC As Object
Dim i As Integer
oDoc = ThisComponent
oTC = oDoc.Text.createTextCursor()
i = 0
oTC.gotoStart(False)
Do
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
oTC.gotoNextParagraph(False)
If oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" Then
oTC.gotoEndOfParagraph(True)
If Left(oTC.String, 1) = "(" AND Right(oTC.String, 1) = ")" Then
oTC.gotoNextParagraph(False)
If oTC.String = "" Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
oTC.goRight(1, True)
oTC.String = ""
Else
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
oTC.String = ""
End If
i = i + 1
End If
End If
End If
Loop While oTC.gotoNextParagraph(False)
If i = 0 Then
MsgBox(" Списки персонажей не найдены. " & CHR$(10) & CHR$(10), _
0 OR 64, "Удаление списков персонажей...")
End If
End Sub
'###############################################################################
' TitlePage ТИТУЛЬНАЯ СТРАНИЦА
'###############################################################################
Sub TitlePage
StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_title_a4.ott", "_blank", 0, Array())
End Sub
'###############################################################################
' HelpShow СПРАВКА
'###############################################################################
Sub HelpShow
Dim sUrl As String
Dim oSvc As Object
oSvc = createUnoService("com.sun.star.system.SystemShellExecute")
sUrl = GetPackDir("CineWriterA4.PackPath") & "Help/CW_Help.html"
oSvc.execute(sUrl, "", 0)
End Sub
'====================================================================================
' GetPackDir(idPath As String) As String URL УСТАНОВКИ CINEWRITER'a
'====================================================================================
Function GetPackDir(idPath As String) As String
Const sPrefix = "vnd.sun.star.expand:"
Dim oConfigProvider As Object, oRegKey As Object
Dim sPackDir As String
oConfigProvider = CreateUnoService("com.sun.star.configuration.ConfigurationProvider")
Dim aNodePath(0) As New com.sun.star.beans.PropertyValue
aNodePath(0).Name = "nodepath"
aNodePath(0).Value = idPath
oRegKey=oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath())
sPackDir = oRegKey.getByName("PackDir")
sPackDir = mid(sPackDir, len(sPrefix)+1)
Dim oCtx as object
oCtx = getProcessServiceManager().DefaultContext
Dim oMacroExpander As Object
oMacroExpander = oCtx.getValueByName("/singletons/com.sun.star.util.theMacroExpander")
sPackDir = oMacroExpander.ExpandMacros(sPackDir)
GetPackDir = sPackDir
End Function
PK
RCޅ:vW W CineWriterA4/ImpExp.xba
REM ***** BASIC *****
'###############################################################################
' FromSophocles ИМПОРТ ИЗ СОФОКЛА
'###############################################################################
Sub FromSophocles
Dim oDoc As Object
Dim oTmpDoc As Object
Dim oImpDoc As Object
Dim oPathSubst As Object
Dim sDefDir As String
Dim mArgs(0) As Variant
Dim Properties(0) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
bEmpty = False
If oDoc.hasLocation Then
Dim Locs() As String
sPathBig$ = oDoc.getURL
Locs() = Split(sPathBig, "/")
i = UBound(Locs())
sDefDir = Left(sPathBig,Len(sPathBig) - Len(Locs(i))-1)
Else
oPathSubst = createUnoService("com.sun.star.util.PathSubstitution")
sDefDir = oPathSubst.getSubstituteVariableValue("$(work)")
If NOT oDoc.isModified Then bEmpty = True
End If
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Text (.txt)", "*.txt")
oFilePicker.SetCurrentFilter("Text (.txt)")
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Импорт файла Софокла..."
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sUrl = mFiles(0)
Else
Exit Sub
End If
Dim args(2) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
args(1).Name = "FilterName"
args(1).Value = "Text (encoded)"
args(2).name = "FilterOptions"
args(2).value = "MS_1251, LF, Courier New"
oTmpDoc = StarDesktop.LoadComponentFromUrl(sUrl, "_blank", 0, args())
oText = oTmpDoc.getText()
oTmpDoc.CurrentController.Select(oText)
oCont = oTmpDoc.CurrentController.getTransferable()
oTmpDoc.dispose
If bEdit Then
oImpDoc = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, Array())
Else
oImpDoc = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, Array())
End If
oImpDoc.DocumentProperties.TemplateName = "CW_A4"
KeyHandlers(oImpDoc)
oImpDoc.CurrentController.InsertTransferable(oCont)
If bEmpty Then oDoc.dispose
oImpDoc.Text.InsertControlCharacter(oImpDoc.Text.getEnd(),_
com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, False)
oImpDoc.CurrentController.getViewCursor().jumpToFirstPage()
oBar = ThisComponent.CurrentController.StatusIndicator
oBar.start("Импорт сценария...", 100)
oBar.Value = 2
oBar.Text = "Импорт сценария..."
'===============================================================================
Dim oReplace As Object
oReplace = ThisComponent.createReplaceDescriptor() ' удаление CR
oReplace.SearchString = "\n"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 3
oReplace = ThisComponent.createReplaceDescriptor() ' удаление номеров страниц
oReplace.SearchString = "^ {59,61}[0-9]+\.$"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 4
'=============== для градусника
numPars = 0
d = ThisComponent.ParagraphCount \ 40
n = d
bar = 5
'===============================================================================
Dim oTC ' удаление лишних пустых абзацев
oTC = ThisComponent.Text.createTextCursor() ' разрывов страницы
oTC.gotoStart(False) ' и блока (MORE) - (CONT'D)
bEmptyPar = False
Do
oTC.gotoEndOfParagraph(True)
If bEmptyPar AND oTC.getString() = "" Then
oTC.goLeft(1, True)
oTC.setString("")
numPars = numPars - 3
End If
If oTC.getString() = "" Then
bEmptyPar = True
Else
bEmptyPar = False
End If
If oTC.getString() = " (MORE)" Then
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.gotoNextParagraph(True)
oTC.setString("")
numPars = numPars - 7
End If
If Left(oTC.String, 3) <> "ИНТ" AND Left(oTC.String, 3) <> "НАТ" AND _
Left(oTC.String, 3) <> "INT" AND Left(oTC.String, 3) <> "EXT" AND _
Left(oTC.String, 3) <> Space(3) AND oTC.String <> "" Then
oTC.String = " " & oTC.String ' дописываем 3 пробела в начале строки ДЕЙСТВИЮ
End If
If numPars = n Then
bar = bar + 1
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTC.gotoNextParagraph(False)
'=============== для градусника
numPars = 0
d = ThisComponent.ParagraphCount \ 50
n = d
'===============================================================================
oTC.gotoStart(False) ' назначение стилей абзацам
tmp = ""
Do
oTC.gotoEndOfParagraph(True)
'############################## пробелы: диалог - 13, ремарка - 20, герой - 26, (действие - 3)
If oTC.String = "" Then ' сделаем с запасом - 10, 17, 23
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
ElseIf Left(oTC.String, 3) = "ИНТ" OR Left(oTC.String, 3) = "НАТ" OR _
Left(oTC.String, 3) = "INT" OR Left(oTC.String, 3) = "EXT" Then
oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ"
ElseIf Left(oTC.String, 23) = Space(23) Then
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
If Left(oTC.String, 23) = Space(23) Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String) + " "
oTC.String = ""
oTC.goLeft(1, True)
oTC.String = ""
numPars = numPars - 1
Else
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String)
oTC.ParaStyleName = "ИМЯ ГЕРОЯ"
oTC.String = tmp
tmp = ""
End If
ElseIf Left(oTC.String, 17) = Space(17) Then
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
If Left(oTC.String, 17) = Space(17) Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String) + " "
oTC.String = ""
oTC.goLeft(1, True)
oTC.String = ""
numPars = numPars - 1
Else
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String)
oTC.ParaStyleName = "РЕМАРКА"
oTC.String = tmp
tmp = ""
End If
ElseIf Left(oTC.String, 10) = Space(10) AND Left(oTC.String, 17) <> Space(17) Then
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
If Left(oTC.String, 10) = Space(10) AND Left(oTC.String, 17) <> Space(17) Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String) + " "
oTC.String = ""
oTC.goLeft(1, True)
oTC.String = ""
numPars = numPars - 1
Else
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String)
oTC.ParaStyleName = "РЕПЛИКА ГЕРОЯ"
oTC.String = tmp
tmp = ""
End If
ElseIf Left(oTC.String, 3) = Space(3) AND Left(oTC.String, 10) <> Space(10) Then
oTC.gotoNextParagraph(False)
oTC.gotoEndOfParagraph(True)
If Left(oTC.String, 3) = Space(3) AND Left(oTC.String, 10) <> Space(10) Then
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String) + " "
oTC.String = ""
oTC.goLeft(1, True)
oTC.String = ""
numPars = numPars - 1
Else
oTC.gotoPreviousParagraph(False)
oTC.gotoEndOfParagraph(True)
tmp = tmp + LTrim(oTC.String)
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
oTC.String = tmp
tmp = ""
End If
End If
If numPars = n Then
bar = bar + 1
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTC.gotoNextParagraph(False)
ThisComponent.CurrentController.getViewCursor().jumpToFirstPage()
oBar.Value = 100
oBar.End
End Sub
'###############################################################################
' ToSophocles ЭКСПОРТ В СОФОКЛ
'###############################################################################
Sub ToSophocles
Dim oDoc As Object
Dim sURL As String
Dim oVC As Object, oSC As Object
Dim dt As Date
Dim sDate As String
Dim mArgs(0) As Variant
Dim Properties(1) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oText = oDoc.getText()
If (NOT oDoc.hasLocation()) Then
MsgBox " Ваш файл всё еще не сохранен. " & CHR$(10) & _
" Вам следует сохранить его в одном из следующих форматов: " & CHR$(10) & _
" ODT, DOCX, DOC, RTF и т.д." & CHR$(10) & CHR$(10), 0 OR 16, "Сохраните файл"
Exit Sub
Else
sURL = oDoc.getURL()
End If
oVC = oDoc.CurrentController.getViewCursor()
oSC = oText.createTextCursorByRange(oVC)
dt = Now
sDate = "_" & Year(dt) & "-" & Format(Month(dt), "00") & "-" & _
Format(Day(dt), "00") & "_" & Format(Hour(dt), "00") & "-" & Format(Minute(dt), "00")
Dim Arr() As String
Arr() = Split(sURL, "/")
i = UBound(Arr())
sDefName = Arr(i)
sDefDir = Left(sURL,Len(sURL) - Len(sDefName)-1)
Arr() = Split(sDefName, ".")
x = Arr(UBound(Arr)) ' расширение
sDefName = Left(sDefName, Len(sDefName)-Len(x)-1) ' имя без расширения
x = LCase(x)
If x<>"odt" AND x<>"docx" AND x<>"doc" AND x<>"rtf" AND x<>"sxw" AND x<>"fodt" AND x<>"uot" Then
nMsg = MsgBox (" Расширение Вашего файла (" & UCase(x) & ") не совпадает " & CHR$(10) & _
" с обычными раширениями текстовых процессоров " & CHR$(10) & _
" (ODT, DOCX, DOC, RTF). " & CHR$(10) & _
" Уверены, что хотите продолжить? " & CHR$(10) & CHR$(10) & _
" (Ваш файл будет сохранен как текстовой для экспорта в Софокл). " & CHR$(10) & CHR$(10) _
, 4 OR 48, "Или это файл текстового процессора?")
End If
If nMsg = 7 Then
Exit Sub
End If
sDefName = ConvertFromUrl(sDefName) & sDate & ".txt"
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Текст (.txt)", "*.txt")
oFilePicker.SetCurrentFilter("Текст (.txt)")
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Экспорт сценария в Софокл..."
oFilePicker.setDefaultName(sDefName)
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sUrl = mFiles(0)
Else
Exit Sub
End If
oDoc.CurrentController.Select(oText)
oCont = oDoc.CurrentController.getTransferable()
oVC.gotoRange(oSC, False)
Dim args(0) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
If bEdit Then
oTmpDoc = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, args())
Else
oTmpDoc = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, args())
End If
oTmpDoc.CurrentController.InsertTransferable(oCont)
oBar = oDoc.CurrentController.StatusIndicator
oBar.start("Экспорт в Софокл...", 100)
oBar.Value = 3
oBar.Text = "Экспорт в Софокл..."
'=============== для градусника
numPars = 0
d = oTmpDoc.ParagraphCount \ 60
n = d
bar = 5
'=================================================================== обработка
Dim oTmpText As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
oTmpText = oTmpDoc.Text
oViewCursor = oTmpDoc.CurrentController.getViewCursor()
oViewCursor.jumpToFirstPage()
oViewCursor.jumpToStartOfPage()
oTextCursor = oTmpText.createTextCursorByRange(oViewCursor)
sSpaces = ""
Do
oTextCursor.gotoEndOfParagraph(True)
If oTextCursor.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then
oTextCursor.String = UCase(oTextCursor.String)
sSpaces = ""
ElseIf oTextCursor.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" Then
sSpaces = ""
ElseIf oTextCursor.ParaStyleName = "ИМЯ ГЕРОЯ" Then
oTextCursor.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" ' чтобы отступ слева был 0
oTextCursor.String = UCase(oTextCursor.String)
sSpaces = String(23, " ")
ElseIf oTextCursor.ParaStyleName = "РЕМАРКА" Then
oTextCursor.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" ' чтобы отступ слева был 0
sSpaces = String(17, " ")
ElseIf oTextCursor.ParaStyleName = "РЕПЛИКА ГЕРОЯ" Then
oTextCursor.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ" ' чтобы отступ слева был 0
sSpaces = String(13, " ")
End If
oTextCursor.gotoStartOfParagraph(False)
oViewCursor.gotoRange(oTextCursor, False)
oTmpText.insertControlCharacter(oViewCursor, com.sun.star.text.ControlCharacter.LINE_BREAK, false)
oTmpText.insertString(oViewCursor, sSpaces & "^", False)
Do While True
oViewCursor.gotoEndOfLine(False)
oTextCursor.gotoRange(oViewCursor, False)
If oTextCursor.isEndOfParagraph() Then
oTmpText.insertString(oViewCursor, "^", False)
Exit Do
End If
oTextCursor.goLeft(1, True)
oTextCursor.String = "^"
oTmpText.insertControlCharacter(oViewCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, false)
oTmpText.insertControlCharacter(oViewCursor, com.sun.star.text.ControlCharacter.LINE_BREAK, false)
oTmpText.insertString(oViewCursor, sSpaces & "^", False)
Loop
If numPars = n Then
bar = bar + 1
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTextCursor.gotoNextParagraph(False)
'=============================================================================
Dim oReplace As Object
oReplace = oTmpDoc.createReplaceDescriptor() ' замены для правильного экспорта
oReplace.SearchString = "^^" ' текстов на русском
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "^ИНТ."
oReplace.ReplaceString = "INT."
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "^НАТ."
oReplace.ReplaceString = "EXT."
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "^INT."
oReplace.ReplaceString = "INT."
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "^EXT."
oReplace.ReplaceString = "EXT."
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "^("
oReplace.ReplaceString = "("
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = ")^"
oReplace.ReplaceString = ")"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
Properties(0).Name = "FilterName"
Properties(0).Value = "Text (encoded)"
Properties(1).Name = "FilterOptions"
Properties(1).Value = "MS_1251, CRLF, Courier New, ru-RU"
oTmpDoc.storeAsUrl(sUrl,Properties())
oTmpDoc.dispose
oBar.Value = 100
oBar.End
End Sub
'=============================================================================
' EncChange обработка выбора кодировки
'=============================================================================
Sub EncChange
Dim oDoc As Object, oText As Object
Dim sUrl As String, sEnc As String
If oDialog.getControl("EncWin").State = True Then
sEnc = "MS_1251"
ElseIf oDialog.getControl("EncUTF").State = True Then
sEnc = "UTF8"
End If
If oDialog.getControl("CRLF").State = True Then
sEnc = sEnc & ", CRLF"
ElseIf oDialog.getControl("LF").State = True Then
sEnc = sEnc & ", LF"
End If
sUrl = oDialog.getControl("UrlField").getText
Dim args(2) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
args(1).Name = "FilterName"
args(1).Value = "Text (encoded)"
args(2).name = "FilterOptions"
args(2).value = sEnc & ", Courier New, ru-RU"
oDoc = StarDesktop.LoadComponentFromUrl(sUrl, "_blank", 0, args())
Dim oTC As Object
Dim sTxt As String
sTxt = ""
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
Do
oTC.gotoEndOfParagraph(True)
sTxt = sTxt & oTC.String
If Len(sTxt) > 3000 Then Exit Do
Loop While oTC.gotoNextParagraph(False)
oDialog.getControl("FieldTxt").Text = sTxt
oDoc.dispose
End Sub
'###############################################################################
' EncShow(sUrl) КОДИРОВКА FOUNTAIN'A
'###############################################################################
Function EncShow(sUrl)
Dim oLibContainer As Object, oLib As Object
Dim oInputStreamProvider As Object
Dim oDoc As Object, oText As Object
Dim mArgs(0) As Variant
Const sLibName = "CineWriterA4"
Const sDialogName = "Enc"
oLibContainer = DialogLibraries
oLibContainer.loadLibrary(sLibName)
oLib = oLibContainer.getByName(sLibName)
oInputStreamProvider = oLib.getByName(sDialogName)
oDialog = CreateUnoDialog(oInputStreamProvider)
oDialog.getControl("UrlField").setText(sUrl) ' скрытое поле с урл
Dim args(2) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
args(1).Name = "FilterName"
args(1).Value = "Text (encoded)"
args(2).name = "FilterOptions"
args(2).value = "MS_1251, CRLF, Courier New, ru-RU"
oDoc = StarDesktop.LoadComponentFromUrl(sUrl, "_blank", 0, args())
Dim oTC As Object
Dim sTxt As String
sTxt = ""
oTC = oDoc.Text.createTextCursor()
oTC.gotoStart(False)
Do
oTC.gotoEndOfParagraph(True)
sTxt = sTxt & oTC.String
If Len(sTxt) > 3000 Then Exit Do
Loop While oTC.gotoNextParagraph(False)
oDialog.getControl("FieldTxt").Text = sTxt
oDoc.dispose
Dim oFrame As Object
Dim CurPosSize As New com.sun.star.awt.Rectangle
oFrame = ThisComponent.getCurrentController().Frame
FramePosSize = oFrame.getComponentWindow.PosSize
xWindowPeer = oDialog.getPeer()
CurPosSize = oDialog.getPosSize()
WindowHeight = FramePosSize.Height
WindowWidth = FramePosSize.Width
DialogWidth = CurPosSize.Width
DialogHeight = CurPosSize.Height
iXPos = ((WindowWidth/2) - (DialogWidth/2))
iYPos = ((WindowHeight/2) - (DialogHeight/2))
oDialog.setPosSize(iXPos, iYPos, DialogWidth, DialogHeight, com.sun.star.awt.PosSize.POS)
EncShow = oDialog.execute()
End Function
'###############################################################################
' FromFountain ИМПОРТ ИЗ FOUNTAIN
'###############################################################################
Sub FromFountain
Dim oDoc As Object
Dim oTmpDoc As Object
Dim oImpDoc As Object
Dim oPathSubst As Object
Dim sDefDir As String
Dim sEnc As String
Dim bBrWin As Boolean
Dim mArgs(0) As Variant
Dim Properties(0) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
bEmpty = False
If oDoc.hasLocation Then
Dim Locs() As String
sPathBig$ = oDoc.getURL
Locs() = Split(sPathBig, "/")
i = UBound(Locs())
sDefDir = Left(sPathBig,Len(sPathBig) - Len(Locs(i))-1)
Else
oPathSubst = createUnoService("com.sun.star.util.PathSubstitution")
sDefDir = oPathSubst.getSubstituteVariableValue("$(work)")
If NOT oDoc.isModified Then bEmpty = True
End If
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Fountain (.fountain)", "*.fountain; *.txt")
oFilePicker.SetCurrentFilter("Fountain (.fountain)")
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Импорт файла Fountain..."
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sUrl = mFiles(0)
Else
Exit Sub
End If
If EncShow(sUrl) = 0 Then Exit Sub
If oDialog.getControl("EncWin").State = True Then
sEnc = "MS_1251"
ElseIf oDialog.getControl("EncUTF").State = True Then
sEnc = "UTF8"
End If
If oDialog.getControl("CRLF").State = True Then
sEnc = sEnc & ", CRLF"
bBrWin = True
ElseIf oDialog.getControl("LF").State = True Then
sEnc = sEnc & ", LF"
bBrWin = False
End If
Dim args(2) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
args(1).Name = "FilterName"
args(1).Value = "Text (encoded)"
args(2).name = "FilterOptions"
args(2).value = sEnc & ", Courier New, ru-RU"
oTmpDoc = StarDesktop.LoadComponentFromUrl(sUrl, "_blank", 0, args())
oText = oTmpDoc.getText()
oTmpDoc.CurrentController.Select(oText)
oCont = oTmpDoc.CurrentController.getTransferable()
oTmpDoc.dispose
If bEdit Then
oImpDoc = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, Array())
Else
oImpDoc = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, Array())
End If
oImpDoc.DocumentProperties.TemplateName = "CW_A4"
KeyHandlers(oImpDoc)
oImpDoc.CurrentController.InsertTransferable(oCont)
If bEmpty Then oDoc.dispose
oImpDoc.Text.InsertControlCharacter(oImpDoc.Text.getEnd(),_
com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, False)
oImpDoc.CurrentController.getViewCursor().jumpToFirstPage()
oBar = oImpDoc.CurrentController.StatusIndicator
oBar.start("Конвертация Fountain...", 100)
oBar.Value = 5
oBar.Text = "Конвертация Fountain..."
'===============================================================================
Dim oReplace As Object
oReplace = ThisComponent.createReplaceDescriptor()
oReplace.SearchString = "\n"
If bBrWin = True Then
oReplace.ReplaceString = ""
Else
oReplace.ReplaceString = "\n"
End If
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 10
oReplace = ThisComponent.createReplaceDescriptor() ' табуляции на пробелы
oReplace.SearchString = "\t"
oReplace.ReplaceString = " "
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 15
'===============================================================================
oReplace = ThisComponent.createReplaceDescriptor() ' заголовки сцен
oReplace.SearchString = "^(инт|нат|ext|int|i/e|est|\.[^\.])(.+[^ ]) ?$"
oReplace.ReplaceString = "{h}$0" ' header
oReplace.SearchCaseSensitive=False
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oReplace = ThisComponent.createReplaceDescriptor() ' убрать точки
oReplace.SearchString = "^\{h\}\.(.+)$"
oReplace.ReplaceString = "{h}$1" ' header
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 25
'===============================================================================
oReplace = ThisComponent.createReplaceDescriptor() ' имя героя
oReplace.SearchString = "^([^{>][^a-zа-яё]+)$"
oReplace.ReplaceString = "{c}$0" ' character
oReplace.SearchRegularExpression=True
oReplace.SearchCaseSensitive=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 35
'===============================================================================
oReplace = ThisComponent.createReplaceDescriptor() ' ремарка
oReplace.SearchString = "^(\(.+\))$"
oReplace.ReplaceString = "{p}$0" ' parenthetical
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 40
'===============================================================================
oReplace = ThisComponent.createReplaceDescriptor() ' выключка по центру
oReplace.SearchString = "^> *(.+)<$"
oReplace.ReplaceString = "{a}$1" ' align
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 45
'===============================================================================
Dim oTC
oTC = ThisComponent.Text.createTextCursor()
oTC.gotoStart(False) ' назначение стилей абзацам
Do
oTC.gotoEndOfParagraph(True)
'##############################
If oTC.String = "" Then
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
ElseIf Left(oTC.String, 3) = "{h}" Then
oTC.String = UCase(oTC.String)
oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ"
ElseIf Left(oTC.String, 3) = "{c}" Then
oTC.ParaStyleName = "ИМЯ ГЕРОЯ"
ElseIf Left(oTC.String, 3) = "{p}" Then
oTC.ParaStyleName = "РЕМАРКА"
ElseIf prev = "" OR Left(prev, 1) <> "{" Then
oTC.ParaStyleName = "ОПИСАНИЕ ДЕЙСТВИЯ"
Else
oTC.ParaStyleName = "РЕПЛИКА ГЕРОЯ"
End If
If Left(oTC.String, 3) = "{a}" Then ' центрирование
oTC.String = RTrim(oTC.String)
oTC.ParaAdjust=3
End If
prev = oTC.String
Loop While oTC.gotoNextParagraph(False)
oBar.Value = 65
'===============================================================================
oReplace = ThisComponent.createReplaceDescriptor() ' очистка пометок
oReplace.SearchString = "^(\{h\}|\{c\}|\{p\}|\{a\})"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
oBar.Value = 75
'===============================================================================
Dim oEndCurs As Object ' окончание документа ' болд, италик, подеркн.
Dim oCurs As Object ' текущий курсор
oEndCurs = ThisComponent.getText().createTextCursor() ' болд-италик
oEndCurs.gotoEnd(False)
oCurs = ThisComponent.getText().createTextCursor()
oReplace = ThisComponent.createSearchDescriptor()
oReplace.SearchRegularExpression = True
oReplace.SearchString = "\*\*\*[^ \*][^\*]+[^ \*]\*\*\*"
Do While Not ThisComponent.Text.compareRegionEnds(oCurs, oEndCurs) <= 0
vFound = ThisComponent.findNext(oCurs.getEnd(), oReplace)
If IsNull(vFound) Then Exit Do
oCurs.gotoRange(vFound, False)
oCurs.CharWeight = com.sun.star.awt.FontWeight.BOLD
oCurs.CharPosture = com.sun.star.awt.FontSlant.ITALIC
oCurs.collapseToStart()
oCurs.goRight(3, True)
oCurs.String = ""
oCurs.gotoRange(vFound, False)
oCurs.collapseToEnd()
oCurs.goLeft(3, True)
oCurs.String = ""
Loop
oBar.Value = 80
oEndCurs = ThisComponent.getText().createTextCursor() ' болд
oEndCurs.gotoEnd(False)
oCurs = ThisComponent.getText().createTextCursor()
oReplace = ThisComponent.createSearchDescriptor()
oReplace.SearchRegularExpression = True
oReplace.SearchString = "\*\*[^ \*][^\*]+[^ \*]\*\*"
Do While Not ThisComponent.Text.compareRegionEnds(oCurs, oEndCurs) <= 0
vFound = ThisComponent.findNext(oCurs.getEnd(), oReplace)
If IsNull(vFound) Then Exit Do
oCurs.gotoRange(vFound, False)
oCurs.CharWeight = com.sun.star.awt.FontWeight.BOLD
oCurs.collapseToStart()
oCurs.goRight(2, True)
oCurs.String = ""
oCurs.gotoRange(vFound, False)
oCurs.collapseToEnd()
oCurs.goLeft(2, True)
oCurs.String = ""
Loop
oBar.Value = 85
oEndCurs = ThisComponent.getText().createTextCursor() ' италик
oEndCurs.gotoEnd(False)
oCurs = ThisComponent.getText().createTextCursor()
oReplace = ThisComponent.createSearchDescriptor()
oReplace.SearchRegularExpression = True
oReplace.SearchString = "\*[^ \*][^\*]+[^ \*]\*"
Do While Not ThisComponent.Text.compareRegionEnds(oCurs, oEndCurs) <= 0
vFound = ThisComponent.findNext(oCurs.getEnd(), oReplace)
If IsNull(vFound) Then Exit Do
oCurs.gotoRange(vFound, False)
oCurs.CharPosture = com.sun.star.awt.FontSlant.ITALIC
oCurs.collapseToStart()
oCurs.goRight(1, True)
oCurs.String = ""
oCurs.gotoRange(vFound, False)
oCurs.collapseToEnd()
oCurs.goLeft(1, True)
oCurs.String = ""
Loop
oBar.Value = 90
oEndCurs = ThisComponent.getText().createTextCursor() ' подчеркн.
oEndCurs.gotoEnd(False)
oCurs = ThisComponent.getText().createTextCursor()
oReplace = ThisComponent.createSearchDescriptor()
oReplace.SearchRegularExpression = True
oReplace.SearchString = "_[^ ].+[^ ]_"
Do While Not ThisComponent.Text.compareRegionEnds(oCurs, oEndCurs) <= 0
vFound = ThisComponent.findNext(oCurs.getEnd(), oReplace)
If IsNull(vFound) Then Exit Do
oCurs.gotoRange(vFound, False)
oCurs.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
oCurs.collapseToStart()
oCurs.goRight(1, True)
oCurs.String = ""
oCurs.gotoRange(vFound, False)
oCurs.collapseToEnd()
oCurs.goLeft(1, True)
oCurs.String = ""
Loop
oBar.Value = 95
oReplace = ThisComponent.createReplaceDescriptor() ' экранированные звездочки
oReplace.SearchString = "\*"
oReplace.ReplaceString = "*"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
ThisComponent.replaceAll(oReplace)
ThisComponent.CurrentController.getViewCursor().jumpToFirstPage()
oBar.Value = 100
oBar.End
End Sub
'###############################################################################
' ToFountain ЭКСПОРТ В FOUNTAIN
'###############################################################################
Sub ToFountain
Dim oDoc As Object
Dim sDocURL As String
Dim oText As Object
Dim oVC As Object, oSC As Object
Dim d As Date
Dim sDate As String
Dim mArgs(0) As Variant
Dim Properties(0) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oText = oDoc.getText()
If (NOT oDoc.hasLocation()) Then
MsgBox " Ваш файл всё еще не сохранен. " & CHR$(10) & _
" Вам следует сохранить его в одном из следующих форматов: " & CHR$(10) & _
" ODT, DOCX, DOC, RTF и т.д." & CHR$(10) & CHR$(10), 0 OR 16, "Сохраните файл"
Exit Sub
Else
sURL = oDoc.getURL()
End If
oVC = oDoc.CurrentController.getViewCursor()
oSC = oText.createTextCursorByRange(oVC)
dt = Now
sDate = "_" & Year(dt) & "-" & Format(Month(dt), "00") & "-" & _
Format(Day(dt), "00") & "_" & Format(Hour(dt), "00") & "-" & Format(Minute(dt), "00")
Dim Arr() As String
Arr() = Split(sURL, "/")
i = UBound(Arr())
sDefName = Arr(i)
sDefDir = Left(sURL,Len(sURL) - Len(sDefName)-1)
Arr() = Split(sDefName, ".")
x = Arr(UBound(Arr)) ' расширение
sDefName = Left(sDefName, Len(sDefName)-Len(x)-1) ' имя без расширения
x = LCase(x)
If x<>"odt" AND x<>"docx" AND x<>"doc" AND x<>"rtf" AND x<>"sxw" AND x<>"fodt" AND x<>"uot" Then
If MsgBox(" Расширение Вашего файла (" & UCase(x) & ") не совпадает " & CHR$(10) & _
" с обычными раширениями текстовых процессоров " & CHR$(10) & _
" (ODT, DOCX, DOC, RTF и т.д.). " & CHR$(10) & _
" Уверены, что хотите продолжить? " & CHR$(10) & CHR$(10) & _
" (Ваш файл будет сохранен как текстовый в формате Fountain). " & CHR$(10) & CHR$(10) _
, 4 OR 48, "Или это файл текстового процессора?") = 7 Then
Exit Sub
End If
End If
sDefName = ConvertFromUrl(sDefName) & sDate & ".txt"
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Текст (.txt)", "*.txt")
oFilePicker.AppendFilter("Fountain (.fountain)", "*.fountain")
oFilePicker.SetCurrentFilter("Текст (.txt)")
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Экспорт сценария в Fountain..."
oFilePicker.setDefaultName(sDefName)
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sUrl = mFiles(0)
Else
Exit Sub
End If
oDoc.CurrentController.Select(oText)
oCont = oDoc.CurrentController.getTransferable()
oVC.gotoRange(oSC, False)
Dim args(0) as New com.sun.star.beans.PropertyValue
args(0).Name = "Hidden"
args(0).Value = True
oTmpDoc = StarDesktop.LoadComponentFromUrl("private:factory/swriter", "_blank", 0, args())
oTmpDoc.CurrentController.InsertTransferable(oCont)
oBar = oDoc.CurrentController.StatusIndicator
oBar.start("Экспорт в Fountain...", 100)
oBar.Value = 5
oBar.Text = "Экспорт в Fountain..."
'=============== для градусника
numPars = 0
d = oTmpDoc.ParagraphCount \ 6
n = d
bar = 20
'=================================================================== обработка
Dim oReplace As Object ' табуляции на пробелы
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "\t"
oReplace.ReplaceString = " "
oReplace.SearchRegularExpression=True
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor() 'экранировать звездочки
oReplace.SearchString = "*"
oReplace.ReplaceString = "\*"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oBar.Value = 10
'================================================================================
Dim SrchAttrBI(1) as new com.sun.star.beans.PropertyValue ' болд, италик и пр.
Dim ReplAttrBI(1) as new com.sun.star.beans.PropertyValue
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = ".+"
oReplace.ReplaceString = "***$0***"
oReplace.SearchRegularExpression=True
oReplace.searchStyles=True
oReplace.searchAll=True
SrchAttrBI(0).Name = "CharWeight"
SrchAttrBI(0).Value = com.sun.star.awt.FontWeight.BOLD
SrchAttrBI(1).Name = "CharPosture"
SrchAttrBI(1).Value = com.sun.star.awt.FontSlant.ITALIC
ReplAttrBI(0).Name = "CharWeight"
ReplAttrBI(0).Value = com.sun.star.awt.FontWeight.NORMAL
ReplAttrBI(1).Name = "CharPosture"
ReplAttrBI(1).Value = com.sun.star.awt.FontSlant.NONE
oReplace.SetSearchAttributes(SrchAttrBI())
oReplace.SetReplaceAttributes(ReplAttrBI())
oTmpDoc.replaceAll(oReplace)
Dim SrchAttrB(0) as new com.sun.star.beans.PropertyValue
Dim ReplAttrB(0) as new com.sun.star.beans.PropertyValue
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = ".+"
oReplace.ReplaceString = "**$0**"
oReplace.SearchRegularExpression=True
oReplace.searchStyles=True
oReplace.searchAll=True
SrchAttrB(0).Name = "CharWeight"
SrchAttrB(0).Value = com.sun.star.awt.FontWeight.BOLD
ReplAttrB(0).Name = "CharWeight"
ReplAttrB(0).Value = com.sun.star.awt.FontWeight.NORMAL
oReplace.SetSearchAttributes(SrchAttrB())
oReplace.SetReplaceAttributes(ReplAttrB())
oTmpDoc.replaceAll(oReplace)
oBar.Value = 15
Dim SrchAttrI(0) as new com.sun.star.beans.PropertyValue
Dim ReplAttrI(0) as new com.sun.star.beans.PropertyValue
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = ".+"
oReplace.ReplaceString = "*$0*"
oReplace.SearchRegularExpression=True
oReplace.searchStyles=True
oReplace.searchAll=True
SrchAttrI(0).Name = "CharPosture"
SrchAttrI(0).Value = com.sun.star.awt.FontSlant.ITALIC
ReplAttrI(0).Name = "CharPosture"
ReplAttrI(0).Value = com.sun.star.awt.FontSlant.NONE
oReplace.SetSearchAttributes(SrchAttrI())
oReplace.SetReplaceAttributes(ReplAttrI())
oTmpDoc.replaceAll(oReplace)
Dim SrchAttrU(0) as new com.sun.star.beans.PropertyValue
Dim ReplAttrU(0) as new com.sun.star.beans.PropertyValue
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = ".+"
oReplace.ReplaceString = "_$0_"
oReplace.SearchRegularExpression=True
oReplace.searchStyles=True
oReplace.searchAll=True
SrchAttrU(0).Name = "CharUnderline"
SrchAttrU(0).Value = com.sun.star.awt.FontUnderline.SINGLE
ReplAttrU(0).Name = "CharUnderline"
ReplAttrU(0).Value = com.sun.star.awt.FontUnderline.NONE
oReplace.SetSearchAttributes(SrchAttrU())
oReplace.SetReplaceAttributes(ReplAttrU())
oTmpDoc.replaceAll(oReplace)
oBar.Value = 20
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "__"
oReplace.ReplaceString = ""
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "_ _"
oReplace.ReplaceString = " "
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "***_***"
oReplace.ReplaceString = "_"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "**_**"
oReplace.ReplaceString = "_"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
oReplace = oTmpDoc.createReplaceDescriptor()
oReplace.SearchString = "*_*"
oReplace.ReplaceString = "_"
oReplace.SearchRegularExpression=False
oReplace.searchAll=True
oTmpDoc.replaceAll(oReplace)
'================================================================================
Dim oTC As Object
oTC = oTmpDoc.Text.createTextCursor()
oTC.gotoStart(False)
Do
oTC.gotoEndOfParagraph(True)
sTmp = Left(UCase(oTC.String), 3) ' первые три буквы
If oTC.ParaStyleName = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" Then ' МЕСТО И ВРЕМЯ ДЕЙСТВИЯ
If sTmp <> "ИНТ" AND sTmp <> "НАТ" AND sTmp <> "INT" AND sTmp <> "EXT" Then
oTC.String = "." & oTC.String
End If
oTC.String = UCase(oTC.String)
Else
If oTC.ParaStyleName = "ИМЯ ГЕРОЯ" Then ' ИМЯ ГЕРОЯ
oTC.String = UCase(oTC.String)
End If
If sTmp = "ИНТ" OR sTmp = "НАТ" OR sTmp = "INT" OR sTmp = "EXT" Then
oTC.String = oTC.String & " "
End If
End If
If oTC.ParaAdjust = com.sun.star.style.ParagraphAdjust.CENTER Then ' по центру
oTC.String = ">" & Trim(oTC.String) & "<"
End If
If numPars = n Then
bar = bar + 5
oBar.Value = bar
n = n + d
End If
numPars = numPars + 1
Loop While oTC.gotoNextParagraph(False)
oBar.Value = 85
'=============================================================================
Properties(0).Name = "FilterName"
Properties(0).Value = "Text"
oTmpDoc.storeAsUrl(sUrl,Properties())
oTmpDoc.dispose
oBar.Value = 100
oBar.End
End Sub
'###############################################################################
' BackUp РЕЗЕРВНАЯ КОПИЯ СЦЕНАРИЯ
'###############################################################################
Sub BackUp
Dim oDoc As Object
Dim sURL As String
Dim dt As Date
Dim sDate As String
Dim mArgs(0) As Variant
Dim Properties(0) As New com.sun.star.beans.PropertyValue
Dim sDefName As String, sDefDir As String, x As String ', sDefName As String,
Dim sFName As String
oDoc = ThisComponent
oText = oDoc.getText()
If (NOT oDoc.hasLocation()) Then
MsgBox " Перед созданием резервной копии " & CHR$(10) & _
" Вам следует сохранить сценарий в одном из следующих форматов: " & CHR$(10) & _
" ODT, DOCX, DOC или RTF " & CHR$(10) & CHR$(10), 0 OR 16, "Сохраните файл"
Exit Sub
Else
sURL = oDoc.getLocation()
End If
dt = Now
sDate = "_" & Year(dt) & "-" & Format(Month(dt), "00") & "-" & _
Format(Day(dt), "00") & "_" & Format(Hour(dt), "00") & "-" & Format(Minute(dt), "00")
Dim Arr() As String
Arr() = Split(sURL, "/")
i = UBound(Arr())
sDefName = Arr(i)
sDefDir = Left(sURL,Len(sURL) - Len(sDefName)-1)
Arr() = Split(sDefName, ".")
x = Arr(UBound(Arr)) ' расширение
sDefName = Left(sDefName, Len(sDefName)-Len(x)-1) ' имя без расширения
sDefName = ConvertFromUrl(sDefName) & sDate '& "." & x
x = LCase(x)
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Microsoft Word 97/2000/XP (.doc)", "*.doc")
oFilePicker.AppendFilter("Microsoft Word 2007/2010/XML (.docx, .xml)", "*.docx")
oFilePicker.AppendFilter("ODF Text Document (.odt)", "*.odt")
oFilePicker.AppendFilter("Rich Text Format (.rtf)", "*.rtf")
oFilePicker.AppendFilter("OpenOffice.org 1.0 Text Document (.sxw)", "*.sxw")
oFilePicker.AppendFilter("OpenDocument Text (Flat XML) (.fodt)", "*.fodt")
oFilePicker.AppendFilter("Unified Office Format text (.uot, .uof)", "*.uot")
If x = "doc" Then
sFName = "MS Word 97"
ElseIf x = "docx" Then
sFName = "MS Word 2007 XML"
ElseIf x = "odt" Then
sFName = "writer8"
ElseIf x = "rtf" Then
sFName = "Rich Text Format"
ElseIf x = "sxw" Then
sFName = "StarOffice XML (Writer)"
ElseIf x = "fodt" Then
sFName = "OpenDocument Text Flat XML"
ElseIf x = "uot" Then
sFName = "UOF text"
Else
sFName = "writer8"
End If
sDefName = sDefName '& "." & x
oFilePicker.SetCurrentFilter(sFName)
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Резервная копия..."
oFilePicker.setDefaultName(sDefName)
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sURL = mFiles(0)
Else
Exit Sub
End If
x2 = Right(sURL, 4)
If x2 = ".doc" Then
sFName = "MS Word 97"
ElseIf x2 = "docx" Then
sFName = "MS Word 2007 XML"
ElseIf x2 = ".odt" Then
sFName = "writer8"
ElseIf x2 = ".rtf" Then
sFName = "Rich Text Format"
ElseIf x2 = ".sxw" Then
sFName = "StarOffice XML (Writer)"
ElseIf x2 = "fodt" Then
sFName = "OpenDocument Text Flat XML"
ElseIf x2 = ".uot" Then
sFName = "UOF text"
Else
sURL = sURL & x
End If
Properties(0).Name = "FilterName"
Properties(0).Value = sFName
oDoc.storeToURL(sURL, Properties())
End Sub
'###############################################################################
' SaveToText СОХРАНЕНИЕ СЦЕНАРИЯ В ТЕКСТОВЫЙ ФАЙЛ С ДАТОЙ-ВРЕМЕНЕМ В ИМЕНИ
'###############################################################################
Sub SaveToText
Dim oDoc As Object
Dim sDocURL As String
Dim dt As Date
Dim sDate As String
Dim mArgs(0) As Variant
Dim Properties(0) As New com.sun.star.beans.PropertyValue
oDoc = ThisComponent
If (NOT oDoc.hasLocation()) Then
MsgBox " Ваш файл всё еще не сохранен. " & CHR$(10) & _
" Вам следует сохранить его в одном из следующих форматов: " & CHR$(10) & _
" ODT, DOCX, DOC, RTF и т.д." & CHR$(10) & CHR$(10), 0 OR 16, "Сохраните файл"
Exit Sub
Else
sURL = oDoc.getLocation()
End If
dt = Now
sDate = "_" & Year(dt) & "-" & Format(Month(dt), "00") & "-" & _
Format(Day(dt), "00") & "_" & Format(Hour(dt), "00") & "-" & Format(Minute(dt), "00")
Dim Arr() As String
Arr() = Split(sURL, "/")
i = UBound(Arr())
sDefName = Arr(i)
sDefDir = Left(sURL,Len(sURL) - Len(sDefName)-1)
Arr() = Split(sDefName, ".")
x = Arr(UBound(Arr)) ' расширение
sDefName = Left(sDefName, Len(sDefName)-Len(x)-1) ' имя без расширения
x = LCase(x)
If x<>"odt" And x<>"docx" And x<>"doc" And x<>"rtf" And x<>"sxw" Then
If MsgBox(" Расширение Вашего файла (" & UCase(x) & ") не совпадает " & CHR$(10) & _
" с обычными раширениями текстовых процессоров " & CHR$(10) & _
" (ODT, DOCX, DOC, RTF). " & CHR$(10) & _
" Уверены, что хотите продолжить? " & CHR$(10) & CHR$(10) & _
" (Ваш файл будет сохранен как текстовый). " & CHR$(10) & CHR$(10) _
, 4 OR 48, "Или это файл текстового процессора?") = 7 Then
Exit Sub
End If
End If
sDefName = ConvertFromUrl(sDefName) & sDate & ".txt"
'sDefName = sDefName & sDate & ".txt"
oFilePicker = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
mArgs(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION
oFilePicker.Initialize(mArgs())
oFilePicker.AppendFilter("Текст (.txt)", "*.txt")
oFilePicker.SetCurrentFilter("Текст (.txt)")
oFilePicker.setDisplayDirectory(sDefDir)
oFilePicker.Title = "Сохранение сценария в текстовый файл..."
oFilePicker.setDefaultName(sDefName)
If oFilePicker.execute() Then
mFiles = oFilePicker.getFiles()
sUrl = mFiles(0)
Else
Exit Sub
End If
Properties(0).Name = "FilterName"
Properties(0).Value = "Text"
oDoc.storeToURL(sUrl, Properties())
End Sub
PK
RCs CineWriterA4/Format.xba
'===============================================================================
' SetFormat(sStyle As String) ФОРМАТИРОВАНИЕ
'===============================================================================
Sub SetFormat(sStyle As String)
Dim oEnum As Object
Dim oVC As Object
Dim oTC As Object
Dim oDoc As Object
oDoc = ThisComponent
If oDoc.DocumentProperties.TemplateName = "CW_A4" Then
oVC = oDoc.CurrentController.getViewCursor()
oTC = oDoc.Text.createTextCursorByRange(oVC)
oEnum = oTC.createEnumeration()
Dim vPar
Do While oEnum.hasMoreElements()
vPar = oEnum.nextElement()
'If sStyle = "МЕСТО И ВРЕМЯ ДЕЙСТВИЯ" OR sStyle = "ИМЯ ГЕРОЯ" Then
' vPar.String = UCase(vPar.String) ' не уверен, что эта опция нужна
'End If
vPar.ParaStyleName = sStyle
Loop
Else
DefFormatA4(sStyle)
End If
End Sub
'###############################################################################
' DefFormatA4(Optional sStyle As String) ПРЕДФОРМАТ A4
'###############################################################################
Sub DefFormatA4(Optional sStyle As String)
Dim oDoc As Object, oDoc2 As Object
Dim oText As Object
Dim oCont As Object ' содержимое
Dim oVC As Object, oSC As Object, oTC As Object, oTC2 As Object
Dim oSels As Object
Dim nPars As Integer, nPars2 As Integer
oDoc = ThisComponent
If oDoc.hasLocation OR oDoc.isModified Then ' применить шаблон, сообщить юзеру об исходном файле
If MsgBox(" Содержимое Вашего файла будет скопировано в новый " & CHR$(10) & _
" файл с использованием сценарного шаблона. " & CHR$(10) & _
" Вы можете сохранить его под новым именем или заменить им "& CHR$(10) & _
" Ваш исходный файл. " & CHR$(10) & CHR$(10), 1 OR 64, "Загрузка шаблона CW A4...") = 2 Then Exit Sub
oText = oDoc.getText()
oVC = oDoc.CurrentController.getViewCursor()
oSC = oText.createTextCursorByRange(oVC)
oSels = oDoc.getCurrentSelection() ' запомнить выделение
oTC = oText.createTextCursorByRange(oSels.getByIndex(0).getStart())
oTC2 = oText.createTextCursorByRange(oSels.getByIndex(0).getEnd())
oTC.gotoStartOfParagraph(False)
oTC2.gotoStartOfParagraph(False)
nPars2 = 0
Do While oText.compareRegionEnds(oTC, oTC2) <> 0
oTC2.gotoPreviousParagraph(False)
nPars2 = nPars2 + 1
Loop
nPars = 0
Do
nPars = nPars + 1
Loop While oTC.gotoPreviousParagraph(False)
oDoc.CurrentController.Select(oText)
oCont = oDoc.CurrentController.getTransferable()
oVC.gotoRange(oSC, False)
If bEdit Then
oDoc2 = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, Array())
Else
oDoc2 = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, Array())
End If
oDoc2.CurrentController.InsertTransferable(oCont)
oTC = oDoc2.Text.createTextCursor() ' восстановить выделение
oTC2 = oDoc2.Text.createTextCursor()
oTC.gotoStart(False)
Do While nPars > 1
oTC.gotoNextParagraph(False)
nPars = nPars - 1
Loop
oTC.ParaStyleName = sStyle
If nPars2 > 0 Then oTC2.gotoRange(oTC, False)
Do While nPars2 > 0
oTC.gotoNextParagraph(True)
oTC2.gotoNextParagraph(False)
oTC2.ParaStyleName = sStyle
nPars2 = nPars2 - 1
Loop
oTC.gotoEndOfParagraph(True)
oVC = oDoc2.CurrentController.getViewCursor()
oVC.gotoRange(oTC, False)
Else ' пустой неизмененный файл - применить шаблон, прежний файл закрыть
If bEdit Then
oDoc2 = StarDesktop.LoadComponentFromURL("file:///home/wah/temp/cw_a4.ott", "_blank", 0, Array())
Else
oDoc2 = StarDesktop.LoadComponentFromURL(GetPackDir("CineWriterA4.PackPath") & "Template/cw_a4.ott", "_blank", 0, Array())
End If
oDoc.Close(True)
oTC = oDoc2.Text.createTextCursor()
oTC.ParaStyleName = sStyle
End If
oDoc2.DocumentProperties.TemplateName = "CW_A4"
KeyHandlers(oDoc2)
End Sub
'###############################################################################
' SetScene МЕСТО И ВРЕМЯ ДЕЙСТВИЯ
'###############################################################################
Sub SetScene
SetFormat("МЕСТО И ВРЕМЯ ДЕЙСТВИЯ")
End Sub
'###############################################################################
' SetAction ОПИСАНИЕ ДЕЙСТВИЯ
'###############################################################################
Sub SetAction
SetFormat("ОПИСАНИЕ ДЕЙСТВИЯ")
End Sub
'###############################################################################
' SetCharacter ИМЯ ГЕРОЯ
'###############################################################################
Sub SetCharacter
SetFormat("ИМЯ ГЕРОЯ")
End Sub
'###############################################################################
' SetParenthetical РЕМАРКА
'###############################################################################
Sub SetParenthetical
SetFormat("РЕМАРКА")
End Sub
'###############################################################################
' SetDialogue РЕПЛИКА ГЕРОЯ
'###############################################################################
Sub SetDialogue
SetFormat("РЕПЛИКА ГЕРОЯ")
End Sub
PK /C Help/PK GC Help/img/PK
Bي Help/img/logo.pngPNG
IHDR @ @ iq bKGD pHYs tIME oi IDATx{dW}?羺oۏywvW>+ YGTQqIUb/ U)ǤLl
H6 JHHݝ}켧v8㞞3:uos}
7vl7vl6zR
,|-wXT=y=Yh m-`q:`d