edittlbexe.frm

VB圣经

VERSION 5.00
Object = "{6AA5A030-32F0-11D4-91F9-3E9B52000000}#1.0#0"; "TLBEditor.ocx"
Begin VB.Form frmEditTLB 
   ClientHeight    =   4515
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   8130
   Icon            =   "EditTLBExe.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4515
   ScaleWidth      =   8130
   StartUpPosition =   3  'Windows Default
   Begin TLBEditor.LibraryViewer LibViewer 
      Height          =   3525
      Left            =   750
      TabIndex        =   0
      Top             =   330
      Width           =   4665
      _ExtentX        =   8229
      _ExtentY        =   6218
   End
   Begin VB.Menu mnuFile 
      Caption         =   ""
      Begin VB.Menu mnuNew 
         Caption         =   ""
      End
      Begin VB.Menu mnuOpen 
         Caption         =   ""
      End
      Begin VB.Menu mnuSave 
         Caption         =   ""
      End
      Begin VB.Menu mnuSaveAs 
         Caption         =   ""
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   ""
      End
   End
End
Attribute VB_Name = "frmEditTLB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_CurrentFile As String
Private m_fDirty As Boolean
Private m_fEditing As Boolean
Private m_fCurrentFileWritable As Boolean
Private m_ListenerHook As ChangeListenerHook
Implements IChangeListener

Private Sub Form_Load()
Dim Listen As ChangeListener
    
    App.Title = LoadResString(cidAppTitle)
    mnuFile.Caption = LoadResString(cidMenuFile)
    mnuNew.Caption = LoadResString(cidMenuFileNew)
    mnuOpen.Caption = LoadResString(cidMenuFileOpen)
    mnuSave.Caption = LoadResString(cidMenuFileSave)
    mnuSaveAs.Caption = LoadResString(cidMenuFileSaveAs)
    mnuExit.Caption = LoadResString(cidMenuFileExit)
    m_fCurrentFileWritable = False
    m_fDirty = False
    
    Me.Caption = BuildString(LoadResString(cidAppCaption), vbNullString, vbNullString)
    
    'Get a listener in place so that we know when we're dirty
    Set m_ListenerHook = New ChangeListenerHook
    Set Listen = New ChangeListener
    m_ListenerHook.Attach Listen, Me
    Set LibViewer.ChangeListener = Listen
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If m_fDirty Then
        If Not SaveChanges Then Cancel = True
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState = vbMinimized Then Exit Sub
    On Error Resume Next
    LibViewer.Move 0, 0, ScaleWidth, ScaleHeight
    On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set LibViewer.ChangeListener = Nothing
    Set m_ListenerHook = Nothing
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuFile_Click()
    mnuSave.Enabled = m_fCurrentFileWritable And m_fDirty
    mnuSaveAs.Enabled = m_fEditing
End Sub

Private Sub mnuOpen_Click()
Dim strFile As String
    On Error GoTo Error
    If m_fDirty Then
        If Not SaveChanges Then Exit Sub
    End If
    strFile = PromptForOpenFileName(Me.hWnd)
    If Len(strFile) = 0 Then Exit Sub
    Set LibViewer.CurrentLibrary = TLI.TypeLibInfoFromFile(strFile)
    m_fCurrentFileWritable = IsTypeLibEditable(strFile)
    m_CurrentFile = strFile
    m_fEditing = True
    
    'Force call to Let Dirty
    m_fDirty = True
    Dirty = False
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub mnuNew_Click()
Dim GuidString As String * 38
    If m_fDirty Then
        If Not SaveChanges Then Exit Sub
    End If
    With New CustomTypeLib
        .LibName = LoadResString(cidNewLibName)
        StringFromGUID2 CoCreateGuid, GuidString
        .Guid = GuidString
        .LCID = 0
        Set LibViewer.CurrentLibrary = .Generate(False)
        m_CurrentFile = vbNullString
        m_fCurrentFileWritable = False
        m_fEditing = True
        
        'Force call to Let Dirty
        m_fDirty = False
        Dirty = True
    End With
End Sub

Private Sub mnuSave_Click()
    On Error GoTo Error
    LibViewer.SaveCurrentLibrary m_CurrentFile
    Dirty = False
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub mnuSaveAs_Click()
Dim strFile As String
    On Error GoTo Error
    strFile = PromptForSaveAsFileName(Me.hWnd, m_CurrentFile)
    If Len(strFile) = 0 Then Exit Sub
    LibViewer.SaveCurrentLibrary strFile
    m_fCurrentFileWritable = True
    m_CurrentFile = strFile
    
    'Force call to Let Dirty
    m_fDirty = True
    Dirty = False
    Exit Sub
Error:
    MsgBox Err.Description, vbExclamation
End Sub

Private Function SaveChanges() As Boolean
Dim strFile As String
    On Error GoTo Error
    Select Case MsgBox(LoadResString(cidSavePrompt), vbYesNoCancel Or vbQuestion)
        Case vbYes
            strFile = PromptForSaveAsFileName(Me.hWnd, m_CurrentFile)
            If Len(strFile) = 0 Then Exit Function 'Dialog canceled
            LibViewer.SaveCurrentLibrary strFile
            SaveChanges = True
        Case vbNo
            SaveChanges = True
        'Case vbCancel
        '    SaveChanges = False
    End Select
    Exit Function
Error:
    MsgBox Err.Description, vbExclamation
End Function

Private Sub UpdateCaption()
    If Len(m_CurrentFile) Then
        If m_fDirty Then
            Me.Caption = BuildString(LoadResString(cidAppCaption), m_CurrentFile, LoadResString(cidDirtyFlag))
        Else
            Me.Caption = BuildString(LoadResString(cidAppCaption), m_CurrentFile, vbNullString)
        End If
    Else
        'New libraries are not considered dirty, just new. The dirty flag would always be on
        'for a New Library otherwise.
        Me.Caption = BuildString(LoadResString(cidAppCaption), LoadResString(cidNewLibrary), vbNullString)
    End If
End Sub
Private Property Let Dirty(ByVal RHS As Boolean)
    If m_fDirty = RHS Then Exit Property
    m_fDirty = RHS
    UpdateCaption
End Property
'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