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

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

20 Сентябрь 2020, 21:19 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Здесь можно поблагодарить участников форума Улыбка
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: « 1 2 3   Вниз
  Печать  
Автор Тема: Функция Msgbox - не влезает большой текст  (Прочитано 3586 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Tigrik
Форумчанин
***
Offline Offline

Сообщений: 94


« Ответ #55089: 29 Июнь 2020, 20:44 »

Немного отвлеклся.
Ещё раз благодарю 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
Записан
Страниц: « 1 2 3   Вверх
  Печать  
 
Перейти в:  

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