技术宅的结界

 找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 2960|回复: 5
收起左侧

【VB】论ide部分功能的实现(语法高亮),(智能感知)

[复制链接]

85

主题

175

回帖

3988

积分

用户组: 管理员

No. 418

UID
418
精华
14
威望
53 点
宅币
1974 个
贡献
1578 次
宅之契约
0 份
在线时间
252 小时
注册时间
2014-8-9
发表于 2014-12-19 22:31:35 | 显示全部楼层 |阅读模式

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

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

x
1f1c367adab44aed8aac5a4eb11c8701a08bfbbb.jpg
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,如图: 155094eef01f3a29074c32649b25bc315d607c9c.jpg
[Visual Basic] 纯文本查看 复制代码
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源码。
[Visual Basic] 纯文本查看 复制代码
'这是我用来识别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
[Visual Basic] 纯文本查看 复制代码
'这段代码用来检测变量
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, 下载次数: 8)
那么在我的源码中,正则匹配部分位于Module2中:
[Visual Basic] 纯文本查看 复制代码
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, 下载次数: 31)
==============================================================================================================================================================================================
结语:
方法是人想出来的,路是人踩出来的,条条大路通罗马,种种方法能解题。以上是鄙人的一点拙见,仅供大家参考。
时至今日,鄙人还在编译原理和人工智能的道路上奋进。世界的发展靠的是人的联系,谨希望同大家共勉,多多交流沟通。
一个人的奋斗也离不开千千万万朋友的帮助,这里特别感谢站长@0xAA55 ,还有@tesla.angela 没有他们的支持,我很难走到今天。
In the beginning I was not the best.
And the world was also not the best.
But I still know that I am who I am.
Because I think that it is good.
I have been working hard.
I have been keeping growth with the world.
And it was so.
回复

使用道具 举报

1099

主题

1600

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
242
威望
681 点
宅币
23204 个
贡献
46153 次
宅之契约
0 份
在线时间
2207 小时
注册时间
2014-1-26
发表于 2014-12-19 22:42:02 来自手机 | 显示全部楼层
哈哈 你这个看着效果真是赞!

52

主题

231

回帖

8973

积分

用户组: 管理员

UID
77
精华
16
威望
237 点
宅币
7890 个
贡献
246 次
宅之契约
0 份
在线时间
229 小时
注册时间
2014-2-22
发表于 2014-12-19 22:42:52 | 显示全部楼层
没有横向滚动条,没有菜单。。。还有主界面无需使用自定义吧!

85

主题

175

回帖

3988

积分

用户组: 管理员

No. 418

UID
418
精华
14
威望
53 点
宅币
1974 个
贡献
1578 次
宅之契约
0 份
在线时间
252 小时
注册时间
2014-8-9
 楼主| 发表于 2014-12-19 23:34:54 | 显示全部楼层
In the beginning I was not the best.
And the world was also not the best.
But I still know that I am who I am.
Because I think that it is good.
I have been working hard.
I have been keeping growth with the world.
And it was so.

0

主题

48

回帖

67

积分

用户组: 小·技术宅

UID
8099
精华
0
威望
2 点
宅币
15 个
贡献
0 次
宅之契约
0 份
在线时间
9 小时
注册时间
2022-10-22
发表于 2022-11-23 21:57:18 | 显示全部楼层
非常棒!
回复

使用道具 举报

0

主题

16

回帖

61

积分

用户组: 小·技术宅

UID
7859
精华
0
威望
2 点
宅币
41 个
贡献
0 次
宅之契约
0 份
在线时间
5 小时
注册时间
2022-5-24
发表于 2022-11-29 17:46:52 | 显示全部楼层
在win10 里面行号显示有问题,还有关键字提示不会出来

本版积分规则

QQ|申请友链||Archiver|手机版|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2023-2-5 23:06 , Processed in 0.064507 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表