frmsets.frm

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

VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form frmSets 
   ClientHeight    =   6252
   ClientLeft      =   48
   ClientTop       =   48
   ClientWidth     =   5148
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.8
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6252
   ScaleWidth      =   5148
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "项目设置"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5916
      Left            =   120
      TabIndex        =   0
      Top             =   108
      Width           =   4764
      Begin VB.CommandButton Command5 
         Caption         =   "取消"
         Height          =   360
         Left            =   3588
         TabIndex        =   11
         Top             =   5364
         Width           =   948
      End
      Begin VB.CommandButton Command4 
         Caption         =   "保存"
         Height          =   360
         Left            =   2448
         TabIndex        =   10
         Top             =   5376
         Width           =   948
      End
      Begin TabDlg.SSTab SSTab2 
         Height          =   4800
         Left            =   180
         TabIndex        =   1
         Top             =   432
         Width           =   4392
         _ExtentX        =   7747
         _ExtentY        =   8467
         _Version        =   393216
         Style           =   1
         Tabs            =   4
         Tab             =   2
         TabsPerRow      =   4
         TabHeight       =   529
         TabCaption(0)   =   "考试类型"
         TabPicture(0)   =   "frmSets.frx":0000
         Tab(0).ControlEnabled=   0   'False
         Tab(0).Control(0)=   "Command1"
         Tab(0).Control(1)=   "Command2"
         Tab(0).Control(2)=   "Command3"
         Tab(0).Control(3)=   "List1"
         Tab(0).ControlCount=   4
         TabCaption(1)   =   "题型设置"
         TabPicture(1)   =   "frmSets.frx":001C
         Tab(1).ControlEnabled=   0   'False
         Tab(1).Control(0)=   "List2"
         Tab(1).Control(1)=   "Command6"
         Tab(1).Control(2)=   "Command7"
         Tab(1).Control(3)=   "Command8"
         Tab(1).ControlCount=   4
         TabCaption(2)   =   "试题难度"
         TabPicture(2)   =   "frmSets.frx":0038
         Tab(2).ControlEnabled=   -1  'True
         Tab(2).Control(0)=   "List3"
         Tab(2).Control(0).Enabled=   0   'False
         Tab(2).Control(1)=   "Command9"
         Tab(2).Control(1).Enabled=   0   'False
         Tab(2).Control(2)=   "Command10"
         Tab(2).Control(2).Enabled=   0   'False
         Tab(2).Control(3)=   "Command11"
         Tab(2).Control(3).Enabled=   0   'False
         Tab(2).ControlCount=   4
         TabCaption(3)   =   "试卷难度"
         TabPicture(3)   =   "frmSets.frx":0054
         Tab(3).ControlEnabled=   0   'False
         Tab(3).Control(0)=   "List4"
         Tab(3).Control(1)=   "Command14"
         Tab(3).Control(2)=   "Command13"
         Tab(3).Control(3)=   "Command12"
         Tab(3).ControlCount=   4
         Begin VB.ListBox List4 
            Height          =   3936
            Left            =   -74808
            TabIndex        =   19
            Top             =   672
            Width           =   2844
         End
         Begin VB.CommandButton Command14 
            Caption         =   "添加"
            Height          =   360
            Left            =   -71808
            TabIndex        =   18
            Top             =   3300
            Width           =   948
         End
         Begin VB.CommandButton Command13 
            Caption         =   "删除"
            Height          =   360
            Left            =   -71808
            TabIndex        =   17
            Top             =   4224
            Width           =   948
         End
         Begin VB.CommandButton Command12 
            Caption         =   "修改"
            Height          =   360
            Left            =   -71808
            TabIndex        =   16
            Top             =   3768
            Width           =   948
         End
         Begin VB.CommandButton Command11 
            Caption         =   "修改"
            Height          =   360
            Left            =   3216
            TabIndex        =   15
            Top             =   3780
            Width           =   948
         End
         Begin VB.CommandButton Command10 
            Caption         =   "删除"
            Height          =   360
            Left            =   3216
            TabIndex        =   14
            Top             =   4236
            Width           =   948
         End
         Begin VB.CommandButton Command9 
            Caption         =   "添加"
            Height          =   360
            Left            =   3216
            TabIndex        =   13
            Top             =   3312
            Width           =   948
         End
         Begin VB.ListBox List3 
            Height          =   3936
            Left            =   204
            TabIndex        =   12
            Top             =   684
            Width           =   2844
         End
         Begin VB.CommandButton Command1 
            Caption         =   "修改"
            Height          =   360
            Left            =   -71736
            TabIndex        =   9
            Top             =   3804
            Width           =   948
         End
         Begin VB.CommandButton Command2 
            Caption         =   "删除"
            Height          =   360
            Left            =   -71736
            TabIndex        =   8
            Top             =   4260
            Width           =   948
         End
         Begin VB.CommandButton Command3 
            Caption         =   "添加"
            Height          =   360
            Left            =   -71736
            TabIndex        =   7
            Top             =   3336
            Width           =   948
         End
         Begin VB.ListBox List1 
            Height          =   3936
            Left            =   -74808
            TabIndex        =   6
            Top             =   696
            Width           =   2844
         End
         Begin VB.ListBox List2 
            Height          =   3936
            Left            =   -74808
            TabIndex        =   5
            Top             =   684
            Width           =   2844
         End
         Begin VB.CommandButton Command6 
            Caption         =   "添加"
            Height          =   360
            Left            =   -71796
            TabIndex        =   4
            Top             =   3312
            Width           =   948
         End
         Begin VB.CommandButton Command7 
            Caption         =   "删除"
            Height          =   360
            Left            =   -71796
            TabIndex        =   3
            Top             =   4236
            Width           =   948
         End
         Begin VB.CommandButton Command8 
            Caption         =   "修改"
            Height          =   360
            Left            =   -71796
            TabIndex        =   2
            Top             =   3780
            Width           =   948
         End
      End
   End
End
Attribute VB_Name = "frmSets"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private xml_doc As New MSXML.DOMDocument

Private Sub SSTab1_DblClick()

End Sub


Private Sub Command1_Click()
    tmp_value = List1.List(List1.ListIndex)
    frmAddValue.Show vbModal
    EditListItem List1, "专业", tmp_value
End Sub




Private Sub Command10_Click()
    If Not MsgboxYesOrNo("是否真的要出除?") Then Exit Sub
    DeleteListItem List3, "试题"
End Sub

Private Sub Command11_Click()
    tmp_value = List3.List(List2.ListIndex)
    frmAddValue.Show vbModal
    EditListItem List3, "试题", tmp_value
End Sub

Private Sub Command12_Click()
    tmp_value = List4.List(List2.ListIndex)
    frmAddValue.Show vbModal
    EditListItem List4, "试卷", tmp_value
End Sub

Private Sub Command13_Click()
    If Not MsgboxYesOrNo("是否真的要出除?") Then Exit Sub
    DeleteListItem List4, "试卷"
End Sub

Private Sub Command14_Click()
    tmp_value = ""
    frmAddValue.Show vbModal
    AddListItem List4, "试卷", tmp_value

End Sub

Private Sub Command2_Click()
    If Not MsgboxYesOrNo("是否真的要出除?") Then Exit Sub
    DeleteListItem List1, "专业"
End Sub

Private Sub Command3_Click()
    tmp_value = ""
    frmAddValue.Show vbModal
    AddListItem List1, "专业", tmp_value
End Sub

Private Sub Command4_Click()
    Dim sql As String
    Dim Rs As New ADODB.Recordset

    sql = "select * from setings where type='SETING'"
    Rs.Open sql, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    If (Rs.EOF And Rs.BOF) Then
        Rs.AddNew
    End If
    Rs("xml_value") = xml_doc.xml
    Rs("type") = "SETING"
    Rs.Update
    MsgMsg "保存完毕!"
    
'    Unload Me
End Sub

Private Sub Command5_Click()
    Unload Me
End Sub

Private Sub Command6_Click()
    tmp_value = ""
    frmAddValue.Show vbModal
    AddListItem List2, "题型", tmp_value
End Sub

Private Sub Command7_Click()
    If Not MsgboxYesOrNo("是否真的要出除?") Then Exit Sub
    DeleteListItem List2, "题型"
End Sub

