【文件属性】:
文件名称:用VB编写的学生学籍管理
文件大小:1.11MB
文件格式:RAR
更新时间:2011-12-24 08:32:24
用VB编写的学生学籍管理
Dim i, j, n As Integer
Dim sql As String
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Public je As Integer '记忆菜单上次数值,实现数据传送
Private Sub acg_Click()
Call asPopup7_Click(False)
End Sub
Private Sub addcg_Click()
Call asPopup6_Click(False)
End Sub
Private Sub addstudent_Click()
Call asPopup2_Click(False)
End Sub
Private Sub asPopup1_Click(Cancel As Boolean)
Grid1.Visible = True
Grid2.Visible = False
tkbase = "学生信息"
fnumber = 13
sql = "select * from " & tkbase
grid1pz '执行grid1的分配空间任务
datagrid '按要求读取数据空间
End Sub
Private Sub grid1pz()
Grid1.Cols = fnumber + 1
Grid1.Column(1).Width = 120
Grid1.Column(2).Width = 100
Grid1.Column(3).Width = 80
Grid1.Column(4).Width = 40
Grid1.Column(5).Width = 80
Grid1.Column(6).Width = 30
Grid1.Column(7).Width = 100
Grid1.Column(8).Width = 200
Grid1.Column(9).Width = 60
Grid1.Column(10).Width = 80
Grid1.Column(11).Width = 100
Grid1.Column(12).Width = 100
Grid1.Column(13).Width = 100
Grid1.Column(4).CellType = cellComboBox
Grid1.ComboBox(4).Clear
Grid1.ComboBox(4).AddItem "男"
Grid1.ComboBox(4).AddItem "女"
Grid1.Column(5).CellType = cellCalendar
Grid1.Column(1).Locked = True
End Sub
Private Sub asPopup2_Click(Cancel As Boolean)
Grid1.Visible = True
Grid2.Visible = False
tkbase = "学生信息"
fnumber = 13
Set qy1 = cnn.Execute("select * from " & tkbase)
grid1pz
For i = 1 To fnumber
Grid1.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
Grid1.Column(1).Locked = False
Grid1.Rows = 1
Grid1.Rows = 21
gridsave = True '允许保存
griddelete = False '拒绝删除
gridedit = False
End Sub
Private Sub asPopup3_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = Form2.hWnd
fo2.Alpha = 90 / 100 * 255
Me.WindowState = vbMinimized
Load Form2
Form2.Show 1
End Sub
Private Sub asPopup4_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = Form4.hWnd
fo2.Alpha = 90 / 100 * 255
Me.WindowState = vbMinimized
Load Form4
Form4.Show 1
End Sub
Private Sub asPopup5_Click(Cancel As Boolean)
MsgBox "非完整源码不可查询!"
End Sub
Private Sub asPopup6_Click(Cancel As Boolean)
Grid1.Visible = False
Grid2.Visible = True
tkbase = "学生与课程"
fnumber = 5
gridpz2
Set qy1 = cnn.Execute("select * from " & tkbase)
For i = 1 To fnumber
Grid2.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
Grid2.Rows = 1
Grid2.Rows = 21
gridsave = True
gridedit = False
griddel = False
Grid2.Column(1).Locked = False
Grid2.Column(2).Locked = False
Grid2.Column(3).Locked = False
End Sub
Private Sub asPopup7_Click(Cancel As Boolean)
Grid1.Visible = False
Grid2.Visible = True
tkbase = "学生与课程"
fnumber = 5
sql = "select * from " & tkbase
gridpz2
datagrid
gridsave = False
gridedit = True
griddel = True
Grid2.Column(1).Locked = True
Grid2.Column(2).Locked = True
Grid2.Column(3).Locked = True
End Sub
Private Sub gridpz2()
Grid2.Cols = 7
Grid2.Column(1).CellType = cellComboBox
Set qy1 = cnn.Execute("select 课程号 from 课程")
Grid2.ComboBox(1).Clear
Do While Not qy1.EOF
Grid2.ComboBox(1).AddItem qy1.Fields(0)
qy1.MoveNext
Loop
Grid2.Column(2).CellType = cellComboBox
Set qy1 = cnn.Execute("select 课程名称 from 课程")
Grid2.ComboBox(2).Clear
Do While Not qy1.EOF
Grid2.ComboBox(2).AddItem qy1.Fields(0)
qy1.MoveNext
Loop
End Sub
Private Sub asPopup9_Click(Cancel As Boolean)
End
End Sub
Private Sub c1_Click(Index As Integer) '提交内容到函数执行,4为当前菜单(0-4),index是按钮数组名称
cmove 4, Index
End Sub
Private Sub cmove(s As Integer, i As Integer) '菜单智能移动函数代码
Dim j As Integer
Dim X, Y, z, x1, y1 As Integer
X = s
Y = s
z = s
x1 = s
j = 0
Do While s > 0
If je > i Then
Do While X > i
Do While Y >= X
j = j + 360
Y = Y - 1
Loop
c1(X).Top = Fre1.Height - j
X = X - 1
Loop
Else
'-----------------向上代码
For X = 0 To i
For Y = 0 To X
j = j + 360
Next
c1(X).Top = j - 360
j = 0
Next
End If
s = s - 1
For y1 = 0 To x1
If y1 = i Then
Fre2(y1).Visible = True
Fre2(y1).Top = c1(y1).Top + c1(y1).Height
If y1 <> z Then
Fre2(y1).Height = c1(y1 + 1).Top - Fre2(y1).Top
Else
Fre2(y1).Height = Fre1.Height - c1(y1).Top - c1(y1).Height
End If
Else
Fre2(y1).Visible = False
End If
Next
Loop
je = i
End Sub
Private Sub cgdel_Click()
Call XPButton6_Click
End Sub
Private Sub cgedit_Click()
Call XPButton4_Click
End Sub
Private Sub delstudent_Click()
Call XPButton6_Click
End Sub
Private Sub editstudent_Click()
Call XPButton4_Click
End Sub
Private Sub findcg_Click()
If hang = 0 Then
Exit Sub
End If
Grid1.Visible = False
Grid2.Visible = True
tkbase = "学生与课程"
fnumber = 5
sql = "select * from 学生与课程 where 学号='" & Grid1.Cell(hang, 1).Text & "'"
gridpz2
datagrid
gridsave = False
gridedit = True
griddel = True
Grid2.Column(1).Locked = True
Grid2.Column(2).Locked = True
Grid2.Column(3).Locked = True
End Sub
Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu student
End If
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
If gridsave = True And Col = 5 Then '确认默认年龄在20岁左右
If Row <> 0 Then
Grid1.Cell(Row, 5).Text = Date - 7300
End If
End If
End Sub
Private Sub Grid1_Validate(Cancel As Boolean) '设定TAB键切换
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub Form_Load()
form1.BackColor = RGB(168, 217, 189)
With Grid1
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(84, 201, 134)
.BackColorFixedSel = RGB(84, 201, 134)
.BackColorBkg = RGB(198, 229, 211)
.BackColorScrollBar = RGB(198, 229, 211)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(198, 229, 211)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
End With
With Grid2
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(84, 201, 134)
.BackColorFixedSel = RGB(84, 201, 134)
.BackColorBkg = RGB(198, 229, 211)
.BackColorScrollBar = RGB(198, 229, 211)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(198, 229, 211)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
End With
je = 4
Dim fr As Integer
Fre1.BackColor = RGB(168, 217, 189)
For fr = 0 To 4
Fre2(fr).Visible = False
Fre2(fr).BackColor = RGB(168, 217, 189)
Next
Grid2.Visible = False
Call c1_Click(0)
End Sub
Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
MsgBox "非完整源码不支持鼠标右键!"
End If
End Sub
Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub
Private Sub datagrid()
griddelete = True '允许删除
gridedit = True
If tkbase = "学生信息" Then
If qy1.State = adStateOpen Then '表状态
qy1.Close
End If
qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText
For i = 1 To fnumber
Grid1.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
qy1.PageSize = 20
nnum = qy1.PageCount
If qy1.PageCount = 0 Then
nnum = 1
End If
numpage = 1
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
Grid1.Rows = 1
Grid1.Rows = 21
If qy1.RecordCount = 0 Then
Exit Sub
End If
qy1.AbsolutePage = numpage
For i = 1 To qy1.PageSize '设定读取行
For j = 1 To fnumber '设定读取列
If qy1.EOF = True Then
Exit Sub
End If
If qy1.Fields(j - 1) <> noNull Then '空值的处理
Grid1.Cell(i, j).Text = qy1.Fields(j - 1)
Else
Grid1.Cell(i, j).Text = ""
End If
Next
If qy1.EOF = False Then
qy1.MoveNext '读取下一记录
Else
Exit Sub
End If
Next
ElseIf tkbase = "学生与课程" Then
If qy1.State = adStateOpen Then '表状态
qy1.Close
End If
qy1.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText
For i = 1 To fnumber
Grid2.Cell(0, i).Text = qy1.Fields(i - 1).Name
Next
qy1.PageSize = 20
nnum = qy1.PageCount
If qy1.PageCount = 0 Then
nnum = 1
End If
numpage = 1
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
Grid2.Rows = 1
Grid2.Rows = 21
If qy1.RecordCount = 0 Then
Exit Sub
End If
qy1.AbsolutePage = numpage
For i = 1 To qy1.PageSize '设定读取行
For j = 1 To fnumber '设定读取列
If qy1.EOF = True Then
Exit Sub
End If
If qy1.Fields(j - 1) <> noNull Then '空值的处理
Grid2.Cell(i, j).Text = qy1.Fields(j - 1)
Else
Grid2.Cell(i, j).Text = ""
End If
Next
If qy1.EOF = False Then
qy1.MoveNext '读取下一记录
Else
Exit Sub
End If
Next
End If
End Sub
Private Sub Grid2_Validate(Cancel As Boolean)
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub renovate_Click()
Call asPopup1_Click(False)
End Sub
Private Sub returncg_Click()
Grid1.Visible = True
Grid2.Visible = False
End Sub
Private Sub savestudent_Click()
Call XPButton5_Click
End Sub
Private Sub XPButton1_Click()
MsgBox "非完整源码只可显示20条记录!"
End Sub
Private Sub XPButton2_Click()
MsgBox "非完整源码只可显示20条记录!"
End Sub
Private Sub XPButton4_Click()
If gridedit = False Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
End Sub
Private Sub XPButton5_Click()
If tkbase = "" Then
MsgBox "表指向不明,请确认", vbInformation, "提示"
Exit Sub
End If
If gridsave = False Then
MsgBox "当前不允许保存!", vbInformation, "提示"
Exit Sub
End If
Select Case tkbase
Case "学生信息"
For i = 1 To 20 '处理重名数据
If Grid1.Cell(i, 1).Text <> "" Then
Set qy1 = cnn.Execute("select 学号 from 学生信息 where 学号='" & Grid1.Cell(i, 1).Text & "'")
If qy1.EOF = False Then
MsgBox "第" & i & "行的学号在数据库里出现重复,请检查", vbInformation, "错误"
Grid1.Cell(i, 1).SetFocus
Exit Sub
End If
End If
Next
For i = 1 To 20
For n = 1 To fnumber
Select Case n
Case 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
If Grid1.Cell(i, 1).Text <> "" Then
If Grid1.Cell(i, n).Text = "" Then
MsgBox "第" & i & "行的--[" & Grid1.Cell(0, n).Text & "]--字段不允许为空!", vbInformation, "提示"
Grid1.Cell(i, n).SetFocus
Exit Sub
End If
End If
End Select
Next
If Grid1.Cell(i, 1).Text <> "" Then
sql = "insert into " & tkbase & " values('"
For j = 1 To fnumber - 1
sql = sql & Grid1.Cell(i, j).Text & "','"
Next
sql = sql & Grid1.Cell(i, fnumber).Text & "')"
Set qy1 = cnn.Execute(sql)
End If
Next
MsgBox "命令执行完毕!", vbInformation, "完成"
Grid1.Rows = 1
Grid1.Rows = 21
Case "学生与课程"
MsgBox "非完整源码不可保证学生与课程的记录!"
End Select
gridsave = False
griddelete = False '拒绝删除
gridedit = False
End Sub
Private Sub XPButton6_Click()
If griddelete = False Then
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
Select Case tkbase
Case "学生信息"
MsgBox "非完整源码不可修改!"
Case "学生与课程"
If Grid2.Cell(hang, 1).Text = "" Then
Exit Sub
End If
delok = MsgBox("确认删除" & Grid2.Cell(hang, 3).Text & "的<" & Grid2.Cell(hang, 2).Text & ">成绩吗??", vbQuestion + vbOKCancel, "注意:此操作将会将学生资料与成绩资料完全清除")
If delok = vbOK Then
sql = "delete from " & tkbase & " where 学号='" & Grid2.Cell(hang, 3).Text & "' and 课程号='" & Grid2.Cell(hang, 1).Text & "'"
Set qy1 = cnn.Execute(sql)
MsgBox "目标己删除完成!", , "提示"
End If
End Select
End Sub
Private Sub XPButton8_Click(Index As Integer)
Call findcg_Click
End Sub
【文件预览】:
学生学籍系统(ACCESS)
----学籍系统.vbp(1KB)
----base.mdb(696KB)
----Form1.log(9KB)
----Form1.frm(30KB)
----StoneXP.oca(83KB)
----as97Popup.ocx(75KB)
----Form4.log(2KB)
----工程1.vbp(645B)
----StoneXP.ocx(308KB)
----FlexCell.oca(80KB)
----MSSCCPRJ.SCC(339B)
----Form2.frm(9KB)
----学籍系统.vbw(349B)
----hand.cur(326B)
----Form1.frx(262KB)
----使用必看.txt(274B)
----Form3.frx(126KB)
----FlexCell.ocx(1.87MB)
----Thumbs.db(6KB)
----Form4.frm(8KB)
----学籍系统.PDM(5KB)
----工程1.vbw(52B)
----学籍系统.exe(992KB)
----as97Popup.oca(27KB)
----Form2.frx(66KB)
----Form3.frm(3KB)
----bas()
--------CTranslucent.cls(7KB)
--------accesscnn.bas(2KB)
--------bsdim.bas(440B)
--------ModAPIWindows.bas(2KB)
----Form2.log(2KB)
----Form4.frx(66KB)
----Fauxs-xp (oynx) v2 icon 02.ico(62KB)
网友评论
- 可以运行,不完整,不过还是很有参考价值。