开发实践教程1:试卷生成系统6.7 试卷生成(FormTestPaper)

Posted VB.Net

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了开发实践教程1:试卷生成系统6.7 试卷生成(FormTestPaper)相关的知识,希望对你有一定的参考价值。

版权声明:本文为博主原创文章,转载请在显著位置标明本文出处以及作者网名,未经作者允许不得用于商业目的。

提供功能:新建试卷、载入试卷、自动填充试卷、保存设计好的试卷、输出Word文档。

窗体设计如下:

 图1-17

在此窗体设计中可能遇到的问题:

1、随机选题

为了实现自动填充试卷题目,代码中使用了随机选题的方式,具体操作是在Sql语句最后加上“order by newid()”语句。当试卷中选择的题目不足时,datagridview中对应行的题目将保持空白。但是考虑可能可以从别的试卷类型选择题目,因此可以通过双击或弹出菜单来选题。

2、保存试卷

只有当试卷信息完善,考题数量和分数完善的情况下才能保存试卷。在保存试卷中可能会出现题目过多的情况,如果按照普通语句,100道题目,需要调用100次insert,但是VB.Net提供了 SqlBulkCopy 类,可以将DataTable批量保存到 SQL Server 中,大大提高效率。

首先定义一个 SqlBulkCopy类的实例:

        Dim sbc As New SqlBulkCopy(connection)

设置需要批量处理的行数:

        sbc.BatchSize = dt.Rows.Count

设置数据库中的表名:

        sbc.DestinationTableName = "用户试卷详表"

建立列映射,注意如果是自动增加的字段,不应建立映射:

        'sbc.ColumnMappings.Add("编号", "编号")   ---- 此字段为自动增加字段

        sbc.ColumnMappings.Add("试卷编号", "试卷编号")

        sbc.ColumnMappings.Add("题编号", "题编号")

        sbc.ColumnMappings.Add("题目序号", "题目序号")

        sbc.ColumnMappings.Add("分数", "分数")

进行批量保存数据:

        sbc.WriteToServer(dt)

关闭SqlBulkCopy类的实例:

        sbc.Close()

3、输出Word文档

由于需要将考题输出到Word文档,因此需要添加“Microsoft Word 14.0 Object Library”引用。注意:笔者的计算机上安装的是Office 2010,对应的Office COM对象是14.0版本),关于如何引用Office组件,请参看教程第21.1节《Office操作》。同时在代码最前面添加:

Imports Microsoft.Office.Interop

在代码中使用saveDoc()方法来输出Word文档,考虑到阅卷需要,输出一份试卷,一份答案。关于如何操作Word,请参看教程第21.3节《Word操作》

4、从数据库中读取并保存图片文件

由于题目中可能存在图片,在代码中使用savePic()方法来保存图片到临时文件夹,当Word文档输出完成后,删除临时文件夹中的图片。关于如何将数据库内的二进制数据输出到文件,请参看教程第19.4.6节《读写二进制数据》

具体代码如下:

Imports System.Data.SqlClient
Imports Microsoft.Office.Interop
Imports System.IO


