📄 subject_ass_form.frm
字号:
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 + -