📄 -
字号:
VERSION 5.00
Begin VB.Form frmAddDel
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Form1"
ClientHeight = 4140
ClientLeft = 60
ClientTop = 345
ClientWidth = 5940
LinkTopic = "Form1"
ScaleHeight = 4140
ScaleWidth = 5940
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdUpdate
Caption = "更 新 记 录"
Height = 375
Left = 4440
TabIndex = 10
Top = 120
Width = 1335
End
Begin VB.CommandButton cmdPrepare
Caption = "准 备 添 加"
Height = 375
Left = 120
TabIndex = 0
Top = 120
Width = 1335
End
Begin VB.TextBox txtValue
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 375
Index = 0
Left = 2040
TabIndex = 9
Text = "Text1"
Top = 1320
Width = 1695
End
Begin VB.CommandButton cmdLast
Caption = "尾 记 录"
Height = 375
Left = 4440
TabIndex = 7
Top = 600
Width = 1335
End
Begin VB.CommandButton cmdFirst
Caption = "头 记 录"
Height = 375
Left = 3000
TabIndex = 6
Top = 600
Width = 1335
End
Begin VB.CommandButton cmdPrevious
Caption = "上 一 条"
Height = 375
Left = 1560
TabIndex = 5
Top = 600
Width = 1335
End
Begin VB.CommandButton cmdNext
Caption = "下 一 条"
Height = 375
Left = 120
TabIndex = 4
Top = 600
Width = 1335
End
Begin VB.CommandButton cmdExit
Caption = "退 出"
Height = 375
Left = 120
Style = 1 'Graphical
TabIndex = 3
Top = 1320
Width = 735
End
Begin VB.CommandButton cmdDel
Caption = "删 除 记 录"
Height = 375
Left = 3000
TabIndex = 2
Top = 120
Width = 1335
End
Begin VB.CommandButton cmdAdd
Caption = "添 加 记 录"
Height = 375
Left = 1560
TabIndex = 1
Top = 120
Width = 1335
End
Begin VB.Label lblNumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0"
ForeColor = &H80000008&
Height = 255
Left = 4920
TabIndex = 13
Top = 1440
Width = 735
End
Begin VB.Label lblCount
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "记录数："
ForeColor = &H80000008&
Height = 255
Left = 4200
TabIndex = 12
Top = 1440
Width = 735
End
Begin VB.Label lblNotice
Alignment = 2 'Center
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 210
Left = 2775
TabIndex = 11
Top = 1080
Width = 120
End
Begin VB.Label lblField
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Label1"
ForeColor = &H80000008&
Height = 375
Index = 0
Left = 240
TabIndex = 8
Top = 1320
Width = 1695
End
End
Attribute VB_Name = "frmAddDel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体frmAddDel
'可以添加记录、删除记录，也可以编辑
'使用非绑定的文本框数组作为录入空间
Option Explicit
Dim intFDNumber As Integer, intI As Integer
Dim sngHig As Single, vntMsg, vntBookmark
Private Sub Form_Load()
On Error Resume Next
Me.Caption = "录入、删除" & "<" & strTDName & ">" & "的记录（动态记录集）"
intFDNumber = td.Fields.Count '获得字段个数
sngHig = txtValue(0).Height '获得录入文本框的高度
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 + 3) * sngHig
'建立动态记录集
Set rs = td.OpenRecordset(dbOpenDynaset)
If rs.RecordCount > 0 Then
For intI = 1 To intFDNumber
txtValue(intI) = rs(intI - 1) '向文本框数组赋头记录各字段值
Next intI
Else
For intI = 1 To intFDNumber
txtValue(intI) = 0 '向文本框数组赋头记录各字段值
Next intI
End If
lblNotice.Visible = True
lblNotice.Caption = "录入前需单击“准备添加”按钮"
rs.MoveLast '统计总数需要将指针移到记录尾
lblNumber.Caption = rs.RecordCount '记录数
End Sub
'准备添加记录
Private Sub cmdPrepare_Click()
rs.AddNew '添加记录
'清空文本框，接受录入数据
For intI = 1 To intFDNumber
txtValue(intI) = ""
Next intI
txtValue(1).SetFocus '使文本框取得焦点
lblNotice.Visible = True
lblNotice.Caption = "录完后请单击“添加记录”按钮"
End Sub
'添加记录
Private Sub cmdAdd_Click()
'将文本框中的录入值送入记录集
On Error Resume Next
For intI = 0 To intFDNumber - 1
rs(intI) = txtValue(intI + 1).Text
Next intI
rs.Update '更新记录集
lblNotice.Visible = True
lblNotice.Caption = "继续录入需单击“准备添加”按钮"
lblNumber.Caption = rs.RecordCount
End Sub
'删除记录
Private Sub cmdDel_Click()
On Error Resume Next
vntMsg = MsgBox("确实要删除记录吗？", vbYesNo)
If vntMsg = vbYes Then
rs.Delete '删除记录
If rs.EOF Then rs.MoveLast
End If
'清空文本框
For intI = 1 To intFDNumber
txtValue(intI) = ""
Next intI
lblNumber.Caption = rs.RecordCount
End Sub
'更新记录
Private Sub cmdUpdate_Click()
On Error Resume Next
rs.Edit
For intI = 0 To intFDNumber - 1
rs(intI) = txtValue(intI + 1).Text
Next intI
rs.Update
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me '卸载编辑窗体
Load frmDatabase '加载数据库窗体
frmDatabase.Visible = True '使数据库窗体可视
End Sub
'下一条
Private Sub cmdNext_Click()
On Error Resume Next
rs.MoveNext '移到下一条
If rs.EOF Then rs.MoveLast
'将作为当前记录的下一条在文本框显示
For intI = 1 To intFDNumber
txtValue(intI) = rs(intI - 1)
Next intI
End Sub
'上一条
Private Sub cmdPrevious_Click()
On Error Resume Next
rs.MovePrevious '移到上一条
If rs.BOF Then rs.MoveFirst
'将作为当前记录的上一条在文本框显示
For intI = 1 To intFDNumber
txtValue(intI) = rs(intI - 1)
Next intI
End Sub
'头记录
Private Sub cmdFirst_Click()
On Error Resume Next
rs.MoveFirst '移到头记录
'将作为当前记录的头记录在文本框显示
For intI = 1 To intFDNumber
txtValue(intI) = rs(intI - 1)
Next intI
End Sub
'尾记录
Private Sub cmdLast_Click()
On Error Resume Next
rs.MoveLast '移到尾记录
'将作为当前记录的尾记录在文本框显示
For intI = 1 To intFDNumber
txtValue(intI) = rs(intI - 1)
Next intI
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -