[RESOLVED] RichTextBox and Tags

[Mark Gambo]

I am attempting to format certain text in a Richtextbox by using Tags. My problem is that when I attempt to remove the tags using the Replace Function I lose all of the prior formatting. Here is my code:

Option Explicit
 
Private Sub Command1_Click()
    Call TextBold(RichTextBox1)
    Call TextColor(RichTextBox1, vbRed)
    Call TextCenter(RichTextBox1)
    Call TextRight(RichTextBox1)
    Call TextItalics(RichTextBox1)
End Sub
 
Private Sub Command2_Click()
    'When I click on the button I lose all formatting
    With RichTextBox1
        .Refresh
        .Text = Replace(.Text, "<", "")
        .Text = Replace(.Text, ">", "")
        .Text = Replace(.Text, "(", "")
        .Text = Replace(.Text, ")", "")
        .Text = Replace(.Text, "{", "")
        .Text = Replace(.Text, "}", "")
        .Refresh
    End With
End Sub
 
Private Sub Form_Load()
    With RichTextBox1
        .Text = "<1>" & vbNewLine 'Color these Characters Blue
        .Text = .Text & "<(5-6-58)>" & vbNewLine 'Bold These Characters & Center Align
        .Text = .Text & "{$1-23-88%}" & vbNewLine 'Italicizes These Characters & Right Align
    End With
End Sub
 
