⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmversionmanager.frm

📁 ArcEngine 这是基于AE组件的源代码
💻 FRM
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmVersionManager 
   Caption         =   "版本管理"
   ClientHeight    =   7440
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5310
   LinkTopic       =   "Form1"
   ScaleHeight     =   7440
   ScaleWidth      =   5310
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtName 
      Height          =   375
      Left            =   1080
      TabIndex        =   7
      Top             =   3540
      Width           =   4095
   End
   Begin VB.Frame fraAccess 
      Caption         =   "种类"
      Height          =   1395
      Left            =   120
      TabIndex        =   3
      Top             =   4620
      Width           =   5055
      Begin VB.OptionButton optAccess 
         Caption         =   "私有"
         Height          =   315
         Index           =   0
         Left            =   240
         TabIndex        =   6
         Top             =   300
         Width           =   3615
      End
      Begin VB.OptionButton optAccess 
         Caption         =   "保护"
         Height          =   315
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Top             =   600
         Width           =   3615
      End
      Begin VB.OptionButton optAccess 
         Caption         =   "公共"
         Height          =   315
         Index           =   1
         Left            =   240
         TabIndex        =   4
         Top             =   900
         Width           =   3615
      End
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "&关闭"
      Height          =   435
      Left            =   3900
      TabIndex        =   2
      Top             =   6900
      Width           =   1215
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "&应用"
      Height          =   435
      Left            =   2520
      TabIndex        =   1
      Top             =   6900
      Width           =   1215
   End
   Begin VB.TextBox txtDescription 
      Height          =   375
      Left            =   1080
      TabIndex        =   0
      Top             =   4080
      Width           =   4095
   End
   Begin MSComctlLib.TreeView tvwVersions 
      Height          =   3255
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   5741
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   177
      LabelEdit       =   1
      LineStyle       =   1
      Sorted          =   -1  'True
      Style           =   6
      Appearance      =   1
   End
   Begin VB.Label Label1 
      Caption         =   "名称"
      Height          =   255
      Left            =   180
      TabIndex        =   12
      Top             =   3660
      Width           =   555
   End
   Begin VB.Label Label2 
      Caption         =   "描述"
      Height          =   255
      Left            =   180
      TabIndex        =   11
      Top             =   4200
      Width           =   915
   End
   Begin VB.Label lblDateCreated 
      Caption         =   "创建日期:"
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   6120
      Width           =   5055
   End
   Begin VB.Label lblDateModified 
      Caption         =   "修改日期:"
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   6480
      Width           =   5055
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "Popup"
      Visible         =   0   'False
      Begin VB.Menu mnuCreate 
         Caption         =   "新建"
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除"
      End
   End
End
Attribute VB_Name = "frmVersionManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private m_pVersionInfo As IVersionInfo
Private m_dicVersions As Scripting.Dictionary
Private m_IsDirty As Boolean


Public Sub DoModal(ByVal pVersionedWorkspace As IVersionedWorkspace)
  Set m_pVersionedWorkspace = pVersionedWorkspace
  Set m_dicVersions = New Scripting.Dictionary
  
  'Load all the Versions into the Version Tree and into the dictionary
  LoadVersionTree pVersionedWorkspace
  
  'Show the form
  Show vbModal
  
  'Free all references
  Set m_pVersionedWorkspace = Nothing
  Set m_pVersionInfo = Nothing
  m_dicVersions.RemoveAll
  Set m_dicVersions = Nothing
  Set pVersionedWorkspace = Nothing
End Sub
Private Sub SetState(ByVal bDirty As Boolean)
  Dim bOwner As Boolean
  bOwner = False
  If Not m_pVersionInfo Is Nothing Then
    bOwner = m_pVersionInfo.IsOwner
  End If
  
  m_IsDirty = bDirty
  cmdApply.Enabled = bDirty
  txtName.Enabled = bOwner
  txtDescription.Enabled = bOwner
  fraAccess.Enabled = bOwner
End Sub
Private Sub LoadVersionTree(ByVal pVersionedWorkspace As IVersionedWorkspace)
  tvwVersions.Nodes.Clear
  AddVersionToTree pVersionedWorkspace.DefaultVersion.VersionInfo, Nothing
  If tvwVersions.Nodes.count > 0 Then
    Set tvwVersions.SelectedItem = tvwVersions.Nodes.Item(1)
  End If
  
  SetState False
End Sub
Private Sub AddVersionToTree(ByVal pVersionInfo As IVersionInfo, ByVal pParentNode As Node)
'Recursive function that first adds the parent VersionInfo to tvwVersions and
'then calls itself recursively for each child VersionInfo

  Dim pEnumVersionInfo As IEnumVersionInfo
  Dim pNode As Node
  
  'Add the parent VersionInfo to the TreeView
  If pParentNode Is Nothing Then
    Set pNode = tvwVersions.Nodes.Add(, , pVersionInfo.VersionName, pVersionInfo.VersionName)
  Else
    Set pNode = tvwVersions.Nodes.Add(pParentNode.Index, tvwChild, pVersionInfo.VersionName, pVersionInfo.VersionName)
  End If
  
  'Add versioninfo to dictionary indexed of VersionName
  Set m_dicVersions.Item(pVersionInfo.VersionName) = pVersionInfo
   
  'Loop through calling this function for each child VersionInfo
  'Add each VersionInfo to the Treeview of all versions
  Set pEnumVersionInfo = pVersionInfo.Children
  Set pVersionInfo = pEnumVersionInfo.Next
  Do Until pVersionInfo Is Nothing
    'Recursively add child version to tree
    AddVersionToTree pVersionInfo, pNode
    Set pVersionInfo = pEnumVersionInfo.Next
  Loop
  
  pNode.Expanded = True
  
  'Release references
  Set pEnumVersionInfo = Nothing
  Set pNode = Nothing
End Sub

'Apply was changed.  Update version's properties
Private Sub cmdApply_Click()
  On Error Resume Next
  
  Dim access As Long
  For access = 0 To 2
    If optAccess.Item(access).Value Then
      Exit For
    End If
  Next access
  
  UpdateVersion m_pVersionInfo.VersionName, txtName.Text, txtDescription.Text, access
    
  SetState False
  Exit Sub
ErrorHandler:
  MsgBox "应用: " & Err.Description
End Sub
 
'Update's version's properties if they've changed.
'Updates member references to keep up to date.
Private Sub UpdateVersion(ByVal sOldVersionName As String, ByVal sNewVersionName As String, ByVal sDescription As String, ByVal access As esriVersionAccess)
  On Error GoTo ErrorHandler
  
  Dim pVersion As IVersion
  Dim pNode As Node
    
  'Get the current version to update
  Set pVersion = m_pVersionedWorkspace.FindVersion(sOldVersionName)
  
  'Update the access permissions
  If pVersion.access <> access Then
    pVersion.access = access
  End If
  
  'Update the description
  If pVersion.Description <> sDescription Then
    pVersion.Description = sDescription
  End If
  
  'Update the version name
  If StrComp(pVersion.VersionName, sNewVersionName, vbBinaryCompare) <> 0 Then
    pVersion.VersionName = sNewVersionName
    m_dicVersions.Remove sOldVersionName
    Set pNode = tvwVersions.Nodes.Item(sOldVersionName)
    pNode.Text = pVersion.VersionInfo.VersionName
    pNode.Key = pVersion.VersionInfo.VersionName
  End If
  
  'Update references to keep in sync with version
  Set m_pVersionInfo = pVersion.VersionInfo
  Set m_dicVersions.Item(m_pVersionInfo.VersionName) = m_pVersionInfo
    
  Exit Sub
ErrorHandler:
  MsgBox "UpdateVersion: " & Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

'Creates a version
Private Sub mnuCreate_Click()
  On Error GoTo ErrorHandler
  
  Dim pVersion As IVersion
  Dim pNewVersion As IVersion
  Dim sVersionName As String
  
  'Get new version name
  sVersionName = InputBox("输入版本名称:", "创建新版本", "")
  If Len(sVersionName) = 0 Then
    Exit Sub
  End If
  
  'Make sure it doesn't have owner name
  If InStr(1, sVersionName, ".") > 0 Then
    MsgBox "Invalid Version Name.  Do not include owner"
    Exit Sub
  End If
  
  'Get the parent version (used to create the child version)
  Set pVersion = m_pVersionedWorkspace.FindVersion(m_pVersionInfo.VersionName)
  
  'Create the new version and add it to the dictionary and tree
  Set pNewVersion = pVersion.CreateVersion(sVersionName)
  Set m_dicVersions.Item(pNewVersion.VersionInfo.VersionName) = pNewVersion.VersionInfo
  
  Dim pNode As Node
  Set pNode = tvwVersions.Nodes.Item(m_pVersionInfo.VersionName)
  Set pNode = tvwVersions.Nodes.Add(pNode, tvwChild, pNewVersion.VersionInfo.VersionName, pNewVersion.VersionInfo.VersionName)
  
  'Select the version so they can easily change the version's properties immediately
  SelectVersion pNode
  Exit Sub
ErrorHandler:
  MsgBox "创建版本: " & Err.Description
End Sub

'Delete the currently selected version
Private Sub mnuDelete_Click()
  On Error GoTo ErrorHandler
  
  Dim pVersion As IVersion
  Dim sVersionName As String
  
  'Delete the version
  sVersionName = m_pVersionInfo.VersionName
  Set pVersion = m_pVersionedWorkspace.FindVersion(sVersionName)
  pVersion.Delete
  
  'resync the treeview, dictionary
  Dim pNode As Node
  Set pNode = tvwVersions.Nodes.Item(sVersionName)
  tvwVersions.Nodes.Remove pNode.Index
  m_dicVersions.Remove sVersionName
  
  'unselect the version (it was deleted)
  SelectVersion Nothing
  Exit Sub
ErrorHandler:
  MsgBox "Delete Version: " & Err.Description
End Sub

Private Sub tvwVersions_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  'Select the current version on MouseDown
  Dim pNode As Node
  Set pNode = tvwVersions.HitTest(x, y)
  SelectVersion pNode
End Sub

Private Sub SelectVersion(pNode As Node)
  If Not pNode Is Nothing Then
    Dim sVersionName As String
  
    'Make the node selected in the treeview and visible
    pNode.Selected = True
    pNode.EnsureVisible
    
    'set current VersionInfo
    sVersionName = pNode.Text
    Set m_pVersionInfo = m_dicVersions.Item(sVersionName)
    
    'Set controls
    txtName.Text = m_pVersionInfo.VersionName
    txtDescription.Text = m_pVersionInfo.Description
    optAccess.Item(m_pVersionInfo.access).Value = True
    lblDateCreated.Caption = "Date Created:  " & m_pVersionInfo.Created
    lblDateModified.Caption = "Date Modified: " & m_pVersionInfo.Modified
    
  Else
    'Since the node is nothing, blank out everything
    Set m_pVersionInfo = Nothing
    Set tvwVersions.SelectedItem = Nothing
    txtName.Text = ""
    txtDescription.Text = ""
    optAccess.Item(0) = False
    optAccess.Item(1) = False
    optAccess.Item(2) = False
    lblDateCreated.Caption = ""
    lblDateModified.Caption = ""
  End If
  
  SetState False
End Sub

'Show context menu
Private Sub tvwVersions_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 2 Then
    Me.PopupMenu mnuPopup
  End If
End Sub

'Notify that Description changed
Private Sub txtDescription_Change()
  SetState True
End Sub

'Notify that Name changed
Private Sub txtName_Change()
  SetState True
End Sub

'Notify that Access Changed
Private Sub optAccess_Click(Index As Integer)
  SetState True
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -