-

所有数理统计知识的源代码都在此,是一本数理统计数的配套光盘.里面有各种分布类型及参数估计插值

VERSION 5.00
Begin VB.Form frmRelation 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "关联"
   ClientHeight    =   3600
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6390
   LinkTopic       =   "Form1"
   ScaleHeight     =   3600
   ScaleWidth      =   6390
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdExit 
      Caption         =   "退    出"
      Height          =   372
      Left            =   5040
      TabIndex        =   13
      Top             =   3120
      Width           =   1212
   End
   Begin VB.TextBox txtMainKey 
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   3360
      TabIndex        =   12
      Top             =   480
      Width           =   1332
   End
   Begin VB.TextBox txtForeignKey 
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   4800
      TabIndex        =   11
      Top             =   2760
      Width           =   1332
   End
   Begin VB.ListBox lstForeignKey 
      Appearance      =   0  'Flat
      Height          =   2184
      Left            =   4800
      TabIndex        =   10
      Top             =   480
      Width           =   1332
   End
   Begin VB.TextBox txtForeignTD 
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   1800
      TabIndex        =   7
      Top             =   2760
      Width           =   1452
   End
   Begin VB.ListBox lstForeignTD 
      Appearance      =   0  'Flat
      Height          =   2184
      Left            =   1800
      TabIndex        =   6
      Top             =   480
      Width           =   1452
   End
   Begin VB.TextBox txtMainTD 
      Appearance      =   0  'Flat
      Height          =   264
      Left            =   240
      TabIndex        =   4
      Top             =   2760
      Width           =   1452
   End
   Begin VB.ListBox lstMainTD 
      Appearance      =   0  'Flat
      Height          =   2184
      Left            =   240
      TabIndex        =   2
      Top             =   480
      Width           =   1452
   End
   Begin VB.CommandButton cmdRelax 
      Caption         =   "解除关联"
      Height          =   372
      Left            =   3840
      TabIndex        =   1
      Top             =   3120
      Width           =   1092
   End
   Begin VB.CommandButton cmdRelation 
      Caption         =   "强制关联"
      Height          =   372
      Left            =   2520
      TabIndex        =   0
      Top             =   3120
      Width           =   1212
   End
   Begin VB.Label lblForeignKey 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择外部键："
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   4800
      TabIndex        =   9
      Top             =   120
      Width           =   1092
   End
   Begin VB.Label lblMainKey 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "主键："
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   3360
      TabIndex        =   8
      Top             =   120
      Width           =   1332
   End
   Begin VB.Label lblRoreignTable 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择外部表："
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   1800
      TabIndex        =   5
      Top             =   120
      Width           =   1452
   End
   Begin VB.Label lblMainTD 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择主表："
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   1452
   End
End
Attribute VB_Name = "frmRelation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体frmRelation
'强制关联或解除关联
Option Explicit

Private Sub Form_Load()
'在列表框中列入数据表
    For Each td In db.TableDefs
        If (td.Attributes And dbSystemObject) = 0 Then  '剔除系统表
            If (td.Attributes <> dbAttachedTable) Then  '剔除附属表
'用户数据表
                lstMainTD.AddItem td.Name               '列入主表列表框
                lstForeignTD.AddItem td.Name            '列入外部表列表框
            End If
        End If
    Next
End Sub


Private Sub lstForeignTD_Click()
    txtForeignTD = lstForeignTD.Text
    If txtForeignTD.Text = txtMainTD.Text Then
        MsgBox "主表与外部表不能为同一表！重新选择"
        txtMainTD.Text = ""
        txtForeignTD.Text = ""
        Exit Sub
    End If
    Set tdMain = db.TableDefs(txtMainTD.Text)           '打开主表
    Set tdForeign = db.TableDefs(txtForeignTD.Text)       '打开外部表
'在主表的索引集合中找到主键后放入主键文本框
    For Each id In tdMain.Indexes
        If id.Required = True And id.Primary = True Then
            txtMainKey.Text = id.Name
        End If
    Next
'在外部表的索引集合中找到外部键后加到外部键列表框
    lstForeignKey.Clear
    For Each id In tdForeign.Indexes
        If id.Required <> True And id.Primary <> True Then
            lstForeignKey.AddItem id.Name
        End If
    Next
End Sub

'单击主表列表框事件
Private Sub lstMainTD_Click()
'将选择的主表放入主表文本框
    txtMainTD = lstMainTD.Text
End Sub

'单击外部键列表框事件
Private Sub lstForeignKey_Click()
'将选择的外部键放入外部键文本框
    txtForeignKey.Text = lstForeignKey.Text
End Sub

'建立强制关联
Private Sub cmdRelation_Click()
    Set rl = db.CreateRelation("强制关联")
    With rl
        .Table = txtMainTD                  '主表
        .ForeignTable = txtForeignTD        '外部表
        Set fd = .CreateField("")
        fd.Name = txtMainKey.Text           '主键
        fd.ForeignName = txtForeignKey.Text '外部键
        .Fields.Append fd
'建立更新级联和删除级联
'        .Attributes = dbRelationUpdateCascade + dbRelationDeleteCascade
    End With
'将关联对象加到关联对象集合
    db.Relations.Append rl
    MsgBox "强制关联完成！", , "强制关联"
    Exit Sub
End Sub

'解除强制关联
Private Sub cmdRelax_Click()
    db.Relations.Delete "强制关联"
    MsgBox "强制关联解除！", , "强制关联"
    Exit Sub
End Sub

'退出
Private Sub cmdExit_Click()
    Unload Me
    Load frmDatabase
    frmDatabase.Visible = True
End Sub