form1.frm

学生 学籍 管理 系统

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()
Label2.Caption = "欢迎使用pp作品，购买完整源码请加QQ649462944,此源码+程序+论文68元,去除注册提示框,详细功能请使用己注册版的EXE文件"
XPFrame1.BackColor = RGB(84, 201, 134)
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