frmquestion.frm

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

   adoTMRs.Close
NoUndo:
  SetEnabled False
  CmdNew.Picture = ImgLst.ListImages(3).Picture
  CmdEdit.Picture = ImgLst.ListImages(4).Picture
  CmdNew.ToolTipText = "添加题目"
  CmdEdit.ToolTipText = "编辑题目"
  NewOrEdit = ""
 End If
 
End Sub

Private Sub CmdExit_Click()
 Unload Me
End Sub

Private Sub CmdNew_Click()
 If CmdNew.ToolTipText = "添加题目" Then
  SetEnabled True
  CmdNew.Picture = ImgLst.ListImages(1).Picture
  CmdEdit.Picture = ImgLst.ListImages(2).Picture
  CmdNew.ToolTipText = "保存题目"
  CmdEdit.ToolTipText = "取消保存"
  NewOrEdit = "New"
  '将后添的三个控件置空
'  CmbBumen.Text = ""
'  Cmbtilei.Text = ""
  TxtZhuti.Text = ""

  
  If CheQK.Value = 1 Then
    '清空
    ClsTM
  End If
 Else
  
    '判断输入是否合格
    If CheckIn = False Then
       Exit Sub
    End If
    Dim sql As String
    Dim XuanZeStr As String, NanDuStr As String, DaanStr As String
    Dim LeiBie As String
    Dim i As Integer
    '定义部门、题类、主题词字段
    Dim BumenStr As String, TileiStr As String, ZhutiStr As String
    '给部门、题类、主题词字段赋值
    BumenStr = CmbBumen.Text
    TileiStr = Cmbtilei.Text
    ZhutiStr = TxtZhuti.Text
    
    NanDuStr = CmbNanDu.Text
    DaanStr = GetDaan()
    '得到类别
    If OpDuo.Value = True Then
      LeiBie = "多"
      Else
      LeiBie = "单"
    End If
    '判断是添加还是编辑
    If NewOrEdit = "New" Then
      'SQL = "insert into question(kemu,wenti,xuanze,daan,nianji,image,nandu,author) values ('"
      'SQL = SQL + kemuStr + "','" + TxTTM + "','" + XuanZeStr + "','" + DaanStr + "','" + nianjiStr + "',NULL,'" + NanDuStr + "','00')"
      'adocn.Execute SQL
      If CmbBumen.Text = "" Or Cmbtilei.Text = "" Or CmbNanDu.Text = "" Then
      MsgBox "<来自部门><题类><难度>三个字段不允许为空", vbExclamation, "提示"
      Exit Sub
      End If
      Dim Qid As Long '题目Id
      Qid = GetAutoID("question")
      Dim adoQuestionRs As Recordset
      Set adoQuestionRs = New Recordset
      adoQuestionRs.Open "select * from  question", adoCn, adOpenStatic, adLockOptimistic
      adoQuestionRs.AddNew
      adoQuestionRs.Fields("id") = Qid
      adoQuestionRs.Fields("kemuid") = UseKeMuID
      adoQuestionRs.Fields("wenti") = TxTTM
      adoQuestionRs.Fields("xuanze1") = TxTXuanZe(0)
      adoQuestionRs.Fields("xuanze2") = TxTXuanZe(1)
      adoQuestionRs.Fields("xuanze3") = TxTXuanZe(2)
      adoQuestionRs.Fields("xuanze4") = TxTXuanZe(3)
      adoQuestionRs.Fields("daan") = DaanStr
      adoQuestionRs.Fields("nianjiid") = UseNianJiID
      adoQuestionRs.Fields("nandu") = NanDuStr
      adoQuestionRs.Fields("leibie") = LeiBie
      adoQuestionRs.Fields("bumen") = BumenStr
      adoQuestionRs.Fields("tilei") = TileiStr
      adoQuestionRs.Fields("zhutici") = ZhutiStr
      
      
      adoQuestionRs.Update
      Dim APosition As Long
      APosition = adoQuestionRs.AbsolutePosition
      '添加节点
      adoQuestionRs.Close
      adoQuestionRs.Open "select * from  question", adoCn, adOpenStatic, adLockOptimistic
      adoQuestionRs.AbsolutePosition = APosition
      'MsgBox adoQuestionRs.Fields("id").Value
      
      'Exit Sub
      Dim NewNod As Node
      Set NewNod = TrVKeMu.Nodes.Add("node_nd|" + LeiBie + "|" + NanDuStr, tvwChild, "N" + Int2Str(adoQuestionRs.Fields("id").Value), "第" + Trim(str(adoQuestionRs.Fields("id").Value)) + "题" + " " + adoQuestionRs.Fields("wenti").Value)
      CmdNew.Tag = adoQuestionRs.Fields(0).Value
       adoQuestionRs.Close
    Else
      '更新
      '用CmdNew控件的Tag属性保存题目ID
      sql = "update question set kemuid=" + Int2Str(UseKeMuID) + ",wenti='" + TxTTM + "',xuanze1='" + TxTXuanZe(0).Text + "',xuanze2='" + TxTXuanZe(1).Text + "',xuanze3='" + TxTXuanZe(2).Text + "',xuanze4='" + TxTXuanZe(3).Text + "',daan='" + DaanStr + "',nianjiid=" + Int2Str(UseNianJiID) + ", nandu='" + NanDuStr + "',leibie='" + LeiBie + "' where id=" + CmdNew.Tag
      adoCn.Execute sql
    End If
  
  SetEnabled False
  CmdNew.Picture = ImgLst.ListImages(3).Picture
  CmdEdit.Picture = ImgLst.ListImages(4).Picture
  CmdNew.ToolTipText = "添加题目"
  CmdEdit.ToolTipText = "编辑题目"
  NewOrEdit = ""
 End If

