Убрать незадействанное пространство у документа

Автор Ципихович Эндрю, 7 мая 2024, 11:45

0 Пользователи и 1 гость просматривают эту тему.

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

здравствуйте, решил вернуться к теме, макрос:
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
то есть разрешение экрана можно узнать, масштаб документа можно узнать и можно установить, тогда когда я в коде поставлю условие, если Разрешение экрана: 1920х1080 тогда как высчитать на сколько нужно уменьшить ширину окна документа, чтобы убрать незадействанные два пространства по бокам у документа врайт?
спасибо

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

подскажите, код:
Sub GetWindowSize
    Dim oModel As Object
    oModel = ThisComponent.CurrentController.Frame
    Dim aRect As New com.sun.star.awt.Rectangle
    aRect = oModel.ComponentWindow.getPosSize()
    Dim aRectWidth As Long: Dim aRectHeight As Long
    aRectWidth = aRect.Width: aRectHeight = aRect.Height
    ' MsgBox "Window size: " & aRectWidth & " x " & aRectHeight & " pixels"
    Dim oRect As New com.sun.star.awt.Rectangle
    oRect.X = 0
    oRect.Y = 0
    oRect.Width = aRectWidth - 200
    oRect.Height = aRectHeight
    oModel.ContainerWindow.setPosSize(oRect.X, oRect.Y, oRect.Width, oRect.Height, True)
    aRect = oModel.ComponentWindow.getPosSize()
    ' MsgBox "Window size: " & aRect.Width & " x " & aRect.Height & " pixels"
    If aRectWidth - 200 <> aRect.Width Then MsgBox aRectWidth - 200 & " <> " & aRect.Width
    If aRectHeight <> aRect.Height Then MsgBox aRectHeight & " <> " & aRect.Height
End Sub
я пытаюсь изменить только ширину окна на 200, а на самом деле уменьшается высота, что в нём не так? спасибо