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
     '顯示