home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Callers_Ad2211429122011.psc / CallersAddin / modVBE.bas < prev   
BASIC Source File  |  2011-09-12  |  30KB  |  724 lines
  1. Attribute VB_Name = "modVBE"
  2. Option Explicit
  3.  
  4. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal lLenB As Long)
  5.  
  6. ' Application reference - do not store in the Connect designer
  7. Public oVBE As VBIDE.VBE
  8. Public oPopupMenu As Office.CommandBar
  9.  
  10. Private cMenuItem() As cMenuItem
  11. Private saCallers() As String
  12. Private iaCallers() As Long
  13. Private fExempt As Long
  14.  
  15. Public nCallers As Long
  16.  
  17. Public Sub RedimCallers(ByVal NumCallers As Long)
  18.     ReDim Preserve saCallers(0 To NumCallers) As String
  19.     ReDim Preserve iaCallers(0 To NumCallers) As Long
  20.     ReDim Preserve cMenuItem(1 To NumCallers) As cMenuItem
  21. End Sub
  22.  
  23. Public Sub EraseCallerArrays()
  24.     Erase saCallers()
  25.     Erase iaCallers()
  26.     Do While nCallers
  27.         cMenuItem(nCallers).Remove
  28.         Set cMenuItem(nCallers) = Nothing
  29.         nCallers = nCallers - 1
  30.     Loop
  31.     Erase cMenuItem()
  32. End Sub
  33.  
  34. Public Sub CodePaneMenuItem_Click(sMenuCaption As String, ByVal Idx As Long)
  35.     Dim sCompName As String
  36.     Dim lStartLine As Long
  37.     Dim lTopLine As Long
  38.     Dim i As Long
  39.   On Error GoTo ErrHandler
  40.     i = InStr(1, sMenuCaption, ".")
  41.     sCompName = Left$(sMenuCaption, i - 1)
  42.   On Error GoTo ErrWith
  43.     With oVBE.ActiveVBProject.VBComponents(sCompName).CodeModule
  44.        lStartLine = iaCallers(Idx)
  45.        lTopLine = lStartLine - CLng(.CodePane.CountOfVisibleLines / 2.5)
  46.        If lTopLine < 1 Then lTopLine = 1
  47.        .CodePane.TopLine = lTopLine
  48.        Call .CodePane.SetSelection(lStartLine, 1, lStartLine, 1)
  49.        If Not oVBE.ActiveCodePane Is .CodePane Then
  50.           .Parent.Activate ' Activate the component
  51.        End If
  52.       .CodePane.Show
  53. ErrWith:
  54.     End With
  55. ErrHandler:
  56.  If Err Then LogError "modVBE.CodePaneMenuItem_Click", sMenuCaption
  57. End Sub
  58.  
  59. Public Sub DisplayCallee()
  60.     CodePaneMenuItem_Click saCallers(0), 0
  61. End Sub
  62.  
  63. Public Sub ResetContextMenu()
  64.    Do While nCallers
  65.       cMenuItem(nCallers).Remove
  66.       Set cMenuItem(nCallers) = Nothing
  67.       nCallers = nCallers - 1
  68.    Loop
  69.    If Not oPopupMenu Is Nothing Then
  70.       Call oPopupMenu.Delete
  71.       Set oPopupMenu = Nothing
  72.    End If
  73. End Sub
  74.  
  75. Public Sub RefreshProjectReferences()
  76.           ' Adapted from Add Error Handling addin by Kamilche
  77.           Dim eProcKind As vbext_ProcKind
  78.           Dim oComp As VBComponent
  79.           Dim oCodePane As CodePane
  80.           Dim oThisMod As CodeModule
  81.           Dim oNextMod As CodeModule
  82.  
  83.           Dim i As Long, j As Long, k As Long
  84.           Dim lCurrentLine As Long
  85.           Dim lCurrentCol As Long
  86.           Dim vbeScope As vbext_Scope
  87.           Dim sProcName As String
  88.           Dim sCompName As String
  89.           Dim sProcRef As String
  90.  
  91. 130      On Error GoTo ErrHandler
  92. 140        Set oCodePane = oVBE.ActiveCodePane
  93.           ' Exit if we're not in the code pane
  94. 150        If oCodePane Is Nothing Then Exit Sub
  95. 160        Set oThisMod = oCodePane.CodeModule
  96.  
  97.           ' Retrieve the current line the cursor is on
  98. 170        oCodePane.GetSelection lCurrentLine, lCurrentCol, j, k
  99.  
  100.           ' Retrieve the procedure name and the ProcKind
  101. 180        sProcName = oThisMod.ProcOfLine(lCurrentLine, eProcKind)
  102.  
  103.            fExempt = 0
  104.            If LenB(sProcName) Then
  105. 185            vbeScope = oThisMod.Members(sProcName).Scope
  106.            Else 'LenB(sProcName) = 0
  107. 190            sProcName = GetDeclareName(oThisMod, lCurrentLine, lCurrentCol, vbeScope)
  108.            End If
  109.  
  110. 200        If LenB(sProcName) Then
  111.  
  112. 210           sCompName = oThisMod.Parent.Name
  113. 220           sProcRef = sCompName & "." & sProcName
  114.  
  115. 230           If sProcRef = saCallers(0) Then Exit Sub
  116. 240           saCallers(0) = sProcRef
  117. 250           iaCallers(0) = lCurrentLine
  118. 260           Call ResetContextMenu
  119.  
  120.              ' Search current code module for references to current procedure
  121. 270           FindCallers oThisMod, sProcName, vbNullString, lCurrentLine
  122.  
  123. 280           If vbeScope <> vbext_Private Then ' vbext_Friend | vbext_Public
  124.  
  125.                  ' Search the other components for references to current procedure
  126. 290               For Each oComp In oVBE.ActiveVBProject.VBComponents
  127. 300                  If Not oComp Is Nothing Then
  128. 310                   If Not oComp.Name = vbNullString Then
  129. 320                    If Not oComp Is oThisMod.Parent Then
  130.  
  131.                          On Error Resume Next
  132. 330                       Set oNextMod = Nothing  ' Bug fix Dec 18, 2010
  133.                            Select Case oComp.Type
  134.                               Case vbext_ct_RelatedDocument, vbext_ct_ResFile
  135.                                ' Related docs, res files throw exception
  136.                               Case Else
  137. 340                            Set oNextMod = oComp.CodeModule
  138.                               'Case vbext_ct_DocObject
  139.                               'Case vbext_ct_ClassModule
  140.                               'Case vbext_ct_MSForm
  141.                               'Case vbext_ct_PropPage
  142.                               'Case vbext_ct_StdModule
  143.                               'Case vbext_ct_UserControl
  144.                               'Case vbext_ct_VBForm
  145.                               'Case vbext_ct_VBMDIForm
  146.                               'Case vbext_ct_ActiveXDesigner
  147.                            End Select
  148.                           On Error GoTo ErrHandler
  149.  
  150. 350                        If Not oNextMod Is Nothing Then
  151. 360                            FindCallers oNextMod, sProcName, sCompName
  152. 370                        End If
  153. 380                     End If
  154.                       End If
  155.                     End If
  156. 390               Next oComp
  157. 400           End If
  158.  
  159. 410           If nCallers Then
  160.                  ' (Re-)create the popup menu using the Position argument
  161. 420               Set oPopupMenu = oVBE.CommandBars.Add(Name:="Callers", Position:=msoBarPopup)
  162.  
  163. 430               For i = 1 To nCallers
  164. 440                   Set cMenuItem(i) = New cMenuItem ' Create new item in popup-menu
  165. 450                   cMenuItem(i).Add oPopupMenu, saCallers(i), i, LoadResPicture(102, vbResBitmap)
  166. 460               Next
  167. 470           End If
  168.  
  169. 480       Else 'LenB(sProcName) = 0
  170. 490           saCallers(0) = vbNullString
  171. 500           Call ResetContextMenu
  172. 510       End If
  173.  
  174. ErrHandler:
  175.       If Err Then LogError "modVBE.RefreshProjectReferences", sProcRef
  176. End Sub
  177.  
  178. Private Function GetInstanceName(oCodeMod As CodeModule, sClassName As String, ByVal lStartLine As Long, ByVal lEndLine As Long) As String
  179.           Dim sCodeLine As String
  180.           Dim lLineEnd As Long
  181.           Dim lStartCol As Long
  182.           Dim lEndColumn As Long
  183.           Dim i As Long, j As Long
  184.           Dim fTryAgain As Boolean
  185. 610     On Error GoTo EndWith
  186. 620       With oCodeMod
  187. 630        lStartCol = 1
  188.            lEndColumn = -1
  189.            lLineEnd = lEndLine
  190. 640        Do
  191.             ' Search the procedure for class instantiation (also frm As New form, ctl As New ctrl, etc)
  192. 650          Do While .Find(sClassName, lStartLine, lStartCol, lEndLine, lEndColumn, True, True)
  193. 660              sCodeLine = .Lines(lStartLine, 1)
  194. 670              If IsCode(sCodeLine, lStartCol, lEndColumn) Then
  195. 680                  If lStartCol > 4 Then
  196. 690                      If Mid$(sCodeLine, lStartCol - 4, 4) = " As " Then
  197. 700                         j = 4   ' cClass  As 'sClassName'
  198.                            'Do While IsDelim(Mid$(sCodeLine, lStartCol - j - 1, 1))
  199. 710                         Do While IsDelimI(MidI(sCodeLine, lStartCol - j - 1))
  200. 720                             j = j + 1
  201. 730                         Loop
  202. 740                         i = j + 1
  203. 750                         Do While Not IsDelimI(MidI(sCodeLine, lStartCol - i - 1))
  204. 760                             i = i + 1
  205. 770                         Loop
  206. 780                         GetInstanceName = Mid$(sCodeLine, lStartCol - i, i - j)
  207. 790                         GoTo EndWith
  208. 800                     End If
  209. 810                 End If
  210. 820                 If lStartCol > 8 Then
  211. 830                     If Mid$(sCodeLine, lStartCol - 8, 8) = " As New " Then
  212. 840                         j = 8   ' cClass  As New 'sClassName'
  213. 850                         Do While IsDelimI(MidI(sCodeLine, lStartCol - j - 1))
  214. 860                             j = j + 1
  215. 870                         Loop
  216. 880                         i = j + 1
  217. 890                         Do While Not IsDelimI(MidI(sCodeLine, lStartCol - i - 1))
  218. 900                             i = i + 1
  219. 910                         Loop
  220. 920                         GetInstanceName = Mid$(sCodeLine, lStartCol - i, i - j)
  221. 930                         GoTo EndWith
  222. 940                     End If
  223. 950                 End If
  224. 960                 If lStartCol > 7 Then
  225. 970                     If Mid$(sCodeLine, lStartCol - 7, 7) = " = New " Then
  226. 980                         i = InStr(sCodeLine, "Set ") + 4  'Set cClass = New 'sClassName'
  227. 990                         If i > 4 And i < lStartCol - 7 Then ' Bug fix Dec 12, 2010
  228. 1000                             GetInstanceName = Mid$(sCodeLine, i, lStartCol - 7 - i)
  229. 1010                             GoTo EndWith
  230. 1020                         End If
  231. 1030                     End If
  232. 1040                 End If
  233. 1050                 If lStartCol > 3 Then
  234. 1060                     If Mid$(sCodeLine, lStartCol - 3, 3) = " = " Then
  235. 1070                         i = InStr(sCodeLine, "Set ") + 4  'Set cClass = 'sClassName'
  236. 1080                         If i > 4 And i < lStartCol - 3 Then ' Bug fix Dec 12, 2010
  237. 1090                             GetInstanceName = Mid$(sCodeLine, i, lStartCol - 3 - i)
  238. 1100                             GoTo EndWith
  239. 1110                         End If
  240. 1120                     End If
  241. 1130                 End If
  242. 1140             End If
  243. 1150             lStartCol = lEndColumn + 1
  244. 1160             lEndColumn = -1
  245.                  lEndLine = lLineEnd
  246. 1170         Loop
  247.  
  248. 1180         fTryAgain = (lLineEnd > .CountOfDeclarationLines + 1)
  249.  
  250.             ' Search the component for class instantiation (also frm As New form, ctl As New ctrl, etc)
  251.              If fTryAgain Then
  252.                lStartLine = 1
  253.                lLineEnd = .CountOfDeclarationLines + 1
  254.                lEndLine = lLineEnd
  255.                lStartCol = 1
  256.                lEndColumn = -1
  257.              End If
  258.  
  259. 1190       Loop While fTryAgain
  260.  
  261.           ' Default to Class name
  262.            GetInstanceName = sClassName
  263. EndWith:
  264.         End With
  265.     If Err Then LogError "modVBE.GetInstanceName", sClassName
  266. End Function
  267.  
  268. Private Sub FindCallers(oCodeMod As CodeModule, sProcName As String, sCompName As String, Optional ByVal lProcLine As Long)
  269.           ' Adapted from Project References addin by ':) Ulli
  270.           Dim eProcKind As vbext_ProcKind
  271.           Dim sMembName As String
  272.           Dim sInstName As String
  273.           Dim sCodeLine As String
  274.           Dim sCaller As String
  275.           Dim lStartCol As Long
  276.           Dim lEndColumn As Long
  277.           Dim lLineStart As Long
  278.           Dim lLineCount As Long
  279.           Dim lLineLen As Long
  280.           Dim lCodeLine As Long
  281.           Dim lEndLine As Long
  282.           Dim lContinue As Long
  283.           Dim fIsCode As Long
  284.           Dim fMustQualify As Long
  285.           Dim i As Long, j As Long
  286.  
  287. 1200     On Error GoTo ErrWith
  288. 1210       With oCodeMod
  289.  
  290.             ' First search in the declarations section
  291. 1220         lCodeLine = 1
  292. 1230         lEndLine = .CountOfDeclarationLines + 1
  293.  
  294. 1240         lStartCol = 1
  295. 1250         lEndColumn = -1
  296.  
  297. 1260         Do While .Find(sProcName, lCodeLine, lStartCol, lEndLine, lEndColumn, True, True)
  298.  
  299. 1270            sCodeLine = .Lines(lCodeLine, 1)
  300. 1280            If IsWholeWord(sCodeLine, lStartCol, lEndColumn) Then
  301.  
  302. 1290               fIsCode = IsCode(sCodeLine, lStartCol, lEndColumn)
  303. 1300               If fIsCode Then
  304.  
  305. 1310                  If LenB(sCompName) Then
  306. 1320                     If oVBE.ActiveVBProject.VBComponents(sCompName).Type <> vbext_ct_StdModule Then
  307. 1330                       If Not fExempt Then fMustQualify = -1
  308.                          End If
  309.                       End If
  310.  
  311. 1340                  If IsValid(oCodeMod, lCodeLine, lStartCol, sCompName, lCodeLine, fMustQualify, sProcName, lProcLine) Then
  312.  
  313. 1350                     lContinue = lCodeLine
  314. 1360                     Do While lCodeLine > 1 ' .ProcOfLine kinda thing
  315.                            'If Right$(.Lines(lCodeLine - 1, 1), 1) = "_" Then
  316. 1370                        If RightI(.Lines(lCodeLine - 1, 1), 1) = 95 Then
  317. 1380                           lCodeLine = lCodeLine - 1 ' Line continuation
  318. 1390                           sCodeLine = .Lines(lCodeLine, 1)
  319. 1400                           lLineLen = Len(sCodeLine)                       ' Check for beginning a comment
  320. 1410                           fIsCode = IsCode(sCodeLine, lLineLen, lLineLen) ' before the end of the line
  321.                                If Not fIsCode Then Exit Do
  322.                             Else
  323.                                Exit Do
  324.                             End If
  325.                          Loop
  326. 1420                     If fIsCode Then
  327. 1430                        If lCodeLine <> lProcLine Then ' lProcLine is zero if not current comp
  328.       
  329. 1440                           sMembName = GetDeclareName(oCodeMod, lCodeLine, 1)
  330. 1450                           If LenB(sMembName) And (sMembName <> sProcName) Then
  331.  
  332. 1460                              sCaller = oCodeMod.Parent.Name & "." & sMembName
  333.  
  334. 1470                              If saCallers(nCallers) <> sCaller Then
  335. 1480                                 nCallers = nCallers + 1
  336. 1490                                 If nCallers > UBound(saCallers) Then
  337. 1500                                     RedimCallers UBound(saCallers) + 100
  338. 1510                                 End If
  339. 1520                                 saCallers(nCallers) = sCaller
  340. 1530                                 iaCallers(nCallers) = lCodeLine
  341. 1540                              End If
  342. 1550                           End If
  343.                             End If
  344.                          End If
  345. 1560                     lCodeLine = lContinue
  346.                       End If
  347.                    End If
  348.                 End If
  349. 1570            lStartCol = lEndColumn + 1
  350. 1580            lEndColumn = -1
  351. 1590            lEndLine = .CountOfDeclarationLines + 1
  352.              Loop
  353.  
  354.             ' Locate the first line of procedure code
  355. 1600         lCodeLine = .CountOfDeclarationLines + 1
  356. 1610         lEndLine = -1
  357.  
  358. 1620         lStartCol = 1
  359. 1630         lEndColumn = -1
  360.  
  361. 1640         Do While .Find(sProcName, lCodeLine, lStartCol, lEndLine, lEndColumn, True, True)
  362. 1650            If lCodeLine <> lProcLine Then
  363. 1660               sCodeLine = .Lines(lCodeLine, 1)
  364.  
  365. 1670               If IsCode(sCodeLine, lStartCol, lEndColumn) Then
  366.  
  367.                       ' Grab member name (and procedure kind) of procedure
  368. 1680                   sMembName = .ProcOfLine(lCodeLine, eProcKind)
  369.  
  370. 1690                    If sMembName <> sProcName Then
  371.  
  372. 1700                       lLineStart = .ProcBodyLine(sMembName, eProcKind)
  373. 1710                       If lLineStart <> lCodeLine Then
  374. 1720                          If Not IsWholeWord(sCodeLine, lStartCol, lEndColumn) Then GoTo DoNext
  375. 1730                       Else
  376. 1740                          i = InStr(sMembName, sProcName)
  377.                              ' If procedure name is not within member name (naming conflict with
  378. 1750                          If i = 0 Or i > 1 Then GoTo DoNext '  param name) or "..._ProcName"
  379.                            End If
  380.  
  381.                            fMustQualify = 0
  382. 1760                       If LenB(sCompName) Then
  383. 1770                          lLineCount = .ProcCountLines(sMembName, eProcKind)
  384. 1780                          sInstName = GetInstanceName(oCodeMod, sCompName, lLineStart, lLineStart + lLineCount)
  385. 1790                          If oVBE.ActiveVBProject.VBComponents(sCompName).Type <> vbext_ct_StdModule Then
  386. 1800                             If Not fExempt Then fMustQualify = -1
  387.                               End If
  388.                            End If
  389.  
  390. 1810                       If IsValid(oCodeMod, lCodeLine, lStartCol, sInstName, lLineStart, fMustQualify, sProcName, lProcLine) Then
  391.  
  392. 1820                          sCaller = oCodeMod.Parent.Name & "." & sMembName
  393.  
  394. 1830                          If saCallers(nCallers) <> sCaller Then
  395. 1840                              nCallers = nCallers + 1
  396. 1850                              If nCallers > UBound(saCallers) Then
  397. 1860                                  RedimCallers UBound(saCallers) + 100
  398. 1870                              End If
  399. 1880                              saCallers(nCallers) = sCaller
  400. 1890                              iaCallers(nCallers) = lCodeLine
  401. 1900                          End If
  402. 1910                       End If
  403. 1920                    End If
  404. 1930                 End If
  405.                   End If
  406. DoNext:
  407. 1940              lStartCol = lEndColumn + 1
  408. 1950              lEndColumn = -1
  409. 1960              lEndLine = -1
  410. 1970         Loop
  411. ErrWith:
  412. 1980       End With
  413.        If Err Then LogError "modVBE.FindCallers", sCaller
  414. End Sub
  415.  
  416. Private Function GetDeclareName(oCodeMod As CodeModule, ByRef lCodeLine As Long, ByVal lStartCol As Long, Optional vbeScope As vbext_Scope) As String
  417.          Dim i As Long, j As Long, k As Long
  418.          Dim sCodeLine As String
  419.          Dim sTempLine As String
  420.          Dim sMembName As String
  421.          Dim sBuffer As String
  422.  
  423. 2000     On Error GoTo ErrHandler
  424.  
  425. 2010      sCodeLine = oCodeMod.Lines(lCodeLine, 1)
  426. 2020      If LenB(sCodeLine) = 0 Then Exit Function
  427.  
  428. 2030      If IsCode(sCodeLine, lStartCol, lStartCol) Then
  429.  
  430.             ' Try to match the member name with the selection
  431. 2040         i = lStartCol
  432. 2050         j = lStartCol
  433. 2060         k = Len(sCodeLine)
  434.  
  435. 2070         Do While i > 1  ' Step back to a delimiter
  436. 2080            If IsDelimI(MidI(sCodeLine, i - 1)) Then Exit Do
  437. 2090            i = i - 1
  438. 2100        Loop
  439. 2110        Do Until j > k ' Step forward to a delimiter
  440. 2120           If IsDelimI(MidI(sCodeLine, j)) Then Exit Do
  441. 2130           j = j + 1
  442. 2140        Loop
  443.  
  444. 2150        sMembName = Trim$(Mid$(sCodeLine, i, j - i))
  445. 2160     End If
  446.  
  447. 2170     sCodeLine = LTrim$(sCodeLine)
  448. 2180     If AscW(sCodeLine) = 35 Then Exit Function '# Line
  449. 2190     If AscW(sCodeLine) = 39 Then Exit Function 'Comment Line
  450.  
  451. 2200     If LenB(sMembName) Then
  452. 2210       On Error Resume Next ' Is it a member name
  453. 2220        sBuffer = oCodeMod.Members(sMembName).Name
  454.  
  455. 2230        If LenB(sBuffer) Then ' If so, is it a code member
  456. 2240          vbeScope = oCodeMod.Members(sBuffer).Scope
  457.  
  458. 2250          If vbeScope <> 0 Then ' If so, we have it
  459. 2260            GetDeclareName = sBuffer
  460. 2270            Exit Function
  461. 2280          End If
  462. 2290        End If
  463. 2300       On Error GoTo ErrHandler
  464. 2310     End If
  465.  
  466. 2320     If lCodeLine <= oCodeMod.CountOfDeclarationLines Then
  467.  
  468.           ' Check for line continuation
  469.            Do While lCodeLine > 1 ' .ProcOfLine kinda thing
  470.              'If Right$(oCodeMod.Lines(lCodeLine - 1, 1), 1) = "_" Then
  471.               If RightI(oCodeMod.Lines(lCodeLine - 1, 1), 1) = 95 Then
  472.                  lCodeLine = lCodeLine - 1 ' Line continuation
  473.               Else
  474.                  Exit Do
  475.               End If
  476.            Loop
  477.  
  478. 2330       sCodeLine = LTrim$(oCodeMod.Lines(lCodeLine, 1))
  479.            sTempLine = " " & sCodeLine
  480.  
  481.           ' Enums and Types are not included in the
  482.           ' members collection so try them first
  483. 2340       If InStr(sTempLine, " Enum ") Then
  484. 2350          j = InStr(sTempLine, " Enum ") + 6
  485. 2360          k = InStr(j, sTempLine, " ")
  486. 2370          If k = 0 Then
  487. 2380             GetDeclareName = Mid$(sTempLine, j)
  488. 2390          Else
  489. 2400             GetDeclareName = Mid$(sTempLine, j, k - j)
  490. 2410          End If
  491. 2420          j = InStr(sCodeLine, " ")
  492. 2430          Select Case Left$(sCodeLine, j - 1)
  493.                 Case "Public"
  494. 2440              vbeScope = vbext_Public
  495. 2460              fExempt = -1
  496.                'Case "Private"
  497.                  'vbeScope = vbext_Private
  498. 2480            Case Else
  499. 2490              vbeScope = vbext_Private
  500. 2500          End Select
  501. 2510          Exit Function
  502.  
  503. 2520       ElseIf InStr(sTempLine, " Type ") Then
  504. 2530          j = InStr(sTempLine, " Type ") + 6
  505. 2540          k = InStr(j, sTempLine, " ")
  506. 2550          If k = 0 Then
  507. 2560             GetDeclareName = Mid$(sTempLine, j)
  508. 2570          Else
  509. 2580             GetDeclareName = Mid$(sTempLine, j, k - j)
  510. 2590          End If
  511. 2600          j = InStr(sCodeLine, " ")
  512. 2610          Select Case Left$(sCodeLine, j - 1)
  513.                 Case "Private"
  514. 2630              vbeScope = vbext_Private
  515.                'Case "Public"
  516.                  'vbeScope = vbext_Public
  517. 2650            Case Else
  518. 2660              vbeScope = vbext_Public
  519. 2670          End Select
  520. 2680          Exit Function
  521.  
  522.           ' An Implements object is also overlooked
  523. 2690       ElseIf Left$(sTempLine, 12) = " Implements " Then
  524. 2700          j = 13
  525. 2710          k = InStr(j, sTempLine, " ")
  526. 2720          If k = 0 Then
  527. 2725             GetDeclareName = Mid$(sTempLine, j)
  528. 2730          Else
  529. 2735             GetDeclareName = Mid$(sTempLine, j, k - j)
  530. 2740          End If
  531. 2745          vbeScope = vbext_Private
  532. 2750          Exit Function
  533.  
  534.           ' Also try a raised Event
  535. 2755       ElseIf Left$(sTempLine, 7) = " Event " Then
  536. 2760          j = 8
  537. 2765          k = InStr(j, sTempLine, "(")
  538. 2770          If Not (k = 0) Then
  539. 2775             GetDeclareName = Mid$(sTempLine, j, k - j)
  540. 2780             vbeScope = vbext_Private
  541. 2785             Exit Function
  542. 2790          End If
  543.  
  544. 2795       End If
  545.  
  546. 2800       j = InStr(sCodeLine, " ") ' Member of a Type or Enum?
  547. 2810       If j = 0 Then j = Len(sCodeLine) + 1
  548. 2820       sMembName = Left$(sCodeLine, j - 1)
  549.  
  550. 2830       sBuffer = " Public Private Declare Const Dim Global "
  551. 2840       If InStr(sBuffer, " " & sMembName & " ") = 0 Then
  552.  
  553. 2850          i = -1
  554. 2855          Do While (lCodeLine > 1) And i ' .ProcOfLine kinda thing
  555. 2860             lCodeLine = lCodeLine - 1
  556. 2865             sTempLine = " " & LTrim$(oCodeMod.Lines(lCodeLine, 1))
  557.  
  558. 2870             j = InStr(2, sTempLine, " ")
  559. 2875             If j = 0 Then j = Len(sTempLine) + 1
  560. 2880             sMembName = LTrim$(Left$(sTempLine, j - 1))
  561.  
  562. 2885             If InStr(sBuffer, " " & sMembName & " ") <> 0 Then i = 0
  563.  
  564. 2890             If InStr(sTempLine, " Type ") Then
  565. 2900                 j = InStr(sTempLine, " Type ") + 6
  566. 2910                 k = InStr(j, sTempLine, " ")
  567. 2920                 If k = 0 Then
  568. 2930                    GetDeclareName = Mid$(sTempLine, j)
  569. 2940                 Else
  570. 2950                    GetDeclareName = Mid$(sTempLine, j, k - j)
  571. 2960                 End If
  572. 2970                 sCodeLine = LTrim$(sTempLine)
  573. 2980                 j = InStr(sCodeLine, " ")
  574. 2990                 Select Case Left$(sCodeLine, j - 1)
  575.                         Case "Public"
  576. 3010                       vbeScope = vbext_Public
  577.                        'Case "Private"
  578.                          'vbeScope = vbext_Private
  579. 3030                    Case Else
  580. 3040                      vbeScope = vbext_Private
  581. 3050                End Select
  582. 3060                Exit Function
  583.  
  584. 3070             ElseIf InStr(sTempLine, " Enum ") Then
  585. 3080                j = InStr(sTempLine, " Enum ") + 6
  586. 3090                k = InStr(j, sTempLine, " ")
  587. 3100                If k = 0 Then
  588. 3110                   GetDeclareName = Mid$(sTempLine, j)
  589. 3120                Else
  590. 3130                   GetDeclareName = Mid$(sTempLine, j, k - j)
  591. 3140                End If
  592. 3150                sCodeLine = LTrim$(sTempLine)
  593. 3160                j = InStr(sCodeLine, " ")
  594. 3170                Select Case Left$(sCodeLine, j - 1)
  595.                        Case "Public"
  596. 3180                      vbeScope = vbext_Public
  597. 3200                      fExempt = -1
  598.                       'Case "Private"
  599.                          'vbeScope = vbext_Private
  600. 3220                   Case Else
  601. 3230                      vbeScope = vbext_Private
  602. 3240                End Select
  603. 3250                Exit Function
  604. 3260             End If
  605.  
  606. 3270         Loop
  607. 3280      End If 'Not a declaration keyword?
  608.  
  609. 3290    End If 'If lCodeLine <= oCodeMod.CountOfDeclarationLines
  610.  
  611.        ' User did not click on top of a member so loop through
  612.        ' the members to try to find one within this code line
  613. 3300    For i = 1 To oCodeMod.Members.Count
  614.  
  615. 3310      j = InStr(sCodeLine, " " & oCodeMod.Members(i).Name)
  616. 3320      If j > 0 Then
  617.  
  618. 3330         sMembName = oCodeMod.Members(i).Name
  619. 3340         k = j + 1 + Len(sMembName)
  620. 3350         Select Case oCodeMod.Members(i).Type
  621.  
  622.                 Case vbext_mt_Variable
  623. 3360               If MidI(sCodeLine, k) = 32 Or MidI(sCodeLine, k) = 40 Then ' " " Or "("
  624. 3370                  If InStr(sCodeLine, " ") = j Then
  625. 3380                     GetDeclareName = sMembName
  626. 3390                     vbeScope = oCodeMod.Members(i).Scope
  627. 3400                     Exit For
  628. 3410                  ElseIf InStr(sCodeLine, " WithEvents ") = j - 11 Then
  629. 3420                     GetDeclareName = sMembName
  630. 3430                     vbeScope = oCodeMod.Members(i).Scope
  631. 3440                     Exit For
  632. 3450                  End If
  633. 3460               ElseIf k > Len(sCodeLine) Then
  634. 3470                  GetDeclareName = sMembName
  635. 3480                  vbeScope = oCodeMod.Members(i).Scope
  636. 3490                  Exit For
  637. 3500               End If
  638.  
  639. 3510            Case vbext_mt_Const
  640. 3520               If InStr(sCodeLine, "Const") = j - 5 Then
  641. 3530                  If MidI(sCodeLine, k) = 32 Then ' " "
  642. 3540                     GetDeclareName = sMembName
  643. 3550                     vbeScope = oCodeMod.Members(i).Scope
  644. 3560                     Exit For
  645. 3570                  End If
  646. 3580               End If
  647.  
  648. 3590            Case vbext_mt_Event  ' Raised Events
  649. 3600               If InStr(sCodeLine, "Event") = j - 5 Then
  650. 3610                  GetDeclareName = sMembName
  651. 3620                  vbeScope = oCodeMod.Members(i).Scope
  652. 3630                  Exit For
  653. 3640               End If
  654.  
  655. 3650            Case vbext_mt_Method      ' Parses ALL procedures except properties,
  656. 3660               If Mid$(sCodeLine, k, 5) = " Lib " Then ' including API Declares
  657. 3670                  GetDeclareName = sMembName
  658. 3680                  vbeScope = oCodeMod.Members(i).Scope
  659. 3690                  Exit For
  660. 3700               End If
  661.  
  662.                'dures except p   fLine ki             lLineStart 
  663.  
  664.  4 'Case "Public"
  665.      ik=neStart 
  666.  
  667.  4 'Case "    6
  668. 3680         ")
  669. End If' including API Declares
  670. 3670               drrivate"i0   LCScope
  671. 3560                m3         8a(' including API "Mod.MembeS      _etDeclareo03Exie = sMembNe = sMembNe = sMembNi    _etDecl,me
  672. 3680        p =            ie = sMembNe             80        p =          i(sCodeLine, " ")
  673. 2430            80        p =ed Ev8ñ        j = InStr(sCodeLineine ki             lLineS    80  lares
  674. 36                     vbV0          pLine, " ")
  675. 3100                       ' includi8LineS  drrivate"                     e(sCodeLine, k, 5) = " Lib " Then ' including API Declares
  676. 36 Events
  677. 3600            tp   _evate"           + 1
  678. 2820       sMembName = op   _evate"           + 1
  679. 2820       sMembName = op   _evate"           + 1
  680. 282  If0                       l=          + 1
  681. 2 "Pri         pLembNe       n Exits rmsf      n Exits rmsf      n Exits rmsf      n Exits rmsf    00         - j -        +180            rmsf      n Exits rmsf      ine, j),        p'4ane = " " & LTrim$(olllllllllllne ki           End Ifo 32 TheBx
  682. 343.Scopee = sMembNam?eLine, "  sMeft$msf      n Exits                   vbeScope = oCodeMod.Members(i).Scope
  683. 3560    ,   h430          Select Case Leflllllllne k oCodeMod.Members(           lCodane = "= s         'If lCodeLine <= oCodeMod.icope = vbext_Private
  684. 30l440                           GetDecla.icop        + 1
  685. 282  If0                 + 1
  686. 282  If0           33333333333333f0      (sCodeLiner   1, 1), 1)))))))))))tbNi   (t " Then
  687. 2760          jfs API Di     GetDec
  688. 282  Ifn))) API Did Then
  689. 2760          jfs APttttttttttttttttttttS=            ie = sMesR op   _evate"      lMeft$msf      n Exit1 'deLinGet1
  690. 282  If0           Dim sTempLin   0                  + 1
  691. 282  sMeft$                          GetDecocedu              oCodeMod.Memberl1, 1v    rmsf  eft$     ie = sMesR op   _evate"      lMeft
  692. 2570            d Ifo 32 Th
  693. 257lMeft
  694. 2570       IembNa'Select Case Le    GetDecla.icop        + 1 i).Si    vbeScope = oCodeMod.Members(i).Scope
  695. 3690    tm                6e90    tmThen
  696. 3470  iane = im sMemine, " er name (an          jfs API Di     Gellll32 Tr nnsMemif lC(i).Scoperif lCne, " er name (an      teginning a'cope = oCtExit For
  697. 3700               End If
  698.  
  699.         ItDe    odeMoeLinoperif lCne, " er name (an      0         - j -   2 ererif lCne, " er name (an    ame en(sCod"p  =      ift90            C     Case vbext_mt_Event  ' Raised Ev
  700.  
  701. Public S    Casea l4 (af0          iemp           lLineStart 
  702.  
  703.  4 'Ceflllllllne k oCodeMod.Mem
  704. 328    = oCtExit For
  705. 37
  706. 2775             Gan <l    Dim sTemoiLin3lll3_ vbe, " Enum "xit For
  707. 37
  708. Cod(i).Scope
  709. 3630                   vbCountOe "    6
  710.             vbeAmFor
  711. 37
  712. Cod(i).Scope
  713. 3630   43sCo          v
  714. 37
  715. Cod(i).Sco,I oCodeMod.Mo s " er name (anp    -hii, 1 SeC         End     $msfcop        eine - CEnd rddName = .ProcOfllne k oCoda   le"I oCodeMod.Mo s " er name (or
  716. 3 e" ope
  717. 3630  erlf'iodeModa raie
  718. 3o s " er naD'iodeModa raie
  719. 3o s " er naD'iodeModa raie
  720. 3o DelimI(MidI 32 Moda rv". aD'iode4 'Chv1m" er name (or
  721. 3 e" ope
  722. 3630  erlf'iodeModa raie
  723. 3o s- 5 Then
  724. 3