<VB数理统计实用算法>书中的算法源程序
源代码在线查看： 数据库_通用f7.frm
VERSION 5.00
Begin VB.Form frmEdit
Appearance = 0 'Flat
BackColor = &H80000005&
ClientHeight = 3465
ClientLeft = 60
ClientTop = 345
ClientWidth = 5550
LinkTopic = "Form1"
ScaleHeight = 3465
ScaleWidth = 5550
StartUpPosition = 3 '窗口缺省
Begin VB.Data dataEdit
Caption = " 单击导航钮可改变当前记录，并使记录更新"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 0
Width = 5415
End
Begin VB.TextBox txtValue
Alignment = 2 'Center
Appearance = 0 'Flat
DataSource = "dataEdit"
Height = 270
Index = 0
Left = 2280
TabIndex = 10
Text = "Text1"
Top = 1560
Width = 1335
End
Begin VB.CommandButton cmdExit
Caption = "退 出"
Height = 375
Left = 120
TabIndex = 8
Top = 1440
Width = 855
End
Begin VB.CommandButton cmdEdit
Caption = "尾 记 录"
Height = 375
Index = 7
Left = 4080
TabIndex = 7
Top = 720
Width = 1335
End
Begin VB.CommandButton cmdEdit
Caption = "头 记 录"
Height = 375
Index = 6
Left = 2760
TabIndex = 6
Top = 720
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "上 一 条"
Height = 375
Index = 5
Left = 1440
TabIndex = 5
Top = 720
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "下 一 条"
Height = 375
Index = 4
Left = 120
TabIndex = 4
Top = 720
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "更 新 记 录"
Height = 375
Index = 3
Left = 4080
TabIndex = 3
Top = 360
Width = 1335
End
Begin VB.CommandButton cmdEdit
Caption = "文本框复原"
Height = 375
Index = 2
Left = 2760
TabIndex = 2
Top = 360
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "删 除 记 录"
Height = 375
Index = 1
Left = 1440
TabIndex = 1
Top = 360
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "添 加 记 录"
Height = 375
Index = 0
Left = 120
TabIndex = 0
Top = 360
Width = 1215
End
Begin VB.Label lblPoint
Alignment = 2 'Center
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "先单击“添加记录”然后再填写数据"
ForeColor = &H80000008&
Height = 210
Left = 1245
TabIndex = 11
Top = 1200
Width = 2925
End
Begin VB.Label lblField
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Label1"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 1080
TabIndex = 9
Top = 1560
Width = 1095
End
End
Attribute VB_Name = "frmEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体frmEdit
'可以添加记录、删除记录，也可以进行编辑
'使用绑定的文本框数组作为录入和编辑空间
'绑定的文本框的DataSource属性需要在属性窗口设置为数据控件dataEdit
Option Explicit
Dim intFDNumber As Integer, intI As Integer
Dim sngHig As Single, vntMsg
Private Sub Form_Load()
On Error Resume Next
Me.Caption = "编辑" & "" & "的记录（动态记录集）"
intFDNumber = td.Fields.Count '获得字段个数
sngHig = txtValue(0).Height '获得录入文本框的高度
dataEdit.DatabaseName = strDBName '使数据控件与数据库连接
dataEdit.RecordSource = strTDName '使数据控件与记录集连接
dataEdit.RecordsetType = 1 '记录集的类型为动态集
lblField(0).Caption = "字段名": txtValue(0).Text = "字段值"
'建立标签数组用以显示字段名
'建立文本框数组用以存放数据
For intI = 1 To intFDNumber
Load lblField(intI): Load txtValue(intI) '加载数组元素
'将数组元素移到适当的位置
lblField(intI).Move lblField(0).Left, lblField(0).Top + intI * sngHig
txtValue(intI).Move txtValue(0).Left, txtValue(0).Top + intI * sngHig
'以字段名作为标签的Caption属性
lblField(intI).Caption = td.Fields(intI - 1).Name
txtValue(intI).Text = ""
lblField(intI).Visible = True '使标签元素可视
txtValue(intI).Visible = True '使文本框元素可视
Next intI
'自动调节窗体高度，使与字段个数匹配
Me.Height = txtValue(0).Top + (intFDNumber + 4) * sngHig
'建立动态记录集
Set rs = td.OpenRecordset(dbOpenDynaset)
'设定绑定文本框的DataField属性
For intI = 1 To intFDNumber
txtValue(intI).DataField = rs(intI - 1).SourceField
Next intI
'判断记录集是否为空
If rs.EOF And rs.EOF Then MsgBox "记录集无记录，必须添加记录！"
End Sub
'cmdEdit是8个元素的命令按钮数组
Private Sub cmdEdit_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0 '添加记录
dataEdit.Recordset.AddNew
txtValue(1).SetFocus '文本框取得焦点
Case 1 '删除记录
vntMsg = MsgBox("确实要删除吗？", vbYesNo)
If vntMsg = vbYes Then
dataEdit.Recordset.Delete '删除记录
dataEdit.Recordset.MoveNext '当前记录下移
If dataEdit.Recordset.EOF Then _
dataEdit.Recordset.MoveLast '若过了记录尾则移到记录尾
End If
dataEdit.UpdateRecord
Case 2 '复原文本框。文本框的数据作了改动，
dataEdit.UpdateControls '但记录未更新，可以在文本框恢复
Case 3 '更新记录
dataEdit.UpdateRecord '更新的意思是存盘
'以下4种动作都自动实现记录更新，即存盘
Case 4 '下一条记录
dataEdit.Recordset.MoveNext
If dataEdit.Recordset.EOF Then dataEdit.Recordset.MoveLast
Case 5 '上一条记录
dataEdit.Recordset.MovePrevious
If dataEdit.Recordset.BOF Then dataEdit.Recordset.MoveFirst
Case 6 '头记录
dataEdit.Recordset.MoveFirst
Case 7 '尾记录
dataEdit.Recordset.MoveLast
End Select
End Sub
'如果对记录集进行了修改或添加或删除
'在保存数据库之前都需要由用户通过Validate事件最后确认
'只要当前记录位置有变化都会引发Validate事件
'参数Action为动作的类型
'参数Save指出当前记录是否更新
'以下一段程序供读者参考。凡带#字的均系有效语句,而非原来的注释
'**********************************************
'#Private Sub dataEdit_Validate(Action As Integer, Save As Integer)
'# Select Case Action
'# Case 1, 2, 3, 4, 11
'1：MoveFirst
'2：MovePrevious
'3：MoveNext
'4：MoveLast
'5：AddNew
'11：关闭程序
'# vntMsg = MsgBox("数据要更新吗？", vbYesNo)
'# If vntMsg = vbNo Then
'# Save = 0 '数据不进行更新
'# Else
'# Save = 1
'# Exit Sub
'# End If
'# End Select
'#End Sub
'***********************************************
'退出
Private Sub cmdExit_Click()
Unload Me '卸载编辑窗体
Load frmDatabase '加载数据库窗体
frmDatabase.Visible = True '使数据库窗体可视
End Sub
