testform.frm

此系统用于教学所用,用于老师进行教学所用

            Width           =   615
         End
      End
      Begin VB.PictureBox TestP_1 
         Height          =   4695
         Left            =   1920
         ScaleHeight     =   4635
         ScaleWidth      =   6075
         TabIndex        =   24
         Top             =   1680
         Width           =   6135
         Begin VB.Label Label1 
            Caption         =   " 试题入库：请选择入库题型！"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   21.75
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   855
            Left            =   120
            TabIndex        =   25
            Top             =   1560
            Width           =   6135
         End
      End
      Begin VB.CommandButton TestCmd_3 
         Caption         =   "实验题"
         Height          =   615
         Left            =   360
         TabIndex        =   23
         Top             =   3720
         Width           =   1455
      End
      Begin VB.CommandButton TestCmd_2 
         Caption         =   "问答题"
         Height          =   615
         Left            =   360
         TabIndex        =   22
         Top             =   2400
         Width           =   1455
      End
      Begin VB.CommandButton TestCmd_1 
         Caption         =   "选择题"
         Height          =   615
         Left            =   360
         TabIndex        =   21
         Top             =   1080
         Width           =   1455
      End
   End
End
Attribute VB_Name = "TestForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdexcel_Click()
Form1.Show
End Sub



Private Sub TestCmd_1_Click()
TestP_1.Visible = False
TestP_2.Visible = True
TestP_3.Visible = False
TestP_4.Visible = False
TestP_2.Left = TestP_1.Left
TestP_2.Top = TestP_1.Top
TestP_2.Width = Screen.Width - TestP_1.Left
TestP_2.Height = Screen.Height - TestP_1.Top
End Sub

Private Sub TestCmd_4_Click()
TestForm.Visible = False
shitiguanli.Show
End Sub

Private Sub TestCmd_2_Click()
TestP_1.Visible = False
TestP_2.Visible = False
TestP_3.Visible = True
TestP_4.Visible = False
TestP_3.Left = TestP_1.Left
TestP_3.Top = TestP_1.Top
TestP_3.Width = Screen.Width - TestP_1.Left
TestP_3.Height = Screen.Height - TestP_1.Top
End Sub

Private Sub TestCmd_3_Click()
TestP_1.Visible = False
TestP_2.Visible = False
TestP_3.Visible = False
TestP_4.Visible = True
TestP_4.Left = TestP_1.Left
TestP_4.Top = TestP_1.Top
TestP_4.Width = Screen.Width - TestP_1.Left
TestP_4.Height = Screen.Height - TestP_1.Top
End Sub

Private Sub Form_Load()
TestP_1.Visible = True
TestP_2.Visible = False
TestP_3.Visible = False
TestP_4.Visible = False
TestFrame.Width = Screen.Width
TestFrame.Height = Screen.Height - TestFrame.Top
Dim txtsql As String
Dim msgtxt As String
Dim mrc As ADODB.Recordset
txtsql = "select * from unittest "
Set mrc = ExecuteSQL(txtsql, msgtxt)
Do While Not mrc.EOF
    Combo1.AddItem mrc.Fields(1)
    Combo2.AddItem mrc.Fields(1)
    Combo3.AddItem mrc.Fields(1)
    mrc.MoveNext
Loop
mrc.Close
End Sub


