www.pudn.com > textmanager.rar > frmquestion.frm, change:2005-04-12,size:30687b


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Begin VB.Form frmquestion  
   Caption         =   "选择题录入" 
   ClientHeight    =   8595 
   ClientLeft      =   -495 
   ClientTop       =   570 
   ClientWidth     =   11880 
   KeyPreview      =   -1  'True 
   LinkTopic       =   "Form2" 
   LockControls    =   -1  'True 
   ScaleHeight     =   8595 
   ScaleWidth      =   11880 
   WindowState     =   2  'Maximized 
   Begin VB.Frame Frame3  
      Caption         =   "题目选择" 
      Height          =   8175 
      Left            =   45 
      TabIndex        =   15 
      Top             =   60 
      Width           =   3435 
      Begin MSComctlLib.ImageList ImgKemu  
         Left            =   2340 
         Top             =   5190 
         _ExtentX        =   1005 
         _ExtentY        =   1005 
         BackColor       =   -2147483643 
         ImageWidth      =   16 
         ImageHeight     =   16 
         MaskColor       =   12632256 
         _Version        =   393216 
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}  
            NumListImages   =   5 
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "frmquestion.frx":0000 
               Key             =   "question" 
            EndProperty 
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "frmquestion.frx":0452 
               Key             =   "zonglei" 
            EndProperty 
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "frmquestion.frx":08A4 
               Key             =   "zilei" 
            EndProperty 
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "frmquestion.frx":0CF6 
               Key             =   "nandu" 
            EndProperty 
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}  
               Picture         =   "frmquestion.frx":1148 
               Key             =   "nanduopen" 
            EndProperty 
         EndProperty 
      End 
      Begin MSComctlLib.TreeView TrVKeMu  
         Height          =   7770 
         Left            =   120 
         TabIndex        =   16 
         Top             =   330 
         Width           =   3180 
         _ExtentX        =   5609 
         _ExtentY        =   13705 
         _Version        =   393217 
         Indentation     =   460 
         LabelEdit       =   1 
         LineStyle       =   1 
         Style           =   7 
         ImageList       =   "ImgKemu" 
         BorderStyle     =   1 
         Appearance      =   0 
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
            Name            =   "宋体" 
            Size            =   12 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
      End 
   End 
   Begin MSComctlLib.ImageList ImgLst  
      Left            =   4260 
      Top             =   7515 
      _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         =   "frmquestion.frx":159A 
            Key             =   "save" 
         EndProperty 
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmquestion.frx":162B 
            Key             =   "undo" 
         EndProperty 
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmquestion.frx":169A 
            Key             =   "new" 
         EndProperty 
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmquestion.frx":1718 
            Key             =   "edit" 
         EndProperty 
      EndProperty 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "问题录入" 
      Height          =   8175 
      Left            =   3540 
      TabIndex        =   0 
      Top             =   60 
      Width           =   8280 
      Begin VB.ComboBox CmbNanDu  
         BackColor       =   &H00E8F4F8& 
         Enabled         =   0   'False 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   330 
         ItemData        =   "frmquestion.frx":17B2 
         Left            =   4350 
         List            =   "frmquestion.frx":17BF 
         Style           =   2  'Dropdown List 
         TabIndex        =   18 
         Top             =   540 
         Width           =   1440 
      End 
      Begin VB.Frame FrmeDA  
         Caption         =   "答案" 
         Enabled         =   0   'False 
         Height          =   4530 
         Left            =   5340 
         TabIndex        =   12 
         Top             =   3420 
         Width           =   765 
         Begin VB.CheckBox CheDaAn  
            Appearance      =   0  'Flat 
            Caption         =   "A" 
            BeginProperty Font  
               Name            =   "宋体" 
               Size            =   12 
               Charset         =   134 
               Weight          =   400 
               Underline       =   0   'False 
               Italic          =   0   'False 
               Strikethrough   =   0   'False 
            EndProperty 
            ForeColor       =   &H80000008& 
            Height          =   270 
            Index           =   0 
            Left            =   135 
            TabIndex        =   13 
            Top             =   300 
            Width           =   525 
         End 
      End 
      Begin VB.ComboBox CmbKeMu  
         Appearance      =   0  'Flat 
         BackColor       =   &H00E8F4F8& 
         Enabled         =   0   'False 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   330 
         ItemData        =   "frmquestion.frx":17CF 
         Left            =   150 
         List            =   "frmquestion.frx":17D1 
         Style           =   2  'Dropdown List 
         TabIndex        =   4 
         Top             =   540 
         Width           =   2010 
      End 
      Begin VB.TextBox TxTTM  
         Appearance      =   0  'Flat 
         BackColor       =   &H00E8F4F8& 
         DataField       =   "wenti" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   2205 
         Left            =   120 
         Locked          =   -1  'True 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   3 
         Top             =   1185 
         Width           =   6045 
      End 
      Begin VB.ComboBox CmbNianJi  
         BackColor       =   &H00E8F4F8& 
         Enabled         =   0   'False 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   10.5 
            Charset         =   134 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   330 
         ItemData        =   "frmquestion.frx":17D3 
         Left            =   2250 
         List            =   "frmquestion.frx":17D5 
         Style           =   2  'Dropdown List 
         TabIndex        =   2 
         Top             =   540 
         Width           =   1995 
      End 
      Begin VB.Frame Frame4  
         Caption         =   "选择项" 
         Height          =   4500 
         Left            =   90 
         TabIndex        =   1 
         Top             =   3420 
         Width           =   5145 
         Begin VB.OptionButton OpDuo  
            Caption         =   "多项选择" 
            Height          =   255 
            Left            =   2550 
            TabIndex        =   20 
            Top             =   225 
            Width           =   1125 
         End 
         Begin VB.OptionButton OpDan  
            Caption         =   "单项选择" 
            Height          =   255 
            Left            =   1050 
            TabIndex        =   19 
            Top             =   210 
            Value           =   -1  'True 
            Width           =   1065 
         End 
         Begin VB.PictureBox PicParent  
            Appearance      =   0  'Flat 
            BackColor       =   &H8000000A& 
            ForeColor       =   &H80000008& 
            Height          =   3855 
            Left            =   120 
            ScaleHeight     =   3825 
            ScaleWidth      =   4785 
            TabIndex        =   8 
            Top             =   570 
            Width           =   4815 
            Begin VB.PictureBox PicXuanZe  
               Appearance      =   0  'Flat 
               BackColor       =   &H00C0C0C0& 
               ForeColor       =   &H80000008& 
               Height          =   3705 
               Left            =   45 
               ScaleHeight     =   3675 
               ScaleWidth      =   4650 
               TabIndex        =   9 
               Top             =   30 
               Width           =   4680 
               Begin VB.TextBox TxTXuanZe  
                  Appearance      =   0  'Flat 
                  BackColor       =   &H00E8F4F8& 
                  BeginProperty Font  
                     Name            =   "宋体" 
                     Size            =   10.5 
                     Charset         =   134 
                     Weight          =   400 
                     Underline       =   0   'False 
                     Italic          =   0   'False 
                     Strikethrough   =   0   'False 
                  EndProperty 
                  Height          =   705 
                  Index           =   0 
                  Left            =   450 
                  Locked          =   -1  'True 
                  MultiLine       =   -1  'True 
                  ScrollBars      =   2  'Vertical 
                  TabIndex        =   10 
                  Top             =   100 
                  Width           =   4200 
               End 
               Begin VB.Label LabBiaohao  
                  BackStyle       =   0  'Transparent 
                  Caption         =   "A:" 
                  BeginProperty Font  
                     Name            =   "宋体" 
                     Size            =   18 
                     Charset         =   134 
                     Weight          =   700 
                     Underline       =   0   'False 
                     Italic          =   0   'False 
                     Strikethrough   =   0   'False 
                  EndProperty 
                  ForeColor       =   &H00FF0000& 
                  Height          =   480 
                  Index           =   0 
                  Left            =   60 
                  TabIndex        =   11 
                  Top             =   240 
                  Width           =   345 
               End 
            End 
         End 
         Begin VB.Shape Shape1  
            Height          =   360 
            Left            =   975 
            Top             =   165 
            Width           =   2790 
         End 
      End 
      Begin VB.Frame Frame6  
         Caption         =   "操作区" 
         Height          =   3825 
         Left            =   6300 
         TabIndex        =   14 
         Top             =   135 
         Width           =   1860 
         Begin VB.Frame Frame8  
            Caption         =   "编辑" 
            Height          =   1230 
            Left            =   60 
            TabIndex        =   21 
            Top             =   2310 
            Width           =   1755 
            Begin VB.CommandButton CmdNew  
               Appearance      =   0  'Flat 
               Height          =   300 
               Left            =   195 
               Picture         =   "frmquestion.frx":17D7 
               Style           =   1  'Graphical 
               TabIndex        =   26 
               ToolTipText     =   "添加题目" 
               Top             =   465 
               Width           =   645 
            End 
            Begin VB.CommandButton CmdEdit  
               Appearance      =   0  'Flat 
               Height          =   300 
               Left            =   930 
               Picture         =   "frmquestion.frx":1845 
               Style           =   1  'Graphical 
               TabIndex        =   25 
               ToolTipText     =   "编辑题目" 
               Top             =   465 
               Width           =   645 
            End 
            Begin VB.CommandButton CmdDel  
               Appearance      =   0  'Flat 
               Height          =   300 
               Left            =   195 
               Picture         =   "frmquestion.frx":18CF 
               Style           =   1  'Graphical 
               TabIndex        =   24 
               ToolTipText     =   "删除该题目" 
               Top             =   840 
               Width           =   645 
            End 
            Begin VB.CheckBox CheQK  
               Appearance      =   0  'Flat 
               Caption         =   "添加时清空" 
               ForeColor       =   &H80000008& 
               Height          =   195 
               Left            =   300 
               TabIndex        =   23 
               Top             =   210 
               Value           =   1  'Checked 
               Width           =   1200 
            End 
            Begin VB.CommandButton CmdExit  
               Appearance      =   0  'Flat 
               Height          =   300 
               Left            =   930 
               Picture         =   "frmquestion.frx":195E 
               Style           =   1  'Graphical 
               TabIndex        =   22 
               ToolTipText     =   "关闭窗口" 
               Top             =   840 
               Width           =   645 
            End 
         End 
      End 
      Begin VB.Label lblLabels  
         BackStyle       =   0  'Transparent 
         Caption         =   "难度:" 
         Height          =   255 
         Index           =   3 
         Left            =   4350 
         TabIndex        =   17 
         Top             =   285 
         Width           =   915 
      End 
      Begin VB.Label lblLabels  
         BackStyle       =   0  'Transparent 
         Caption         =   "所属科目:" 
         Height          =   255 
         Index           =   1 
         Left            =   150 
         TabIndex        =   7 
         Top             =   255 
         Width           =   975 
      End 
      Begin VB.Label lblLabels  
         BackStyle       =   0  'Transparent 
         Caption         =   "问题主体:" 
         Height          =   255 
         Index           =   2 
         Left            =   240 
         TabIndex        =   6 
         Top             =   960 
         Width           =   975 
      End 
      Begin VB.Label lblLabels  
         BackStyle       =   0  'Transparent 
         Caption         =   "所属年级:" 
         Height          =   255 
         Index           =   0 
         Left            =   2250 
         TabIndex        =   5 
         Top             =   270 
         Width           =   915 
      End 
   End 
End 
Attribute VB_Name = "frmquestion" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
 
'标志是添加还是编辑 
Dim NewOrEdit As String 
 
'产生选择项 
Sub CreateXuanZe() 
  Dim i As Integer 
  '自动产生数组控件 
  For i = 1 To 3 
     '产生标签 
     Load LabBiaohao(i) 
     LabBiaohao(i).Caption = Chr(65 + i) + ":" 
     LabBiaohao(i).Top = 165 + 850 * i 
     LabBiaohao(i).Visible = True 
     '产生文本框 
     Load TxTXuanZe(i) 
     TxTXuanZe(i).Top = 100 + 850 * i 
     TxTXuanZe(i).Visible = True 
     '产生答案选择框 
     Load CheDaAn(i) 
     CheDaAn(i).Caption = Chr(65 + i) 
     CheDaAn(i).Top = 300 + 350 * i 
     CheDaAn(i).Visible = True 
  Next i 
  '设置cmb控件初始值 
 ' CmbKeMu.ListIndex = 0 
 ' CmbNianji.ListIndex = 0 
  CmbNanDu.ListIndex = 0 
End Sub 
 
Private Sub CheDaAn_Click(Index As Integer) 
Dim i As Integer 
If OpDan.Value = True Then 
 
  For i = 0 To 3 
  If CheDaAn(i).Value Then 
     If i <> Index Then 
       If CheDaAn(Index).Value Then 
      MsgBox "此题你选择的是<单选>不能有多个答案" 
       End If 
      CheDaAn(Index).Value = False 
      Exit Sub 
      End If 
  End If 
  Next i 
