mainwindow.dob

VB圣经

    End With
    Locals.fRestorableRefs = True
End Sub
Private Sub SaveActiveRefGenLibraryFile(Locals As SaveActiveRefLocals, fContinue As Boolean)
    On Error GoTo Error
    Locals.NewFile = TempFile("~TE")
    LibViewer.SaveCurrentLibrary Locals.NewFile
    fContinue = True
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
    On Error Resume Next
    Kill Locals.NewFile 'Get rid of any garbage
    On Error GoTo 0
    Locals.NewFile = vbNullString
    fContinue = False
End Sub
Private Sub SaveActiveRefPullRefs(Locals As SaveActiveRefLocals)
Dim iFile As Long
    With m_ActiveProject.References
        For iFile = Locals.cRefs To Locals.iActiveRef Step -1
            'Refs are 1 based
            .Remove .Item(iFile)
        Next iFile
    End With
End Sub
Private Sub SaveActiveRefRestoreRefs(Locals As SaveActiveRefLocals)
Dim iFile As Long
    With m_ActiveProject.References
        For iFile = Locals.iActiveRef To Locals.cRefs
            .AddFromFile Locals.Files(iFile)
        Next iFile
    End With
End Sub

Private Sub Commands_ButtonDropDown(ByVal Button As MSComctlLib.Button)
Dim Proj As VBProject
Dim Ref As Reference
Dim LibPath As String
Dim ptlib As ITypeLib
    On Error GoTo Error
    Select Case Button.Index
        Case cbiChooseProject
            If m_fProjectsDirty Then
                m_fProjectsDirty = False
                With Button.ButtonMenus
                    .Clear
                    For Each Proj In m_VBInst.VBProjects
                        .Add , , Proj.Name
                    Next
                End With
            End If
        Case cbiEditLibrary
            With Button.ButtonMenus
                .Clear
                Set m_Libraries = Nothing
                For Each Ref In m_ActiveProject.References
                    If Ref.Type = vbext_rk_TypeLib Then
                        If Not Ref.BuiltIn And Not Ref.IsBroken Then
                            LibPath = LibPathFromRef(Ref)
                            Set ptlib = Nothing
                            If Len(LibPath) Then
                                On Error Resume Next
                                Set ptlib = LoadTypeLibIfEditable(LibPath)
                                On Error GoTo 0
                            End If
                            If Not ptlib Is Nothing Then
                                If m_Libraries Is Nothing Then Set m_Libraries = New Collection
                                'This is handy. VB's library names are unique
                                m_Libraries.Add ptlib, Ref.Name
                                .Add , , Ref.Name
                            End If
                        End If
                    End If
                Next
            End With
    End Select
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
End Sub

Private Property Let Dirty(ByVal RHS As Boolean)
    If m_fDirty = RHS Then Exit Property
    m_fDirty = RHS
    With Commands.Buttons
        .Item(cbiChooseProject).Enabled = Not RHS
        .Item(cbiEditLibrary).Enabled = Not RHS And (Not m_ActiveProject Is Nothing)
        .Item(cbiNewLibrary).Enabled = Not RHS And (Not m_ActiveProject Is Nothing)
        .Item(cbiSaveChanges).Enabled = RHS
        .Item(cbiDiscardChanges).Enabled = RHS
    End With
    If RHS Then UpdateCaption
End Property

