📄 stud_entry.frm
字号:
Caption = "Division :"
BeginProperty Font
Name = "Palatino Linotype"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 5760
TabIndex = 16
Top = 3240
Width = 1425
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Branch:"
BeginProperty Font
Name = "Palatino Linotype"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 5760
TabIndex = 15
Top = 2040
Width = 1140
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Student Name :"
BeginProperty Font
Name = "Palatino Linotype"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 5760
TabIndex = 14
Top = 4440
Width = 2295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Roll No :"
BeginProperty Font
Name = "Palatino Linotype"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 5760
TabIndex = 0
Top = 3840
Width = 1290
End
End
Attribute VB_Name = "stud_entry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim branch, year, SQL1 As String
Dim division As Integer
Dim flag1, flag2 As Boolean
Dim flag, addflag, upflag As Boolean
Dim records, msgflag As Integer
Dim rs As New ADODB.Recordset
Dim db As New ADODB.Connection
Private Sub addr_txt_KeyPress(KeyAscii As Integer)
If (cmb_branch.Text = "" Or cmb_div.Text = "" Or cmb_year.Text = "" Or roll_txt = "" Or name_txt.Text = "") Then KeyAscii = 0
End Sub
Private Sub cmb_div_Click()
division = cmb_div.Text
If (Not branch = vbNullString And Not year = vbNullString And Not division = 0) Then
If addflag = False Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_STUDENTRY WHERE SDIVISION=" & cmb_div.Text & " AND SYEAR='" & cmb_year.Text & "'", db, adOpenKeyset, adLockPessimistic
CMD_NXT.Enabled = True
cmd_prev.Enabled = True
cmd_del.Enabled = True
cmd_add.Enabled = True
cmd_update.Enabled = True
cmdcancel.Visible = False
If Not rs.EOF Then
roll_txt.Text = rs.Fields(0)
name_txt.Text = rs.Fields(1)
addr_txt.Text = rs.Fields(5)
cont_txt.Text = rs.Fields(6)
End If
End If
End If
End Sub
Private Sub CMB_YEAR_Click()
year = cmb_year.Text
If (branch <> "" And year <> "" And division <> 0) Then
If addflag = False Then
Set rs = Nothing
rs.Open "SELECT * FROM ARS_STUDENTRY WHERE SDIVISION=" & division & " AND SYEAR='" & year & "'", db, adOpenKeyset, adLockPessimistic
CMD_NXT.Enabled = True
cmd_prev.Enabled = True
cmd_del.Enabled = True
cmd_add.Enabled = True
cmd_update.Enabled = True
cmdcancel.Visible = False
If Not rs.EOF Then
roll_txt.Text = rs.Fields(0)
name_txt.Text = rs.Fields(1)
addr_txt.Text = rs.Fields(5)
cont_txt.Text = rs.Fields(6)
End If
End If
End If
End Sub
Private Sub cmd_add_Click()
On Error GoTo msg
addflag = True
If flag = True Then
roll_txt.Locked = False
cmd_update.Enabled = False
cmd_del.Enabled = False
CMD_NXT.Enabled = False
cmd_prev.Enabled = False
name_txt.Text = ""
addr_txt.Text = ""
roll_txt.Text = ""
cont_txt.Text = ""
flag = False
cmdcancel.Visible = True
Else
If (Not name_txt.Text = "" And Not addr_txt.Text = "" And Not roll_txt.Text = "" And Not cont_txt.Text = "" And cmb_div.Text <> "" And cmb_branch.Text <> "") Then
On Error GoTo msg
Set rs = Nothing
rs.Open "SELECT * FROM ARS_STUDENTRY", db, adOpenKeyset, adLockPessimistic
While Not rs.EOF
If roll_txt.Text = rs.Fields(0) Then
MsgBox "Student Roll_No Must Be Unique", vbCritical, "Error Message"
roll_txt.Text = ""
GoTo msg1
End If
rs.MoveNext
Wend
name_txt.Text = UCase(name_txt.Text)
addr_txt.Text = UCase(addr_txt.Text)
'Set rs = Nothing
'rs.MoveLast
'SQL1 = "INSERT INTO ARS_STUDENTRY values(" & roll_txt.Text & ",'" & name_txt.Text & " ','" & CMB_BRANCH.Text & "','" & cmb_year.Text & "'," & cmb_div.Text & ",' " & addr_txt.Text & " '," & cont_txt.Text & " )"
'Set rs = db.Execute(SQL1)
'rs.MoveLast
rs.AddNew
rs(0) = CInt(roll_txt.Text)
rs(1) = Trim(UCase(name_txt.Text))
rs(2) = cmb_branch.Text
rs(3) = cmb_year.Text
rs(4) = cmb_div.Text
rs(5) = Trim(UCase(addr_txt.Text))
rs(6) = cont_txt.Text
rs.Update
rs.Fields.Refresh
'rs.AddNew 0, CInt(roll_txt.Text)
'rs.AddNew 1, Trim(UCase(name_txt.Text))
'rs.AddNew 2, CMB_BRANCH.Text
'rs.AddNew 3, cmb_year.Text
'rs.AddNew 4, cmb_div.Text
'rs.AddNew 5, Trim(UCase(addr_txt.Text))
'rs.AddNew 6, cont_txt.Text
MsgBox "Current Record Added Successfully!", vbOKOnly, "Record Added"
roll_txt.Locked = False
cmd_update.Enabled = True
cmd_del.Enabled = True
cmd_del.Visible = True
CMD_NXT.Enabled = True
cmd_prev.Enabled = True
cmdcancel.Visible = False
flag = True
addflag = False
Else
msg:
MsgBox "Please Fill All Record!", vbOKOnly, "Error Message"
End If
End If
msg1:
End Sub
Private Sub cmd_del_Click()
On Error GoTo msg
If (Not cmb_year.Text = "" And Not cmb_div.Text = "" And Not name_txt.Text = "" And Not addr_txt.Text = "" And Not roll_txt.Text = "" And Not cont_txt.Text = "") Then
msgflag = MsgBox("Are You sure To Delete Record!", vbYesNo, "Confirm Record Delete")
If msgflag = 6 Then
rs.Delete
rs.Fields.Refresh
name_txt.Text = ""
addr_txt.Text = ""
roll_txt.Text = ""
cont_txt.Text = ""
CMB_YEAR_Click
cmb_div_Click
End If
Else
msg:
MsgBox "No Record To Delete", vbCritical, "Error Message"
End If
End Sub
Private Sub cmd_exit_Click()
db.Close
Set rs = Nothing
Set db = Nothing
ARS_MDI.Enabled = True
Unload Me
End Sub
Private Sub cmd_nxt_Click()
On Error GoTo msg
If (cmb_year.Text <> "" And cmb_div.Text <> "" And name_txt.Text <> "" And addr_txt.Text <> "" And roll_txt.Text <> "" And cont_txt.Text <> "") Then
'If flag1 = False Then
rs.MoveNext
If Not (rs.EOF) Then
roll_txt.Text = rs.Fields(0)
name_txt.Text = rs.Fields(1)
addr_txt.Text = rs.Fields(5)
cont_txt.Text = rs.Fields(6)
'flag2 = False
Else
rs.MoveLast
roll_txt.Text = rs.Fields(0)
name_txt.Text = rs.Fields(1)
addr_txt.Text = rs.Fields(5)
cont_txt.Text = rs.Fields(6)
'flag1 = True
MsgBox "At Last Record!", vbOKOnly
'flag2 = False
End If
Else
msg:
MsgBox "Please Fill All Record Or Select Record!", vbOKOnly, "Error Message"
End If
End Sub
Private Sub cmd_prev_Click()
On Error GoTo msg
If (cmb_year.Text <> "" And cmb_div.Text <> "" And name_txt.Text <> "" And addr_txt.Text <> "" And roll_txt.Text <> "" And cont_txt.Text <> "") Then
rs.MovePrevious
If Not (rs.BOF = True) Then
roll_txt.Text = rs.Fields(0)
name_txt.Text = rs.Fields(1)
addr_txt.Text = rs.Fields(5)
cont_txt.Text = rs.Fields(6)
Else
rs.MoveFirst
MsgBox "At First Record!", vbOKOnly
End If
Else
msg:
MsgBox "Please Fill All Record Or Select Record!", vbOKOnly, "Error Message"
End If
End Sub
Private Sub cmd_update_Click()
On Error GoTo msg
If (cmb_branch.Text <> "" And cmb_year.Text <> "" And cmb_div.Text <> "" And name_txt.Text <> "" And addr_txt.Text <> "" And roll_txt.Text <> "" And cont_txt.Text <> "") Then
rs.Fields.Refresh
name_txt.Text = UCase(name_txt.Text)
addr_txt.Text = UCase(addr_txt.Text)
rs.Update 0, CInt(roll_txt.Text)
rs.Update 1, Trim(UCase(name_txt.Text))
rs.Update 2, cmb_branch.Text
rs.Update 3, cmb_year.Text
rs.Update 4, cmb_div.Text
rs.Update 5, Trim(UCase(addr_txt.Text))
rs.Update 6, cont_txt.Text
rs.Fields.Refresh
MsgBox "Current Record Updated Successfully!", vbOKOnly, "Record Updated"
Else
msg:
MsgBox "Please Fill All Record Or Select Record!", vbOKOnly, "Error Message"
End If
End Sub
Private Sub CMDCANCEL_Click()
roll_txt.Locked = True
cmd_update.Enabled = True
cmd_del.Enabled = True
cmd_del.Visible = True
CMD_NXT.Enabled = True
cmd_prev.Enabled = True
cmdcancel.Enabled = False
cmdcancel.Visible = False
addflag = False
flag = True
roll_txt.Text = ""
name_txt.Text = ""
addr_txt.Text = ""
cont_txt.Text = ""
If (cmb_year.Text <> "" And cmb_div.Text <> "") Then
CMB_YEAR_Click
cmb_div_Click
End If
End Sub
Private Sub Combo1_Change()
End Sub
Private Sub cont_txt_KeyPress(KeyAscii As Integer)
On Error GoTo msg
If (cmb_branch.Text <> "" And cmb_div.Text <> "" And cmb_year.Text <> "" And roll_txt <> "" And name_txt.Text <> "" And addr_txt.Text <> "") Then
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
Else
msg:
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
branch = "COMPUTER"
cmb_branch.Text = branch
addflag = False
flag1 = False
flag2 = False
flag = True
cmdcancel.Visible = False
year = vbNullString
On Error GoTo err
GoTo ok
err:
MsgBox "Exception:Connection To Database Failed!!", vbOKOnly, "Error Message!"
ok:
db.Open "Provider=OraOLEDB.Oracle.1;Password=TIGER;Persist Security Info=True;User ID=SCOTT"
rs.Open "SELECT * FROM ARS_STUDENTRY", db, adOpenKeyset, adLockPessimistic
End Sub
Private Sub name_txt_KeyPress(KeyAscii As Integer)
If (cmb_branch.Text = "" Or cmb_div.Text = "" Or cmb_year.Text = "" Or roll_txt = "") Then KeyAscii = 0
End Sub
Private Sub roll_txt_KeyPress(KeyAscii As Integer)
On Error GoTo msg
If (cmb_branch.Text <> "" And cmb_div.Text <> "" And cmb_year.Text <> "") Then
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
Else
msg:
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -