【VB】论ide部分功能的实现（语法高亮），（智能感知）

cyycoish · 发表于 2014-12-19 22:31:35

欢迎访问技术宅的结界，请注册或者登录吧。

您需要登录才可以下载或查看，没有账号？立即注册→加入我们

×

Ok let us start!
本贴讨论ide编辑器的两个功能：一个是Highlighting（语法高亮），另一个是Intellisence（智能感知）{以下简称：IS}
=====================================================================================================================
好，先看IS
以一款vbs编辑器为例，vbs功能之所以强大，是因为它可以调用com，windows提供了种类丰富，功能强大的各类com组件
com组件种类繁多，让我们眼花缭乱，一款好的编辑器应该提供com组件的属性与方法来便于我们编程
那么问题来了：如何实现?
1.我们可以把所有com组件的所有属性与方法存进类数据库文件，在编辑时进行调用
2.我们可以获取系统注册的com组件的信息，scan com组件字符串，然后筛选调用
就上述两种方法，大家可以讨论，第一种繁琐，而且不是dynamic，显然应该使用方法2
所以关键技术放在了如何与系统的com组件注册机制获得connection
好的，这里就引出typelib infomation，如图：

Dim i As Integer
Dim oTLB As InterfaceInfo
Dim tar As Object
Set tar = CreateObject(objectName)
Set oTLB = tli.InterfaceInfoFromObject(tar)
listA.Clear
For i = 1 To oTLB.Members.Count
Select Case oTLB.Members(i).InvokeKind
Case INVOKE_CONST
listA.AddItem "常数:" & oTLB.Members(i).Name
Case INVOKE_EVENTFUNC
listA.AddItem "事件:" & oTLB.Members(i).Name
Case INVOKE_FUNC
listA.AddItem "方法:" & oTLB.Members(i).Name
Case INVOKE_PROPERTYGET
listA.AddItem "属性(Get):" & oTLB.Members(i).Name
Case INVOKE_PROPERTYPUT
listA.AddItem "属性(Let):" & oTLB.Members(i).Name
Case INVOKE_PROPERTYPUTREF
listA.AddItem "属性(Set):" & oTLB.Members(i).Name
Case INVOKE_UNKNOWN
listA.AddItem "未知:" & oTLB.Members(i).Name
End Select
Next

复制代码

tar即为目标com组件，先创建名为tar的com对象
然后用tli库的InterfaceInfoFromObject方法获得com对象
利用i计数器和oTLB.Members.Count控制循环，获取该com组件在系统内注册的信息
那么INVOKE_CONST即为常数INVOKE_EVENTFUNC为事件INVOKE_FUNC为方法等等。。
好了，至此我们将信息录入listbox，下面只要让listbox跟踪插入符的移动，便可以做出以我乱VS（出自于：以假乱真）的IS啦
那么具体在vb6的方法实现是，将form或者一个picture的font属性设置得和richtextbox一样，用“TextWidth（列数）”方法计算listbox的left
用TextHeight（当前行-显示的首行）计算listbox的top，那么关于获得编辑文本框的光标行列，显示之首行等信息，我已经封装成一个模块，大家可以在这里下载（源码同样包含）：

Module1.bas (6 KB, 下载次数: 6)
继续，关于如何搜索com组件的关键字，我是这样解决的：因为在vbs中引用com代码通常是这样的
dim a
set a = createobject("xxx.xxx")
a.
这里只要输出“.”即可弹出listbox，然后根据语法set 空格（n个）变量名（可能未声明）createobject括号字符串xxx.xxx（注意，这个语句可能出现在变量使用之上文的任意位置）获得这个xxx.xxx
然后取得类似变量名点的式子然后方法如上搜索属性方法，具体代码参见vbspad源码。

'这是我用来识别com组件连接字符串的代码：
Public Function ScanObjects(valName As String, cTextBox As RichTextBox)
Dim ts As String
Set objRegEx = New RegExp
With objRegEx
.MultiLine = True
.IgnoreCase = True
.Global = True
End With
'Dim matchStr As String
Dim eXMatCol As MatchCollection, eXMat As Match
objRegEx.Pattern = "set\s*" & valName & "\s*=\s*createobject\s*\(" & Chr(34) & ".*" & Chr(34) & "\)"
If objRegEx.Test(cTextBox.Text) Then
Set eXMatCol = objRegEx.Execute(cTextBox.Text)
Set eXMat = eXMatCol.Item(eXMatCol.Count - 1)
ts = eXMat.Value
objRegEx.Pattern = Chr(34) & ".*" & Chr(34)
If objRegEx.Test(ts) Then
Set eXMatCol = objRegEx.Execute(cTextBox.Text)
Set eXMat = eXMatCol.Item(eXMatCol.Count - 1)
ScanObjects = Replace(eXMat.Value, Chr(34), vbNullString)
Exit Function
End If
End If
End Function

复制代码

那么关于字符串的匹配与搜索呢，我是这样想的，例如，有com组件xxx.xxx,其下有方法abc整形参数一个
dim var
set var = createobject("xxx.xxx")
var.abc(1)
那么listbox里边一定会列出abc
我们即可在richtextbox的keypress事件中监测键码“上键”和“下键”，检测到将listbox setfocus，同时，listbox监测键码空格（32）回车（13）将listbox中的内容copy到richtextbox中
最后richtextbox.setfocus，list.visible=false

'这段代码用来检测变量
Public Function GetVarName(cTextBox As RichTextBox)
Dim ts1 As String
Dim eXMatCol As MatchCollection, eXMat As Match
ts1 = GetLineText(cTextBox, GetCurPos(cTextBox).Y - 1)
Set objRegEx = New RegExp
With objRegEx
.MultiLine = True
.IgnoreCase = True
.Global = True
End With
objRegEx.Pattern = "\w*\."
If objRegEx.Test(cTextBox.Text) Then
Set eXMatCol = objRegEx.Execute(cTextBox.Text)
Set eXMat = eXMatCol.Item(eXMatCol.Count - 1)
GetVarName = Replace(eXMat.Value, ".", vbNullString)
Exit Function
End If
End Function

复制代码

搜索同名属性方法：
Private Sub ScanListWords()
Dim i As Integer
For i = 0 To List1.ListCount - 1
If InStr(1, LCase(List1.List(i)), LCase(pStr)) <> 0 The
List1.ListIndex = i
End If
Next
End Sub

好了，IS告一段落下面该讲讲语法高亮了
=================================================================================================================================================================================================
语法高亮，实在是伟大的发明，它能让满眼乱七八糟的数字与符号看起来富有意义
关于vb实现语法高亮，最容易想到的便是richtextbox（简称：rtb）控件
但是呢rtb在对大量代码染色时速度很慢，不过我还是决定试一试
说到rtb的染色，rtb上色有两种办法（不说子类化重绘，我没有尝试过子类化重绘）：
1.配合使用selstart，sellenth，selcolor属性（我给他起个名字叫：三属性渲染）。2.使用rtb格式化文档（我尝试失败）
那么咱们讲讲三属性渲染：
对于rtb控件的染色提速有以下几点方法：
1.加载时全部染色（很耗时），然后对于正在编辑的行，进行单独染色（初始全染，编辑分染）
2.对于显示的多行进行染色，当显示首行有变动，用timer监测变动及时补染。对于正在编辑的行，再单独染色（分时分段渲染，编辑分染）
由于vbspad也属于早起开发的工具，在当时，我采用了“初始全染，编辑分染”的方法，虽然方法2效率更高。
那么对于关键字的识别，主要还是用到了正则表达式。
关于正则，笔者不赘述，大家可以参考这篇文档（版权归原作者所有，仅供学习交流，本人不负任何责任）：

vb6_正则表达式.pdf (326.55 KB, 下载次数: 10)
那么在我的源码中，正则匹配部分位于Module2中：

Option Explicit
Dim objRegEx As RegExp
Dim aRWord() As String
Dim aFWord() As String
Dim aOWord() As String
Public Sub InitHighLig()
aRWord = Split("Call|Case|Class|Const|Debug|Dim|Do|Each|Else|ElseIf|Empty|End|End If|End With|End Sub|End Function|Eqv|Exit Function|Exit Sub|Exit For|Exit Do|Exit While|Error|Err|False|For|Function|Get|Goto|If|Imp|In|Is|Let|Loop|New|Next|Nothing|Null|On|Option|Preserve|Private|Public|ReDim|Rem|Resume|Select|Set|Sub|Then|To|True|Until|WEnd|While|With", "|")
aFWord = Split("Abs|Array|Asc|Atn|CBool|CByte|CCur|CDate|CDbl|Chr|CInt|CLng|Cos|CreateObject|CSng|CStr|Date|DateAdd|DateDiff|DatePart|DateSerial|DateValue|Day|Eval|Exp|Filter|Fix|FormatCurrency|FormatDateTime|FormatNumber|FormatPercent|GetLocale|GetObject|GetRef|Hex|Hour|InputBox|InStr|InStrRev|Int|IsArray|IsDate|IsEmpty|IsNull|IsNumeric|IsObject|Join|LBound|LCase|Left|Len|LoadPicture|Log|LTrim|Mid|Minute|Month|MonthName|MsgBox|Now|Oct|Replace|RGB|Right|Rnd|Round|RTrim|ScriptEngine|ScriptEngineBuildVersion|ScriptEngineMajorVersion|ScriptEngineMinorVersion|Second|SetLocale|Sgn|Sin|Space|Split|Sqr|StrComp|String|StrReverse|Tan|Time|Timer|TimeSerial|TimeValue|Trim|TypeName|UBound|UCase|VarType|Weekday|WeekdayName|Year", "|")
aOWord = Split(">|<|=|+|-|*|/|^|Mod|Not|And|Or|Xor", "|")
Set objRegEx = New RegExp
With objRegEx
.MultiLine = False
.IgnoreCase = True
.Global = True
End With
End Sub
Public Sub HigLigCurLnB(tB As RichTextBox, rTBSSt As Long, Optional ln As Long)
On Error GoTo EH_HLCL:
Dim sRWords As String, aRWords() As String
Dim rST As Long
sRWords = "dim |option explicit|if | then|else|end if|do|loop|"
aRWords = Split(sRWords, "|")
rST = tB.SelStart
Dim t As Variant
For Each t In aRWords
If InStrRev(LCase(tB.Text), t, rTBSSt) Then
tB.SelStart = tB.SelStart - Len(t)
tB.SelLength = Len(t)
tB.SelColor = &HFF0000
tB.SelLength = 0
tB.SelColor = &H0&
tB.SelStart = rST
tB.SelColor = &H0&
Exit For
End If
Next
EH_HLCL:
If Err <> 0 Then
tB.SelLength = 0
tB.SelColor = &H0&
End If
End Sub
Public Function FormatCurCode(ln As Long)
'If a Then a = 3
End Function
Public Sub HigLigCurLnC(cTextBox As RichTextBox, lnSelectionStart As Long, Optional ln As Long)
Dim s1 As String
Dim st As String
Dim i As Integer
With cTextBox
If GetCurPos(cTextBox).Y = 1 Then
st = Mid(.Text, InStrRev(Mid(.Text, 1, lnSelectionStart), vbCrLf) + 1)
Else
st = Mid(.Text, InStrRev(Mid(.Text, 1, lnSelectionStart), vbCrLf) + 2)
End If
MsgBox Chr(34) & st & """"
i = Len(st)
Do While i <= 1
's1 = Mid(st, i,
If IsRWord(s1) = True Then
.SelStart = lnSelectionStart - i
.SelLength = Len(s1)
.SelColor = &HFF0000
i = i - Len(s1)
End If
Loop
.SelLength = 0
.SelStart = lnSelectionStart
.SelColor = &H0&
End With
End Sub
Public Sub HigLigCurLn(cTextBox As RichTextBox, lnSelectionStart As Long, Optional colorAll As Boolean = False)
Dim st1 As String
Dim t As Variant, i As Integer
Dim fPos As Integer, rPos As Long
Dim eXMatCol As MatchCollection, eXMat As Match
rPos = lnSelectionStart
st1 = GetLineText(cTextBox, GetCurPos(cTextBox).Y - 1)
If colorAll = True Then st1 = cTextBox.Text
If colorAll = False Then
With cTextBox
If lnSelectionStart <= (GetCurPos(cTextBox).X - 1) Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - lnSelectionStart)
Else
.SelStart = .SelStart + (lnSelectionStart - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = Len(st1) - 2
.SelColor = &H0&
End With
End If
For Each t In aRWord()
objRegEx.Pattern = "\b" & t & "\b"
If objRegEx.Test(st1) Then
Set eXMatCol = objRegEx.Execute(st1)
'MsgBox eXMatCol.Count
For i = 0 To eXMatCol.Count - 1
Set eXMat = eXMatCol.Item(i)
fPos = eXMat.FirstIndex
With cTextBox
'MsgBox "fpos:" & fPos & vbCrLf & "cpos:" & GetCurPos(cTextBox).x - 1 '====
If fPos <= GetCurPos(cTextBox).X - 1 Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - fPos)
Else
.SelStart = .SelStart + (fPos - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = eXMatCol(0).Length
.SelColor = &HFF0000
'.SelColor = vbRed
.SelText = objRegEx.Replace(.SelText, t)
End With
Next
End If
Next
For Each t In aFWord()
objRegEx.Pattern = "\b" & t & "\b"
If objRegEx.Test(st1) Then
Set eXMatCol = objRegEx.Execute(st1)
For i = 0 To eXMatCol.Count - 1
Set eXMat = eXMatCol.Item(i)
fPos = eXMat.FirstIndex
With cTextBox
If fPos <= GetCurPos(cTextBox).X - 1 Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - fPos)
Else
.SelStart = .SelStart + (fPos - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = eXMatCol(0).Length
.SelColor = &HC000C0
.SelText = objRegEx.Replace(.SelText, t)
End With
Next
End If
Next
For Each t In aOWord()
Select Case t
Case "Mod", "Not", "And", "Or", "Xor"
objRegEx.Pattern = "\b" & t & "\b"
Case ">", "<", "=", "^", "-", "/"
objRegEx.Pattern = t
Case "+", "*"
objRegEx.Pattern = "" & t
End Select
If objRegEx.Test(st1) Then
Set eXMatCol = objRegEx.Execute(st1)
For i = 0 To eXMatCol.Count - 1
Set eXMat = eXMatCol.Item(i)
fPos = eXMat.FirstIndex
With cTextBox
If fPos <= GetCurPos(cTextBox).X - 1 Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - fPos)
Else
.SelStart = .SelStart + (fPos - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = eXMatCol(0).Length
.SelColor = &H80FF&
If t = "Mod" Or t = "Not" Or t = "And" Or t = "Or" Or t = "Xor" Then .SelText = objRegEx.Replace(.SelText, t)
End With
Next
End If
Next
'字符串
objRegEx.Pattern = Chr(34) & ".*" & Chr(34)
If objRegEx.Test(st1) Then
Set eXMatCol = objRegEx.Execute(st1)
For i = 0 To eXMatCol.Count - 1
Set eXMat = eXMatCol.Item(i)
fPos = eXMat.FirstIndex
With cTextBox
If fPos <= GetCurPos(cTextBox).X - 1 Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - fPos)
Else
.SelStart = .SelStart + (fPos - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = eXMatCol(0).Length
.SelColor = &H808080
End With
Next
End If
'注释
objRegEx.Pattern = "'\w*"
If objRegEx.Test(st1) Then
Set eXMatCol = objRegEx.Execute(st1)
Set eXMat = eXMatCol.Item(0)
fPos = eXMat.FirstIndex
With cTextBox
If fPos <= GetCurPos(cTextBox).X - 1 Then
.SelStart = .SelStart - ((GetCurPos(cTextBox).X - 1) - fPos)
Else
.SelStart = .SelStart + (fPos - (GetCurPos(cTextBox).X - 1))
End If
.SelLength = eXMatCol(0).Length
.SelColor = &HC000&
End With
End If
With cTextBox
.SelStart = rPos
.SelLength = 0
.SelColor = &H0&
End With
End Sub
Private Function IsRWord(wordText As String) As Boolean
Dim t As Variant
IsRWord = False
For Each t In aRWord()
If LCase(wordText) = LCase(t) Then
IsRWord = True
Exit Function
End If
Next
End Function

复制代码

这是vbspad的源码，bug有很多，请大家谅解：

VP2_Source.zip (111.77 KB, 下载次数: 49)
==============================================================================================================================================================================================
结语：
方法是人想出来的，路是人踩出来的，条条大路通罗马，种种方法能解题。以上是鄙人的一点拙见，仅供大家参考。
时至今日，鄙人还在编译原理和人工智能的道路上奋进。世界的发展靠的是人的联系，谨希望同大家共勉，多多交流沟通。
一个人的奋斗也离不开千千万万朋友的帮助，这里特别感谢站长@0xAA55 ，还有@tesla.angela 没有他们的支持，我很难走到今天。

0xAA55 · 发表于 2014-12-19 22:42:02

哈哈你这个看着效果真是赞！

Golden Blonde · 发表于 2014-12-19 22:42:52

没有横向滚动条，没有菜单。。。还有主界面无需使用自定义吧！

cyycoish · 发表于 2014-12-19 23:34:54

@美俪女神 {:soso_e113:} 捕获.JPG

imr2013 · 发表于 2022-11-23 21:57:18

非常棒！

W741 · 发表于 2022-11-29 17:46:52

在win10 里面行号显示有问题，还有关键字提示不会出来

liu496324 · 发表于 2023-7-6 11:01:29

很好，试一下

账号		自动登录	找回密码
密码			立即注册→加入我们