Выравнивание строки текста по ширине

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Ruslan Demidow
Мужчина!
Мужчина!
Аватара пользователя
 
Сообщения: 987
Зарегистрирован: 25.03.2004 (Чт) 13:39
Откуда: N.Novgorod

Выравнивание строки текста по ширине

Сообщение Ruslan Demidow » 22.02.2005 (Вт) 13:19

Вот возникла необходимость реализовать в своем редакторе сообщений выравнивание строк текста по ширине.
В качестве контрола для вывода текста я использую RichTextBox (или RichTextEdit, кто как называет...), в дальнейшем RTB.

У RTB есть метод .SelAlignment, который в качестве параметров имеет rtfLeft, rtfRight и rtfCenter. А мне нужно по ширине. Такого параметра не нашёл. Значит, видимо, придётся делать ручками.
Начал думать (т.е. скорей всего изобретать велосипед). :oops:

Алгоритм представляется таким:
Берём строку текста.
Определяем её длину в символах.
Определяем разницу в длине между лимитом длины строки (ну, например, 80 символов).
Если разница равна 0 (нулю или меньше нуля), тогда переходим к следующей строке и всё сначала.
Если разница больше нуля - значит эта разница содержит количество пробелов (мне думается так и организовывается выравнивание по ширине во многих редакторах), которые нужно вставить между словами в строке.
Дальше разбиваем строку на слова и добавляем количество необходимых пробелов.
А вот тут у меня заковыка происходит: не могу допетрить как распределить пробелы между словами. Ведь где-то нужно вставить два пробела, где-то три, а где-то и вообще не нужно.
Вот сижу и думаю, как это сделать.

Ну например, длина строки текста 46 символов, лимит строки 60 символов. Значит нужно вставить в строку 14 пробелов. Количество слов (если делить строку через Split с разделителем Chr$(32)) равно шести.
Т.е. имеем строку из шести слов, длинной 46 символов, лимит 60 и нужно с помощью 14 пробелов выровнять её по ширине. Как? Голова уже пухнет. Какой бы метод ни выбрал (посимвольно пробегать строку, через цикл по елементам массива слов в строке или ещё как), всё увязывается на Mid$ и на кучу проверок If, что мне кажется не очень рациональным и аккуратным с точки зрения организации и обработки возможных ошибок.

Помогите, плиз. Можно теорией, можно кодом. Во втором случае будет более наглядно. Но и в первом буду премного благодарен.
Это Ж-ж-ж-ж неспроста (с) Винни-Пух

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 22.02.2005 (Вт) 13:30

Ты и вправду зря изобретал велосипед. В RichTextEdit версии 2 и выше есть выравнивание по ширине, просто его надо задавать через API.
Если хочется вручную, то дам тебе алгоритм "целого" распределения.
Например, у тебя есть некоторое количество пробелов (31), которое надо распределить между шестью (например) зонами так, чтобы не было остатка.
Алгоритм такой:
0. Обнуляешь переменную A (рациональное число).
1. Делишь количество пробелов на число зон (31/6=5.1666...).
2. Выделяешь целую часть (5), остаток прибавляешь к переменной A (0.1666...).
3. Если A=>1, отнимаешь от A один, а к целой части его прибавляешь.
4. Повторяешь пункт 1 со следующей зоной.
Lasciate ogni speranza, voi ch'entrate.

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 22.02.2005 (Вт) 13:31

З.Ы. Искать слова лучше функцией InStr.
Lasciate ogni speranza, voi ch'entrate.

Ruslan Demidow
Мужчина!
Мужчина!
Аватара пользователя
 
Сообщения: 987
Зарегистрирован: 25.03.2004 (Чт) 13:39
Откуда: N.Novgorod

Сообщение Ruslan Demidow » 22.02.2005 (Вт) 16:00

alibek писал(а):Ты и вправду зря изобретал велосипед. В RichTextEdit версии 2 и выше есть выравнивание по ширине, просто его надо задавать через API.

Мне не столько нужно выравнять текст в представлении, сколько уже в конечном тексте, который будет сохранён. При том, сохранён он будет как обычный (не-RTF текст).
Т.е. Пользователь набрал текст в RTB, выделил нужный кусок текста и нажал выровнять. Я в программе через API выравниваю выделенный текст по ширине. Когда пользователь жмёт сохранить у меня есть два варианта действий:
Первый: это сохранить текст из RTB как есть, без разбиения строк по ограничению длины. Но тогда всё выравнивание поплывёт.
Второй: это читать текст из RTB построчно и после каждой строки, вместо мягкого переноса ставить vbcrlf. Тогда и выравнивание сохранится.
Но у меня вопрос вот в чём: через API RTB в выравниваемый текст, тоже пробелы добавляет? Если да, то это уже легче.
Сумбурно, конечно, но уж как смог выразил свою мысль.. :oops:

