frmkaoshi.frm

自己用vb开发的局域网考试系统

       'TxTDaan(i).Visible = True
    Else
       Load LabDaan(i)
       LabDaan(i).Caption = i & "、"
       LabDaan(i).Left = 100
       'LabDaan(i).Visible = True
       Load TxTDaan(i)
       TxTDaan(i).Left = 435
       'TxTDaan(i).Visible = True
    
     End If
     TxTDaan(i).Top = (Round((i / 2) + 0.1) - 1) * 315 + Round((i / 2) + 0.2) * 100
     LabDaan(i).Top = TxTDaan(i).Top
  Next i
  PicDA.Height = TxTDaan(30).Top + 315 + 100
  VSDA.Max = PicDA.Height - PicParent.Height
  VSDA.Min = 0
End Sub

Private Sub TxTDaan_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 39 Then KeyAscii = -24145

End Sub

Private Sub VSDA_Change()
  PicDA.Top = -1 * VSDA.Value
End Sub
'预览判断题
Sub ViewPD(ByVal TMid As Long) '题目id
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  Dim DaanArr() As String
  adoRS.Open "select * from 试卷判断题 where ID=" & TMid, LocalConn, adOpenStatic, adLockOptimistic
  If Not adoRS.EOF Then
     '显示
     RtbPD.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示答案
     If Len(adoRS.Fields("考生答案").Value) <= 0 Then
        OptMei.Value = True
      ElseIf adoRS.Fields("考生答案").Value = "T" Then
        OptDui.Value = True
       Else
        OptCuo.Value = True
     End If
  End If

End Sub
'预览作文题
Sub ViewZW(ByVal TMid As Long) '题目id
    Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  Dim DaanArr() As String
  adoRS.Open "select * from 试卷作文题 where ID=" & TMid, LocalConn, adOpenStatic, adLockOptimistic
  If Not adoRS.EOF Then
     '显示
     RtbZWTM.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示答案
     RtbZW.Text = adoRS.Fields("考生答案").Value
  End If
 Set adoRS = Nothing
End Sub
'预览问答题
Sub ViewWD(ByVal TMid As Long) '题目id
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  Dim DaanArr() As String
  adoRS.Open "select * from 试卷问答题 where ID=" & TMid, LocalConn, adOpenStatic, adLockOptimistic
  If Not adoRS.EOF Then
     '显示
     RtbWDTM.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示答案
     RtbWDDA.Text = adoRS.Fields("考生答案").Value
  End If
 Set adoRS = Nothing
End Sub
'预览填空题
Sub ViewTK(ByVal TMid As Long) '题目id
  Dim adoRS As Recordset
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  Dim DaanArr() As String
  adoRS.Open "select * from 试卷填空题 where ID=" & TMid, LocalConn, adOpenStatic, adLockOptimistic
  If Not adoRS.EOF Then
     '显示
     RtbTK.Text = "   " + adoRS.Fields("问题").Value + "(" & adoRS.Fields("分数").Value & ")" + vbCrLf
     '显示空和答案
     Dim i As Integer
     For i = 1 To 30
       LabDaan(i).Visible = False
       TxTDaan(i).Visible = False
       TxTDaan(i).Text = ""
     Next i
     'rtbTK.Tag里面保存空个数,以后可以用
     RtbTK.Tag = adoRS.Fields("空数").Value
     For i = 1 To adoRS.Fields("空数").Value
       LabDaan(i).Visible = True
       TxTDaan(i).Visible = True
     Next i
    '显示答案
     If Len(adoRS.Fields("考生答案").Value) > 0 Then
       DaanArr = Split(adoRS.Fields("考生答案").Value, "▲▲")
       For i = 0 To UBound(DaanArr)
        TxTDaan(i + 1).Text = DaanArr(i)
       Next i
     End If
  End If
 Set adoRS = Nothing
End Sub
'看选择题
Sub ViewTM(ByVal adoTMRs As Recordset)
  Dim DAArr() As String
  Dim i As Integer
  
  TXTView.Text = "  " + adoTMRs.Fields("问题").Value + "(" + Str(adoTMRs.Fields("分数").Value) + "分" + ")" + vbCrLf
  
  TXTView.Text = TXTView.Text + "    A、" + adoTMRs.Fields("A").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    B、" + adoTMRs.Fields("B").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    C、" + adoTMRs.Fields("C").Value + vbCrLf + vbCrLf
  TXTView.Text = TXTView.Text + "    D、" + adoTMRs.Fields("D").Value + vbCrLf + vbCrLf
  '清空
  For i = 0 To 3
    Check1(i).Value = 0
  Next i
  '显示答案
  If Len(adoTMRs.Fields("考生答案").Value) > 0 Then
   DAArr = Split(adoTMRs.Fields("考生答案").Value, ",")
   For i = 0 To UBound(DAArr)
     Check1(Asc(DAArr(i)) - 65).Value = 1
   Next i
  End If
  
