-

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

End Sub

'字段处理
Private Sub mnuField_Click()
'检查数据库或数据表是否打开
    If CheckOpen = False Then Exit Sub      '没有打开的数据库或数据表
    mnuIndex.Enabled = True
    mnuRecordset.Enabled = True
    mnuQuery.Enabled = True
    Unload frmDatabase                      '卸载数据库窗体
    Load frmField                           '加载字段窗体
    frmField.Visible = True                 '使字段窗体可视
End Sub

'索引处理
Private Sub mnuIndex_Click()
'检查数据库或数据表是否打开
    If CheckOpen = False Then Exit Sub      '没有打开的数据库或数据表
    Unload frmDatabase                      '卸载数据库窗体
    Load frmIndex                           '加载索引窗体
    frmIndex.Visible = True                 '使索引窗体可视
End Sub

'关联处理
Private Sub mnuRelation_Click()
'检查数据库是否打开
    If strDBName = "" Then
        MsgBox "没有打开数据库,重作!", 0, "强制关联"
        Exit Sub
    End If
    If db.TableDefs.Count <= 5 Then
        MsgBox "必须有两个以上的数据表才能进行关联！"
        Exit Sub
    End If
    Unload frmDatabase                      '卸载数据库窗体
    Load frmRelation                        '加载关联窗体
    frmRelation.Visible = True              '使关联窗体可视
End Sub

'在记录集内录入或删除记录
Private Sub mnuAddDel_Click()
'检查数据库或数据表是否打开
    If CheckOpen = False Then Exit Sub      '没有打开的数据库或数据表
    Unload frmDatabase                      '卸载数据库窗体
    Load frmAddDel                          '加载录入或删除窗体
    frmAddDel.Visible = True                '使录入或删除窗体可视
End Sub

'记录集的编辑
Private Sub mnuEdit_Click()
'检查数据库或数据表是否打开
    If CheckOpen = False Then Exit Sub      '没有打开的数据库或数据表
    Unload frmDatabase                      '卸载数据库窗体
    Load frmEdit                            '加载编辑窗体
    frmEdit.Visible = True                  '使编辑窗体可视
End Sub

'记录集的显示
Private Sub mnuDisplay_Click()
'检查数据库或数据表是否打开
    If CheckOpen = False Then Exit Sub      '没有打开的数据库或数据表
    Unload frmDatabase                      '卸载数据库窗体
    Load frmDisplay                         '加载显示窗体
    frmDisplay.Visible = True               '使显示窗体可视
End Sub

'查询
Private Sub mnuQuery_Click()
'检查数据库是否打开
    If strDBName = "" Then
        MsgBox "没有打开的数据库，重作！", 0
        Exit Sub
    End If
    Unload frmDatabase                      '卸载数据库窗体
    Load frmSQL                             '加载查询窗体
    frmSQL.Visible = True                   '使查询窗体可视
End Sub

'从数据库变换到数据文件
Private Sub mnuBaseToFile_Click()
    Unload Me
    frmDataFile.Show
End Sub

'从数据文件变换到数据库
Private Sub mnuFileToBase_Click()
    Unload Me
    frmFileData.Show
End Sub

'结束
Private Sub mnuEnd_Click()
    Unload Me
    End
End Sub

'----------------以下为“近期访问文件菜单”部分------------------
'从INI文件读取信息
Private Sub ReadFromINI(ByVal frmA As Form)
'将strINI设置为255个字符，保存键字符串
    strINI = String(255, 0)
    With frmA
        For intI = 1 To MaxFileNumber
            strKey = "RecentFile" & intI                '设置键名
'从段“RecentFiles”读取strKey所代表的键字符串，保存在strINI中，
'返回值intRecent表示读取的实际字符个数
            intRecent = GetPrivateProfileString("RecentFiles", _
                    strKey, "********", strINI, Len(strINI), _
                    App.Path & "\RecentFile.ini")
            If intRecent And Left(strINI, 8) <> "********" Then
'如果读取的实际字符数不为0，并且strINI前8个字符不为********
'则显示文件菜单的分割线
                .mnuSep2.Visible = True
                If .mnuFileArray.UBound < intI Then
'菜单数组无法容纳从INI文件中读取的文件名字符串，
'使用Load加载菜单项，可以加载任意个菜单项
                    Load .mnuFileArray(intI)
                End If
'将返回的字符串加上表示为快捷键的序号，
'赋予菜单数组的Caption属性
                    .mnuFileArray(intI).Caption = "&" & intI & "." & strINI
                    .mnuFileArray(intI).Visible = True   '使菜单项可视
            End If
        Next intI
    End With
End Sub

'向INI文件写入信息
Private Sub WriteToINI()
    strINIFileName = App.Path & "\RecentFile.ini"       'INI文件名
'由菜单数组中获得文件名
'由mnuFileArray.Count可以获得菜单数组中菜单项的个数
    For intI = 1 To mnuFileArray.Count - 1
        strINI = GetFileFromArray(intI, Me)             '从菜单数组中获得文件名
        strKey = "RecentFile" & intI
'"RecentFiles"是段名
'strKey是键名
'strINI是要写入INI文件的字符串
'strINIFileName是INI文件名
        WritePrivateProfileString "RecentFiles", _
            strKey, strINI, strINIFileName
    Next intI
End Sub

