frmshijuan.frm

自己用vb开发的局域网考试系统

            _ExtentX        =   10292
            _ExtentY        =   8520
            _Version        =   393217
            BackColor       =   15267064
            Enabled         =   -1  'True
            ReadOnly        =   -1  'True
            ScrollBars      =   2
            Appearance      =   0
            TextRTF         =   $"FrmShiJuan.frx":0573
            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 VB.Frame Frame3 
         BackColor       =   &H00FFFF80&
         Height          =   6690
         Left            =   180
         TabIndex        =   11
         Top             =   165
         Width           =   2535
         Begin MSComctlLib.ImageList ImgKemu 
            Left            =   1785
            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         =   "FrmShiJuan.frx":0610
                  Key             =   "question"
               EndProperty
               BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
                  Picture         =   "FrmShiJuan.frx":0A62
                  Key             =   "zonglei"
               EndProperty
               BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
                  Picture         =   "FrmShiJuan.frx":0EB4
                  Key             =   "zilei"
               EndProperty
               BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
                  Picture         =   "FrmShiJuan.frx":1306
                  Key             =   "nandu"
               EndProperty
               BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
                  Picture         =   "FrmShiJuan.frx":1758
                  Key             =   "nanduopen"
               EndProperty
            EndProperty
         End
         Begin MSComctlLib.TreeView TrVKeMu 
            Height          =   6390
            Left            =   90
            TabIndex        =   12
            ToolTipText     =   "双击加入所选中的题目"
            Top             =   210
            Width           =   2310
            _ExtentX        =   4075
            _ExtentY        =   11271
            _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
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFF80&
      Caption         =   "试卷标题："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   270
      Left            =   2220
      TabIndex        =   96
      Top             =   75
      Width           =   1200
   End
End
Attribute VB_Name = "FrmShiJuan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public LstWho As String '表示对那个list框改变分数
Dim Who As Integer ' 'who表示的是现在编辑的题型的序号
Function CreateTest() As Boolean '生成试卷
 CreateTest = False
 If LstTM.ListCount < 1 And LstTMD.ListCount < 1 And LstTKT.ListCount < 1 And LstPDT.ListCount < 1 And LstWDT.ListCount < 1 And LstZWT.ListCount < 1 Then
     MsgBox "请至少选择一种题型！"
     Exit Function
 End If
'生成试卷
If TXTTitle.Text = "" Then
   MsgBox "<试卷标题> 是必填项！", vbExclamation, "系统提示"
   TXTTitle.SetFocus
   Exit Function
End If

Dim Danxuan As String '单选题
Dim Duoxuan As String '多选题
Dim Danxuans As String '单选分数
Dim Duoxuans As String '多选分数
'Dim TianKong As String '填空题
'Dim TianKongs As String '填空题分数
'Dim PanDuan As String '判断题
'Dim PanDuans As String '判断题分数
'Dim WenDa As String '问答题
'Dim WenDas As String '问答题分数
'Dim ZuoWen As String '作文题
'Dim ZuoWens As String '作文题分数
Dim i, j As Integer
Dim TempArr() As String
Dim Zscore As Single
'单选
Danxuans = ""
If LstTM.ListCount <> 0 Then
  For i = 0 To LstTM.ListCount - 1
    TempArr = Split(LstTM.List(i), "(")
    Danxuan = Danxuan + TempArr(0) + ","
    Danxuans = Danxuans + "1,"
    Zscore = Zscore + 1
'    Danxuans = Danxuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
  Next i
Else
  Danxuan = ","
  Danxuans = ","
End If
'多选
Duoxuans = ""
If LstTMD.ListCount <> 0 Then
  For i = 0 To LstTMD.ListCount - 1
    TempArr = Split(LstTMD.List(i), "(")
    Duoxuan = Duoxuan + TempArr(0) + ","
    Duoxuans = Duoxuans + "2,"
    Zscore = Zscore + 2
'    Duoxuans = Duoxuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
  Next i
Else
  Duoxuan = ","
  Duoxuans = ","
End If
''填空
'If LstTKT.ListCount <> 0 Then
'  For i = 0 To LstTKT.ListCount - 1
'    TempArr = Split(LstTKT.List(i), "(")
'    TianKong = TianKong + TempArr(0) + ","
'    TianKongs = TianKongs + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
'  Next i
'Else
'  TianKong = ","
'  TianKongs = ","
'End If
''判断
'If LstPDT.ListCount <> 0 Then
'  For i = 0 To LstPDT.ListCount - 1
'    TempArr = Split(LstPDT.List(i), "(")
'    PanDuan = PanDuan + TempArr(0) + ","
'    PanDuans = PanDuans + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
'  Next i
'Else
'  PanDuan = ","
'  PanDuans = ","
'End If
''问答
'If LstWDT.ListCount <> 0 Then
'  For i = 0 To LstWDT.ListCount - 1
'    TempArr = Split(LstWDT.List(i), "(")
'    WenDa = WenDa + TempArr(0) + ","
'    WenDas = WenDas + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
'  Next i
'Else
'  WenDa = ","
'  WenDas = ","
'End If
''作文
'If LstZWT.ListCount <> 0 Then
'  For i = 0 To LstZWT.ListCount - 1
'    TempArr = Split(LstZWT.List(i), "(")
'    ZuoWen = ZuoWen + TempArr(0) + ","
'    ZuoWens = ZuoWens + Left(TempArr(1), Len(TempArr(1)) - 1) + ","
'    Zscore = Zscore + Val(Left(TempArr(1), Len(TempArr(1)) - 1))
'  Next i
'Else
' ZuoWen = ","
' ZuoWens = ","
'End If


