Получить информацию о разрешении экрана

[Ципихович Эндрю]

здравствуйте, нагуглил по сабжу:
К сожалению, получить информацию о разрешении экрана напрямую с помощью макроса LibreOffice невозможно. LibreOffice не имеет встроенных функций для доступа к системным параметрам, таким как разрешение экрана.
серьёзно?, и как быть?

[mikekaganski]

https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1awt_1_1XToolkit.html#a29f80014339cc32d254de3be5cb22057

[Ципихович Эндрю]

спасибо за ответ, по сабжу разобрался, код:

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

Option Explicit

Sub Ge
    Dim screenWidth As Integer
    Dim screenHeight As Integer
    Dim toolkit As Object
    toolkit = CreateUnoService("com.sun.star.awt.Toolkit")
    Dim screenRectangle As New com.sun.star.awt.Rectangle
    screenRectangle = toolkit.getWorkArea()
    screenWidth = screenRectangle.Width
    screenHeight = screenRectangle.Height
    ' MsgBox "Разрешение экрана: " & screenWidth & " x " & screenHeight & " пикселей"
    If screenWidth = 1919 and screenHeight = 1079 Then
    ' Установить масштаб документа на 180%
    ' 1 вариант
    ThisComponent.ActiveWindow.ViewZoomValue = 1.8
    ' 2 вариант
    Dim oController As Object
    oController = ThisComponent.CurrentController
    oController.Zoom = 180
    End If
End Subподскажите пожалуйста как решить вопрос Установить масштаб документа на 180%?, спасибо

[Ципихович Эндрю]

забыл сказать два варианта опробовал по последнему вопросу - чего-то не работает....

[sokol92]

См. здесь.

[Ципихович Эндрю]

спасибо за ответ, честно говоря не хило относительно количества кода:

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

Option Explicit

Sub Ge
    Dim screenWidth As Integer
    Dim screenHeight As Integer
    Dim toolkit As Object
    toolkit = CreateUnoService("com.sun.star.awt.Toolkit")
    Dim screenRectangle As New com.sun.star.awt.Rectangle
    screenRectangle = toolkit.getWorkArea()
    screenWidth = screenRectangle.Width
    screenHeight = screenRectangle.Height
    ' MsgBox "Разрешение экрана: " & screenWidth & " x " & screenHeight & " пикселей"
    If screenWidth = 1919 and screenHeight = 1079 Then
    ' Выполнить макрос Sub setMyFavoriteZoom(Optional oEvent As Variant)
Call setMyFavoriteZoom
    End If
End Sub

Sub setMyFavoriteZoom(Optional oEvent As Variant)
    ' Константа для избранного уровня масштабирования (в данном случае 125%)
    Const MY_FAVORITE_ZOOM = 180
    ' Переменные для хранения исходного объекта и настроек просмотра
    Dim oSource As Variant
    Dim oViewSettings As Variant
    ' Проверьте, отсутствует ли параметр oEvent (т. е. подпрограмма была вызвана без аргумента)
    If IsMissing(oEvent) Then
        ' Если oEvent отсутствует, установите исходный объект для текущего компонента (т. е. активного документа)
        oSource = ThisComponent
    Else
        ' Если oEvent присутствует, установите исходный объект в качестве источника события (например, нажатие кнопки)
        oSource = oEvent.Source
    EndIf
' Проверьте, поддерживает ли исходный объект сервис «com.sun.star.text.TextDocument» (т. е. является ли это текстовый документ)
    If oSource.supportsService("com.sun.star.text.TextDocument") Then
        ' Получить текущие настройки просмотра документа
        oViewSettings = oSource.getCurrentController().getViewSettings()
        ' MsgBox "Масштаб документа: " & oViewSettings.ZoomValue
        ' Проверьте, не равен ли текущий уровень масштабирования избранному уровню масштабирования
        If oViewSettings.ZoomValue <> MY_FAVORITE_ZOOM Then
            ' Если уровни масштабирования различаются, установите предпочтительный уровень масштабирования
            oViewSettings.ZoomValue = MY_FAVORITE_ZOOM
        EndIf
    EndIf
End Subсмотря с чем сравнивать, с вордом конечно:

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

'разрешение экрана
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 
Sub Ge()
    Dim screenWidth As Long
    Dim screenHeight As Long
    screenWidth = GetSystemMetrics(0) 'M_CXSCREEN 'Width=ширина
    screenHeight = GetSystemMetrics(1) 'M_CYSCREEN 'Height=высота
    MsgBox "Разрешение экрана: " & screenWidth & " x " & screenHeight & " пикселей"
    Dim documentScale As Long
    documentScale = ActiveDocument.ActiveWindow.View.Zoom.Percentage
    If screenWidth = 1920 And screenHeight = 1080 Then
    ActiveDocument.ActiveWindow.View.Zoom.Percentage = 180 'изменение масштаба
    documentScale = ActiveDocument.ActiveWindow.View.Zoom.Percentage 'масштаб после изменения масштаба
    End If
End Sub

[mikekaganski]

1. Вы можете опротестовать в суде необоснованно удержанный налог на длину кода.
2. Довольно забавно сравнивать длину кода, где в одном случае куча комментариев и констант, а в другом комментариев и отдельных констант нет.
3. При этом в случае получения разрешения экрана в VBA Вы пользуетесь системным вызовом GetSystemMetrics, который точно так же прекрасно отработает и в LibreOffice под Windows. А если сравнение идёт между "непереносимым кодом в Word (попробуйте получить им разрешение в Word на macOS) и кодом, работающем на любой платформе в LibreOffice", то это сравнение тёплого с мягким.
4. В случае установки зума ещё и сравнивается сервисный код для того, чтобы работать в обработчике событий.
5. Ну и в принципе: VBA - это специализированный API. В случае LibreOffice предлагается API, который практически без изменения логики можно использовать что под Basic, что под Python или Java. Очень любопытно, какую ценную информацию несёт глубокомысленное замечание, что эти программы (и длина кода) разные...

[sokol92]

смотря с чем сравнивать, с вордом конечно:

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

ActiveDocument.ActiveWindow.View.Zoom.Percentage = 180 'изменение масштаба
и

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

oSource.CurrentController.ViewSettings.ZoomValue = 180 'изменение масштаба

[Ципихович Эндрю]

sokol92, ну если так - тогда я на лопатках))
спасибо всем отозвавшимся

[mikekaganski]

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

    If screenWidth = 1919 and screenHeight = 1079 Then

tdf#161844

[Ципихович Эндрю]

mikekaganski - спасибо за ссылку на Mike Kaganski - какое совпадение))
я увы не сильно волоку в такого рода источниках, даже переводчик НЕ помогает)), если поправите буду благодарен:

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

Sub ShowScreenSize()
    Dim screenRectangle As Object
    screenRectangle = CreateUnoService("com.sun.star.awt.Toolkit").getWorkArea()
    MsgBox "Разрешение экрана: " & screenRectangle.Width & " x " & screenRectangle.Height
End Sub

[mikekaganski]

Не очень понимаю, о чём Вы. Увидев размер экрана, который у Вас указан, я проверил у себя и увидел, что действительно getWorkArea возвращает прямоугольник с неправильными размерами. Я написал баг на эту тему (используя слегка модифицированный код из Вашей функции) и исправил его. Об этом и ссылка.

[Ципихович Эндрю]

значит буду жить с 1919 and 1079