frmappendfromother.frm

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

VERSION 5.00
Begin VB.Form frmAppendFromOther 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据追加"
   ClientHeight    =   2805
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   5745
   Icon            =   "frmAppendFromOther.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   5745
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "1332"
   Begin VB.Frame Frame3 
      Caption         =   "添加到"
      Height          =   1200
      Left            =   180
      TabIndex        =   7
      Tag             =   "5375"
      Top             =   135
      Width           =   3960
      Begin VB.ComboBox cmbSourceDsName 
         Height          =   315
         Left            =   1305
         Style           =   2  'Dropdown List
         TabIndex        =   11
         Top             =   270
         Width           =   2460
      End
      Begin VB.ComboBox cmbSourceDtName 
         Height          =   315
         Left            =   1305
         Style           =   2  'Dropdown List
         TabIndex        =   10
         Top             =   690
         Width           =   2460
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         Caption         =   "数据源"
         Height          =   195
         Left            =   45
         TabIndex        =   9
         Tag             =   "3051"
         Top             =   330
         Width           =   1140
      End
      Begin VB.Label Label5 
         Alignment       =   1  'Right Justify
         Caption         =   "数据集"
         Height          =   195
         Left            =   45
         TabIndex        =   8
         Tag             =   "3052"
         Top             =   780
         Width           =   1140
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "要追加的数据集"
      Height          =   1200
      Left            =   180
      TabIndex        =   2
      Tag             =   "5341"
      Top             =   1395
      Width           =   3960
      Begin VB.ComboBox cmbDtName 
         Height          =   315
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   705
         Width           =   2460
      End
      Begin VB.ComboBox cmbDsName 
         Height          =   315
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   285
         Width           =   2460
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         Caption         =   "数据集"
         Height          =   210
         Left            =   60
         TabIndex        =   6
         Tag             =   "3052"
         Top             =   765
         Width           =   1140
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "数据源"
         Height          =   210
         Left            =   60
         TabIndex        =   5
         Tag             =   "3051"
         Top             =   330
         Width           =   1140
      End
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "确定"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4395
      TabIndex        =   1
      Tag             =   "3057"
      Top             =   255
      Width           =   1200
   End
   Begin VB.CommandButton btnCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4410
      TabIndex        =   0
      Tag             =   "3058"
      Top             =   825
      Width           =   1200
   End
End
Attribute VB_Name = "frmAppendFromOther"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub btnCancel_Click()
    Unload Me
End Sub

Private Sub btnOK_Click()
    Dim objDs As soDataSource
    Dim objSourceDtVector As soDatasetVector
    Dim objDestDtVector As soDatasetVector
    Dim objRecordset As soRecordset
    Dim bResult As Boolean
    
    '取源矢量数据集
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbSourceDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
        Exit Sub
    End If
    Set objSourceDtVector = objDs.Datasets.Item(cmbSourceDtName.Text)
    If objSourceDtVector Is Nothing Then
        MsgBox "打开数据集时出错！", vbInformation
        Exit Sub
    End If
    
    '取要追加的矢量数据集
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
        Exit Sub
    End If
    If objDs.Datasets.Item(cmbDtName.Text).Vector = False Then
        MsgBox "所选数据集不是矢量数据集!", vbInformation
        Exit Sub
    End If
    Set objDestDtVector = objDs.Datasets.Item(cmbDtName.Text)
    If objDestDtVector Is Nothing Then
        MsgBox "所选数据集不是矢量数据集", vbInformation
        Exit Sub
    End If
    
    Set objRecordset = objDestDtVector.Query("", True)
    If objRecordset Is Nothing Then
        MsgBox "打开数据集时出错！", vbInformation
        Exit Sub
    End If
    
    '追加
    bResult = objSourceDtVector.Append(objRecordset)
    If bResult = True Then
        MsgBox "添加成功", vbInformation
    Else
        MsgBox "添加失败", vbInformation
    End If
    
    Unload Me
End Sub

Private Sub cmbDsName_Click()
    '选择用来追加的数据源，并装载相应的数据集
    If cmbDsName.ListIndex < 0 Then Exit Sub
    
    Dim objDt As soDataset
    Dim objDs As soDataSource
    Dim nDtType As Long
    
    '取得源数据集的类型
    If cmbSourceDsName.Text = "" Then Exit Sub
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbSourceDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
        Exit Sub
    Else
        Set objDt = objDs.Datasets.Item(cmbSourceDtName.Text)
        If objDt Is Nothing Then
            MsgBox "打开数据集时出错！", vbInformation
            Exit Sub
        Else
            nDtType = objDt.Type          '取得类型
        End If
    End If
    '改变目标数据集
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
        cmbDtName.Clear
        Exit Sub
    Else
        cmbDtName.Clear
        For Each objDt In objDs.Datasets
            If (objDt.Type = nDtType) Then
                If Not (objDt.DataSourceAlias = cmbSourceDsName.Text) Then
                    '以上条件保证源数据集不会被添加进来
                    cmbDtName.AddItem objDt.Name
                End If
            End If
        Next
    End If
    
    cmbSourceDtName_Click
End Sub

Private Sub cmbDtName_Click()
    If cmbDtName.ListIndex > -1 Then
        btnOK.Enabled = True
    Else
        btnOK.Enabled = False
    End If
End Sub

Private Sub cmbSourceDsName_Click()
    '选择追加的目标数据源，并装载相应的数据集
    Dim objDs As soDataSource
    Dim objDt As soDataset
    
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbSourceDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
    Else
        '每次改变数据源，都重新添加源数据集
        cmbSourceDtName.Clear
        cmbDtName.Clear
        For Each objDt In objDs.Datasets
            If objDt.Vector = True Then cmbSourceDtName.AddItem objDt.Name                            '是矢量数据集才添加
        Next
        If cmbSourceDtName.ListCount > 0 Then
            If cmbSourceDsName.Text = frmMain.tvwSpace.SelectedItem.Text Then
                cmbSourceDtName.Text = frmMain.tvwSpace.SelectedItem.Text
            Else
                cmbSourceDtName.ListIndex = 0
            End If
        End If
    End If
End Sub

Private Sub cmbSourceDtName_Click()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    Dim nDtType As Long
    
    '取得源数据集的类型
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbSourceDsName.Text)
    If objDs Is Nothing Then
        MsgBox "打开数据源错误！", vbInformation
        Exit Sub
    End If
    Set objDt = objDs.Datasets.Item(cmbSourceDtName.Text)
    If objDt Is Nothing Then
        MsgBox "打开数据集时出错！", vbInformation
        Exit Sub
    Else
        nDtType = objDt.Type
    End If
    
    '如果目标数据源已设置，则目标数据集相应改变
    If cmbDsName.Text <> "" Then              '目标数据源已设置
        Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbDsName.Text)
        If objDs Is Nothing Then
            MsgBox "打开数据源错误！", vbInformation
        Else
            cmbDtName.Clear
            For Each objDt In objDs.Datasets
                If objDt.Type = nDtType Then cmbDtName.AddItem objDt.Name         '与源数据集同类型才添加
            Next
            btnOK.Enabled = False
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim objDs As soDataSource
    Dim objDt As soDataset
    
    '添加源数据源和目标数据源列表
    With frmMain.SuperWorkspace1
        For Each objDs In .Datasources
            cmbSourceDsName.AddItem objDs.Alias
            cmbDsName.AddItem objDs.Alias
        Next
    End With
End Sub