Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H000000C0&
            Height          =   240
            Left            =   4800
            TabIndex        =   12
            Top             =   285
            Width           =   1290
         End
         Begin VB.Label Label7 
            AutoSize        =   -1  'True
            Caption         =   "難度："
            BeginProperty Font 
               Name            =   "宋體"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   6630
            TabIndex        =   11
            Top             =   300
            Width           =   540
         End
      End
   End
   Begin MSComctlLib.ImageList ImgLst 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   95
      ImageHeight     =   24
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmPanDuan.frx":0270
            Key             =   "save"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmPanDuan.frx":0301
            Key             =   "undo"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmPanDuan.frx":0370
            Key             =   "new"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmPanDuan.frx":03EE
            Key             =   "edit"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FrmPanDuan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim NewOrEdit As String

'檢查試卷庫(kù)里是否已經(jīng)用了該題目
Function CheckTestId(ByVal Qid As Long, ByVal IdString) As Boolean
  CheckTestId = True
  Dim i As Integer
  Dim IDArr() As String
  If IdString <> "" Then
    IDArr = Split(IdString, ",")
    For i = 0 To UBound(IDArr)
      If Qid = Val(IDArr(i)) Then Exit Function
    Next i
  End If
  CheckTestId = False
End Function
'從LstTM里取得ID號(hào),返回為long型
Function GetID(ByVal IdString) As Long
   GetID = Val(Mid(IdString, 2))
   
End Function

Private Sub CmbND_Click()
    Dim adoRs As Recordset
   Set adoRs = New Recordset
   '查詢題目id
   If CmbND.ListIndex <> 0 Then
     adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & CmbND.Text & "'", adoCn, adOpenStatic, adLockOptimistic
    Else
     adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
   End If
   LstTM.Clear
  '添加列表
  Do While Not adoRs.EOF
    LstTM.AddItem "第" & adoRs.Fields("id").Value & "題"
    adoRs.MoveNext
  Loop
  Set adoRs = Nothing
  '設(shè)置對(duì)應(yīng)的難度選擇項(xiàng)
  SetText CmbND.Text, CmbNanDu

End Sub

Private Sub CmdDel_Click()

If LstTM.ListIndex < 0 Then
 MsgBox "你還沒(méi)有選擇要?jiǎng)h除的題目呢!", vbExclamation, "系統(tǒng)提示"
 Exit Sub
End If
'========================若此題已被使用則不能刪除*****《待做》

Dim adoRs As Recordset
Set adoRs = New Recordset
adoRs.Open "select panduan from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic

Dim TiID As Long
'獲得ID號(hào)
TiID = GetID(LstTM.List(LstTM.ListIndex))

Do While Not adoRs.EOF
  'MsgBox adoRs.Fields("danxuan")
 ' MsgBox CmdDel.Tag
  If CheckTestId(TiID, adoRs.Fields("panduan")) Then
    MsgBox "試卷庫(kù)里以使用此題目，現(xiàn)在不能刪除！"
    Set adoRs = Nothing
    Exit Sub
  End If
  adoRs.MoveNext
Loop
 Set adoRs = Nothing
 
Dim Result As String
Result = MsgBox("你確實(shí)要?jiǎng)h除此題目嗎!此為無(wú)返回過(guò)程", vbYesNo + vbExclamation, "提問(wèn)?")
If Result = vbNo Then Exit Sub
 
'從數(shù)據(jù)庫(kù)中刪除題目

Dim sql1 As String
sql1 = "delete from questionPD where id=" & TiID
adoCn.Execute sql1
'從LISTVIEW刪除題目
LstTM.RemoveItem LstTM.ListIndex

'清除控件內(nèi)容
ClsTM

End Sub
'判斷輸入是否合格
Function CheckIn() As Boolean
  CheckIn = False
  If RtbTK.Text = "" Then
    MsgBox "請(qǐng)輸入填空題的問(wèn)題主體！"
    RtbTK.SetFocus
    Exit Function
  End If
  CheckIn = True
End Function
Private Sub CmdEdit_Click()
  Dim TiID As Long
 If CmdNew.ToolTipText = "添加題目" Then
  If LstTM.ListIndex < 0 And NewOrEdit <> "New" Then
   MsgBox "請(qǐng)選擇要修改的題目!"
   Exit Sub
  End If
  '========================若此題已被使用則不能修改

  Dim adoRs As Recordset
  Set adoRs = New Recordset
  adoRs.Open "select panduan from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
  '獲得ID號(hào)
  TiID = GetID(LstTM.List(LstTM.ListIndex))
  Do While Not adoRs.EOF
    If CheckTestId(TiID, adoRs.Fields("panduan")) Then
      MsgBox "試卷庫(kù)里以使用此題目，現(xiàn)在不能修改！"
      Exit Sub
    End If
    adoRs.MoveNext
  Loop
  Set adoRs = Nothing
  
  SetEnabled True
  CmdNew.Picture = ImgLst.ListImages(1).Picture
  CmdEdit.Picture = ImgLst.ListImages(2).Picture
  CmdNew.ToolTipText = "保存題目"
  CmdEdit.ToolTipText = "取消保存"
  NewOrEdit = "Edit"
 Else
   If LstTM.ListIndex < 0 Then GoTo NoUndo
  '返回到原狀態(tài)
   Dim adoTMRs As Recordset
   Dim sql As String
   Set adoTMRs = New Recordset
   '獲得ID號(hào)
   TiID = GetID(LstTM.List(LstTM.ListIndex))
   sql = "select * from questionPD where id=" & TiID
   adoTMRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
   '清除控件
   ClsTM
   PlayTM adoTMRs
   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
'清空題目
Sub ClsTM()
 RtbTK.Text = ""

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"
  If CheQK.Value = 1 Then
    '清空
    ClsTM
  End If
 Else
  
    '判斷輸入是否合格
    If CheckIn = False Then
       Exit Sub
    End If
    Dim sql As String
    Dim NanDuStr As String, DaanStr As String
    NanDuStr = CmbNanDu.Text
    '得到答案字符串
    If OptDui.Value = True Then
      DaanStr = "T"
     Else
      DaanStr = "F"
    End If
    '判斷是添加還是編輯
    If NewOrEdit = "New" Then
      Dim Qid As Long '題目Id
      Qid = GetAutoID("questionPD")
      sql = "insert into questionPD(id,kemuid,nianjiid,wenti,daan,nandu) values ("
      sql = sql & Qid & "," & UseKeMuID & "," & UseNianJiID & ",'" & RtbTK.Text & "','" & DaanStr & "','" & NanDuStr & "')"
      adoCn.Execute sql
      LstTM.AddItem "第" & Qid & "題"
     Else
      '更新
      '用CmdNew控件的Tag屬性保存題目ID
      sql = "update questionPD set wenti='" & RtbTK.Text & "',daan='" & DaanStr & "',nandu='" & NanDuStr & "' where id=" & GetID(LstTM.List(LstTM.ListIndex))
      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_Load()
  CmbND.ListIndex = 0
  CmbNanDu.ListIndex = 0
  Dim adoRs As Recordset
  Set adoRs = New Recordset
  adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
  LstTM.Clear
  Do While Not adoRs.EOF
    LstTM.AddItem "第" & adoRs.Fields("id").Value & "題"
    adoRs.MoveNext
  Loop
  Set adoRs = Nothing
End Sub
'設(shè)置是否可以編輯
Sub SetEnabled(ByVal TF As Boolean)
  CmbNanDu.Enabled = TF
  RtbTK.Locked = Not TF
  CmdDel.Enabled = Not TF
  Frame5.Enabled = TF
  Frame2.Enabled = Not TF
End Sub

Private Sub LstTM_Click()
 Dim adoRs As Recordset
 Set adoRs = New Recordset
 adoRs.Open "select * from questionPD where id=" & GetID(LstTM.List(LstTM.ListIndex)), adoCn, adOpenStatic, adLockOptimistic
 PlayTM adoRs
 Set adoRs = Nothing
End Sub

'顯示題目
Sub PlayTM(ByVal adoRs As Recordset)
  SetText adoRs.Fields("nandu").Value, CmbNanDu
  RtbTK.Text = adoRs.Fields("wenti").Value
  If adoRs.Fields("daan").Value = "T" Then
     OptDui.Value = True
    Else
     OptCuo.Value = True
  End If
End Sub
'顯示下來(lái)列表的列
Sub SetText(ByVal TXT As String, ByVal CmbBox As ComboBox)
  Dim i As Integer
  For i = 0 To CmbBox.ListCount - 1
    If CmbBox.List(i) = TXT Then
      CmbBox.ListIndex = i
      Exit Sub
    End If
  Next i
End Sub

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

End Sub