End If 
 
  
End Sub 
 
Private Sub CmdDel_Click() 
 
If CmdDel.Tag = "" Then 
 MsgBox "你还没有选择要删除的题目呢!", vbExclamation, "系统提示" 
 Exit Sub 
End If 
'========================若此题已被使用则不能删除*****《待做》 
 
Dim adoRs As Recordset 
Set adoRs = New Recordset 
adoRs.Open "select danxuan,duoxuan from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, DB, adOpenStatic, adLockOptimistic 
 
Dim TiID As String 
Dim Ntiid As Long 
TiID = TrVKeMu.Nodes.Item(Val(CmdDel.Tag)).Text 
'获得ID号 
Ntiid = Val(Mid(TiID, 2, Len(TiID) - 2)) 
 
Do While Not adoRs.EOF 
  'MsgBox adoRs.Fields("danxuan") 
 ' MsgBox CmdDel.Tag 
  If CheckTestId(Ntiid, adoRs.Fields("danxuan")) Then 
    MsgBox "试卷库里以使用此题目,现在不能删除!" 
    Exit Sub 
  End If 
  If CheckTestId(Ntiid, adoRs.Fields("duoxuan")) Then 
    MsgBox "试卷库里以使用此题目,现在不能删除!" 
    Exit Sub 
  End If 
  adoRs.MoveNext 
 Loop 
 Set adoRs = Nothing 
  
 Dim Result As String 
