frmcopydataset.frm

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

VERSION 5.00
Begin VB.Form frmCopyDataset 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "复制数据集"
   ClientHeight    =   3840
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6510
   Icon            =   "frmCopyDataset.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3840
   ScaleWidth      =   6510
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "2907"
   Begin VB.CheckBox chkRenameCopy 
      Caption         =   "更名复制"
      Height          =   240
      Left            =   3495
      TabIndex        =   8
      Tag             =   "3094"
      Top             =   2895
      Width           =   1275
   End
   Begin VB.ListBox lstDestDt 
      Height          =   1620
      Left            =   4785
      TabIndex        =   7
      Top             =   1155
      Width           =   1545
   End
   Begin VB.CommandButton btnDelAll 
      Caption         =   "全部移除"
      Enabled         =   0   'False
      Height          =   345
      Left            =   3555
      TabIndex        =   6
      Tag             =   "3093"
      Top             =   2385
      Width           =   1140
   End
   Begin VB.CommandButton btnDel 
      Caption         =   "移除"
      Enabled         =   0   'False
      Height          =   345
      Left            =   3555
      TabIndex        =   5
      Tag             =   "3092"
      Top             =   1980
      Width           =   1140
   End
   Begin VB.CommandButton btnAddAll 
      Caption         =   "全部添加"
      Height          =   345
      Left            =   3555
      TabIndex        =   4
      Tag             =   "3091"
      Top             =   1590
      Width           =   1140
   End
   Begin VB.CommandButton btnAdd 
      Caption         =   "添加"
      Height          =   345
      Left            =   3555
      TabIndex        =   3
      Tag             =   "3090"
      Top             =   1200
      Width           =   1140
   End
   Begin VB.ComboBox cmbDestDS 
      Height          =   315
      Left            =   4695
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   435
      Width           =   1635
   End
   Begin VB.ComboBox cmbSourceDS 
      Height          =   315
      Left            =   1920
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   435
      Width           =   1635
   End
   Begin VB.ListBox lstSourceDt 
      Height          =   1620
      ItemData        =   "frmCopyDataset.frx":000C
      Left            =   1920
      List            =   "frmCopyDataset.frx":000E
      TabIndex        =   1
      Top             =   1155
      Width           =   1545
   End
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   5010
      TabIndex        =   10
      Tag             =   "3058"
      Top             =   3420
      Width           =   1200
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   3180
      TabIndex        =   9
      Tag             =   "3057"
      Top             =   3420
      Width           =   1200
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   3135
      Left            =   75
      Picture         =   "frmCopyDataset.frx":0010
      Stretch         =   -1  'True
      Top             =   75
      Width           =   1710
   End
   Begin VB.Label Label4 
      Caption         =   "目标数据集"
      Height          =   180
      Left            =   4770
      TabIndex        =   14
      Tag             =   "3089"
      Top             =   900
      Width           =   1650
   End
   Begin VB.Label Label3 
      Caption         =   "源数据集"
      Height          =   180
      Left            =   1935
      TabIndex        =   13
      Tag             =   "3087"
      Top             =   900
      Width           =   1530
   End
   Begin VB.Label Label2 
      Caption         =   "目标数据源"
      Height          =   210
      Left            =   4665
      TabIndex        =   12
      Tag             =   "3088"
      Top             =   180
      Width           =   1800
   End
   Begin VB.Label Label1 
      Caption         =   "源数据源"
      Height          =   210
      Left            =   1935
      TabIndex        =   11
      Tag             =   "3086"
      Top             =   180
      Width           =   1530
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000006&
      X1              =   0
      X2              =   6600
      Y1              =   3315
      Y2              =   3315
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   6600
      Y1              =   3330
      Y2              =   3330
   End
End
Attribute VB_Name = "frmCopyDataset"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub btnAdd_Click()
    '把选中的数据集对象作为复制对象
    lstDestDt.AddItem lstSourceDt.Text
    lstSourceDt.RemoveItem lstSourceDt.ListIndex
    lstDestDt.ListIndex = 0
    If lstSourceDt.ListCount <> 0 Then
        lstSourceDt.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()
    '把源数据源中的所有数据集都作为复制的对象
    Dim i As Integer
    For i = 0 To lstSourceDt.ListCount - 1
        lstSourceDt.ListIndex = i
        lstDestDt.AddItem lstSourceDt.Text
    Next
    
    lstDestDt.ListIndex = 0
    lstSourceDt.Clear
    btnDel.Enabled = True
    btnDelAll.Enabled = True
    btnOK.Enabled = True
    btnAdd.Enabled = False
    btnAddAll.Enabled = False
End Sub

Private Sub btnCancel_Click()
    Unload Me
End Sub

Private Sub btnDel_Click()
    '移除以前添加的用来复制的数据集
    lstSourceDt.AddItem lstDestDt.Text
    lstDestDt.RemoveItem lstDestDt.ListIndex
    lstSourceDt.ListIndex = 0
    
    If lstDestDt.ListCount = 0 Then
        btnOK.Enabled = False
        btnDelAll.Enabled = False
        btnDel.Enabled = False
    Else
        lstDestDt.ListIndex = 0
    End If
    
    btnAdd.Enabled = True
    btnAddAll.Enabled = True
End Sub

Private Sub btnDelAll_Click()
    '移除全部的数据集
    Dim i As Integer
    
    For i = 0 To lstDestDt.ListCount - 1
        lstDestDt.ListIndex = i
        lstSourceDt.AddItem lstDestDt.Text
    Next
    
    lstSourceDt.ListIndex = 0
    lstDestDt.Clear
    btnOK.Enabled = False
    btnDelAll.Enabled = False
    btnDel.Enabled = False
    btnAdd.Enabled = True
    btnAddAll.Enabled = True
End Sub

Private Sub btnOK_Click()
    '确定复制源数据源中的部分或全部数据集到目标数据源中
    Dim objDestDS As soDataSource
    Dim objSourceDS As soDataSource
    Dim objDataSet As soDataset
    
    Dim strDsDest As String, strDsSource As String
    Dim strDtName As String
    
    Dim i As Integer, j As Integer
    
    strDsSource = cmbSourceDS.Text
    strDsDest = cmbDestDS.Text
    If strDsSource = strDsDest Then chkRenameCopy.Value = 1     '同数据源复制必须改名
    
    '获得源数据源
    Set objSourceDS = frmMain.SuperWorkspace1.Datasources.Item(strDsSource)
    If objSourceDS Is Nothing Then
        MsgBox "数据源" & cmbSourceDS.Text & "内部错误，无法继续！", vbInformation
        Exit Sub
    End If
    
    '获得目标数据源
    Set objDestDS = frmMain.SuperWorkspace1.Datasources.Item(strDsDest)
    If objDestDS Is Nothing Then
        MsgBox "数据源" & cmbDestDS.Text & "内部错误，无法继续！", vbInformation
        Exit Sub
    End If
    
    '循环处理每个数据集
    For i = 0 To lstDestDt.ListCount - 1
        lstDestDt.ListIndex = i
        strDtName = Trim$(lstDestDt.Text)
        If (objDestDS.IsAvailableDatasetName(strDtName)) = False Then                          '数据集名合法判断
            chkRenameCopy.Value = 1
        End If
        If chkRenameCopy.Value = 1 Then                             '改名复制,进行改名同名判断
            Do
                strDtName = Trim$(InputBox("目标数据源中有重名数据集名或数据集名" & vbCrLf & "非法,请输入新的数据集名:" & vbCrLf, , strDtName))
                If strDtName = "" Then
                    If MsgBox("数据集名为空!是否取消复制?", vbQuestion + vbYesNo) = vbYes Then
                        Unload Me
                        Exit Sub
                    End If
                Else
                    If (objDestDS.IsAvailableDatasetName(strDtName)) Then                            '数据集名合法判断
                          Exit Do
                    End If
                End If
            Loop
        End If
        Set objDataSet = objDestDS.CopyDataset(objSourceDS.Datasets.Item(lstDestDt.Text), strDtName)
        If Not (objDataSet Is Nothing) Then
            frmMain.tvwSpace.Nodes.Add objDestDS.Alias, tvwChild, , objDataSet.Name
        Else
            MsgBox "复制失败！", vbInformation
        End If
    Next
    
    Unload Me
End Sub

Private Sub cmbDestDS_Click()
    '选择追加的目标数据源
    If cmbDestDS.Text = cmbSourceDS.Text Then
        chkRenameCopy.Value = vbChecked
    Else
        chkRenameCopy.Value = vbUnchecked
    End If
End Sub

Private Sub cmbSourceDS_Click()
    '选择用来复制的源数据源，并装载相应的数据集
    Dim objDs As soDataSource
    Dim objDatasets As soDatasets
    Dim objSourceDt As soDataset
    
    Set objDs = frmMain.SuperWorkspace1.Datasources.Item(cmbSourceDS.Text)
    If objDs Is Nothing Then
        MsgBox "数据源" & cmbSourceDS.Text & "错误！", vbInformation
        Exit Sub
    End If
    Set objDatasets = objDs.Datasets
    
    lstSourceDt.Clear
    For Each objSourceDt In objDatasets
        lstSourceDt.AddItem objSourceDt.Name
    Next
    If lstSourceDt.ListCount > 0 Then
        lstSourceDt.ListIndex = 0
    End If
End Sub

Private Sub Form_Load()
    Dim objDs As soDataSource
    
    '添加源数据源，目标数据源列表
    With frmMain.SuperWorkspace1
        For Each objDs In .Datasources
            cmbSourceDS.AddItem objDs.Alias
            cmbDestDS.AddItem objDs.Alias
        Next
    End With
    
    If frmMain.tvwSpace.SelectedItem.Text = "工作空间" Then
        cmbSourceDS.ListIndex = 0
    ElseIf frmMain.tvwSpace.SelectedItem.Parent.Text = "工作空间" Then
        cmbSourceDS.Text = frmMain.tvwSpace.SelectedItem.Text
    Else
        cmbSourceDS.Text = frmMain.tvwSpace.SelectedItem.Parent.Text
    End If
    
    cmbDestDS.ListIndex = 0
End Sub

Private Sub lstDestDt_DblClick()
      btnDel_Click
End Sub

Private Sub lstSourceDt_DblClick()
      btnAdd_Click
End Sub