connect.dsr

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

112 mobjDoc.EV_Timer2
114 DoEvents
116 LockWindowUpdate 0
118 mobjDoc.bRefreshing = False

    Exit Sub
eH:
 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.eVBControlsEvents_ItemRemoved " & _
            "错误行 " & Erl & vbCrLf & Err.Number, vbCritical, "错误信息"
 Resume Next
End Sub


Private Sub eVBControlsEvents_ItemRenamed(ByVal VBControl As VBIDE.VBControl, ByVal OldName As String, ByVal OldIndex As Long)
On Error GoTo eH

100 If bInRunMode Then Exit Sub
106 mobjDoc.bRefreshing = True
108 LockWindowUpdate GetDesktopWindow
110 bControlChange = True
112 mobjDoc.EV_Timer2
114 DoEvents
116 LockWindowUpdate 0
118 mobjDoc.bRefreshing = False
    Exit Sub
eH:
 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.eVBControlsEvents_ItemRenamed " & _
            "错误行 " & Erl & vbCrLf & Err.Number, vbCritical, "错误信息"
 Resume Next
End Sub


Private Sub eVBProjectEvents_ItemAdded(ByVal VBProject As VBIDE.VBProject)
    On Error GoTo eH

100 If bClosingSession Or bInRunMode Then Exit Sub
102 Do While VBProject.Name = vbNullString
104     DoEvents
    Loop
    
106 IsLoading = IsLoading - 1

108 If IsLoading <= 0 Then
110     mobjDoc.FS_Insert_Components

112     mobjDoc.M_RefreshActiveModule
114     mobjDoc.L_ResetListByNewStart
        DoEvents
    End If

    Exit Sub
eH:
116 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.eVBProjectEvents_ItemAdded " & _
            "错误行 " & Erl & vbCrLf & Err.Number, vbCritical, "错误信息"
118 Resume Next
End Sub

Private Sub eVBProjectEvents_ItemRemoved(ByVal VBProject As VBIDE.VBProject)
    On Error GoTo eH
    Dim sOldKey$
    Const Vb_Sep = "|"

100 If bClosingSession Or bInRunMode Then Exit Sub

    Do
102     DoEvents
104 Loop While VBProject.Name = vbNullString

106 sOldKey = VBProject.Name & Vb_Sep
108 mobjDoc.EV_DeleteFromKey sOldKey
110 DoEvents
112 mobjDoc.L_ResetLists

114 If IsPrjMDI Then
116     IsPrjMDI = False

118     If VBInstance.VBProjects.Count Then
            Dim objPrj As VBProject
            Dim objComp As VBComponent

120         For Each objPrj In VBInstance.VBProjects
122             For Each objComp In objPrj.VBComponents
124                 If objComp.Type = vbext_ct_VBMDIForm Then
126                     IsPrjMDI = True
                        Exit Sub
                    End If
128             Next objComp
130         Next objPrj
        End If
    End If

    Exit Sub
eH:
132 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.eVBProjectEvents_ItemRemoved " & _
            "错误行 " & Erl & vbCrLf & Err.Number, vbCritical, "错误信息"
134 Resume Next
End Sub

Private Sub eVBProjectEvents_ItemRenamed(ByVal VBProject As VBIDE.VBProject, ByVal OldName As String)
    On Error GoTo eH
    Dim sOldKey$
    Const Vb_Sep = "|"

100 If bClosingSession Or bInRunMode Then Exit Sub

    Do
102     DoEvents
104 Loop While VBProject.Name = vbNullString

    'by starting a new session OldName is vbNullString
106 If OldName = vbNullString Then
108     If k > 72000 Then k = 0 'reset the Dummy KeyMaker
        Exit Sub
    End If

110 sOldKey = OldName & Vb_Sep
112 mobjDoc.EV_DeleteFromKey sOldKey
114 mobjDoc.L_ResetListByNewStart
116 mobjDoc.Tv_Insert_Project VBProject

    Exit Sub
eH:
118 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.eVBProjectEvents_ItemRenamed " & _
            "错误行 " & Erl & vbCrLf & Err.Number
120 Resume Next
End Sub

Private Sub mobjFCEvts_AfterAddFile(ByVal VBProject As VBIDE.VBProject, ByVal FileType As VBIDE.vbext_FileType, ByVal FileName As String)
    On Error GoTo eH
100 If bInRunMode Then Exit Sub

    Dim NewNodeText$
    Const Vb_lBracket = "("
    Const Vb_rBrackett = ")"
    Const Vb_Sep = "|"
    Const Vb_Backslash = "\"

102 NewNodeText = Vb_lBracket & Right$(FileName, LenB(FileName) / 2 - InStrRev(FileName, Vb_Backslash)) & Vb_rBrackett

104 Select Case FileType
    Case 6 '.res file
106     mobjDoc.Ev_ResClean VBProject.Name & Vb_Sep, NewNodeText
    End Select

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

Private Sub mobjFCEvts_AfterChangeFileName(ByVal VBProject As VBIDE.VBProject, ByVal FileType As VBIDE.vbext_FileType, ByVal NewName As String, ByVal OldName As String)
    'MsgBox "AfterChangeFileName, VBProject: " & VBProject.Name & _
     ", FileType: " & str(FileType) & ", NewName: " & NewName & _
     ", OldName: " & OldName
    On Error GoTo eH  'not every comp. has a name prop.
100 If bInRunMode Then Exit Sub

    Dim sNewText$, sKey$, OldFileText$
    Dim objPrj As VBProject

102 For Each objPrj In VBInstance.VBProjects
104     If objPrj.FileName = NewName Then
106         sKey = _
                    objPrj.Name & _
                    Vb_Sep
108         sNewText = _
                    objPrj.Name & _
                    Vb_lBracket & _
                    Right$(NewName, Len(NewName) - InStrRev(NewName, Vb_Bksl)) & _
                    Vb_rBrackett
110         mobjDoc.EV_NodeNewText sKey, sNewText
            Exit Sub
        End If
112 Next objPrj

114 OldFileText = Vb_lBracket & _
            Right$(OldName, Len(OldName) - InStrRev(OldName, Vb_Bksl)) & _
            Vb_rBrackett
116 sKey = mobjDoc.H_SearchNodeText(VBProject.Name & Vb_Sep, OldFileText)
118 sNewText = mobjDoc.H_NodeKeyToCodeModName(sKey)

120 sNewText = sNewText & _
            Vb_lBracket & _
            Right$(NewName, Len(NewName) - InStrRev(NewName, Vb_Bksl)) & _
            Vb_rBrackett
122 mobjDoc.EV_NodeNewText sKey, sNewText

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

Sub Show()
    On Error GoTo eH

100 If Not VBInstance Is Nothing Then
        'Variablen im Userdokument setzen
102     Set mobjDoc.VBInstance = VBInstance
104     Set mobjDoc.Connect = Me

        'Fenster anzeigen
106     mWindow.Visible = True
    Else
108     MsgBox "no active VB Instance resolved"
    End If

    Exit Sub
eH:
110 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.Show " & _
            "错误行 " & Erl
112 Resume Next
End Sub


Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
    'This event fires when the user loads the add-in from the Add-In Manager
    On Error GoTo eH

    'Retain handle to the current instance of Visual Basic for later use
100 Set VBInstance = Application
102 Set eVBProjectEvents = VBInstance.Events.VBProjectsEvents
104 Set eVBComponentsEvents = VBInstance.Events.VBComponentsEvents(Nothing)
106 Set eVBControlsEvents = VBInstance.Events.VBControlsEvents(Nothing, Nothing)
108 Set mobjFCEvts = VBInstance.Events.FileControlEvents(Nothing)
110 Set nEvents2 = VBInstance.Events
112 Set eVBBuildEvents = nEvents2.VBBuildEvents
114 Set modSubclass.VBInstance = VBInstance
116 Set modSubclass.Connect = Connect
IsFirstStart = True
    'Relevant hWnds
118 IDEhwnd = VBInstance.MainWindow.hWnd 'Not listed but endorsed!
120 hWndMDIClient = FindWindowEx(VBInstance.MainWindow.hWnd, 0, "MDIClient", vbNullString)
122 hModule = GetModuleHandle("CodeBrowser.dll")

124 If GetSetting(App.Title, "Settings", "DockingAddInGUID", "0") = "0" Then
        'freie GUID ermittel, wenn noch keine vorhanden
126     DockingAddInGUID = GUIDGen
128     SaveSetting App.Title, "Settings", "DockingAddInGUID", DockingAddInGUID
    Else
        'GUID laden
130     DockingAddInGUID = GetSetting(App.Title, "Settings", "DockingAddInGUID", "0")
    End If

132 Set objAddInInst = AddInInst

    'Convert the ActiveX document into a dockable tool window in the VB IDE
134 Set mWindow = VBInstance.Windows.CreateToolWindow(objAddInInst, "CodeBrowser.docCodeBrowser", "增强资源管理器", DockingAddInGUID, mobjDoc)
136 HookMainWindow

    'build UI
138 Me.Show

    'if we start with the IDE,
    'but we need to have first a loaded project.
140 If ConnectMode = ext_cm_AfterStartup Then
142     If VBInstance.VBProjects.Count Then
144         mobjDoc.FS_Insert_Components
146         mobjDoc.M_RefreshActiveModule
148         mobjDoc.L_ResetListByNewStart
        End If
    End If
    Exit Sub

eH:
150 MsgBox Err.Description & vbCrLf & _
            "程序 CodeBrowser.Connect.AddinInstance_OnConnection " & _
            "错误行 " & Erl & vbCrLf & _
            Err.Number, vbCritical, "错误信息"
152 Resume Next
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
    'This event fires when the user explicitly unloads the add-in
    On Error GoTo eH

100 UnloadAddin
102 Unload Me

104 If RemoveMode = vbext_dm_HostShutdown Then
106     bHostShutdown = True
    End If

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


Private Sub mobjFCEvts_BeforeLoadFile(ByVal VBProject As VBIDE.VBProject, FileNames() As String)

    Dim i&

100 If Right$(FileNames(i), 1) = Vb_x Then Exit Sub

102 For i = 0 To UBound(FileNames)
104     If Right$(FileNames(i), 4) = Vb_vbp Then
106         IsLoading = IsLoading + 1
            Exit Sub
        End If
    Next

End Sub