Функция Msgbox - не влезает большой текст

[rami]

Здесь, они оставлены для наглядности и возможного дальнейшего усложнения (все-таки, хочу сделать версию и с текстом и обработкой текста сообщений и кнопок).

Сначала нужно делать обработку данных, если получилось —  делать диалог.

Если буду думать над двух-вариантным расположением кнопок (горизонтально и вертикально), то, скорее всего, будет удобнее не со структурой, а таким же массивом (X, Y, W, H) - мне, почему-то, думается, что так будет удобнее высчитывать координаты по размерам при смене расположения кнопок.

Структуры и массивы нужны только когда их требуют функции или методы, в других случаях их следует избегать у StarBasic очень мало инструментов для работы с массивами.

[Tigrik]

В Диалоге с кнопками, все-таки, хотелось что бы была проверка текста (и для сообщения, и для надписей кнопок).
Проверка будет самой простой - влезает ли строка из текста в те ограничения по количеству символов, которые получились в макросе с Диалогом и подсчёт максимальной длины строки в тексте сообщения или на кнопках.
Если строка длиннее, чем ограничитель - MaxChar (это, в основном, будет более актуально для кнопок, если их будет много - они будут не очень широкими), тогда "включается" доп функция SplitBigString.
Она убирает лишние пробелы между словами и если это будет необходимо, то "разобьет" слово, которое длиннее, чем ограничитель. Возможно, в каких-то случаях, будет достаточно "подчистить" в тексте лишние пробелы и обновленная строка влезет в "габариты".
Может такое случится, что к "остатку", который не влез в строку, можно было бы прибавить следующую строку, но я подумал, что это не нужно - пользователь (если таковой найдется, что бы применять эти макросы) в своём тексте мог специально, по своим соображениям, отделять их друг от друга - пусть так и остается. В макросе есть возможность (закомментарил) убирать полностью пустые строки.

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


REM  *****  BASIC  *****

Sub CheckStringProc()
Dim MaxChar%, strText$, tt(), s$
strText = InputBox ("Введите любой текст: ", "Проверка функции CorrectText")
MaxChar = InputBox ("Введите число - ограничение на длину строки: ", "Проверка функции CorrectText")
tt() = CorrectText(strText$, MaxChar%)
s = "Было введен текст: " & chr(10) & strText & chr(10) & String(30, "-") & chr(10) & _
"Ограничение по количеству символов в строке: " & MaxChar & chr(10) &_
"Длина введенного текста: " & Len(strText) & chr(10) & chr(10) & _
"ПОЛУЧИЛОСЬ =>" & chr(10) & "Новый текст: " & chr(10) & tt(0) & chr(10) & String(30, "-") & chr(10) & _
"Длина полученного текста: " & Len(tt(0)) & chr(10) & "Максимальная длина строки: "  & tt(1)
Msgbox s
End Sub


Function CorrectText(strText$, MaxChar%) As Object
Dim aBT(), aBW() '   Массивы для строк текста и для слов в строке
Dim sW$, sNew$ '   Строки: каждая строка из старого текста и Новый Текст
Dim MaxLenStr%, sumLens%, strLen%, tempLen% '   Длины: Максимальная, Сумма, Слова в строке, для подсчета Суммы
Dim del$, i%, j%
aBT() = Split(Join(Split(strText, chr(13)), chr(10)), chr(10)) '  Если есть символы chr(13)), то заменяем их на chr(10)
For i = 0 To UBound(aBT()) '  ПО СТРОКАМ
strLen = Len(aBT( i )) '  Длина строки в первоначальном тексте
' If strLen Then '  Можно включить, если нужно убирать полностью пустые строки
'   Если длина строки длиннее MaxChar символов, тогда "Сборка" строки из слов
If strLen > MaxChar Then aBT( i ) = SplitBigString(Trim(aBT( i )), MaxChar)
'   Если обработка строки не помогла
If Len(aBT( i )) > MaxChar Then
sW = ""
aBW() = Split(aBT( i ), " ")
For j = 0 To UBound(aBW()) '   ПО СЛОВАМ
strLen = Len(aBW( j )) '   Длина слова
If sumLens + strLen > MaxChar Then '   Текущее слово уже не влезает в новую строку
tempLen = 0
del = chr(10)
If MaxLenStr < MaxChar Then MaxLenStr = IIf(MaxLenStr < sumLens - 1, sumLens - 1, MaxLenStr)
Else '   Строка ещё не набрана
tempLen = sumLens
del = " "
EndIf
If j = 0 Then del = "" '   В самом начале строки нет разделителя
sW = sW & del & aBW( j ) '   "Накопительная" преобразованная строка из первоначального текста
sumLens = tempLen + strLen + 1
Next
sumLens = 0
Else
sW = aBT( i ) ' Иначе, строка полностью переносится в строку Нового Текста
If MaxLenStr < MaxChar Then MaxLenStr = IIf(MaxLenStr < Len(sW), Len(sW), MaxLenStr)
EndIf
del = IIf(i = 0, "", chr(10)) '   В самом начале нового текста нет разделителя
sNew = sNew & del & sW '   Обработанная строка вошла в новый текст
' EndIf
Next
CorrectText = Array(sNew, MaxLenStr)
End Function


