singleedit.frm

vb写的试题库生成系统

    cmdDeleteChapter.Enabled = False
    fraAnswer.Enabled = True
    fraLevel.Enabled = True
    txtContent.Locked = False
    txtContent = ""
    picName = ""
    Picture1.Picture = LoadPicture()
    optAnswer(0) = True
    optLevel(1) = True
    For i = 0 To 3
            txtAnswer(i) = ""
    Next
    txtNews = "增加新题……"
End Sub

Private Sub cmdAddChapter_Click()
    Dim i%, strName As String
    On Error GoTo DealError
    strName = Trim(InputBox("请输入章节名称：", , ""))
    If strName <> "" Then
        '检查章名是否重复
        For i = 0 To cmbChapter.ListCount - 1
            If cmbChapter.List(i) = strName Then Exit For
        Next
        If i <> cmbChapter.ListCount Then
            MsgBox "章名<" & strName & ">已被使用，请使用其他名称！", vbCritical
        Else
            objRsChapter.AddNew
            objRsChapter!名称 = strName
            objRsChapter.Update
            cmbChapter.AddItem strName
            cmbChapter.ItemData(cmbChapter.NewIndex) = objRsChapter!编号
            MsgBox "成功添加新的章名！"
        End If
    End If
    Exit Sub
DealError:
    'ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdAddPic_Click()
    '添加或替换图片
    CommonDialog1.DialogTitle = "选择图片文件"
    CommonDialog1.Filter = "图片（*.bmp）|*.bmp"
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName Like "*.bmp" Then
        picName = CommonDialog1.FileName
        Picture1.Picture = LoadPicture(picName)
    Else
        picName = ""
        Picture1.Picture = LoadPicture()
    End If
End Sub

Private Sub cmdDelete_Click()
    Dim n%
    On Error GoTo DealError
    If cmbChapter = "" Or objRs.RecordCount <= 0 Then Exit Sub
    n = MsgBox("确认删除当前试题吗？", vbQuestion + vbYesNo)
    If n = vbYes Then
        objRs.Delete
        objRs.Update
        objRs.MoveNext
        If objRs.EOF And objRs.RecordCount > 0 Then objRs.MoveLast
        Show_Data
    End If
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub


Private Sub cmdDeleteChapter_Click()
    Dim n%, strSQL$
    On Error GoTo DealError
    If cmbChapter = "" Then Exit Sub
    n = MsgBox("确定要删除本章单选题吗？", vbQuestion + vbYesNo)
    If n = vbYes Then
        strSQL = "delete from 单选题 where 章节=" & cmbChapter.ItemData(cmbChapter.ListIndex)
        conn.Execute strSQL
        MsgBox cmbChapter & "的单选题已被成功删除！", vbInformation
        strSQL = "select 章节 from 判断题 where 章节=" _
                 & cmbChapter.ItemData(cmbChapter.ListIndex) _
                 & "union  select 章节 from 多选题 where 章节=" _
                 & cmbChapter.ItemData(cmbChapter.ListIndex) _
                 & "select 章节 from 填空题 where 章节=" _
                 & cmbChapter.ItemData(cmbChapter.ListIndex) _
                 & "select 章节 from 简答题 where 章节=" _
                 & cmbChapter.ItemData(cmbChapter.ListIndex)
        n = 0
        conn.Execute strSQL, n
        If n = 0 Then
            n = MsgBox(cmbChapter & "已无其他类型试题，是否删除章节名称？", vbQuestion + vbYesNo)
            If n = vbYes Then
                strSQL = "delete from 章节 where 编号=" & cmbChapter.ItemData(cmbChapter.ListIndex)
                conn.Execute strSQL
                cmbChapter.RemoveItem cmbChapter.ListIndex
            End If
        End If
    End If
    Exit Sub
DealError:
    'ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdDeletePic_Click()
    picName = ""
    Picture1.Picture = LoadPicture()
End Sub