Private Sub TestCmd_5_Click()
Dim msgtxt As String
Dim txtsql As String
Dim biaoz As Integer
Dim daan
Dim num As Integer
Dim time As Data
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim msgtxt1 As String
Dim txtsql1 As String
Dim num1 As Integer
 
 If TestCText_1 = "" Then
   MsgBox "请输入题干！", vbOKOnly + vbExclamation, "警告"
  Exit Sub
 End If

  If TestCText_2 = "" Then
   MsgBox "请输入选项！", vbOKOnly + vbQuestion, "警告"
   Exit Sub
  End If
   If TestCText_3 = "" Then
    biaoz = MsgBox("确定不要备注吗？", vbOKCancel, "提示")
    If biaoz = 2 Then
      TestCText_3.SetFocus
      Exit Sub
    End If
   End If
  If Check1.Value Then
    daan = Check1.Caption
   Else
     If Check2.Value Then
      daan = Check2.Caption
     Else
       If Check3.Value Then
          daan = Check3.Caption
       Else
        If Check4.Value Then
           daan = Check4.Caption
        Else
          If Check5.Value Then
          daan = Check5.Caption
          Else
           If Check6.Value Then
            daan = Check6.Caption
            Else
             MsgBox "请选择答案！", vbOKOnly + vbExclamation, "警告"
            End If
           End If
        End If
       End If
     End If
    End If
  If Not testtxt(Combo1.Text) Then
     MsgBox "请选择单元号！", vbOKOnly, "警告"
    Exit Sub
  End If
  
   txtsql = "select * from selecttest "
  Set mrc = ExecuteSQL(txtsql, msgtxt)
  If mrc.EOF = True Then
   num = 1
  Else
   mrc.MoveLast
   num = mrc.Fields(0) + 1
  End If
   mrc.AddNew
   mrc.Fields(0) = num
   mrc.Fields(1) = Trim(TestCText_1)
   mrc.Fields(2) = Trim(TestCText_2)
   mrc.Fields(3) = Trim(daan)
   mrc.Fields(4) = Trim(Combo1.Text)
   txtsql1 = "select * from unittest  "
   Set mrc1 = ExecuteSQL(txtsql1, msgtxt1)
   If mrc1.EOF = True Then
        num1 = 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo1.Text)
        mrc1.Update
   Else
     Do While Not mrc1.EOF
       If mrc1.Fields(1) <> Trim(Combo1.Text) Then
           mrc1.MoveNext
        Else
           Exit Do
        End If
     Loop
     If mrc1.EOF = True Then
        mrc1.MoveLast
        num1 = mrc1.Fields(0) + 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo1.Text)
        mrc1.Update
     End If
     mrc1.Close
   End If
   mrc.Fields(5) = Trim(TestCText_3)
   mrc.Fields(6) = Date
   mrc.Update
   msgtxt = "恭喜你，数据入库成功！现在数据库拥有" & num
   MsgBox msgtxt, vbOKOnly, "恭喜"
   mrc.Close
End Sub

Private Sub TestCmd_6_Click()
Dim msgtxt As String
Dim txtsql As String
Dim biaozhi As Integer
Dim mrc As ADODB.Recordset
Dim num As Integer
Dim mrc1 As ADODB.Recordset
Dim msgtxt1 As String
Dim txtsql1 As String
Dim num1 As Integer
If TestQText_1.Text = "" Then
  MsgBox "请输入题目！", vbOKOnly + vbExclamation, "警告"
  TestQText_1.SetFocus
  Exit Sub
  End If

If TestQText_2.Text = "" Then
MsgBox "请输入答案！", vbOKOnly + vbExclamation, "警告"
TestQText_2.SetFocus
Exit Sub
End If

If Combo2.Text = "" Then
 MsgBox "请选择单元！", vbOKOnly + vbExclamation, "警告"
 Combo2.SetFocus
 Exit Sub
 End If
 If TestQText_3.Text = "" Then
  biaozhi = MsgBox("确定不要备注吗？", vbOKCancel, "提示")
  If biaozhi = 2 Then
  TestQText_3.SetFocus
  Exit Sub
  End If
End If
txtsql = "select * from counttest"
Set mrc = ExecuteSQL(txtsql, msgtxt)
If mrc.EOF Then
  num = 1
