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


VERSION 5.00 
Begin VB.Form FrmOldTest  
   Caption         =   "请选择旧试卷" 
   ClientHeight    =   6405 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   3345 
   ControlBox      =   0   'False 
   LinkTopic       =   "Form1" 
   LockControls    =   -1  'True 
   ScaleHeight     =   6405 
   ScaleWidth      =   3345 
   StartUpPosition =   2  '屏幕中心 
   Begin VB.CommandButton Command2  
      Caption         =   "确定" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   10.5 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   390 
      Left            =   1335 
      TabIndex        =   3 
      Top             =   5940 
      Width           =   870 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "关闭" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   10.5 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   390 
      Left            =   2325 
      TabIndex        =   2 
      Top             =   5940 
      Width           =   870 
   End 
   Begin VB.Frame Frame1  
      Caption         =   "所有旧试卷" 
      Height          =   5790 
      Left            =   15 
      TabIndex        =   0 
      Top             =   45 
      Width           =   3270 
      Begin VB.ListBox LstTest  
         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          =   5490 
         ItemData        =   "FrmOldTest.frx":0000 
         Left            =   90 
         List            =   "FrmOldTest.frx":0002 
         TabIndex        =   1 
         Top             =   240 
         Width           =   3120 
      End 
   End 
   Begin VB.Shape Shape1  
      BorderWidth     =   2 
      Height          =   495 
      Left            =   30 
      Top             =   5895 
      Width           =   3300 
   End 
End 
Attribute VB_Name = "FrmOldTest" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
'定义一个数组来保存对应试卷的id 
Dim TestIdArr() As Long 
 
Private Sub Command1_Click() 
 Unload Me 
End Sub 
 
Private Sub Command2_Click() 
 If LstTest.ListIndex < 0 Then 
   MsgBox "请选择你要的旧试卷!" 
   Exit Sub 
 End If 
 '保存ID的数组 
 Dim StrIdArr() As String 
 '保存题目分数数组 
 Dim TestScoreArr() As String 
 Dim adoRs As Recordset 
 Dim i As Long 
 Set adoRs = New Recordset 
 adoRs.Open "select * from test where id=" + str(TestIdArr(LstTest.ListIndex)), DB, adOpenStatic, adLockOptimistic 
  
 Select Case FrmShiJuan.LstWho 
  Case "LstTM" 
  '单选 
   If adoRs.Fields("danxuan").Value = "" Then 
     MsgBox "这份试卷没有单选题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("danxuan"), ",") 
   TestScoreArr = Split(adoRs.Fields("danxuans"), ",") 
   FrmShiJuan.LstTM.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstTM.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
  '多选 
   If adoRs.Fields("duoxuan").Value = "" Then 
     MsgBox "这份试卷没有多选题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("duoxuan"), ",") 
   TestScoreArr = Split(adoRs.Fields("duoxuans"), ",") 
   FrmShiJuan.LstTMD.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstTMD.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
 Case "LstTK" 
   '填空 
   If adoRs.Fields("tiankong").Value = "" Then 
     MsgBox "这份试卷没有填空题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("tiankong").Value, ",") 
   TestScoreArr = Split(adoRs.Fields("tiankongs").Value, ",") 
   FrmShiJuan.LstTKT.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstTKT.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
 Case "LstPD" 
    '判断 
   If adoRs.Fields("panduan").Value = "" Then 
     MsgBox "这份试卷没有判断题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("panduan").Value, ",") 
   TestScoreArr = Split(adoRs.Fields("panduans").Value, ",") 
   FrmShiJuan.LstPDT.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstPDT.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
 Case "LstWD" 
  '问答 
   If adoRs.Fields("wenda").Value = "" Then 
     MsgBox "这份试卷没有问答题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("wenda").Value, ",") 
   TestScoreArr = Split(adoRs.Fields("wendas").Value, ",") 
   FrmShiJuan.LstWDT.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstWDT.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
 Case "LstZW" 
   '作文 
   If adoRs.Fields("zuowen").Value = "" Then 
     MsgBox "这份试卷没有作文题!" 
     Exit Sub 
   End If 
   StrIdArr = Split(adoRs.Fields("zuowen").Value, ",") 
   TestScoreArr = Split(adoRs.Fields("zuowens").Value, ",") 
   FrmShiJuan.LstZWT.Clear 
   For i = 0 To UBound(StrIdArr) 
     FrmShiJuan.LstZWT.AddItem StrIdArr(i) + "(" + TestScoreArr(i) + ")" 
   Next i 
End Select 
    
 Set adoRs = Nothing 
 Unload Me 
End Sub 
 
Private Sub Form_Load() 
 Dim IdCount As Integer 
Dim i As Integer 
 
'取得全部试卷 
Dim Qurs As ADODB.Recordset 
Set Qurs = New Recordset 
Qurs.Open "select title,id from test where kemuid=" & UseKeMuID & " and nianjiid=" & UseNianJiID, DB, adOpenStatic, adLockOptimistic 
IdCount = 0 
If Not Qurs.EOF Then 
  Do While Not Qurs.EOF 
    LstTest.AddItem Qurs.Fields("title").Value 
    IdCount = IdCount + 1 
    Qurs.MoveNext 
  Loop 
  ReDim TestIdArr(IdCount) As Long 
  Qurs.MoveFirst 
  For i = 0 To IdCount - 1 
    TestIdArr(i) = Qurs.Fields("id").Value 
    Qurs.MoveNext 
  Next i 
  Qurs.Close 
  Set Qurs = Nothing 
  LstTest.ListIndex = 0 
Else 
  MsgBox "还没有生成旧试卷!" 
End If 
End Sub