Logo MurCode
Microsoft Access Новое сообщение

Окраска строк в RichTextBox в разные цвета, что-то я накосячил

_Вопрос?
Дата: 13.12.2011 19:20:46
Сообщения в контрол передаются программно. Первая строка в RichTextBox д.б. окрашена в красный цвет, все последующие - в чёрный: 
'переменная содержит передаваемое сообщение и константу перевода строки
strStroka = strMess & vbCrLf
  With Forms!ff
'если это первое сообщение    
   If Len(!txtMess.Text) = 0 Then
'заносим его в контрол        
        !txtMess.Text = Nz(!txtMess.Text) & strStroka
'начало выделенного текста        
        !txtMess.SelStart = 0
'длина выделенного текста = длине сообщения        
        !txtMess.SelLength = Len(strStroka)
'окрасить выделенное в красный        
        !txtMess.SelColor = 255 
'если это не первое сообщение    
    Else
'добавим его к тексту контрола           
         !txtMess.Text = Nz(!txtMess.Text) & strStroka
'начало выделенного текста = разнице между длинами всего текста и добавляемого          
         !txtMess.SelStart = Len(!txtMess.Text) - Len(strStroka)
'длина выделенного текста = длине сообщения           
         !txtMess.SelLength = Len(strStroka)
'окрасить выделенное в чёрный           
         !txtMess.SelColor = 0 
    End If
  End With
Первые два сообщения в контроле окрашиваются правильно, а начиная с 3-го картина такая:
только последняя(очередная) строка окрашена в чёрный цвет, а все предыдущие становятся красными.
_Вопрос?
Дата: 13.12.2011 19:54:18
Получается, что определённое в самом начале SelLength - величина изменяемая и на строке
'добавим его к тексту контрола           
         !txtMess.Text = Nz(!txtMess.Text) & strStroka
         .............
каждый раз увеличивается?
_Вопрос?
Дата: 13.12.2011 20:16:15
Пока гуру Access не прочли этот топик:
а что, если создать массив куда загонять очередное сообщение и признак цвета и каждый раз перезаписывать содержимое контрола? Тогда окраска строк должна, по идее, сохраняться...
PWW
Дата: 13.12.2011 22:41:43
_Вопрос?,


Почему бы не подумать о следующем: придумать свой тег цвета, например пара символов
#R красный
#B черный
В тексте искать эти теги и красить в нужный цвет участок текста. Теги прятать разукрашивая их в цвет фона и делая размер шрифта для них =1 (т.е. очень маленький)
Старый ворчун
Дата: 13.12.2011 23:56:19
а так:

  With Forms("Form1")!txtMess
    .SelStart = Len(Nz(.text))
    If Len(.text) = 0 Then
        .SelColor = 255
    Else
        .SelColor = 0
    End If
    .SelText = strMess
  End With
_Вопрос?
Дата: 14.12.2011 13:11:56
2 Старый ворчун:
Ну!!! Вот же!!! Спасибо!!!
Всё дело было в добавлении строки после окраски и волшебном .SelText...
_Вопрос?
Дата: 14.12.2011 15:53:53
Всё прекрасно, всё работает, но...попробовал усложнить задачу: заставить выводить, по необходимости, нарастающее многоточие после текста, для чего попробовать управлять св-вом TimerInterval: в модуль формы добавил код на событие Timer:
Me!txtMess.Text = Me!txtMess.Text & "."
DoEvents
а саму процедуру изменил так:
Public Sub sss(strMess As String, lngColor As Long, lngTimeInterval As Long)
  If Not isLoadedForm("ff") Then
      DoCmd.OpenForm "ff"
  End If
  Forms("ff").TimerInterval = lngTimeInterval

 With Forms("ff")!txtMess
    .SelStart = Len(Nz(.Text))
    If Len(.Text) = 0 Then
        .SelColor = lngColor
'первое сообщение 
       .SelText = strMess
    Else
        .SelColor = lngColor
'не первое сообщение - добавить перед ним перевод строки
        .SelText = vbCrLf & strMess
    End If
    
  End With
End Sub
Две тестовые вызывающие процедуры, одна запускает нарастающее многоточие:
Public Sub www()
Call sss("Ищем", 0, 500)
End Sub
текст выводится чёрным цветом, строка из точек формируется...
Другая процедура останавливает появление точек и выводит сообщение красным цветом:
Public Sub eee()
Call sss("Нашли!", 255, 0 )
End Sub
Тут иная ситуация: процедуру, в которой запускается таймер можно запускать только самой первой и только один раз, иначе и добавляемая ею строка, и все строки, которые уже были перед ней, окрашиваются в цвет самой первой строки...
Старый ворчун
Дата: 14.12.2011 23:48:06
_Вопрос?
Всё прекрасно, всё работает, но...попробовал усложнить задачу: заставить выводить, по необходимости, нарастающее многоточие после текста, для чего попробовать управлять св-вом TimerInterval: в модуль формы добавил код на событие Timer:
Me!txtMess.Text = Me!txtMess.Text & "."
DoEvents

но вы же этим все ломаете...
почему не так:
With Me!txtMess
    .SelStart = Len(Nz(.Text))
    .SelText) = "."
End With
Старый ворчун
Дата: 15.12.2011 00:39:33
опечатка, должно быть
    .SelText = "."
_Вопрос?
Дата: 15.12.2011 14:26:34
И опять - спасибо!
Только вся идея разбилась о реалии: таймер начинает работать только после того, как перестаёт работать основная процедура
Т.е. запустив в одной процедуре такой код:
..........................
Call sss("Ищем", 0, 500)
'запуск "тяжелого" запроса
................................
Call sss("Нашли!", 0, 0)
.................................
нарастающее многоточие не увидишь... жаль, хорошая была идея!