'adoQuestionRs.Close

End Sub



Private Sub Form_Activate()
 Unload FrmFlash

End Sub



Private Sub Form_Load()
  '初始化状态栏
  Stb.Panels(4).Text = Date
  Stb.Panels(5).Text = Time
  Stb.Panels(1).Text = "当前操作员编号：" + UserCode
  Dim adoRs As Recordset
  Set adoRs = New Recordset
  adoRs.Open "select name from admin where code='" + UserCode + "'", adoCn, adOpenStatic, adLockOptimistic
  Stb.Panels(2).Text = "操作员姓名：" + adoRs.Fields(0).Value
  Set adoRs = Nothing
 '定义部门和题类记录集
 Dim adoBumenRs As Recordset
 Dim adotileiRs As Recordset
 Set adoBumenRs = New Recordset
 Set adotileiRs = New Recordset
   
 '初始化部门datacombo
   adoBumenRs.Open "bumen", adoCn, adOpenStatic, adLockOptimistic
 If Not adoBumenRs.EOF Then
   adoBumenRs.MoveLast
   adoBumenRs.MoveFirst
   ReDim BumenIdArr(adoBumenRs.RecordCount) As Long
    '添加到控件
   Do While Not adoBumenRs.EOF
      BumenIdArr(0) = adoBumenRs.Fields("id").Value
      '0
      CmbBumen.AddItem adoBumenRs.Fields("bumen").Value
      adoBumenRs.MoveNext
   Loop
   CmbBumen.ListIndex = 0
 End If
 Set adoBumenRs = Nothing
  
  '初始化题类datacombo
   adotileiRs.Open "tilei", adoCn, adOpenStatic, adLockOptimistic
 If Not adotileiRs.EOF Then
   adotileiRs.MoveLast
   adotileiRs.MoveFirst
   ReDim TileiIdArr(adotileiRs.RecordCount) As Long
    '添加到控件
   Do While Not adotileiRs.EOF
      TileiIdArr(0) = adotileiRs.Fields("id").Value
      Cmbtilei.AddItem adotileiRs.Fields("tilei").Value
      adotileiRs.MoveNext
   Loop
   Cmbtilei.ListIndex = 0
 End If
 Set adotileiRs = Nothing
 
 
 
   Dim MyNod As Node
  ', Mynod1 As Node
  Dim NewNod As Node
  Dim sql As String
  '难度
  Dim NanDu(1 To 3) As String
  '类别
  Dim LeiBie(1 To 2) As String
  Dim j As Integer
  Dim k As Integer
  Dim adoQuestionRs As Recordset
  Set adoQuestionRs = New Recordset
  Dim NanDuStr As String
  NanDu(1) = "低"
  NanDu(2) = "中"
  NanDu(3) = "高"
  LeiBie(1) = "单"
  LeiBie(2) = "多"
 'cmdnew 加图片
 CmdNew.Picture = ImgLst.ListImages(3).Picture
 '建立根接点
  For k = 1 To 2
  '建立类别节点
  Set NewNod = TrVKeMu.Nodes.Add(, , "node_ml|" + LeiBie(k), LeiBie(k) + "项选择")
  '建立难度节点
  For j = 1 To 3
       NanDuStr = NanDu(j)
       Set NewNod = TrVKeMu.Nodes.Add("node_ml|" + LeiBie(k), tvwChild, "node_nd|" + LeiBie(k) + "|" + NanDu(j), NanDu(j))
       NewNod.Image = "nandu"
       NewNod.ExpandedImage = "nanduopen"
       '建立题目节点
       sql = "select id,wenti from question where kemuid=" + Int2Str(UseKeMuID) + " and nianjiid=" + Int2Str(UseNianJiID) + " and nandu='" + NanDu(j) + "' and leibie='" + LeiBie(k) + "' order by id"
       adoQuestionRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
       Do While Not adoQuestionRs.EOF
          Dim StrWenti As String
          StrWenti = adoQuestionRs.Fields("wenti").Value
                 
          Set NewNod = TrVKeMu.Nodes.Add("node_nd|" + LeiBie(k) + "|" + NanDu(j), tvwChild, "N" + Int2Str(adoQuestionRs.Fields("id").Value), "第" + Trim(str(adoQuestionRs.Fields("id").Value)) + "题" + " " + adoQuestionRs.Fields("wenti").Value)
          adoQuestionRs.MoveNext
       Loop
       adoQuestionRs.Close
     Next j
 Next k
 '产生选择项
 CreateXuanZe
 '设置控件可否编辑
 SetEnabled False
End Sub





Private Sub OpDan_Click()
'检查答案时候只有一个
 Dim i As Integer
 Dim DaanCount As Integer
 DaanCount = 0
 For i = 0 To 3
   If CheDaAn(i).Value = 1 Then
     DaanCount = DaanCount + 1
   End If
 Next i
 If DaanCount > 1 Then
   MsgBox "你的答案不止一个答案，不能是单选题！"
   OpDuo.Value = True
 End If
End Sub

Private Sub OpDan_KeyDown(KeyCode As Integer, Shift As Integer)
     If KeyCode = vbKeyRight Then OpDuo.SetFocus
End Sub
Private Sub ipduo_KeyDown(KeyCode As Integer, Shift As Integer)
     If KeyCode = vbKeyLeft Then OpDan.SetFocus
End Sub

Private Sub TrVkemu_NodeClick(ByVal Node As MSComctlLib.Node)
  If Left(Node.Key, 7) = "node_nd" Then
       SetCmbText Node.Text, CmbNanDu
       Exit Sub
  End If
   
   '===========================
   
   Dim Pid As Long
   If Node.Children = 0 And Left(Node.Key, 1) = "N" Then
       Pid = Val(Right(Node.Key, Len(Node.Key) - 1))
       '查询显示
       Dim adoTMRs As Recordset
       Dim sql As String
       Set adoTMRs = New Recordset
       sql = "select * from question where id=" + str(Pid)
       adoTMRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
       CmdDel.Tag = Node.Index
       '清除控件
       ClsTM
       PlayTM adoTMRs
       adoTMRs.Close
   End If
End Sub
Sub SetCmbText(ByVal str As String, ByVal CmbBox As ComboBox)
  '查找对应项
  Dim i As Integer
  For i = 0 To CmbBox.ListCount - 1
    If str = CmbBox.List(i) Then CmbBox.ListIndex = i
  Next i
  
End Sub

'设置控件是否可以编辑
Sub SetEnabled(ByVal TF As Boolean)
  Dim i As Integer
  CmbKeMu.Enabled = TF
  CmbNianJi.Enabled = TF
  CmbNanDu.Enabled = TF
  CmbBumen.Enabled = TF
  Cmbtilei.Enabled = TF
  TxtZhuti.Enabled = TF
  TrVKeMu.Enabled = Not TF
'  CmbGS.Enabled = TF
  TxTTM.Locked = Not TF
  For i = 0 To 3
     TxTXuanZe(i).Locked = Not TF
  Next i
  FrmeDA.Enabled = TF
  'FrmeMove.Enabled = Not TF
  CmdDel.Enabled = Not TF
  OpDuo.Enabled = TF
  OpDan.Enabled = TF
End Sub
'得到答案字符串
Function GetDaan() As String
  Dim i As Integer
  Dim str As String
  For i = 0 To 3
    If CheDaAn(i).Value = 1 Then
       str = str + Chr(65 + i) + ","
    End If
  Next i
  If str <> "" Then str = Left(str, Len(str) - 1)
  GetDaan = str
End Function
'检查输入时候合格
Function CheckIn() As Boolean
  CheckIn = False
   Dim i As Integer
    '检查难度
   If CmbNanDu.Text = "" Then
      MsgBox "请选择难度！"
      CmbNanDu.SetFocus
      Exit Function
   End If
   
   If Trim(TxTTM) = "" Then
      MsgBox "请把题目填写完整！", 48, "提示！"
      Exit Function
   End If
   For i = 0 To 3
     If Trim(TxTXuanZe(i)) = "" Then
          MsgBox "请把选择项填写完整！", 48, "提示"
          TxTXuanZe(i).SetFocus
          Exit Function
     End If
   Next i
   If GetDaan() = "" Then
     MsgBox "请选择该题目的正确答案，以便电脑判卷！", 48, "提示"
     Exit Function
   End If
     CheckIn = True
End Function
'显示题目模块
Sub PlayTM(ByVal tmRS As Recordset)
   Dim DaanArr() As String
   Dim i As Integer, j As Integer
   'SetCmbText tmRS.Fields("kemu"), CmbKeMu
   'SetCmbText tmRS.Fields("nianji"), CmbNianji
   SetCmbText tmRS.Fields("nandu"), CmbNanDu
   SetCmbText tmRS.Fields("bumen"), CmbBumen
   SetCmbText tmRS.Fields("tilei"), Cmbtilei
   TxtZhuti.Text = tmRS.Fields("zhutici")
   TxTTM.Text = tmRS.Fields("wenti")
   CmdNew.Tag = tmRS.Fields("id")
   LabTihao.Caption = CStr(tmRS.Fields("id"))
   If tmRS.Fields("leibie") = "多" Then
      OpDuo.Value = True
     Else
      OpDan.Value = True
   End If

   '显示选项:
   TxTXuanZe(0).Text = tmRS.Fields("xuanze1")
   TxTXuanZe(1).Text = tmRS.Fields("xuanze2")
   TxTXuanZe(2).Text = tmRS.Fields("xuanze3")
   TxTXuanZe(3).Text = tmRS.Fields("xuanze4")
   '显示选择的答案
   DaanArr = Split(tmRS.Fields("daan"), ",")
   For i = 0 To UBound(DaanArr)
    For j = 0 To 3
     If CheDaAn(j).Caption = DaanArr(i) Then CheDaAn(j).Value = 1
    Next j
   Next i
   
End Sub

'清空题目的显示控件
Sub ClsTM()
  TxTTM.Text = ""
  Dim i As Integer
  For i = 0 To 3
    TxTXuanZe(i).Text = ""
    CheDaAn(i).Value = 0
  Next i
End Sub

Private Sub txttm_KeyPress(KeyAscii As Integer)

   If KeyAscii = 39 Then KeyAscii = -24145
   If KeyAscii = 13 Then OpDan.SetFocus


End Sub

Private Sub TxTXuanZe_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 39 Then KeyAscii = -24145
   If KeyAscii <> 13 Then Exit Sub
   Select Case Index
      Case 0
          TxTXuanZe(1).SetFocus
      Case 1
          TxTXuanZe(2).SetFocus
      Case 2
          TxTXuanZe(3).SetFocus
      Case 3
          CheDaAn(0).SetFocus
   End Select
   
   

End Sub