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