Private Sub TextBold(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strText As String
 
lngTag_End = 1
 
With RTB
    strText = .Text
    
    Do While InStr(lngTag_End, strText, "<") > 0
        .SelLength = 0
        lngTag_Start = InStr(lngTag_End, strText, "<")
        lngTag_End = InStr(lngTag_Start, strText, ">")
        .SelStart = lngTag_Start
        .SelLength = (lngTag_End - lngTag_Start) - 1
        .SelBold = True
        lngTag_End = lngTag_End + 1
    Loop
End With
 
End Sub
 
Private Sub TextCenter(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strText As String
 
lngTag_End = 1
 
With RTB
    strText = .Text
    
    Do While InStr(lngTag_End, strText, "(") > 0
        .SelLength = 0
        lngTag_Start = InStr(lngTag_End, strText, "(")
        lngTag_End = InStr(lngTag_Start, strText, ")")
        .SelStart = lngTag_Start
        .SelLength = (lngTag_End - lngTag_Start) - 1
        .SelAlignment = rtfCenter
        lngTag_End = lngTag_End + 1
    Loop
End With
 
End Sub
 
Private Sub TextColor(RTB As RichTextBox, lngColor As Long)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strText As String
 
lngTag_End = 1
 
With RTB
    strText = .Text
    
    Do While InStr(lngTag_End, strText, "<") > 0
        .SelLength = 0
        lngTag_Start = InStr(lngTag_End, strText, "<")
        lngTag_End = InStr(lngTag_Start, strText, ">")
        .SelStart = lngTag_Start
        .SelLength = (lngTag_End - lngTag_Start) - 1
        .SelColor = lngColor
        lngTag_End = lngTag_End + 1
    Loop
End With
 
End Sub
 
Private Sub TextRight(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strText As String
 
lngTag_End = 1
 
With RTB
    strText = .Text
    
    Do While InStr(lngTag_End, strText, "$") > 0
        .SelLength = 0
        lngTag_Start = InStr(lngTag_End, strText, "$")
        lngTag_End = InStr(lngTag_Start, strText, "%")
        .SelStart = lngTag_Start
        .SelLength = (lngTag_End - lngTag_Start) - 1
        .SelAlignment = rtfRight
        lngTag_End = lngTag_End + 1
    Loop
End With
 
End Sub
 
Private Sub TextItalics(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strText As String
 
lngTag_End = 1
 
With RTB
    strText = .Text
    
    Do While InStr(lngTag_End, strText, "{") > 0
        .SelLength = 0
        lngTag_Start = InStr(lngTag_End, strText, "{")
        lngTag_End = InStr(lngTag_Start, strText, "}")
        .SelStart = lngTag_Start
        .SelLength = (lngTag_End - lngTag_Start) - 1
        .SelItalic = True
        lngTag_End = lngTag_End + 1
    Loop
End With
 
End Sub

[Static]

using replace "resets" it not sure why.. this works (although not "pretty")

Private Sub Command2_Click()
    'When I click on the button I lose all formatting
    With RichTextBox1
        Do While .Find("<", 0) <> -1
            .SelText = ""
        Loop
        Do While .Find(">", 0) <> -1
            .SelText = ""
        Loop
        Do While .Find("(", 0) <> -1
            .SelText = ""
        Loop
        Do While .Find(")", 0) <> -1
            .SelText = ""
        Loop
        Do While .Find("{", 0) <> -1
            .SelText = ""
        Loop
        Do While .Find("}", 0) <> -1
            .SelText = ""
        Loop
    End With
End Sub

[Mark Gambo]

I though about doing what you posted but I thought I was doing something wrong. Thanks!

[Mark Gambo]

Well after hours of tweeking here is my completed project. I know that numerous other features can be added to this project but it does exactly what I need it to do:

Option Explicit
 
Private Sub Command1_Click()
     Call TextFormat(RichTextBox1)
End Sub
 
Private Sub Form_Load()
    With RichTextBox1
        .Text = "<Color=255><Right>1<\Right><\Color>" & vbNewLine 'Color these Characters Blue
        .Text = .Text & "<B><Center>5-6-58<\Center><\B>" & vbNewLine 'Bold These Characters & Center Align
        .Text = .Text & "<I><Left>1-23-88<\Left><\I>" & vbNewLine 'Italicizes These Characters & Right Align
    End With
End Sub
 
Private Sub TextFormat(RTB As RichTextBox)
Dim lngTag_Start As Long
Dim lngTag_End As Integer
Dim strTag_Start As String
Dim strTag_End As String
 
Dim strText As String
Dim a As Long
 
For a = 1 To 10
    strTag_Start = "<" & Choose(a, "B", "I", "U", "Center", "Left", _
                                    "Right", "Color=255", "Color=16711680", _
                                    "Color=65280", "Color=65535") & ">"
    If a = 7 Then
        a = a
    End If
    
    strTag_End = "<\" & Choose(a, "B", "I", "U", "Center", "Left", _
                                    "Right", "Color", "Color", _
                                    "Color", "Color") & ">"
    
    lngTag_End = 1
 
    With RTB
        strText = .Text
        
        Do While InStr(lngTag_End, strText, strTag_Start) > 0
            .SelLength = 0
            lngTag_Start = InStr(lngTag_End, strText, strTag_Start)
            lngTag_End = InStr(lngTag_Start, strText, strTag_End)
            .SelStart = lngTag_Start
            .SelLength = (lngTag_End - lngTag_Start) - 1
            
            Select Case strTag_Start
                Case "<B>"
                    .SelBold = True
                Case "<I>"
                    .SelItalic = True
                Case "<U>"
                    .SelUnderline = True
                Case "<Center>"
                    .SelAlignment = rtfCenter
                Case "<Left>"
                    .SelAlignment = rtfLeft
                Case "<Right>"
                    .SelAlignment = rtfRight
                Case Else
                    If Left(strTag_Start, 6) = "<Color" Then
                        
                        .SelColor = CLng(Mid(strTag_Start, 8, Len(strTag_Start) - 8))
                    End If
            End Select
        
            lngTag_End = lngTag_End + 1
        
        Loop
    End With
    
    With RTB
        Do While .Find(strTag_Start, 0) <> -1
                .SelText = ""
        Loop
        
        Do While .Find(strTag_End, 0) <> -1
            .SelText = ""
        Loop
    End With
Next a
End Sub

[Mark Gambo]

Here is an updated version of my code that I posterd in Post # 4 Converting Text to a Long Value