doccodebrowser.dob

vb资源管理器增强型 vb资源管理器增强型

'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 34 '15
'            .aTag = Vb_VBMDIForm
'            'Procedures, Events, etc.
'            If H_CheckForMembers(objModule) = True Then
'                k = k + 1
'                .aDummyKey = Vb_a & Str$(k)
'            End If
'        End With
'    Case vbext_ct_UserControl
'        Set objModule = objComp.CodeModule
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 16
'            .aTag = Vb_UserControl
'            'Procedures, Events, etc.
'            If H_CheckForMembers(objModule) = True Then
'                k = k + 1
'                .aDummyKey = Vb_a & Str$(k)
'            End If
'        End With
'    Case vbext_ct_DocObject
'        Set objModule = objComp.CodeModule
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 5
'            .aTag = Vb_DocObject
'            'Procedures, Events, etc.
'            If H_CheckForMembers(objModule) = True Then
'                k = k + 1
'                .aDummyKey = Vb_a & Str$(k)
'            End If
'        End With
'    Case vbext_ct_ActiveXDesigner
'        Set objModule = objComp.CodeModule
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 3
'            .aTag = Vb_ActiveXDesigner
'            'Procedures, Events, etc.
'            If H_CheckForMembers(objModule) = True Then
'                k = k + 1
'                .aDummyKey = Vb_a & Str$(k)
'            End If
'        End With
'    Case vbext_ct_PropPage
'        Set objModule = objComp.CodeModule
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 17
'            .aTag = Vb_PropPage
'            'Procedures, Events, etc.
'            If H_CheckForMembers(objModule) = True Then
'                k = k + 1
'                .aDummyKey = Vb_a & Str$(k)
'            End If
'        End With
'    Case vbext_ct_RelatedDocument
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.Name & Vb_Sep
'            .aText = objModule.Name & sTmp
'            .aImage = 9
'            .aTag = objComp.FileNames(1)
'        End With
'    Case vbext_ct_ResFile
'        sTmp = Vb_lBracket & Right$(objComp.FileNames(1), LenB(objComp.FileNames(1)) / 2 - InStrRev(objComp.FileNames(1), Vb_Backslash)) & Vb_rBrackett
'
'        With CmpNodes(i)
'            .aKey = ProjectKey & objComp.FileNames(1) & Vb_Sep
'            .aText = sTmp
'            .aImage = 8
'            .aTag = Vb_ResFile
'        End With
'    End Select
'Next objComp
'
'DoEvents
'
'For j = 1 To i
'    With tvCodeBrowser.Nodes.Add(ProjectKey, _
     '                tvwChild, _
     '                CmpNodes(j).aKey, _
     '                CmpNodes(j).aText, CmpNodes(j).aImage)
'        .Tag = CmpNodes(j).aTag
'    End With
'
'    If LenB(CmpNodes(j).aDummyKey) > 0 Then
'        tvCodeBrowser.Nodes.Add CmpNodes(j).aKey, _
         '                tvwChild, _
         '                CmpNodes(j).aDummyKey, _
         '                Vb_Dummy
'    End If
'Next j
'
'i = 0
'ReDim CmpNodes(0)
'Exit Sub
'
'eH:
'Select Case Err.Number
'Case -2147467259    'method type of object failed
'    Err.Clear
'    Resume Next
'Case Else
'    MsgBox Err.Number & ", " & Err.Description
'    Resume Next
'End Select
''<EhFooter>
'Exit Sub
'
'EV_AddNewProject_Err:
'MsgBox Err.Description & vbCrLf & _
 '        "程序 CodeBrowser.docCodeBrowser.EV_AddNewProject " & _
 '        "错误行 " & Erl
'Resume Next
''</EhFooter>
'End Sub


Public Sub EV_RemoveProject(VBProject As VBIDE.VBProject)
    On Error GoTo eH

100 tvCodeBrowser.Nodes.Remove VBProject.Name & Vb_Sep
102 DoEvents
104 L_ResetLists

    Exit Sub
eH:
106 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.docCodeBrowser.EV_RemoveProject " & _
            "错误行 " & Erl, vbCritical, "错误信息"
