module1.bas

毕业设计的学生成绩管理

Attribute VB_Name = "Module1"
Option Explicit
Public numUserType As Integer           '用户类型：系统管理员＝1，数据录入人员＝2，查询人员＝3
Public objCon As New ADODB.Connection   'ADO连接对象，整个系统用一个
Public Declare Function htmlhelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
Public Const HH_DISPLAY_INDEX = 2
Public Const HH_DISPLAY_TOC = 1
Public Const HH_DISPLAY_TOPIC = 0

Public Function fFindItemInCombo(ByRef objCombo As Object, ByVal strItem As String) As Integer      '在COMBO对象中查找项目，返回项目下标
    Dim numI As Integer
    For numI = 0 To objCombo.ListCount - 1
        If objCombo.List(numI) = strItem Then
            Exit For
        End If
    Next
    If numI = objCombo.ListCount Then
        fFindItemInCombo = 0        '未找到
    Else
        fFindItemInCombo = numI
    End If
End Function
Public Function fGetXm(ByVal strXh As String)   '根据学号查找姓名
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select xm From XSDAB Where xh='" & strXh & "'")
    If Not objRs.EOF Then
        fGetXm = Trim(objRs("xm"))
    Else
        fGetXm = ""
    End If
    objRs.Close
End Function
Public Function fGetXh(ByVal strXm As String)   '根据姓名查找学号
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select xh From XSDAB Where xm='" & strXm & "'")
    If Not objRs.EOF Then
        If objRs.RecordCount > 1 Then
            MsgBox "有重复的学生姓名，系统将取第一个记录。", , "系统信息"
        End If
        fGetXh = Trim(objRs("xh"))
    Else
        fGetXh = ""
    End If
    objRs.Close
End Function
Public Function fGetKcbh(ByVal Kcmc As String)  '根据课程名称查找课程编号
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select kcbh From KCMCB Where kcmc='" & Kcmc & "'")
    If Not objRs.EOF Then
        fGetKcbh = Trim(objRs("kcbh"))
    Else
        fGetKcbh = ""
    End If
    objRs.Close
End Function
Public Function fGetKcmc(ByVal Kcbh As String)  '根据课程编号查找课程名称
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select kcmc From KCMCB Where kcbh='" & Kcbh & "'")
    If Not objRs.EOF Then
        fGetKcmc = Trim(objRs("kcmc"))
    Else
        fGetKcmc = ""
    End If
    objRs.Close
End Function
Public Function fGetXbbh(ByVal Xbmc As String)  '根据系别名称查找系别编号
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select xbbh From XBMCB Where xbmc='" & Xbmc & "'")
    If Not objRs.EOF Then
        fGetXbbh = Trim(objRs("xbbh"))
    Else
        fGetXbbh = ""
    End If
    objRs.Close
End Function

Public Function fGetZybh(ByVal Zymc As String)  '根据专业名称查找专业编号
    Dim objRs As New ADODB.Recordset
    Set objRs = objCon.Execute("Select zybh From ZYMCB Where zymc='" & Zymc & "'")
    If Not objRs.EOF Then
        fGetZybh = Trim(objRs("zybh"))
    Else
        fGetZybh = ""
    End If
    objRs.Close
End Function

Public Function fSckcbmc(ByVal nj As String, ByVal Xbmc As String, ByVal Zymc As String, ByVal xq As String)    '根据年级、系别名称、专业名称和学期生成课程表名称
    Dim strTemp As String
    strTemp = "CJ" + Trim(nj)
    If Len(Trim(fGetXbbh(Xbmc))) = 1 Then    '形成课程表名
        strTemp = strTemp & "0" & Trim(fGetXbbh(Xbmc))
    Else
        strTemp = strTemp & Trim(fGetXbbh(Xbmc))
    End If
    If Len(Trim(fGetZybh(Zymc))) = 1 Then
        strTemp = strTemp & "0" & Trim(fGetZybh(Zymc))
    Else
        strTemp = strTemp & Trim(fGetZybh(Zymc))
    End If
    strTemp = strTemp & IIf(Len(Trim(xq)) = 1, "0" & Trim(xq), Trim(xq))
    fSckcbmc = strTemp
End Function

Public Sub pOpenProgressBar(ByVal strTitle As String, ByVal strMsg As String, ByVal numMax As Integer, ByRef objParent As Object)   '打开进度条窗口
    objParent.Enabled = False   '父窗口变为不可用
    Load frmProBar
    frmProBar.AutoRedraw = True
    frmProBar.Label1.Caption = strMsg
    frmProBar.Caption = strTitle
    frmProBar.ProgressBar1.Max = numMax '进度条最大值
    frmProBar.ProgressBar1.Min = 1      '进度条当前值
    frmProBar.Show
    frmProBar.Refresh
End Sub
Public Sub pCloseProgressBar(ByVal numMax As Integer, ByRef objParent As Object)    '关闭进度条窗口
    frmProBar.ProgressBar1.Value = numMax
    objParent.Enabled = True
    Unload frmProBar
End Sub
Public Sub pSetProgressBarValue(ByVal numCur As Integer)    '设置进度
    frmProBar.ProgressBar1.Value = numCur
End Sub


'***************************************************************************************
'  过程：Cell_Setup
'  功能：初始化显示成绩的Cell控件
'***************************************************************************************
Public Sub Cell_Setup(ByRef obj As Object)
    obj.DoResetContent
'   清除原有内容
    obj.EnablePopMenu = False
'   关闭右键菜单（快捷菜单）
    obj.PageLabelVisible = False
'   关闭工作表标签
    obj.SideLabelVisible = False
'   关闭行号列
    obj.TopLabelVisible = False
'   关闭列号行
    obj.ResizeWhenPasteNeed = False
    obj.DoSetDefaultFont 8, 0, "宋体"
    obj.Cols = 0
    obj.Rows = 0
End Sub