Function SplitBigString(strBigText$, MaxChar%, Optional del$) As String
  Dim aBT(), s$, strElem$, i%, nn%
If IsMissing(del) Then del = " " '   По умолчанию, разделитель в строке - пробел
aBT() = Split(strBigText, del)
nn = UBound(aBT())
For i = 0 To nn
aBT( i ) = Trim(aBT( i ))
If Len(aBT( i )) Then
If Len(aBT( i )) > MaxChar Then strElem = InsertDelWord(aBT( i ), MaxChar, " ") Else strElem = aBT( i )
If i = nn Then del = "" '   В самом конце строки нет разделителя
s = s & strElem & del
EndIf
Next
SplitBigString = s
End Function


Function InsertDelWord(strWord$, MaxChar%, del$) As String
Dim i%, j%, s$
j = Len(strWord)
For i = 1 To j Step MaxChar : s = s & Mid(strWord, i, MaxChar) & del : Next
InsertDelWord = Left(s, j + (j / MaxChar - 0.501)) '   Удаление последнего (лишнего) разделителя
End Function


Первый макрос - он проверочный, только для тестирования. В ходе тестирования, мне было удобнее смотреть: первоначальный текст и его длина и что получилось, если задать определенный ограничитель. Я оставил этот шаблон.

Функция InsertDelWord, хоть и не большая, но мне почему-то думается, что есть стандартная функция или другое решение, но ничего не нашёл. Да, особо и не искал - эта функция на полчаса работы.
Может быть, и функцию SplitBigString, также, можно как-то по другому, попроще "решить" - хотя и так не очень сложно получилось. И получились они немного "универсальными" - можно задавать различные разделители.
Возможно, эти функции можно было через регулярные выражения "пропустить", но я, пока, ими ещё не занимался.

Меня немного "смущает" некоторая громоздкость основной функции CorrectText. Её главная задача - это "собирать" строки из слов - не сложная задача, но получился, на мой взгляд, большой код.

[rami]

Меня немного "смущает" некоторая громоздкость основной функции CorrectText. Её главная задача - это "собирать" строки из слов - не сложная задача, но получился, на мой взгляд, большой код.

Из трёх ваших функций можно сделать одну в три раза короче, но зачем это нужно если при правильной настройке элемента управления текст сам распределяется как надо?

[Tigrik]

Меня немного "смущает" некоторая громоздкость основной функции CorrectText. Её главная задача - это "собирать" строки из слов - не сложная задача, но получился, на мой взгляд, большой код.

Из трёх ваших функций можно сделать одну в три раза короче, но зачем это нужно если при правильной настройке элемента управления текст сам распределяется как надо?

Я и не сомневался, что есть более простой код, но, пока, не знаю как его сделать.
Rami, если Вам не трудно, скажите, пожалуйста, - это можно сделать по такому же алгоритму, но более "совершенными" методами и стандартными функции или есть другой алгоритм?
---
А правильная настройка текста - это опция "Переносить текст", как в Calcе? Текст "дробится" по ширине ячейке и увеличивается высота ячейки, если количество строк увеличивается.
В редакторе Диалогов нашел возможность включить "Разрыв слова" - да, текст, если не помещается в заданную ширину элемента, то переносится на другие строки, но высота, при этом, не меняется. Получается, что и с этой возможностью нужно узнавать количество полученных таким образом строк - иначе не задать правильную высоту элемента управления.
Или есть ещё какие-то возможности при работе с текстами в Диалогах, которые способны решать такие задачи (я не нашёл)?

[rami]

это можно сделать по такому же алгоритму, но более "совершенными" методами и стандартными функции или есть другой алгоритм?

Про ваш алгоритм ничего не скажу (не читал, но осуждаю), но я использовал функции InStr и Mid, уложился в 18 строк кода (без двоеточий ). Могу показать.

Или есть ещё какие-то возможности при работе с текстами в Диалогах, которые способны решать такие задачи (я не нашёл)?

Используйте UnoControlEditModel с настройками MultiLine, ReadOnly, VScroll. С прокруткой можно размещать многотомные собрания сочинений в разумных размерах.

[Tigrik]

это можно сделать по такому же алгоритму, но более "совершенными" методами и стандартными функции или есть другой алгоритм?

Про ваш алгоритм ничего не скажу (не читал, но осуждаю), но я использовал функции InStr и Mid, уложился в 18 строк кода (без двоеточий ). Могу показать.

Покажите, пожалуйста.

Или есть ещё какие-то возможности при работе с текстами в Диалогах, которые способны решать такие задачи (я не нашёл)?

Используйте UnoControlEditModel с настройками MultiLine, ReadOnly, VScroll. С прокруткой можно размещать многотомные собрания сочинений в разумных размерах.

Спасибо. Буду пробовать.

[rami]

Обратите внимание, что InputBox не подходит для вставки текста с абзацами, т.к. он однострочный. Я заменил его на строку с переводами строк.

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

Sub CheckStringProc()
Dim MaxChar%, strText$, tt(), s$
strText = "Функция InsertDelWord, хоть и не большая, но мне почему-то думается, что есть стандартная функция или другое решение, но ничего не нашёл. Да, особо и не искал - эта функция на полчаса работы." & chr(10) & chr(10) & _
"Может быть, и функцию SplitBigString, также, можно как-то по другому, попроще 'решить' - хотя и так не очень сложно получилось. И получились они немного 'универсальными' - можно задавать различные разделители." & chr(10) & _
"Возможно, эти функции можно было через регулярные выражения 'пропустить', но я, пока, ими ещё не занимался." ' Это текст с форума."

'strText = InputBox ("Введите любой текст: ", "Проверка функции CorrectText")
MaxChar = InputBox ("Введите число - ограничение на длину строки: ", "Проверка функции CorrectText")
tt() = CorrectText(strText$, MaxChar%)
s = "Был введен текст: " & chr(10) & strText & chr(10) & String(30, "-") & chr(10) & _
"Ограничение по количеству символов в строке: " & MaxChar & chr(10) &_
"Длина введенного текста: " & Len(strText) & chr(10) & chr(10) & _
"ПОЛУЧИЛОСЬ =>" & chr(10) & "Новый текст: " & chr(10) & tt(0) & chr(10) & String(30, "-") & chr(10) & _
"Длина полученного текста: " & Len(tt(0)) & chr(10) & "Максимальная длина строки: "  & tt(1)
Msgbox s
End Sub

Function CorrectText(strText$, MaxChar%)
Dim newText$, i%, j%, lf%, limit%
newText = replace(strText, chr(13), chr(10))
limit = MaxChar
Do While j < len(strText)
j = InStr(i+1, newText, " ")
If j = 0 Then j = len(strText) +1
If j > limit Then
mid(newText, i, 1, chr(10))
limit = i + MaxChar
lf = InStr(i+1, newText, chr(10))
If lf = 0 Then lf = len(strText) +1
If limit > lf Then limit = lf + MaxChar
End If
i = j
Loop
CorrectText = array(newText, "Заглушка")
End Function

