Обработчик события печати

[proger1983]

Здравствуйте, уважаемые форумчане. Возникла необходимость автоматической обработки выводимых на печать документов офиса. Что-то типа этого: при возникновении события печати нужно его остановить, сформировать pdf с теми же настройками печати, обработать pdf отдельной программой (добавить штрих-код и немного текста) и отправить на печать на тот же принтер с теми же настройками. Пока только увидел название принтера в Event.Source.Printer. А где взять остальное (число страниц на листе, качество печати и т.п.)? И главное как остановить обработчик события, чтобы документ не ушел на печать без обработки?

[sokol92]

Добрый день! Думаю, более перспективный путь описан в п. 13.5.2 замечательной книги А.Питоньяка OOME_4_0.odt.
Вы перехватываете команду Диспетчера ".uno:Print" и обрабатываете должным образом.
Экспорт в PDF-файл имеет огромное число опций, которые описаны здесь.
Наконец, описание текущего принтера можно получить с помощью метода getPrinter документа LibreOffice. Свойства принтера описаны здесь.

[proger1983]

Добрый день! Думаю, более перспективный путь описан в п. 13.5.2 замечательной книги А.Питоньяка OOME_4_0.odt.
Вы перехватываете команду Диспетчера ".uno:Print" и обрабатываете должным образом.
Экспорт в PDF-файл имеет огромное число опций, которые описаны здесь.
Наконец, описание текущего принтера можно получить с помощью метода getPrinter документа LibreOffice. Свойства принтера описаны здесь.

Огромное спасибо. Взял за основу скрипт перехвата:

Код Выделить Развернуть

Global oDispatchInterceptor
Global oSlaveDispatchProvider
Global oMasterDispatchProvider

Dim oMarkerDispatch

Sub RegisterInterceptor ( )
   If IsNull(oDispatchInterceptor) Or IsEmpty(oDispatchInterceptor) Then
       oDispatchInterceptor = CreateUnoListener("MarkerFrame_", "com.sun.star.frame.XDispatchProviderInterceptor")
       ThisComponent.currentController.Frame.registerDispatchProviderInterceptor(oDispatchInterceptor)
   End If
End Sub

Sub ReleaseInterceptor ( )
On Error Resume Next
   ThisComponent.currentController.Frame.releaseDispatchProviderInterceptor(oDispatchInterceptor)
End Sub

Function MarkerFrame_queryDispatch ( oUrl, sTargetFrameName As String, lSearchFlags As Long ) As Variant
   Dim oDisp
   Dim sUrl As String

   If oUrl.Protocol = "slot:" Then
       Exit Function
   End If

   Select Case oUrl.complete
       Case ".uno:Print"
           oDisp = GetMarkerDispatch
       Case Else
           oDisp = oSlaveDispatchProvider.queryDispatch( oUrl, sTargetFrameName, lSearchFlags )
   End Select

   MarkerFrame_queryDispatch = oDisp
End Function

Function MarkerFrame_queryDispatches ( mDispatches ) As Variant
   'MarkerFrame_queryDispatches = mDispatches()
End Function

Function MarkerFrame_getSlaveDispatchProvider ( ) As Variant
   MarkerFrame_getSlaveDispatchProvider = oSlaveDispatchProvider
End Function

Sub MarkerFrame_setSlaveDispatchProvider ( oSDP )
   oSlaveDispatchProvider = oSDP
End Sub

Function MarkerFrame_getMasterDispatchProvider ( )  As Variant
   MarkerFrame_getMasterDispatchProvider = oMasterDispatchProvider
End Function

Sub MarkerFrame_setMasterDispatchProvider ( oMDP )
   oMasterDispatchProvider = oMDP
End Sub

Function GetMarkerDispatch ( )
   If IsNull(oMarkerDispatch) Or IsEmpty(oMarkerDispatch) Then
       oMarkerDispatch = CreateUnoListener("Marker_", "com.sun.star.frame.XDispatch")
   End If

   GetMarkerDispatch = oMarkerDispatch
End Function

Sub Marker_dispatch ( URL, Arguments )
   Select Case URL.complete
       Case ".uno:Print"
           service = createUnoService("org.openoffice.marker")
           service.trigger("print")
       Case Else
   End Select
End Sub

Sub Marker_addStatusListener ( Control, URL )
End Sub

Sub Marker_removeStatusListener ( Control, URL )
End Sub

Прописал RegisterInterceptor в событие OnFocus (если на OnStartApp, то ругается на currentController). По меню "Печать..." отлично попадает в мой обработчик (пока org.openoffice.marker в msgbox выводит свой аргумент), но по меню "Просмотр печати" офис падает. Без этих скриптов оба пункта меню работают. В чём может быть проблема?

[proger1983]

Если включить в перехват ".uno:PrintPreview", то офис падать перестаёт. Но не хочется терять функционал предварительного просмотра.

[sokol92]