Private Sub Command8_Click()
    tmp_value = List2.List(List2.ListIndex)
    frmAddValue.Show vbModal
    EditListItem List2, "题型", tmp_value
End Sub


Private Sub Command9_Click()
    tmp_value = ""
    frmAddValue.Show vbModal
    AddListItem List3, "试题", tmp_value
End Sub

Private Sub Form_Load()
    
    
    Dim Rs As New ADODB.Recordset
    Dim sql As String
    
    Dim xml_str As String
    
    xml_str = "<项目>" & _
        "<专业>" & _
        "</专业>" & _
        "<题型>" & _
        "</题型>" & _
        "<试题>" & _
        "</试题>" & _
        "<试卷>" & _
        "</试卷>" & _
    "</项目>"
    sql = "select * from setings where type='SETING'"
    Rs.Open sql, dbcon, adOpenKeyset, adLockOptimistic, adCmdText
    
    If (Rs.EOF And Rs.BOF) Or IsNull(Rs("xml_value")) Then
        xml_doc.loadXML xml_str
    Else
        xml_doc.loadXML Rs("xml_value")
    End If
    

    SSTab2.Tab = 0
    FillList List1, "专业"
    FillList List2, "题型"
    FillList List3, "试题"
    FillList List4, "试卷"
End Sub
Private Sub FillList(ByRef list_obj As ListBox, ByVal xm1 As String)
    Dim node As IXMLDOMElement
    Dim list_nodes As IXMLDOMNodeList
    Dim local_uil As String
    
    list_obj.Clear
    local_uil = "项目/" & xm1 & "/ITEM"
    Set list_nodes = xml_doc.getElementsByTagName(local_uil)
    
    For Each node In list_nodes
        list_obj.AddItem node.Text
    Next
    
End Sub
Private Sub AddListItem(ByRef list_obj As ListBox, ByVal xm1 As String, ByVal value As String)
    Dim node As IXMLDOMElement
    Dim list_nodes As IXMLDOMNodeList
    Dim xm2_node As IXMLDOMElement
    Dim local_uil As String
    
    local_uil = "项目/" & xm1 & "/ITEM"
    Set list_nodes = xml_doc.getElementsByTagName(local_uil)
    If value = "" Then Exit Sub
    For Each node In list_nodes
        If node.Text = value Then
            MsgMsg "已经存在该项目!"
            Exit Sub
        End If
    Next
    Set xm2_node = xml_doc.selectSingleNode("项目/" & xm1)
    Set node = xml_doc.createElement("ITEM")
    node.Text = value
    xm2_node.appendChild node
    list_obj.AddItem value
    
End Sub
Private Sub EditListItem(ByRef list_obj As ListBox, ByVal xm1 As String, ByVal value As String)
    Dim node As IXMLDOMElement
    Dim list_nodes As IXMLDOMNodeList
    Dim xm2_node As IXMLDOMElement
    Dim local_uil As String
    
    Dim old_value As String
    
    local_uil = "项目/" & xm1 & "/ITEM"
    Set list_nodes = xml_doc.getElementsByTagName(local_uil)
    
    If value = "" Then Exit Sub
    old_value = list_obj.List(list_obj.ListIndex)
    For Each node In list_nodes
        If node.Text = old_value Then
            node.Text = value
            list_obj.List(list_obj.ListIndex) = value
            Exit Sub
        End If
    Next
End Sub
Private Sub DeleteListItem(ByRef list_obj As ListBox, ByVal xm1 As String)
    Dim node As IXMLDOMElement
    Dim list_nodes As IXMLDOMNodeList
    Dim xm2_node As IXMLDOMElement
    Dim local_uil As String
    
    Dim old_value As String
    
    local_uil = "项目/" & xm1 & "/ITEM"
    Set list_nodes = xml_doc.getElementsByTagName(local_uil)
    
    
    old_value = list_obj.List(list_obj.ListIndex)
    Set xm2_node = xml_doc.selectSingleNode("项目/" & xm1)

    For Each node In list_nodes
        If node.Text = old_value Then
            xm2_node.removeChild node
            list_obj.RemoveItem list_obj.ListIndex
            Exit Sub
        End If
    Next
End Sub
Private Sub Form_Resize()
    SetWindowPos Me
End Sub