frmmnlx.frm

vb试卷生成系统！能够生成8开vb考试试卷

         BackColor       =   &H00C0C0C0&
         Caption         =   "下一题"
         Height          =   375
         Left            =   4170
         Style           =   1  'Graphical
         TabIndex        =   10
         Top             =   4590
         Width           =   795
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   1
         Left            =   270
         TabIndex        =   6
         Top             =   1935
         Width           =   345
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   2
         Left            =   270
         TabIndex        =   7
         Top             =   2310
         Width           =   345
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   3
         Left            =   270
         TabIndex        =   8
         Top             =   2730
         Width           =   345
      End
      Begin VB.CommandButton Command7 
         BackColor       =   &H00C0C0C0&
         Caption         =   "上一题"
         Height          =   375
         Left            =   3390
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   4590
         Width           =   795
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0C0C0&
         Caption         =   " "
         Height          =   285
         Index           =   0
         Left            =   270
         TabIndex        =   5
         Top             =   1560
         Width           =   345
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         Height          =   180
         Index           =   1
         Left            =   630
         TabIndex        =   39
         Top             =   1590
         Width           =   4230
      End
      Begin VB.Image Image1 
         Height          =   375
         Left            =   3540
         Top             =   4140
         Visible         =   0   'False
         Width           =   465
      End
      Begin VB.Label Label5 
         BackColor       =   &H00C0C0C0&
         Caption         =   "答案选"
         Height          =   255
         Left            =   4260
         TabIndex        =   45
         Top             =   4320
         Visible         =   0   'False
         Width           =   795
      End
      Begin VB.Label Label3 
         BackColor       =   &H00C0C0C0&
         Caption         =   "你选"
         Height          =   255
         Left            =   4230
         TabIndex        =   44
         Top             =   4080
         Visible         =   0   'False
         Width           =   705
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         Height          =   180
         Index           =   0
         Left            =   330
         TabIndex        =   38
         Top             =   240
         Width           =   4500
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         Height          =   180
         Index           =   4
         Left            =   630
         TabIndex        =   42
         Top             =   2790
         Width           =   4230
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         Height          =   180
         Index           =   3
         Left            =   630
         TabIndex        =   41
         Top             =   2280
         Width           =   4230
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         Height          =   180
         Index           =   2
         Left            =   630
         TabIndex        =   40
         Top             =   1980
         Width           =   4230
      End
   End
End
Attribute VB_Name = "frmmnlx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mnda() As String
Dim dtsj As Integer
Dim mnzqda() As String
Private m_cN3 As cNeoCaption
Dim ls, no, nocount As Integer

Private Sub Command1_Click()
nocount = Adodc3.Recordset.RecordCount
ReDim mnda(nocount) As String
For i = 1 To nocount
    mnda(i) = "A"
Next i
ReDim mnzqda(nocount) As String
no = 1
duti
Frame2.Visible = True
Command1.Enabled = False
Command4.Enabled = True
Frame2.Caption = "当前测试题是第" + Trim(Str(no)) + "题　　共选择测试题" + Trim(Str(nocount)) + "题"
Timer1.Interval = 1000
dtsj = 0
Label3.Visible = False
Label5.Visible = False
Image1.Visible = False
End Sub

Private Sub Command10_Click()
End
End Sub

Private Sub Command11_Click(Index As Integer)
Text1(Index).Text = Trim(Str(Int((VScroll1(Index).Max + VScroll1(Index).Min) / 2)))
End Sub

Private Sub Command2_Click()
Frame1.Visible = True
Frame2.Visible = False
Frame3.Visible = False
End Sub

Private Sub Command3_Click()
frmmnlx.Hide
fMainForm.Show
End Sub

Private Sub Command4_Click()
Timer1.Interval = 0
For i = 0 To 3
    If Option1(i).Value = True Then
        mnda(no) = Chr(65 + i)
    End If
Next i
Label3.Caption = "你选" + mnda(no)
If mnda(no) = mnzqda(no) Then
    Image1.Picture = LoadPicture(App.Path + "\ico\CHECKMRK.ICO")
Else
    Image1.Picture = LoadPicture(App.Path + "\ico\MISC20.ICO")