[Tigrik]

Обратите внимание, что InputBox не подходит для вставки текста с абзацами, т.к. он однострочный. Я заменил его на строку с переводами строк.

Спасибо большое. Буду изучать.

[Tigrik]

Классно работает, но на длинном слове, почему-то спотыкается.

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


strText = "Электровоздухораспределитель - это очень длинное слово!"

Это у меня тест для проверки разбивки слова.
Вообщем-то, можно прицепить (где это нужно) третью функцию (в моём примере - InsertDelWord).

[rami]

Если сделать ширину меньше 29 символов? Раньше были мастера, которые писали библию на рисовом зёрнышке, нужно у них поучиться

[Tigrik]

Немного отвлеклся.
Ещё раз благодарю Rami за предоставленный макрос. Мне он очень облегчил работу над анализом строк. С этими "лупоглазыми" инструкциями (Do...Loop) я всего пару "сталкивался", но оказалось очень удобным.
Правда, обнаружились два момента.

Первый - скорее всего, обычная "очепятка".
Указатель j определяет место текущего пробела между словами (то есть, как бы, слово с пробелом), а limit - ограничитель по количеству символов, поэтому при проверке j > limit из-за этого пробела "собираемая" строка на один символ меньше.
Скорее всего, там пропущено "+1": j > limit + 1

Второй момент не такой однозначный - он не всегда проявляется.
Вероятнее всего, это связано с указателем конца строки lf - в предложенной функции (он остался под наименованием CorrectText) - этот указатель поздно "включается", что приводит к неточности просчета.
В тестовой процедуре есть две проверочные строки текста и запускаются две функции. Вторая функция (LayoutAllStringsWords) "построена" на алгоритме, предложенном Rami, но, здесь, lf является основным указателем для выхода из инструкций и просчитывается с самого начала.
Удалось добавить "разбивку" слова на нужные фрагменты (можно, даже, по одному символу в строке), но программный код существенно увеличился. Возможно, можно будет как-то его сократить - подумаю ещё.

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


Sub CheckStringProc()
Dim MaxChar%, strText$, tt(), tS01$, tS02$, s$, sF$
strText = "Одна строка" & chr(10) & "Другая строка" '   Только если MaxChar больше 19, первая строка остается целиком
' strText = "В строке - 22 символа." & chr(10) & "Только при MaxChar больше 30 первая строка целиком размещается на строчке." & chr(10) & "Но появляются проблемы со второй строкой."
MaxChar = InputBox ("Введите число - ограничение на длину строки: ", "Проверка функции CorrectText")
tt() = CorrectText(strText$, MaxChar%)
tS01 = tt(0)
tt() = Array(LayoutAllStringsWords(strText$, MaxChar%), "Не известно!")
tS02 = tt(0)
For i = 0 To 1
s = IIf(i, tS02, tS01)
tt() = Array(s, "Заглушка")
sF = IIf(i, "LayoutAllStringsWords", "CorrectText")
s = "Проверка функции - " & sF & chr(10) & String(30, "=") & chr(10) & _
"Был введен текст: " & chr(10) & strText & chr(10) & String(30, "-") & chr(10) & _
"Ограничение по количеству символов в строке: " & MaxChar & chr(10) &_
"Длина введенного текста: " & Len(strText) & chr(10) & chr(10) & _
"ПОЛУЧИЛОСЬ =>" & chr(10) & "Новый текст: " & chr(10) & tt(0) & chr(10) & String(30, "-") & chr(10) & _
"Длина полученного текста: " & Len(tt(0)) & chr(10) & "Максимальная длина строки: "  & tt(1)
Msgbox s
Next
End Sub


Function CorrectText(strText$, MaxChar%)
Dim newText$, i%, j%, lf%, limit%
newText = replace(strText, chr(13), chr(10))
limit = MaxChar
Do While j < len(strText)
j = InStr(i+1, newText, " ")
If j = 0 Then j = len(strText) +1
If j > limit Then
mid(newText, i, 1, chr(10))
limit = i + MaxChar
lf = InStr(i+1, newText, chr(10))
If lf = 0 Then lf = len(strText) +1
If limit > lf Then limit = lf + MaxChar
End If
i = j
Loop
CorrectText = array(newText, "Заглушка")
End Function


Function LayoutAllStringsWords(strText$, MaxChar%) As String
Dim newText$, i%, j%, lf%, limit%
Dim lenWord%, sWord$, nPlus%, iW%
newText = replace(strText, chr(13), chr(10))
Do While lf < len(newText)
limit = i + MaxChar
lf = InStr(i+1, newText, chr(10))
If lf = 0 Then lf = len(newText) +1
Do While lf > limit + 1
j = InStr(i+1, newText, " ")
If j = 0 Then j = len(newText) +1
If j > lf Then j = lf
If j > limit + 1 Then
lenWord = j - i - 1
sWord = mid(newText, i + 1, lenWord)
If lenWord > MaxChar Then
nPlus = lenWord / MaxChar - 0.501
For iW = MaxChar To Len(sWord) + nPlus - 1 Step MaxChar + 1
sWord = Left(sWord, iW) & chr(10) & Right(sWord, Len(sWord) - iW)
Next
newText = Left(newText, i) & sWord & Right(newText, Len(newText) - j + 1)
EndIf
If i Then mid(newText, i, 1, chr(10))
limit = i + MaxChar * (nPlus + 1) + nPlus
If limit > lf Then limit = lf + MaxChar
End If
lf = lf + nPlus
j = j + nPlus
i = j
nPlus = 0
Loop
i = lf
Loop
LayoutAllStringsWords = newText
End Function


[Tigrik]

Для макроса Диалога с кнопками нужен подсчёт максимальной длины строки текста и количество строк. Со вторым - ноу проблем.
С длиной строки, также, не очень тяжело, но появилась дилемма. Вставить этот просчёт в тот макрос, где происходит основная компоновка строк (при этом как-то "некрасиво" усложняется код) ИЛИ запустить это отдельным циклом, уже после сборки строк текста. Решил, что, пока, не буду усложнять функцию сборки строк - там только "разбивка" слов (если нужно) и "сборка" строк.

Но в данном примере, тоже некоторая дилемма между выбором двух похожих элементов кода.
Первая процедура - это часть макроса Диалога, где необходим анализ текста сообщений и надписей на кнопках.
Понятно, что, как говориться, "на вкус и цвет все фломастеры разные" - то есть каждый выбирает, что ему подходит. Но я стараюсь делать, по большей части, в одном цикле, если это можно, но, в данном случае, второй вариант намного легче, компактнее и понятен, но два раза повторяет один и тот же (почти тот же) цикл.
Здесь используется "облегченная" версия функции по сборке строк (LayoutOneStringWords) - там анализируется только одно строка и убраны лишние действия.

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


