frm_setsystem.frm

学生学籍管理系统

Private Sub command1_Click(Index As Integer)
Select Case Index
'增加
Case 0
    If command1(0).Caption = "增加" Then
       State "add"
    Else
        If Trim(Text1(0)) <> "" And Trim(Text1(1)) <> "" And Trim(Text1(2)) <> "" And Trim(Combo1.Text) <> "" Then
            Set myUser = New Cls_user
            myUser.OpenUserMessageByUserID Trim(Text1(0))
            If myUser.GetUserMessageRs.EOF = False Then
                MsgBox "用户编号重复,请重新填写!", vbApplicationModal + vbExclamation + vbOKOnly, "错误"
                Text1(0).SetFocus
                Text1(0).SelStart = 0
                Set myUser = Nothing
            Else
                frm_ProgressBar.Show 1
                myUser.OpenUserMessage
                myUser.GetUserMessageRs.AddNew
                '写入表UserMessage
                DisplayIn myUser.GetUserMessageRs
                myUser.GetUserMessageRs.Update
                myUser.GetUserMessageRs.Requery
                
                If Trim(Combo2.Text) <> "" Then
                    myUser.OpenConnect
                    myUser.GetUserMessageRs.AddNew
                    myUser.GetUserMessageRs.Fields(1) = Trim(Text1(0))
                    myUser.GetUserMessageRs.Fields(2) = Trim(Combo2.Text)
                    myUser.GetUserMessageRs.Update
                    myUser.GetUserMessageRs.Requery
                End If
                Set myUser = Nothing
                RefreshList
                State "cencel"
            End If
        Else
            MsgBox "请将信息填写完整后再提交!", vbApplicationModal + vbInformation + vbOKOnly, "错误"
            Text1(0).SetFocus
        End If
    End If
'修改
Case 1
    If command1(1).Caption = "修改" Then
       State "edit"
    Else
       frm_ProgressBar.Show 1
       Set myUser = New Cls_user
       myUser.OpenUserMessageByUserID Trim(Text1(0))
       DisplayIn myUser.GetUserMessageRs
       myUser.GetUserMessageRs.Update
       myUser.GetUserMessageRs.Requery
       
       If Trim(Combo2.Text) <> "" Then
           myUser.OpenConnectByUserID Trim(Text1(0).Text)
           If myUser.GetUserMessageRs.EOF = False Then
              myUser.GetUserMessageRs.Fields(2) = Trim(Combo2.Text)
              myUser.GetUserMessageRs.Update
              myUser.GetUserMessageRs.Requery
           Else
              myUser.GetUserMessageRs.AddNew
              myUser.GetUserMessageRs.Fields(1) = Trim(Text1(0))
              myUser.GetUserMessageRs.Fields(2) = Trim(Combo2.Text)
              myUser.GetUserMessageRs.Update
              myUser.GetUserMessageRs.Requery
           End If
       End If
       Set myUser = Nothing
       State "cencel"
    End If
'删除
Case 2
    Dim yn As String
    yn = MsgBox("真的删除吗？", vbYesNo, "删除")
    If yn = vbYes Then
      frm_ProgressBar.Show 1
      Set myUser = New Cls_user
      myUser.OpenUserMessageByUserID Trim(Text1(0))
      myUser.GetUserMessageRs.Delete
      myUser.GetUserMessageRs.Requery
      
      myUser.OpenConnectByUserID Trim(Text1(0).Text)
      If myUser.GetUserMessageRs.EOF = False Then
      Do Until myUser.GetUserMessageRs.EOF
           myUser.GetUserMessageRs.Delete
           myUser.GetUserMessageRs.Requery
           myUser.GetUserMessageRs.MoveNext
      Loop
      End If
      Set myUser = Nothing
      RefreshList
    End If
    State "cencel"
'取消
Case 3
       State "cencel"
'退出
Case 4
       Unload Me
End Select
End Sub

Private Sub State(kind As String)
'各种操作时各个控件的状态
Dim i As Integer
Select Case kind
Case "add"
 For i = 0 To 2
     Text1(i) = ""
     Text1(i).Enabled = True
 Next
 Combo1 = ""
 Combo1.Enabled = True
 Combo2.Enabled = False
    Text1(0).SetFocus
    command1(0).Caption = "提交"
    command1(0).DragMode = 0
    command1(1).DragMode = 1
    command1(2).DragMode = 1
    command1(3).DragMode = 0
    command1(4).DragMode = 1
Case "edit"
    For i = 1 To 2
        Text1(i).Enabled = True
    Next
    Combo1.Enabled = True
    If Trim(Combo1.Text) = "教员" Then Combo2.Enabled = True
    Text1(1).SetFocus
    command1(1).Caption = "更新"
    command1(0).DragMode = 1
    command1(1).DragMode = 0
    command1(2).DragMode = 1
    command1(3).DragMode = 0
    command1(4).DragMode = 1
    