alibek писал(а):Если хочется вручную, то дам тебе алгоритм "целого" распределения.
Например, у тебя есть некоторое количество пробелов (31), которое надо распределить между шестью (например) зонами так, чтобы не было остатка.
Алгоритм такой:
0. Обнуляешь переменную A (рациональное число).
1. Делишь количество пробелов на число зон (31/6=5.1666...).
2. Выделяешь целую часть (5), остаток прибавляешь к переменной A (0.1666...).
3. Если A=>1, отнимаешь от A один, а к целой части его прибавляешь.
4. Повторяешь пункт 1 со следующей зоной.

Не понял пункт 2. Целую часть я понял как выделить. Как прибавить остаток - тоже знаю. Я не понял какую роль играет переменная А?
Флага? Если можно подробней на этом, плиз.
Пункт три: почему нужно проверять А на больше или равно единице?
И пункт четыре: зона - это слово? Тогда значит всё это нужно проделать с каждым словом в строке?
Это Ж-ж-ж-ж неспроста (с) Винни-Пух

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 22.02.2005 (Вт) 17:08

Код: Выделить всё
CurrentWidth = 46
TotalWidth = 60
W = (TotalWidth - CurrentWidth) 'кол-во пробелов
Words = 6 'кол-во слов
DW = 0!
For I = 1 To ...
  Width = W / (Words - 1)
  W0 = Fix(Width)
  DW = DW + (Width - W0)
  If DW => 1 Then
    W0 = W0 + 1
    DW = DW + 1
  End If
  Debug.Print "Слово " & I & ", ширина " & W0
Next I

В A накопляется "дефицит" или "избыток" пробелов, связанных с округлением.
Когда этот "дефицит" становится равным 1 либо больше, это означает, что из за ошибок округления уже накопился один пробел, который необходимо вставить в слово.
Зона - это интервал между словами, куда ты добавляешь пробелы; он на один меньше, чем количество слов.
Lasciate ogni speranza, voi ch'entrate.

Konst_One
Член-корреспондент академии VBStreets
Член-корреспондент академии VBStreets
Аватара пользователя
 
Сообщения: 3041
Зарегистрирован: 09.04.2004 (Пт) 13:47
Откуда: Химки

Сообщение Konst_One » 22.02.2005 (Вт) 17:27

Код: Выделить всё
Public Enum AlignTypeEnum
  AlignNone = 0
  AlignLeft = 1
  AlignRight = 2
  AlignCenter = 3
  AlignStretch = 4
End Enum

Public Function StringAlign(Text As Variant, Length As Long, Optional Align As AlignTypeEnum = AlignLeft, Optional FillChar As String = " ") As String
Dim s As String, Free As Long, CR As Boolean
Const Delimiters = " ,.!?:;"

  s = "" & Text
  If Right(s, Len(vbCrLf)) = vbCrLf Then
    CR = True
    s = Left(s, Len(s) - Len(vbCrLf))
  End If
  s = Trim(s)
  Free = Length - Len(s)
  If Free > 0 Then
    Select Case Align
   
    Case AlignLeft
        s = s & String(Free, FillChar)
       
     Case AlignRight
        s = String(Free, FillChar) & s
       
    Case AlignCenter
        s = String(Free \ 2, FillChar) & s & String((Free + 1) \ 2, FillChar)
       
    Case AlignStretch
        Dim DelimitCount As Long, i As Long
        For i = Len(s) To 1 Step -1
          If InStr(1, Delimiters, Mid(s, i, 1), vbBinaryCompare) Then
            DelimitCount = DelimitCount + 1
          End If
        Next
        If DelimitCount = 0 Then
          s = s & String(Free, FillChar)
        Else
           For i = Len(s) To 1 Step -1
            If InStr(1, Delimiters, Mid(s, i, 1), vbBinaryCompare) Then
              s = Left(s, i) & String(Int(Free / DelimitCount + 0.5), FillChar) & Mid(s, i + 1)
              Free = Free - Int(Free / DelimitCount + 0.5)
              DelimitCount = DelimitCount - 1
              If Free <= 0 Then Exit For
            End If
          Next
        End If
   
    Case Else
        s = "" & Text
     
    End Select
  End If
 
  If CR Then s = s & vbCrLf
 
  StringAlign = s
End Function


'пример
dim s as string
s=s & StringAlign("Строка слева",80, AlignLeft) & vbcrlf
s=s & StringAlign("По середине", 80, AlignCenter) & vbcrlf
s=s & StringAlign("Справа",80, AlignRight) & vbcrlf

debug.print s

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 22.02.2005 (Вт) 17:45

Konst_One, а я отказался от Fix(Value+0.5) :)
Оно глючит, когда надо выровнять несколько колонок по отдельности, при этом вписав их в одну ширину (это когда я писал грид и реализовал автозаполнение ширины столбцов).
Lasciate ogni speranza, voi ch'entrate.

Ruslan Demidow
Мужчина!
Мужчина!
Аватара пользователя
 
Сообщения: 987
Зарегистрирован: 25.03.2004 (Чт) 13:39
Откуда: N.Novgorod

Сообщение Ruslan Demidow » 22.02.2005 (Вт) 20:38

Странно, вроде бы отправлял сообщение с благодарностями. Но не вижу. Ладно отпишу второй раз.

Спасибо вам, ребята, за доходчивое объяснение.
Теперь вот пробую через API тоже самое сделать.
Делаю это так:

Код: Выделить всё

Public Const PFM_ALIGNMENT As Long = &H8

Public Const EM_SETPARAFORMAT As Long = (WM_USER + 71)
Public Const PFA_CENTER As Long = &H3
Public Const PFA_LEFT As Long = &H1
Public Const PFA_JUSTIFY As Long = 4
Public Const PFA_RIGHT As Long = &H2
Public Const MAX_TAB_STOPS As Long = 32


Public Type PARAFORMAT2
    cbSize As Integer
    wPad1 As Integer
    dwMask As Long
    wNumbering As Long
    wReserved As Long ' // redefined as wEffects in PARAFORMAT2
    dxStartIndent As Long
    dxRightIndent As Long
    dxOffset As Long
    wAlignment As Long
    cTabCount As Integer
    rgxTabs(MAX_TAB_STOPS) As Long
    dySpaceBefore As Long ';     // vertical spacing before para
    dySpaceAfter As Long ';      // vertical spacing after para
    dyLineSpacing As Long ';     // line spacing depending on Rule
    sStyle As Integer ';            // style handle
    bLineSpacingRule As Byte ';  // rule for line spacing (see tom.doc)
    bCRC As Byte ';              // reserved for CRC for rapid searching
    wShadingWeight As Long ';    // shading in hundredths of a per cent
    wShadingStyle As Long ';     // nibble 0: style, 1: cfpat, 2: cbpat
    wNumberingStart As Long ';   // starting value for numbering
    wNumberingStyle As Long ';   // alignment, roman/arabic, (), ), ., etc.
    wNumberingTab As Long ';     // space bet 1st indent and 1st-line text
    wBorderSpace As Long ';      // space between border and text (twips)
    wBorderWidth As Long ';      // border pen width (twips)
    wBorders As Long ';          // byte 0: bits specify which borders
End Type

Private Sub APIFormatText()
  Dim ret As Long
  Dim PF As PARAFORMAT2
   
   On Error GoTo APIFormatText_Error

    With PF
        .cbSize = LenB(PF)
        .dwMask = PFM_ALIGNMENT
        .wAlignment = PFA_JUSTIFY
    End With
        ret = SendMessage(RTBedit.hwnd, EM_SETPARAFORMAT, 0, PF)

   On Error GoTo 0
   Exit Sub

APIFormatText_Error:
    If bSaveLog Then
        SaveLog "Error " & Err.Number & " (" & Err.Description & ") in procedure APIFormatText of Form frmEditor"
    End If
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure APIFormatText of Form frmEditor", _
            vbCritical & vbOKOnly
End Sub


Так вот: после отправки сообщения окну RTB - оно в ответ молчит как партизан и ничего не форматируется.
А ret имеет значение 0.

Что я делаю не так?
Это Ж-ж-ж-ж неспроста (с) Винни-Пух

hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Сообщение hCORe » 22.02.2005 (Вт) 22:25

Как объявлен SendMessage?
Моду создают модоки, а распространяют модозвоны.

Ruslan Demidow
Мужчина!
Мужчина!
Аватара пользователя
 
Сообщения: 987
Зарегистрирован: 25.03.2004 (Чт) 13:39
Откуда: N.Novgorod

Сообщение Ruslan Demidow » 22.02.2005 (Вт) 23:03

hCORe писал(а):Как объявлен SendMessage?
Код: Выделить всё
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long

Но что интересно, с установкой формата выделенного текса через CHARFORMAT2, с использованием EM_SETCHARFORMAT - работает, но это для символа, а мне нужно на весь параграф установить выравнивание.

И ещё вопрос: как узнать, какова длина TAB'а в RTB? Нужно для того, что бы при сохранении сообщения, эти TAB'ы заменить на соответствующее количество пробелов.
Это Ж-ж-ж-ж неспроста (с) Винни-Пух

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 23.02.2005 (Ср) 5:25

Private Const EM_SETTABSTOPS As Long = &HCB
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Majestic-12 [Bot], Yandex-бот и гости: 90

    TopList