frmediting.frm

GIS地理信息系统开发。大名鼎鼎的MAPX＋VisualBasic6.0软件开发

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmEditing 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Object Editing Options"
   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         =   "Create Temporary Layer"
      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         =   "&Create Permanent Layer..."
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   4080
      Width           =   2055
   End
   Begin VB.Frame Frame1 
      Caption         =   "Options:"
      Height          =   1455
      Left            =   120
      TabIndex        =   3
      Top             =   2520
      Width           =   4095
      Begin VB.CheckBox InsertionLayerCheck 
         Caption         =   "&Insertion Layer"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   1080
         Width           =   3735
      End
      Begin VB.CheckBox LineDirCheck 
         Caption         =   "Show &Line Direction"
         Height          =   255
         Left            =   2160
         TabIndex        =   7
         Top             =   720
         Width           =   1815
      End
      Begin VB.CheckBox CentroidCheck 
         Caption         =   "Show Centr&oids"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   720
         Width           =   1695
      End
      Begin VB.CheckBox NodesCheck 
         Caption         =   "Show &Nodes"
         Height          =   255
         Left            =   2160
         TabIndex        =   5
         Top             =   360
         Width           =   1335
      End
      Begin VB.CheckBox EditableCheck 
         Caption         =   "&Editable"
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   1575
      End
   End
   Begin VB.ListBox LayerList 
      Height          =   2010
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   4095
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "OK"
      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         =   "Layer:"
      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
' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Option Explicit

Private Sub CentroidCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' Update the Layer.ShowCentroids property according to the value
    ' of the check box.
    If NodesCheck.Value = 1 Then
        lyr.ShowCentroids = True
    Else
        lyr.ShowCentroids = False
    End If
End Sub

Private Sub CreatePermanentLayer_Click()
    ' Pop up a Save common dialog to ask the user where to place the new layer.
    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
    ' Remove the .tab extension from the file title to get the layer name
    friendlyName = Left$(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
    
    On Error GoTo CreateErr
    ' Create the new layer and make it editable.
    Set lyr = FrmMain.Map1.Layers.CreateLayer(friendlyName, CommonDialog1.FileName)
    lyr.Editable = True
    
    ' Update the dialog so that the newly created layer shows up.
    UpdateControls True
    
    Exit Sub
CreateErr:
    MsgBox "Could not create a layer named: """ & friendlyName & """ in """ & CommonDialog1.FileName & """: " & Error
End Sub

Private Sub CreateTempLayer_Click()
    Dim lyrName As String
    Dim lyr As Layer
    ' Put up a prompt for the new layer's name
    lyrName = InputBox("Please enter a Layer Name:", "Layer Name")
    If lyrName = "" Then
         Exit Sub
    End If
    
    On Error GoTo CreateErr
    ' Create a new temporary layer, and make it editable.
    Set lyr = FrmMain.Map1.Layers.CreateLayer(lyrName)
    lyr.Editable = True

    ' Update the dialog so that the newly created layer shows up.
    UpdateControls True
    
    Exit Sub
CreateErr:
    MsgBox "Could not create a layer named: """ & lyrName & """: " & Error
End Sub

Private Sub EditableCheck_Click()
    Dim lyr As Layer
    Set lyr = FrmMain.Map1.Layers.Item(LayerList.ListIndex + 1)
    
    ' Set the Layer.Editable attribute according to the user's wishes.
    ' This code is slightly complicated because we want to display a
    ' confirmation if the user is trying to make a permanent layer
    ' editable.
    If EditableCheck.Value = 0 Then
        lyr.Editable = False
    Else
        If IsPermanent(lyr) = True And lyr.Editable = False Then
            If MsgBox("You have chosen to make a permanent layer editable. This will allow you to permanently delete and edit the features of this layer. Are you sure you wish to continue?", 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
    
        ' Save which item was currently selected. This information will be lost when
        ' we execute the LayerList.Clear
        oldIndex = LayerList.ListIndex
    
        LayerList.Clear
        ' Refill the LayerList with every layer on the map.
        For Each lyr In FrmMain.Map1.Layers
            LayerList.AddItem lyr.Name
        Next
        If oldIndex <> -1 Then
            LayerList.ListIndex = oldIndex
        End If
    End If
    
    ' Disable all the checkboxes if there's nothing selected in the layer listbox
    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
    
        ' Set all the checkboxes to Checked or Unchecked depending on the attributes
        ' 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
        
        ' Set the value and caption of the insertion layer checkbox, depending on
        ' whether there is an insertion layer.
        If IsInvalidObject(FrmMain.Map1.Layers.InsertionLayer) Then
            InsertionLayerCheck.Value = 0
            InsertionLayerCheck.Caption = "Insertion Layer (Current: None)"
        ElseIf IsInsertionLayer(lyr) Then
            InsertionLayerCheck.Caption = "Insertion Layer"
            InsertionLayerCheck.Value = 1
        Else
            InsertionLayerCheck.Caption = "Insertion Layer (Current: " + 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)
    
    ' Set the insertion layer to the current layer if the user clicked on the
    ' checkbox. This code is complicated by the fact that we want to prompt the
    ' user if a permanent layer is selected
    If InsertionLayerCheck.Value = 1 And Not IsInsertionLayer(lyr) Then
        If IsPermanent(lyr) Then
            If MsgBox("You have chosen to set the insertion layer to a permanent layer. This will allow you to permanently add features to this layer. Are you sure you wish to continue?", vbYesNo) = vbNo Then
                InsertionLayerCheck.Value = 0
                Exit Sub
            End If
        End If
        
        InsertionLayerCheck.Caption = "Insertion Layer"
        Set FrmMain.Map1.Layers.InsertionLayer = lyr
    End If
    
    ' Set the insertion layer to nothing if the user unchecked the checkbox.
    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)
    
    ' Set the Layer.ShowLineDirection property according to the user's wishes.
    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)
    
    ' Set the Layer.ShowNodes property according to the user's wishes
    If NodesCheck.Value = 1 Then
        lyr.ShowNodes = True
    Else
        lyr.ShowNodes = False
    End If
End Sub

Private Sub OKButton_Click()
    Unload Me
End Sub