erwinspy_addin_form.frm

这个源程序用来读写ERWIN设计的ER1文件中的元数据信息

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   Caption         =   "ERwin Spy - ERwin API Sample"
   ClientHeight    =   4365
   ClientLeft      =   1095
   ClientTop       =   1770
   ClientWidth     =   9990
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Icon            =   "ERwinSpy_Addin_Form.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4365
   ScaleWidth      =   9990
   ShowInTaskbar   =   0   'False
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   7320
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton btProperties 
      Caption         =   ">>"
      Height          =   1935
      Left            =   4800
      TabIndex        =   4
      ToolTipText     =   "Click to see properties"
      Top             =   1320
      Width           =   375
   End
   Begin ComctlLib.TreeView tvObjects 
      Height          =   3495
      Left            =   120
      TabIndex        =   1
      ToolTipText     =   "Double click to expand"
      Top             =   720
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   6165
      _Version        =   327682
      HideSelection   =   0   'False
      LabelEdit       =   1
      Style           =   7
      Appearance      =   1
   End
   Begin ComctlLib.TreeView tvProperties 
      Height          =   3495
      Left            =   5400
      TabIndex        =   2
      ToolTipText     =   "Double click to expand"
      Top             =   720
      Width           =   4455
      _ExtentX        =   7858
      _ExtentY        =   6165
      _Version        =   327682
      HideSelection   =   0   'False
      LabelEdit       =   1
      Sorted          =   -1  'True
      Style           =   7
      Appearance      =   1
   End
   Begin VB.Label ERwinSpyLabel 
      Alignment       =   2  'Center
      Caption         =   "ERwin Spy"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   495
      Left            =   3600
      TabIndex        =   5
      Top             =   0
      Width           =   2775
   End
   Begin VB.Label LabelProperties 
      Alignment       =   1  'Right Justify
      Caption         =   "Properties"
      Height          =   255
      Left            =   6600
      TabIndex        =   3
      Top             =   360
      Width           =   3255
   End
   Begin VB.Label Label 
      Caption         =   "Objects"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   1935
   End
   Begin VB.Menu mnFile 
      Caption         =   "&File"
      Begin VB.Menu mnFileOpen 
         Caption         =   "File &Open ..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnClose 
         Caption         =   "Close Open Model"
      End
      Begin VB.Menu mnSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnOptions 
         Caption         =   "&Options"
         Begin VB.Menu mnExtraDebug 
            Caption         =   "Extra Debug Info"
         End
      End
      Begin VB.Menu mnSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnModels 
      Caption         =   "&Models"
      Begin VB.Menu mnModelsArray 
         Caption         =   "-"
         Index           =   0
      End
   End
   Begin VB.Menu mnHemp 
      Caption         =   "&Help"
      NegotiatePosition=   3  'Right
      Begin VB.Menu mnAbout 
         Caption         =   "&About Erwin Spy"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private btMouseLeft As Boolean              ' To keep a state of the mouse buttons
Private oApplication As SCAPI.Application   ' SCAPI Application
Private oSession As SCAPI.Session           ' Active session


' Init the form with SCAPI Application reference
Sub Init(oApp As SCAPI.Application)
    Set oApplication = oApp
End Sub

Private Sub Form_Load()
    Dim Version As String

    ' Reset UI
    ClearViews
    
    ' Disable the expand button
    btProperties.Enabled = False
    ' Activate the API
    Dim oSCAPI As New SCAPI.Application
    
    ' Init the form
    frmMain.Init oSCAPI
    
    ' Show the form
    frmMain.Show 1

    ' Populate Models menu
    PopulateModels
    
    
End Sub

Private Sub Form_Resize()
    ' Resize controls on the form
    
    Dim nAddWidth As Integer
    nAddWidth = IIf(Me.Width > 10110, (Me.Width - 10110) / 2, 0)
    LabelProperties.Left = IIf(Me.Width > 10110, Me.Width - 3510, 5400)
    tvProperties.Left = IIf(Me.Width > 10110, 5400 + nAddWidth, 5400)
    tvProperties.Width = IIf(Me.Width > 10110, 4455 + nAddWidth, 4455)
    tvProperties.Height = IIf(Me.Height > 5055, Me.Height - 1600, 3495)
    btProperties.Left = IIf(Me.Width > 10110, 4800 + nAddWidth, 4800)
    tvObjects.Width = IIf(Me.Width > 10110, 4455 + nAddWidth, 4455)
    tvObjects.Height = IIf(Me.Height > 5055, Me.Height - 1600, 3495)
    ERwinSpyLabel.Left = IIf(Me.Width > 10110, 3600 + nAddWidth, 3600)
