frmstsi.frm

一个较简单实用的学校学籍管理系统

      Width           =   1695
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  查  询"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   1
      Left            =   1800
      TabIndex        =   0
      Top             =   3960
      Width           =   1815
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  修  改"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   2
      Left            =   3600
      TabIndex        =   1
      Top             =   3960
      Width           =   1815
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  删  除"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   3
      Left            =   5400
      TabIndex        =   2
      Top             =   3960
      Width           =   1815
   End
End
Attribute VB_Name = "frmstsi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mrc As ADODB.Recordset
Dim MsgText As String
Dim tSQL As String
Private Sub Combo1_Click()
    Text1(4) = Combo1.Text
    If Label1(3).BackColor <> &HFFFFFF Then
        If Label2(4).Caption = Combo1.Text Then
            Combo1.BackColor = &HE0E0E0
        Else
            Combo1.BackColor = &HFFFFFF
        End If
    End If
End Sub

Private Sub Command1_Click()
    Dim txtSQL As String
    For i = 0 To 24
        If i <> 4 Then
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请填写:" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Text1(i).SetFocus
                Exit Sub
            End If
        Else
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请填写:" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Combo1.SetFocus
                Exit Sub
            End If
        End If
    Next
    If IsDate(Text1(3)) = True Then
        MsgBox "出生日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
        Text1(3).SetFocus
        Exit Sub
    End If
    If IsDate(Text1(6)) = True Then
        MsgBox "入学日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
        Text1(6).SetFocus
        Exit Sub
    End If
    txtSQL = "select * from student_Form where student_NO='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        MsgBox "学号不能重复!", vbOKOnly, "警告"
        Text1(0).SetFocus
        Exit Sub
    End If
    mrc.Close
    txtSQL = "select * from student_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0))
    mrc.Fields(1) = Trim(Text1(1))
    mrc.Fields(2) = Trim(Text1(2))
    mrc.Fields(3) = Trim(Text1(3))
    mrc.Fields(4) = Trim(Text1(4))
    mrc.Fields(5) = Trim(Text1(5))
    mrc.Fields(6) = Trim(Text1(6))
    mrc.Fields(7) = Trim(Text1(7))
    mrc.Fields(8) = Trim(Text1(8))
    mrc.Fields(9) = Trim(Text1(9))
    mrc.Fields(10) = Trim(Text1(10))
    mrc.Fields(11) = Trim(Text1(11))
    mrc.Fields(12) = Trim(Text1(12))
    mrc.Fields(13) = Trim(Text1(13))
    mrc.Fields(14) = Trim(Text1(14))
    mrc.Fields(15) = Trim(Text1(15))
    mrc.Fields(16) = Trim(Text1(16))
    mrc.Fields(17) = Trim(Text1(17))
    mrc.Fields(18) = Trim(Text1(18))
    mrc.Fields(19) = Trim(Text1(19))
    mrc.Fields(20) = Trim(Text1(20))
    mrc.Fields(21) = Trim(Text1(21))
    mrc.Fields(22) = Trim(Text1(22))
    mrc.Fields(23) = Trim(Text1(23))
    mrc.Fields(24) = Trim(Text1(24))
    If Text1(25) = Label2(25).Caption Then
        mrc.Fields(25) = "0"
    Else
    mrc.Fields(25) = Trim(Text1(25))
    End If
    If Text1(26) = Label2(26).Caption Then
        mrc.Fields(26) = "0"
    Else
    mrc.Fields(26) = Trim(Text1(26))
    End If
    If Text1(27) = Label2(27).Caption Then
        mrc.Fields(27) = "0"
    Else
    mrc.Fields(27) = Trim(Text1(27))
    End If
    If Text1(28) = Label2(28).Caption Then
        mrc.Fields(28) = "0"
    Else
    mrc.Fields(28) = Trim(Text1(28))
    End If
    If Text1(29) = Label2(29).Caption Then
        mrc.Fields(29) = "0"
    Else
    mrc.Fields(29) = Trim(Text1(29))
    End If
    If Text1(30) = Label2(30).Caption Then
        mrc.Fields(30) = "0"
    Else
        mrc.Fields(30) = Trim(Text1(30))
    End If
    mrc.Update
    mrc.Close
    MsgBox "学籍信息添加成功!", vbOKOnly, "提示"
    With MSFlexGrid1
        .Rows = .Rows + 1
        .TextMatrix(.Rows - 1, 0) = Trim(Text1(0))
        .TextMatrix(.Rows - 1, 1) = Trim(Text1(1))
        .TextMatrix(.Rows - 1, 2) = Trim(Text1(2))
        .TextMatrix(.Rows - 1, 3) = Trim(Text1(3))
        .TextMatrix(.Rows - 1, 4) = Trim(Text1(4))
        .TextMatrix(.Rows - 1, 5) = Trim(Text1(5))
        .TextMatrix(.Rows - 1, 6) = Trim(Text1(6))
        .TextMatrix(.Rows - 1, 7) = Trim(Text1(7))
        .TextMatrix(.Rows - 1, 8) = Trim(Text1(8))
        .TextMatrix(.Rows - 1, 9) = Trim(Text1(9))
        
        
    End With
    MSFlexGrid1.TopRow = MSFlexGrid1.Rows - 1
    TextDcolor
