class_info.frm

这是一个非常 好的一个程序进行体会一下学生管理系统

      BackColor       =   &H00FFC0C0&
      Caption         =   "课 程 描 述："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   2520
      Width           =   1575
   End
   Begin VB.Label Label6 
      BackColor       =   &H00FFC0C0&
      Caption         =   "权重系数："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   1800
      Width           =   1215
   End
   Begin VB.Label Label5 
      BackColor       =   &H00FFC0C0&
      Caption         =   "计划学时："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3240
      TabIndex        =   8
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label4 
      BackColor       =   &H00FFC0C0&
      Caption         =   "学  分："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5520
      TabIndex        =   6
      Top             =   360
      Width           =   975
   End
   Begin VB.Label Label3 
      BackColor       =   &H00FFC0C0&
      Caption         =   "课程类别："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFC0C0&
      Caption         =   "课程名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2520
      TabIndex        =   2
      Top             =   360
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "课程号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   1095
   End
End
Attribute VB_Name = "form12"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "RVB_UniqueId" ,"41FF01F00001"
Attribute VB_Ext_KEY = "RVB_ModelStereotype" ,"Form"
Public actiontype As Integer '定义类型变量，区分动作种类
Dim txtSQL As String
Private txtSQL1 As String   'ExecuteSQL 的 SQL语句参数
Dim mrc As ADODB.Recordset
Private mrc1 As ADODB.Recordset  '定义查询返回记录集
Dim inno As String '用来记录输入的学号
Dim i As Integer  '定义循环变量

Private Sub Command1_Click() '添加按钮
    actiontype = 1 '置类型变量为1，表明是执行添加操作
    mrc.AddNew
    Command1.Enabled = False '添加无效
    Command2.Enabled = False '修改无效
    Command3.Enabled = False '删除无效
    Command4.Enabled = True '保存有效
    Command8.Enabled = True '取消有效
    Call Blank_all
    Text1(0).SetFocus
End Sub

Private Sub Command10_Click() '“第一个”按钮
    mrc.MoveFirst
    Call Show_record
End Sub

Private Sub Command11_Click() '“最后一个”按钮
    mrc.MoveLast
    Call Show_record
End Sub

Private Sub Command2_Click() '修改按钮
    inno = InputBox("请输入你要修改的课程的课程号：（8位）", "注意") '输入要想修改的课程号
    If inno <> "" Then
        txtSQL1 = "select * from Cou_info where Cou_no=" & "'" & Trim(inno) & "'" '查询该学号对应的记录是否存在
        Set mrc1 = ExecuteSQL(txtSQL1, MsgText)   '执行查询，并将结果返回给mrc
        If mrc1.EOF Then                   '根据mrc1.EOF标志判断是否存在该记录
          MsgBox "该课程号不存在！", 0 + 48, "注意"
          Command2.SetFocus               '要求重新输入课程号
          mrc1.Close                       '关闭记录集
          Exit Sub
        Else
          mrc1.Close
          Command1.Enabled = False '添加无效
          Command2.Enabled = False '修改无效
          Command3.Enabled = False '删除无效
          Command4.Enabled = True '保存有效
          Command8.Enabled = True '取消有效
          mrc.MoveFirst     '将所查到的记录置为控件的当前记录
          Do While mrc.Fields(0) <> inno
                mrc.MoveNext
          Loop
          Call Blank_all
          Call Show_record
        End If
     End If
End Sub


Private Sub Command3_Click() '删除按钮
    inno = InputBox("请输入你要删除的课程信息的课程号：（8位）", "注意") '输入需要删除的课程号
    If inno <> "" Then  '在输入非空的情况下，进行查询
        txtSQL1 = "select * from Cou_info where Cou_no=" & "'" & Trim(inno) & "'"
        Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
        If mrc1.EOF Then    '如果输入的课程号不存在，给出提示
          MsgBox "该课程号不存在！", 0 + 48, "注意"
          Command3.SetFocus
          mrc1.Close
          Exit Sub
        End If
        mrc1.Close
        mrc.MoveFirst
        Do While mrc.Fields(0) <> inno  '置需要删除的记录为当前记录
            mrc.MoveNext
        Loop
        Call Show_record
        Dim re As Integer
        re = MsgBox("真的要删除该记录吗？", 4 + 32 + 256, "询问！")
        If re = 6 Then
          mrc.Delete '如果返回“是”，删除记录
          mrc.Requery
          If mrc.EOF Then '删除的是最后一个记录的情况
              MsgBox "数据库内已无记录！", 0 + 48, "注意！"
              Call Blank_all
              Command3.Enabled = False
              Command2.Enabled = False
              Command1.SetFocus
              Exit Sub
          Else:
              mrc.MoveFirst '置第一个记录为当前记录
              Call Show_record
          End If
        End If
    End If
End Sub

Private Sub Command4_Click()  '保存按钮
   If Text1(0).Text = "" Then
        MsgBox "请填写课程号！", 0 + 48, "注意！"
        Text1(0).SetFocus
        Exit Sub
   End If
   If Text1(1).Text = "" Then
        MsgBox "请填写课程名！", 0 + 48, "注意！"
        Text1(1).SetFocus
        Exit Sub
   End If
   If Combo1.Text = "" Then
        MsgBox "请选择课程类型！", 0 + 48, "注意！"
        Combo1.SetFocus
        Exit Sub
   End If
   If actiontype Then '如果之前执行的是添加操作，这判断课程号是否重复
        txtSQL1 = "select * from Cou_info where Cou_no=" & "'" & Text1(0).Text & "'"
        Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
        If Not mrc1.EOF Then
            MsgBox "课程号有重复，请重新输入！", 0 + 48 + 0, "注意"
            Text1(0).SetFocus
            mrc1.Close
            Exit Sub
        End If
        mrc1.Close
    End If
    Dim re As Integer
    re = MsgBox("真的要保存修改/添加吗？", 4 + 32, "请确认")  '确认是否保存
    If re = 6 Then
        Call WriteRecord    '将窗体上的信息登录到记录上
        mrc.Update '更新数据库
        actiontype = 0
        Call Initial_command    '初始化按钮
    End If