Else
mrc.MoveLast
num = mrc.Fields(0) + 1
End If
mrc.AddNew
mrc.Fields(0) = num
mrc.Fields(1) = Trim(TestQText_1)
mrc.Fields(2) = Trim(TestQText_2)
mrc.Fields(3) = Trim(Combo2.Text)
  txtsql1 = "select * from unittest  "
   Set mrc1 = ExecuteSQL(txtsql1, msgtxt1)
   If mrc1.EOF = True Then
        num1 = 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo2.Text)
        mrc1.Update
   Else
     Do While Not mrc1.EOF
       If mrc1.Fields(1) <> Trim(Combo2.Text) Then
           mrc1.MoveNext
        Else
           Exit Do
        End If
     Loop
     If mrc1.EOF = True Then
        mrc1.MoveLast
        num1 = mrc1.Fields(0) + 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo2.Text)
        mrc1.Update
     End If
     mrc1.Close
   End If
mrc.Fields(4) = Trim(TestQText_3)
mrc.Fields(5) = Date
mrc.Update
msgtxt = "恭喜，试题入库成功！现在数据库里有" & num & "个试题"
  TestQText_1.Text = ""
  TestQText_1.SetFocus
  TestQText_2.Text = ""
  TestQText_3.Text = ""
MsgBox msgtxt, vbOKOnly, "恭喜"
mrc.Close
End Sub
  
Private Sub TestCmd_7_Click()
Dim msgtxt As String
Dim txtsql As String
Dim biaozhi As Integer
Dim mrc As ADODB.Recordset
Dim num As Integer
Dim mrc1 As ADODB.Recordset
Dim msgtxt1 As String
Dim txtsql1 As String
Dim num1 As Integer
If TestEText_1 = "" Then
  MsgBox "请输入题目！", vbExclamation + vbOKOnly, "警告"
  TestEText_1.SetFocus
  Exit Sub
End If
If TestEText_2 = "" Then
  MsgBox "请输入问题的答案！", vbQuestion + vbOKOnly, "警告"
  TestEText_2.SetFocus
  Exit Sub
End If
If TestEText_3 = "" Then
  biaozhi = MsgBox("确定不要备注吗？", vbQuestion + vbOKCancel, "提示")
  If biaozhi = 2 Then
    TestEText_3.SetFocus
    Exit Sub
  End If
End If
If Combo3.Text = "" Then
  MsgBox "请选择单元号！", vbExclamation + vbOKOnly, "警告"
  Combo3.SetFocus
  Exit Sub
End If
txtsql = "select * from shiytest"
Set mrc = ExecuteSQL(txtsql, msgtxt)
If mrc.EOF Then
  num = 1
Else
  mrc.MoveLast
  num = mrc.Fields(0) + 1
End If
mrc.AddNew
mrc.Fields(0) = num
mrc.Fields(1) = Trim(TestEText_1)
mrc.Fields(3) = Trim(TestEText_2)
mrc.Fields(4) = Trim(Combo3.Text)
  txtsql1 = "select * from unittest  "
   Set mrc1 = ExecuteSQL(txtsql1, msgtxt1)
   If mrc1.EOF = True Then
        num1 = 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo3.Text)
        mrc1.Update
   Else
     Do While Not mrc1.EOF
       If mrc1.Fields(1) <> Trim(Combo3.Text) Then
           mrc1.MoveNext
        Else
           Exit Do
        End If
     Loop
     If mrc1.EOF = True Then
        mrc1.MoveLast
        num1 = mrc1.Fields(0) + 1
        mrc1.AddNew
        mrc1.Fields(0) = num1
        mrc1.Fields(1) = Trim(Combo3.Text)
        mrc1.Update
     End If
     mrc1.Close
   End If
mrc.Fields(5) = Trim(TestEText_3)
mrc.Fields(6) = Date
mrc.Update
mrc.Close
msgtxt = "恭喜，试题入库成功！现在数据库里有" & num & "个实验题"
MsgBox msgtxt, vbExclamation + vbOKOnly, "恭喜"
TestEText_1 = ""
TestEText_1.SetFocus
TestEText_2 = ""
TestEText_3 = ""

End Sub