End If
Dim rightn As Integer
rightn = 0
For i = 1 To nocount
    If mnda(i) = mnzqda(i) Then
        rightn = rightn + 1
    End If
Next i
MsgBox "你答对了" + Str(rightn) + "道  答错了" + Str(nocount - rightn), vbInformation, App.EXEName
Command4.Enabled = False
Image1.Visible = True
Label3.Visible = True
Label5.Visible = True
End Sub

Private Sub Command5_Click()
If Val(Text1(0) + Text1(1).Text + Text1(2).Text + Text1(3).Text) = 0 Then
    MsgBox "你还没有选择题量。", vbInformation, App.EXEName
    Exit Sub
End If
If Val(Text1(4).Text) = 0 Then
    MsgBox "你还没有填写答题时间", vbInformation, App.EXEName
    Exit Sub
End If
load
For i = 0 To 3
    Dim sc, zs As Integer
    adodc1(i).Refresh
    zs = adodc1(i).Recordset.RecordCount
    For j = 1 To zs - Val(Text1(i).Text)
        sc = Int(Rnd() * adodc1(i).Recordset.RecordCount)
        If adodc1(i).Recordset.BOF Or adodc1(i).Recordset.EOF Then
            adodc1(i).Recordset.MoveFirst
        End If
        adodc1(i).Recordset.Move (sc)
        adodc1(i).Recordset.Delete
        adodc1(i).Recordset.Update
        adodc1(i).Refresh
        If adodc1(i).Recordset.RecordCount <> 0 Then
            adodc1(i).Recordset.MoveFirst
        End If
    Next j
Next i
While Adodc3.Recordset.RecordCount <> 0
    Adodc3.Recordset.Delete (adAffectCurrent)
    Adodc3.Recordset.Update
    Adodc3.Refresh
Wend
For i = 0 To 3
    adodc1(i).Refresh
    For j = 1 To adodc1(i).Recordset.RecordCount
        Dim kk As Integer
        kk = 5
        If i > 1 Then kk = 6
        Adodc3.Recordset.AddNew
        For k = 0 To kk
            Adodc3.Recordset.Fields(k) = adodc1(i).Recordset.Fields(k)
        Next k
        Adodc3.Recordset.Update
        Adodc3.Refresh
        adodc1(i).Recordset.MoveNext
    Next j
Next i
Frame1.Visible = False
Frame3.Visible = True
Command1.Enabled = True
End Sub

Private Sub Command6_Click()
If no + 1 <= nocount Then
    For i = 0 To 3
        If Option1(i).Value = True Then
            mnda(no) = Chr(65 + i)
        End If
    Next i
    no = no + 1
    duti
End If
Frame2.Caption = Trim(Str(no)) + "/" + Trim(Str(nocount)) + "      剩余时间：" + Str(Val(Text1(4).Text) - dtsj) + "秒"
End Sub

Private Sub Command7_Click()
If no - 1 >= 1 Then
    For i = 0 To 3
        If Option1(i).Value = True Then
            mnda(no) = Chr(65 + i)
        End If
    Next i
    no = no - 1
    duti
End If
Frame2.Caption = Trim(Str(no)) + "/" + Trim(Str(nocount)) + "      剩余时间：" + Str(Val(Text1(4).Text) - dtsj) + "秒"
End Sub

Private Sub Command8_Click(Index As Integer)
Text1(Index).Text = Trim(Str(VScroll1(Index).Max))
End Sub

Private Sub Command9_Click(Index As Integer)
Text1(Index).Text = Trim(Str(VScroll1(Index).Min))
End Sub

Private Sub Form_Activate()
If picname <> "" Then
    PicCaption.Picture = LoadPicture(picname)
    PicBorder.Picture = LoadPicture(picbname)
    Skin Me, m_cN3
End If
End Sub

Private Sub Form_Load()
Set m_cN3 = New cNeoCaption
    Skin Me, m_cN3
load
For i = 0 To 3
    VScroll1(i).Max = adodc1(i).Recordset.RecordCount
    VScroll1(i).Value = VScroll1(i).Max
Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
Command3_Click
End Sub

