frmstudentinput.frm
来自「这是别人的数据库课程设计」· FRM 代码 · 共 457 行
FRM
457 行
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmStudentInput
BorderStyle = 3 'Fixed Dialog
Caption = "学生信息录入"
ClientHeight = 5715
ClientLeft = 45
ClientTop = 330
ClientWidth = 6000
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5715
ScaleWidth = 6000
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Caption = "学生单个信息录入"
Height = 5535
Left = 120
TabIndex = 0
Top = 120
Width = 5775
Begin VB.CommandButton cmdQuit
Caption = "退出录入"
Height = 375
Left = 3720
TabIndex = 31
Top = 5040
Width = 1095
End
Begin VB.CommandButton cmdCancel
Caption = "取消重录"
Height = 375
Left = 2280
TabIndex = 30
Top = 5040
Width = 1095
End
Begin VB.CommandButton cmdAdd
Caption = "确认录入"
Height = 375
Left = 960
TabIndex = 29
Top = 5040
Width = 1095
End
Begin VB.TextBox txtMemo
Height = 975
Left = 1080
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 28
Text = "frmStudentInput.frx":0000
Top = 3960
Width = 4575
End
Begin VB.TextBox txtPostCode
Height = 270
Left = 1080
TabIndex = 27
Text = "txtPostCode"
Top = 3600
Width = 2055
End
Begin VB.TextBox txtHouseAddress
Height = 270
Left = 1080
TabIndex = 26
Text = "txtHouseAddress"
Top = 3240
Width = 4575
End
Begin VB.TextBox txtHousePhone
Height = 270
Left = 1080
TabIndex = 25
Text = "txtHousePhone"
Top = 2880
Width = 4575
End
Begin VB.TextBox txtHouseName
Height = 270
Left = 1080
TabIndex = 24
Text = "txtHouseName"
Top = 2520
Width = 2055
End
Begin VB.TextBox txtEmail
Height = 270
Left = 1080
TabIndex = 23
Text = "txtEmail"
Top = 2160
Width = 4575
End
Begin VB.TextBox txtStatusID
Height = 270
Left = 1080
TabIndex = 22
Text = "txtStatusID"
Top = 1800
Width = 4575
End
Begin VB.TextBox txtPhone
Height = 270
Left = 720
TabIndex = 21
Text = "txtPhone"
Top = 1440
Width = 4935
End
Begin VB.ComboBox cobSpeciality
Height = 300
Left = 2400
Style = 2 'Dropdown List
TabIndex = 20
Top = 1080
Width = 3255
End
Begin VB.ComboBox cobNation
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 19
Top = 1080
Width = 1095
End
Begin MSComCtl2.DTPicker dtBirthday
Height = 255
Left = 2880
TabIndex = 18
Top = 720
Width = 2775
_ExtentX = 4895
_ExtentY = 450
_Version = 393216
Format = 26869760
CurrentDate = 37205
End
Begin VB.ComboBox cobSex
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 17
Top = 720
Width = 1095
End
Begin VB.TextBox txtName
Height = 270
Left = 3360
TabIndex = 16
Text = "txtName"
Top = 360
Width = 2295
End
Begin VB.TextBox txtID
Height = 270
Left = 720
TabIndex = 15
Text = "txtID"
Top = 360
Width = 2055
End
Begin VB.Label Label16
AutoSize = -1 'True
Caption = "备注："
Height = 180
Left = 240
TabIndex = 14
Top = 3960
Width = 540
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "邮政编码："
Height = 180
Left = 240
TabIndex = 13
Top = 3600
Width = 900
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "家长地址："
Height = 180
Left = 240
TabIndex = 12
Top = 3240
Width = 900
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "家长电话："
Height = 180
Left = 240
TabIndex = 11
Top = 2880
Width = 900
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "家长姓名："
Height = 180
Left = 240
TabIndex = 10
Top = 2520
Width = 900
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "电子信箱："
Height = 180
Left = 240
TabIndex = 9
Top = 2160
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "身份证号："
Height = 180
Left = 240
TabIndex = 8
Top = 1800
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "电话："
Height = 180
Left = 240
TabIndex = 7
Top = 1440
Width = 540
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "专业："
Height = 180
Left = 1920
TabIndex = 6
Top = 1080
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "民族："
Height = 180
Left = 240
TabIndex = 5
Top = 1080
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "出生日期："
Height = 180
Left = 1920
TabIndex = 4
Top = 720
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "性别："
Height = 180
Left = 240
TabIndex = 3
Top = 720
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 2880
TabIndex = 2
Top = 360
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "学号："
Height = 180
Left = 240
TabIndex = 1
Top = 360
Width = 540
End
End
End
Attribute VB_Name = "frmStudentInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
'错误检测
On Error GoTo ErrMsg
'判断学号
If Trim(txtID.Text) = "" Then
MsgBox "学号不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
txtID.SetFocus
Exit Sub
End If
'判断姓名
If Trim(txtName.Text) = "" Then
MsgBox "姓名不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
txtName.SetFocus
Exit Sub
End If
'判断出生日期，以必须是15--30岁之间这例
If (Year(Now) - Year(dtBirthday.Value)) < 15 Or (Year(Now) - Year(dtBirthday.Value)) > 30 Then
MsgBox "输入的出生日期应保证在15--30岁间！", vbOKOnly + vbExclamation, "系统提示"
dtBirthday.SetFocus
Exit Sub
End If
'若电子信箱输入，则判断是否是合法的
If Trim(txtEmail.Text) <> "" Then
'?--是任意一个字符，*--零个或任意个字符
'邮箱必须是如下样式的：abc@jlu.com
If txtEmail.Text Like "?*@??*.???*" = False Then
MsgBox "输入的邮箱不是有效的信箱，请核实！", vbOKOnly + vbExclamation, "系统提示"
txtEmail.SetFocus
Exit Sub
End If
End If
'若邮政编码为空不处理，若不是空的，则要判断是否是6位数字
If Trim(txtPostCode.Text) <> "" Then
If Len(Trim(txtPostCode.Text)) <> 6 Or Not (txtPostCode.Text Like "[0-9][0-9][0-9][0-9][0-9][0-9]") Then
MsgBox "邮政编码输入不正确，必须是6位数字，请核实！", vbOKOnly + vbExclamation, "系统提示"
txtPostCode.SetFocus
Exit Sub
End If
End If
Dim SQL As String
SQL = "Select * From Student Where ID='" & Trim(txtID.Text) & "'"
Set adoRS = adoCon.Execute(SQL)
If Not adoRS.EOF Then
MsgBox "编号为：" & Trim(txtID.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
txtID.SetFocus
Exit Sub
End If
'构造插入学生表的Insert语句
SQL = ""
SQL = "Insert Into Student "
SQL = SQL & " Values('" & Trim(txtID.Text) & "'"
SQL = SQL & ",'" & Trim(txtName.Text) & "'"
SQL = SQL & ",'" & cobSex.Text & "'"
SQL = SQL & ",'" & Format(dtBirthday.Value, "YYYY-MM-DD") & "'"
SQL = SQL & ",'" & cobNation.Text & "'"
SQL = SQL & ",'" & cobSpeciality.Text & "'"
SQL = SQL & ",'" & txtPhone.Text & "'"
SQL = SQL & ",'" & txtStatusID.Text & "'"
SQL = SQL & ",'" & txtEmail.Text & "'"
SQL = SQL & ",'" & txtHouseName.Text & "'"
SQL = SQL & ",'" & txtHousePhone.Text & "'"
SQL = SQL & ",'" & txtHouseAddress.Text & "'"
SQL = SQL & ",'" & txtPostCode.Text & "'"
SQL = SQL & ",'" & txtMemo.Text & "')"
'执行插入
adoCon.Execute (SQL)
'调用设置控件
Call FillControl
MsgBox "恭喜恭喜^_^，插入成功！", vbOKOnly + vbInformation, "成功提示"
txtID.SetFocus
'错误处理
ErrMsg:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
Exit Sub
End If
End Sub
Private Sub cmdCancel_Click()
'错误检测
On Error GoTo ErrMsg
Call FillControl
txtID.SetFocus
'错误处理
ErrMsg:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
Exit Sub
End If
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub Form_Load()
'错误检测
On Error GoTo ErrMsg
'MDI子窗体居中
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
'调用填写控件过程
Call FillControl
'错误处理
ErrMsg:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
Exit Sub
End If
End Sub
Private Sub FillControl()
txtID.Text = ""
txtName.Text = ""
With cobSex
.Clear
.AddItem "男"
.AddItem "女"
.ListIndex = 0
End With
dtBirthday.Value = Now
'从民族表中提取记录，添加到下拉列表框中
Set adoRS = adoCon.Execute("Select Name From Nation Order By Name")
cobNation.Clear
Do While Not adoRS.EOF
cobNation.AddItem adoRS("Name")
adoRS.MoveNext
Loop
cobNation.ListIndex = 0
'从专业表中提取记录，添加到下拉列表框中
Set adoRS = adoCon.Execute("Select Name From Speciality Order By Name")
cobSpeciality.Clear
Do While Not adoRS.EOF
cobSpeciality.AddItem adoRS("Name")
adoRS.MoveNext
Loop
cobSpeciality.ListIndex = 0
txtPhone.Text = ""
txtStatusID.Text = ""
txtEmail.Text = ""
txtHouseName.Text = ""
txtHousePhone.Text = ""
txtHouseAddress.Text = ""
txtPostCode.Text = ""
txtMemo.Text = ""
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?