CODE: [Copy to clipboard]
Public Function Highlight(keyword As String, colorset As Variant)
'加亮语法,在这里实现
'算法:
' S1 得到关键字(这里就是cd % 0123456789 之类的)
' S2 使用RTF的FindTxt方法 得到行号。SelText设置颜色(一会查)
' S3 行号count暂存至tmpi,继续查找
' S4 查找下一个,行号与tmpi比较,相同停止,不同回S2
'下面开始编码
count = MDIForm1.ActiveForm.CodeInp.find(keyword, , , 2)
tmpi = 0
ok2go = False
'here,it's a bug
'it could now GO ON FINDING
While ok2go = False
If count = -1 Then
'no match word could resume next
ok2go = True
Else
MDIForm1.ActiveForm.CodeInp.SelColor = colorset
'here add something which could make the program go on serching
'not stop replacing the ONLY word all the time
If count = tmpi Then
ok2go = True
Else
'not do nothing but do something to make the program go
MDIForm1.ActiveForm.CodeInp.SelStart = MDIForm1.ActiveForm.CodeInp.SelStart + MDIForm1.ActiveForm.CodeInp.SelLength + 1
End If
End If
Wend
End Function
CODE: [Copy to clipboard]
Private Const vbKeyWords As String = "echo,set,path,1,2,3,4,5,6,7,8,9,+,-,*,/,@,$,%,^,&,:"
'一些稀奇古怪的永远用不到的东西...
'过两天分类一下,今天手里没有IDE环境了,只是瞎写了一些东西,
'下午贴到vb上看看效果,以前的那个太麻烦,慢死了。
'这次用UE写的
Private Const Color1 As Long = &H800000 '关键字颜色
Private Const RemarkColor As Long = &H8000& '注释颜色
Sub vbCodeSTX(ByRef CodeInpt 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(CodeInpt.Text)
If l = 0 Then Exit Sub
oloc = CodeInpt.SelStart
olen = CodeInpt.SelLength
CodeInpt.Visible = False
'处理关键字 第一种 (暂时只做一种)
vks = Split(vbKeyWords, ",")
For i = 0 To UBound(vks)
mloc = CodeInpt.Find(vks(i), 0, , rtfWholeWord)
Do While mloc >= 0
With CodeInpt
.SelStart = mloc
.SelLength = Len(vks(i))
.SelColor = Color1
.SelStart = mloc + Len(vks(i)) + 1
End With
'上面这一段比较好
mloc = CodeInpt.Find(vks(i), , l, rtfWholeWord)
Loop
Next
'处理注释 rem
mloc = CodeInpt.Find("rem", 0)
Do While mloc >= 0
CodeInpt.SelStart = mloc + 1
mloc2 = CodeInpt.Find(vbCrLf, , l)
If mloc2 > mloc Then
With CodeInpt
.SelStart = mloc
.SelLength = mloc2 - mloc
If InStr(CodeInpt.SelText, Chr(34)) = 0 Then
.SelColor = RemarkColor '是注释行
End If
.SelStart = mloc2 + 1
End With
End If
mloc = CodeInpt.Find("'", , l)
Loop
CodeInpt.SelStart = oloc
CodeInpt.SelLength = olen
CodeInpt.Visible = True
End Sub
'bug一个 刚刚修正
'在修复一个bug