frmexport.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

            .AddItem "Arc/Info E00 文件 (*.e00)"         '"Arc/Info E00 文件 (*.e00)"
            .AddItem "ArcView Shape 文件 (*.shp)"        '"ArcView Shape 文件 (*.shp)"
            .AddItem "Arc/Info Coverage 文件 (*.*)"      '"Arc/Info Coverage 文件 (Arc.*)"
            .ListIndex = 0
        End With
    Else
        bIsVector = False
        With cmbFileType
            '栅格文件
            .Clear
            .AddItem "Bmp 图像文件 (*.bmp)"              '"Bmp 图像文件 (*.bmp)"
            .AddItem "JPG 图像文件 (*.jpg)"              '"JPG 图像文件 (*.jpg)"
            .AddItem "TIF 图像文件 (*.tif)"              '"TIF 图像文件 (*.tif)"
            .AddItem "Erdas 影像文件(*.img)"             '"Erdas 影像文件(*.img)"
            .AddItem "ECW格式文件*.ecw"                  '"ECW格式文件*.ecw"
            .ListIndex = 0
        End With
    End If
    Set Dt = Nothing
    cmbFileType.Enabled = True
    cmdOpen.Enabled = True
End Sub

Private Sub cmbDatasource_Click()
    Dim nDatasetCount As Integer          '数据集数目
    Dim objDt As soDataset                '数据集对象
    cmbDataset.Clear
    nDatasetCount = frmMain.SuperWorkspace1.Datasources.Item(cmbDatasource.Text).Datasets.Count
    
    If nDatasetCount > 0 Then             '源数据集数目不为零,则添加
        cmbFileType.Enabled = True
        txtExportFileName.Enabled = True
        cmdOpen.Enabled = True
        With frmMain.SuperWorkspace1.Datasources.Item(cmbDatasource.Text)
            For Each objDt In .Datasets
                cmbDataset.AddItem objDt.Name
            Next
        End With
        If frmMain.tvwSpace.SelectedItem.Parent.Text = "工作空间" Then
            cmbDataset.ListIndex = 0
        Else
            cmbDataset.Text = frmMain.tvwSpace.SelectedItem.Text
        End If
    Else
        cmbFileType.Enabled = False
        txtExportFileName.Enabled = False
        cmdOpen.Enabled = False
    End If
    Set objDt = Nothing
End Sub

Private Sub cmbFileType_Click()
    If cmbFileType.Text = "MicroStation dgn 文件(*.dgn)" Then  '"MicroStation dgn 文件(*.dgn)"
        lblDGNUnit.Enabled = True
        cmbDGNUnit.Enabled = True
        cmbDGNUnit.BackColor = &H80000005
    Else
        lblDGNUnit.Enabled = False
        cmbDGNUnit.Enabled = False
        cmbDGNUnit.BackColor = &H80000004
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdExport_Click()
    If Trim$(txtExportFileName.Text) = "" Then
        MsgBox "非法文件名", vbInformation
        Exit Sub
    End If
    Dim DS As soDataSource                    '数据集对象
    Dim bExportResult As Boolean
    Dim strDatasource As String
    Dim strDataset As String
    Dim objDtPump As soDataPump
    Dim objExpParam As soExportParams
    
    strDatasource = cmbDatasource.Text
    strDataset = cmbDataset.Text
     
    Set DS = frmMain.SuperWorkspace1.Datasources.Item(strDatasource)
    If DS Is Nothing Then
        MsgBox "数据源" & strDatasource & "内部错误，无法继续!", vbInformation
        Exit Sub
    End If
    Set objDtPump = DS.DataPump
    Set objExpParam = objDtPump.DataExportParams
    If objExpParam Is Nothing Then
        MsgBox "内部错误，无法继续!", vbInformation
        Exit Sub
    End If
    objExpParam.DatasetToBeExported = cmbDataset.Text
    objExpParam.ShowProgress = IIf(chkProgress = 1, True, False)
    objExpParam.FileName = txtExportFileName.Text
    Select Case cmbUnit.Text
        Case "千米"
            objExpParam.DesUnits = scuKilometer
        Case "米"
            objExpParam.DesUnits = scuMeter
        Case "分米"
            objExpParam.DesUnits = scuDecimeter
        Case "厘米"
            objExpParam.DesUnits = scuCentimeter
        Case "毫米"
            objExpParam.DesUnits = scuMillimeter
        Case "里"
            objExpParam.DesUnits = scuMile
        Case "码"
            objExpParam.DesUnits = scuYard
        Case "英尺"
            objExpParam.DesUnits = scuFoot
        Case "英寸"
            objExpParam.DesUnits = scuInch
    End Select
    If bIsVector Then
        '根据文件类型选择转出参数
        Select Case (cmbFileType.ListIndex + 1)
            '矢量文件
            Case 1:                             '"MapInfo 交换文件 (*.mif)":
                objExpParam.FileType = scfMIF
            Case 2:                             '"AutoCAD 交换文件(*.dxf)":
                objExpParam.FileType = scfDXF
            Case 3:                             '"MicroStation dgn 文件(*.dgn)":
                objExpParam.FileType = scfDGN
            Case 4:                             '"Arc/Info E00 文件 (*.e00)":
                objExpParam.FileType = scfE00
            Case 5:                             '"ArcView Shape 文件 (*.shp)":
                objExpParam.FileType = scfSHP
            Case 6:                             '"Arc/Info Coverage 文件 (*.*)":
                objDtPump.FileType = scfCoverage
         End Select
    Else
        Select Case (cmbFileType.ListIndex + 1)
             '栅格文件
            Case 1:                              '"Bmp 图像文件 (*.bmp)":
                objExpParam.FileType = scfBMP
            Case 2:                              '"JPG 图像文件 (*.jpg)":
                objExpParam.FileType = scfJPG
            Case 3:                              '"TIF 图像文件 (*.tif)":
                objExpParam.FileType = scfTIF
            Case 4:                              '"Erdas 影像文件(*.img)":
                objExpParam.FileType = scfIMG
            Case 5:
                objExpParam.FileType = scfECW
         End Select
    End If
    bExportResult = objDtPump.Export()
    If bExportResult Then
        Unload Me
    Else
        MsgBox "转出失败!数据集可能被破坏。", vbInformation
    End If
    Set objExpParam = Nothing
    Set objDtPump = Nothing
