frmimportdatasource4_dgn.frm

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

VERSION 5.00
Begin VB.Form frmImportDs4_Dgn 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "转入向导4 - 转入矢量DGN文件2"
   ClientHeight    =   3840
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6375
   Icon            =   "frmImportDatasource4_Dgn.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3840
   ScaleWidth      =   6375
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "2926"
   Begin VB.CommandButton btnAdd 
      Caption         =   "添加"
      Height          =   375
      Left            =   3585
      TabIndex        =   8
      Tag             =   "3080"
      Top             =   960
      Width           =   1065
   End
   Begin VB.CommandButton btnDel 
      Caption         =   "删除"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3585
      TabIndex        =   7
      Tag             =   "3148"
      Top             =   1500
      Width           =   1065
   End
   Begin VB.CommandButton btnAddall 
      Caption         =   "全加"
      Height          =   375
      Left            =   3585
      TabIndex        =   6
      Tag             =   "3149"
      Top             =   2040
      Width           =   1065
   End
   Begin VB.CommandButton btnDelall 
      Caption         =   "全删"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3585
      TabIndex        =   5
      Tag             =   "3150"
      Top             =   2580
      Width           =   1065
   End
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "放弃"
      Height          =   375
      Left            =   5025
      TabIndex        =   4
      Tag             =   "3058"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "完成"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   3390
      TabIndex        =   3
      Tag             =   "3133"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.CommandButton btnBack 
      Caption         =   "上一步"
      Height          =   375
      Left            =   2190
      TabIndex        =   2
      Tag             =   "3129"
      Top             =   3435
      Width           =   1200
   End
   Begin VB.ListBox lstDestinationLayer 
      BackColor       =   &H00FFFFFF&
      Height          =   1815
      Left            =   4740
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   825
      Width           =   1440
   End
   Begin VB.ListBox lstSourceLayer 
      BackColor       =   &H80000014&
      Height          =   1815
      Left            =   2055
      TabIndex        =   0
      Top             =   840
      Width           =   1440
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   3210
      Left            =   75
      Picture         =   "frmImportDatasource4_Dgn.frx":000C
      Stretch         =   -1  'True
      Top             =   75
      Width           =   1785
   End
   Begin VB.Label Label1 
      Caption         =   "从左侧列表中选择要转入的层次添加到右侧列表中"
      Height          =   210
      Left            =   2115
      TabIndex        =   9
      Tag             =   "3147"
      Top             =   285
      Width           =   4110
   End
   Begin VB.Line Line2 
      X1              =   0
      X2              =   6405
      Y1              =   3330
      Y2              =   3330
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000009&
      X1              =   0
      X2              =   6405
      Y1              =   3345
      Y2              =   3345
   End
End
Attribute VB_Name = "frmImportDs4_Dgn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub btnAdd_Click()
    lstDestinationLayer.AddItem lstSourceLayer.Text
    lstSourceLayer.RemoveItem lstSourceLayer.ListIndex
    lstDestinationLayer.ListIndex = 0
    If lstSourceLayer.ListCount <> 0 Then
        lstSourceLayer.ListIndex = 0
    Else
        btnAdd.Enabled = False
        btnAddall.Enabled = False
    End If
    btnOK.Enabled = True
    btnDel.Enabled = True
    btnDelall.Enabled = True
End Sub

Private Sub btnAddAll_Click()
    lstDestinationLayer.Clear
    Dim i As Integer
    For i = 0 To 63
        lstDestinationLayer.AddItem Str(i)
    Next
    lstDestinationLayer.ListIndex = 0
    lstSourceLayer.Clear
    btnDel.Enabled = True
    btnDelall.Enabled = True
    btnOK.Enabled = True
    btnAdd.Enabled = False
    btnAddall.Enabled = False
End Sub

Private Sub btnBack_Click()
    Unload Me
    frmImportDs3_Dgn.Show
End Sub

Private Sub btnCancel_Click()
    Unload Me
    Unload frmImportDs3_Dgn
    Unload frmImportDs2_V
    Unload frmImportDs1
End Sub

Private Sub btnDel_Click()
    lstSourceLayer.AddItem lstDestinationLayer.Text
    lstDestinationLayer.RemoveItem lstDestinationLayer.ListIndex
    lstSourceLayer.ListIndex = 0
    If lstDestinationLayer.ListCount = 0 Then
        btnOK.Enabled = False
        btnDelall.Enabled = False
        btnDel.Enabled = False
    Else
        lstDestinationLayer.ListIndex = 0
    End If
    btnAdd.Enabled = True
    btnAddall.Enabled = True
End Sub

Private Sub btnDelAll_Click()
    Dim i As Integer
    lstSourceLayer.Clear
    For i = 0 To 63
        lstSourceLayer.AddItem Str(i)
    Next
    lstSourceLayer.ListIndex = 0
    lstDestinationLayer.Clear
    btnOK.Enabled = False
    btnDelall.Enabled = False
    btnDel.Enabled = False
    btnAdd.Enabled = True
    btnAddall.Enabled = True
