⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 subject_ass_form.frm

📁 Attendance Report System of student in Visual Basic and Oracle AS Backend
💻 FRM
📖 第 1 页 / 共 2 页
字号:
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim branch, year, SQL1 As String
Dim division, tid As Integer
Dim flag1, flag2 As Boolean
Dim flag, addflag As Boolean
Dim records, msgflag, i As Integer
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim db As New ADODB.Connection
Private Sub cmb_div_Click()
batch_frame.Visible = False
THCHK.Value = 0
PRCHK.Value = 0
batch_a.Value = 0
batch_b.Value = 0
batch_c.Value = 0
batch_d.Value = 0
division = Cmb_div.Text
If (branch <> "" And year <> "" And division <> 0) Then
If addflag = False Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_subassign WHERE  DIV=" & Cmb_div.Text & " AND YEAR='" & cmb_year.Text & "'", db, adOpenKeyset, adLockPessimistic
Cmb_id.Clear
THCHK.Value = 0
PRCHK.Value = 0
i = 0
While Not rs.EOF
Cmb_id.AddItem rs.Fields(3), i
rs.MoveNext
i = i + 1
Wend
End If
End If
End Sub
Private Sub Cmb_id_Click()
If addflag = True Then
Set rs1 = Nothing
Set rs = Nothing
rs.Open "SELECT * FROM ARS_TEACHENTRY WHERE TID=" & Cmb_id.Text & " ", db, adOpenKeyset, adLockPessimistic
Label4.Caption = UCase(rs.Fields(3))
Else
If Cmb_id.Text <> "" Then
sub_cmb.Clear
batch_frame.Visible = False
THCHK.Value = 0
PRCHK.Value = 0
batch_a.Value = 0
batch_b.Value = 0
batch_c.Value = 0
batch_d.Value = 0
sub_cmb.Clear
If Cmb_id.Text <> "" Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_SUBASSIGN WHERE DIV=" & Cmb_div.Text & " AND YEAR='" & cmb_year.Text & "' AND TID=" & Cmb_id.Text & " ", db, adOpenKeyset, adLockPessimistic
i = 0
'rs.MoveFirst
While Not rs.EOF
sub_cmb.AddItem rs.Fields(4), i
i = i + 1
rs.MoveNext
Wend
End If
Else
MsgBox " Add Teacher To Assign Subject", vbInformation, "Message"
End If
End If
If Cmb_id.Text <> "" Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_TEACHENTRY WHERE TID=" & Cmb_id.Text & " ", db, adOpenKeyset, adLockPessimistic
Label4.Caption = UCase(rs.Fields(3))
End If

End Sub

Private Sub Cmb_id_KeyPress(KeyAscii As Integer)
If (KeyAscii <> 8) Then
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then
KeyAscii = 0
MsgBox "Only Numeric Data!", vbOKOnly, "Error Message"
End If
End If
End Sub

Private Sub CMB_YEAR_Click()
sub_cmb.Clear
batch_frame.Visible = False
THCHK.Value = 0
PRCHK.Value = 0
batch_a.Value = 0
batch_b.Value = 0
batch_c.Value = 0
batch_d.Value = 0
year = cmb_year.Text
If (branch <> "" And year <> "" And division <> 0) Then
If addflag = True Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_TEACHENTRY", db, adOpenKeyset, adLockPessimistic
i = 0
Cmb_id.Clear
THCHK.Value = 0
PRCHK.Value = 0
If Not rs.EOF Then
While Not rs.EOF
Cmb_id.AddItem rs.Fields(0), i
i = i + 1
rs.MoveNext
Wend
End If
End If
End If
End Sub

Private Sub cmb_year_LostFocus()
If (cmb_year.Text = "FE") Then
sub_cmb.AddItem "M1", 0
sub_cmb.AddItem "APP-SCI", 1
sub_cmb.AddItem "APP-MECH", 2
sub_cmb.AddItem "FEE", 3
sub_cmb.AddItem "GRAPHICS", 4
ElseIf (cmb_year.Text = "SE") Then

sub_cmb.AddItem "DS", 0
sub_cmb.AddItem "EDC", 1
sub_cmb.AddItem "DELD", 2
sub_cmb.AddItem "DSA", 3
sub_cmb.AddItem "FIM", 4
sub_cmb.AddItem "PL", 5
ElseIf (cmb_year.Text = "TE") Then

sub_cmb.AddItem "DSP", 0
sub_cmb.AddItem "DC", 1
sub_cmb.AddItem "RDBMS", 2
sub_cmb.AddItem "TCS", 3
sub_cmb.AddItem "MMC", 4
Else
sub_cmb.AddItem "CN", 0
sub_cmb.AddItem "OS", 1
sub_cmb.AddItem "UNIX", 2
sub_cmb.AddItem "S/W-ENGG", 3
sub_cmb.AddItem "PROJECT", 4
End If

