www.pudn.com > MapX5Demo.rar > frmSaveLayer.frm, change:2002-09-20,size:6009b


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