frmsjgl.frm

一个题库系统 可以按照试题的难度

        zfz_old = 0
        For Each tmp_item In List1.ListItems
            zfz_old = zfz_old + CInt(tmp_item.SubItems(1))
        Next
        List1.ListItems.Remove List1.SelectedItem.Index
        zfz = 0
        For Each tmp_item In List1.ListItems
            zfz = zfz + CInt(tmp_item.SubItems(1))
        Next
        zfz = zfz - zfz_old
        
        Text5.Text = CInt(Text5.Text) + zfz

    End If
End Sub

Private Sub Command2_Click()
List1_DblClick
End Sub

Private Sub Command3_Click()
    Dim sSQL As String
    If MsgboxYesOrNo("是否真的要出除?") Then
        sSQL = "delete from sj_stk where sjid='" & m_ID & "'"
        dbcon.Execute sSQL
        sSQL = "delete from sjk where id='" & m_ID & "'"
        dbcon.Execute sSQL
        frjSJCK.RefData
        Unload Me
    End If
End Sub

Private Sub Command4_Click()
    On Error Resume Next
    If Text8.Text = "" Then
        MsgMsg "试卷名称不能为空！"
        Exit Sub
    End If
    
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    
    sSQL = "select * from sjk where id='" & m_ID & "'"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    
    Rs("sjmc") = Text8.Text
    Rs("zf") = CInt(Text5.Text)
    Rs.Update
    Rs.Close
    
    Dim tmp_item As ListItem
    sSQL = "delete * from sj_stk where sjid='" & m_ID & "' AND tx='" & List2.SelectedItem.Text & "'"
    dbcon.Execute sSQL
    sSQL = "select * from sj_stk where sjid='" & m_ID & "'"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    
    For Each tmp_item In List1.ListItems
        Rs.AddNew
        Rs("tx") = tmp_item.Text
        Rs("fz") = tmp_item.SubItems(1)
        Rs("ND") = tmp_item.SubItems(2)
        Rs("NZ") = tmp_item.SubItems(3)
        Rs("DA") = tmp_item.SubItems(4)
        Rs("ID") = tmp_item.SubItems(5)
        Rs("SJID") = m_ID
        Rs.Update
    Next
    
    Rs.Close
    
    
    
    MsgMsg "保存完毕!"
    
End Sub

Private Sub Command5_Click()
    Unload Me
End Sub

Private Sub Command6_Click()
    Dim file_name As String
    
    CDlg.ShowSave
    file_name = CDlg.FileName
    If file_name = "" Then Exit Sub
    If InStr(1, file_name, ".txt") Then
        
    Else
        file_name = file_name & ".txt"
    End If
    
    Open file_name For Output As #1
    Print #1, "        " & Text8.Text

    
    Dim tmp_item As ListItem
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    Dim icount As Long
    icount = 1
    For Each tmp_item In List2.ListItems
        sSQL = "select sum(fz) as zfz from sj_stk where sjid='" & m_ID & "' and tx='" & tmp_item.Text & "'"
        Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        Print #1, tmp_item.Text & "(" & Rs("zfz") & "分)"
        Rs.Close
        sSQL = "select * from sj_stk where sjid='" & m_ID & "' and tx='" & tmp_item.Text & "'"
        Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        icount = 1
        Do While Not Rs.EOF
            Print #1, "    " & icount & ")(" & Rs("fz") & "分)" & Rs("nz")
'            Print #1, "    答案:" & Rs("da")
            Rs.MoveNext
            icount = icount + 1
        Loop
        
        Rs.Close
    Next
    icount = 1
    Print #1, ""
    Print #1, ""
    Print #1, "-------------标准答案-----------------------------------"
    For Each tmp_item In List2.ListItems
        sSQL = "select sum(fz) as zfz from sj_stk where sjid='" & m_ID & "' and tx='" & tmp_item.Text & "'"
        Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        Print #1, tmp_item.Text & "(" & Rs("zfz") & "分)"
        Rs.Close
        sSQL = "select * from sj_stk where sjid='" & m_ID & "' and tx='" & tmp_item.Text & "'"
        Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        icount = 1
        Do While Not Rs.EOF
            Print #1, "    " & icount & ")(" & Rs("fz") & "分)" & Rs("da")
'            Print #1, "    答案:" & Rs("da")
            Rs.MoveNext
            icount = icount + 1
        Loop
        
        Rs.Close
    Next
    
    
    
    Close #1
    
    MsgMsg "保存完毕！"
    