Result = MsgBox("你确实要删除此题目吗!此为无返回过程", vbYesNo + vbExclamation, "提问?") 
If Result = vbNo Then Exit Sub 
  
'从数据库中删除题目 
 
Dim sql1 As String 
sql1 = "delete * from question where id=" & Ntiid 
DB.Execute sql1 
'从LISTVIEW删除题目 
TrVKeMu.Nodes.Remove Val(CmdDel.Tag) 
 
'清除控件内容 
ClsTM 
 CmdDel.Tag = "" 
End Sub 
'检查试卷库里是否已经用了该题目 
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 
Private Sub CmdEdit_Click() 
  Dim TiID As String 
   Dim Ntiid As Integer 
 If CmdNew.ToolTipText = "添加题目" Then 
  If CmdDel.Tag = "" And NewOrEdit <> "New" Then 
   MsgBox "请选择要修改的题目!" 
   Exit Sub 
  End If 
  '========================若此题已被使用则不能修改 
 
  Dim adoRs As Recordset 
  Set adoRs = New Recordset 
  adoRs.Open "select danxuan,duoxuan from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, DB, adOpenStatic, adLockOptimistic 
  TiID = TrVKeMu.Nodes.Item(Val(CmdDel.Tag)).Text 
  '获得ID号 
  Ntiid = Val(Mid(TiID, 2, Len(TiID) - 2)) 
 
  Do While Not adoRs.EOF 
    'MsgBox adoRs.Fields("danxuan") 
    ' MsgBox CmdDel.Tag 
    If CheckTestId(Ntiid, adoRs.Fields("danxuan")) Then 
      MsgBox "试卷库里以使用此题目,现在不能修改!" 
      Exit Sub 
    End If 
    If CheckTestId(Ntiid, adoRs.Fields("duoxuan")) Then 
      MsgBox "试卷库里以使用此题目,现在不能删除!" 
      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 CmdDel.Tag = "" Then GoTo NoUndo 
  '返回到原状态 
   Dim adoTMRs As Recordset 
   Dim sql As String 
   Set adoTMRs = New Recordset 
      
   TiID = TrVKeMu.Nodes.Item(Val(CmdDel.Tag)).Text 
   '获得ID号 
   Ntiid = Val(Mid(TiID, 2, Len(TiID) - 2)) 
   sql = "select * from question where id=" + str(Ntiid) 
   adoTMRs.Open sql, DB, 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 
 
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 XuanZeStr As String, NanDuStr As String, DaanStr As String 
    Dim LeiBie As String 
    Dim i As Integer 
    NanDuStr = CmbNanDu.Text 
    DaanStr = GetDaan() 
    '得到类别 
    If OpDuo.Value = True Then 
      LeiBie = "多" 
      Else 
      LeiBie = "单" 
    End If 
    '判断是添加还是编辑 
    If NewOrEdit = "New" Then 
      'SQL = "insert into question(kemu,wenti,xuanze,daan,nianji,image,nandu,author) values ('" 
      'SQL = SQL + kemuStr + "','" + TxTTM + "','" + XuanZeStr + "','" + DaanStr + "','" + nianjiStr + "',NULL,'" + NanDuStr + "','00')" 
      'DB.Execute SQL 
      If CmbKeMu.Text = "" Or CmbNianJi.Text = "" Or CmbNanDu.Text = "" Then 
      MsgBox "请先选择题目使用的范围<科目><种类><难度>" 
      Exit Sub 
      End If 
      Dim Qid As Long '题目Id 
      Qid = GetAutoID("question") 
      Dim adoQuestionRs As Recordset 
      Set adoQuestionRs = New Recordset 
      adoQuestionRs.Open "select * from  question", DB, adOpenStatic, adLockOptimistic 
      adoQuestionRs.AddNew 
      adoQuestionRs.Fields("id") = Qid 
      adoQuestionRs.Fields("kemuid") = UseKeMuID 
      adoQuestionRs.Fields("wenti") = TxTTM 
      adoQuestionRs.Fields("xuanze1") = TxTXuanZe(0) 
      adoQuestionRs.Fields("xuanze2") = TxTXuanZe(1) 
      adoQuestionRs.Fields("xuanze3") = TxTXuanZe(2) 
      adoQuestionRs.Fields("xuanze4") = TxTXuanZe(3) 
      adoQuestionRs.Fields("daan") = DaanStr 
      adoQuestionRs.Fields("nianjiid") = UseNianJiID 
      adoQuestionRs.Fields("nandu") = NanDuStr 
      adoQuestionRs.Fields("leibie") = LeiBie 
      adoQuestionRs.Update 
      Dim APosition As Long 
      APosition = adoQuestionRs.AbsolutePosition 
      '添加节点 
      adoQuestionRs.Close 
      adoQuestionRs.Open "select * from  question", DB, adOpenStatic, adLockOptimistic 
      adoQuestionRs.AbsolutePosition = APosition 
      'MsgBox adoQuestionRs.Fields("id").Value 
       
      'Exit Sub 
      Dim NewNod As Node 
      Set NewNod = TrVKeMu.Nodes.Add("node_nd|" + LeiBie + "|" + NanDuStr, tvwChild, "N" + Int2Str(adoQuestionRs.Fields("id").Value), "第" + Trim(str(adoQuestionRs.Fields("id").Value)) + "题") 
      CmdNew.Tag = adoQuestionRs.Fields(0).Value 
       adoQuestionRs.Close 
    Else 
      '更新 
      '用CmdNew控件的Tag属性保存题目ID 
      sql = "update question set kemuid=" + Int2Str(UseKeMuID) + ",wenti='" + TxTTM + "',xuanze1='" + TxTXuanZe(0).Text + "',xuanze2='" + TxTXuanZe(1).Text + "',xuanze3='" + TxTXuanZe(2).Text + "',xuanze4='" + TxTXuanZe(3).Text + "',daan='" + DaanStr + "',nianjiid=" + Int2Str(UseNianJiID) + ", nandu='" + NanDuStr + "',leibie='" + LeiBie + "' where id=" + CmdNew.Tag 
      DB.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_Activate() 
 Unload FrmFlash 
 
End Sub 
 
Private Sub Form_Load() 
   Dim MyNod As Node 
  ', Mynod1 As Node 
  Dim NewNod As Node 
  Dim sql As String 
  '难度 
  Dim NanDu(1 To 3) As String 
  '类别 
  Dim LeiBie(1 To 2) As String 
  Dim j As Integer 
  Dim k As Integer 
  Dim adoQuestionRs As Recordset 
  Set adoQuestionRs = New Recordset 
  Dim NanDuStr As String 
  NanDu(1) = "低" 
  NanDu(2) = "中" 
  NanDu(3) = "高" 
  LeiBie(1) = "单" 
  LeiBie(2) = "多" 
 '建立根接点 
  For k = 1 To 2 
  '建立类别节点 
  Set NewNod = TrVKeMu.Nodes.Add(, , "node_ml|" + LeiBie(k), LeiBie(k) + "项选择") 
  '建立难度节点 
  For j = 1 To 3 
       NanDuStr = NanDu(j) 
       Set NewNod = TrVKeMu.Nodes.Add("node_ml|" + LeiBie(k), tvwChild, "node_nd|" + LeiBie(k) + "|" + NanDu(j), NanDu(j)) 
       NewNod.Image = "nandu" 
       NewNod.ExpandedImage = "nanduopen" 
       '建立题目节点 
       sql = "select id from question where kemuid=" + Int2Str(UseKeMuID) + " and nianjiid=" + Int2Str(UseNianJiID) + " and nandu='" + NanDu(j) + "' and leibie='" + LeiBie(k) + "' order by id" 
       adoQuestionRs.Open sql, DB, adOpenStatic, adLockOptimistic 
       Do While Not adoQuestionRs.EOF 
          Set NewNod = TrVKeMu.Nodes.Add("node_nd|" + LeiBie(k) + "|" + NanDu(j), tvwChild, "N" + Int2Str(adoQuestionRs.Fields("id").Value), "第" + Trim(str(adoQuestionRs.Fields("id").Value)) + "题") 
          adoQuestionRs.MoveNext 
       Loop 
       adoQuestionRs.Close 
     Next j 
 Next k 
 '产生选择项 
 CreateXuanZe 
 '设置控件可否编辑 
 SetEnabled False 
End Sub 
 
 
 
Private Sub OpDan_Click() 
'检查答案时候只有一个 
 Dim i As Integer 
 Dim DaanCount As Integer 
 DaanCount = 0 
 For i = 0 To 3 
   If CheDaAn(i).Value = 1 Then 
     DaanCount = DaanCount + 1 
   End If 
 Next i 
 If DaanCount > 1 Then 
   MsgBox "你的答案不止一个答案,不能是单选题!" 
   OpDuo.Value = True 
 End If 
End Sub 
 
Private Sub TrVkemu_NodeClick(ByVal Node As MSComctlLib.Node) 
  If Left(Node.Key, 7) = "node_nd" Then 
       SetCmbText Node.Text, CmbNanDu 
       Exit Sub 
  End If 
    
   '=========================== 
    
   Dim Pid As Long 
   If Node.Children = 0 And Left(Node.Key, 1) = "N" Then 
       Pid = Val(Right(Node.Key, Len(Node.Key) - 1)) 
       '查询显示 
       Dim adoTMRs As Recordset 
       Dim sql As String 
       Set adoTMRs = New Recordset 
       sql = "select * from question where id=" + str(Pid) 
       adoTMRs.Open sql, DB, adOpenStatic, adLockOptimistic 
       CmdDel.Tag = Node.Index 
       '清除控件 
       ClsTM 
       PlayTM adoTMRs 
       adoTMRs.Close 
   End If 
End Sub 
Sub SetCmbText(ByVal str As String, ByVal CmbBox As ComboBox) 
  '查找对应项 
  Dim i As Integer 
  For i = 0 To CmbBox.ListCount - 1 
    If str = CmbBox.List(i) Then CmbBox.ListIndex = i 
  Next i 
   