Public Class FormTestPaper

    Public Enum paperState
        nooption = 0
        newpaper = 1
        load = 2
        edit = 3
    End Enum

    Dim connection As SqlConnection

    Public currentPaper As clsPaper

    Public addExamId As Integer

    Public currentPaperState As paperState

    Dim dgvCanResize As Boolean = False

    Const wordImgwidth As Integer = 120
    Const wordImgheight As Integer = 90

    Dim F_Main As FormMain

    Private lstScoreChangeRow As List(Of Integer)

    Private Sub FormTestPaper_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.WindowState = FormWindowState.Maximized
        connection = New SqlConnection(databaseConnString)
        connection.Open()

        currentPaper = New clsPaper(loginId)

        tsbInfo.Enabled = False
        tsbAuto.Enabled = False
        tsbSave.Enabled = False
        tsbOutput.Enabled = False


        dgvCanResize = True

        F_Main = Me.MdiParent

        lstScoreChangeRow = New List(Of Integer)
    End Sub

    Private Sub tsbCreate_Click(sender As Object, e As EventArgs) Handles tsbCreate.Click
        Dim fTestPaperInfo As New FormTestPaperInfo(0)
        fTestPaperInfo.ShowDialog(Me)

        If currentPaperState = paperState.nooption Then
            Exit Sub
        End If
        tsbInfo.Enabled = True

        dgv.Rows.Clear()

        Call showPaperStructure()

        tsbInfo.Enabled = True
        tsbAuto.Enabled = True
        tsbSave.Enabled = True
        tsbOutput.Enabled = True

        lstScoreChangeRow.Clear()
    End Sub


    Private Sub showPaperStructure()
        Dim SubjectTypes() As String
        SubjectTypes = currentPaper.SubjectTypeInfo.Split(";")
        Dim sql As String

        Dim command As New SqlCommand()
        command.Connection = connection

        Dim examID As Integer = 0

        Dim id As Integer = 0

        For i As Integer = 0 To SubjectTypes.Length - 2
            Dim examType As String
            Dim singleSubjectInfo() As String = SubjectTypes(i).Split(",")
            Dim sqlReader As SqlDataReader

            sql = "select 类型名称 from 题类型表 where 编号=" & singleSubjectInfo(0)
            command.CommandText = sql

            sqlReader = command.ExecuteReader(CommandBehavior.SingleResult)
            If sqlReader.HasRows Then
                sqlReader.Read()
                examType = sqlReader(0)
            Else
                examType = ""
            End If
            sqlReader.Close()

            Dim examTypeCount As Integer
            examTypeCount = CType(singleSubjectInfo(1), Integer)
            Dim examTypeScore As Single
            examTypeScore = CType(singleSubjectInfo(2), Single)

            For j As Integer = 0 To examTypeCount - 1
                id += 1

                Dim newRow As New DataGridViewRow()

                Dim newRowCell As New DataGridViewTextBoxCell                '
                newRowCell.Value = examID   '初始时为0
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = examID   '初始时为0
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = singleSubjectInfo(0)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = id
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = examType
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = examTypeScore
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = currentPaper.Typename
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = ""
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = ""
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = ""
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = ""
                newRow.Cells.Add(newRowCell)

                dgv.Rows.Add(newRow)
            Next
        Next

    End Sub


    Private Sub tsbAuto_Click(sender As Object, e As EventArgs) Handles tsbAuto.Click
        If dgv.Rows.Count < 1 Then
            MessageBox.Show("请先建立基本的试卷信息")
            Exit Sub
        End If

        Dim sql As String = ""
        Dim command As New SqlCommand()
        command.Connection = connection

        Dim SubjectTypes() As String
        SubjectTypes = currentPaper.SubjectTypeInfo.Split(";")

        Dim currentRowPos As Integer = 0

        Dim currentPaperPos As Integer = 0

        Dim currentTypeCount As Integer = 0



        For i As Integer = 0 To SubjectTypes.Length - 2
            Dim singleSubjectInfo() As String = SubjectTypes(i).Split(",")

            currentTypeCount = singleSubjectInfo(1)
            currentRowPos = currentPaperPos


            sql = "SELECT top " & singleSubjectInfo(1) & " 编号,题目,选项,答案,图片 " &
                  "FROM 题表 " &
                  "where (题类型=" & singleSubjectInfo(0) & ") and (考试类型=" & currentPaper.TypeIndex & ") order by newid()"
            command.CommandText = sql

            Dim sqlReader As SqlDataReader
            sqlReader = command.ExecuteReader()
            If sqlReader.HasRows Then

                Do While sqlReader.Read
                    dgv.Rows(currentRowPos).Cells(1).Value = sqlReader(0)
                    dgv.Rows(currentRowPos).Cells(7).Value = sqlReader(1)
                    dgv.Rows(currentRowPos).Cells(8).Value = sqlReader(2)
                    dgv.Rows(currentRowPos).Cells(9).Value = sqlReader(3)
                    dgv.Rows(currentRowPos).Cells(10).Value = sqlReader(4)

                    currentRowPos += 1
                Loop
            End If
            sqlReader.Close()

            currentPaperPos = currentPaperPos + currentTypeCount

        Next

    End Sub


    Private Sub tsbInfo_Click(sender As Object, e As EventArgs) Handles tsbInfo.Click

        Dim fTestPaperInfo As New FormTestPaperInfo(currentPaper.ID)
        fTestPaperInfo.ShowDialog(Me)

        If currentPaperState = paperState.edit Then
            dgv.Rows.Clear()

            Call showPaperStructure()
        End If
    End Sub

    Private Sub tsbLoad_Click(sender As Object, e As EventArgs) Handles tsbLoad.Click
        Dim fLoadTestPaper As New FormLoadTestPaper
        fLoadTestPaper.ShowDialog(Me)

        If currentPaperState = paperState.nooption Then
            Exit Sub
        End If

        tsbInfo.Enabled = True

        dgv.Rows.Clear()

        If currentPaper.isReady = "否" Then
            Call showPaperStructure()
        Else
            Call showPaperStructureAndData()
        End If

        tsbInfo.Enabled = True
        tsbAuto.Enabled = True
        tsbSave.Enabled = True
        tsbOutput.Enabled = True

        lstScoreChangeRow.Clear()
    End Sub

    Private Sub showPaperStructureAndData()
        Dim sql As String

        Dim command As New SqlCommand()
        command.Connection = connection

        Dim examID As Integer = 0

        Dim id As Integer = 0


        sql = "SELECT 用户试卷详表.题目序号, 用户试卷详表.分数, 题表.编号, 题表.题类型, 题类型表.类型名称, 考试类型表三级.类型名称, 题表.题目, 题表.选项, 题表.答案, 题表.图片
                    FROM ((用户试卷详表 INNER JOIN 题表 ON 用户试卷详表.题编号 = 题表.编号) 
                        INNER JOIN 题类型表 ON 题表.题类型 = 题类型表.编号) 
                        INNER JOIN 考试类型表三级 ON 题表.考试类型 = 考试类型表三级.编号
                   where 用户试卷详表.试卷编号=" & currentPaper.ID &
                  " order by 用户试卷详表.题目序号"


        command.CommandText = sql

        Dim sqlReader As SqlDataReader
        sqlReader = command.ExecuteReader()
        If sqlReader.HasRows Then
            Do While sqlReader.Read()

                Dim newRow As New DataGridViewRow()

                Dim newRowCell As New DataGridViewTextBoxCell                '
                newRowCell.Value = sqlReader(2)   '初始时为0
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(2)   '初始时为0
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(3)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(0)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(4)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(1)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(5)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(6)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(7)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(8)
                newRow.Cells.Add(newRowCell)

                newRowCell = New DataGridViewTextBoxCell
                newRowCell.Value = sqlReader(9)
                newRow.Cells.Add(newRowCell)

                dgv.Rows.Add(newRow)
            Loop

        Else

        End If
        sqlReader.Close()

    End Sub

    Private Sub dgv_Resize(sender As Object, e As EventArgs) Handles dgv.Resize
        If dgvCanResize = True Then dgv.Columns(7).Width = dgv.Width - 430

    End Sub

    Private Sub tsbSave_Click(sender As Object, e As EventArgs) Handles tsbSave.Click
        Dim errMsg As String
        errMsg = checkData()
        If errMsg <> "" Then
            MessageBox.Show(errMsg)
            Exit Sub
        End If

        F_Main.tsslInfo.Text = "保存数据中……"


        Dim sql As String
        Dim command As New SqlCommand()
        command.Connection = connection

        If currentPaper.isReady = "否" Then
            errMsg = savePaperData()
            If errMsg <> "" Then
                F_Main.tsslInfo.Text = "保存试卷题目时发生错误:" & errMsg
                Exit Sub
            End If

            sql = "update 用户试卷表 set 是否有效='是' where 编号=" & currentPaper.ID
            command.CommandText = sql
            command.ExecuteReader(CommandBehavior.SingleResult)

        Else
            If currentPaper.Author = loginId Then
                errMsg = updatePaperData()
                If errMsg <> "" Then
                    F_Main.tsslInfo.Text = "更新试卷题目时发生错误:" & errMsg
                    Exit Sub
                End If

            Else
                Dim tempcurrentPaper As New clsPaper()
                tempcurrentPaper = currentPaper
                tempcurrentPaper.ID = 0
                tempcurrentPaper.Author = loginId
                tempcurrentPaper.SaveTime = Now.ToString("yyyy-MM-dd HH:mm:ss")
                tempcurrentPaper.isReady = "否"

                Dim id As Integer = savePaperInfo(tempcurrentPaper)
                If id = 0 Then
                    F_Main.tsslInfo.Text = "保存数据出错"
                    Exit Sub
                End If
                tempcurrentPaper.ID = id

                errMsg = savePaperData()
                If errMsg <> "" Then
                    F_Main.tsslInfo.Text = "保存试卷题目时发生错误:" & errMsg
                    Exit Sub
                End If

                sql = "update 用户试卷表 set 是否有效='是' where 编号=" & tempcurrentPaper.ID
                command.CommandText = sql
                command.ExecuteReader(CommandBehavior.SingleResult)
                currentPaper = tempcurrentPaper

            End If
        End If

        If currentPaper.ID > 0 AndAlso lstScoreChangeRow.Count > 0 Then
            errMsg = updateScore()
            If errMsg <> "" Then
                F_Main.tsslInfo.Text = "修改分值时发生错误:" & errMsg
                Exit Sub
            End If
        End If

        currentPaper.isReady = "是"
        For i As Integer = 0 To dgv.Rows.Count - 1
            dgv.Rows(i).Cells(0).Value = dgv.Rows(i).Cells(1).Value
        Next

        F_Main.tsslInfo.Text = "保存完毕"
    End Sub

    Private Function checkData() As String
        For i As Integer = 0 To dgv.Rows.Count - 1
            If dgv.Rows(i).Cells(1).Value = 0 Then
                Return ("类型:" & dgv.Rows(i).Cells(4).Value & ControlChars.CrLf & "题目不全,请将题目补充完。")
            End If
        Next

        Dim count As Single
        For i As Integer = 0 To dgv.Rows.Count - 1
            count += dgv.Rows(i).Cells(5).Value
        Next
        If count <> currentPaper.TotalScore Then
            Return "分数不符合试卷设置"
        End If

        Return ""
    End Function

    Private Function savePaperData() As String
        Dim dt As New DataTable("用户试卷详表")
        dt.Columns.Add("编号", Type.GetType("System.Int32"))
        dt.Columns.Add("试卷编号", Type.GetType("System.Int32"))
        dt.Columns.Add("题编号", Type.GetType("System.Int32"))
        dt.Columns.Add("题目序号", Type.GetType("System.Int32"))
        dt.Columns.Add("分数", Type.GetType("System.Single"))


        For i As Integer = 0 To dgv.Rows.Count - 1
            Dim dtRow As DataRow = dt.NewRow
            dtRow(0) = 0 ' DBNull.Value
            dtRow(1) = currentPaper.ID
            dtRow(2) = dgv.Rows(i).Cells(1).Value
            dtRow(3) = dgv.Rows(i).Cells(3).Value
            dtRow(4) = dgv.Rows(i).Cells(5).Value

            dt.Rows.Add(dtRow)
        Next

        Dim sbc As New SqlBulkCopy(connection)
        Try
            sbc.BatchSize = dt.Rows.Count
            sbc.DestinationTableName = "用户试卷详表"
            sbc.ColumnMappings.Add("试卷编号", "试卷编号")
            sbc.ColumnMappings.Add("题编号", "题编号")
            sbc.ColumnMappings.Add("题目序号", "题目序号")
            sbc.ColumnMappings.Add("分数", "分数")
            sbc.WriteToServer(dt)
            sbc.Close()

            Return ""
        Catch ex As Exception
            Return ex.Message
        End Try

    End Function

    Private Function updateScore() As String
        Dim command As New SqlCommand()
        command.Connection = connection

        Dim sql As String
        Dim id As Integer
        Dim score As Single

        Try
            For Each rowindex As Integer In lstScoreChangeRow
                id = dgv.Rows(rowindex).Cells(3).Value
                score = dgv.Rows(rowindex).Cells(5).Value
                sql = "update 用户试卷详表 set 分数=" & score & " where (题目序号=" & id & ") and (试卷编号=" & currentPaper.ID & ")"
                command.CommandText = sql
                command.ExecuteNonQuery()
            Next
            Return ""
        Catch ex As Exception
            Return ex.Message
        End Try
    End Function

    Private Function updatePaperData() As String
        Dim sql As String
        Dim command As New SqlCommand()
        command.Connection = connection

        Dim st As SqlTransaction
        st = connection.BeginTransaction
        command.Transaction = st

        Try
            For i As Integer = 0 To dgv.Rows.Count - 1
                If dgv.Rows(i).Cells(0).Value <> dgv.Rows(i).Cells(1).Value Then
                    sql = "update 用户试卷详表 set 题编号=" & CType(dgv.Rows(i).Cells(1).Value, Integer) & " where 编号=" & currentPaper.ID
                    command.CommandText = sql
                    command.ExecuteNonQuery()
                End If
            Next
            st.Commit()
            Return ""
        Catch ex As Exception
            st.Rollback()
            Return ex.Message
        End Try
    End Function

    Private Function savePaperInfo(ByVal paperInfo As clsPaper) As Integer

        Dim sql As String
        sql = "insert into 用户试卷表(试卷名称,试卷说明,试卷类型,题型信息,总分值,考试时长,录入人ID,录入时间,是否有效) values('" &
            paperInfo.Name & "','" & paperInfo.Info & "','" & paperInfo.TypeIndex & "','" & paperInfo.SubjectTypeInfo & "','" &
            paperInfo.TotalScore & "','" & paperInfo.TotalTime & "','" & paperInfo.Author & "','" & paperInfo.SaveTime & "','" & paperInfo.isReady & "')"

        Dim command As New SqlCommand()

        command.CommandText = sql
        command.Connection = connection

        Try
            command.ExecuteNonQuery()

            sql = "select 编号 from 用户试卷表 order by 编号 desc"
            command.CommandText = sql

            Dim sqlReader As SqlDataReader
            sqlReader = command.ExecuteReader(CommandBehavior.SingleResult)

            Dim id As Integer
            If sqlReader.HasRows Then
                sqlReader.Read()
                id = sqlReader(0)
            End If

            sqlReader.Close()

            Return id
        Catch ex As Exception
            Return 0
        End Try
    End Function

    Private Sub dgv_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles dgv.MouseDoubleClick
        Dim dgvhti As DataGridView.HitTestInfo = dgv.HitTest(e.X, e.Y)
        Dim selectedIndex As Integer

        If dgvhti.Type = DataGridViewHitTestType.Cell Or dgvhti.Type = DataGridViewHitTestType.RowHeader Then
            selectedIndex = dgvhti.RowIndex
            Call changeExam(selectedIndex)

        Else
            Exit Sub
        End If
    End Sub

    Private Sub tsmiCheckExam_Click(sender As Object, e As EventArgs) Handles tsmiCheckExam.Click
        If dgv.SelectedRows.Count < 1 Then Exit Sub

        Dim examid As Integer
        examid = dgv.SelectedRows(0).Cells(1).Value
        Dim fExamSingle As New FormExamSingle(examid, 2)
        fExamSingle.ShowDialog()
    End Sub

    Private Sub tsmiEditScore_Click(sender As Object, e As EventArgs) Handles tsmiEditScore.Click
        If dgv.SelectedRows.Count < 1 Then Exit Sub

        Dim oldScore As Single = dgv.SelectedRows(0).Cells(5).Value
        Dim newScore As Single

        Dim inputScore As String
        inputScore = InputBox("请输入新的分值", "更改单个考题分数", oldScore.ToString)

        If Single.TryParse(inputScore, newScore) = False Then
            MessageBox.Show("你输入的不是一个有效分数")
            Exit Sub
        End If
        dgv.SelectedRows(0).Cells(5).Value = newScore

        lstScoreChangeRow.Add(dgv.SelectedRows(0).Index)

    End Sub

    Private Sub tsmiChangeExam_Click(sender As Object, e As EventArgs) Handles tsmiChangeExam.Click
        If dgv.SelectedRows.Count < 1 Then Exit Sub

        Dim selectedIndex As Integer
        selectedIndex = dgv.SelectedRows(0).Index
        Call changeExam(selectedIndex)
    End Sub

    Private Sub changeExam(ByVal selectedIndex As Integer)

        Dim paperTypename As String
        Dim paperType As Integer
        Dim examType As Integer
        Dim range As String = ""


        paperTypename = dgv.Rows(selectedIndex).Cells(6).Value
        paperType = currentPaper.TypeIndex
        examType = CType(dgv.Rows(selectedIndex).Cells(2).Value, Integer)

        Dim examid As Integer
        For i As Integer = 0 To dgv.Rows.Count - 1
            examid = dgv.Rows(i).Cells(1).Value
            If examid <> 0 Then
                range &= examid.ToString & ","
            End If
        Next
        If range.Length > 0 Then range = range.Substring(0, range.Length - 1)

        Dim fExamSingle As New FormChooseExam(paperTypename, paperType, examType, range)
        fExamSingle.ShowDialog(Me)

        If addExamId = 0 Then
            Exit Sub
        End If

        Dim sql As String = ""
        Dim command As New SqlCommand()
        command.Connection = connection

        sql = "SELECT 编号,题目,选项,答案,图片 " &
                 "FROM 题表 " &
                 "where 编号=" & addExamId
        command.CommandText = sql

        Dim sqlReader As SqlDataReader
        sqlReader = command.ExecuteReader()
        If sqlReader.HasRows Then
            sqlReader.Read()
            dgv.Rows(selectedIndex).Cells(1).Value = sqlReader(0)
            dgv.Rows(selectedIndex).Cells(7).Value = sqlReader(1)
            dgv.Rows(selectedIndex).Cells(8).Value = sqlReader(2)
            dgv.Rows(selectedIndex).Cells(9).Value = sqlReader(3)
            dgv.Rows(selectedIndex).Cells(10).Value = sqlReader(4)
        End If
        sqlReader.Close()
    End Sub

    Private Sub dgv_MouseDown(sender As Object, e As MouseEventArgs) Handles dgv.MouseDown
        Dim dgvhti As DataGridView.HitTestInfo = dgv.HitTest(e.X, e.Y)
        Dim selectedIndex As Integer

        If e.Button = MouseButtons.Right Then
            If dgvhti.Type = DataGridViewHitTestType.Cell Or dgvhti.Type = DataGridViewHitTestType.RowHeader Then
                selectedIndex = dgvhti.RowIndex
                dgv.Rows(selectedIndex).Selected = True
                ContextMenuStrip1.Show(dgv, e.Location)

                If dgv.Rows(selectedIndex).Cells(1).Value = 0 Then
                    tsmiCheckExam.Enabled = False
                Else
                    tsmiCheckExam.Enabled = True
                End If

            Else
                Exit Sub
            End If
        End If

    End Sub


    Private Sub tsbOutput_Click(sender As Object, e As EventArgs) Handles tsbOutput.Click
        Dim errMsg As String
        errMsg = checkData()
        If errMsg <> "" Then
            MessageBox.Show(errMsg)
            Exit Sub
        End If

        If checkWord() = True Then
            MessageBox.Show("请先退出Word,再使用此功能。")
            Exit Sub
        End If

        Dim wordQName As String
        Dim wordAName As String
        Dim sfd As New SaveFileDialog
        sfd.Title = "输出试卷以及答案文档"
        sfd.Filter = "word文档|*.doc"
        sfd.FileName = currentPaper.Name
        If sfd.ShowDialog <> DialogResult.OK Then
            Exit Sub
        End If
        wordQName = sfd.FileName

        If wordQName.Substring(wordQName.Length - 4, 4) <> ".doc" Then
            F_Main.tsslInfo.Text = "错误提示:目前只能输出word文档"
            Exit Sub
        End If
        wordAName = wordQName.Replace(".doc", "_答案.doc")

        F_Main.tsslInfo.Text = "输出试卷中……"
        Dim outputMsg As String
        outputMsg = saveDoc(wordQName, wordAName)
        F_Main.tsslInfo.Text = outputMsg

    End Sub

    Private Function saveDoc(ByVal wordQName As String, ByVal wordAName As String) As String

        Dim wordApp As New Microsoft.Office.Interop.Word.Application
        Dim docQ As Microsoft.Office.Interop.Word.Document
        Dim docA As Microsoft.Office.Interop.Word.Document

        Try