Danxuan = Left(Danxuan, Len(Danxuan) - 1)
Danxuans = Left(Danxuans, Len(Danxuans) - 1)
Duoxuan = Left(Duoxuan, Len(Duoxuan) - 1)
Duoxuans = Left(Duoxuans, Len(Duoxuans) - 1)

'TianKong = Left(TianKong, Len(TianKong) - 1)
'TianKongs = Left(TianKongs, Len(TianKongs) - 1)
'PanDuan = Left(PanDuan, Len(PanDuan) - 1)
'PanDuans = Left(PanDuans, Len(PanDuans) - 1)
'
'WenDa = Left(WenDa, Len(WenDa) - 1)
'WenDas = Left(WenDas, Len(WenDas) - 1)
'ZuoWen = Left(ZuoWen, Len(ZuoWen) - 1)
'ZuoWens = Left(ZuoWens, Len(ZuoWens) - 1)
Dim Msg As String
Msg = Msg + CStr(LstTM.ListCount) + "道单选择题," + "  分数：" + CStr(LstTM.ListCount) + vbCrLf
Msg = Msg + CStr(LstTMD.ListCount) + "道多选择题," + "  分数：" + CStr(2 * LstTMD.ListCount) + vbCrLf
'Msg = Msg + "填空题：" + tiankong + "  分数：" + tiankongs + vbCrLf
'Msg = Msg + "填空题：" + panduan + "  分数：" + panduans + vbCrLf
'Msg = Msg + "问答题：" + wenda + "  分数：" + wendas + vbCrLf
'Msg = Msg + "作文题：" + zuowen + "  分数：" + zuowens + vbCrLf
Msg = Msg + "试卷总分数为：" & Zscore
MsgBox Msg
'写入数据库
If MsgBox("你真的要生成这份试卷吗？确认吗？", vbYesNo, "问题") = vbNo Then
   Exit Function
End If
Dim testRS As Recordset
Set testRS = New Recordset
testRS.Open "test", adoCn, adOpenStatic, adLockOptimistic
testRS.AddNew
testRS.Fields("id") = GetAutoID("test")
testRS.Fields("kemuid") = UseKeMuID
testRS.Fields("nianjiid") = UseNianJiID
testRS.Fields("title") = TXTTitle.Text
testRS.Fields("danxuan") = Danxuan
testRS.Fields("duoxuan") = Duoxuan
testRS.Fields("danxuans") = Danxuans
testRS.Fields("duoxuans") = Duoxuans
'testRS.Fields("tiankong") = TianKong
'testRS.Fields("tiankongs") = TianKongs
'testRS.Fields("panduan") = PanDuan
'testRS.Fields("panduans") = PanDuans
'testRS.Fields("wenda") = WenDa
'testRS.Fields("wendas") = WenDas
'testRS.Fields("zuowen") = ZuoWen
'testRS.Fields("zuowens") = ZuoWens
testRS.Fields("zscore").Value = Zscore
testRS.Update

MsgBox "试卷已经成功的生成！"
TXTTitle.Text = ""
CreateTest = True
End Function
Private Sub Check1_Click()

End Sub

'Private Sub CmbPD_Click()
'  Dim adoRs As Recordset
'   Dim NanDuStr As String
'   Set adoRs = New Recordset
'   '查询题目id
'   NanDuStr = CmbPD.Text
'   If CmbPD.ListIndex <> 0 Then
'     adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
'    Else
'     adoRs.Open "select id from questionPD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
'   End If
'   LstPD.Clear
'  '添加列表
'  Do While Not adoRs.EOF
'    LstPD.AddItem "第" & adoRs.Fields("id").Value & "题"
'    adoRs.MoveNext
'  Loop
'  Set adoRs = Nothing
'End Sub

'Private Sub CmbTK_Click()
'     Dim adoRs As Recordset
'   Dim NanDuStr As String
'   Set adoRs = New Recordset
'   '查询题目id
'   NanDuStr = CmbTK.Text
'   If CmbTK.ListIndex <> 0 Then
'     adoRs.Open "select id from questionTK where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
'    Else
'     adoRs.Open "select id from questionTK where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
'   End If
'   LstTK.Clear
'  '添加列表
'  Do While Not adoRs.EOF
'    LstTK.AddItem "第" & adoRs.Fields("id").Value & "题"
'    adoRs.MoveNext
'  Loop
'  Set adoRs = Nothing
'
'End Sub

'Private Sub CmbWD_Click()
'  Dim adoRs As Recordset
'   Dim NanDuStr As String
'   Set adoRs = New Recordset
'   '查询题目id
'   NanDuStr = CmbWD.Text
'   If CmbWD.ListIndex <> 0 Then
'     adoRs.Open "select id from questionWD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID & " and nandu='" & NanDuStr & "'", adoCn, adOpenStatic, adLockOptimistic
'    Else
'     adoRs.Open "select id from questionWD where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, adoCn, adOpenStatic, adLockOptimistic
'   End If
'   LstWD.Clear
'  '添加列表
'  Do While Not adoRs.EOF
'    LstWD.AddItem "第" & adoRs.Fields("id").Value & "题"
'    adoRs.MoveNext
'  Loop
'  Set adoRs = Nothing
'End Sub

'Private Sub CmbZW_Click()
'  Dim adoRs As Recordset
'   Dim NanDuStr As String
'   Set adoRs = New Recordset
'   '查询题目id
'   NanDuStr = CmbZW.Text
'   If