'从菜单数组中获得文件名，保存在GetFileFromArray
Private Function GetFileFromArray(Index As Integer, _
                ByVal frmA As Form) As String
'index是菜单数组中的索引号
'frmA是窗体
    Set mnuA = frmA.mnuFileArray(Index)                 '创建菜单对象
'从菜单数组中获取文件名
'将菜单标题的左边3个字符去掉，剩下的是文件全名
    strFileName = Right(mnuA.Caption, Len(mnuA.Caption) - 3)
    GetFileFromArray = strFileName                      '返回函数值
End Function

'将文件加到菜单数组中
Private Sub AddFileToArray(ByVal strFileName As String, _
                            ByVal frmA As Form)
'strFileName是从公共对话框中返回的文件名
'frmA是窗体类型的对象变量
'strFileArray是动态数组，使用Preserve可以保持原有数据不变
    ReDim Preserve strFileArray(0) As String
'将传递过来的文件名保存在文件数组中
    strFileArray(0) = strFileName
    With frmA
        .mnuSep2.Visible = True
        intMenuNum = .mnuFileArray.UBound                '菜单数组中菜单个数
        Dim iLoop As Integer
        iLoop = 1
'遍历菜单数组
        For intI = 1 To intMenuNum
'获得菜单数组中索引号为intI的文件名
            strINI = GetFileFromArray(intI, Me)
            If strINI <> strFileName Then
'如果传递过来的文件名不在文件数组中，
'则重新定义文件数组，并保留以前的文件数组
                ReDim Preserve strFileArray(iLoop) As String
'将菜单数组中的文件名保存在文件数组中
                strFileArray(iLoop) = strINI
                iLoop = iLoop + 1
            End If
        Next intI
        If intMenuNum < UBound(strFileArray) + 1 And _
                intMenuNum < MaxFileNumber Then
'如果菜单数组小于要显示的文件数，并且小于设置的菜单数组的最大数，
'则使用Load语句创建一个菜单对象
            Load mnuFileArray(intMenuNum + 1)
        End If
        intMenuNum = .mnuFileArray.UBound                '菜单数组中菜单个数
'遍历菜单数组
        For intI = 1 To intMenuNum
'将文件数组名显示在菜单中
            .mnuFileArray(intI).Caption = "&" & intI & "." _
                & strFileArray(intI - 1)
            .mnuFileArray(intI).Visible = True           '使菜单项可视
        Next intI
    End With
End Sub

'卸载窗体时将菜单数组中的内容写入INI文件
Private Sub Form_Unload(Cancel As Integer)
    WriteToINI
End Sub

'单击菜单中的文件可以打开数据库
Private Sub mnuFileArray_Click(Index As Integer)
    Dim strX As String
    Dim vntX
    Dim strOpenFileName As String
'从菜单数组中获得文件名
    strDBName = GetFileFromArray(Index, Me)
'判断文件在目录中是否存在
    strX = Dir(strDBName, vbNormal + vbHidden + vbReadOnly)
    If strX = "" Then
        MsgBox strDBName & "文件不存在！"
        Exit Sub
    End If
    Set db = DBEngine(0).OpenDatabase(strDBName)
    lblPoint.Visible = True
    lblPoint.Caption = _
        "提示：进入“记录集”、“字段”、“索引”等操作前，" & Chr(10) & Chr(13) & _
        "       需单击列表框中的数据表,再用“数据表”菜单打开该数据表"
    On Error GoTo OpenError
    lblTDName.Visible = True                            '使数据表名指示标签可视
    lstTDName.Visible = True                            '使数据表名列表框可视
    lstTDName.Clear
    If db.TableDefs.Count <= 4 Then
        MsgBox "该数据库无数据表，没有建成，需要重新创建！"
        Exit Sub
    End If
'在列表框显示数据表
    For Each td In db.TableDefs
        If (td.Attributes And dbSystemObject) = 0 Then  '甩掉系统表
            If (td.Attributes <> dbAttachedTable) Then  '甩掉附属表
                lstTDName.AddItem td.Name               '用户表进入列表框
            End If
        End If
    Next
    mnuIndex.Enabled = False        '“索引”菜单项无效
    mnuRecordset.Enabled = False    '“记录集”菜单项无效
    mnuField.Enabled = False        '“字段”菜单项无效
    mnuRelation.Enabled = True      '“强制关联”菜单项有效
    mnuQuery.Enabled = True         '“查询”菜单项有效
    mnuTable.Enabled = True         '“数据表”菜单可用
    mnuCreateTable.Enabled = True   '“新建”数据表菜单可用
    mnuOpenTable.Enabled = True     '“打开”数据表菜单可用
    mnuDeleteTable.Enabled = True   '“删除”数据表菜单可用
    strOpenFileName = strDBName
    AddFileToArray strOpenFileName, Me
    Exit Sub
OpenError:
    MsgBox "打开数据库错误", , "打开数据库"
End Sub

'弹出式菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'按鼠标右键则出现弹出式菜单
    If Button = 2 Then Me.PopupMenu puDataFile
End Sub

'从数据文件变换到数据库
Private Sub puFileToTable_Click()
    Unload Me
    frmFileData.Show
End Sub

'从数据库变换到数据文件
Private Sub puTableToFile_Click()
    Unload Me
    frmDataFile.Show
End Sub