[RESOLVED] Richtextbox - find special signs, and select bold [ Whole word only ]

[Fraps]

Hi,

I would like to find, and bold some special signs in a richtextbox.text.
Currently I can find only these signs, that have been settled in the code just like this:

RichTextBox1.find ("§")
RichTextBox1.SelBold = True
RichTextBox1.SelUnderline = True

The question - how to find any signs within Richtextbox like §1 or §2 ....§200, and then bold them all

[Fraps]

I've created something...:

On Error Resume Next

Dim pom, pom1 As String
Dim i As Integer

pom1 = "§"
Do While RichTextBox1.find(pom1, i) <> True
i = RichTextBox1.find(pom1, i)
RichTextBox1.SelStart = i
RichTextBox1.SelLength = Len(pom1)
RichTextBox1.SelFontName = "Arial"
RichTextBox1.SelFontSize = 15
RichTextBox1.SelBold = True
RichTextBox1.SelItalic = True
RichTextBox1.SelUnderline = True
RichTextBox1.SelColor = &HFAAAAA
i = i + Len(pom2) + 1
Loop

I can find now, and bold all the signs like §. Is there anybody who can help me to find all the signs like §10,§11.....

[akhileshbc]

Try this:

Option Explicit

Private Sub Command1_Click()
    Dim i As Long
    i = 0
    
    Do
    Debug.Print i
        i = InStr(i + 1, RichTextBox1.Text, "$", vbTextCompare)
        If i > 0 Then
            RichTextBox1.SelStart = i - 1
            RichTextBox1.SelLength = InStr(i, RichTextBox1.Text, " ", vbTextCompare) - i
            RichTextBox1.SelBold = True
            RichTextBox1.SelUnderline = True
        Else
            Exit Do
        End If
    Loop

End Sub

Private Sub Form_Load()
    RichTextBox1.Text = "I am going to write something $200 and how's the next thinfs $77 asdjjdas"
End Sub

....

[Fraps]

Great stuff thanks!. Last thing - Some documents have § 1, § 300... The space between the sign, and number. Can you please take a look at this?

[akhileshbc]

In this line:

RichTextBox1.SelLength = InStr(i, RichTextBox1.Text, " ", vbTextCompare) - i

The above part will find the position of the first <space> after each $ symbol.
So, you have to tweak around that part....

[Fraps]

Many thanks akhileshbc. But I'm wondering that probably I should have two spaces?

$<SPACE>200<SPACE><STOP>
So is the SelLength shouldn't have two compares?

[Fraps]

Ok maybe I'll do something.
The last case:

Can I set a whole word only in this code?

Option Explicit

Private Sub Command1_Click()
    Dim i As Long
    i = 0
    
    Do
    Debug.Print i
        i = InStr(i + 1, RichTextBox1.Text, "mother", vbTextCompare)
        If i > 0 Then
            RichTextBox1.SelStart = i - 1
            RichTextBox1.SelLength = InStr(i, RichTextBox1.Text, " ", vbTextCompare) - i
            RichTextBox1.SelBold = True
            RichTextBox1.SelUnderline = True
        Else
            Exit Do
        End If
    Loop

End Sub

What if the text consists with mother like grandmother. I would like to bold only mother.
Is this posible?

[Fraps]

Ok I have it:

Private Sub Command1_Click()
        HighlightWords RichTextBox1, "mother", vbRed
      End Sub

      Private Function HighlightWords(rtb As RichTextBox, _
                                  sFindString As String, _
                                  lColor As Long) _
                                  As Integer

        Dim lFoundPos As Long           'Position of first character
                                        'of match
        Dim lFindLength As Long         'Length of string to find
        Dim lOriginalSelStart As Long
        Dim lOriginalSelLength As Long
        Dim iMatchCount As Integer      'Number of matches

        'Save the insertion points current location and length
        lOriginalSelStart = rtb.SelStart
        lOriginalSelLength = rtb.SelLength

        'Cache the length of the string to find
        lFindLength = Len(sFindString)

        'Attempt to find the first match
        lFoundPos = rtb.Find(sFindString, 0, , rtfNoHighlight)
        While lFoundPos > 0
          iMatchCount = iMatchCount + 1

          rtb.SelStart = lFoundPos
          'The SelLength property is set to 0 as
          'soon as you change SelStart
          rtb.SelLength = lFindLength
          rtb.SelColor = lColor

          'Attempt to find the next match
          lFoundPos = rtb.Find(sFindString, _
            lFoundPos + lFindLength, , rtfNoHighlight)
        Wend

        'Restore the insertion point to its original
        'location and length
        rtb.SelStart = lOriginalSelStart
        rtb.SelLength = lOriginalSelLength

        'Return the number of matches
        HighlightWords = iMatchCount

      End Function

[Fraps]

According to above code I'm really close ( I think ) to get what I've posted here in a prelude.
so I can now put something like that:

Private Sub Command1_Click()
        HighlightWords RichTextBox1,"$" & " " & 1, vbRed
        HighlightWords RichTextBox1,"$" & " " & 2, vbRed
and so on and on...
      End Sub

Is there any way to put here something like: show me all the digits after the space
something like:

HighlightWords RichTextBox1,"$" & " " & [digits], vbRed

[xavierjohn22]

you can check if that text is numeric

Private Function IsNumericOnly(sExpression As String) As Boolean
    Dim sTemp As String
    Dim iLen As Integer
    Dim iCount As Integer
    Dim sChar As String

    sTemp = sExpression
    iLen = Len(sTemp)
    If iLen > 0 Then
        For iCount = 1 To iLen
            sChar = Mid(sTemp, iCount, 1)
            If Not sChar Like "[0-9]" Then Exit Function
        Next
        IsNumericOnly = True
    End If
End Function

[Merri]

Generic function:

HighlightSymbolNumber RichTextBox1, "&#167;", vbRed
HighlightSymbolNumber RichTextBox1, "$", vbRed

Public Sub HighlightSymbolNumber(RTB As RichTextBox, Symbol As String, ByVal Color As OLE_COLOR)
    Dim P As Long, SP As Long, T As String
    Dim SelStart As Long, SelLength As Long
    SelStart = RTB.SelStart
    SelLength = RTB.SelLength
    T = RTB.Text
    P = InStr(T, Symbol)
    Do While P
        SP = P
        P = P + 1
        Do While P <= Len(T)
            Select Case AscW(Mid$(T, P, 1))
            Case 32, 48 To 57
                P = P + 1
            Case Else
                Exit Do
            End Select
        Loop
        RTB.SelStart = SP - 1
        RTB.SelLength = P - SP
        RTB.SelColor = Color
        P = InStr(P, T, Symbol)
    Loop
    RTB.SelStart = SelStart
    RTB.SelLength = SelLength
End Sub

[Fraps]

Thanks Merri, this is exactly what I'm looking for. Kiitos