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