End Sub

Private Sub btnOK_Click()
    Dim objDS As soDataSource
    Dim strDsName As String
    Dim bResult As Boolean
    Dim i As Integer
    Dim objDtPump As soDataPump
    Dim objImpParam As soImportParams
    
    strDsName = frmImportDs1.cmbImportTo.Text
    Set objDS = frmMain.SuperWorkspace1.Datasources.Item(strDsName)
    If objDS Is Nothing Then
        MsgBox "数据源" & strDsName & "内部错误，无法继续!", vbInformation
        Exit Sub
    End If
    i = objDS.Datasets.Count
    Set objDtPump = objDS.DataPump
    Set objImpParam = objDtPump.DataImportParams
    If objImpParam Is Nothing Then
        MsgBox "导入参数对象 " & "内部错误，无法继续!", vbInformation
        Exit Sub
    End If
    objImpParam.FileName = frmImportDs1.txtImportFile.Text                               '源数据源文件名
    objImpParam.FileType = scfDGN
    objImpParam.ShowProgress = IIf(frmImportDs1.chkProgress.Value = 1, True, False)      '进程条
    objImpParam.ImportAsCompressedDatset = IIf(frmImportDs2_V.chkCompressed = 1, True, False)
    objImpParam.IgnoreStyle = IIf(frmImportDs2_V.chkStyle = 1, True, False)
    frmMain.SuperWorkspace1.DgnColorMappingTable = frmImportDs3_Dgn.txtColorFile.Text '颜色表文件
    frmMain.SuperWorkspace1.StyleMappingTable = frmImportDs3_Dgn.txtStyleMap.Text
    objImpParam.ImportAsCADDataset = frmImportDs2_V.optCADLayer.Value
    '取得图层名称
    With frmImportDs2_V
        objImpParam.DatasetCAD = IIf(.optCADLayer = True, .txtCADLayer.Text, "")
        objImpParam.DatasetLine = IIf(.chkLine.Value = vbChecked, .txtGISLine.Text, "")
        objImpParam.DatasetPoint = IIf(.chkPoint.Value = vbChecked, .txtGISPoint.Text, "")
        objImpParam.DatasetRegion = IIf(.chkRegion.Value = vbChecked, .txtGISRegion.Text, "")
        objImpParam.DatasetText = IIf(.chkText.Value = vbChecked, .txtGISText.Text, "")
    End With
    '取得Dgn单位
    Select Case frmImportDs3_Dgn.cmbDGNUnit.ListIndex
        Case 0
            objImpParam.DgnUnitsSelected = scdMain
        Case 1
            objImpParam.DgnUnitsSelected = scdSub
        Case 2
            objImpParam.DgnUnitsSelected = scdUOR
    End Select
    bResult = objDtPump.Import
    Unload Me
    If bResult Then
        '添加TreeView节点
        i = i + 1
        Do While i <= objDS.Datasets.Count
            Select Case objDS.Datasets.Item(i).Type
                Case scdPoint
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Case scdLine
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Case scdRegion
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Case scdText
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Case scdCAD
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
                Case Else
                    frmMain.tvwSpace.Nodes.Add "A" & frmImportDs1.cmbImportTo.Text, tvwChild, , objDS.Datasets.Item(i).Name
            End Select
            i = i + 1
        Loop
        frmMain.tvwSpace.SelectedItem = frmMain.tvwSpace.Nodes.Item(2)
    Else
        MsgBox "文件转入失败!", vbInformation
    End If
    Set objDS = Nothing
    Set objImpParam = Nothing
    Set objDtPump = Nothing
    Unload frmImportDs1
    Unload frmImportDs2_V
    Unload frmImportDs3_Dgn
    Unload Me
End Sub

Private Sub Form_Load()
    Dim i As Integer
    For i = 0 To 63
    lstSourceLayer.AddItem Str(i)
    Next
    lstSourceLayer.ListIndex = 0
End Sub

Private Sub lstDestinationLayer_DblClick()
    lstDestinationLayer.RemoveItem lstDestinationLayer.ListIndex
    If lstDestinationLayer.ListCount = 0 Then
        btnDel.Enabled = False
        btnDelall.Enabled = False
        btnOK.Enabled = False
    End If
End Sub

Private Sub lstDestinationLayer_GotFocus()
    If lstDestinationLayer.ListCount <> 0 Then
        btnDel.Enabled = True
        btnDelall.Enabled = True
    End If
End Sub

Private Sub lstSourceLayer_DblClick()
    lstDestinationLayer.AddItem lstSourceLayer.ListIndex
End Sub

Private Sub lstSourceLayer_GotFocus()
    btnDel.Enabled = False
    btnDelall.Enabled = False
End Sub