End Sub

Private Sub cmdAdd_Click()
If addflag = False Then
        
        Set rs1 = Nothing
        Set rs = Nothing



            addflag = True
            Command1.Visible = False
             cmdcancel.Visible = True
            batch_frame.Visible = False
            cmb_year.Text = ""
            Cmb_id.Text = ""
            sub_cmb.Text = ""
            Label4.Caption = ""
            THCHK.Value = 0
            PRCHK.Value = 0
            batch_a.Value = 0
            batch_b.Value = 0
            batch_c.Value = 0
            batch_d.Value = 0
            Cmb_div.Text = ""
            rs.Open "SELECT * FROM ARS_TEACHENTRY", db, adOpenKeyset, adLockPessimistic
    
            i = 0
            While Not rs.EOF
                    Cmb_id.AddItem rs.Fields(0), i
                    rs.MoveNext
                    i = i + 1
            Wend

Else

            Command1.Visible = True
            If (Not cmb_year.Text = "" And Not Cmb_div.Text = "" And Not Cmb_id.Text = "" And (THCHK.Value = 1 Or PRCHK.Value = 1)) Then

                    Set rs = Nothing
                    rs.Open "SELECT * FROM ARS_SUBASSIGN ", db, adOpenKeyset, adLockPessimistic

                    While Not rs.EOF

                                        If (rs.Fields(1) = cmb_year.Text And rs.Fields(2) = Cmb_div.Text And rs.Fields(4) = sub_cmb.Text) Then

                                        If rs.Fields(5) = THCHK.Value And THCHK.Value = 1 Then GoTo msg


                                        If rs.Fields(6) = PRCHK.Value And PRCHK.Value = 1 Then

                                                If (rs.Fields(7) = batch_a.Value And batch_a.Value = 1) Or (rs.Fields(8) = batch_b.Value And batch_b.Value = 1) Or (rs.Fields(9) = batch_c.Value And batch_c.Value = 1) Or (rs.Fields(10) = batch_d.Value And batch_d.Value = 1) Then GoTo msg
                                        
                                        End If
                                        
                                        End If
                        rs.MoveNext
                    Wend




            addflag = False
            cmdcancel.Visible = False
            Set rs1 = Nothing
            rs1.Open "SELECT * FROM ARS_subassign", db, adOpenKeyset, adLockPessimistic
            rs1.AddNew


            rs1(0) = Trim(UCase(cmb_branch.Text))
            rs1(1) = Trim(UCase(cmb_year.Text))
            rs1(2) = CInt(Cmb_div.Text)
            rs1(3) = CInt(Cmb_id.Text)
            rs1(4) = Trim(sub_cmb.Text)
                        
                                           If (THCHK.Value = 1) Then
                                             rs1(5) = 1
                        
                                            Else
                                             rs1(5) = 0
                                           End If
                        
                        
                                            If (PRCHK.Value = 1) Then
                                                  rs1(6) = 1
                                            Else
                                                  rs1(6) = 0
                                            End If
                        
                        
                                  
                                             If (PRCHK.Value = 1) Then
                        
                                                  If (batch_a.Value = 1) Then
                                                     rs1(7) = 1
                                                  Else
                                                    rs1(7) = 0
                                                 End If
                         
                         
                                           If (batch_b.Value = 1) Then
                                               rs1(8) = 1
                                           Else
                                             rs1(8) = 0
                                           End If
                        
                        
                                              If (batch_c.Value = 1) Then
                                                 rs1(9) = 1
                                                 Else
                                                 rs1(9) = 0
                                              End If
                        
                        
                                             If (batch_d.Value = 1) Then
                                                 rs1(10) = 1
                                              Else
                                                  rs1(10) = 0
                                             End If
                                         
                                   End If





rs1.Update
rs1.Fields.Refresh
MsgBox "Current Record Added Successfully!", vbOKOnly, "Record Added"
Command1.Visible = True
flag = True
addflag = False
GoTo succ
Else
MsgBox "Please Fill All Record!", vbOKOnly, "Error Message"
GoTo succ
End If
msg:
MsgBox "This Subject Already Assign To Other Teacher", vbInformation, "Message"
End If
succ:
End Sub

Private Sub CMDCANCEL_Click()
cmb_year.Text = ""
            Cmb_id.Text = ""
            sub_cmb.Text = ""
            THCHK.Value = 0
            PRCHK.Value = 0
            batch_a.Value = 0
            batch_b.Value = 0
            batch_c.Value = 0
            batch_d.Value = 0
            Cmb_div.Text = ""
