frmadduser.frm
来自「学生信息管理系统,学生入学时间及毕业时间,学生成绩,学生所在系」· FRM 代码 · 共 459 行
FRM
459 行
VERSION 5.00
Begin VB.Form FrmAddUser
BackColor = &H00FFFF00&
BorderStyle = 3 'Fixed Dialog
Caption = "添加用户"
ClientHeight = 4770
ClientLeft = 45
ClientTop = 330
ClientWidth = 4695
Icon = "FrmAddUser.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4770
ScaleWidth = 4695
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdNext
Caption = "下一步(1)"
Height = 495
Left = 240
TabIndex = 20
Top = 3960
Width = 1335
End
Begin VB.CommandButton Cmdcancel
Caption = "取消"
Height = 495
Left = 2880
TabIndex = 19
Top = 3960
Width = 1335
End
Begin VB.Frame Frame1
BackColor = &H00FF0000&
BorderStyle = 0 'None
Height = 2535
Left = 240
TabIndex = 7
Top = 120
Width = 3735
Begin VB.TextBox txtUserdes
Height = 375
Left = 1560
MaxLength = 10
TabIndex = 2
Top = 1440
Width = 1575
End
Begin VB.TextBox txtUserid
Height = 375
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 10
TabIndex = 0
Top = 383
Width = 1575
End
Begin VB.TextBox txtUsername
Height = 375
Left = 1560
MaxLength = 15
TabIndex = 1
Top = 923
Width = 1575
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00E7DFE7&
BackStyle = 0 'Transparent
Caption = "用户描述："
Height = 180
Left = 240
TabIndex = 10
Top = 1560
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00E7DFE7&
BackStyle = 0 'Transparent
Caption = "用户编号："
Height = 180
Left = 240
TabIndex = 9
Top = 480
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00E7DFE7&
BackStyle = 0 'Transparent
Caption = "姓名："
Height = 180
Left = 600
TabIndex = 8
Top = 1020
Width = 540
End
End
Begin VB.Frame Frame2
BackColor = &H00E7DFE7&
BorderStyle = 0 'None
Height = 2535
Left = 240
TabIndex = 11
Top = 120
Visible = 0 'False
Width = 3735
Begin VB.TextBox txtPwd2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 10
PasswordChar = "*"
TabIndex = 6
Top = 1200
Width = 1695
End
Begin VB.TextBox txtPwd1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 10
PasswordChar = "*"
TabIndex = 4
Top = 480
Width = 1695
End
Begin VB.Label Label5
AutoSize = -1 'True
BackColor = &H00E7DFE7&
BackStyle = 0 'Transparent
Caption = "确认密码(&C)："
Height = 180
Left = 120
TabIndex = 5
Top = 1320
Width = 1170
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00E7DFE7&
BackStyle = 0 'Transparent
Caption = "密码(&P)："
Height = 180
Left = 480
TabIndex = 3
Top = 600
Width = 810
End
End
Begin VB.Frame Frame3
BackColor = &H00E7DFE7&
BorderStyle = 0 'None
Height = 2535
Left = 240
TabIndex = 12
Top = 120
Visible = 0 'False
Width = 3735
Begin VB.Frame Frame5
BackColor = &H00E7DFE7&
BorderStyle = 0 'None
Enabled = 0 'False
Height = 2415
Left = 1680
TabIndex = 17
Top = 120
Width = 1935
Begin VB.ListBox List1
BackColor = &H00E7DFE7&
Height = 2160
ItemData = "FrmAddUser.frx":1982
Left = 120
List = "FrmAddUser.frx":19A4
Style = 1 'Checkbox
TabIndex = 18
Top = 120
Width = 1695
End
End
Begin VB.Frame Frame4
BackColor = &H00E7DFE7&
Caption = "用户操作级别"
Height = 1935
Left = 120
TabIndex = 13
ToolTipText = "请选择一个操作级别"
Top = 360
Width = 1575
Begin VB.OptionButton Option1
BackColor = &H00E7DFE7&
Caption = "普通用户"
Height = 375
Index = 2
Left = 120
TabIndex = 16
ToolTipText = "请选择一个操作级别"
Top = 1320
Width = 1215
End
Begin VB.OptionButton Option1
BackColor = &H00E7DFE7&
Caption = "超级用户"
Height = 375
Index = 1
Left = 120
TabIndex = 15
ToolTipText = "请选择一个操作级别"
Top = 840
Width = 1215
End
Begin VB.OptionButton Option1
BackColor = &H00E7DFE7&
Caption = "系统管理员"
Height = 375
Index = 0
Left = 120
TabIndex = 14
ToolTipText = "请选择一个操作级别"
Top = 360
Width = 1215
End
End
End
Begin VB.CommandButton cmdNext1
Caption = "下一步(2)"
Height = 495
Left = 240
TabIndex = 21
Top = 3960
Width = 1335
End
Begin VB.CommandButton cmdComp
Caption = "完成"
Height = 495
Left = 240
TabIndex = 22
Top = 3960
Width = 1335
End
End
Attribute VB_Name = "FrmAddUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MyAddUser As OpenRs
Dim Choose As Boolean
Dim Level As Integer
Private Sub Cmdcancel_Click()
Unload Me
End Sub
Private Sub cmdComp_Click() '完成按钮
If Choose = False Then
MsgBox "请选择一个操作级别！", vbOKOnly + vbInformation, "添加新用户"
Exit Sub
End If
MyAddUser.rs1.AddNew
MyAddUser.rs1!user_id = Trim(txtUserId.Text)
MyAddUser.rs1!user_name = Trim(txtUserName)
MyAddUser.rs1!user_des = Trim(txtUserdes.Text)
MyAddUser.rs1!user_pwd = Trim(txtPwd1.Text)
MyAddUser.rs1!user_level = Level
MyAddUser.rs1.Update
If MsgBox("添加用户成功！" & vbCrLf & vbCrLf & "是否继续添加用户？", vbYesNo + vbQuestion, "添加用户") = vbYes Then
Frame3.Visible = False
cmdComp.Visible = False
Frame1.Visible = True
cmdNext.Visible = True
txtUserId.SetFocus
Call ClearText
Else
Unload Me
End If
End Sub
Private Sub cmdNext_Click()
Choose = False
Dim txtUseridSQL As String
If Trim(txtUserId.Text) = "" Then
MsgBox "用户编号不能为空！", vbOKOnly + vbInformation, "提示"
txtUserId.SetFocus
Exit Sub
Else
txtUseridSQL = "select * from User_Info" '校验用户编号是否重复
MyAddUser.rsDK1 txtUseridSQL
While (MyAddUser.rs1.EOF = False)
If Trim(MyAddUser.rs1!user_id) = Trim(txtUserId.Text) Then
MsgBox "用户编号已存在，请重新输入用户编号！", vbOKOnly + vbExclamation, "警告"
txtUserId.Text = ""
txtUserName.Text = ""
txtUserdes.Text = ""
txtUserId.SetFocus
Exit Sub
Else
MyAddUser.rs1.MoveNext
End If
Wend
End If
'***校验用户名是否为空
If txtUserName.Text = "" Then
MsgBox "用户名不能为空！", vbOKOnly + vbInformation, "提示"
txtUserName.SetFocus
Exit Sub
End If
Frame1.Visible = False
Frame2.Visible = True
txtPwd1.SetFocus
cmdNext.Visible = False
cmdNext1.Visible = True
End Sub
Private Sub cmdNext1_Click()
Dim i As Integer
If txtPwd1.Text = "" Then
MsgBox "请输入密码！", vbOKOnly + vbInformation, "提示"
txtPwd1.SetFocus
Exit Sub
End If
If txtPwd2.Text = "" Then
MsgBox "请输入确认密码！", vbOKOnly + vbInformation, "提示"
txtPwd2.SetFocus
Exit Sub
End If
If txtPwd1.Text <> txtPwd2.Text Then
MsgBox "两次输入的密码不一致！！！" & vbCrLf & vbCrLf & "请重新输入！", vbOKOnly + vbInformation, "提示"
txtPwd1.Text = ""
txtPwd2.Text = ""
txtPwd1.SetFocus
Exit Sub
End If
Frame2.Visible = False
Frame3.Visible = True
cmdNext1.Visible = False
cmdComp.Visible = True
For i = 0 To 2 '取消选项按钮选择
Option1(i).Value = False
Next i
List1.ListIndex = -1
End Sub
Private Sub Choose_level()
Dim i As Integer
If Option1(0).Value = True Then
Level = 1
For i = 0 To 9 '全选
List1.Selected(i) = True
Next i
List1.ListIndex = -1
ElseIf Option1(1).Value = True Then
Level = 2
For i = 0 To 6
List1.Selected(i) = True
Next i
List1.Selected(7) = False
List1.Selected(8) = False
List1.Selected(9) = False
List1.ListIndex = -1
ElseIf Option1(2).Value = True Then
Level = 3
List1.Selected(0) = True
List1.Selected(1) = True
For i = 2 To 9
List1.Selected(i) = False
Next i
List1.ListIndex = -1
End If
End Sub
Private Sub Form_Load()
Set MyAddUser = New OpenRs
End Sub
Private Sub Option1_Click(Index As Integer)
Choose = True
Call Choose_level
End Sub
Private Sub ClearText()
Dim i As Integer
txtUserId.Text = ""
txtUserName.Text = ""
txtUserdes.Text = ""
txtPwd1.Text = ""
txtPwd2.Text = ""
For i = 0 To 2 '取消选项按钮选择
Option1(i).Value = False
Next i
Choose = False
For i = 0 To 9
List1.Selected(i) = False
List1.ListIndex = -1
Next i
End Sub
Private Sub txtPwd1_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then
KeyAscii = 0
ElseIf KeyAscii = 13 Then
txtPwd2.SetFocus
End If
End Sub
Private Sub txtPwd2_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then
KeyAscii = 0
ElseIf KeyAscii = 13 Then
Call cmdNext1_Click
End If
End Sub
Private Sub txtUserdes_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then
KeyAscii = 0
ElseIf KeyAscii = 13 Then
Call cmdNext_Click
End If
End Sub
Private Sub txtUserId_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then
KeyAscii = 0
ElseIf KeyAscii = 13 Then
txtUserName.SetFocus
End If
End Sub
Private Sub txtUsername_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then
KeyAscii = 0
ElseIf KeyAscii = 13 Then
txtUserdes.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?