End Sub

Private Sub Command2_Click(Index As Integer)
    Dim j As Integer
    Dim txtSQL As String
    If Text1(5) <> Label2(5).Caption Then
        If IsDate(Text1(5)) = True Then
            MsgBox "起始日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
            Text1(5).SetFocus
            Exit Sub
        Else
            Text1(5) = Format(Text1(5), "yyyy-mm-dd")
        End If
    End If
    If Text1(6) <> Label2(6).Caption Then
        If IsDate(Text1(6)) = True Then
            MsgBox "起始日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
            Text1(6).SetFocus
            Exit Sub
        Else
            Text1(6) = Format(Text1(6), "yyyy-mm-dd")
        End If
    End If
    txtSQL = "select * from student_Form"
    If Text1(0) <> Label2(0).Caption Then
        txtSQL = txtSQL & " where student_NO='" & Trim(Text1(0)) & "'"
    End If
    If Text1(1) <> Label2(1).Caption Then
        If txtSQL = "select * from student_Form" Then
            txtSQL = txtSQL & " where student_Name='" & Trim(Text1(1)) & "'"
        Else
            txtSQL = txtSQL & " and student_Name='" & Trim(Text1(1)) & "'"
        End If
    End If
    If Text1(4) <> Label2(4).Caption Then
        If txtSQL = "select * from student_Form" Then
            txtSQL = txtSQL & " where student_Cla='" & Trim(Text1(4)) & "'"
        Else
            txtSQL = txtSQL & " and student_Cla='" & Trim(Text1(4)) & "'"
        End If
    End If
    If Text1(5) <> Label2(5).Caption And Text1(6) <> Label2(6).Caption Then
        If txtSQL = "select * from student_Form" Then
            txtSQL = txtSQL & " where Format(student_Esd,'yyyy-mm-dd') >='" & Trim(Text1(5)) & "'and Format(student_Esd,'yyyy-mm-dd') <='" & Trim(Text1(6)) & "'"
        Else
            txtSQL = txtSQL & " and Format(student_Esd,'yyyy-mm-dd') >='" & Trim(Text1(5)) & "'and Format(student_Esd,'yyyy-mm-dd') <='" & Trim(Text1(6)) & "'"
        End If
    End If
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    j = 1
    Do While Not mrc.EOF
        j = j + 1
    mrc.MoveNext
    Loop
    ProgressBar1.Visible = True
    ProgressBar1.Min = CInt(0)
    ProgressBar1.Max = CInt(j)
    Set mrc = ExecuteSQL(txtSQL, MsgText)
        Frame1.Visible = True
        With MSFlexGrid1
        .Visible = False
        .Rows = 1
        ProgressBar1.Value = .Rows
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 0 To mrc.Fields.Count - 1
                Select Case mrc.Fields(i).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
        .Visible = True
        End With
        Frame1.Visible = False
    mrc.Close
    TextDcolor
    Text1(4).Visible = True
    Combo1.Visible = True
    Text1(2).Enabled = False
    Text1(3).Enabled = False
    Text1(7).Enabled = False
    Text1(8).Enabled = False
