| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 10926 人关注过本帖, 1 人收藏
标题:VB语法着色器
只看楼主 加入收藏
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
  问题点数:0  回复次数:41   
VB语法着色器
历经N天完成的作品,和大家分享一下.

本作品主使用了以下技术:
1.VB语法着色(核心功能,绝对原创)
2.监视剪贴板并自动替换(部分参考网络文章)
3.智能分析是否VB代码(原创,不过这个功能写的比较简单,所以智能程度不够,只是意思意思而已)
4.全局热键(部分参考网络文章)
5.托盘图标及Explorer崩溃后重建任务栏图标(部分参考网络文章)
6.一个封装了INI文件读写的类(原创)
7.自定义着色方案,支持着色方案导入导出(也算原创吧,不过这个没啥技术含量)

先来张图


下边是源码

压缩包内的CodeStyle文件夹内已经放了一个UBB的着色方案

希望大家提点意见

等静哥审核通过后再来几段效果代码
附件: 您没有浏览附件的权限,请 登录注册
搜索更多相关主题的帖子: VB语法  
2008-06-11 19:39
三断笛
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:31
帖 子:1621
专家分:1617
注 册:2007-5-24
  得分:0 
不错不错  支持版主!


太谦虚啦!
2008-06-22 16:52
klj123
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2008-6-22
  得分:0 
不错不错  支持版主!
2008-06-22 18:48
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
  得分:0 
看看效果
'VB语法高亮(by 永夜的极光) V1.03
Option Explicit

Private Type
Record
  Pos As Integer
  iType As Integer
End Type
Private
Rec() As Record
Private RecCount As Integer
Private
RecMax As Integer
Private
aWord$(), aLine$()


Public Function isKeyWord(str As String[color=Magenta]) As Boolean
  Dim[/color] i%
  For i = [color=Blue]0 To UBound([/color]aKeyWord)
    [color=Green]If
StrComp([/color]str, aKeyWord(i), vbTextCompare) = 0 Then
      isKeyWord = True
      Exit Function
    End If
  Next

  isKeyWord = False
End Function

Public Function
isSymbol(str As String[color=Magenta]) As Boolean
  Dim[/color] i%
  For i = [color=Blue]0 To UBound([/color]aSymbol)
    [color=Green]If
StrComp([/color]str, aSymbol(i), vbTextCompare) = 0 Then
      isSymbol = True
      Exit Function
    End If
  Next

  isSymbol = False
End Function

Public Function
isFunction(str As String[color=Magenta]) As Boolean
  Dim[/color] i%
  For i = [color=Blue]0 To UBound([/color]aFunction)
    [color=Green]If
StrComp([/color]str, aFunction(i), vbTextCompare) = 0 Then
      isFunction = True
      Exit Function
    End If
  Next

  isFunction = False
End Function

Public Function
Encode(str As String[color=Magenta]) As String
  If[/color] str = "" Then Exit Function
  ScanRTB str
  Dim s$, i%, j%, tmpS
  
  s = [color=MediumTurquoise]Left([/color]str, Rec([color=Blue]0).[/color]Pos - [color=Blue]1)[/color]
  If CodeType = HTML Then s = Replace(Replace(Replace(s, [color=DarkOliveGreen]"<", "&lt"),[/color] vbCrLf, [color=DarkOliveGreen]"<br>" &[/color] vbCrLf), [color=DarkOliveGreen]" ", "&nbsp;")[/color]
  
  For i = 0 To RecCount - 1
    If Rec(i).iType >= 0 Then
      If