#Region "试卷:标题"
            docQ = wordApp.Documents.Add()
            Dim paragQTitle As Word.Paragraph
            paragQTitle = docQ.Paragraphs.Add
            Dim fontQTitle As New Word.Font
            fontQTitle.Size = 16
            fontQTitle.Bold = True
            fontQTitle.Name = "宋体"
            paragQTitle.Range.Font = fontQTitle
            paragQTitle.Range.Text = currentPaper.Name
            paragQTitle.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
            paragQTitle.Range.InsertParagraphAfter()
#End Region

#Region "答案:标题"
            docA = wordApp.Documents.Add()
            Dim paragATitle As Word.Paragraph
            paragATitle = docA.Paragraphs.Add
            Dim fontATitle As New Word.Font
            fontATitle.Size = 16
            fontATitle.Bold = True
            fontATitle.Name = "宋体"
            paragATitle.Range.Font = fontATitle
            paragATitle.Range.Text = currentPaper.Name
            paragATitle.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
            paragATitle.Range.InsertParagraphAfter()
#End Region


#Region "试卷:考生信息部分"
            Dim paragQTitle1 As Word.Paragraph
            paragQTitle1 = docQ.Paragraphs.Add
            paragQTitle1.Range.Text = vbCrLf

            paragQTitle1 = docQ.Paragraphs.Add
            fontQTitle.Size = 12
            fontQTitle.Bold = True
            fontQTitle.Name = "宋体"
            paragQTitle1.Range.Font = fontQTitle
            paragQTitle1.Range.Text = "学号:         姓名:            总分:"
            paragQTitle1.Format.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
            paragQTitle1.Range.InsertParagraphAfter()

            paragQTitle1 = docQ.Paragraphs.Add
            paragQTitle1.Range.Text = vbCrLf
#End Region

#Region "答案:"
            Dim paragATitle1 As Word.Paragraph
            paragATitle1 = docA.Paragraphs.Add
            paragATitle1.Range.Text = vbCrLf

            paragATitle1 = docA.Paragraphs.Add
            paragATitle1.Range.Text = ""
            paragATitle1.Format.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
            paragATitle1.Range.InsertParagraphAfter()

            paragATitle1 = docA.Paragraphs.Add
            paragATitle1.Range.Text = vbCrLf
#End Region

            Dim htScore As New Hashtable()
            htScore = getHtScore()

            Dim currentIndex As Integer = 0
            Dim CurrentTx As Integer = -1

            Dim examIndex As Integer = 0

            For i As Integer = 0 To dgv.RowCount - 1
                Dim paragQ As Microsoft.Office.Interop.Word.Paragraph
                Dim paragA As Microsoft.Office.Interop.Word.Paragraph

                Dim tx As Integer = dgv(2, i).Value
                If CurrentTx <> tx Then
                    currentIndex += 1
                    CurrentTx = tx
                    examIndex = 0

                    paragQ = docQ.Paragraphs.Add
                    paragA = docA.Paragraphs.Add


                    If htScore(dgv(2, i).Value.ToString) = "yes" Then
                        paragQ.Range.Text = getExamIndexChina(currentIndex) & "、" & dgv(4, i).Value &
                                "(每题 " & dgv(5, i).Value & " 分)" & vbCrLf
                        paragA.Range.Text = getExamIndexChina(currentIndex) & "、" & dgv(4, i).Value &
                                "(每题 " & dgv(5, i).Value & " 分)" & vbCrLf
                    Else
                        paragQ.Range.Text = getExamIndexChina(currentIndex) & "、" & dgv(4, i).Value & vbCrLf
                        paragA.Range.Text = getExamIndexChina(currentIndex) & "、" & dgv(4, i).Value & vbCrLf
                    End If
                End If
                examIndex += 1

                paragQ = docQ.Paragraphs.Add
                paragQ.Range.Text = examIndex.ToString & "、" &
                                        dgv(7, i).Value.ToString &
                                        IIf(htScore(dgv(2, i).Value.ToString) = "yes", "", "( " & dgv(5, i).Value & " 分)") & vbCrLf
                paragA = docA.Paragraphs.Add
                paragA.Range.Text = examIndex.ToString & "、" &
                                        dgv(7, i).Value.ToString &
                                        IIf(htScore(dgv(2, i).Value.ToString) = "yes", "", "( " & dgv(5, i).Value & " 分)") & vbCrLf

#Region "试卷、答案:输出图片"
                If blTempPicPath = True Then
                    Dim picid As Integer = Integer.Parse(dgv(10, i).Value)
                    If picid <> 0 Then
                        Dim picPath As String = savePic(picid)
                        If picPath <> "" Then

                            paragQ = docQ.Paragraphs.Add
                            paragA = docA.Paragraphs.Add

                            Dim examQPic As Word.InlineShape
                            examQPic = paragQ.Range.InlineShapes.AddPicture(picPath, False)
                            examQPic.Width = wordImgwidth
                            examQPic.Height = wordImgheight
                            Dim examAPic As Word.InlineShape
                            examAPic = paragA.Range.InlineShapes.AddPicture(picPath, False)
                            examAPic.Width = wordImgwidth
                            examAPic.Height = wordImgheight

                        End If
                        paragQ = docQ.Paragraphs.Add
                        paragQ.Range.Text = vbCrLf

                        paragA = docA.Paragraphs.Add
                        paragA.Range.Text = vbCrLf
                    End If


                End If


#End Region

#Region "试卷、答案:输出选项"
                Dim xx As String = ""
                Dim xx_arr() As String

                If IsNothing(dgv(8, i).Value) = False AndAlso dgv(8, i).Value <> "" Then
                    xx_arr = dgv(8, i).Value.ToString.Split("@;@", 10, StringSplitOptions.RemoveEmptyEntries)

                    For j As Integer = 0 To xx_arr.Length - 1
                        xx &= Chr(65 + j) & "." & xx_arr(j) & vbCrLf
                    Next

                    paragQ = docQ.Paragraphs.Add
                    paragQ.Range.Text = xx
                    paragA = docA.Paragraphs.Add
                    paragA.Range.Text = xx


                End If
