Option Explicit
''
Private Sub InitSubjectSet()
Dim rst As Recordset
Dim i       As Integer
    Set rst = New Recordset
    rst.LockType = adLockBatchOptimistic
    rst.CursorLocation = adUseClient
    rst.CursorType = adOpenStatic
    rst.ActiveConnection = pCN
    rst.Source = "select * from 套号"
    rst.Open
    Me.Combo1.Clear
    For i = 1 To rst.RecordCount
        Me.Combo1.AddItem rst![套号名称]
        Me.Combo1.ItemData(Me.Combo1.ListCount - 1) = rst![ID]
        rst.MoveNext
    Next i
    If Combo1.ListCount > 0 Then
        Combo1.ListIndex = 0
    End If
    Set rst = Nothing
End Sub



Private Sub Combo1_Click()
    Me.Adodc1.ConnectionString = pCN.ConnectionString
    Me.Adodc1.RecordSource = "select ID,题目编号,题目内容,类型,题目答案,题目分值,题目备注 from V_题库主表 where 题目套号=" & Combo1.ItemData(Combo1.ListIndex)
    Me.Adodc1.Refresh
    Set Me.MSHFlexGrid1.Recordset = Me.Adodc1.Recordset
    Me.MSHFlexGrid1.Refresh
End Sub

Private Sub Command1_Click()
Call frmSubjectEdit.EditSubject(, Me.Combo1.ItemData(Me.Combo1.ListIndex))
    Call InitSubject
End Sub

Private Sub Command2_Click()
    Call frmSubjectEdit.EditSubject(Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0), Me.Combo1.ItemData(Me.Combo1.ListIndex))
    Call InitSubject
End Sub

Private Sub Command3_Click()
Dim rst As Recordset
    
    If Me.MSHFlexGrid1.Rows > 1 Then
        If MsgBox("你真的要删除选中的题目吗?", vbQuestion + vbOKCancel) = vbOK Then
            If Me.MSHFlexGrid2.Rows > 1 Then
                MsgBox "下面还有备选记录不能删除!", vbInformation
                GoTo Proc_Exit
            End If
            
            Set rst = New Recordset
            rst.Open "select * from 考生答案 where 题目编号='" & Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1) & "'", pCN, adOpenStatic, adLockBatchOptimistic
            If rst.RecordCount > 0 Then
                MsgBox "已经有考生考过该题了，不能删除!", vbInformation
                GoTo Proc_Exit
            End If
            
            Set rst = Nothing
            
            pCN.Execute "delete from 题库主表 where 题目编号='" & Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1) & "'"
            If Me.MSHFlexGrid1.Rows > 2 Then
                Me.MSHFlexGrid1.RemoveItem Me.MSHFlexGrid1.Row
            Else
                Me.MSHFlexGrid1.Rows = 1
            End If
            Call InitSubjectAnswer
        End If
    End If
Proc_Exit:
    
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Command5_Click()
    Call frmSubjectAnswerEdit.EditSubjectAnswer(Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1), Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 2))
    Call InitSubjectAnswer
End Sub

Private Sub Command6_Click()
    If Me.MSHFlexGrid2.Rows > 1 Then
        Call frmSubjectAnswerEdit.EditSubjectAnswer(Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1), Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 2), Me.MSHFlexGrid2.TextMatrix(Me.MSHFlexGrid2.Row, 0))
        Call InitSubjectAnswer
    End If
End Sub

Private Sub Command7_Click()
Dim rst As Recordset
    If Me.MSHFlexGrid2.Rows > 1 Then
        If MsgBox("你真的要删除选中的答案吗?", vbQuestion + vbOKCancel) = vbOK Then
            Set rst = New Recordset
            rst.Open "select * from 考生答案 where 题目编号='" & Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1) & "'", pCN, adOpenStatic, adLockBatchOptimistic
            If rst.RecordCount > 0 Then
                MsgBox "已经有考生考过该题了，不能删除!", vbInformation
                GoTo Proc_Exit
            End If
            
            pCN.Execute "delete from 题目明细 where ID=" & Me.MSHFlexGrid2.TextMatrix(Me.MSHFlexGrid2.Row, 0)
            If Me.MSHFlexGrid2.Rows = 2 Then
                Me.MSHFlexGrid2.Rows = 1
            Else
                Me.MSHFlexGrid2.RemoveItem Me.MSHFlexGrid2.Row
            End If
            
        End If
    End If
Proc_Exit:

End Sub

Private Sub Form_Load()
frmSubject.Height = 0
    Call InitSubjectSet
    Call InitSubject
End Sub

Private Sub InitSubject()
    Me.Adodc1.ConnectionString = pCN.ConnectionString
    Me.Adodc1.RecordSource = "select * from 题库主表 where 题目套号=" & Me.Combo1.ItemData(Me.Combo1.ListIndex)
    Me.Adodc1.Refresh
    Set Me.MSHFlexGrid1.Recordset = Me.Adodc1.Recordset
    If Me.MSHFlexGrid1.Rows > 1 Then
        Me.MSHFlexGrid1.Row = 1
    End If
    Call InitSubjectAnswer
End Sub

Private Sub InitSubjectAnswer()
    If Me.MSHFlexGrid1.Rows > 1 Then
        Me.Adodc2.ConnectionString = pCN.ConnectionString
        Me.Adodc2.RecordSource = "select * from 题目明细 where 题目编号='" & Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1) & "'"
        Me.Adodc2.Refresh
        Set Me.MSHFlexGrid2.Recordset = Me.Adodc2.Recordset
    Else
        Me.MSHFlexGrid2.Rows = 1
    End If
End Sub


Private Sub MSHFlexGrid1_Click()
    Call InitSubjectAnswer
End Sub


Private Sub MSHFlexGrid1_RowColChange()
    Call InitSubjectAnswer
End Sub

Private Sub Timer1_Timer()
If frmSubject.Height < 6840 Then
frmSubject.Height = frmSubject.Height + 100
End If
End Sub








Option Explicit
Private mblnEdit As Boolean
Private mlngID As Long

Public Sub EditSubjectAnswer(ByVal strSubjectID As String, ByVal strSubjectText As String, Optional ByVal lngID As Long = 0)
Dim rst As Recordset
    Text1 = strSubjectID
    Text2 = strSubjectText
    mlngID = lngID
    mblnEdit = (lngID <> 0)
    If mblnEdit Then
        Set rst = New Recordset
        rst.Open "select * from 题目明细 where ID=" & lngID, pCN, adOpenStatic, adLockBatchOptimistic
        Text3 = rst![题目编码]
        Text4 = rst![备选答案]
        Text5 = rst![题目备注] & ""
    End If
    Set rst = Nothing
    Me.Show 1
End Sub

Private Sub Command1_Click()
Dim rst As Recordset
On Error GoTo Proc_Exit
    If Len(Text3) = 0 Then
        MsgBox "题目编码不为空!", vbInformation
        GoTo Proc_Exit
    End If
    
    If Len(Text3) > 1 Then
        MsgBox "题目编码为一位的字母!", vbInformation
        GoTo Proc_Exit
    End If
    
    If Not (Asc(Text3) >= 65 And Asc(Text3) <= 90) And Not (Asc(Text3) >= 97 And Asc(Text3) <= 122) Then
        MsgBox "题目编码必须为字母!", vbInformation
        GoTo Proc_Exit
    End If
        
    If Len(Text4) = 0 Then
        MsgBox "备选答案不为空!", vbInformation
        GoTo Proc_Exit
    End If
    
    Set rst = New Recordset
    If mblnEdit Then
        rst.Open "select * from 题目明细 where ID=" & mlngID, pCN, adOpenStatic, adLockBatchOptimistic
    Else
        rst.Open "select * from 题目明细", pCN, adOpenStatic, adLockBatchOptimistic
        rst.AddNew
    End If
     
    rst![题目编号] = Text1
    rst![题目编码] = UCase(Text3)
    rst![备选答案] = Text4
    rst![题目备注] = Text5
    rst.UpdateBatch
    mblnEdit = False
    Text3 = ""
    Text4 = ""
    Text5 = ""
    Text3.SetFocus