Private Sub cmdEdit_Click()
    If cmbChapter = "" Or objRs.RecordCount <= 0 Then Exit Sub
    fraChangeRecord.Enabled = False
    fraEditPic.Enabled = True
    cmdEdit.Enabled = False
    cmdDelete.Enabled = False
    cmdAdd.Enabled = False
    cmdSave.Enabled = True
    cmbChapter.Enabled = False
    cmdAddChapter.Enabled = False
    cmdEditChapter.Enabled = False
    cmdDeleteChapter.Enabled = False
    fraAnswer.Enabled = True
    fraLevel.Enabled = True
    txtContent.Locked = False
    If IsNull(objRs!图片) Then
        picName = ""
    Else
        picName = objRs!图片
    End If
    txtNews = "修改本题……"
End Sub

Private Sub cmdEditChapter_Click()
    Dim i%, strName As String
    On Error GoTo DealError
    If cmbChapter = "" Then Exit Sub
    strName = Trim(InputBox("请输入<" & cmbChapter & ">章节的新名称：", , ""))
    If strName <> "" Then
        '检查章名是否重复
        For i = 0 To cmbChapter.ListCount - 1
            If cmbChapter.List(i) = strName And i <> cmbChapter.ListIndex Then Exit For
        Next
        If i <> cmbChapter.ListCount Then
            MsgBox "章名<" & strName & ">已被使用，请使用其他名称！", vbCritical
        Else
            objRsChapter.MoveFirst
            objRsChapter.Find "名称='" & cmbChapter & "'"
            objRsChapter!名称 = strName
            objRsChapter.Update
            cmbChapter.List(cmbChapter.ListIndex) = strName
            MsgBox "成功修改章名！"
        End If
    End If
    Exit Sub
DealError:
    'ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdExit_Click()
    Unload Me               '关闭窗体
End Sub




Private Sub cmdMoveFirst_Click()
    If objRs.RecordCount > 0 Then
        objRs.MoveFirst
        Show_Data
    End If
End Sub

Private Sub cmdMoveLast_Click()
    If objRs.RecordCount > 0 Then
        objRs.MoveLast
        Show_Data
    End If
End Sub

Private Sub cmdMoveNaext_Click()
    If objRs.RecordCount > 0 Then
        objRs.MoveNext
        If objRs.EOF Then objRs.MoveLast
        Show_Data
    End If
End Sub

Private Sub cmdMovePre_Click()
    If objRs.RecordCount > 0 Then
        objRs.MovePrevious
        If objRs.BOF Then objRs.MoveFirst
        Show_Data
    End If
End Sub

Private Sub cmdSave_Click()
On Error GoTo DealError
    Dim i%
    If Trim(txtContent) = "" Then
        MsgBox "请输入题干！", vbCritical
        txtContent.SetFocus
    ElseIf Trim(txtAnswer(0)) = "" Then
        MsgBox "请输入选项A内容！", vbCritical
        txtAnswer(0).SetFocus
    ElseIf Trim(txtAnswer(1)) = "" Then
        MsgBox "请输入选项B内容！", vbCritical
        txtAnswer(1).SetFocus
    ElseIf Trim(txtAnswer(2)) = "" Then
        MsgBox "请输入选项C内容！", vbCritical
        txtAnswer(2).SetFocus
    ElseIf Trim(txtAnswer(3)) = "" Then
        MsgBox "请输入选项D内容！", vbCritical
        txtAnswer(3).SetFocus
    Else
    
    
        If isAdding Then objRs.AddNew
        '保存试题
        objRs!章节 = cmbChapter.ItemData(cmbChapter.ListIndex)
        objRs!题干 = Trim(txtContent)
        objRs!选项1 = txtAnswer(0)
        objRs!选项2 = txtAnswer(1)
        objRs!选项3 = txtAnswer(2)
        objRs!选项4 = txtAnswer(3)
        
        If picName <> "" Then
            objRs!图片 = picName
        Else
            objRs!图片 = Null
        End If
        
        
        For i = 0 To 3
            If optAnswer(i) Then objRs!答案 = i
        Next
        
        If optLevel(0) Then
            objRs!难度 = 0
        ElseIf optLevel(1) Then
            objRs!难度 = 1
        Else
            objRs!难度 = 2
        End If
        
        
        objRs.Update
        MsgBox "试题保存成功！"
        '恢复按钮状态
        
        isAdding = False
        
        fraChangeRecord.Enabled = True
        fraEditPic.Enabled = False
        cmdEdit.Enabled = True
        cmdDelete.Enabled = True
        cmdAdd.Enabled = True
        cmdSave.Enabled = False
        cmbChapter.Enabled = True
        cmdAddChapter.Enabled = True
        cmdEditChapter.Enabled = True
        cmdDeleteChapter.Enabled = True
        fraAnswer.Enabled = False
        txtContent.Locked = True
        picName = ""
        Show_Data
    End If
    Exit Sub
DealError:
    'ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub Form_Load()
    On Error GoTo DealError
    Dim strSQL As String
    '创建数据库连接
    Set conn = New Connection
   With conn                                      '建立服务器连接
       ' .Provider = "SQLOLEDB"
       ' .ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False" & ThisDBName
       ' .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=:" & ThisDBName
       
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=;Server=(local);database=" & ThisDBName
        .Open                                         '打开连接
    End With

    '执行查询获得“单选题”数据
    Set objRs = New Recordset
    Set objRs.ActiveConnection = conn
    objRs.CursorLocation = adUseClient
    objRs.CursorType = adOpenKeyset
    objRs.LockType = adLockOptimistic
    strSQL = "select * from 单选题"
    objRs.Open strSQL
    
    '执行查询，获得章节信息
    Set objRsChapter = New Recordset
    Set objRsChapter.ActiveConnection = conn
    objRsChapter.CursorLocation = adUseClient
    objRsChapter.CursorType = adOpenKeyset
    objRsChapter.LockType = adLockOptimistic
    strSQL = "select * from 章节"
    objRsChapter.Open strSQL

    '创建“章节”下拉列表
    If objRsChapter.RecordCount > 0 Then
        objRsChapter.MoveFirst
        While Not objRsChapter.EOF
            cmbChapter.AddItem objRsChapter!名称
            cmbChapter.ItemData(cmbChapter.NewIndex) = objRsChapter!编号
            objRsChapter.MoveNext
        Wend
        cmbChapter.ListIndex = 0
    End If
    

    '按章节筛选记录集数据
    objRs.Filter = "章节=" & cmbChapter.ItemData(cmbChapter.ListIndex)
    '显示第一条记录
    If objRs.RecordCount > 0 Then objRs.MoveFirst
    Show_Data
    Exit Sub
DealError:
    'ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub Show_Data()
    Dim i%
    '显示当前记录
    If objRs.RecordCount > 0 Then
        txtContent = objRs!题干
        txtAnswer(0) = objRs!选项1
        txtAnswer(1) = objRs!选项2
        txtAnswer(2) = objRs!选项3
        txtAnswer(3) = objRs!选项4
        Picture1.Picture = LoadPicture()
        Picture1.Cls
        If IsNull(objRs!图片) Then
            Picture1.Print vbCrLf; vbCrLf; vbCrLf; vbCrLf; Tab(10); "本题无图片！"
        Else
            Picture1.Picture = LoadPicture(objRs!图片)
        End If
        optAnswer(objRs!答案).Value = True
        optLevel(objRs!难度) = True
        txtNews = "第" & objRs.AbsolutePosition & "题 共" & objRs.RecordCount & "题"
    Else
        txtNews = "当前章节中无试题！"
        txtContent = ""
        Picture1.Picture = LoadPicture()
        Picture1.Cls
        For i = 0 To 3
            txtAnswer(i) = ""
        Next
    End If
End Sub