#End Region

#Region "试卷:输出空行"
                paragQ = docQ.Paragraphs.Add
                paragQ.Range.Text = vbCrLf
#End Region


#Region "答案:输出答案"
                paragA = docA.Paragraphs.Add
                paragA.Range.Text = "【答案】" & dgv(9, i).Value & vbCrLf
                paragA = docA.Paragraphs.Add
                paragA.Range.Text = vbCrLf
#End Region

            Next

#Region "试卷:保存为Doc格式文件"
            docQ.SaveAs2(wordQName, Word.WdSaveFormat.wdFormatDocument)
            docQ.Close()
#End Region
#Region "答案:保存为Doc格式文件"
            docA.SaveAs2(wordAName, Word.WdSaveFormat.wdFormatDocument)
            docA.Close()
#End Region

            wordApp.Quit()

            Dim picfiles() As String = Directory.GetFiles(tempPicPath)
            For j As Integer = 0 To picfiles.Count - 1
                File.Delete(picfiles(j))
            Next

            Return "输出试卷成功!"
        Catch ex As Exception
            Return "输出试卷失败:" & ex.Message
        End Try
    End Function

    Private Function checkWord() As Boolean
        For Each pro As Process In Process.GetProcesses
            If pro.ProcessName.ToLower = "winword" Then
                Return True
            End If
        Next
        Return False
    End Function

    Private Function getHtScore() As Hashtable
        Dim htSubject_Score As New Hashtable
        Dim htSubject_Score_Out As New Hashtable

        Dim SubjectTypes() As String
        SubjectTypes = currentPaper.SubjectTypeInfo.Split(";")

        For i As Integer = 0 To SubjectTypes.Length - 2
            Dim singleSubjectInfo() As String = SubjectTypes(i).Split(",")
            htSubject_Score.Add(singleSubjectInfo(0), singleSubjectInfo(2))
            htSubject_Score_Out.Add(singleSubjectInfo(0), "yes")
        Next

        Dim strExamid As String

        For i As Integer = 0 To dgv.Rows.Count - 1
            strExamid = dgv(2, i).Value.ToString

            If htSubject_Score(strExamid) <> dgv(5, i).Value.ToString Then
                If htSubject_Score_Out(strExamid) = "yes" Then
                    htSubject_Score_Out(strExamid) = "no"
                End If
            End If
        Next

        Return htSubject_Score_Out
    End Function

    Private Function getExamIndexChina(ByVal ExamIndex As Integer) As String
        Select Case ExamIndex
            Case 1
                Return "一"
            Case 2
                Return "二"
            Case 3
                Return "三"
            Case 4
                Return "四"
            Case 5
                Return "五"
            Case 6
                Return "六"
            Case 7
                Return "七"
            Case 8
                Return "八"
            Case 9
                Return "九"
            Case 10
                Return "十"
            Case Else
                Return "序号"
        End Select
    End Function

    Private Function savePic(ByVal picid As Integer) As String
        Dim filepath As String = tempPicPath & "\\temp_" & picid & ".jpg"
        If File.Exists(filepath) Then File.Delete(filepath)

        Dim command As New SqlCommand()
        command.Connection = connection

        command.CommandText = "select 图片数据 from 图表 where 编号=" & picid

        Dim sqlReaderimg As SqlDataReader = command.ExecuteReader(CommandBehavior.SequentialAccess)
        Try
            Dim buffersize As Integer = 1024
            Dim buffer(buffersize - 1) As Byte

            If sqlReaderimg.HasRows = False Then
                Return ""
            End If

            Dim fs As New FileStream(filepath, FileMode.CreateNew, FileAccess.Write)
            sqlReaderimg.Read()

            Dim returnbyte As Integer
            Dim startpos As Integer = 0
            returnbyte = sqlReaderimg.GetBytes(0, startpos * buffersize, buffer, 0, buffersize)
            Do While returnbyte = buffersize
                fs.Write(buffer, 0, buffersize)
                fs.Flush()

                ReDim buffer(buffersize - 1)
                startpos += 1
                returnbyte = sqlReaderimg.GetBytes(0, startpos * buffersize, buffer, 0, buffersize)
            Loop

            fs.Close()
            sqlReaderimg.Close()

            Return filepath
        Catch ex As Exception
            Return ""
        End Try
    End Function


    Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs)
        Dim htScore As New Hashtable()
        htScore = getHtScore()

    End Sub

    Private Sub tsbHome_Click(sender As Object, e As EventArgs) Handles tsbHome.Click
        F_Main.tsslInfo.Text = ""
        Me.Close()
    End Sub
End Class

由于.net平台下C#和vb.NET很相似,本文也可以为C#爱好者提供的参考。

学习更多vb.net知识,请参看 vb.net 教程 目录

以上是关于开发实践教程1:试卷生成系统6.7 试卷生成(FormTestPaper)的主要内容,如果未能解决你的问题,请参考以下文章

开发实践教程1:试卷生成系统6.8 试卷信息(FormTestPaperInfo)

开发实践教程1:试卷生成系统3 系统设计

开发实践教程1:试卷生成系统4 类

开发实践教程1:试卷生成系统6.10 载入试卷(FormLoadTestPaper)

开发实践教程1:试卷生成系统6.13 试卷搜索(FormPaperManagerQuery)

开发实践教程1:试卷生成系统6.14 更新试卷信息(FormPaperInfoUpdate)