formkemugl.frm

学校考试成绩分析系统源码

VERSION 5.00
Object = "{4406B9AC-521E-476B-AF25-3D2C36110576}#3.0#0"; "CommandSCE.ocx"
Begin VB.Form FormKEMUGL 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "科目管理"
   ClientHeight    =   4260
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4365
   Icon            =   "FormKEMUGL.frx":0000
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4260
   ScaleWidth      =   4365
   StartUpPosition =   2  '屏幕中心
   Begin CSCommandSCE.CommandSCE CommandSCE4 
      Height          =   345
      Left            =   2880
      TabIndex        =   3
      Top             =   3720
      Width           =   1305
      _ExtentX        =   2302
      _ExtentY        =   609
      IconAlign       =   0
      Icon            =   "FormKEMUGL.frx":058A
      Caption         =   "关闭"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin CSCommandSCE.CommandSCE CommandSCE2 
      Height          =   345
      Left            =   2880
      TabIndex        =   2
      Top             =   660
      Width           =   1305
      _ExtentX        =   2302
      _ExtentY        =   609
      IconAlign       =   0
      Icon            =   "FormKEMUGL.frx":05A6
      Caption         =   "删除科目"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin CSCommandSCE.CommandSCE CommandSCE1 
      Height          =   345
      Left            =   2880
      TabIndex        =   1
      Top             =   60
      Width           =   1305
      _ExtentX        =   2302
      _ExtentY        =   609
      IconAlign       =   0
      Icon            =   "FormKEMUGL.frx":05C2
      Caption         =   "添加科目"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.ListBox List1 
      Height          =   4020
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   2475
   End
End
Attribute VB_Name = "FormKEMUGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub CommandSCE1_Click()    'ＡＤＤ
On Error GoTo ERg
Dim SQL, dbPath, MsgStr
dbPath = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.Open dbPath

MsgStr = InputBox("请输入欲添加的科目的名称:", "添加科目")

If MsgStr <> "" Then
    SQL = "ALTER TABLE 成绩 ADD COLUMN " & MsgStr & " TEXT(6) DEFAULT " & "/ NOT NULL"
    rs.Open SQL, Conn
    
    DoEvents
    SQL = "UPDATE 成绩 SET " & MsgStr & "= '/'"
    rs.Open SQL, Conn
    
    Form_Load  '刷新科目
    
    MsgBox MsgStr & " 科目已经添加!", , "OK"
End If
Exit Sub
ERg:
  If Err.Number = "-2147217887" Then MsgBox MsgStr & "科目字段已经存在", vbCritical
End Sub

Private Sub CommandSCE2_Click()    'DEL
If MsgBox(" 确认科目删除操作？(删除后无法恢复)", vbQuestion + vbYesNo, "提示") = vbYes Then
    Dim SQL, dbPath
    dbPath = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
    Dim Conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set Conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    Conn.Open dbPath

    SQL = "ALTER TABLE 成绩 DROP COLUMN " & List1.Text
    rs.Open SQL, Conn
    DoEvents

        Form_Load  '刷新科目
End If
End Sub


Private Sub CommandSCE4_Click()
Form1.FillCommboKEMU
Unload Me
End Sub

Private Sub Form_Load()
Dim SQL, dbPath
dbPath = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.Open dbPath
SQL = "SELECT top 1 * FROM 成绩"
rs.Open SQL, Conn

'========
Dim I
With List1
    .Clear
    For I = 5 To rs.Fields.Count - 1
      .AddItem rs.Fields(I).Name
    Next I
End With

CommandSCE2.Enabled = False
End Sub

Private Sub List1_Click()
If List1.Text <> "" Then
CommandSCE2.Enabled = True
Else
CommandSCE2.Enabled = False
End If
End Sub