End Sub 
 
'设置控件是否可以编辑 
Sub SetEnabled(ByVal TF As Boolean) 
  Dim i As Integer 
  CmbKeMu.Enabled = TF 
  CmbNianJi.Enabled = TF 
  CmbNanDu.Enabled = TF 
  TrVKeMu.Enabled = Not TF 
'  CmbGS.Enabled = TF 
  TxTTM.Locked = Not TF 
  For i = 0 To 3 
     TxTXuanZe(i).Locked = Not TF 
  Next i 
  FrmeDA.Enabled = TF 
  'FrmeMove.Enabled = Not TF 
  CmdDel.Enabled = Not TF 
  OpDuo.Enabled = TF 
  OpDan.Enabled = TF 
End Sub 
'得到答案字符串 
Function GetDaan() As String 
  Dim i As Integer 
  Dim str As String 
  For i = 0 To 3 
    If CheDaAn(i).Value = 1 Then 
       str = str + Chr(65 + i) + "," 
    End If 
  Next i 
  If str <> "" Then str = Left(str, Len(str) - 1) 
  GetDaan = str 
End Function 
'检查输入时候合格 
Function CheckIn() As Boolean 
  CheckIn = False 
   Dim i As Integer 
    '检查难度 
   If CmbNanDu.Text = "" Then 
      MsgBox "请选择难度!" 
      CmbNanDu.SetFocus 
      Exit Function 
   End If 
    
   If Trim(TxTTM) = "" Then 
      MsgBox "请把题目填写完整!", 48, "提示!" 
      Exit Function 
   End If 
   For i = 0 To 3 
     If Trim(TxTXuanZe(i)) = "" Then 
          MsgBox "请把选择项填写完整!", 48, "提示" 
          TxTXuanZe(i).SetFocus 
          Exit Function 
     End If 
   Next i 
   If GetDaan() = "" Then 
     MsgBox "请选择该题目的正确答案,以便电脑判卷!", 48, "提示" 
     Exit Function 
   End If 
     CheckIn = True 
End Function 
'显示题目模块 
Sub PlayTM(ByVal tmRS As Recordset) 
   Dim DaanArr() As String 
   Dim i As Integer, j As Integer 
   'SetCmbText tmRS.Fields("kemu"), CmbKeMu 
   'SetCmbText tmRS.Fields("nianji"), CmbNianji 
   SetCmbText tmRS.Fields("nandu"), CmbNanDu 
   TxTTM.Text = tmRS.Fields("wenti") 
   CmdNew.Tag = tmRS.Fields("id") 
   If tmRS.Fields("leibie") = "多" Then 
      OpDuo.Value = True 
     Else 
      OpDan.Value = True 
   End If 
 
   '显示选项: 
   TxTXuanZe(0).Text = tmRS.Fields("xuanze1") 
   TxTXuanZe(1).Text = tmRS.Fields("xuanze2") 
   TxTXuanZe(2).Text = tmRS.Fields("xuanze3") 
   TxTXuanZe(3).Text = tmRS.Fields("xuanze4") 
   '显示选择的答案 
   DaanArr = Split(tmRS.Fields("daan"), ",") 
   For i = 0 To UBound(DaanArr) 
    For j = 0 To 3 
     If CheDaAn(j).Caption = DaanArr(i) Then CheDaAn(j).Value = 1 
    Next j 
   Next i 
    
End Sub 
 
'清空题目的显示控件 
Sub ClsTM() 
  TxTTM.Text = "" 
  Dim i As Integer 
  For i = 0 To 3 
    TxTXuanZe(i).Text = "" 
    CheDaAn(i).Value = 0 
  Next i 
End Sub 
 
Private Sub TxTTM_KeyPress(KeyAscii As Integer) 
   If KeyAscii = 39 Then KeyAscii = -24145 
 
End Sub 
 
Private Sub TxTXuanZe_KeyPress(Index As Integer, KeyAscii As Integer) 
   If KeyAscii = 39 Then KeyAscii = -24145 
 
End Sub