End Sub

Private Sub cmdOpen_Click()
      Dim nRespond As Integer
      Dim strExportFile As String
      Dim nFileTypeIndex As Integer
      '获取要转入的文件名
      cmlFile.DialogTitle = "转出"
      cmlFile.Flags = cdlOFNOverwritePrompt
      cmlFile.CancelError = False
      If bIsVector Then
            Select Case cmbFileType.ListIndex + 1
                '矢量文件
                Case 1:
                      cmlFile.Filter = "MapInfo 交换文件 (*.mif)|*.mif"
                Case 2:
                      cmlFile.Filter = "AutoCAD 交换文件(*.dxf)|*.dxf"
                Case 3:
                      cmlFile.Filter = "MicroStation dgn 文件(*.dgn)|*.dgn"
                Case 4:
                      cmlFile.Filter = "Arc/Info E00 文件 (*.e00)|*.e00"
                Case 5:
                      cmlFile.Filter = "ArcView Shape 文件 (*.shp)|*.shp"
                Case 6:
                      cmlFile.Filter = "Arc/Info Coverage 文件 (Arc.*)|Arc*.*"
                Case 7:
                      cmlFile.Filter = "国标矢量交换文件 (*.vct)|*.vct"
                Case 8:
                      cmlFile.Filter = "idrisi矢量交换文件 (*.vce)|*.vec"
        
            End Select
      Else
            Select Case cmbFileType.ListIndex + 1
                '栅格文件
                Case 1:
                      cmlFile.Filter = "Bmp 图像文件 (*.bmp)|*.BMP;*.bmp|所有文件 |*.*"
                Case 2:
                      cmlFile.Filter = "JPG 图像文件 (*.jpg)|*.JPG;*.jpg|所有文件 |*.*"
                Case 3:
                      cmlFile.Filter = "TIF 图像文件 (*.tif)|*.TIF;*.tif|所有文件 |*.*"
                Case 4:
                      cmlFile.Filter = "Erdas 影像文件(*.img)|*.IMG;*.img;*.Img|所有文件 |*.*"
                Case 5:
                      cmlFile.Filter = "ECW格式文件(*.ecw)|所有文件 |*.*"
            End Select
      End If
      cmlFile.ShowSave
      If LTrim$(cmlFile.FileName) = "" Then
            Exit Sub
      Else
            txtExportFileName.Text = LTrim$(cmlFile.FileName)
            Exit Sub
      End If
End Sub
Private Sub Form_Load()
    Dim nDatasourceCount As Integer     '数据源数目
    Dim i As Integer                    '循环变量
    Dim strDatasource() As String       '数据源名称
    '获取主窗体数据源信息,添加到组合框
    cmbDatasource.Clear
    nDatasourceCount = frmMain.SuperWorkspace1.Datasources.Count
    ReDim strDatasource(nDatasourceCount) As String
    For i = 1 To nDatasourceCount
        strDatasource(i) = frmMain.SuperWorkspace1.Datasources.Item(i).Alias
        cmbDatasource.AddItem strDatasource(i)
    Next
    
    With cmbUnit
        .AddItem "千米"
        .AddItem "米"
        .AddItem "分米"
        .AddItem "厘米"
        .AddItem "毫米"
        .AddItem "里"
        .AddItem "码"
        .AddItem "英尺"
        .AddItem "英寸"
        .ListIndex = 1
    End With
    With cmbDGNUnit
        .AddItem "主单位"
        .AddItem "从单位"
        .AddItem "最小分辨率"
        .ListIndex = 2
    End With
End Sub