Private Sub Commands_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Dim strLibName As String
    On Error GoTo Error
    Select Case ButtonMenu.Parent.Index
        Case cbiChooseProject
            Set ActiveProject = m_VBInst.VBProjects(ButtonMenu.Text)
            UpdateCaption
        Case cbiEditLibrary
            strLibName = ButtonMenu.Text
            LoadLibViewer m_Libraries(strLibName), strLibName
            UpdateCaption
    End Select
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub LoadLibViewer(ByVal ptlib As ITypeLib, strLibName As String)
Dim TLInf As TypeLibInfo
Dim Ref As Reference
Dim Refs As References
Dim fAddLibrary As Boolean
Dim NewRef As Reference
    Set Refs = m_ActiveProject.References
    If Len(strLibName) Then
        Set NewRef = Refs(strLibName)
        If NewRef Is m_ActiveRef Then Exit Sub
    End If
    Set TLInf = New TypeLibInfo
    Set TLInf.ITypeLib = ptlib
    Set LibViewer.CurrentLibrary = TLInf
    If Len(strLibName) Then
        Set m_ActiveRef = NewRef
    Else
        Set m_ActiveRef = Nothing
    End If
    For Each Ref In Refs
        If Not Ref Is m_ActiveRef Then
            If Ref.Type = vbext_rk_TypeLib Then
                On Error Resume Next
                Set TLInf.ITypeLib = Nothing
                TLInf.ContainingFile = LibPathFromRef(Ref)
                fAddLibrary = Err = 0
                On Error Resume Next
                If fAddLibrary Then
                    LibViewer.AddReferencedLibrary TLInf
                End If
            End If
        End If
    Next
End Sub

Private Sub FileControlEvents_AfterCloseFile(ByVal VBProject As VBIDE.VBProject, ByVal FileType As VBIDE.vbext_FileType, ByVal FileName As String, ByVal WasDirty As Boolean)
Dim FD As FunctionDelegator
Dim pCall As ICallVoidReturnVoid
    If FileType = vbext_ft_Project Then
        m_cRemainingProjects = m_cRemainingProjects - 1
        If m_cRemainingProjects = 0 Then
            Set pCall = InitDelegator(FD, m_pfnAfterCloseFile)
            pCall.Call
        End If
    End If
End Sub

Private Sub ProjectsEvents_ItemAdded(ByVal VBProject As VBIDE.VBProject)
    m_fProjectsDirty = True
End Sub

Private Sub ProjectsEvents_ItemRemoved(ByVal VBProject As VBIDE.VBProject)
    If VBProject Is m_ActiveProject Then
        'CONSIDER: Prompt to save changes
        Set LibViewer.CurrentLibrary = Nothing
        Set m_ActiveProject = Nothing
        Set ReferencesEvents = Nothing
        Set LibViewer.CurrentLibrary = Nothing
        Set m_Libraries = Nothing
        m_fDirty = True
        Dirty = False
        UpdateCaption
    End If
End Sub
Private Function LoadTypeLibIfEditable(FilePath As String) As ITypeLib
    On Error Resume Next
    If IsTypeLibEditable(FilePath) Then Set LoadTypeLibIfEditable = LoadTypeLibEx(FilePath)
    On Error GoTo 0
End Function

Private Sub ProjectsEvents_ItemRenamed(ByVal VBProject As VBIDE.VBProject, ByVal OldName As String)
    m_fProjectsDirty = True
    If VBProject Is m_ActiveProject Then UpdateCaption
End Sub

Private Sub ReferencesEvents_ItemAdded(ByVal Reference As VBIDE.Reference)
Dim strLibPath As String
    If Reference.Type = vbext_rk_TypeLib Then
        strLibPath = LibPathFromRef(Reference)
        On Error Resume Next
        If Len(strLibPath) Then
            LibViewer.AddReferencedLibrary TLI.TypeLibInfoFromFile(strLibPath)
        End If
        On Error GoTo 0
    End If
End Sub

Private Sub ReferencesEvents_ItemRemoved(ByVal Reference As VBIDE.Reference)
Dim strLibPath As String
    'Make sure this is a typelib reference
    If Reference.Type = vbext_rk_TypeLib Then
        If m_ActiveRef Is Reference Then
            'CONSIDER: Prompt to save changes
            Set LibViewer.CurrentLibrary = Nothing 'Also clears all referenced libraries
            Set m_Libraries = Nothing
            Set m_ActiveRef = Nothing
            Dirty = False
            UpdateCaption
        Else
            strLibPath = LibPathFromRef(Reference)
            If Len(strLibPath) Then
                'This fails silently if it can't do it
                LibViewer.RemoveReferencedLibrary TLI.TypeLibInfoFromFile(strLibPath)
            End If
        End If
    End If
