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

📄 stud_entry.frm

📁 Attendance Report System of student in Visual Basic and Oracle AS Backend
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      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 + -