frmsavelayer.frm

该源码实现了mapx5的一些新功能

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmSaveLayer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "另存为"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin MSComDlg.CommonDialog CommonDialog 
      Left            =   120
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdSaveFilePath 
      Height          =   375
      Left            =   4080
      Picture         =   "frmSaveLayer.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   1560
      Width           =   375
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "退出"
      Height          =   400
      Left            =   2760
      TabIndex        =   6
      Top             =   2400
      Width           =   1200
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存"
      Height          =   400
      Left            =   720
      TabIndex        =   5
      Top             =   2400
      Width           =   1200
   End
   Begin VB.TextBox txtFilePath 
      Height          =   375
      Left            =   1320
      TabIndex        =   4
      Top             =   1560
      Width           =   2775
   End
   Begin VB.CheckBox chkSaveFeatures 
      Caption         =   "只保存选中部分"
      Enabled         =   0   'False
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   960
      Width           =   3615
   End
   Begin VB.ComboBox cbLayers 
      Height          =   315
      Left            =   1320
      TabIndex        =   1
      Top             =   360
      Width           =   2775
   End
   Begin VB.Label Label2 
      Caption         =   "路径："
      Height          =   255
      Left            =   360
      TabIndex        =   3
      Top             =   1620
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "图层名称："
      Height          =   255
      Left            =   360
      TabIndex        =   0
      Top             =   435
      Width           =   975
   End
End
Attribute VB_Name = "frmSaveLayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************************
'File Name   ：frmSaveLayer.frm
'Description ：save a layer,include parts of all features
'Author      ：James Liu
'Copyright   ：MapInfo China
'Create Date ：2002年9月11日
'********************************************************************************

Private Sub cbLayers_Click()
On Error Resume Next

Dim oLayer As MapXLib.Layer
    
    Set oLayer = frmMain.Map.Layers(cbLayers.Text)
    If oLayer.Selection.Count <> 0 Then
        chkSaveFeatures.Enabled = True
        chkSaveFeatures.value = 0
    Else
        chkSaveFeatures.Enabled = False
        chkSaveFeatures.value = 0
    End If

End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
Dim oLayer As MapXLib.Layer
Dim oFtrs As MapXLib.Features
Dim oLayerInfo As MapXLib.LayerInfo
Dim oFields As MapXLib.Fields
Dim oDS As MapXLib.Dataset
Dim sFilePath As String
Dim sLayerName As String

On Error Resume Next
    
    sFilePath = Trim(txtFilePath.Text)
    If sFilePath = "" Then Exit Sub
    
    Set oLayer = frmMain.Map.Layers(cbLayers.List(cbLayers.ListIndex))
    Set oDS = frmMain.Map.DataSets(oLayer.Name)
    If Err.Number > 0 Then
        Err.Clear
        Set oDS = frmMain.Map.DataSets.Add(miDataSetLayer, oLayer, oLayer.Name)
    End If
    
    sLayerName = "SaveLayer" & Trim(Time())
    Set oLayerInfo = New MapXLib.LayerInfo
    oLayerInfo.Type = miLayerInfoTypeNewTable
    oLayerInfo.AddParameter "FileSpec", sFilePath
    oLayerInfo.AddParameter "Name", sLayerName
    oLayerInfo.AddParameter "Fields", oDS.Fields
    If chkSaveFeatures.value = 1 Then
        Set oFtrs = oLayer.Selection
    Else
        Set oFtrs = oLayer.AllFeatures
    End If
    oLayerInfo.AddParameter "Features", oFtrs
    oLayerInfo.AddParameter "OverwriteFile", "1"
    oLayerInfo.AddParameter "Visible", False
    
    frmMain.Map.Layers.Add oLayerInfo
    
    frmMain.Map.Layers.Remove sLayerName
    
    Set oDS = Nothing
    Set oLayerInfo = Nothing
    
    If chkSaveFeatures.value = 1 Then
        MsgBox "将" & oLayer.Name & "中的部分要素成功保存到" & sFilePath
    Else
        MsgBox "将" & oLayer.Name & "成功保存到" & sFilePath
    End If
    Unload Me
    
End Sub

Private Sub cmdSaveFilePath_Click()
On Error Resume Next

Dim sFilePath As String
Dim sFileName As String
    
    CommonDialog.CancelError = True
    CommonDialog.Filter = "*.tab|*.tab"
    CommonDialog.ShowSave
    sFilePath = CommonDialog.FileName
    If Trim(sFilePath) <> "" Then
        txtFilePath.Text = sFilePath
    End If

    
End Sub

Private Sub Form_Load()
On Error Resume Next

Dim oLayer As MapXLib.Layer
    For Each oLayer In frmMain.Map.Layers
        cbLayers.AddItem oLayer.Name
    Next oLayer
    
    cbLayers.ListIndex = 0
    Set oLayer = frmMain.Map.Layers(1)
    If oLayer.Selection.Count <> 0 Then
        chkSaveFeatures.Enabled = True
        chkSaveFeatures.value = 0
    Else
        chkSaveFeatures.Enabled = False
        chkSaveFeatures.value = 0
    End If
    
End Sub