Sub PartMacroDlgStr()
Dim strText$, MaxChar%, numStrMess%, lenStrMess% '   Текст, Ограничитель по символам, кол-во строк, Макс.длина строки для Сообщения
Dim aTextButt$(), MaxCharButt%, numStrButt%,lenStrButt% '   Тоже самое, для Кнопок
Dim tt(), lenStr%, i%, tt2(), j%, s$
strText = "Первая строка текста сообщения." & chr(10) & "Вторая строка для текста." & chr(10) & "Третья строка"
'strText = "Электровоздухораспределитель - это очень длинное слово!"
aTextButt$() = Array("Первая кнопка", "Вторая кнопка", "Ещё одна кнопка", "Кнопка в двумя строками" & chr(10) & "Вторая строка надписи", "Крайняя кнопка", )
MaxChar = 20
strText = replace(strText, chr(13), chr(10))
'=========    ПЕРВЫЙ ВАРИАНТ анализа строк текста сообщения
tt() = Split(strText, chr(10))
For i = 0 To UBound(tt())
lenStr = Len(tt(i))
If lenStr > MaxChar Then '   Компоновка тех строк, где длина превышает Ограничитель
tt(i) = LayoutOneStringWords(tt(i), MaxChar)
tt2() = Split(tt(i), chr(10))
For j = 0 To UBound(tt2()) '   Поиск максимальной длины строки
lenStr2 = Len(tt2(j))
lenStrMess = IIf(lenStr2 > lenStrMess, lenStr2, lenStrMess)
Next
Else '   Поиск максимальной длины строки, если не нужна компоновка
lenStrMess = IIf(lenStr > lenStrMess, lenStr, lenStrMess)
EndIf
Next
s = Join(tt(), chr(10))
numStrMess = UBound(Split(s, chr(10))) + 1
s = "Был введен текст: " & chr(10) & strText & chr(10) & String(30, "-") & chr(10) & _
"Ограничение по количеству символов в строке: " & MaxChar & chr(10) &_
"Длина введенного текста: " & Len(strText) & chr(10) & chr(10) & _
"ПОЛУЧИЛОСЬ =>" & chr(10) & "Новый текст: " & chr(10) & s & chr(10) & String(30, "-") & chr(10) & _
"Длина полученного текста: " & Len(s) & chr(10) & "Максимальная длина строки: "  & lenStrMess & chr(10) & _
"Количество строк в тексте: " & numStrMess
Msgbox s
'=========    ВТОРОЙ ВАРИАНТ анализа строк текста сообщения
tt() = Split(strText, chr(10))
For i = 0 To UBound(tt()) '   Компоновка тех строк, где длина превышает Ограничитель
If Len(tt(i)) > MaxChar Then tt(i) = LayoutOneStringWords(tt(i), MaxChar)
Next
tt() = Split(Join(tt(), chr(10)), chr(10))
For i = 0 To UBound(tt()) '   Поиск максимальной длины строки
lenStr = Len(tt(i))
lenStrMess = IIf(lenStr > lenStrMess, lenStr, lenStrMess)
Next
numStrMess = i
s = Join(tt(), chr(10))
s = "Был введен текст: " & chr(10) & strText & chr(10) & String(30, "-") & chr(10) & _
"Ограничение по количеству символов в строке: " & MaxChar & chr(10) &_
"Длина введенного текста: " & Len(strText) & chr(10) & chr(10) & _
"ПОЛУЧИЛОСЬ =>" & chr(10) & "Новый текст: " & chr(10) & s & chr(10) & String(30, "-") & chr(10) & _
"Длина полученного текста: " & Len(s) & chr(10) & "Максимальная длина строки: "  & lenStrMess & chr(10) & _
"Количество строк в тексте: " & numStrMess
Msgbox s
End Sub


Function LayoutOneStringWords(strText$, MaxChar%) As String
Dim newText$, i%, j%, lf%, limit%
Dim lenWord%, sWord$, nPlus%, iW%, lenStrMax%
newText = replace(strText, chr(13), chr(10))
limit = MaxChar
Do While j < len(newText)
j = InStr(i+1, newText, " ")
If j = 0 Then j = len(newText) +1
If j > limit + 1 Then '   Если указатель превышает установленное ограничение
lenWord = j - i - 1
sWord = mid(newText, i + 1, lenWord)
If lenWord > MaxChar Then '   Если текущее слово длиннее, чем MaxChar
nPlus = lenWord / MaxChar - 0.501
For iW = MaxChar To Len(sWord) + nPlus - 1 Step MaxChar + 1
sWord = Left(sWord, iW) & chr(10) & Right(sWord, Len(sWord) - iW)
Next
newText = Left(newText, i) & sWord & Right(newText, Len(newText) - j + 1)
EndIf
If i Then mid(newText, i, 1, chr(10)) '   Если первое слово приходится 'разбивать', то перед ним ничего не ставим
limit = i + MaxChar * (nPlus + 1) + nPlus
End If
j = j + nPlus '   Увеличение указателя на количество пробелов в 'разбитом' слове
i = j
nPlus = 0
Loop
LayoutOneStringWords = newText
End Function


По данному примеру - есть ли какие-нибудь рекомендации в плане "стиля" или "негласных" правил программирования?
Какой вариант более "стильный"?

[rami]

Код выглядит нормально, какой из вариантов выбрать, не важно, лишь бы оба работали.