Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

15 Апрель 2021, 16:40 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Доступно и просто о работе в офисных пакетах
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Возможно ли задать моноширинный шрифт для окна MsgBox() ?  (Прочитано 952 раз)
0 Пользователей и 1 Гость смотрят эту тему.
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 379


WWW
« Ответ #57571: 26 Февраль 2021, 18:34 »

Даже интересно стало - написал пример для расширяемого окна с моноширинным шрифтом.
Можно задать автоподбор ширины окна (по самой длинной строке текста) и высоты. На моих тестах подбор происходит аккуратно.
Для простоты используется статический диалог "Msgbox" из документа, хотя нетрудно его создать и динамически. Стартовый макрос - TestMyMsgBox.

Код:
Option Explicit
Option Compatible

' Макросы для отображения текста в диалоге.

' --------------------------------------------------------------------------------
' Возвращает объект для диалога.
' Параметры:
' oDoc документ (для диалогов приложения указывать при вызове GlobalScope).
' libName имя библиотеки.
' dlgName имя диалога.
Function GetDialog(Byval oDoc, ByVal libName As String, ByVal dlgName As String)
  Dim oDialog
  On Local Error GoTo ErrLabel
  With oDoc.DialogLibraries
    .loadLibrary(libname)
    oDialog=CreateUnoDialog(.getByName(libName).getByName(dlgName))
  End With
  GetDialog=oDialog 
ErrLabel:
End Function

' --------------------------------------------------------------------------------
' Вызывает диалог Msgbox из библиотеки Standard.
' oDoc документ (для диалогов приложения указывать при вызове GlobalScope).
' Параметры:
' message сообщение.
' title заголовок сообщения.
' width  ширина для Text (>0). 0: автоподбор ширины, -1: не менять.
' height высота для Text (>0). 0: автоподбор высоты, -1: не менять.
Sub MyMsgbox(Byval oDoc, ByVal message As String, ByVal Title As String, _
             Optional ByVal width As Long, Optional ByVal height)
  Dim oDialog, oDialogModel, oControl, size As New com.sun.star.awt.Size
  Dim nCols As Integer, nRows As Integer
  Dim arr, lMax As Long, v, oldVal As Long, i As Long, rows As Long
  Dim wMax As Long, hMax As Long    ' наибольшие ширина и высота для Text.
  If IsMissing(width) Then width=0
  If IsMissing(height) Then height=0
  With CreateUnoService("com.sun.star.awt.Toolkit").WorkArea
    size.width=.width : size.height=.height - 60
  End With 
  oDialog=GetDialog(oDoc, "Standard", "Msgbox")
 
  With oDialog
    oControl=.getControl("Text")
    oDialogModel=.getModel
    size=.convertSizeToLogic(size, 17)
    wMax=size.width
    hMax=size.height
   
    With .getControl("Text").getModel
      If width=0 Then   ' автоподбор ширины
        oldVal=.width
        width=.width
        wMax=wMax - oDialogModel.width + .width
        arr=Split(message, Chr(10))
        lMax=Len(Title)
        For Each v In arr
          If len(v)>lMax Then lMax=len(v)
        Next v
        oControl.getColumnsAndLines nCols, nRows 
        If lMax> nCols Then width=Fix(.width * Cdbl(Lmax) / nCols)
        If width>wMax Then width=wMax
        .width=width
        Do While width<=wmax-5
          oControl.getColumnsAndLines nCols, nRows
          If lMax<=nCols Then Exit Do
          width=width+5
          .width=width
        Loop 
        oDialogModel.width=oDialogModel.width + width - oldVal
      End If  ' автоподбора ширины
     
      width=.width
      If height=0 Then  ' автоподбор высоты
        oldVal=.height
        height=.height
        oControl.getColumnsAndLines nCols, nRows               
        hMax=hMax - oDialogModel.height + .height
        If Not IsArray(arr) Then arr=Split(message, Chr(10))
        rows=0   ' счетчик строк message с учетом переносов
        For Each v In arr
          rows=rows + WrapRows(v, nCols)
        Next v
       
        If rows>nrows Then height=Fix(.height * Cdbl(rows) / nRows)
        If height>hMax Then height=hMax
        .height=height
        Do While height<=hMax-5   ' не хватает
          oControl.getColumnsAndLines nCols, nRows
          If rows<=nRows Then Exit Do
          height=height+5
          .height=height
        Loop
       
        Do While height>=oldval + 5 ' убираем лишнее
          height=height-5
          .height=height
          oControl.getColumnsAndLines nCols, nRows
          If rows>nRows Then Exit Do
        Loop
        height=height+5 
        .height=height 
        oDialogModel.height=oDialogModel.height + height - oldVal
      End If  ' автоподбора высоты
     
      .Text=message
      .ReadOnly=True
    End With
   
    .setTitle title
    .Execute
  End With 
End Sub

' Возвращает число строк при переносе строки s по словам по ширине w
Function WrapRows(ByVal s As String, ByVal w As Long) As Long
  Dim i As Long
  WrapRows=1
  Do While Len(s)>w  ' i - позиция последнего пробела до позиции w
    WrapRows=WrapRows+1
    i=w
    Do While i>0
      If mid(s, i, 1)=" " Then Exit Do
      i=i-1
    Loop
    If i=0 Then i=w+1
    s=Mid(s, i+1)
  Loop   
End Function

' --------------------------------------------------------------------------------
' Тест для MyMsgbox
Sub TestMyMsgbox
  Dim oDoc, s As String
  oDoc=ThisComponent
  s=oDoc.BasicLibraries.getByName("Standard").getByName("ModDialog")
  MyMsgbox oDoc, s, "Модуль ModDialog"
  MyMsgbox oDoc, Left(s, 1000), "Модуль ModDialog (начало)"
  MyMsgbox oDoc, Left(s, 1000), "Модуль ModDialog (начало), ширина 100", 100
End Sub

* TestDialog.ods (11.36 Кб - загружено 3 раз.)
Записан

Владимир.
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!