108 Resume Next
End Sub

Public Sub EV_RenameProject(VBProject As VBIDE.VBProject, OldName As String)
    On Error GoTo eH
    Dim NodeX As Node, sTmp$

100 sTmp = Vb_lBracket & Right$(VBProject.FileName, LenB(VBProject.FileName) / 2 - InStrRev(VBProject.FileName, Vb_Backslash)) & Vb_rBrackett

102 For Each NodeX In tvCodeBrowser.Nodes
        'replace the prj.name in node.text
104     If NodeX.key = OldName & Vb_Sep Then NodeX.Text = VBProject.Name & sTmp

        'replace the key
106     If Left$(NodeX.key, LenB(OldName) / 2) = OldName Then _
                NodeX.key = H_ReplaceString(NodeX.key, _
                OldName & Vb_Sep, VBProject.Name & Vb_Sep)
    Next

108 L_ResetLists

    Exit Sub
eH:
110 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.docCodeBrowser.EV_RenameProject " & _
            "错误行 " & Erl, vbCritical, "错误信息"
112 Resume Next
End Sub

Public Function H_ReplaceString(strSearch As String, _
        strOld As String, _
        strNew As String) As String
    '<EhHeader>
    On Error GoTo H_ReplaceString_Err
    '</EhHeader>

    Dim lngFoundPos               As Long
    Dim strReturn                 As String
    Dim strReplace                As String
    Dim strIn                     As String
    Dim strFind                   As String
    Dim lngStartPos               As Long

100 strIn = strSearch
102 strFind = strOld
104 strReplace = strNew
106 lngFoundPos = 1
108 lngStartPos = 1
110 strReturn = vbNullString


    'Process the string while strFind is found
112 Do While lngFoundPos <> 0

114     lngFoundPos = InStr(lngStartPos, strIn, strFind)

        'If strFind is found
116     If lngFoundPos <> 0 Then

            'Take all characters before strFind, add strReplace
            'onto the end, and add this to strReturn
118         strReturn = strReturn & _
                    Mid$(strIn, lngStartPos, lngFoundPos - lngStartPos) & _
                    strReplace

            'If no strFind is found
        Else

            'Add the remainder of the string to strReturn
120         strReturn = strReturn & _
                    Mid$(strIn, lngStartPos)

        End If

        'Start next search at the first character after the replaced string
122     lngStartPos = lngFoundPos + Len(strFind)

    Loop

    'Return the new string
124 H_ReplaceString = strReturn


    '<EhFooter>
    Exit Function

H_ReplaceString_Err:
    MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.docCodeBrowser.H_ReplaceString " & _
            "错误行 " & Erl, vbCritical, "错误信息"
    Resume Next
    '</EhFooter>
End Function




'Public Sub A_RelinkLists()
'Dim strTemp As String 'Used to take apart selected row in listbox.
'Dim intCounter As Byte ' Loop through number of columns.
'Dim txtOutput(3) As String, sKey$
'Dim strProject$, strCodeModule$
'Dim objCP As CodePane
'
'If LstHistory.ListCount = 0 Then
'    LastMemberCount = 0
'    LastMemberName = vbNullString     'should be always different
'    LastMemberType = 0
'    LastCodeModuleName = vbNullString
'    LastProjectName = vbNullString
'    LastKey = vbNullString
'Else
'    'prepare
'    strProject = arrHistory(2, UBound(arrHistory, 2) - 1)
'    strCodeModule = arrHistory(1, UBound(arrHistory, 2) - 1)
'    strTemp = arrHistory(0, UBound(arrHistory, 2) - 1)
'    If strTemp = Vb_Gnrl Then strTemp = vbNullString
'    sKey = strProject & Vb_Sep & strCodeModule & Vb_Sep & strTemp
'    LastMemberCount = VBInstance.VBProjects(strProject).VBComponents(strCodeModule).CodeModule.Members.Count
'    LastMemberName = H_NodeKeyToProcName(sKey)    'should be always different
'
'    Select Case H_NodeKeyToProcKind(sKey)
'    Case vbNullString
'        LastMemberType = 0
'    Case Vb_Get
'        LastMemberType = 3
'    Case Vb_Let
'        LastMemberType = 1
'    Case Vb_Set
'        LastMemberType = 2
'    End Select
'
'    LastCodeModuleName = strCodeModule
'    LastProjectName = strProject
'    LastKey = sKey
'    LstHistSel = UBound(arrHistory, 2) - 1
'End If
'End Sub