End Sub

Private Sub Command5_Click() '显示按钮
    If Combo2(0).Text = "" And Combo2(1).Text = "" Then
        MsgBox "请现设置查询条件！", 0 + 48, "注意！"
        Combo2(0).SetFocus
        Exit Sub
    End If
    If Combo2(0).Text <> "" And Combo2(1).Text <> "" Then
        txtSQL1 = "select Cou_no from Cou_info where Cou_no = " & "'" & Trim(Combo2(0).Text) & "'" & _
                 " and Cou_name = " & "'" & Trim(Combo2(1).Text) & "'"
        Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
        If mrc1.EOF Then
            MsgBox "没有符合条件的记录！", 0 + 48, "注意！"
            Combo2(0).SetFocus
            mrc1.Close
            Exit Sub
        End If
        mrc1.Close
    End If
    mrc.MoveFirst
    If Combo2(0).Text <> "" Then
        Do While Not mrc.EOF
            If mrc.Fields(0) = Trim(Combo2(0).Text) Then Exit Do
            mrc.MoveNext
        Loop
        If mrc.EOF Then
           MsgBox "没有符合条件的记录！", 0 + 48, "注意！"
           mrc.MoveFirst
           Call Show_record
           Exit Sub
        End If
        Call Show_record
    Else
        Do While Not mrc.EOF
            If mrc.Fields(1) = Combo2(1).Text Then Exit Do
            mrc.MoveNext
        Loop
        If mrc.EOF Then
           MsgBox "没有符合条件的记录！", 0 + 48, "注意！"
           mrc.MoveFirst
           Call Show_record
           Exit Sub
        End If
        Call Show_record
    End If
End Sub

Private Sub Command6_Click() '重置按钮
    Combo2(0).Text = ""
    Combo2(1).Text = ""
End Sub

Private Sub Command7_Click() '“上一个”按钮
    mrc.MovePrevious
    If mrc.BOF Then
        MsgBox "已到记录顶！", 0 + 48, "注意！"
        mrc.MoveFirst
    End If
    Call Show_record
End Sub

Private Sub Command8_Click() '取消按钮
    Call Initial_command
    If actiontype = 1 Then
        mrc.CancelUpdate
        actiontype = 0
    End If
    '数据库空的情况下无需做的操作
    If Not mrc.EOF Then
        mrc.Requery
        mrc.MoveFirst
        Call Show_record
    Else
        Command1.SetFocus
        Command2.Enabled = False
        Command3.Enabled = False
    End If
End Sub

Private Sub Command9_Click() '“下一个”按钮
    mrc.MoveNext
    If mrc.EOF Then
        MsgBox "已到记录底！", 0 + 48, "注意！"
        mrc.MoveLast
    End If
    Call Show_record
End Sub

Private Sub Form_Load()
    actiontype = 0 '初始化类型变量
    Call Initial_command
    txtSQL = "select * from Cou_info "
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "数据库内无记录！", 0 + 48, "注意！"
        Command3.Enabled = False
        Command2.Enabled = False
        Command1.TabIndex = 0
        Exit Sub
    End If
    While Not mrc.EOF '初始化查询中的课程名称combo控件
        Combo2(0).AddItem mrc.Fields(0)
        mrc.MoveNext
    Wend
    mrc.MoveFirst
    While Not mrc.EOF
        Combo2(1).AddItem mrc.Fields(1)
        mrc.MoveNext
    Wend
    mrc.MoveFirst
    Call Show_record
End Sub

Public Sub Initial_command() '定义过程初始化按钮
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = False
    Command8.Enabled = False
End Sub

Public Sub Blank_all() '定义过程使所有控件为空白
    For i = 0 To 7
        Text1(i).Text = ""
    Next i
    Combo1.Text = ""
    Combo3.Text = ""
End Sub

Public Sub Show_record() '定义过程将记录内容显示在控件上
    For i = 0 To 6
        If IsNull(mrc.Fields(i)) = False Then
            Text1(i).Text = mrc.Fields(i)
        End If
    Next i
    If IsNull(mrc.Fields(7)) = False Then
        Combo1.ListIndex = 1  'mrc.Fields(7)
    End If
    If mrc.Fields(8) = True Then
        Combo3.ListIndex = 0
    Else
        Combo3.ListIndex = 1
    End If
    If IsNull(mrc.Fields(9)) = False Then
        Text1(7).Text = mrc.Fields(9)
    End If
End Sub

Public Sub WriteRecord()  '定义过程将控件的内容写入记录
    For i = 0 To 6
        If Text1(i) <> "" Then
            mrc.Fields(i) = Trim(Text1(i).Text)
        End If
    Next i
    If Not IsNull(Combo1.Text) Then
        mrc.Fields(7) = Combo1.ListIndex
    End If
    If Combo3.Text = "是" Then
        mrc.Fields(8) = True
    Else
        If Combo3.Text = "否" Then
            mrc.Fields(8) = False
        End If
    End If
    If Not IsNull(Text1(7).Text) Then
        mrc.Fields(9) = Trim(Text1(7).Text)
    End If
End Sub