Proc_Exit:
    If Err.Number <> 0 Then
        MsgBox "发生意外错误,错误号:" & Err.Number & " 错误描述:" & Err.Description
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub












Option Explicit


Private mlngID As Long
Private mblnEdit As Boolean
Private mlngSubjectID As Long

Public Function EditSubject(Optional ByVal lngID As Long = 0, Optional lngSubjectSetID As Long)
Dim rst As Recordset
    mlngSubjectID = lngSubjectSetID
    mlngID = lngID
    mblnEdit = IIf(lngID > 0, True, False)
    If mblnEdit Then
        Set rst = New Recordset
        rst.Open "select * from 题库主表 where ID=" & lngID, pCN, adOpenStatic, adLockBatchOptimistic
        Text3 = rst![题目编号]
        If rst![题目类型] Then
            Option2.Value = True
        Else
            Option1.Value = True
        End If
        Text1 = rst![题目内容]
        Text4 = rst![题目分值]
        Text5 = rst![题目答案]
        Text2 = rst![题目备注] & ""
        Text3.BackColor = &H80000018
        Text3.Locked = True
    Else
        Text3.BackColor = vbWhite
        Text3.Locked = False
    End If
    Set rst = Nothing
    Me.Show 1
End Function




Private Sub Command1_Click()
Dim rst As Recordset
Dim strTemp As String
Dim i       As Integer
On Error GoTo Proc_Exit
    If Len(Text3) = 0 Then
        MsgBox "题目编号不为空!", vbInformation
        GoTo Proc_Exit
    End If
    
    If Len(Text1) = 0 Then
        MsgBox "题目内容不为空!", vbInformation
        GoTo Proc_Exit
    End If
    
    If Len(Text5) = 0 Then
        MsgBox "题目答案不为空!", vbInformation
        GoTo Proc_Exit
    End If
    
    For i = 1 To Len(Text5)
        strTemp = Mid(Text5, i, 1)
        If Not (Asc(strTemp) >= 65 And Asc(strTemp) <= 90) And Not (Asc(strTemp) >= 97 And Asc(strTemp) <= 122) Then
            MsgBox "题目答案必须为字母!", vbInformation
            GoTo Proc_Exit
        End If
    Next i
  

    Set rst = New Recordset
    If mblnEdit Then
        rst.Open "select * from 题库主表 where ID=" & mlngID, pCN, adOpenStatic, adLockBatchOptimistic
    Else
        rst.Open "select * from 题库主表", pCN, adOpenStatic, adLockBatchOptimistic
        rst.AddNew
    End If
    rst![题目编号] = Text3
    If Option1.Value Then
        rst![题目类型] = False
    Else
        rst![题目类型] = True
    End If
    rst![题目内容] = Text1
    rst![题目分值] = Val(Text4)
    
    rst![题目答案] = UCase(Text5)
    rst![题目备注] = Text2
    rst![题目套号] = mlngSubjectID
    rst.UpdateBatch
    Text1 = ""
    Text2 = ""
    Text3 = ""
    Text4 = ""
    Text5 = ""
    mblnEdit = False
    Text3.BackColor = vbWhite
    Text3.Locked = False
Proc_Exit:
    Set rst = Nothing
    If Err.Number <> 0 Then
        If Err.Number = -2147467259 Then
            MsgBox "题目编号不能重复!", vbInformation
        Else
            MsgBox "发生意外错误,错误号:" & Err.Number & " 错误描述:" & Err.Description, vbInformation
        End If
        Err.Clear
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub