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

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

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

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 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

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

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