Case "cencel"
    For i = 0 To 2
         Text1(i) = ""
         Text1(i).Enabled = False
    Next
    Combo1.Text = ""
    Combo2.Text = ""
    Combo1.Enabled = False
    Combo2.Enabled = False
    command1(0).Caption = "增加"
    command1(1).Caption = "修改"
    command1(0).DragMode = 0
    command1(1).DragMode = 1
    command1(2).DragMode = 1
    command1(3).DragMode = 1
    command1(4).DragMode = 0
    
Case "selected"
    For i = 0 To 2
         Text1(i).Enabled = False
    Next
    Combo1.Enabled = False
    Combo2.Enabled = False
    command1(0).Caption = "增加"
    command1(1).Caption = "修改"
    command1(0).DragMode = 0
    command1(1).DragMode = 0
    command1(2).DragMode = 0
    command1(3).DragMode = 1
    command1(4).DragMode = 0
End Select
End Sub


Private Sub SSTab1_Click(Index As Integer, PreviousTab As Integer)
Select Case PreviousTab
Case 0

     Text2(0).SetFocus
End Select
End Sub


Private Sub Text1_GotFocus(Index As Integer)
    '设定文本框获得焦点时处于全部被选中状态
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    '传递焦点
    Select Case Index
    Case 0
        If KeyAscii = 13 Then Text1(1).SetFocus
    Case 1
        If KeyAscii = 13 Then Text1(2).SetFocus
    Case 2
        If KeyAscii = 13 Then Combo1.SetFocus
    End Select
End Sub

Private Function DisplayIn(myrs As Recordset)
    '向UserMessage中写入记录
    Dim i As Integer
    For i = 0 To 2
        myrs.Fields(i) = Trim(Text1(i))
    Next
    myrs.Fields(3) = Trim(Combo1.Text)
        
End Function
Private Function DisplayOut(myrs As Recordset)
    '显示选中的用户信息
    Dim i As Integer
    For i = 0 To 2
        Text1(i).Text = Trim(myrs.Fields(i))
    Next
    Combo1.Text = myrs.Fields(3)

End Function

Private Sub RefreshList()
    List1.Clear
    '显示用户编号于list1中
    Set myUser = New Cls_user
    myUser.OpenUserMessage
    If myUser.GetUserMessageRs.EOF = False Then
       Do Until myUser.GetUserMessageRs.EOF
          List1.AddItem myUser.GetUserMessageRs.Fields(0)
          myUser.GetUserMessageRs.MoveNext
       Loop
    End If
    Set myUser = Nothing
End Sub
Private Sub imgclose_Click()
    Unload Me
End Sub

Private Sub imglefttitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawForms Me
End Sub

Private Sub imgtop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawForms Me
End Sub

Private Sub imgrighttitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawForms Me
End Sub

Private Sub LoadUserRole()
    Combo1.AddItem "总监"
    Combo1.AddItem "教务主管"
    Combo1.AddItem "财务"
    Combo1.AddItem "咨询师"
    Combo1.AddItem "教员"
End Sub


Private Sub CheckUp(checktype As String)
Select Case checktype
Case "update"
    '修改密码，写入数据库
    Set mypwd = New Cls_user
    mypwd.EditPassWord Trim(lblUserid), Trim(Text2(2))
    frm_ProgressBar.Show 1
    SSTab1.Item(0).Tab = 0
    Set mypwd = Nothing
    '检验用户输入的密码是否合法
Case "query"
    Set mypwd = New Cls_user
    mypwd.OpenUserMessageByUserID Trim(lblUserid)
    If mypwd.GetUserMessageRs.EOF = False Then
       If Trim(Text2(0)) = Trim(mypwd.GetUserMessageRs.Fields(2)) Then
          Text2(1).Enabled = True
          Text2(1).SetFocus
       End If
    Else
       MsgBox "密码错误！请重新输入!"
       Text2(1).Enabled = False
       Text2(0).SetFocus
    End If
    Set mypwd = Nothing
End Select
End Sub

Private Sub Text2_GotFocus(Index As Integer)
Text2(Index).SelLength = Len(Text2(Index).Text)
End Sub

Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
     If KeyAscii = 13 And Text2(0) <> "" Then CheckUp "query"
Case 1
     If KeyAscii = 13 And Text2(1) <> "" Then
        If Trim(Text2(1)) = Trim(Text2(0)) Then
           MsgBox "新密码和旧密码相同！请重新输入！"
           Text2(1).SetFocus
        Else
           Text2(2).Enabled = True
           Text2(2).SetFocus
        End If
     End If
Case 2
     If KeyAscii = 13 And Text2(2) <> "" Then
        If Trim(Text2(1)) = Trim(Text2(2)) Then
           command2.DragMode = 0
           command2_Click
        Else
           MsgBox "确认密码错误！请重新输入!"
           Text2(2).SetFocus
        End If
     End If
End Select
End Sub

Public Sub TheSecondState()
Dim i As Integer
   lblUserid.Caption = UserID                 '显示此次登陆的用户编号
   command2.DragMode = 1
   For i = 0 To 2
       Text2(i) = ""
   Next
   Text2(1).Enabled = False
   Text2(2).Enabled = False
End Sub