i Mod 2 [color=Magenta]= 1[/color] Then
        s = s & [color=MediumTurquoise]IIf([/color]Code(Rec(i).iType).Enable, Code(Rec(i).iType).[color=Green]End, "")[/color]
      Else
        s = s & [color=MediumTurquoise]IIf([/color]Code(Rec(i).iType).Enable, Code(Rec(i).iType).Start, [color=DarkOliveGreen]"")[/color]
      End If
      j = i
      While Rec(i + [color=Blue]1).[/color]iType < 0
        i = i + 1
      Wend
      tmpS = [color=MediumTurquoise]Mid([/color]str, Rec(j).Pos, Rec(i + [color=Blue]1).[/color]Pos - Rec(j).Pos)
      If CodeType = HTML Then tmpS = Replace(Replace(Replace(tmpS, [color=DarkOliveGreen]"<", "&lt"),[/color] vbCrLf, [color=DarkOliveGreen]"<br>" &[/color] vbCrLf), [color=DarkOliveGreen]" ", "&nbsp;")[/color]
      s = s & tmpS
    End If
  Next
  If
Code(CGLOBAL).Enable = True Then
    Encode = Code(CGLOBAL).Start & s & Code(CGLOBAL).End
  Else

    Encode = s
  End If
End Function

Private Sub
AddRecord(Pos As Integer, iType As Integer[color=Magenta])
  If[/color] RecCount = RecMax Then
    RecMax = RecMax + 1000
    ReDim Preserve Rec(RecMax)
  End If
  Rec(RecCount).Pos = Pos
  Rec(RecCount).iType = iType
  RecCount = RecCount + 1
End Sub

Private Sub
ScanRecord()
  Dim ColorStack%()
  Dim i%, j%, LastPos%
  ReDim ColorStack(MAXCOLOR)
  For i = 0 To MAXCOLOR - 1
    ColorStack(i) = -1
  Next
  For
i = 0 To RecCount - 2 Step 2
    If Code(Rec(i).iType).Enable = False Then
      For
j = 0 To MAXCOLOR - 1
        ColorStack(j) = -1
      Next
    Else

      LastPos = ColorStack(Rec(i).iType)
      If LastPos = -1 Then
        ColorStack(Rec(i).iType) = i
      Else
        If
Rec(LastPos + [color=Blue]1).[/color]iType = -1 Then
          Rec(Rec(LastPos + [color=Blue]1).[/color]Pos).iType = -1
        Else
          Rec(LastPos + [color=Blue]1).[/color]iType = -1
        End If
        Rec(LastPos + [color=Blue]1).[/color]Pos = i + 1
        Rec(i).iType = -1
        For j = 0 To MAXCOLOR - 1
          If ColorStack(j) > LastPos Then
            ColorStack(j) = -1
          End If
        Next
      End If
    End If
  Next
End Sub

Private Sub
ScanRTB(str As String[color=Magenta])
  Dim[/color] Pos%, i%
  If str = "" Then Exit Sub
  RecCount = 0
  aLine = [color=MediumTurquoise]Split([/color]str, vbCrLf)
  Pos = 0
  ScanLine aLine([color=Blue]0),[/color] 0, 1
  For i = [color=Blue]1 To UBound([/color]aLine)
    Pos = [color=MediumTurquoise]InStr([/color]Pos + 1, str, vbCrLf)
    ScanLine aLine(i), Pos + 1, 1
  Next
  If
CanNesting Then ScanRecord
  Rec(RecCount).Pos = [color=MediumTurquoise]Len([/color]str) + 1
  Rec(RecCount).iType = 0
End Sub

Private Sub
ScanLine(str As String, Offset As Long, iStep As Integer[color=Magenta])
  Dim[/color] Pos1%, Pos2%, i%
  Select Case iStep
    Case 1:
      Pos1 = [color=MediumTurquoise]InStr([/color]1, str, [color=DarkOliveGreen]"'",[/color] vbTextCompare)
      If Pos1 <> 0 Then
        Dim
c%
        c = 0
        Pos2 = [color=MediumTurquoise]InStr(1, Left([/color]str, Pos1 - [color=Blue]1), """",[/color] vbTextCompare)
        While Pos2 <> 0
          c = c + 1
          Pos2 = [color=MediumTurquoise]InStr([/color]Pos2 + [color=Blue]1, Left([/color]str, Pos1 - [color=Blue]1), """",[/color] vbTextCompare)
        Wend
        If
c Mod 2 [color=Magenta]= 1[/color] Then
          Pos1 = [color=MediumTurquoise]InStr([/color]Pos1, str, [color=DarkOliveGreen]"""",[/color] vbTextCompare)
          ScanLine Left(str, Pos1), Offset, 2
          ScanLine Mid(str, Pos1 + [color=Blue]1),[/color] Offset + Pos1, 1
        Else
          ScanLine Left(str, Pos1 - [color=Blue]1),[/color] Offset, 2 '
          AddRecord Offset + Pos1, CCOMMENT
          AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CCOMMENT
        End If
      Else

        ScanLine str, Offset, [color=Blue]2
      [color=Green]End If
    Case
2[/color]:[/color]
      If str = "" Then
        Exit Sub
      End If

      Pos1 = [color=MediumTurquoise]InStr([/color]1, str, [color=DarkOliveGreen]"""",[/color] vbTextCompare)
      If Pos1 <> 0 Then
        If
Pos1 <> 1 Then
          ScanLine Left(str, Pos1 - [color=Blue]1),[/color] Offset, 3
        End If
        Pos2 = [color=MediumTurquoise]InStr([/color]Pos1 + 1, str, [color=DarkOliveGreen]"""",[/color] vbTextCompare)
        AddRecord Offset + Pos1, CSTRING
        AddRecord Offset + Pos2 + 1, CSTRING
        ScanLine Mid(str, Pos2 + [color=Blue]1),[/color] Offset + Pos2, 2
      Else
        ScanLine str, Offset, [color=Blue]3
      [color=Green]End If
    Case
3[/color]:[/color]
      If str = "" Then
        Exit Sub
      End If

      aWord = [color=MediumTurquoise]Split([/color]str, [color=DarkOliveGreen]" ")[/color]
      Pos1 = 0
      ScanLine aWord([color=Blue]0),[/color] Offset, 4
      For i = [color=Blue]1 To UBound([/color]aWord)
        Pos1 = [color=MediumTurquoise]InStr([/color]Pos1 + 1, str, [color=DarkOliveGreen]" ")[/color]
        ScanLine aWord(i), Offset + Pos1, [color=Blue]4
      [color=Green]Next
    Case
4[/color]:[/color]
      If str = "" Then
        Exit Sub
      End If

      Pos1 = [color=MediumTurquoise]InStr([/color]1, str, [color=DarkOliveGreen]".")[/color]
      If Pos1 > 1 Then
        If
IsNumeric([color=MediumTurquoise]Mid([/color]str, Pos1 - [color=Blue]1, 1))[/color] And IsNumeric([color=MediumTurquoise]Mid([/color]Pos1 + [color=Blue]1, 1))[/color] Then
          ScanLine str, Offset, 5
        Else
          ScanLine Left(str, Pos1 - [color=Blue]1),[/color] Offset, 5
          AddRecord Offset + Pos1, CSYMBOL
          AddRecord Offset + Pos1 + 1, CSYMBOL
          ScanLine Mid(str, Pos1 + [color=Blue]1),[/color] Offset + Pos1, 4
        End If
      ElseIf
Pos1 = 1 Then
        AddRecord Offset + Pos1, CSYMBOL
        AddRecord Offset + Pos1 + 1, CSYMBOL
        ScanLine Mid(str, Pos1 + [color=Blue]1),[/color] Offset + Pos1, 4
      Else
        ScanLine str, Offset, [color=Blue]5
      [color=Green]End If
         
    Case
5[/color]:[/color]
      If str = "" Then
        Exit Sub
      End If
      If
IsNumeric(str) Then
        AddRecord Offset + 1, CNUMBER
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CNUMBER
        Exit Sub
      End If
      For
i = [color=Blue]0 To UBound([/color]aSymbol)
        Pos1 = [color=MediumTurquoise]InStr([/color]1, str, aSymbol(i))
        If Pos1 <> 0 Then '如果包含
          ScanLine Left(str, Pos1 - [color=Blue]1),[/color] Offset, 5
          AddRecord Offset + Pos1, CSYMBOL
          AddRecord Offset + Pos1 + [color=MediumTurquoise]Len([/color]aSymbol(i)), CSYMBOL
          ScanLine Mid(str, Pos1 + [color=MediumTurquoise]Len([/color]aSymbol(i))), Offset + Pos1 + [color=MediumTurquoise]Len([/color]aSymbol(i)) - 1, 5
          Exit Sub
        End If
      Next

      ScanLine str, Offset, [color=Blue]6
    [color=Green]Case
6[/color]:[/color]
      If str = "" Then
        Exit Sub
      End If
      If
str = "_" Then
        AddRecord Offset + 1, CSYMBOL
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CSYMBOL
      ElseIf IsNumeric(str) Then
        AddRecord Offset + 1, CNUMBER
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CNUMBER
      ElseIf isFunction(str) Then
        AddRecord Offset + 1, CFUNCTION
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CFUNCTION
      ElseIf isKeyWord(str) Then
        AddRecord Offset + 1, CKEYWORD
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CKEYWORD
      Else
        AddRecord Offset + 1, CNORMAL
        AddRecord Offset + [color=MediumTurquoise]Len([/color]str) + 1, CNORMAL
      End If
    Case Else
:
      Debug.Print "Error Step"
  End Select
End Sub

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-22 21:25
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
  得分:0 
这几个函数就是语法分析的核心算法啦

Public Function Encode(str As String) As String
总的对外接口

Private Sub ScanRTB(str As String)
本来是没有监视剪贴板功能的,需要高亮的代码放在RichTextBox里面,所以就叫了这么个函数名字,后来把RichTextBox去掉了,这个函数名也不知道叫什么好,就没改了

Private Sub ScanLine(str As String, Offset As Long, iStep As Integer)
逐行分析,这个就是核心的核心啦。类似于二叉树的形式

Private Sub ScanRecord()
这个函数是为了合并一些可以合并的标签

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-22 21:33
三断笛
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:31
帖 子:1621
专家分:1617
注 册:2007-5-24
  得分:0 
顶!
以后发代码就不用自己写代码做高亮啦~!
2008-06-22 21:49
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
  得分:0 
三断笛看看有啥BUG没,估计还是有不少的

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-22 21:55
三断笛
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:31
帖 子:1621
专家分:1617
注 册:2007-5-24
  得分:0 
呵呵 你的代码我有时间可还得好好研究一下呢  比我写的规范多了  很多地方都值得学习      这样的好作品得顶起来呀!

BUG还没发现  没仔细去读代码  不过在运行这个程序的时候再打开VB,有时候会弹出作用于某某方法失败的提示     



好帖,顶呀!!!!!!!!!!
2008-06-23 23:21
jxyga111
Rank: 8Rank: 8
来 自:中華人民共和國
等 级:贵宾
威 望:32
帖 子:6012
专家分:895
注 册:2008-3-21
  得分:0 
樓主辛苦了

烈焰照耀世界,斌凍凍千萬裏
2008-06-24 08:13
jxyga111
Rank: 8Rank: 8
来 自:中華人民共和國
等 级:贵宾
威 望:32
帖 子:6012
专家分:895
注 册:2008-3-21
  得分:0 
LZ我的是繁體系統可否給個繁體的,到我這邊是亂碼啊,謝了

烈焰照耀世界,斌凍凍千萬裏
2008-06-24 08:20







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.058896 second(s), 7 queries.
Copyright©2004-2019, BCCN.NET, All Rights Reserved