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
|
Код выглядит нормально, какой из вариантов выбрать, не важно, лишь бы оба работали.
|
|
|
Записан
|
|
|
|
|