End Sub

Private Sub UpdateCaption()
Dim hWndTarget As Long
Dim strCaption As String
Dim strDirty As String
    'This is crazy, but the VBIDE.Window.Caption is read only
    strCaption = LoadResString(cidWindowCaption)
    If m_ActiveProject Is Nothing Then
        strCaption = BuildString(strCaption, LoadResString(cidWindowCaptionNoProject), LoadResString(cidWindowCaptionNoLibrary), vbNullString)
    ElseIf m_ActiveRef Is Nothing Then
        If m_fDirty Then
            strCaption = BuildString(strCaption, m_ActiveProject.Name, LoadResString(cidWindowCaptionNewLibrary), vbNullString)
        Else
            strCaption = BuildString(strCaption, m_ActiveProject.Name, LoadResString(cidWindowCaptionNoLibrary), vbNullString)
        End If
    ElseIf m_fDirty Then
        strCaption = BuildString(strCaption, m_ActiveProject.Name & "." & m_ActiveRef.Name, LibPathFromRef(m_ActiveRef), LoadResString(cidWindowCaptionDirtyFlag))
    Else
        strCaption = BuildString(strCaption, m_ActiveProject.Name & "." & m_ActiveRef.Name, LibPathFromRef(m_ActiveRef), vbNullString)
    End If
    hWndTarget = GetParent(GetParent(UserDocument.hWnd))
    SendMessage hWndTarget, WM_SETTEXT, 0, ByVal strCaption
End Sub

Private Sub UserDocument_Resize()
    LibViewer.Move 0, Commands.Height, ScaleWidth, ScaleHeight - Commands.Height
End Sub

Private Sub UserDocument_Show()
    With Commands.Buttons
        .Item(cbiChooseProject).ToolTipText = LoadResString(cidTipProjects)
        .Item(cbiEditLibrary).ToolTipText = LoadResString(cidTipLibraries)
        .Item(cbiNewLibrary).ToolTipText = LoadResString(cidTipNewLibrary)
        .Item(cbiSaveChanges).ToolTipText = LoadResString(cidTipSaveChanges)
        .Item(cbiDiscardChanges).ToolTipText = LoadResString(cidTipDiscardChanges)
    End With
End Sub

'IChangeListener events
Private Sub IChangeListener_OnAddImplTypeChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IAddImplTypeChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnAddMemberChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IAddMemberChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnAddTypeChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IAddTypeChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnCopyMemberChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.ICopyMemberChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnDeleteChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IDeleteChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnFlattenInterfaceChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IFlattenInterfaceChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnHelpChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IHelpChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnImplTypeChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IImplTypeChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnInsertParamChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IInsertParamChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnInternalizeTypesChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IInternalizeTypesChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnLibraryChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.ILibraryChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnMemberChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IMemberChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnParamChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IParamChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnRedirectTypesChange(Target As TLBEditor.ChangeTarget, ByVal Change As TLBEditor.IRedirectTypesChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnRemoveParamArrayChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IRemoveParamArrayChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnRenameChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IRenameChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnReorderVarsChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IReorderVarsChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnReorderVTableChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IReorderVTableChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnResetAllIDsChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IResetAllIDsChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnResetAutomaticIDsChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.IResetAutomaticIDsChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub
Private Sub IChangeListener_OnTypeChange(Target As TLBEditor.ChangeTarget, Change As TLBEditor.ITypeChange, Optional ByVal fSyncUI As Boolean = True, Optional ByVal Hint As Long = 0&)
    Dirty = True
End Sub