End Sub

Private Sub Form_Load()
    GetData
    SetList2Data
    
    SetList1Data List2.SelectedItem.Text
End Sub

Private Sub Form_Resize()
    SetWindowPos Me
End Sub

Public Sub GetData()
    On Error Resume Next
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    sSQL = "select * from sjk where id='" & m_ID & "'"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        
    Text8.Text = Rs("sjmc")
    Text1.Text = Rs("sjnd")
    Text7.Text = Rs("sjlx")
    Text4.Text = Rs("bz")
    Text2.Text = Rs("scrq")
    Text3.Text = Rs("zts")
    Text6.Text = Rs("ts")
    Rs.Close
    Text5.Text = GetZF
    
End Sub
Private Function GetZF() As Integer
    On Error GoTo lab
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    sSQL = "select sum(fz) as zfz from sj_stk where sjid='" & m_ID & "'"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    
    GetZF = Rs("zfz")
    
    Exit Function
lab:
    GetZF = 0
End Function
Public Sub SetList2Data()
    On Error Resume Next
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    Dim rs_fz As New ADODB.Recordset
    Dim tmp_item As ListItem
    
    List2.View = lvwReport
    
    List2.ColumnHeaders.Clear
    List2.ColumnHeaders.Add , GetID, "题型", List2.Width * 0.7
    List2.ColumnHeaders.Add , GetID, "分值", List2.Width * 0.3
    
    List2.ListItems.Clear
    sSQL = "select * from scfa_txfz where scfa_id='" & FA_ID & "'"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    Do While Not Rs.EOF
        Set tmp_item = List2.ListItems.Add(, GetID, Rs("tx"))
        sSQL = "select sum(fz) as zfz from sj_stk where sjid='" & m_ID & "' and tx='" & Rs("tx") & "'"
        rs_fz.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
        
        tmp_item.SubItems(1) = rs_fz("zfz")
        rs_fz.Close
        Rs.MoveNext
    Loop
    Rs.Close
End Sub
Public Sub SetList1Data(ByVal TX As String)
    On Error Resume Next
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    Dim tmp_item As ListItem
    
    List1.View = lvwReport
    
    List1.ColumnHeaders.Clear
    List1.ColumnHeaders.Add , GetID, "题型", 4 * TextWidth("国")
    List1.ColumnHeaders.Add , GetID, "分值", 4 * TextWidth("国")
    List1.ColumnHeaders.Add , GetID, "难度", 4 * TextWidth("国")
    List1.ColumnHeaders.Add , GetID, "内容", 4 * TextWidth("国")
    List1.ColumnHeaders.Add , GetID, "答案", 4 * TextWidth("国")
    List1.ColumnHeaders.Add , GetID, "", 0
    
    List1.ListItems.Clear
    sSQL = "select * from sj_stk where sjid='" & m_ID & "' and tx='" & TX & "' order by nd"
    Rs.open sSQL, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    Do While Not Rs.EOF
        Set tmp_item = List1.ListItems.Add(, GetID, Rs("tx"))
        tmp_item.SubItems(1) = Rs("fz")
        tmp_item.SubItems(2) = Rs("nd")
        tmp_item.SubItems(3) = Rs("nz")
        tmp_item.SubItems(4) = Rs("da")
        tmp_item.SubItems(5) = Rs("id")
        Rs.MoveNext
    Loop
    Rs.Close
End Sub

Private Sub List1_DblClick()
    On Error Resume Next
    With frmSxxg
        .TX = List1.SelectedItem.Text
        .FZ = List1.SelectedItem.SubItems(1)
        .ND = List1.SelectedItem.SubItems(2)
        .NZ = List1.SelectedItem.SubItems(3)
        .DA = List1.SelectedItem.SubItems(4)
    End With
    
    
    frmSxxg.Show vbModal
    
    
    Dim zfz_old As Long, zfz As Long
    Dim tmp_item As ListItem
    zfz_old = 0
    For Each tmp_item In List1.ListItems
        zfz_old = zfz_old + CInt(tmp_item.SubItems(1))
    Next
    List1.SelectedItem.SubItems(1) = frmSxxg.FZ
    zfz = 0
    For Each tmp_item In List1.ListItems
        zfz = zfz + CInt(tmp_item.SubItems(1))
    Next
    zfz = zfz - zfz_old
    
    Text5.Text = CInt(Text5.Text) + zfz
    
End Sub

Private Sub List2_Click()
    SetList1Data List2.SelectedItem.Text
End Sub