frmqueryresult.frm

一个功能强大、程序条理分明的学生学籍管理系统

    Dim colRptDeatailLbl As New Collection
    
    '定义一个未知类型的对象变量
    Dim ctl As Object

    Dim iFldCount As Integer '记录集的字段个数
    Dim iPageLbl As Integer 'PageHeader中控件Label的个数
    Dim iPageTxt As Integer 'PageHeader中控件TextBox的个数
    Dim iDeatailLbl As Integer 'Deatail中控件Label的个数
    Dim iDeatailTxt As Integer 'Deatail中控件TextBox的个数
    
    Dim iLoop As Integer '用来控制循环次数的数值
    Dim i As Integer
    Dim iWidth As Integer '线的宽度
    iWidth = 0
    
    '定义一个记录集，如果想将Data Report的设计包装成为Dll组件
    '那么，可以提供一个属性接口，该属性定义为记录集对象类型
    Dim rsRpt As New ADODB.Recordset
    
    '如何能动态的传入数据源？——将控制报表的代码放到外部（即不要在Data Report
    '本身的Initialize事件里写这些操作数据报表的代码，即可在外部传递数据源了），
    '因为对Data Report细节区域的代码需要用到数据源，如果在Initialize事件里写了
    '代码，那么就必须相应的在该事件里有数据源，否则将出错。
    
    ' 提示：处理Data Report之前，一定要先设置数据源！！！！
    Set rsRpt = frmQueryResult.rsQueryResult
    Set temRpt.DataSource = rsRpt
    
    '添加了两个对象集合，分别是RptLabel和RptTextBox
    
    '遍历页眉区域的控件，然后根据类型将控件加入集合
    '其实设计阶段，页眉只放置了RptLabel控件，采用下面的写法是为了
    '使得代码具有更大的适应性、更灵活
    For Each ctl In temRpt.Sections("RptPageHeader").Controls
        Select Case TypeName(ctl)
            Case "RptLabel" '用这样的写法是为了有通用性
                ctl.Visible = False
                colRptPageLbl.Add ctl
            Case "RptTextBox"
                ctl.Visible = False
                ctl.CanGrow = True
                colRptPageTxt.Add ctl
        End Select
    Next ctl
    
    '分别计算集合中得到的控件的数量
    iPageLbl = colRptPageLbl.Count
    iPageTxt = colRptPageTxt.Count
    
    '遍历细节区域的控件，然后根据类型将控件加入集合
    '其实设计阶段，细节只放置了RptTextBox控件，采用下面的写法是为了
    '使得代码具有更大的适应性、更灵活
     For Each ctl In temRpt.Sections("RptDeatail").Controls
        Select Case TypeName(ctl)
            Case "RptLabel" '用这样的写法是为了有通用性
                ctl.Visible = False
                colRptDeatailLbl.Add ctl
            Case "RptTextBox"
                ctl.Visible = False
                ctl.CanGrow = True
                
                '将这些控件的DataField属性进行初始化，否则会出错
                '随后的代码将调整各个控件的DataField属性
                ctl.DataField = rsRpt.Fields(0).name
                colRptDeatailTxt.Add ctl
        End Select
    Next ctl
    
    '分别计算集合中得到的控件的数量
    iDeatailLbl = colRptDeatailLbl.Count
    iDeatailTxt = colRptDeatailTxt.Count
    '注意，在设计阶段，应该让PageHeader与Deatail的控件数量保持一样多
    
    '判断记录集中的记录数
    If Not (rsRpt.EOF And rsRpt.BOF) Then
        rsRpt.MoveFirst
        iFldCount = rsRpt.Fields.Count
    End If
    
    '先把循环次数设置为RptTextBox与RptLabel控件数量比较多的一个
    iLoop = IIf(iDeatailTxt > iDeatailLbl, iDeatailTxt, iDeatailLbl)
    
    '把循环次数设定为字段数与控件数之间小的那个，如果控件数量不够，则需要改动控件数目
    If iFldCount <= iLoop Then
        iLoop = iFldCount
    End If
    
    '这一次循环是为了设置页眉区域内每个RptLabel控件的标题
    For i = 1 To iLoop
        '该语句使得线的宽度基本上与可视控件总宽度一样
        iWidth = iWidth + colRptPageLbl(i).Width
        colRptPageLbl(i).Caption = rsRpt.Fields(i - 1).name
        colRptPageLbl(i).Alignment = rptJustifyCenter
        colRptPageLbl(i).Visible = True
    Next i
    
    '设置线的宽度
    temRpt.Sections("RptHeader").Controls("lineHeader").Width = iWidth
    
    '对数据源记录集进行遍历
    '分别设置每个TextBox的DataField属性，并调整其对其方式
    For i = 1 To iLoop
        colRptDeatailTxt(i).DataField = rsRpt.Fields(i - 1).name
        colRptDeatailTxt(i).Alignment = rptJustifyCenter
        colRptDeatailTxt(i).Visible = True
    Next i
    
    '在细节区域，没有必要自己去设置遍历记录集的循环，Data Report会自动列出
    '所有的记录数据
    'Do While Not rsRpt.EOF
    '    rsRpt.MoveNext
    'Loop

    '**********************************************************************
 
    '设置Data Report报表标题部分标题文本的字体、字号
    temRpt.Sections("RptHeader").Controls("lblRptHeader").Font.Size = 15
    temRpt.Sections("RptHeader").Controls("lblRptHeader").Font.name = "黑体"
    
    '设置Data Report的标题文本以及对齐方式
    temRpt.Sections("RptHeader").Controls("lblRptHeader").Caption = strHeader
    temRpt.Sections("RptHeader").Controls("lblRptHeader").Alignment = rptJustifyRight
    
    '设置Data Report报表标题部显示日期部分的字体、字号
    temRpt.Sections("RptHeader").Controls("lblRptNow").Font.Size = 12
    temRpt.Sections("RptHeader").Controls("lblRptNow").Font.name = "宋体"
    
    '利用预定放置控件，显示当前日期
    temRpt.Sections("RptHeader").Controls("lblrptNow").Caption = "%D"
    temRpt.Sections("RptHeader").Controls("lblrptNow").Alignment = rptJustifyRight
    
    '利用预定放置控件在页脚放置页数和总页数
    temRpt.Sections("RptPageFooter").Controls("lblPageFooter").Caption = "Page %p of %P"
    
    '显示报表
    temRpt.Show
    
    '将鼠标指针恢复原状
    '清空状态栏信息
    Screen.MousePointer = vbDefault
    frmMainMDI.staMainMdi.Panels(2).Text = vbNullString
    
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
    Screen.MousePointer = vbDefault
    frmMainMDI.staMainMdi.Panels(2).Text = vbNullString
End Sub

Private Sub cmdStudScore_Click()
    '定义变量，存放记录集中记录总数
    Dim iCount As Integer
    Dim iCol As Integer, iRow As Integer
    
    '定义变量用来存放学生的姓名
    Dim strStudName As String
    
    On Error GoTo err
    '如果查询结果记录集非空，那么调用“平均成绩”按钮，同时为几个变量赋值
    If Not (rsQueryResult.EOF And rsQueryResult.BOF) Then
        Call cmdAveScore_Click
        
        rsQueryResult.MoveLast
        rsQueryResult.MoveFirst
        strStudName = rsQueryResult("姓名")
        iCount = rsQueryResult.RecordCount
    End If
   
   '下面是关于MSChartScore控件的使用方法
   '在代码中将会比较详细的进行讲解。
    With MSChartScore
        'MSChart控件的ChartType属性，可以使得开发人员利用代码动态的
        '来改变控件的外观。控件的外观种类比较多，包括了饼状图、柱（条）状图
        '线性图、组合图形等等，而且还可以通过相关属性来调整二维图形外观和
        '三维图形外观。在这里，选用了二维的柱状图类型。
        .chartType = VtChChartType2dBar
        
        '定义控件要显示的函数和列数，其中列数和行数的概念不同与普通表的概念
        '在这里，这个列数指的是每行中的列数。关于这点，将在本节后面继续讲述
        .RowCount = iCount
        .ColumnCount = 1
        
        .AllowSeriesSelection = True
        .AllowSelections = True
                
        '在写入列标签文本的时候，需要指明是那个列。在多行和多列的情况下，如果
        '不指明行或列，。直接使用ColumnLabel，那么将会出现错误
        .Column = 1
        .ColumnLabel = "成绩" & Space(1)
        
        '将系列里的第一列颜色设置为绿色
        '分别改变边界的颜色和内部的填充颜色
        
        '在MSChart控件中，Plot是控件图形部分，一个控件的图形部分由系列（Series）组成
        .Plot.SeriesCollection(1).DataPoints(-1).EdgePen.VtColor.Set 0, 200, 0
        .Plot.SeriesCollection(1).DataPoints(-1).Brush.FillColor.Set 0, 200, 0

        '能够自己设置坐标的范围，需要先关闭自动缩放的功能
        .Plot.Axis(VtChAxisIdY).ValueScale.Auto = False
        .Plot.Axis(VtChAxisIdY).ValueScale.Minimum = 0
        .Plot.Axis(VtChAxisIdY).ValueScale.Maximum = 100
        
        .Plot.Axis(VtChAxisIdX).ValueScale.Auto = False
        '用来分割每个Series，使其宽度成为原来的1/2，取得合适的视觉效果
        .Plot.xGap = 2
        
        
        '不显示第二Y轴的刻度
        .Plot.Axis(VtChAxisIdY2).AxisScale.Hide = True
        '取消与X轴垂直显示的网格线
        .Plot.Axis(VtChAxisIdX).AxisGrid.MajorPen.Style = VtPenStyleNull
        '取消与y轴垂直显示的网格线
        .Plot.Axis(VtChAxisIdY).AxisGrid.MajorPen.Style = VtPenStyleNull
              
        '设置MSChart图表的标题，前后加上空格是为了确保文本能完整的显示
        .Title.Text = Space(2) & Trim$(strStudName) & "的平均成绩为：" & txtAveScore.Text & Space(2)
    End With
    
    '下面的代码段主要是为图表设定数据
    With MSChartScore
        For iCol = 1 To .ColumnCount
            For iRow = 1 To iCount
                .Column = iCol
                .Row = iRow
                '指定行、指定列，然后就可以确定图中的一个特定的柱体，为其设定数据
                .Data = rsQueryResult("成绩")
                '设定特定行的标签值
                .RowLabel = Trim$(rsQueryResult("课程名称")) & "：" & rsQueryResult("成绩")
                rsQueryResult.MoveNext
            Next iRow
        Next iCol
    End With
    
    '**************************************************************
    'MSChart控件的数据来源可以来自数组，此时要设定ChartData属性为数组；
    '数据来源也可以是数据库，设置MSChart的DataSource等属性
    '**************************************************************
    
    '设置好MSChart之后，转到页面上去
    sstabScore.Tab = 1
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub Form_Load()
    If sstabScore.Tab = 1 Then
        framOperGroup.Visible = False
    End If
    '增加子窗口数量
    frmMainMDI.WindowCreated
