frmkaoshi.frm

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

adoRS.Close

 '创建选择题的树
 CreateTree
 
''显示填空题显示
'adoRS.Close
'adoRS.Open "select ID from 试卷填空题", LocalConn, adOpenStatic, adLockOptimistic
'LstTK.Clear
'If Not adoRS.EOF Then
'  adoRS.MoveLast
'  adoRS.MoveFirst
'  '重定义
'  ReDim TKIDArr(adoRS.RecordCount + 1) As Long
'  Do While Not adoRS.EOF
'     LstTK.AddItem "第" & adoRS.AbsolutePosition & "题"
'     TKIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
'     adoRS.MoveNext
'  Loop
'End If
'
''显示判断题显示
'adoRS.Close
'adoRS.Open "select ID from 试卷判断题", LocalConn, adOpenStatic, adLockOptimistic
'LstPD.Clear
'If Not adoRS.EOF Then
'  adoRS.MoveLast
'  adoRS.MoveFirst
'  '重定义
'  ReDim PDIDArr(adoRS.RecordCount + 1) As Long
'  Do While Not adoRS.EOF
'     LstPD.AddItem "第" & adoRS.AbsolutePosition & "题"
'     PDIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
'     adoRS.MoveNext
'  Loop
'End If
'
''显示问答题显示
'adoRS.Close
'adoRS.Open "select ID from 试卷问答题", LocalConn, adOpenStatic, adLockOptimistic
'LstWD.Clear
'If Not adoRS.EOF Then
'  adoRS.MoveLast
'  adoRS.MoveFirst
'  '重定义
'  ReDim WDIDArr(adoRS.RecordCount + 1) As Long
'  Do While Not adoRS.EOF
'     LstWD.AddItem "第" & adoRS.AbsolutePosition & "题"
'     WDIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
'     adoRS.MoveNext
'  Loop
'End If
'
''显示作文题显示
'adoRS.Close
'adoRS.Open "select ID from 试卷作文题", LocalConn, adOpenStatic, adLockOptimistic
'LstZW.Clear
'If Not adoRS.EOF Then
'  adoRS.MoveLast
'  adoRS.MoveFirst
'  '重定义
'  ReDim ZWIDArr(adoRS.RecordCount + 1) As Long
'  Do While Not adoRS.EOF
'     LstZW.AddItem "第" & adoRS.AbsolutePosition & "题"
'     ZWIDArr(adoRS.AbsolutePosition) = adoRS.Fields("ID").Value
'     adoRS.MoveNext
'  Loop
'End If
'显示背景图片
PicXZ.Picture = Me.Picture
'PicTK.Picture = Me.Picture
'PicPD.Picture = Me.Picture
'PicWD.Picture = Me.Picture
'PicZW.Picture = Me.Picture
''产生填空框
'CreateDA
'初始化

'使除开始外的其他按钮不可用
TrVTM.Enabled = False
Dim i As Integer
For i = 0 To 3
   Check1(i).Enabled = False
Next i
CmdRefer.Enabled = False
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

 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 Timer1_Timer()
 CountSec = CountSec - 1
 labTime.Caption = Sec2Time(CountSec)
 If CountSec <= 0 Then
    Timer1.Enabled = False
    MsgBox "交卷时间到！！"
    
 End If
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