End Sub

Private Sub Command3_Click(Index As Integer)
    Dim txtSQL As String
    Dim j As Integer
    For i = 0 To 7
        If i <> 4 Then
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Text1(i).SetFocus
                Exit Sub
            End If
        Else
            If Text1(i) = Label2(i).Caption Then
                MsgBox "请" & Label2(i).Caption & "!", vbOKOnly, "提示"
                Combo1.SetFocus
                Exit Sub
            End If
        End If
    Next
    If IsDate(Text1(3)) = 1 Then
        MsgBox "出生日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
        Text1(3).SetFocus
        Exit Sub
    End If
    If IsDate(Text1(6)) = 1 Then
        MsgBox "入学日期应为日期格式(yyyy-mm-dd)!", vbOKOnly, "警告"
        Text1(6).SetFocus
        Exit Sub
    End If
    txtSQL = "delete from student_Form where student_NO='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
   
    txtSQL = "select * from student_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0))
    mrc.Fields(1) = Trim(Text1(1))
    mrc.Fields(2) = Trim(Text1(2))
    mrc.Fields(3) = Trim(Text1(3))
    mrc.Fields(4) = Trim(Text1(4))
    mrc.Fields(5) = Trim(Text1(5))
    mrc.Fields(6) = Trim(Text1(6))
    mrc.Fields(7) = Trim(Text1(7))
    mrc.Fields(8) = Trim(Text1(8))
    mrc.Fields(9) = Trim(Text1(9))
    mrc.Fields(10) = Trim(Text1(10))
    mrc.Fields(11) = Trim(Text1(11))
    mrc.Fields(12) = Trim(Text1(12))
    mrc.Fields(13) = Trim(Text1(13))
    mrc.Fields(14) = Trim(Text1(14))
    mrc.Fields(15) = Trim(Text1(15))
    mrc.Fields(16) = Trim(Text1(16))
    mrc.Fields(17) = Trim(Text1(17))
    mrc.Fields(18) = Trim(Text1(18))
    mrc.Fields(19) = Trim(Text1(19))
    mrc.Fields(20) = Trim(Text1(20))
    mrc.Fields(21) = Trim(Text1(21))
    mrc.Fields(22) = Trim(Text1(22))
    mrc.Fields(23) = Trim(Text1(23))
    mrc.Fields(24) = Trim(Text1(24))
    If Text1(25) = Label2(25).Caption Then
        mrc.Fields(25) = "0"
    Else
    mrc.Fields(25) = Trim(Text1(25))
    End If
    If Text1(26) = Label2(26).Caption Then
        mrc.Fields(26) = "0"
    Else
    mrc.Fields(26) = Trim(Text1(26))
    End If
    If Text1(27) = Label2(27).Caption Then
        mrc.Fields(27) = "0"
    Else
    mrc.Fields(27) = Trim(Text1(27))
    End If
    If Text1(28) = Label2(28).Caption Then
        mrc.Fields(28) = "0"
    Else
    mrc.Fields(28) = Trim(Text1(28))
    End If
    If Text1(29) = Label2(29).Caption Then
        mrc.Fields(29) = "0"
    Else
    mrc.Fields(29) = Trim(Text1(29))
    End If
    If Text1(30) = Label2(30).Caption Then
        mrc.Fields(30) = "0"
    Else
        mrc.Fields(30) = Trim(Text1(30))
    End If
    If Text1(30) = Label2(30).Caption Then
        mrc.Fields(30) = ""
    Else
        mrc.Fields(30) = Trim(Text1(30))
    End If
    mrc.Update
    mrc.Close
    MsgBox "学籍信息修改成功!", vbOKOnly, "提示"
    j = 0
    For i = 1 To MSFlexGrid1.Rows - 1
        If MSFlexGrid1.TextMatrix(i, 0) = Text1(0) Then
            j = i
        End If
    Next
    If j <> 0 Then
        MSFlexGrid1.TextMatrix(j, 0) = Trim(Text1(0))
        MSFlexGrid1.TextMatrix(j, 1) = Trim(Text1(1))
        MSFlexGrid1.TextMatrix(j, 2) = Trim(Text1(2))
        MSFlexGrid1.TextMatrix(j, 3) = Trim(Text1(3))
        MSFlexGrid1.TextMatrix(j, 4) = Trim(Text1(4))
        MSFlexGrid1.TextMatrix(j, 5) = Trim(Text1(5))
        MSFlexGrid1.TextMatrix(j, 6) = Trim(Text1(6))
        MSFlexGrid1.TextMatrix(j, 7) = Trim(Text1(7))
        MSFlexGrid1.TextMatrix(j, 8) = Trim(Text1(8))
        MSFlexGrid1.TextMatrix(j, 9) = Trim(Text1(9))
        MSFlexGrid1.TextMatrix(j, 10) = Trim(Text1(10))
        MSFlexGrid1.TextMatrix(j, 11) = Trim(Text1(11))
        MSFlexGrid1.TextMatrix(j, 12) = Trim(Text1(12))
        MSFlexGrid1.TextMatrix(j, 13) = Trim(Text1(13))
        MSFlexGrid1.TextMatrix(j, 14) = Trim(Text1(14))
        MSFlexGrid1.TextMatrix(j, 15) = Trim(Text1(15))
        MSFlexGrid1.TextMatrix(j, 16) = Trim(Text1(16))
        MSFlexGrid1.TextMatrix(j, 17) = Trim(Text1(17))
        MSFlexGrid1.TextMatrix(j, 18) = Trim(Text1(18))
        MSFlexGrid1.TextMatrix(j, 19) = Trim(Text1(19))
        MSFlexGrid1.TextMatrix(j, 20) = Trim(Text1(20))
        MSFlexGrid1.TextMatrix(j, 21) = Trim(Text1(21))
        MSFlexGrid1.TextMatrix(j, 22) = Trim(Text1(22))
        MSFlexGrid1.TextMatrix(j, 23) = Trim(Text1(23))
        MSFlexGrid1.TextMatrix(j, 24) = Trim(Text1(24))
        MSFlexGrid1.TextMatrix(j, 25) = Trim(Text1(25))
        MSFlexGrid1.TextMatrix(j, 26) = Trim(Text1(26))
        MSFlexGrid1.TextMatrix(j, 27) = Trim(Text1(27))
        MSFlexGrid1.TextMatrix(j, 28) = Trim(Text1(28))
        MSFlexGrid1.TextMatrix(j, 29) = Trim(Text1(29))
                
        If Text1(30) <> Label2(30).Caption Then
            MSFlexGrid1.TextMatrix(j, 30) = Trim(Text1(30))
        End If
    End If
    MSFlexGrid1.TopRow = j
    j = 0
    TextDcolor

End Sub

Private Sub Command4_Click()
    Dim txtSQL As String
    Dim j As Integer
 If MsgBox("要删除学籍记录?", vbYesNo + vbQuestion + vbDefaultButton2, "确认") = vbYes Then
        txtSQL = "delete from student_Form where student_NO='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    MsgBox "学籍信息已经删除!", vbOKOnly, "提示"
    j = 0
    For i = 1 To MSFlexGrid1.Rows - 1
        If MSFlexGrid1.TextMatrix(i, 0) = Text1(0) Then
            j = i
        End If
    Next
    If j <> 0 Then
        MSFlexGrid1.TextMatrix(j, 0) = "已删除"
        MSFlexGrid1.TextMatrix(j, 1) = "已删除"
        MSFlexGrid1.TextMatrix(j, 2) = "已删除"
        MSFlexGrid1.TextMatrix(j, 3) = "已删除"
        MSFlexGrid1.TextMatrix(j, 4) = "已删除"
        MSFlexGrid1.TextMatrix(j, 5) = "已删除"
        MSFlexGrid1.TextMatrix(j, 6) = "已删除"
        MSFlexGrid1.TextMatrix(j, 7) = "已删除"
        MSFlexGrid1.TextMatrix(j, 8) = "已删除"
    End If
    j = 0
    TextDcolor
    Text1(1).Enabled = False
    Text1(2).Enabled = False