End Sub

Private Sub Form_Resize()
    On Error GoTo err
    Dim yHeight As Integer
    yHeight = frmQueryResult.ScaleHeight - framOperGroup.Height
    
    sstabScore.Height = frmQueryResult.ScaleHeight
    sstabScore.Width = frmQueryResult.ScaleWidth
    
    dgrQueryScore.Height = sstabScore.Height - 1.5 * framOperGroup.Height
    dgrQueryScore.Width = sstabScore.Width
    framOperGroup.Width = sstabScore.Width
    MSChartScore.Width = sstabScore.Width - 300
    MSChartScore.Top = sstabScore.Top + sstabScore.TabHeight + 100
    MSChartScore.Height = 0.7 * sstabScore.Height
    
    framOperGroup.Move 0, yHeight
    
    '确保窗体保持原始大小
    If frmQueryResult.ScaleWidth < 10050 Or frmQueryResult.ScaleHeight < 7000 Then
        frmQueryResult.Enabled = False
        frmQueryResult.Height = 8250
        frmQueryResult.Width = 10800
    End If
    frmQueryResult.Enabled = True
    Exit Sub
err:
    frmQueryResult.Enabled = True
    Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmMainMDI.WindowDestroyed
End Sub

Private Sub sstabScore_GotFocus()
    '定义两个局部的记录集对象
    Dim rsTempStud As ADODB.Recordset
    Dim rsTempCourse As ADODB.Recordset
    '定义SQL语句，用以获取记录集
    Dim strStudSql As String
    Dim strCourseSql As String
    
    strStudSql = rsQueryResult.source
    strCourseSql = strStudSql
    
    '两条SQL语句用来限定临时记录集中只含一个字段，该字段值不允许重复
    strStudSql = Replace(strStudSql, "*", "distinct 学号")
    strCourseSql = Replace(strCourseSql, "*", "distinct 课程代号")
    
    Set rsTempStud = GetRecordSet(strStudSql)
    
    Set rsTempCourse = GetRecordSet(strCourseSql)
    
    '判定含“学号”字段的记录集，如果记录集中只有一条记录的话，则是对某个
    '特定的学生执行了查询成绩的操作，此时“显示图表”按钮设置为可用，否则
    '就设定为不可用；同时，自动调用“平均成绩”按钮
    With rsTempStud
        If Not (.EOF And .BOF) Then
            .MoveLast
            .MoveFirst
            If .RecordCount = 1 Then
                cmdStudScore.Enabled = True
                Call cmdAveScore_Click
            Else
                cmdStudScore.Enabled = False
            End If
        End If
    End With
    
    '判定含“课程代号”字段的记录集，如果记录集中只有一条记录的话，则是对某个
    '特定的学科执行了查询成绩的操作，此时“比率图”按钮设置为可用，否则就设置
    '为不可用；同时，自动调用“平均成绩”按钮
    With rsTempCourse
        If Not (.EOF And .BOF) Then
            .MoveLast
            .MoveFirst
            If .RecordCount = 1 Then
                cmdAveCour.Enabled = True
                Call cmdAveScore_Click
            Else
                cmdAveCour.Enabled = False
            End If
        End If
    End With
    
    '使用完毕，设防被占用的资源
    rsTempStud.Close
    Set rsTempStud = Nothing
    rsTempCourse.Close
    Set rsTempCourse = Nothing
End Sub