[RESOLVED] Color Lines of RichTextBox

[wileyj]

Hi, I have this richtextbox where I'd like to color an entire line of it a certain color whenever I see a certain word.

For example, if I type in "Hello, how are you today?" Let's say "you" is the word I'm looking for. When it finds this word, I'd like it to color the line blue, but the actual word another color like red.

Like this. "Hello, how are you today?"

Anyone have any ideas? I know I need to use SelLength, SelColor and what not, but not sure how.

[longwolf]

there are faster ways, but this will do it:

Private Sub ColorText(ByRef Word As String, ByRef Color As Long)
    Dim lMrkr As Long
    Dim sText As String
    
    sText = RichTextBox1.Text
    lMrkr = InStr(sText, Word)
    Do While lMrkr
        RichTextBox1.SelStart = lMrkr - 1
        RichTextBox1.SelLength = Len(Word)
        RichTextBox1.SelColor = Color
        lMrkr = InStr(lMrkr + 1, sText, Word)
    Loop
End Sub

Oups, just saw that you want to color the line too.
You can use the Split function to break the text into lines for testng/coloring, then go back and do the words.

[MartinLiss]

Here you go

Private Sub Command1_Click()
    Dim lngCount As Long
    Dim lngLineIndex As Long
    Dim lngLength As Long
    Dim lngTotLength As Long
    Dim strBuffer As String
    Dim strRichText As String
    Dim i As Integer
    Dim intPos As Integer
    Const WORD_TO_BE_FOUND = "you"
    
    'Get Line count
    lngCount = SendMessage(RichTextBox1.hwnd, EM_GETLINECOUNT, 0, 0)
    With RichTextBox1
        For i = 0 To lngCount - 1
            'Get line index
            lngLineIndex = SendMessage(.hwnd, EM_LINEINDEX, i, 0)
            'get line length
            lngLength = SendMessage(.hwnd, EM_LINELENGTH, lngLineIndex, 0)
            'resize buffer
            strBuffer = Space(lngLength)
            'get line text
            Call SendMessageStr(.hwnd, EM_GETLINE, i, ByVal strBuffer)
            ' see if the line contains the word
            intPos = InStr(1, strBuffer, WORD_TO_BE_FOUND)
            If intPos > 0 Then
                ' color the line blue
                .SelStart = lngTotLength
                .SelLength = lngLength
                .SelColor = vbBlue
                ' color the word red
                .SelStart = intPos + lngTotLength - 1
                .SelLength = Len(WORD_TO_BE_FOUND)
                .SelColor = vbRed
            End If
            ' Accumulate the total characters read
            lngTotLength = lngTotLength + lngLength
        Next
    End With
End Sub