frmkaoshi.frm

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

NewWho = 1
End Sub

'生成题目树
Sub CreateTree()
  
  Dim adoRS As Recordset
  Dim i As Integer
  Dim MyNod As Node
  Dim NewNod As Node
 '显示试卷题目信息
 '打开记录集
  Set adoRS = New Recordset
  adoRS.CursorLocation = adUseClient

  adoRS.Open "select ID from 试卷选择题 where 类别='单'", LocalConn, adOpenStatic, adLockOptimistic
   
  '=========
  '判断是否有单选  '===================
  If adoRS.RecordCount <> 0 Then
     '=========建立单项选择根接点
  Set MyNod = TrVTM.Nodes.Add(, , "node_dan", "单项选择题", 1)
  Do While Not adoRS.EOF
    '建立单项题节点
    Set NewNod = TrVTM.Nodes.Add("node_dan", tvwChild, "node_dan|" + Trim(str(adoRS.Fields("ID").Value)), "第" + Trim(str(adoRS.AbsolutePosition)) + "题", 2)
    adoRS.MoveNext
  Loop
  End If
  adoRS.Close
 
   '=========建立多选
  adoRS.Open "select ID from 试卷选择题 where 类别='多'", LocalConn, adOpenStatic, adLockOptimistic
  If adoRS.RecordCount <> 0 Then
   '建立多项选择根接点
  Set MyNod = TrVTM.Nodes.Add(, , "node_duo", "多项选择题", 1)
  Do While Not adoRS.EOF
    '建立多项题节点
    Set NewNod = TrVTM.Nodes.Add("node_duo", tvwChild, "node_duo|" + Trim(str(adoRS.Fields("ID").Value)), "第" + Trim(str(adoRS.AbsolutePosition)) + "题", 2)
    adoRS.MoveNext
  Loop
  Set adoRS = Nothing
  End If
End Sub

'设置现在做的是那个题型，显示那个图片框
Sub SetPicVisible(ByVal Who As Integer)
  'who表示的是现在编辑的题型的序号
NewWho = Who
Select Case Who
   Case 1
      PicTK.Visible = False
      PicPD.Visible = False
      PicWD.Visible = False
      PicZW.Visible = False
      PicXZ.Visible = True
   Case 2
     PicXZ.Visible = False
      PicPD.Visible = False
      PicWD.Visible = False
      PicZW.Visible = False
     PicTK.Visible = True
   Case 3
     PicXZ.Visible = False
      PicTK.Visible = False
      PicWD.Visible = False
      PicZW.Visible = False
     PicPD.Visible = True
   Case 4
     PicXZ.Visible = False
      PicTK.Visible = False
      PicPD.Visible = False
      PicZW.Visible = False
     PicWD.Visible = True
   Case 5
     PicXZ.Visible = False
      PicTK.Visible = False
      PicPD.Visible = False
      PicWD.Visible = False
     PicZW.Visible = True
 End Select
End Sub
'保存答案
Sub SaveAll()
  Select Case NewWho
    Case 1
     SaveDaAN
    Case 2
     SaveTK
    Case 3
     SavePD
    Case 4
     SaveWD
    Case 5
     SaveZW
  End Select
End Sub
Private Sub Form_Resize()
    '设置各组和框的位置
  PicTK.Top = PicXZ.Top
  PicTK.Left = PicXZ.Left
  PicPD.Top = PicXZ.Top
  PicPD.Left = PicXZ.Left
  PicWD.Top = PicXZ.Top
  PicWD.Left = PicXZ.Left
  PicZW.Top = PicXZ.Top
  PicZW.Left = PicXZ.Left

End Sub


Private Sub ImgPD_Click()
  SaveAll '保存答案
   SetPicVisible 3
End Sub

Private Sub imgSubmit_Click()
       '交卷
 Dim answer As String
 SaveDaAN
 MsgBox "请检查你所做的题目有没有漏和错！你一旦交了卷就不能更改了！"
 answer = MsgBox("你确定真的要交卷吗?请慎重考虑！！！！", vbExclamation + vbYesNo, "确定")
 If answer = vbYes Then
   If JiaoJuan = True Then '处理交卷
      DelDB
      MsgBox "你已经成功的交了卷！"
      Unload Me
    Else
      MsgBox "交卷失败，请重试或者报告老师！"
   End If
 End If

End Sub

Private Sub ImgTK_Click()
    SaveAll '保存答案
  SetPicVisible 2
End Sub

Private Sub ImgWD_Click()
      SaveAll '保存答案
    SetPicVisible 4
End Sub

Private Sub ImgXZ_Click()
     SaveAll '保存答案
   SetPicVisible 1

End Sub

Private Sub ImgZW_Click()
     SaveAll '保存答案
    SetPicVisible 5
End Sub

Private Sub LabWDSave_Click()
 If LstWD.Tag = "" Then
    MsgBox "请选择要保存的题目！"
    Exit Sub
 End If
 '保存问答题
 SaveWD
 MsgBox "答案已经保存成功！"
End Sub

Private Sub LabZWSave_Click()
 If LstZW.Tag = "" Then
   MsgBox "请选择保存的题目!"
   Exit Sub
 End If
 SaveZW
 MsgBox "作文已经成功的保存！"
End Sub

Private Sub LstPD_Click()
  Dim NewDAan As String
  If OptMei.Value = True Then
     NewDAan = ""
    ElseIf OptDui.Value = True Then
     NewDAan = "T"
    Else
     NewDAan = "F"
  End If
  If NewDAan <> OldDAan Then
    SavePD
  End If
  ViewPD PDIDArr(LstPD.ListIndex + 1)
  If OptMei.Value = True Then
     OldDAan = ""
    ElseIf OptDui.Value = True Then
     OldDAan = "T"
    Else
     OldDAan = "F"
  End If
  LstPD.Tag = PDIDArr(LstPD.ListIndex + 1)
End Sub

Private Sub LstTK_Click()
'判断是否改变
  Dim NewDAan As String
  Dim i As Integer
  If RtbTK.Tag <> "" Then
    For i = 1 To Val(RtbTK.Tag)
      NewDAan = NewDAan + TxTDaan(i).Text
    Next i
    If OldDAan <> NewDAan Then
      SaveTK
    End If
  End If
  ViewTK TKIDArr(LstTK.ListIndex + 1)
  OldDAan = ""
  For i = 1 To Val(RtbTK.Tag)
      OldDAan = OldDAan + TxTDaan(i).Text
  Next i
  LstTK.Tag = TKIDArr(LstTK.ListIndex + 1)
End Sub

Private Sub LstWD_Click()
 If OldDAan <> RtbWDDA.Text Then
    SaveWD
 End If
 ViewWD WDIDArr(LstWD.ListIndex + 1)
 OldDAan = RtbWDDA.Text
 LstWD.Tag = WDIDArr(LstWD.ListIndex + 1)
End Sub

Private Sub LstZW_Click()
  If OldDAan <> RtbZW.Text Then
    SaveZW
  End If
  ViewZW ZWIDArr(LstZW.ListIndex + 1)
  OldDAan = RtbZW.Text
  LstZW.Tag = ZWIDArr(LstZW.ListIndex + 1)
End Sub

Private Sub RtbWDDA_KeyPress(KeyAscii As Integer)
   If KeyAscii = 39 Then KeyAscii = -24145

End Sub

Private Sub RtbZW_KeyPress(KeyAscii As Integer)
    If KeyAscii = 39 Then KeyAscii = -24145

End Sub

Private Sub TrVTM_NodeClick(ByVal Node As MSComctlLib.Node)
   Dim Pid As Long
   
   If Node.Children = 0 Then
      
       '判断答案是否改变,改变则保存
       Dim i As Integer
       Dim NewDAan As String
       For i = 0 To 3
       If Check1(i).Value Then
          NewDAan = NewDAan & Check1(i).Caption & ","
       End If
       Next i
       '改变则保存
       If OldDAan <> NewDAan And TXTView.Tag <> "" Then
          SaveDaAN
       End If
       '显示
       
       Pid = Val(Right(Node.Key, Len(Node.Key) - 9))
       '查询显示
       Dim adoTMRs As Recordset
       Dim sql As String
       Set adoTMRs = New Recordset
       adoTMRs.CursorLocation = adUseClient

       sql = "select * from 试卷选择题 where ID=" + str(Pid)
       adoTMRs.Open sql, LocalConn, adOpenStatic, adLockOptimistic
       ViewTM adoTMRs
       '保存作为上一次的答案,判断答案是否改变,改变则保存
       OldDAan = ""
       For i = 0 To 3
       If Check1(i).Value Then
          OldDAan = OldDAan & Check1(i).Caption & ","
       End If
       Next i
              
       '在控件里保存所选的题目ID
       TXTView.Tag = Pid
       
       '关闭记录集
       Set adoTMRs = Nothing
       
      
     'PopupMenu M_Add
   End If
End Sub
'产生填空框
Sub CreateDA()
  Dim i As Integer
  For i = 1 To 30
    If (i Mod 2) = 0 Then
       Load LabDaan(i)
       LabDaan(i).Caption = i & "、"
       LabDaan(i).Left = 3190
       'LabDaan(i).Visible = True
       Load TxTDaan(i)
       TxTDaan(i).Left = 3525
       '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
     '显示