'Public Sub EV_Tmr()
''<EhHeader>
'On Error GoTo EV_Tmr_Err
''</EhHeader>
'Timer1.Enabled = True
''<EhFooter>
'Exit Sub
'
'EV_Tmr_Err:
'MsgBox Err.Description & vbCrLf & _
 '        "程序 CodeBrowser.docCodeBrowser.EV_Tmr " & _
 '        "错误行 " & Erl
'Resume Next
''</EhFooter>
'End Sub

Public Sub Tv_ExpandActive()
    On Error GoTo eH
    Dim key$, oCodePane As CodePane, tmpHwnd&, PosX&, PosY&

100 If ProcessMsg = True Then ProcessMsg = False
102 DoEvents
104 DoEvents
106 DoEvents
108 LockWindowUpdate GetDesktopWindow

110 If VBInstance.VBProjects.Count > 1 Then
112     key = VBInstance.VBProjects(1) & Vb_Sep
114     tvCodeBrowser.Nodes(key).Selected = True
116     key = VBInstance.VBProjects(VBInstance.VBProjects.Count) & Vb_Sep
118     tvCodeBrowser.Nodes(key).Selected = True
        Exit Sub
120 ElseIf VBInstance.VBProjects.Count = 1 Then
122     Set oCodePane = VBInstance.ActiveCodePane

124     If oCodePane Is Nothing Then
126         Set oCodePane = VBInstance.ActiveVBProject.VBComponents(1).CodeModule.CodePane
128         key = VBInstance.ActiveVBProject.Name & Vb_Sep '& VBInstance.ActiveVBProject.VBComponents(1).Name & Vb_Sep
130         If Len(key) Then tvCodeBrowser.Nodes(key).Selected = True
        Else
132         key = VBInstance.ActiveVBProject.Name & Vb_Sep '& oCodePane.CodeModule.Parent.Name & Vb_Sep
134         tvCodeBrowser.Nodes(key).Selected = True
        End If

136     tmpHwnd = FindActiveCodepane

138     If tmpHwnd Then
140         With MouseEvent
142             PosX = .GetX
144             PosY = .GetY
146             .ClickWindow tmpHwnd
148             .SetMousePos PosX, PosY
            End With

150         DoEvents
152         oCodePane.SetSelection 1, 1, 1, 1
        End If
    End If

154 LockWindowUpdate 0
156 If ProcessMsg = False Then ProcessMsg = True
    Exit Sub

eH:
158 LockWindowUpdate 0
160 If ProcessMsg = False Then ProcessMsg = True

162 Select Case Err.Number
    Case 35601 'Element not found
164     Timer1.Enabled = True
166 Case -2147352567     'Method '~' of Object '~' failed
168     Resume Next

170 Case Else
172     MsgBox Err.Description & vbCrLf & _
                "程序 CodeBrowser.docCodeBrowser.Tv_ExpandActive " & _
                "错误行 " & Erl & vbCrLf & Err.Number, vbCritical, "错误信息"
174     Resume Next
    End Select
End Sub

Public Sub Tv_MDIChildCheck()
    On Error GoTo eH
    Dim sKey$, NodeX As Node, objComp As VBComponent

100 With VBInstance
102     Set objComp = .SelectedVBComponent

104     If objComp.Type = vbext_ct_VBForm Then
106         sKey = .ActiveVBProject.Name & Vb_Sep & objComp.Name & Vb_Sep
108         Set NodeX = tvCodeBrowser.Nodes(sKey)

110         Select Case objComp.Properties(35).Value
            Case False
112             If Not (NodeX.Image = 14) Then
114                 NodeX.Image = 14
116                 tvCodeBrowser.Refresh
                End If
118         Case True
120             If Not (NodeX.Image = 30) Then
122