Private Const KeyWordColor As Long = &H800000 '关键字颜色
Private Const NotesColor As Long = &H8000& '注释颜色
Sub vbCodeSTX(ByRef RTF1 As RichTextBox)
Dim vks() As String
Dim i As Long, l As Long
Dim mloc As Long, mloc2 As Long
Dim oloc As Long, olen As Long
l = LenB(RTF1.Text)
If l = 0 Then Exit Sub
oloc = RTF1.SelStart
olen = RTF1.SelLength
RTF1.Visible = False
'处理vb关键字
vks = Split(vbKeyWords, ",")
For i = 0 To UBound(vks)
mloc = RTF1.Find(vks(i), 0, , rtfWholeWord)
Do While mloc >= 0
With RTF1
.SelStart = mloc
.SelLength = Len(vks(i))
.SelColor = KeyWordColor
.SelStart = mloc + Len(vks(i)) + 1
End With
mloc = RTF1.Find(vks(i), , l, rtfWholeWord)
Loop
Next
'处理注释
mloc = RTF1.Find("'", 0)
Do While mloc >= 0
RTF1.SelStart = mloc + 1
mloc2 = RTF1.Find(vbCrLf, , l)
If mloc2 > mloc Then
With RTF1
.SelStart = mloc
.SelLength = mloc2 - mloc
If InStr(RTF1.SelText, Chr(34)) = 0 Then
.SelColor = NotesColor '是注释行
End If
.SelStart = mloc2 + 1
End With
End If
mloc = RTF1.Find("'", , l)
Loop
RTF1.SelStart = oloc
RTF1.SelLength = olen
RTF1.Visible = True