Command1.Visible = True
Command1.Enabled = True
cmdcancel.Visible = False
addflag = False
flag = True
If (Not cmb_year.Text = "" And Not Cmb_div.Text = "" And Not Cmb_id = "" And Not sub_cmb.Text = "") Then
CMB_YEAR_Click
cmb_div_Click
Cmb_id_Click
sub_cmb_Click
End If
End Sub

Private Sub cmdExit_Click()
db.Close
Set rs = Nothing
ARS_MDI.Enabled = True
Unload Me
End
End Sub

Private Sub Command1_Click()
If (Not cmb_year.Text = "" And Not Cmb_div.Text = "" And Not Cmb_id.Text = "" And Not sub_cmb.Text = "") Then
    msgflag = MsgBox("Are You sure To Delete Record!", vbYesNo, "Confirm Record Delete")
    If (msgflag = 6) Then
            rs1.MoveFirst
                i = 4
            While Not rs1.EOF

                    If (rs1.Fields(i) = sub_cmb.Text And rs1.Fields(i + 1) = THCHK.Value Or rs1.Fields(i + 2) = PRCHK.Value) Then
                        rs1.Delete
                        rs1.Fields.Refresh
                        cmb_year.Text = ""
                        Cmb_div.Text = ""
                        Cmb_id.Text = ""
                        Label4.Caption = ""
                        sub_cmb.Text = ""
                        THCHK.Value = 0
                        PRCHK.Value = 0
                        MsgBox "Record Deleted Sucessfully! ", vbInformation, "Message"
                        rs1.Fields.Refresh
                        Exit Sub
                    End If
           rs1.MoveNext
           Wend
    End If
Else
MsgBox "No Record To Delete", vbCritical, "Error Message"
End If
End Sub


Private Sub Form_Load()
cmdcancel.Visible = False
batch_frame.Visible = False
i = 0
branch = "COMPUTER"
cmb_branch.Text = branch
addflag = False
flag1 = False
flag2 = False
flag = True
division = 1
year = vbNullString
On Error GoTo err
GoTo ok
err:
MsgBox "Exception:Connection To Database Failed!!", vbOKOnly, "Error Message!"
ok:
db.Open "uid=scott;pwd=tiger;dsn=ars"
rs1.Open "SELECT * FROM ARS_TEACHENTRY", db, adOpenKeyset, adLockPessimistic
Cmb_div.Clear
Cmb_div.AddItem 1, 0
Cmb_div.AddItem 2, 1
If Not rs1.EOF Or Not rs1.BOF Then cmb_branch.Text = rs1.Fields(2)
End Sub







Private Sub sub_cmb_Click()
If Cmb_id.Text <> "" And cmb_year.Text <> "" And Cmb_div.Text <> "" Then
batch_frame.Visible = False
THCHK.Value = 0
PRCHK.Value = 0
batch_a.Value = 0
batch_b.Value = 0
batch_c.Value = 0
batch_d.Value = 0
If sub_cmb.Text <> "" Then
'rs.MoveFirst
Set rs1 = Nothing
rs1.Open "SELECT * FROM ARS_SUBASSIGN  WHERE TID= " & Cmb_id.Text & "  and DIV=" & Cmb_div.Text & " ", db, adOpenKeyset, adLockPessimistic
i = 0
'" & Cmb_id.Text & "  and YEAR= ' " & cmb_year.Text & " ' AND
While Not rs1.EOF

If (rs1.Fields(4) = sub_cmb.Text) Then
If rs1.Fields(5) <> 0 Then
THCHK.Value = 1
End If
If rs1.Fields(6) <> 0 Then
PRCHK.Value = 1
batch_frame.Visible = True
    If rs1.Fields(7) <> 0 Then
        batch_a.Value = 1
    End If
    
    If rs1.Fields(8) <> 0 Then
        batch_b.Value = 1
    End If
    
    If rs1.Fields(9) <> 0 Then
        batch_c.Value = 1
    End If


    If rs1.Fields(10) <> 0 Then
        batch_d.Value = 1
    End If


End If

End If
rs1.MoveNext
i = i + 1
Wend
End If
Else

MsgBox "Please Select All Fields", vbInformation, "Message"
End If
msg:

End Sub

Private Sub PRCHK_Click()
If PRCHK.Value = 1 Then
batch_frame.Visible = True
batch_a.Value = 0
batch_b.Value = 0
batch_c.Value = 0
batch_d.Value = 0
Else
batch_frame.Visible = False
End If

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -