开发实践教程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：试卷生成系统6.10 载入试卷（FormLoadTestPaper）