Эти две команды ( ".uno:PrintPreview", ".uno:Print") связаны (я с этим сталкивался). Детально посмотрю в LO, когда появится возможность.
Отформатируйте, пожалуйста, код Basic в своем сообщении с помощью кпопки "#".

[proger1983]

Код Выделить Развернуть

Global oDispatchInterceptor
Global oSlaveDispatchProvider
Global oMasterDispatchProvider

Dim oMarkerDispatch

Sub RegisterInterceptor ( )
    If IsNull(oDispatchInterceptor) Or IsEmpty(oDispatchInterceptor) Then
        oDispatchInterceptor = CreateUnoListener("MarkerFrame_", "com.sun.star.frame.XDispatchProviderInterceptor")
    End If
    ThisComponent.currentController.Frame.registerDispatchProviderInterceptor(oDispatchInterceptor)
End Sub

Sub ReleaseInterceptor ( )
On Error Resume Next
    ThisComponent.currentController.Frame.releaseDispatchProviderInterceptor(oDispatchInterceptor)
End Sub

Function MarkerFrame_queryDispatch ( oUrl, sTargetFrameName As String, lSearchFlags As Long ) As Variant
    Dim oDisp
    Dim sUrl As String

    If oUrl.Protocol = "slot:" Then
        Exit Function
    End If

    Select Case oUrl.complete
        Case ".uno:Print"
            oDisp = GetMarkerDispatch
        Case ".uno:PrintPreview"
            oDisp = GetMarkerDispatch
        Case Else
            oDisp = oSlaveDispatchProvider.queryDispatch( oUrl, sTargetFrameName, lSearchFlags )
    End Select

    MarkerFrame_queryDispatch = oDisp
End Function

Function MarkerFrame_queryDispatches ( mDispatches ) As Variant
    'MarkerFrame_queryDispatches = mDispatches()
End Function

Function MarkerFrame_getSlaveDispatchProvider ( ) As Variant
    MarkerFrame_getSlaveDispatchProvider = oSlaveDispatchProvider
End Function

Sub MarkerFrame_setSlaveDispatchProvider ( oSDP )
    oSlaveDispatchProvider = oSDP
End Sub

Function MarkerFrame_getMasterDispatchProvider ( )  As Variant
    MarkerFrame_getMasterDispatchProvider = oMasterDispatchProvider
End Function

Sub MarkerFrame_setMasterDispatchProvider ( oMDP )
    oMasterDispatchProvider = oMDP
End Sub

Function GetMarkerDispatch ( )
    If IsNull(oMarkerDispatch) Or IsEmpty(oMarkerDispatch) Then
        oMarkerDispatch = CreateUnoListener("Marker_", "com.sun.star.frame.XDispatch")
    End If

    GetMarkerDispatch = oMarkerDispatch
End Function

Sub Marker_dispatch ( URL, Arguments )
    Dim service As Object
    Select Case URL.complete
        Case ".uno:Print"
            service = createUnoService("org.openoffice.marker")
            service.trigger("print")
        Case ".uno:PrintPreview"
            ReleaseInterceptor()
            service = createUnoService("com.sun.star.frame.DispatchHelper")
            service.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:PrintPreview", "", 0, Array())
            RegisterInterceptor()
        Case Else
    End Select
End Sub

Sub Marker_addStatusListener ( Control, URL )
End Sub

Sub Marker_removeStatusListener ( Control, URL )
End Sub

Если перехватывать так, то оба пункта меню работают так, как мне надо, но при предварительном просмотре иногда офис таки падает. Когда на 2 раз, когда на 5. Что бы еще придумать?

[proger1983]

Код Выделить Развернуть

Global oFrame
Global oDispatchInterceptor
Global oSlaveDispatchProvider
Global oMasterDispatchProvider

Dim oMarkerDispatch

Sub RegisterInterceptor ( )
    If IsNull(oFrame) Or IsEmpty(oFrame) Then
        oFrame = ThisComponent.currentController.Frame
    End If
    If IsNull(oDispatchInterceptor) Or IsEmpty(oDispatchInterceptor) Then
        oDispatchInterceptor = CreateUnoListener("MarkerFrame_", "com.sun.star.frame.XDispatchProviderInterceptor")
        oFrame.registerDispatchProviderInterceptor(oDispatchInterceptor)
    End If
End Sub

Sub ReleaseInterceptor ( )
On Error Resume Next
    oFrame.releaseDispatchProviderInterceptor(oDispatchInterceptor)
End Sub

Function MarkerFrame_queryDispatch ( oUrl, sTargetFrameName As String, lSearchFlags As Long ) As Variant
    Dim oDisp
    Dim sUrl As String

    If oUrl.Protocol = "slot:" Then
        Exit Function
    End If

    Select Case oUrl.complete
        Case ".uno:Print"
            oDisp = GetMarkerDispatch
        Case ".uno:PrintPreview"
            oDisp = GetMarkerDispatch
        Case Else
            oDisp = oSlaveDispatchProvider.queryDispatch( oUrl, sTargetFrameName, lSearchFlags )
    End Select

    MarkerFrame_queryDispatch = oDisp
End Function

Function MarkerFrame_queryDispatches ( mDispatches ) As Variant
    'MarkerFrame_queryDispatches = mDispatches()
End Function

Function MarkerFrame_getSlaveDispatchProvider ( ) As Variant
    MarkerFrame_getSlaveDispatchProvider = oSlaveDispatchProvider
End Function

Sub MarkerFrame_setSlaveDispatchProvider ( oSDP )
    oSlaveDispatchProvider = oSDP
End Sub

Function MarkerFrame_getMasterDispatchProvider ( )  As Variant
    MarkerFrame_getMasterDispatchProvider = oMasterDispatchProvider
End Function

Sub MarkerFrame_setMasterDispatchProvider ( oMDP )
    oMasterDispatchProvider = oMDP
End Sub

Function GetMarkerDispatch ( )
    If IsNull(oMarkerDispatch) Or IsEmpty(oMarkerDispatch) Then
        oMarkerDispatch = CreateUnoListener("Marker_", "com.sun.star.frame.XDispatch")
    End If

    GetMarkerDispatch = oMarkerDispatch
End Function

Sub Marker_dispatch ( URL, Arguments )
    Dim service As Object
    Select Case URL.complete
        Case ".uno:Print"
            service = createUnoService("org.openoffice.marker")
            service.trigger("print")
        Case ".uno:PrintPreview"
            oFrame.releaseDispatchProviderInterceptor(oDispatchInterceptor)
            service = createUnoService("com.sun.star.frame.DispatchHelper")
            service.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
            oFrame.registerDispatchProviderInterceptor(oDispatchInterceptor)
        Case Else
    End Select
End Sub

Sub Marker_addStatusListener ( Control, URL )
End Sub

Sub Marker_removeStatusListener ( Control, URL )
End Sub
Так, вроде, стабильно работает. Осталось теперь сделать свой диалог печати с преобразованием документа в PDF.

[kompilainenn]

Если перехватывать так, то оба пункта меню работают так, как мне надо, но при предварительном просмотре иногда офис таки падает. Когда на 2 раз, когда на 5. Что бы еще придумать?

Написать баг репорт, точно говорю (ЛО не должен падать никогда ни от каких манипуляций, а если падает, то это надо чинить)

[sokol92]

У меня Calc "падает", если в коде из #6 выполнить RegisterInterceptor, а затем начать редактирование документа (или выполнить предварительный просмотр).

Version: 7.1.3.2 (x64) / LibreOffice Community
Build ID: 47f78053abe362b9384784d31a6e56f8511eb1c1
CPU threads: 6; OS: Windows 10.0 Build 19042; UI render: default; VCL: win
Locale: ru-RU (ru_RU); UI: ru-RU
Calc: threaded

Похоже, что в начале редактирования вызывается обработчик команды ".uno:Print", так же, как и при предварительном просмотре.

Возможно, что мой совет перехватывать именно ".uno:Print" был чересчур оптимистичным.

[kompilainenn]

У меня Calc "падает", если

ну так есть воспроизводимый макрос для багрепорта?

[mikekaganski]

У меня Calc "падает", если

ну так есть воспроизводимый макрос для багрепорта?

Вот - подготовлен по ответу #2. Падает на предпросмотре.

[proger1983]

Переложил код на Python. Там перехват отлично работает и без костылей на предварительный просмотр. Плюс когда это всё было на Basic, то презентации стабильно падали при загрузке.

[proger1983]

Всё очень даже хорошо продвигается: свой диалог рисуется, pdf сохраняется и обрабатывается. Возник вопрос с номерами и количеством страниц. Если задать диапазон для печати, то хорошо бы проверить его, что не выходит за количество страниц. Поиском нашёл, что у документа можно обратиться к CurrentController.PageCount. Но это решение походит только для текстовых документов. Как количество страниц определить для таблиц и презентаций? Можно конечно экспортировать в pdf с очень малым разрешением, чтобы посмотреть там, а потом уже экспортировать нормально. Но это как-то...

[sokol92]

Спасибо за интересные сообщения.

Кстати, определение числа печатаемых страниц макросом для Excel непростая задача. В VBA прямых путей нет, обходные (от разработчика) здесь.

Для Calc мне этот путь не известен. Можно, конечно, попробовать посчитать через информацию о разрывах страниц и области печати, но это явно не комильфо.

[proger1983]

Спасибо за интересные сообщения.

Кстати, определение числа печатаемых страниц макросом для Excel непростая задача. В VBA прямых путей нет, обходные (от разработчика) здесь.

Для Calc мне этот путь не известен. Можно, конечно, попробовать посчитать через информацию о разрывах страниц и области печати, но это явно не комильфо.

Не за что  Почитав ещё немного форумов, остановился на варианте с двумя экспортами в pdf. Плюс при экспорте параметры PageRange и Selection не работали как надо (думал будет pdf с лишь нужными страницами, но нет). Приходится нужные страницы дёргать из pdf при обработке.