Обычно размеры точно под текст не подгоняют, делают размеры с запасом.
Давайте образец диалога со всеми потрохами.
Да, конечно, я так и буду делать с запасом.
Когда "соберу" в удобной, для показа, "упаковке", выложу на форум.
В моём макросе нужен был небольшой диалог, где будет только текст и три кнопки со своими событиями. Msgbox - хорошая функция (даже есть четыре кнопки), но нужны были свои надписи на кнопках.
Даже программно такой диалог не долго "строится", но появилась идея сделать универсальный макрос (мне нравится делать универсальные программы).
На входе будет один обязательный параметр - массив текстов для кнопок и два необязательных параметров: заголовок для диалога и строка текста сообщения.
Предлагаю на всеобщее обозрение самый простой вариант этого макроса (надо немного оптимизировать расчеты и убрать лишние параметры - после того, когда макрос будет полностью готов, цвет тоже можно убрать - нужен только, что бы видеть поле текста). Может быть, кому-нибудь пригодится и такой вариант или на основе этого сделать что-то своё.
Другой вариант, чуть посложнее - уже тестируется анализ текстов для сообщения и на кнопках - длинные строки или даже слова разбивать на подстроки.
В основной процедуре закомментированы вводные параметры для отладки - они должны вызывать разные ошибки.
REM ***** BASIC *****
Dim oDlg 'Объект Диалог
Sub Start_Dlg_MsgButton()
Dim aTextButtom(), strDlgTitle$, strDlgMess$, onRezult%
aTextButtom() = Array("ДА", "НЕТ", "Надо подумать!!!")
strDlgTitle = "Окно Диалога с кнопками"
strDlgMess = "Текст сообщения может быть длинным!" & chr(10) & "А нужно выбрать одну кнопку."
' aTextButtom() = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15") ' Большое кол-во кнопок
' aTextButtom() = Array("ДА", "НЕТ", String(56+1, "A")) ' Большой текст на Кнопке для проверки ошибки
' strDlgMess = String(180+1, "A") ' Большой текст Сообщения для проверки ошибки
' For onRezult = 1 To 45+1 : strDlgMess = strDlgMess & "A" & chr(10) : Next ' Большое кол-во строк Сообщения
' onRezult = Dlg_MsgButton_Light(Array("Запустить какую-то программу", "Взять какие-то данные", "Что-нибудь ещё")) ' Только кнопки
onRezult = Dlg_MsgButton_Light(aTextButtom(), strDlgTitle, strDlgMess)
Select Case onRezult
Case -2 : Msgbox "Большое количество кнопок!", 0, "Ошибка!"
Case -1 : Msgbox "Очень большой текст!", 0, "Ошибка!"
Case 0 : Msgbox "Выход без кнопки!"
Case Else : Msgbox ("Нажата кнопка № " & onRezult)
End Select
End Sub
Sub Dlg_MsgButton_Light(aTextButton(), Optional strDlgTitle$, Optional strDlgMess$) As Integer
Dim oDlgModel, oModel, oListener, DlgRez
Dim SizeDlg(1 To 2) As Long ' Размер Окна Диалога
Dim strFullText$(1), aText(), sTextMesNew, i&, j&, varTemp, strTemp
Dim DeltaXY& ' Отступ в Окне Диалога
Dim aTxProp(1, 7) ' 0 - Кол-во кнопок (только для 2-го массива); 1 - Кол-во строк; 2 - Макс.длина строки;
' 3 - Ширина; 4 - Высота; 5 - Расст. по X; 6 - Расст. по Y; 7 - всего символов на кнопках (актуально для 2-го массива) или в сообщении
Dim oWindow, ATWSize
oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
ATWSize = oWindow.ActiveTopWindow.Size ' Размеры Окна Windows в пикселях
oDlgModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
oDlgModel.setPropertyValue("Title", strDlgTitle)
'///////////////////////////////////////////
' Попытка поменять шрифт
Dim aFontDecs
Dim sNameFontDlg$
sNameFontDlg = "DejaVu Sans Mono"
aFontDecs = oDlgModel.FontDescriptor
aFontDecs.Name = sNameFontDlg
aFontDecs.Height = 10 : aFontDecs.Slant = 2 : aFontDecs.Weight = 200 : aFontDecs.Kerning = True
oDlgModel.FontDescriptor = aFontDecs
'///////////////////////////////////////////
oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
oDlg.setModel(oDlgModel)
oDlg.createPeer(oWindow, null)
'///////////////////////////////////////////
Dim xD&, yD&, wD&, hD& ' Координаты (X и Y) и размеры (ширина и высота) Окна Диалога
Dim indXY& ' Расстояние (по X и Y) от границы Экрана Монитора до Окна Диалога
Dim maxXD&, maxYD& ' Максимальные размеры Окна Диалога
Dim hStBut& ' Высота одно-строчной кнопки
Dim minCharButt, maxButt% ' Мин. кол-во символов для кнопки и макс. кол-во кнопок
Dim wChar!, hChar! ' Ширина и Высота Символа
Dim maxCharX%(1), maxCharY%(1) ' Макс.кол-во символов в строке и макс.кол-во строк в Сообщении и на Кнопке
Dim ConvSize, wCWin%, hCWin% ' Размеры (ширина и высота) Окна Windows после Конвертации от Размеров Монитора в пикселях
ConvSize = oDlg.convertSizeToLogic(ATWSize, 18)
wCWin = ConvSize.Width : hCWin = ConvSize.Height
DeltaXY = 12 : indXY = 24
wChar = 5 : hChar = 8 : hStBut = 3 * hChar / 2
maxXD = wCWin - indXY * 2 : maxYD = hCWin - indXY * 2
maxCharX(0) = maxXD / wChar : maxCharY(0) = (maxYD - DeltaXY - hStBut) / hChar ' Пока, ориентировочные формулы
maxCharX(1) = (maxXD - (UBound(aTextButton()) + 2) * DeltaXY) / (UBound(aTextButton()) + 1) / wChar : maxCharY(1) = 1
minCharButt = 8 : maxButt = (maxXD - DeltaXY) / (DeltaXY + minCharButt * wChar)
'///////////////////////////////////////////
If IsMissing(strDlgTitle) Then strDlgTitle = ""
If IsMissing(strDlgMess) Then strDlgMess = "" Else strDlgMess = Join(Split(strDlgMess, chr(13)), chr(10))
If UBound(aTextButton()) + 1 > maxButt Then Dlg_MsgButton_Light=-2 : Exit Sub 'Ошибка - превышено кол-во кнопок
REM ========= По максимальной длине строки (сообщения или текстов кнопок) вычисляются ширины (текста или кнопок)
Dim nn%
strFullText(0) = strDlgMess : strFullText(1) = Join(aTextButton(), chr(10))
For i = 0 To 1
aText() = Split(Trim(strFullText( i )), chr(10))
nn = UBound(aText())
If i = 0 Then If nn+1 > maxCharY(0) Then Dlg_MsgButton_Light=-1 : Exit Sub 'Ошибка - превышена длина строк (в сообщении или на кнопке)
aTxProp(i, ((i+1) Mod 2)) = nn + 1 ' Кол-во Строк для Сообщения или кол-во Кнопок
For j = LBound(aText()) To nn
strTemp = Trim(aText( j )) : aText( j ) = strTemp : varTemp = Len(strTemp)
If varTemp > maxCharX( i ) Then Dlg_MsgButton_Light=-1 : Exit Sub'Ошибка - превышено кол-во символов в строке (в сообщ-ии, на кнопке)
'aTxProp(i, 7) = aTxProp(i, 7) + varTemp ' Всего кол-во символов: в Сообщении или на Кнопках == пока не используется
aTxProp(i, 2) = IIf(aTxProp(i, 2) < varTemp, varTemp, aTxProp(i, 2))' Макс. длина строки в строках Сообщения или на Кнопках
Next
If i = 0 Then sTextMesNew = Join(aText(), chr(10)) Else aTextButtonNew() = Split(Join(aText(), chr(10)), chr(10))
Next
REM ========= Координаты и размеры текста, кнопок, окна диалога
aTxProp(0, 1) = UBound(Split(sTextMesNew, chr(10))) + 1 ' 0, 1 - кол-во Строк Сообщения
aTxProp(1, 0) = UBound(aTextButtonNew()) + 1 ' 1, 0 - кол-во Кнопок
aTxProp(1, 1) = 1 ' Пусть, пока, будет одна строка текста на кнопке
aTxProp(0, 4) = (aTxProp(0, 1)) * (hChar) : aTxProp(1, 4) = (aTxProp(1, 1)) * hChar + hChar/2 ' Высота Текста Сообщ-я и Высота Кнопки
aTxProp(0, 3) = aTxProp(0, 2) * wChar : aTxProp(1, 3) = aTxProp(1, 2) * wChar ' Ширина Текста Сообщения и Ширина Кнопки
SizeDlg( 2 ) = aTxProp(0, 4) + aTxProp(1, 4) + DeltaXY ' 2 - Высота Диалога
' Если текст шире, чем все кнопки
If (aTxProp(1, 3) * aTxProp(1, 0) + DeltaXY * (aTxProp(1, 0) - 1)) < aTxProp(0, 3) Then
aTxProp(0, 5) = DeltaXY ' 0, 5 - расст. до текста = DeltaX (по оси X)
SizeDlg( 1 ) = aTxProp(0, 5) * 2 + aTxProp(0, 3) ' 1 - Ширина Диалога
aTxProp(1, 5) = (SizeDlg( 1 ) - aTxProp(1, 3) * aTxProp(1, 0)) / (aTxProp(1, 0) + 1) '1, 5 - расстояние до Кнопки (по оси X)
Else
aTxProp(1, 5) = DeltaXY ' 1, 5 - расст. до кнопки = DeltaX (по оси X)
SizeDlg( 1 ) = aTxProp(1, 3) * aTxProp(1, 0) + DeltaXY * (aTxProp(1, 0) + 1) ' 1 - Ширина Диалога
aTxProp(0, 5) = (SizeDlg( 1 ) - aTxProp(0, 3)) / 2 ' 0, 5 - расстояние до Текста (по оси X)
EndIf
aTxProp(0, 6) = 0 ' 0, 6 - расст. до Текста (по оси Y)
varTemp = (SizeDlg( 2 ) - (aTxProp(0, 6) + aTxProp(0, 4) + aTxProp(1, 4))) / 2
aTxProp(1, 6) = aTxProp(0, 6) + aTxProp(0, 4) + varTemp ' 1, 6 - расст. до Кнопки (по оси Y)
REM ========= Координаты и Размеры Окна Диалога
xD = (wCWin - SizeDlg( 1 )) / 2 : yD = (hCWin - SizeDlg( 2 )) / 2
wD = SizeDlg( 1 ) : hD = SizeDlg( 2 )
oDlgModel.setPropertyValue("PositionX", Clng(xD)) : oDlgModel.setPropertyValue("PositionY", Clng(yD))
oDlgModel.setPropertyValue("Width", wD) : oDlgModel.setPropertyValue("Height", hD)
REM ========= Установить модель элемента управления (текстовой сообщение) в Модель Диалога
oModel = oDlgModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
oModel.setPropertyValues( Array("PositionX", "PositionY", "Width", "Height", "Label", "Align", "VerticalAlign", "BackgroundColor"), _
Array(Clng(aTxProp(0, 5)), Clng(aTxProp(0, 6)), Clng(aTxProp(0, 3)), Clng(aTxProp(0, 4)), sTextMesNew, 1, 1, &HFFFF00 ) )
oDlgModel.insertByName("TextMessage",oModel)
oListener = CreateUnoListener("Button_", "com.sun.star.awt.XActionListener") ' Установить Обработчик Событий (для кнопки)
REM ========= Задать свойства элемента управления (кнопки) в Модель Диалога
For i = 1 To aTxProp(1, 0)
varTemp = Clng(aTxProp(1, 5) * i + aTxProp(1, 3) * ( i - 1 )) : strTemp = aTextButtonNew( i - 1)
my_createInsertControl(oDlgModel, Array("Type", "com.sun.star.awt.UnoControlButtonModel", "Name", "ComButton" + i, _
"Label", strTemp, "BackgroundColor", &HFFA500, _
"PositionX", varTemp, "PositionY", aTxProp(1, 6), "Width", aTxProp(1, 3), "Height", aTxProp(1, 4), "TabIndex", i, _
"Align", 1, "VerticalAlign", 1, "Tabstop", True, "PushButtonType", com.sun.star.awt.PushButtonType.STANDARD))
oDlg.getControl("ComButton" & i).addActionListener(oListener)
Next
Dlg_MsgButton_Light = oDlg.execute()
End Sub
Sub Button_actionPerformed(ActionEvent)
oDlg.endDialog(ActionEvent.Source.Model.TabIndex)
End Sub
Из нерешенного - не получается придать шрифт всей модели диалога и, затем, ещё найти возможность поточнее считать знакоместо (высоту и ширину) для символа (сейчас, эти значения - подобраны эмпирическим методом).
И, конечно, хотелось бы услышать замечания и поправки - ошибки и неточности, наверняка, где-нибудь "притаились".
