15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как разукрасить HTML тэги в RichTextBox

Для этого нам необходимо добавить на форму два RichText Box-а, один назовём rchVisible, а второй rchHidden (у этого richtextbox необходимо установить свойство visible в false).

Далее, добавляем в форму нижеприведённый код. Не забудьте изменить в строке Open App.Path & " odbooks.htm" For Input As fnum имя файла на Ваш.

' Color the tags in the RichTextBox's text.
' This version is a little simple and does not
' ignores comment properly. It cannot handle nested
' brackets as in:
'
' <A HREF= <!-- here's a comment -->
'    http://www.vb-helper.com>
'
Private Sub ColorTags(rch As RichTextBox)
Dim txt As String
Dim tag_open As Integer
Dim tag_close As Integer

    txt = rch.Text
    tag_close = 1
    Do
        ' See where the next tag starts.
        tag_open = InStr(tag_close, txt, "<")
        If tag_open = 0 Then Exit Do
       
        ' See where the tag ends.
        tag_close = InStr(tag_open, txt, ">")
        If tag_open = 0 Then tag_close = Len(txt)
       
        ' Color the tag.
        rch.SelStart = tag_open - 1
        rch.SelLength = tag_close - tag_open + 1
        rch.SelColor = vbRed
    Loop
End Sub

' Load the file.
Private Sub Form_Load()
Dim fnum As Integer
Dim txt As String

    ' Move the hidden text box so it cannot be seen.
    rchHidden.Move -rchHidden.Width - 120, 0
   
    ' Load the file.
    fnum = FreeFile
    Open App.Path & " odbooks.htm" For Input As fnum
    txt = Input$(LOF(fnum), fnum)
    rchHidden.Text = txt
    Close fnum

    ' Color the HTML tags.
    ColorTags rchHidden

    ' Copy the result to the visible text box.
    rchHidden.SelStart = 0
    rchHidden.SelLength = Len(rchHidden.Text)
    rchVisible.SelStart = 0
    rchVisible.SelLength = Len(rchVisible.Text)
    rchVisible.SelRTF = rchHidden.SelRTF
End Sub
Private Sub Form_Resize()
    rchVisible.Move 0, 0, ScaleWidth, ScaleHeight
End Sub