frmediting.frm

MapX示例程序：编辑特征示例

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmEditing 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "对象编辑选项"
   ClientHeight    =   5100
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4290
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5100
   ScaleWidth      =   4290
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton CreateTempLayer 
      Caption         =   "创建临时层"
      Height          =   375
      Left            =   2280
      TabIndex        =   10
      Top             =   4080
      Width           =   1935
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3000
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton CreatePermanentLayer 
      Caption         =   "创建永久层"
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   4080
      Width           =   2055
   End
   Begin VB.Frame Frame1 
      Caption         =   "选项"
      Height          =   1455
      Left            =   120
      TabIndex        =   3
      Top             =   2520
      Width           =   4095
      Begin VB.CheckBox InsertionLayerCheck 
         Caption         =   "插入图层"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   1080
         Width           =   3735
      End
      Begin VB.CheckBox LineDirCheck 
         Caption         =   "显示线方向"
         Height          =   255
         Left            =   2160
         TabIndex        =   7
         Top             =   720
         Width           =   1815
      End
      Begin VB.CheckBox CentroidCheck 
         Caption         =   "显示中心"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   720
         Width           =   1695
      End
      Begin VB.CheckBox NodesCheck 
         Caption         =   "显示节点"
         Height          =   255
         Left            =   2160
         TabIndex        =   5
         Top             =   360
         Width           =   1335
      End
      Begin VB.CheckBox EditableCheck 
         Caption         =   "可编辑"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   1575
      End
   End
   Begin VB.ListBox LayerList 
      Height          =   1860
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   4095
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Top             =   4680
      Width           =   1575
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      X1              =   -120
      X2              =   4320
      Y1              =   4560
      Y2              =   4560
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   4320
      Y1              =   4575
      Y2              =   4575
   End
   Begin VB.Label Label1 
      Caption         =   "图层:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   2055
   End
End
Attribute VB_Name = "FrmEditing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CentroidCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    '设置图层的ShowCentroids
    If NodesCheck.Value = 1 Then
        lyr.ShowCentroids = True
    Else
        lyr.ShowCentroids = False
    End If
End Sub

Private Sub CreatePermanentLayer_Click()
    '弹出对话框确定图层保存的路径
    CommonDialog1.DefaultExt = "tab"
    CommonDialog1.DialogTitle = "Pick a location for your layer"
    CommonDialog1.Filter = "MapInfo Tables (*.tab)|*.tab"
    CommonDialog1.ShowSave
    If Len(CommonDialog1.FileName) = 0 Then
        Exit Sub
    End If
    
    Dim lyr As Layer
    Dim friendlyName As String
    '从文件名中删除.tab扩展名
    friendlyName = Left$(CommonDialog1.FileTitle, _
                            Len(CommonDialog1.FileTitle) - 4)
    
    On Error GoTo CreateErr
    '创建新图层
    Set lyr = FrmMain.Map1.Layers.CreateLayer(friendlyName, _
                                                CommonDialog1.FileName)
    lyr.Editable = True
    
    UpdateControls True
    
    Exit Sub
