<VB数理统计实用算法>书中的算法源程序
源代码在线查看: 数据库_通用f2.frm
VERSION 5.00
Begin VB.Form frmField
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "字段"
ClientHeight = 3900
ClientLeft = 60
ClientTop = 345
ClientWidth = 6435
LinkTopic = "Form1"
ScaleHeight = 3900
ScaleWidth = 6435
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdCancel
Caption = "取 消"
Height = 375
Left = 4800
TabIndex = 11
Top = 3360
Width = 1455
End
Begin VB.ListBox lstFDName
Appearance = 0 'Flat
Height = 2364
Left = 120
TabIndex = 10
Top = 360
Width = 2295
End
Begin VB.CommandButton cmdDelField
Caption = "删除字段"
Height = 375
Left = 240
TabIndex = 8
Top = 3360
Width = 1455
End
Begin VB.CommandButton cmdAddEnd
Caption = "完 成"
Height = 375
Left = 3240
TabIndex = 7
Top = 3360
Width = 1455
End
Begin VB.CommandButton cmdAddField
Caption = "添加字段"
Height = 375
Left = 1800
TabIndex = 6
Top = 3360
Width = 1335
End
Begin VB.TextBox txtFieldSize
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 264
Left = 4080
TabIndex = 5
Text = "Text2"
Top = 3000
Width = 2175
End
Begin VB.ListBox lstFieldType
Appearance = 0 'Flat
Height = 2010
Left = 4080
TabIndex = 3
Top = 840
Width = 2175
End
Begin VB.TextBox txtFieldName
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 264
Left = 4080
TabIndex = 1
Text = "Text1"
Top = 480
Width = 2175
End
Begin VB.Label lblAdd
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "完成下面所提示的工作再单击“添加字段”"
ForeColor = &H80000008&
Height = 252
Left = 2880
TabIndex = 13
Top = 120
Width = 3612
End
Begin VB.Label lblDel
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "单击“删除字段”,可将选中字段删除"
ForeColor = &H80000008&
Height = 492
Left = 120
TabIndex = 12
Top = 2880
Width = 2412
End
Begin VB.Label lblFDName
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择数据表所包括的字段:"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 9
Top = 120
Width = 2295
End
Begin VB.Label lblFieldSize
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "给出字段大小"
ForeColor = &H80000008&
Height = 375
Left = 2760
TabIndex = 4
Top = 3000
Width = 1215
End
Begin VB.Label lblFieldType
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择字段类型"
ForeColor = &H80000008&
Height = 495
Left = 2640
TabIndex = 2
Top = 840
Width = 1335
End
Begin VB.Label lblFieldName
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "键入字段名"
ForeColor = &H80000008&
Height = 375
Left = 2880
TabIndex = 0
Top = 480
Width = 1095
End
End
Attribute VB_Name = "frmField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体frmField
'字段处理
Option Explicit
Dim strFDName As String '保存字段名字
Dim strFDType As String '保存字段类型
Dim strTextSize As String '保存文本字段大小
Dim msgResult As VbMsgBoxResult '保存信息框选择结果
Dim intIndex As Integer '保存选中类型的索引号
Private Sub Form_Load()
'初始化
strFDName = ""
strFDType = ""
strTextSize = ""
txtFieldName.Text = ""
txtFieldSize.Text = ""
lblFieldSize.Visible = False
txtFieldSize.Visible = False
'往列表框添加字段类型
With lstFieldType
.AddItem "dbText"
.AddItem "dbInteger"
.AddItem "dbLong"
.AddItem "dbSingle"
.AddItem "dbDouble"
.AddItem "dbDate"
.AddItem "dbBinary"
.AddItem "dbBoolean"
.AddItem "dbByte"
.AddItem "dbCurrency"
.AddItem "dbFloat"
.AddItem "dbMemo"
.AddItem "dbNumeric"
End With
lblFDName = td.Name & "所包括的字段:"
'在列表框显示字段
For Each fd In td.Fields
lstFDName.AddItem fd.Name
Next
End Sub
'删除字段
Private Sub cmdDelField_Click()
td.Fields.Delete (lstFDName)
lblFDName = td.Name & "所包括的字段:"
'在列表框显示字段
lstFDName.Clear '清除列表框
For Each fd In td.Fields
lstFDName.AddItem fd.Name
Next
End Sub
'单击字段类型列表框事件
Private Sub lstFieldType_Click()
'如果字段类型是文本,需要字段大小
'为键入文本字段大小创造条件
If lstFieldType.Text = "dbText" Then
lblFieldSize.Visible = True '使指示标签可视
txtFieldSize.Visible = True '使存贮文本大小的文本框可视
End If
intIndex = lstFieldType.ListIndex '取得选中类型的索引号
End Sub
'添加字段
Private Sub cmdAddField_Click()
strFDName = txtFieldName.Text
strTextSize = txtFieldSize.Text
If strFDName = "" Then
MsgBox "没有给出字段名,重作", 0, "添加字段"
Exit Sub
End If
strFDType = lstFieldType.Text '从列表框取得字段类型
If strFDType = "" Then
MsgBox "没有选择类型,重作", 0, "添加字段"
Exit Sub
End If
If strFDType = "dbText" And strTextSize = "" Then
MsgBox "没有给出文本大小,重作", 0, "添加字段"
Exit Sub
End If
'按类型来建立字段
Select Case strFDType
Case "dbText"
Set fd = td.CreateField(strFDName, dbText, Val(strTextSize))
Case "dbInteger"
Set fd = td.CreateField(strFDName, dbInteger)
Case "dbLong"
Set fd = td.CreateField(strFDName, dbLong)
Case "dbSingle"
Set fd = td.CreateField(strFDName, dbSingle)
Case "dbDouble"
Set fd = td.CreateField(strFDName, dbDouble)
Case "dbDate"
Set fd = td.CreateField(strFDName, dbDate)
Case "dbBinary"
Set fd = td.CreateField(strFDName, dbBinary)
Case "dbBoolean"
Set fd = td.CreateField(strFDName, dbBoolean)
Case "dbByte"
Set fd = td.CreateField(strFDName, dbByte)
Case "dbCurrency"
Set fd = td.CreateField(strFDName, dbCurrency)
Case "dbFloat"
Set fd = td.CreateField(strFDName, dbFloat)
Case "dbMemo"
Set fd = td.CreateField(strFDName, dbMemo)
Case "dbNumeric"
Set fd = td.CreateField(strFDName, dbNumeric)
Case Else
Set fd = td.CreateField(strFDName, dbText, 20)
End Select
'添加字段到数据表
td.Fields.Append fd
lstFDName.Clear '清除列表框
lblFDName = td.Name & "所包括的字段:"
For Each fd In td.Fields
lstFDName.AddItem fd.Name
Next
'准备接受下一个字段
txtFieldName.Text = ""
strFDName = ""
strFDType = ""
strTextSize = ""
lstFieldType.Selected(intIndex) = False '清除选中类型的选中状态
lblFieldSize.Visible = False
txtFieldSize.Visible = False
End Sub
'完成
Private Sub cmdAddEnd_Click()
On Error Resume Next
db.TableDefs.Append td '添加数据表到数据库
Unload Me '卸载字段窗体
Load frmDatabase '加载数据库窗体
frmDatabase.lblPoint.Visible = True
frmDatabase.lblPoint.Caption = _
"提示:完成字段操作,可以转入“索引”或“记录集”操作"
frmDatabase.Line1.Visible = True
frmDatabase.Visible = True '使数据库窗体可视
End Sub
'取消
Private Sub cmdCancel_Click()
Unload Me '卸载字段窗体
Load frmDatabase '加载数据库窗体
frmDatabase.Visible = True '使数据库窗体可视
frmDatabase.lblPoint.Visible = True
frmDatabase.lblPoint.Caption = _
"提示:取消字段操作,可以考虑重新开始"
End Sub