Private Sub Label1_Change(Index As Integer)
Dim lens, lines As Integer
lens = 0
lines = 1
For i = 1 To Len(Label1(Index).Caption)
    lens = lens + 1
    If Asc(Mid(Label1(Index).Caption, i, 1)) < 0 Then
        lens = lens + 1
    End If
    If Asc(Mid(Label1(Index).Caption, i, 1)) = 10 Then
        lines = lines + 1
        lens = 0
    End If
    If Index = 0 And lens >= 50 Then
        lines = lines + 1
        lens = lens - 50
    ElseIf lens >= 47 Then
        lines = lines + 1
        lens = lens - 47
    End If
Next i
If Index = 0 Then
    Label1(0).Height = lines * 180
Else
    Label1(Index).Height = lines * 180
    Label1(Index).top = Label1(Index - 1).top + Label1(Index - 1).Height + 50
    Option1(Index - 1).top = Label1(Index).top - 30
End If
End Sub

Private Sub Label1_Click(Index As Integer)
If Index > 0 Then
    Option1(Index - 1).SetFocus
End If
End Sub

Private Sub Text1_Change(Index As Integer)
If Val(Text1(Index).Text) > VScroll1(Index).Max Then
    If Index <> 4 Then
        MsgBox "题库中己经没有足够选的题数了.", vbExclamation, App.EXEName
    Else
        MsgBox "答题时间最长3600秒", vbExclamation, App.EXEName
    End If
    Text1(Index).Text = VScroll1(Index).Max
End If
VScroll1(Index).Value = Val(Text1(Index).Text)
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
    KeyAscii = 0
End If
End Sub

Private Sub Timer1_Timer()
dtsj = dtsj + 1
If dtsj = Val(Text1(4).Text) Then
    MsgBox "答题时间到。", vbInformation, App.EXEName
    Command4_Click
End If
Frame2.Caption = Trim(Str(no)) + "/" + Trim(Str(nocount)) + "      剩余时间：" + Str(Val(Text1(4).Text) - dtsj) + "秒"
End Sub

Private Sub VScroll1_Change(Index As Integer)
Text1(Index) = Trim(Str(VScroll1(Index).Value))
End Sub
Private Sub load()
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\kaoti.mdb;Persist Security Info=False"
Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\moniti.mdb;Persist Security Info=False"
Adodc3.RecordSource = "result"
Adodc3.Refresh
For i = 0 To 3
    adodc1(i).ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\moniti.mdb;Persist Security Info=False"
    adodc1(i).RecordSource = "moniti" + Trim(Str(i + 1))
    adodc1(i).Refresh
    While adodc1(i).Recordset.RecordCount <> 0
        adodc1(i).Recordset.Delete (adAffectCurrent)
        adodc1(i).Recordset.Update
        adodc1(i).Refresh
    Wend
    
    Adodc2.RecordSource = "select * from xuanze" + Trim(Str(i + 1))
    Adodc2.Refresh
    For j = 1 To Adodc2.Recordset.RecordCount
        adodc1(i).Recordset.AddNew
        Dim kk As Integer
        kk = 5
        If i > 1 Then kk = 6
        For k = 0 To kk
            adodc1(i).Recordset.Fields(k) = Adodc2.Recordset.Fields(k)
        Next k
        adodc1(i).Recordset.Update
        adodc1(i).Refresh
        Adodc2.Recordset.MoveNext
    Next j
Next i
End Sub
Private Sub duti()
Adodc3.Refresh
Adodc3.Recordset.MoveFirst
Adodc3.Recordset.Move (no - 1)
Label1(0).Caption = Adodc3.Recordset.Fields(0)
If Adodc3.Recordset.Fields(6) <> "" Then
    Label1(0).Caption = Label1(0).Caption + Adodc3.Recordset.Fields(6)
End If
For i = 1 To 4
    Label1(i).Caption = Adodc3.Recordset.Fields(i)
Next i
mnzqda(no) = Adodc3.Recordset.Fields(5)
Option1(Asc(mnda(no)) - 65).Value = True
Label5.Caption = "答案选" + mnzqda(no)
Label3.Caption = "你选" + mnda(no)
If mnda(no) = mnzqda(no) Then
    Image1.Picture = LoadPicture(App.Path + "\ico\CHECKMRK.ICO")
Else
    Image1.Picture = LoadPicture(App.Path + "\ico\MISC20.ICO")
End If
End Sub