CreateErr:
    MsgBox "无法创建图层: """ & friendlyName & """ 于： """ & _
            CommonDialog1.FileName & """: " & Error
End Sub

Private Sub CreateTempLayer_Click()
    Dim lyrName As String
    Dim lyr As Layer
    '获取新图层名
    lyrName = InputBox("请输入图层名:", "图层名")
    If lyrName = "" Then
         Exit Sub
    End If
    
    On Error GoTo CreateErr
    '创建新图层
    Set lyr = FrmMain.Map1.Layers.CreateLayer(lyrName)
    lyr.Editable = True

    UpdateControls True
    
    Exit Sub
CreateErr:
    MsgBox "无法创建图层: """ & lyrName & """: " & Error
End Sub

Private Sub EditableCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' 更新图层的Editable属性
    ' 这里验证了是否修改永久层的Editable属性
    If EditableCheck.Value = 0 Then
        lyr.Editable = False
    Else
        If IsPermanent(lyr) = True And lyr.Editable = False Then
            If MsgBox("您将永久层设置为可编辑模式. 此时对永久层" & _
                        "的修改操作将永久存在.是否继续?", vbYesNo) <> vbYes Then
                EditableCheck.Value = 0
                Exit Sub
            End If
        End If
        lyr.Editable = True
    End If
End Sub

Private Sub Form_Load()
    UpdateControls True
End Sub

Private Sub UpdateControls(RefillList As Boolean)
    If RefillList = True Then
        Dim oldIndex As Integer
        Dim lyr As Layer
    
        ' 保存被选择的项
        oldIndex = LayerList.ListIndex
    
        LayerList.Clear
        ' 将地图上所有图层填充至LayerList
        For Each lyr In FrmMain.Map1.Layers
            LayerList.AddItem lyr.Name
        Next
        If oldIndex <> -1 Then
            LayerList.ListIndex = oldIndex
        End If
    End If
    
    ' 若列列表框中图层未被选中,则使下列控件无效
    If LayerList.ListIndex = -1 Then
        InsertionLayerCheck.Enabled = False
        EditableCheck.Enabled = False
        LineDirCheck.Enabled = False
        NodesCheck.Enabled = False
        CentroidCheck.Enabled = False
    Else
        InsertionLayerCheck.Enabled = True
        EditableCheck.Enabled = True
        LineDirCheck.Enabled = True
        NodesCheck.Enabled = True
        CentroidCheck.Enabled = True
    
        ' 根据图层属性更新控件
        ' of the layer.
        Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
        If lyr.Editable = True Then
            EditableCheck.Value = 1
        Else
            EditableCheck.Value = 0
        End If
        
        If lyr.ShowLineDirection = True Then
            LineDirCheck.Value = 1
        Else
            LineDirCheck.Value = 0
        End If
        
        If lyr.ShowNodes = True Then
            NodesCheck.Value = 1
        Else
            NodesCheck.Value = 0
        End If
        
        If lyr.ShowCentroids = True Then
            CentroidCheck.Value = 1
        Else
            CentroidCheck.Value = 0
        End If
        
        ' 设定插入图层(若存在此图层)
        If IsInvalidObject(FrmMain.Map1.Layers.InsertionLayer) Then
            InsertionLayerCheck.Value = 0
            InsertionLayerCheck.Caption = "插入图层 (当前: None)"
        ElseIf IsInsertionLayer(lyr) Then
            InsertionLayerCheck.Caption = "插入图层"
            InsertionLayerCheck.Value = 1
        Else
            InsertionLayerCheck.Caption = "插入图层 (当前: " + _
                    FrmMain.Map1.Layers.InsertionLayer.Name + ")"
            InsertionLayerCheck.Value = 0
        End If
    End If
End Sub

Private Sub InsertionLayerCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' 更新图层的Editable属性
    ' 这里验证了是否修改永久层的Editable属性
    If InsertionLayerCheck.Value = 1 And Not IsInsertionLayer(lyr) Then
        If IsPermanent(lyr) Then
            If MsgBox("您将永久层设置为可编辑模式. 此时对永久层的" & _
                        "修改操作将永久存在.是否继续?", vbYesNo) = vbNo Then
                InsertionLayerCheck.Value = 0
                Exit Sub
            End If
        End If
        
        InsertionLayerCheck.Caption = "Insertion Layer"
        Set FrmMain.Map1.Layers.InsertionLayer = lyr
    End If
    
    If InsertionLayerCheck.Value = 0 And IsInsertionLayer(lyr) Then
        InsertionLayerCheck.Caption = "Insertion Layer (Current: None)"
        Set FrmMain.Map1.Layers.InsertionLayer = Nothing
    End If
End Sub

Private Sub LayerList_Click()
    UpdateControls False
End Sub

Private Sub LineDirCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' 设置图层的ShowLineDirection属性
    If NodesCheck.Value = 1 Then
        lyr.ShowLineDirection = True
    Else
        lyr.ShowLineDirection = False
    End If
End Sub

Private Sub NodesCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' 设置图层的ShowNodes属性
    If NodesCheck.Value = 1 Then
        lyr.ShowNodes = True
    Else
        lyr.ShowNodes = False
    End If
End Sub

Private Sub OKButton_Click()
    Unload Me
End Sub