frmprodbyman.vb

这个是本人写的题库系统,开发工具是vb.net.试题编辑,试卷编辑,可以在word中编辑试题.由于时间关系,很多功能需要细化.

                txt_chapter.Text = MyChp.ChapterName
            End If
        End If
    End Sub

    Private Sub cmd_objdelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_objdelete.Click
        If CurTestDeta.TestContextID <= 0 Then
            Exit Sub
        End If
        If tv_object.SelectedNode Is Nothing Then
            Exit Sub
        End If
        Dim node As TreeNode
        For Each node In tv_object.Nodes
            If node Is tv_object.SelectedNode Then
                Exit Sub
            End If
        Next
        node = tv_object.SelectedNode
        tv_object.BeginUpdate()
        tv_object.Nodes.Remove(node)
        tv_object.EndUpdate()

        MyTestDeta.Equal(CurTestDeta)
        If MyTestDeta.Delete() Then
            CurTestDeta.Initials()
            MyTestType.Equal(CurTestType)
            If MyTestType.TestNum > 0 Then
                MyTestType.TestNum = MyTestType.TestNum - 1
                If MyTestType.Modify() Then
                    CurTestType.Equal(MyTestType)
                End If
            End If
        End If

    End Sub

    Private Sub frmprodbyman_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        Dim flag As Boolean
        flag = False
        If Trim(txt_testtitel.Text) = "" Or Trim(txt_teacher.Text) = "" Or _
                Trim(comb_testmoth.Text) = "" Or Trim(comb_testtype.Text) = "" _
                 Or Trim(txt_totalscore.Text) = "" Then
            MsgBox("试卷信息中有空的项目，请正确填写后再退出.", MsgBoxStyle.Exclamation, "翼清测试题库系统V1.0")
            Exit Sub
        End If
        If CurTest.TestTitle <> Trim(txt_testtitel.Text) Then
            flag = True
        End If
        If CurTest.TestOpName <> Trim(txt_teacher.Text) Then
            flag = True
        End If
        If CurTest.TestMoth <> Trim(comb_testmoth.Text) Then
            flag = True
        End If
        If CurTest.TestType <> Trim(comb_testtype.Text) Then
            flag = True
        End If
        If Int(CurTest.TestScore).ToString <> Trim(txt_totalscore.Text) Then
            flag = True
        End If
        If flag Then
            If MsgBox("[试卷信息已改变，您是否保存?", MsgBoxStyle.YesNo + MsgBoxStyle.Question, _
                                         "翼清测试题库系统V1.0") = MsgBoxResult.Yes Then
                CurTest.TestTitle = MakeStr(txt_testtitel.Text)
                CurTest.TestOpName = MakeStr(txt_teacher.Text)
                CurTest.TestMoth = MakeStr(comb_testmoth.Text)
                CurTest.TestType = MakeStr(comb_testtype.Text)
                CurTest.TestScore = MakeStr(txt_totalscore.Text)
                CurTest.Modify()
            End If
        End If
        CurTest.Initials()
        MyTest.Initials()
        CurChp.Initials()
        MyChp.Initials()
        CurObjt.Initials()
        MyObjt.Initials()
        CurObjtType.Initials()
        MyObjtType.Initials()
        CurSubjt.Initials()
        MySubjt.Initials()
        CurTestDeta.Initials()
        MyTestDeta.Initials()
        CurTestType.Initials()
        MyTestType.Initials()
        MyTestCon.Initials()
        MyTestRes.Initials()
    End Sub

    Private Sub cmd_showtest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_showtest.Click

        '先用引用“加入Word 11.0”的函数库
        Dim DocTestConFileName As String
        Dim DocTestResFileName As String
        Dim DocObjConFileName As String
        Dim DocObjResFileName As String
        Prb_ok.Visible = True
        Prb_ok.Minimum = 0

        DocTestConFileName = Application.StartupPath & "\试卷内容.rtf"
        DocTestResFileName = Application.StartupPath & "\试卷答案.rtf"
        DocObjConFileName = Application.StartupPath & "\试题内容.rtf"
        DocObjResFileName = Application.StartupPath & "\试题答案.rtf"
        MyTest.Equal(CurTest)
        Dim msWordApp As New Word.Application
        Dim msWordDoc As Word.Document
        Dim msWordSelection As Word.Selection
        Try

            'Dim InFile As String

            msWordDoc = msWordApp.Documents.Add("", False)
            msWordSelection = msWordApp.Selection
            Dim tmptypedbset As DataSet
            Me.Text = "手工出卷----正在保存卷子信息....."
            artbtest.Text = vbTab & vbTab & vbTab & vbTab & CurTest.TestTitle & vbCrLf
            artbtest.Text = artbtest.Text & "课程: " & CurSubjt.SubjectName & "    "
            artbtest.Text = artbtest.Text & "出卷人: " & CurTest.TestOpName & "   "
            artbtest.Text = artbtest.Text & "出卷时间: " & CurTest.TestOpTime & "    "
            artbtest.Text = artbtest.Text & "考试方式: " & CurTest.TestMoth & "    "
            artbtest.Text = artbtest.Text & "试卷类别: " & CurTest.TestType & "    "
            artbtest.Text = artbtest.Text & "试卷总分: " & Str(CurTest.TestScore) & vbCrLf
            artbtest.SaveFile(DocObjConFileName, RichTextBoxStreamType.RichText)
            msWordSelection.InsertFile(FileName:=DocObjConFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
            Dim typei As Integer
            typei = 1
            tmptypedbset = MyTestType.GetTestType(CurTest.TestID)
            If Not tmptypedbset Is Nothing Then
                Dim typedrow As DataRow
                'Prb_ok.Maximum = tmptypedbset.Tables(0).Rows.Count * 2

                For Each typedrow In tmptypedbset.Tables(0).Rows
                    'Prb_ok.PerformStep()
                    MyObjtType.GetinfoByID(typedrow.Item("ObjectTypeID"))
                    artbtest.Text = TransToChina(typei) & MyObjtType.ObjectTypeName
                    artbtest.SaveFile(DocObjConFileName, RichTextBoxStreamType.RichText)
                    msWordSelection.InsertFile(FileName:=DocObjConFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
                    typei = typei + 1
                    Dim tmpobjdbset As DataSet
                    Dim obji As Integer
                    obji = 1
                    tmpobjdbset = MyTestDeta.GetTestDetas(CurTest.TestID, typedrow.Item("ObjectTypeID"))
                    If Not tmpobjdbset Is Nothing Then
                        Dim tmpobjdrow As DataRow
                        For Each tmpobjdrow In tmpobjdbset.Tables(0).Rows
                            MyObjt.GetInfo(tmpobjdrow.Item("ObjectName"))
                            If MyObjt.ObjectID > 0 Then
                                artbtest.Rtf = MyObjt.ObjectContext
                                artbtest.SelectionStart = 0
                                artbtest.SelectionLength = 0
                                Clipboard.SetDataObject(Trim(Str(obji)) & ". ")
                                obji = obji + 1
                                artbtest.Paste()
                                artbtest.SaveFile(DocObjConFileName, RichTextBoxStreamType.RichText)
                                msWordSelection.InsertFile(FileName:=DocObjConFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
                            End If
                        Next
                    End If
                Next
            End If

            msWordDoc.SaveAs(FileName:=DocTestConFileName, FileFormat:=Word.WdSaveFormat.wdFormatRTF)
            msWordDoc.Close()
            artbtestall.LoadFile(DocTestConFileName, RichTextBoxStreamType.RichText)
            MyTestCon.SaveTestResult(CurTest.TestID, GetMemoStringAndPROG(artbtestall.TextRTF, Prb_ok))
            'MyTest.TestContext = GetMemoStringAndPROG(artbtestall.TextRTF, Prb_ok)
            '生成答案
            msWordDoc = msWordApp.Documents.Add("", False)
            msWordSelection = msWordApp.Selection
          
            artbtest.Text = vbTab & vbTab & vbTab & vbTab & CurTest.TestTitle & "(答案)" & vbCrLf
            artbtest.Text = artbtest.Text & "课程: " & CurSubjt.SubjectName & "    "
            artbtest.Text = artbtest.Text & "出卷人: " & CurTest.TestOpName & "   "
            artbtest.Text = artbtest.Text & "出卷时间: " & CurTest.TestOpTime & "    "
            artbtest.Text = artbtest.Text & "考试方式: " & CurTest.TestMoth & "    "
            artbtest.Text = artbtest.Text & "试卷类别: " & CurTest.TestType & "    "
            artbtest.Text = artbtest.Text & "试卷总分: " & Str(CurTest.TestScore) & vbCrLf
            artbtest.SaveFile(DocObjResFileName, RichTextBoxStreamType.RichText)
            msWordSelection.InsertFile(FileName:=DocObjResFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
           
            Dim typeii As Integer
            typeii = 1
            tmptypedbset = MyTestType.GetTestType(CurTest.TestID)
            If Not tmptypedbset Is Nothing Then
                Dim typedrow1 As DataRow
                For Each typedrow1 In tmptypedbset.Tables(0).Rows
                    ' Prb_ok.PerformStep()
                    MyObjtType.GetinfoByID(typedrow1.Item("ObjectTypeID"))
                    artbtest.Text = TransToChina(typeii) & MyObjtType.ObjectTypeName
                    artbtest.SaveFile(DocObjResFileName, RichTextBoxStreamType.RichText)
                    msWordSelection.InsertFile(FileName:=DocObjResFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
                    typeii = typeii + 1
                    Dim tmpobjdbset As DataSet
                    Dim obji As Integer
                    obji = 1
                    tmpobjdbset = MyTestDeta.GetTestDetas(CurTest.TestID, typedrow1.Item("ObjectTypeID"))
                    If Not tmpobjdbset Is Nothing Then
                        Dim tmpobjdrow As DataRow
                        For Each tmpobjdrow In tmpobjdbset.Tables(0).Rows
                            MyObjt.GetInfo(tmpobjdrow.Item("ObjectName"))
                            If MyObjt.ObjectID > 0 Then
                                artbtest.Rtf = MyObjt.ObjectResult
                                artbtest.SelectionStart = 0
                                artbtest.SelectionLength = 0
                                Clipboard.SetDataObject(Trim(Str(obji)) & ". ")
                                obji = obji + 1
                                artbtest.Paste()
                                artbtest.SaveFile(DocObjResFileName, RichTextBoxStreamType.RichText)
                                msWordSelection.InsertFile(FileName:=DocObjResFileName, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False)
                            End If
                        Next
                    End If
                Next
            End If
            msWordDoc.SaveAs(FileName:=DocTestResFileName, FileFormat:=Word.WdSaveFormat.wdFormatRTF)
            msWordDoc.Close()

            artbtestall.LoadFile(DocTestResFileName, RichTextBoxStreamType.RichText)
            MyTestRes.SaveTestResult(CurTest.TestID, GetMemoStringAndPROG(artbtestall.TextRTF, Prb_ok))
            'MyTest.TestResult = GetMemoStringAndPROG(artbtestall.TextRTF, Prb_ok)
            msWordApp.Quit()
            msWordSelection = Nothing
            msWordDoc = Nothing
            msWordApp = Nothing
        Catch ex As Exception
            MsgBox("保存试卷时出错。", MsgBoxStyle.Exclamation, "翼清测试题库系统V1.0")
            Prb_ok.Visible = False
            MyTestCon.DeleteByTestID(CurTest.TestID)
            MyTestRes.DeleteByTestID(CurTest.TestID)
            Me.Text = "手工出卷"
            msWordApp.Quit()
            msWordSelection = Nothing
            msWordDoc = Nothing
            msWordApp = Nothing
        End Try

        If Not MyTest.Modify() Then
            'CurTest.TestContext = ""
            'CurTest.TestResult = ""
        Else
            CurTest.Equal(MyTest)
        End If
        Prb_ok.Visible = False
        Me.Text = "手工出卷"
    End Sub

    Public Function TransToChina(ByVal i As Integer) As String
        Select Case i
            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 11
                Return "十一."
            Case 12
                Return "十二."
            Case 13
                Return "十三."
            Case 14
                Return "十四."
            Case 15
                Return "十五."
            Case 16
                Return "十六."
            Case 17
                Return "十七."
            Case 18
                Return "十八."
            Case 19
                Return "十九."
            Case 20
                Return "二十."
        End Select
        Return ""
    End Function


    Private Sub comb_residx_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles comb_residx.SelectedIndexChanged
        MyObjtType.GetInfo(MakeStr(comb_qobjtype.Text))
        CurObjtType.Equal(MyObjtType)
        If CurTest.TestID > 0 Then
            objdbset = MyObjt.GetObjDetailsByAll(CurSubjt.SubjectID, CurObjtType.ObjectTypeID, Int(Trim(comb_residx.Text)))
            If Not objdbset Is Nothing Then
                dg_objects.DataSource = objdbset.Tables(0).DefaultView
                gb_objnum.Text = "共有" & Str(objdbset.Tables(0).Rows.Count) & " 道题"
            Else
                dg_objects.DataSource = Nothing
                gb_objnum.Text = "共有0道题"
            End If
        End If
    End Sub
    Public Function OpenOnce(ByVal frm As Form, ByVal parentfrm As Form) As Boolean
        Dim mdifrm As Form
        For Each mdifrm In parentfrm.MdiChildren
            If frm.Text = mdifrm.Text Then
                mdifrm.Activate()
                Return False
                Exit Function
            End If
        Next
        Return True
    End Function

    Private Sub cmd_qobj_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmd_qobj.Click
        Dim fmqueryobj As New frmqueryobj
        fmqueryobj.ShowDialog()

        If CurTest.TestID > 0 Then
            If Not OBJQueryDbset Is Nothing Then
                dg_objects.DataSource = OBJQueryDbset.Tables(0).DefaultView
                gb_objnum.Text = "共有" & Str(OBJQueryDbset.Tables(0).Rows.Count) & " 道题"
            Else
                dg_objects.DataSource = Nothing
                gb_objnum.Text = "共有0道题"
            End If
        End If
    End Sub

End Class