End Sub

Private Sub mnAbout_Click()
    frmAbout.Init oApplication
    frmAbout.Show 1, Me
End Sub

Private Sub mnExit_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)

oApplication.Sessions.Clear
Set oApplication = Nothing

End Sub

' Populate Models menu with available models
Private Sub PopulateModels()
    ' Reset the menu array
    mnModelsArray(0).Visible = True
    Do While mnModelsArray.Count > 1
        Unload mnModelsArray(mnModelsArray.Count - 1)
    Loop
    
    ' Start adding
    Dim oUnit As SCAPI.PersistenceUnit
    Dim nIdx As Long
    
    nIdx = 1
    
    'a = oApplication.PersistenceUnits.Count
    
    MsgBox oApplication.ApiVersion
    ' Populate the menu with models
    For Each oUnit In oApplication.PersistenceUnits
        Load mnModelsArray(nIdx)
        mnModelsArray(nIdx).Caption = oUnit.Name
        nIdx = nIdx + 1
    Next
    
    ' Add a separator
    Load mnModelsArray(nIdx)
    mnModelsArray(nIdx).Caption = "-- Meta Data --"
    mnModelsArray(nIdx).Enabled = False
    nIdx = nIdx + 1
    
    ' Add intrinsic meta data
    Load mnModelsArray(nIdx)
    mnModelsArray(nIdx).Caption = "Intrinsic Meta"
    nIdx = nIdx + 1
    
    ' Populate the menu with model data
    For Each oUnit In oApplication.PersistenceUnits
        Load mnModelsArray(nIdx)
        mnModelsArray(nIdx).Caption = oUnit.Name
        nIdx = nIdx + 1
    Next

    mnModelsArray(0).Visible = False
    
End Sub

Private Sub mnExtraDebug_Click()
    ' Check/Uncheck
    mnExtraDebug.Checked = Not mnExtraDebug.Checked
End Sub

' Open a file
Private Sub mnFileOpen_Click()

   ' CancelError is True.
   On Error GoTo ErrHandler
   ' Set filters.
   CommonDialog1.Filter = "All Files (*.*)|*.*|ER1 Files (*.er1)|*.er1"
   ' Specify default filter.
   CommonDialog1.FilterIndex = 2
   ' Current directory
   CommonDialog1.InitDir = CurDir
   CommonDialog1.FileName = ""
   ' No read only and file must exists
   CommonDialog1.Flags = CommonDialog1.Flags Or _
                        cdlOFNHideReadOnly Or _
                        cdlOFNFileMustExist
   
   ' Display the Open dialog box.
   CommonDialog1.ShowOpen
   
   ' Load file
   On Error GoTo APIHandler
   Dim oModel As SCAPI.PersistenceUnit
   
   Me.MousePointer = vbHourglass

   Set oModel = oApplication.PersistenceUnits.Add("erwin://" + CommonDialog1.FileName, "RDO=Yes")
   
   ' Reset the model menu
   PopulateModels
   
   Me.MousePointer = vbDefault
   ' Locate the new file in the menu
    Dim nIdx As Integer
    For nIdx = 1 To mnModelsArray.Count - 1
        If mnModelsArray(nIdx).Caption = oModel.Name Then
            ' leave
            Exit For
        End If
    Next
    
    If nIdx >= mnModelsArray.Count Then
        ' Error
        MsgBox "Internal error while loading " + oModel.Name + " model"
        Set oModel = Nothing
        ClearViews
   End If
   
   ' Activate it
   mnModelsArray_Click (nIdx)
   Exit Sub

ErrHandler:
    ' User pressed Cancel button.
   Exit Sub
   
APIHandler:
   Me.MousePointer = vbDefault
   MsgBox "Failed to open a file with error msg: " + Err.Description
End Sub

' A model selected
Private Sub mnModelsArray_Click(Index As Integer)
    If (Not mnModelsArray(Index).Checked) Then
        ' Close the current window and open a session with a new one
        If Not oSession Is Nothing Then