frmimportdatasource2_g.frm

超图的文件的导入与导出VB开发程序的应用,对地理信息系统开发有益

VERSION 5.00
Begin VB.Form frmImportDs2_G 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "转入向导2 - 转入栅格文件"
   ClientHeight    =   3840
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6375
   Icon            =   "frmImportDatasource2_G.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3840
   ScaleWidth      =   6375
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "2910"
   Begin VB.CommandButton btnCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   5025
      TabIndex        =   5
      Tag             =   "3058"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "完成"
      Default         =   -1  'True
      Height          =   375
      Left            =   3390
      TabIndex        =   4
      Tag             =   "3133"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.CommandButton btnBack 
      Caption         =   "上一步"
      Height          =   375
      Left            =   2190
      TabIndex        =   3
      Tag             =   "3129"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.TextBox txtLayerName 
      Height          =   345
      Left            =   3495
      TabIndex        =   0
      Top             =   2190
      Width           =   2220
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   3135
      Left            =   150
      Picture         =   "frmImportDatasource2_G.frx":000C
      Stretch         =   -1  'True
      Top             =   75
      Width           =   1860
   End
   Begin VB.Label Label2 
      Caption         =   "输入栅格文件的图层名，若为空，则图层不能建立"
      Height          =   390
      Left            =   2325
      TabIndex        =   2
      Tag             =   "3131"
      Top             =   420
      Width           =   3420
   End
   Begin VB.Line Line2 
      X1              =   15
      X2              =   6420
      Y1              =   3330
      Y2              =   3330
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   15
      X2              =   6420
      Y1              =   3345
      Y2              =   3345
   End
   Begin VB.Label Label1 
      Caption         =   "图层名称"
      Height          =   225
      Left            =   2340
      TabIndex        =   1
      Tag             =   "3132"
      Top             =   2235
      Width           =   1140
   End
End
Attribute VB_Name = "frmImportDs2_G"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'转入向导第二步,转入栅格文件.本步获得图层名,并进行转入
Private Sub btnBack_Click()
    Unload Me
    frmImportDs1.Show
End Sub

Private Sub btnCancel_Click()
    Unload Me
    Unload frmImportDs1
End Sub

Private Sub btnOK_Click()
    Dim i As Integer
    Dim bResult As Boolean                      '转入是否成功的标志
    Dim sDsName As String
    Dim objDS As soDataSource
    Dim objDtPump As soDataPump
    Dim objImpParam As soImportParams
      
    sDsName = frmImportDs1.cmbImportTo.Text
    Set objDS = frmMain.SuperWorkspace1.Datasources.Item(sDsName)
    If objDS Is Nothing Then
        MsgBox "获取数据源失败", vbInformation
        Exit Sub
    End If
    
    i = objDS.Datasets.Count
    
    Set objDtPump = objDS.DataPump
    Set objImpParam = objDtPump.DataImportParams
    
    If Not objImpParam Is Nothing Then
        objImpParam.FileName = frmImportDs1.txtImportFile.Text
        objImpParam.DatasetImage = txtLayerName.Text
        objImpParam.ShowProgress = IIf(frmImportDs1.chkProgress.Value = 1, True, False)
        Select Case frmImportDs1.cmbFileType.ListIndex
              Case 0                        '"Bmp 图像文件 (*.bmp)|*.BMP;*.bmp"
                    objImpParam.FileType = scfBMP
              Case 1                       '"GRID 图像文件 (*.grd)|*.GRD;*.grd"
                    objImpParam.FileType = scfGRD
              Case 2                       '"JPG 图像文件 (*.jpg)|*.JPG;*.jpg"
                    objImpParam.FileType = scfJPG
              Case 3                        '"MrSid 图像文件 (*.sid)|*.SID;*.sid"
                    objImpParam.FileType = scfSID
              Case 4                        '"WMF 图像文件 (*.wmf)|*.WMF;*.wmf"
                    objImpParam.FileType = scfWMF
              Case 5                        '"Idrisi 栅格文件(*.img)|*.IMG;*.img;*.Img"
                    objImpParam.FileType = scfIDR
              Case 6                        '"Erdas 影像文件(*.img)|*.IMG;*.img;*.Img"
                    objImpParam.FileType = scfIMG
              Case 7                        '"TIF文件(*.tif)|*.tif"
                    objImpParam.FileType = scfTIF
        End Select
        bResult = objDtPump.Import()
        If bResult Then
            '添加TreeView节点
            i = i + 1
            Do While i <= objDS.Datasets.Count
                If objDS.Datasets.Item(i).Type = scdGrid Then
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                ElseIf objDS.Datasets.Item(i).Type = scdImage Then
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Else
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                End If
                i = i + 1
            Loop
        Else
            Dim objError As New soError
            
            MsgBox objError.LastErrorMsg
            
            Set objError = Nothing
        End If
    End If
    
    Set objDS = Nothing
    Set objImpParam = Nothing
    Set objDtPump = Nothing
    Unload frmImportDs1
    Unload Me
End Sub

Private Sub Form_Load()
    frmImportDs2_G.txtLayerName.Text = PathToName(frmImportDs1.txtImportFile.Text) & "_Grid"
End Sub

Private Sub txtLayerName_Change()
    If Len(LTrim(txtLayerName.Text)) = 0 Then
        btnOK.Enabled = False
    Else
        btnOK.Enabled = True
    End If
End Sub