-
Notifications
You must be signed in to change notification settings - Fork 32
/
LineNumbering.bas
223 lines (200 loc) · 7.97 KB
/
LineNumbering.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
Attribute VB_Name = "LineNumbering_Module"
' #VBIDEUtils#************************************************************
' * Programmer Name : removed
' * Web Site : http://www.ppreview.net
' * E-Mail : removed
' * Date : 10/02/2000
' * Time : 15:11
' * Module Name : LineNumbering_Module
' * Module Filename : LineNumbering.bas
' **********************************************************************
' * Comments :
' *
' *
' **********************************************************************
Option Explicit
Public Sub AddLineNumbering(bRemove As Boolean)
' #VBIDEUtils#************************************************************
' * Programmer Name : removed
' * Web Site : http://www.ppreview.net
' * E-Mail : removed
' * Date : 10/02/2000
' * Time : 15:11
' * Module Name : LineNumbering_Module
' * Module Filename : LineNumbering.bas
' * Procedure Name : AddLineNumbering
' * Parameters :
' **********************************************************************
' * Comments :
' *
' *
' **********************************************************************
Dim modCode As VBIDE.CodeModule
Dim nLine As Long
Dim nStart As Long
Dim nEnd As Long
Dim sProcName As String
Dim nProcType As vbext_ProcKind
Dim sLine As String
Dim sTemp As String
Dim bSkipNextLine As Boolean
Dim bOldLine As Boolean
Dim sTmp As String
Dim nCount As Integer
Dim nI As Integer
Dim nLineNum As Long
Dim cHourglass As class_Hourglass
Set cHourglass = New class_Hourglass
Set modCode = VBInstance.ActiveCodePane.CodeModule
frmProgress.MessageText = "Numbering all procedures"
frmProgress.Maximum = 0
frmProgress.Show
nCount = 0
For nI = 1 To modCode.members.Count
If (modCode.members(nI).Type = 5) Or (modCode.members(nI).CodeLocation <= modCode.CountOfDeclarationLines) Then
' *** Declaration
Else
nCount = nCount + 1
End If
Next
frmProgress.Maximum = nCount
frmProgress.Show
DoEvents
nCount = 1
' *** First procedure is after all module-level declarations
nLine = modCode.CountOfDeclarationLines + 1
If nLine < modCode.CountOfLines Then
' *** Get name of first procedure
sProcName = modCode.ProcOfLine(nLine, nProcType)
Do While sProcName > ""
frmProgress.Progress = nCount
DoEvents
nCount = nCount + 1
nStart = modCode.ProcBodyLine(sProcName, nProcType)
nEnd = modCode.ProcStartLine(sProcName, nProcType) _
+ modCode.ProcCountLines(sProcName, nProcType) - 2
nLineNum = 1
bSkipNextLine = True ' *** Skip procedure declaration line, but still process incase it has a line-contination
For nLine = nStart To nEnd Step 1
sLine = modCode.Lines(nLine, 1)
sTemp = Trim$(sLine)
' *** Skip blank lines, comments, and compilation constants
If Not bSkipNextLine Then
If LineNumberEnd(sLine) = 0 Then
' *** No Line numbering
sTmp = Trim$(LCase$(sLine))
If (sTmp = "") Or _
(sTmp = "end sub") Or _
(sTmp = "end function") Or _
(sTmp = "end property") Or _
(left(sTmp, 1) = "#") Or _
(left(sTmp, 1) = "'") Or _
(left(sTmp, 3) = "rem") Or _
(left(sTmp, 3) = "dim") Then
' *** Do nothing
Else
If bRemove = False Then
' *** Add line numbering
'modCode.ReplaceLine nLine, (nLine - nStart) & " " & sLine
modCode.ReplaceLine nLine, nLineNum & " " & sLine
nLineNum = nLineNum + 1
End If
End If
Else
' *** Else already has line number Remove it
bOldLine = False
Do While Len(sLine) > 0 And IsNumeric(left(sLine, 1))
sLine = Mid$(sLine, 2)
bOldLine = True
Loop
On Error Resume Next
If bOldLine Then sLine = Mid$(sLine, 2)
sTmp = Trim$(LCase$(sLine))
If (sTmp = "") Or _
(sTmp = "end sub") Or _
(sTmp = "end function") Or _
(sTmp = "end property") Or _
(left(sTmp, 1) = "#") Or _
(left(sTmp, 1) = "'") Or _
(left(sTmp, 3) = "rem") Or _
(left(sTmp, 3) = "dim") Then
' *** Do nothing
Else
If bRemove = False Then
' *** Add line numbering
modCode.ReplaceLine nLine, (nLine - nStart) & " " & sLine
Else
' *** Remove line numbering
modCode.ReplaceLine nLine, sLine
End If
End If
End If
End If
bSkipNextLine = SkipNextLine(sLine)
Next
' *** Find next procedure
nLine = modCode.ProcStartLine(sProcName, nProcType) + modCode.ProcCountLines(sProcName, nProcType)
If nLine > modCode.CountOfLines Then Exit Do '-------------------------\/
sProcName = modCode.ProcOfLine(nLine, nProcType)
Loop
End If
Unload frmProgress
Set frmProgress = Nothing
End Sub
Private Function SkipNextLine(sLine As String) As Boolean 'returns true if should not put a Line Number on next line of code 'because either Line Continuation or Select Case
' #VBIDEUtils#************************************************************
' * Programmer Name : removed
' * Web Site : http://www.ppreview.net
' * E-Mail : removed
' * Date : 10/02/2000
' * Time : 15:11
' * Module Name : LineNumbering_Module
' * Module Filename : LineNumbering.bas
' * Procedure Name : SkipNextLine
' * Parameters :
' * sLine As String
' **********************************************************************
' * Comments :
' *
' *
' **********************************************************************
If InStr(sLine, " _") Then
SkipNextLine = True
ElseIf left$(LCase$(Trim$(sLine)), 6) = "select" Then
SkipNextLine = True
End If
End Function
Private Function LineNumberEnd(sLine As String) As Integer 'if sLine starts with a line number, returns the number of digits plus 1 'LineNumberEnd("12 If x = 0 Then") = 3
' #VBIDEUtils#************************************************************
' * Programmer Name : removed
' * Web Site : http://www.ppreview.net
' * E-Mail : removed
' * Date : 10/02/2000
' * Time : 15:11
' * Module Name : LineNumbering_Module
' * Module Filename : LineNumbering.bas
' * Procedure Name : LineNumberEnd
' * Parameters :
' * sLine As String
' **********************************************************************
' * Comments :
' *
' *
' **********************************************************************
' *** Useful for removing line numbers
Dim nPos As Long
Dim sWord As String
nPos = InStr(sLine, " ")
If nPos > 0 Then
sWord = Trim$(left$(sLine, nPos - 1))
If IsNumeric(sWord) Then
LineNumberEnd = nPos
End If
Else
sWord = Trim$(sLine)
If IsNumeric(sWord) Then
' *** Line consists of line number only
LineNumberEnd = Len(sLine)
End If
End If
End Function