新阳师傅验收一遍完系统之后指出了很多需要改正的地方,旨在让用户用起来更简单快捷。在这里我的小伙伴晓蝉也帮了我很大的忙。此致感谢!
一、登陆界面的优化:
原先的界面如上图所示,太过普通。模仿QQ、飞信得出如下界面。
优化的主要功能:除了界面所展示以外还有要求账号只能为数字或字母,限制字数。Enter键和Tab键的使用。代码如下:
<span style="font-size:14px;"><span style="font-size:24px;">'只能输入字母和数字 Private Sub txtusername_KeyPress(KeyAscii As Integer) If (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Or (KeyAscii = 8) Then Else MsgBox "用户名由字母和数字组成", vbOKOnly + vbExclamation, "警告" KeyAscii = 0 End If End Sub '限制输入的字符长度为6-16之间 Private Sub txtusername_LostFocus() If Not Len(txtUserName) = 0 And Len(txtUserName) < 6 Or Len(txtUserName) > 16 Then MsgBox "用户名和密码由6-16个字母和数字组成" txtUserName.SelLength = Len(txtUserName.Text) txtUserName.SelStart = 0 txtUserName.SetFocus End If If txtUserName = "" Then txtUserName.Text = "请输入帐号" txtUserName.ForeColor = RGB(128, 128, 128) End If End Sub Private Sub txtusername_GotFocus() If txtUserName = "请输入帐号" Then txtUserName.Text = "" txtUserName.ForeColor = RGB(0, 0, 0) End If End Sub Private Sub Txtpassword_LostFocus() If txtPassword = "" Then txtPassword.Text = "请输入密码" txtPassword.PasswordChar = "" txtPassword.ForeColor = RGB(128, 128, 128) End If End Sub Private Sub Txtpassword_GotFocus() If txtPassword = "请输入密码" Then txtPassword.Text = "" txtPassword.PasswordChar = "*" txtPassword.ForeColor = RGB(0, 0, 0) End If End Sub</span></span>
<pre name="code" class="vb"><span style="font-size:14px;"><span style="font-size:14px;"><span style="font-size:24px;">Private Sub txtborndate_Change() Dim Lenth As Byte Lenth = Len(txtBorndate) If Lenth = 4 Or Lenth = 7 Then txtBorndate = txtBorndate & "-" txtBorndate.SelStart = Lenth + 1 End If End Sub Private Sub txtBorndate_GotFocus() If txtBorndate.Text = "yyyy-mm-dd" Then txtBorndate.Text = "" txtBorndate.ForeColor = RGB(0, 0, 0) End If End Sub Private Sub txtborndate_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then If Right(txtBorndate, 1) = "-" Then txtBorndate = Left(txtBorndate, Abs(Len(txtBorndate) - 2)) KeyAscii = 0 txtBorndate.SelStart = Len(txtBorndate) End If ElseIf Len(txtBorndate) >= 10 Then KeyAscii = 0 ElseIf KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub Private Sub txtBorndate_LostFocus() If txtBorndate.Text = "" Then txtBorndate.Text = "yyyy-mm-dd" txtBorndate.ForeColor = RGB(128, 128, 128) End If End Sub Private Sub txtrudate_Change() Dim Lenth As Byte Lenth = Len(txtRudate) If Lenth = 4 Or Lenth = 7 Then txtRudate = txtRudate & "-" txtRudate.SelStart = Lenth + 1 End If End Sub Private Sub txtRudate_GotFocus() If txtRudate.Text = "yyyy-mm-dd" Then txtRudate.Text = "" txtRudate.ForeColor = RGB(0, 0, 0) End If End Sub Private Sub txtrudate_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then If Right(txtRudate, 1) = "-" Then txtRudate = Left(txtRudate, Abs(Len(txtRudate) - 2)) KeyAscii = 0 txtRudate.SelStart = Len(txtRudate) End If ElseIf Len(txtRudate) >= 10 Then KeyAscii = 0 ElseIf KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub '设置姓名字节的限制,由2个到4个字组成,即4-8个字节组成 Private Sub txtname_LostFocus() If Not LenB(txtName) = 0 And LenB(txtName) < 4 Or LenB(txtName) > 8 Then txtName.SetFocus txtName.SelLength = Len(txtName.Text) txtName.SelStart = 0 MsgBox "姓名输入错误" End If End Sub '不能输入数字 Private Sub Txtname_KeyPress(KeyAscii As Integer) If (KeyAscii >= 48 And KeyAscii <= 57) Then MsgBox "不允许输入数字", vbOKOnly + vbExclamation, "警告" KeyAscii = 0 '键盘不能用 End If End Sub Private Sub txtRudate_LostFocus() If txtRudate.Text = "" Then txtRudate.Text = "yyyy-mm-dd" txtRudate.ForeColor = RGB(128, 128, 128) End If End Sub '限制text中只能输入数字 Private Sub txtsid_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then MsgBox "学号由数字组成!", vbOKOnly + vbExclamation, "警告" KeyAscii = 0 End If End Sub 日期不能为同一天的功能代码展示: '入学日期和出生日期不能同一天 If txtBorndate = txtRudate Then MsgBox "出生日期和入学日期不能同一天", vbOKOnly + vbExclamation, "警告" txtRudate.SetFocus Exit Sub End If</span></span></span>
<span style="font-size:14px;">'添加课程之前确认是否列表中已有课程 Dim intindex1 As Integer Dim intindex2 As Integer With listSelectcourse For intindex1 = 0 To .ListCount - 1 For intindex2 = .ListCount - 1 To intindex1 + 1 Step -1 If .List(intindex2) = .List(intindex1) Then .RemoveItem intindex2 End If Next intindex2 Next intindex1 End With</span>
<span style="font-size:14px;"><span style="font-size:24px;">listAllcourse.Enabled = True listSelectcourse.Enabled = True cmdAdd.Enabled = True cmdDelete.Enabled = True cmdModify.Enabled = True cmdSet.Enabled = False</span></span>
<span style="font-size:14px;"><span style="font-size:24px;">Private Sub Check1_Click(Index As Integer) If Not Check1(0).Value Then txtSID.Text = "" End If If Not Check1(1).Value Then txtName.Text = "" End If If Not Check1(2).Value Then txtClassno.Text = "" End If End Sub</span></span>
<span style="font-size:14px;"><span style="font-size:24px;"> '添加错误处理 txtSQL = "select * from course_Info" Set mrc = ExecuteSQL(txtSQL, MsgText) '得到student表,并显示出来 On Error GoTo dateErr '如果有错误直接执行dateErr那一步 mrc.MoveFirst ' Call viewData myBookmark = mrc.Bookmark mcclean = True dateErr: If Err = 3021 Then MsgBox "没有数据", vbOKOnly + vbExclamation, "警告" End If</span></span>
<span style="font-size:14px;"><span style="font-size:24px;">Me.Height = 5625 Me.Width = 6720</span></span>