Question

我想创建一个类似于NotePad ++的RichTextBox

我们输入<?php时的示例将此单词颜色更改为红色

我该怎么做？

Answer 1

这是突出文字的最佳代码。你会喜欢它：P

创建一个新类并复制其中所有代码

使用以下代码

Dim cls As New Class1
cls.ColorVisibleLines(RichTextBox1)

Imports System.Runtime.InteropServices

Public Class Class1

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As Integer) As Integer

'color blue
Dim scriptKeyWords() As String = {"<?php", "?>"}
'color red
Dim scriptOperatorKeyWords() As String = {} '{"+", "-", "*", "/", "\", "-", "&", "=", "<>", "<", "<=", ">", ">="}
'color magenta
Dim commentChar As String = "'"

Private Enum EditMessages
    LineIndex = 187
    LineFromChar = 201
    GetFirstVisibleLine = 206
    CharFromPos = 215
    PosFromChar = 1062
End Enum

Public Function GetCharFromLineIndex(ByVal LineIndex As Integer, rtb As RichTextBox) As Integer
    Return SendMessage(rtb.Handle.ToInt32, EditMessages.LineIndex, LineIndex, 0)
End Function
Public Function FirstVisibleLine(rtb As RichTextBox) As Integer
    Return SendMessage(rtb.Handle.ToInt32, EditMessages.GetFirstVisibleLine, 0, 0)
End Function
Public Function LastVisibleLine(rtb As RichTextBox) As Integer
    Dim LastLine As Integer = FirstVisibleLine(rtb) + (rtb.Height / rtb.Font.Height)

    If LastLine > rtb.Lines.Length Or LastLine = 0 Then
        LastLine = rtb.Lines.Length
    End If
    Return LastLine
End Function
Public Sub ColorRtb(ByRef rtb As RichTextBox)
    Dim FirstVisibleChar As Integer
    Dim i As Integer = 0
    While i < rtb.Lines.Length
        FirstVisibleChar = GetCharFromLineIndex(i, rtb)
        ColorLineNumber(rtb, i, FirstVisibleChar)
        i += 1
    End While
End Sub
Public Sub ColorLineNumber(ByVal rtb As RichTextBox, ByVal LineIndex As Integer, ByVal lStart As Integer)
    Dim TLine As String = rtb.Lines(LineIndex) '.ToLower
    Dim i As Integer = 0
    Dim instance As Integer
    Dim SelectionAt As Integer = rtb.SelectionStart
    ' Lock the update
    LockWindowUpdate(rtb.Handle.ToInt32)
    ' Color the line black to remove any previous coloring 
    rtb.SelectionStart = lStart
    rtb.SelectionLength = TLine.Length
    rtb.SelectionColor = Color.Black
    HighLightOperatorKey(rtb) 'operator keyword
    HighLightKeywords(rtb) 'keyword
    ' Find any comments 
    instance = TLine.IndexOf(commentChar) + 1
    ' If there are comments, color them 
    If instance <> 0 Then
        rtb.SelectionStart = (lStart + instance - 1) 'rtb.SelectionStart = (lStart + instance - 1)
        rtb.SelectionLength = (TLine.Length - instance + 1)
        rtb.SelectionColor = Color.Magenta
    End If

    If instance = 1 Then
        ' Unlock the update, restore the start and exit 
        rtb.SelectionStart = SelectionAt
        rtb.SelectionLength = 0
        LockWindowUpdate(0)
        Exit Sub
        'Return ' TODO: might not be correct. Was : Exit Sub 
    End If

    ' Restore the selectionstart 
    rtb.SelectionStart = SelectionAt
    rtb.SelectionLength = 0

    ' Unlock the update 
    LockWindowUpdate(0)

End Sub
Public Sub HighLightKeywords(ByVal rtb As RichTextBox)
    For Each oneWord As String In scriptKeyWords
        Dim pos As Integer = 0
        Do While rtb.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0
            pos = rtb.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)
            rtb.Select(pos, oneWord.Length)
            rtb.SelectionColor = Color.Blue

            pos += 1

        Loop

    Next

End Sub

Public Sub HighLightOperatorKey(ByVal rtb As RichTextBox)
    For Each oneWord As String In scriptOperatorKeyWords

        Dim pos As Integer = 0

        Do While rtb.Text.ToUpper.IndexOf(oneWord.ToUpper, pos) >= 0

            pos = rtb.Text.ToUpper.IndexOf(oneWord.ToUpper, pos)

            rtb.Select(pos, oneWord.Length)
            ' rtb.SelectionFont = New Font("Courier New", 12, FontStyle.Regular)
            rtb.SelectionColor = Color.Red

            pos += 1

        Loop

    Next
End Sub

Public Sub ColorVisibleLines(ByVal rtb As RichTextBox)
    Dim FirstLine As Integer = FirstVisibleLine(rtb)
    Dim LastLine As Integer = LastVisibleLine(rtb)
    Dim FirstVisibleChar As Integer
    Dim i As Integer = FirstLine
    If (FirstLine = 0) And (LastLine = 0) Then
        'If there is no text it will error, so exit the sub
        Exit Sub
    Else
        While i < LastLine
            FirstVisibleChar = GetCharFromLineIndex(FirstLine, rtb)
            ColorLineNumber(rtb, FirstLine, FirstVisibleChar)
            FirstLine += 1
            i += 1
        End While
    End If

End Sub


End Class

在richtextbox vb.net中更改单词颜色

1 个答案: