CoderHelpr 是怎样实现简单的代码对齐的?

CoderHelpr 是怎样实现简单的代码对齐的?

注意:此代码无法很好的完成代码的自动对齐.在一些特殊的代码语句.将会导致程序操作结果乱上加乱.但是要注意的是.不会破坏任何代码.一般,此代码可以满足基本的代码对齐.

Option Explicit

Public Sub AutoInd(cm As CodeModule)
Dim Tmp As String
Dim spadd As String
Dim spJian As String
Dim sp As Long
Dim n As Long
spJian = "End,Loop'"
On Error Resume Next
Dim rm As String
For n = 1 To cm.CountOfLines
Tmp = Trim(GetLine(cm, n))
rm = ""
If InStr(Tmp, "'") > 0 Then
rm = Mid(Tmp, InStr(Tmp, "'"))
Tmp = Mid(Tmp, 1, InStr(Tmp, "'") - 1)
End If
If HaveAddTxt(Tmp) = True And HaveJianTxt(Tmp) = True Then
Tmp = Space(sp) + Trim(Tmp)
SetLine cm, n, Tmp + rm
'Debug.Print sp, Tmp
ElseIf HaveAddTxt(Tmp) = True Then
Tmp = Space(sp) + Trim(Tmp)
SetLine cm, n, Tmp + rm
'Debug.Print sp, Tmp
'此处放置类型 If xxx>bbb Then Exit Sub 'dfsdfasd
'此类行符合HaveAddTxt,但是不可以使得下行缩进,
sp = setifline(Tmp) '
sp = sp + 4
Tmp = Space(sp) + Trim(GetLine(cm, n + 1))
SetLine cm, n + 1, Tmp + rm
'Debug.Print sp, Tmp
ElseIf HaveJianTxt(Tmp) = True Then
sp = sp - 4
Tmp = Space(IIf(sp > 0, sp, 0)) + Trim(Tmp)
SetLine cm, n, Tmp + rm
'Debug.Print sp, Tmp
Else
Tmp = Space(sp) + Trim(Tmp)
SetLine cm, n, Tmp + rm
'Debug.Print sp, Tmp
End If
Next n
End Sub

Public Function setifline(sline As String) As Long
'测试时请在立即窗口中执行此行.
'? setifline( "If xxx>fff Then'dfgsdf ")
Dim locthen As Long, tx As String, locrem As Long
Dim Tmp As String
Tmp = sline
If InStr(Tmp, "If") > 0 Then
locthen = InStr(Tmp, " Then") + 5
tx = Mid(Trim(Tmp), locthen)
locrem = InStr(tx, "'")
If locrem > 0 Then
tx = Mid(tx, 1, locrem - 1)
End If
tx = Trim(tx)
If tx <> "" Then
setifline = -4
End If
End If
End Function

Function HaveAddTxt(Code As String) As Boolean
Dim spadd As String, ary() As String
Dim sx As Variant
spadd = " Sub, Function,With,If,Select,Do,For"
ary = Split(spadd, ",")
For Each sx In ary
HaveAddTxt = InStr(Code, sx + " ") > 0
If HaveAddTxt = True Then Exit For
Next
End Function

Function HaveJianTxt(Code As String) As Boolean
Dim spadd As String, ary() As String
Dim sx As Variant
spadd = "End ,Loop ,Next"
ary = Split(spadd, ",")
For Each sx In ary
HaveJianTxt = Mid(Trim(Code), 1, Len(sx)) = sx
If HaveJianTxt = True Then Exit For
Next
End Function

Public Function GetLine(cm As CodeModule, nLine As Long) As String
GetLine = cm.Lines(nLine, 1)
End Function

Public Function SetLine(cm As CodeModule, nLine As Long, Text As String)
On Error Resume Next
cm.ReplaceLine nLine, Text
End Function

Published At
Categories with Web编程
Tagged with
comments powered by Disqus