End Sub
'保存选择题
Sub SaveDaAN()
Dim i As Integer
Dim DAan As String
For i = 0 To 3
If Check1(i).Value Then
   DAan = DAan & Check1(i).Caption & ","
End If
Next i
If DAan = "" Then DAan = "," '若此题未做
DAan = Left(DAan, Len(DAan) - 1)
Dim sql As String
sql = "update 试卷选择题 set 考生答案='" & DAan & "' where id=" & Val(TXTView.Tag)
LocalConn.Execute sql
End Sub
''保存作文题
Sub SaveZW()
  If LstZW.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstZW.Tag

  '保存
  Dim DAan As String
  DAan = RtbZW.Text
  Dim sql As String
  sql = "update 试卷作文题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存问答题
Sub SaveWD()
  If LstWD.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstWD.Tag
  
  Dim DAan As String
  DAan = RtbWDDA.Text
  Dim sql As String
  sql = "update 试卷问答题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存判断题
Sub SavePD()
  If LstPD.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstPD.Tag
  
  Dim DAan As String
  If OptDui = True Then
    DAan = "T"
  End If
  If OptCuo = True Then
    DAan = "F"
  End If
  Dim sql As String
  sql = "update 试卷判断题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub
''保存填空题
Sub SaveTK()
  If LstTK.Tag = "" Then
    Exit Sub
  End If
  Dim ID As String
  ID = LstTK.Tag
  
  Dim i As Integer
  Dim DAan As String
  For i = 1 To Val(RtbTK.Tag)
    DAan = DAan & TxTDaan(i).Text & "▲▲"
  Next i
  DAan = Left(DAan, Len(DAan) - 2)
  Dim sql As String
  sql = "update 试卷填空题 set 考生答案='" & DAan & "' where id=" & ID
  LocalConn.Execute sql
End Sub

'处理交卷
'"▼▼"用于分割各填空题、问答题、作文的答案
'"▲▲"用于分割填空题各个空的字符
'函数返回true和false表示交卷是否成功
Function JiaoJuan() As Boolean
  JiaoJuan = False
  Dim Scores As Long '成绩
  'Dim Zscore As Long '总分
  Dim Danxuan As String, Duoxuan As String  '答案字符串
  Dim Danxuans As String, Duoxuans As String  '对应的分数字符串
  Dim Danxuanid As String, Duoxuanid As String  '对应的试卷ID字符串
  Dim TianKong As String, TianKongs As String, TianKongID As String '填空题
  Dim PanDuan As String, PanDuans As String, PanDuanID As String '判断题
  Dim WenDa As String, WenDas As String, WenDaID As String '问答题
  Dim ZuoWen As String, ZuoWens As String, ZuoWenID As String '作文题
  Dim TestID As Long '试卷标号
  '试卷基本信息
  Dim tempRS As Recordset
  Set tempRS = New Recordset
  tempRS.CursorLocation = adUseClient

  tempRS.Open "试卷信息", LocalConn, adOpenStatic, adLockOptimistic
  TestID = tempRS.Fields("试卷编号").Value
  'Zscore = tempRS.Fields("试卷总分").Value  '总分
  tempRS.Close
  Set tempRS = Nothing
  
  Dim rs As Recordset
  Set rs = New Recordset
  rs.CursorLocation = adUseClient

  '选择题
  rs.Open "试卷选择题", LocalConn, adOpenStatic, adLockOptimistic
  Do While Not rs.EOF
     If rs.Fields("类别").Value = "单" Then
        If rs.Fields("考生答案").Value <> "" Then
           Danxuan = Danxuan + rs.Fields("考生答案") + "/"
        Else
           Danxuan = Danxuan + "o" + "/"
        End If
        '试卷分数,ID'不正确分数为0
        If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
            Scores = Scores + rs.Fields("分数").Value
            Danxuans = Danxuans + Trim(Str(rs.Fields("分数").Value)) + ","
           Else
            Danxuans = Danxuans + "0,"
        End If
        Danxuanid = Danxuanid + Trim(Str(rs.Fields("ID").Value)) + ","
     ElseIf rs.Fields("类别").Value = "多" Then
        If rs.Fields("考生答案").Value <> "" Then
            Duoxuan = Duoxuan + rs.Fields("考生答案").Value + "/"
        Else
            Duoxuan = Duoxuan + "o" + "/"
        End If
        '试卷分数,ID'不正确分数为0
        If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
            Scores = Scores + rs.Fields("分数").Value
            Duoxuans = Duoxuans + Trim(Str(rs.Fields("分数").Value)) + ","
           Else
            Duoxuans = Duoxuans + "0,"
        End If
        Duoxuanid = Duoxuanid + Trim(Str(rs.Fields("ID").Value)) + ","
     End If
   
     rs.MoveNext
  Loop
  '填空题
'  rs.Close
'  rs.Open "试卷填空题", LocalConn, adOpenStatic, adLockOptimistic
'  Do While Not rs.EOF
'    TianKong = TianKong + rs.Fields("考生答案").Value + "▼▼"
'    TianKongID = TianKongID & rs.Fields("ID").Value & ","
'    TianKongs = TianKongs + ","
'    rs.MoveNext
'  Loop
'
'  '填判断
'  rs.Close
'  rs.Open "试卷判断题", LocalConn, adOpenStatic, adLockOptimistic
'  Do While Not rs.EOF
'    PanDuan = PanDuan + rs.Fields("考生答案").Value + ","
'    PanDuanID = PanDuanID & rs.Fields("ID").Value & ","
'    If rs.Fields("考生答案").Value = rs.Fields("答案").Value Then
'      Scores = Scores + rs.Fields("分数").Value
'      PanDuans = PanDuans & rs.Fields("分数").Value & ","
'     Else
'      PanDuans = PanDuans + "0,"
'    End If
'    rs.MoveNext
'  Loop
'
'  '问答题
'  rs.Close
'  rs.Open "试卷问答题", LocalConn, adOpenStatic, adLockOptimistic
'  Do While Not rs.EOF
'    WenDa = WenDa + rs.Fields("考生答案").Value + "▼▼"
'    WenDaID = WenDaID & rs.Fields("ID").Value & ","
'    WenDas = WenDas + ","
'    rs.MoveNext
'  Loop
'
' '作文题
'  rs.Close
'  rs.Open "试卷作文题", LocalConn, adOpenStatic, adLockOptimistic
'  Do While Not rs.EOF
'    ZuoWen = ZuoWen + rs.Fields("考生答案").Value + "▼▼"
'    ZuoWenID = ZuoWenID & rs.Fields("ID").Value & ","
'    ZuoWens = ZuoWens + ","
'    rs.MoveNext
'  Loop
  '判断是否有该题型,没有则处理
  If Danxuan = "" Then
    Danxuan = "/"
    Danxuans = ","
    Danxuanid = ","
  End If
  If Duoxuan = "" Then
    Duoxuan = "/"
    Duoxuans = ","
    Duoxuanid = ","
  End If
'  If TianKong = "" Then
'    TianKong = "▼▼"
'    TianKongID = ","
'    TianKongs = ","
'  End If
'  If PanDuan = "" Then
'    PanDuan = ","
'    PanDuanID = ","
'    PanDuans = ","
'  End If
'  If WenDa = "" Then
'    WenDa = "▼▼"
'    WenDaID = ","
'    WenDas = ","
'  End If
'  If ZuoWen = "" Then
'    ZuoWen = "▼▼"
'    ZuoWenID = ","
'    ZuoWens = ","
'  End If
  '选择
  Danxuan = Left(Danxuan, Len(Danxuan) - 1)
  Duoxuan = Left(Duoxuan, Len(Duoxuan) - 1)
  Danxuans = Left(Danxuans, Len(Danxuans) - 1)
  Duoxuans = Left(Duoxuans, Len(Duoxuans) - 1)
  Danxuanid = Left(Danxuanid, Len(Danxuanid) - 1)
  Duoxuanid = Left(Duoxuanid, Len(Duoxuanid) - 1)
'  '填空
'  TianKong = Left(TianKong, Len(TianKong) - 2)
'  TianKongID = Left(TianKongID, Len(TianKongID) - 1)
'  TianKongs = Left(TianKongs, Len(TianKongs) - 1)
'  ' 判断
'  PanDuan = Left(PanDuan, Len(PanDuan) - 1)
'  PanDuanID = Left(PanDuanID, Len(PanDuanID) - 1)
'  PanDuans = Left(PanDuans, Len(PanDuans) - 1)
'  '问答
'  WenDa = Left(WenDa, Len(WenDa) - 2)
'  WenDaID = Left(WenDaID, Len(WenDaID) - 1)
'  WenDas = Left(WenDas, Len(WenDas) - 1)
'  '作文
'  ZuoWen = Left(ZuoWen, Len(ZuoWen) - 2)
'  ZuoWenID = Left(ZuoWenID, Len(ZuoWenID) - 1)
'  ZuoWens = Left(ZuoWens, Len(ZuoWens) - 1)
  '提交分数
  Dim RemoteConn As Connection
  Set RemoteConn = New Connection
  Dim sql As String
  Dim ID As Long
  RemoteConn.Open ConnString '
  ID = GetAutoID("score")
  '选择题和基本信息
  sql = "insert into score(id,studentid,testid,testtime,score,danxuan,danxuanid,danxuans,duoxuan,duoxuanid,duoxuans,complete) values(" & ID & "," + StudentID + "," & TestID & ",'" + Format(Date, "yyyy-mm-dd") & "'," & Scores & ",'" + Danxuan + "','" + Danxuanid + "','" + Danxuans + "','" + Duoxuan +