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

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

先来张图
图片附件: 游客没有浏览图片的权限,请 登录注册


下边是源码
VB代码着色V1.03.rar (48.06 KB)

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

希望大家提点意见

等静哥审核通过后再来几段效果代码
搜索更多相关主题的帖子: VB语法 
2008-06-11 19:39
永夜的极光
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: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
三断笛看看有啥BUG没,估计还是有不少的

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-22 21:55
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
繁体的怎么弄?我没做过繁体的,是不是把文字都换成繁体的就行呢?

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-24 09:25
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
[bo][un]冰镇柠檬汁儿[/un] 在 2008-6-26 14:07 的发言:[/bo]

颜色不好看呀

颜色可以自己改的,我没啥艺术天赋,所以随便弄个颜色就算了

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-26 15:53
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
不可能吧?提示什么错误?

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-26 16:30
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
哦,那估计是你没装VB或者VB没装全,少了几个组件,只要看提示缺少哪个ocx,把名字打到百度里边,搜索一下,然后下载这个文件到c:\windows\system32里面就可以了

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-26 17:37
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
这是VB本身的特点决定的,如果做成安装程序,是可以实现的,但是我没做过,而且做成安装程序可能会变的很大.
毕竟这里是VB板块,而且我这个工具是专门针对VB代码的,如果没装VB,这个工具MS也没啥用.

当然咯,总而言之一句话,就是我太懒了 ....

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-26 20:32
永夜的极光
Rank: 6Rank: 6
等 级:贵宾
威 望:27
帖 子:2721
专家分:1
注 册:2007-10-9
收藏
得分:0 
飞燕要啥资料?

从BFS(Breadth First Study)到DFS(Depth First Study)
2008-06-27 08:31
快速回复:VB语法着色器
数据加载中...
 
   



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

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