form3.frm

来自「模拟驾驶员上机考试,实现单机自动随机出题,批卷,纠错.」· FRM 代码 · 共 875 行 · 第 1/2 页

FRM
875
字号
      EndProperty
      Height          =   1710
      Index           =   1
      Left            =   45
      TabIndex        =   0
      Top             =   5160
      Width           =   9255
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim kaoti(1 To 100, 1 To 10)
Dim dati(1 To 100) As String
Dim ckaoti(1 To 100) As String
Dim dkaoti(1 To 100) As String
Dim cdaoshu As Integer
Dim fenshu As Integer
Dim daoshu As Integer
Dim ttime As Integer
Private Sub sckt()
Dim aa(1 To 100) As Integer
i = 1
strtmp = ","
While i <= 100
Randomize
 strvalue = 1 + Int(Rnd * 1449)
If InStr(strtmp, "," & strvalue & ",") = 0 Then  '比较所选数  验证 strtmp这个字符串中 有没有"," & strvalue & "," 这个字符串
   aa(i) = strvalue
  'Print strvalue
 strtmp = strtmp & strvalue & ","
'.......另外要做的操作
i = i + 1
End If
Wend
Set xlapp = CreateObject("Excel.Application") '创建Excel应用类
    xlapp.Visible = False '设置Excel可见
    Set xlbook = xlapp.Workbooks.Open(App.Path & "\OTK.dll") '打开Excel工作簿
    Set xlsheet = xlbook.Worksheets(1) '打开Excel工作表
    'xlsheet.Activate '激活工作表
    'xzzs = 1448 'xlsheet.Cells(1, 8)
For i = 1 To 100
    For j = 1 To 10
    kaoti(i, j) = xlsheet.Cells(aa(i), j)
    Next
     DoEvents
     PB1.Value = i
     Label7 = i & "%"
Next
  xlapp.quit
 Rem>>>>>>>>>>
qingling
 Label3 = Format("1", "000")
 If kaoti(1, 9) = 1 Then
    xuan (Label3)
    Else
    pan (Label3)
    End If

     
End Sub
Private Sub xuan(t)
For i = 1 To 5
  Label1(i).Visible = True
  Label1(i) = kaoti(t, i)
  Next
 fenlei = kaoti(t, 10)
 Label4.Left = fenlei.Left + fenlei.Width
For i = 1 To 4
  Label10(i).Visible = True
  Next
  Me.Picture = LoadPicture(App.Path & "\yxt1.dll")
  tupian (kaoti(t, 7))
For i = 1 To 2
  Label2(i).Visible = False
  Next
Select Case dati(t)
   Case "A"
     Label10(1).BackStyle = 1
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 0
   Case "B"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 1
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 0
   Case "C"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 1
     Label10(4).BackStyle = 0
   Case "D"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 1
   Case ""
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 0
End Select
     
End Sub
Private Sub pan(t)
For i = 1 To 2
   Label2(i).Visible = True
 Next
Label1(1) = kaoti(t, 1)
fenlei = kaoti(t, 10)
Label4.Left = fenlei.Left + fenlei.Width
Me.Picture = LoadPicture(App.Path & "\pag.dll")
tupian (kaoti(t, 3))
For i = 2 To 5
  Label1(i).Visible = False
  Next
For i = 1 To 4
  Label10(i).Visible = False
  Next
If dati(t) = "q" Then
   Label2(1).BackStyle = 1
   Label2(2).BackStyle = 0
End If
If dati(t) = "w" Then
   Label2(1).BackStyle = 0
   Label2(2).BackStyle = 1
 End If
 If dati(t) = "" Then
   Label2(1).BackStyle = 0
   Label2(2).BackStyle = 0
   End If
End Sub
Private Sub js(t)
If t = 0 Then
    For i = 1 To 100
     If dati(i) = "" Then
      Label3 = Format(i, "000")
       If kaoti(i, 9) = 1 Then
        xuan (i)
        Else
        pan (i)
       End If
       Exit Sub
     End If
    Next
  Else
    If kaoti(t, 9) = 1 Then
        xuan (t)
    Else
        pan (t)
   End If
End If
End Sub

Private Sub Command1_Click()
 Label30_Click (2)
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 57 Then Label30_Click (1)
If Label30(1).Enabled = False Then
If KeyAscii = 48 Then Label30_Click (2)
If KeyAscii = 53 Then Label20_Click (2)
If KeyAscii = 54 Then Label20_Click (3)
If Label2(1).Visible = True Then
   Select Case KeyAscii
       Case "49"
       Label2_Click (1)
       Case "50"
       Label2_Click (2)
    End Select
  Else
     Select Case KeyAscii
       Case "49"
       Label10_Click (1)
       Case "50"
       Label10_Click (2)
       Case "51"
       Label10_Click (3)
       Case "52"
       Label10_Click (4)
    End Select
    End If
    End If
If KeyAscii = "27" Then
   start.Show
   Unload Me
   End If
End Sub

Private Sub Form_Load()
Me.Left = 0
Me.Top = 0
Me.Width = Screen.Width
Me.Height = Screen.Height
Pt1.Left = 0
Pt1.Top = 0
Pt1.Width = Screen.Width
Pt1.Height = Screen.Height
Timer2.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Form4.Show
End Sub

Private Sub Label10_Click(Index As Integer)
Select Case Index
   Case "1"
     dati(Label3) = "A"
     Label10(1).BackStyle = 1
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 0
      js (0)
     Case "2"
     dati(Label3) = "B"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 1
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 0
      js (0)
     Case "3"
     dati(Label3) = "C"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 1
     Label10(4).BackStyle = 0
      js (0)
     Case "4"
     dati(Label3) = "D"
     Label10(1).BackStyle = 0
     Label10(2).BackStyle = 0
     Label10(3).BackStyle = 0
     Label10(4).BackStyle = 1
      js (0)
     End Select
End Sub

Private Sub Label2_Click(Index As Integer)
Select Case Index
    Case "1"
      dati(Label3) = "q"
      Label2(1).BackStyle = 1
      Label2(2).BackStyle = 0
      js (0)
    Case "2"
      dati(Label3) = "w"
      Label2(1).BackStyle = 0
      Label2(2).BackStyle = 1
      js (0)
End Select
End Sub

Private Sub Label20_Click(Index As Integer)
If Label30(1).Enabled = False Then
Select Case Index
   Case "1"
      Label3 = Format("1", "000")
      js (1)
     Case "2"
      If Label3 = 1 Then Exit Sub
      Label3 = Format(Label3 - 1, "000")
     js (Label3)
     Case "3"
      If Label3 = 100 Then Exit Sub
      Label3 = Format(Label3 + 1, "000")
      js (Label3)
     Case "4"
      Label3 = 100
      js (100)
     End Select
     End If
End Sub
Private Sub tupian(uu)
If uu <> "" Then
   If InStr(kaoti(Label3, 1), "仪表板") Then
      Image1.Left = Label1(1).Left + 300 * (InStr(kaoti(Label3, 1), "“") + 1)
      Image1.Top = Label1(1).Top + 50
      Else
      Image1.Left = 10515 'Label1(1).Left + 50
      Image1.Top = 4567 '3345
    End If
   Image1.Picture = LoadPicture(App.Path & uu)
   Else
   Image1.Left = 10515
   Image1.Top = 4567
   Image1.Picture = LoadPicture(App.Path & "\kuc.dll")
   End If
End Sub

Private Sub Label30_Click(Index As Integer)
Select Case Index
   Case "1"
      Timer1.Enabled = True
      For i = 1 To 4
       Label10(i).Enabled = True
      Next
      For i = 1 To 2
       Label2(i).Enabled = True
      Next
      Label30(1).Enabled = False
      Label30(2).Enabled = True
   Case "2"
      pijuan
   Case "3"
      Form5.Show
End Select
End Sub
Private Sub pijuan()
   For i = 1 To 100
     If kaoti(i, 9) = 1 Then
     pxuan (i)
     Else
     ppan (i)
     End If
     Next


 For i = 0 To 99
     If kaoti(i + 1, 9) = 1 Then
     fxuan (i)
     Else
     fpan (i)
     End If
   Next
 For i = 1 To fenshu
    Form4.MG1.Row = dkaoti(i) - 1
    Form4.MG1.Col = 6
    Set Form4.MG1.CellPicture = LoadPicture(App.Path & "\tu\dui.pct")
    Next
 For i = 1 To cdaoshu
    Form4.MG1.Row = ckaoti(i) - 1
    Form4.MG1.Col = 6
    Set Form4.MG1.CellPicture = LoadPicture(App.Path & "\tu\cha.pct")
    Next
  Form4.Label2 = Label5(0)
  Form4.Label3 = Label5(1)
  Form4.Label4 = fenshu
  If fenshu >= 90 Then
     Form4.Image1.Picture = LoadPicture(App.Path & "\tu\hh.ptc")
     Else
     Form4.Image1.Picture = LoadPicture(App.Path & "\tu\bh.ptc")
     End If
     
Unload Me

End Sub
Private Sub pxuan(t)
  If InStr(kaoti(t, 6), dati(t)) And dati(t) <> "" Then
    fenshu = fenshu + 1
    dkaoti(fenshu) = t
    Else
     cdaoshu = cdaoshu + 1
     ckaoti(cdaoshu) = t
     End If
End Sub
Private Sub ppan(t)
  If InStr(kaoti(t, 2), dati(t)) And dati(t) <> "" Then
     fenshu = fenshu + 1
     dkaoti(fenshu) = t
     Else
       cdaoshu = cdaoshu + 1
       ckaoti(cdaoshu) = t
       End If
End Sub
Private Sub qingling()
For i = 1 To 4
 Label10(i).Enabled = False
 Next
 For i = 1 To 2
 Label2(i).Enabled = False
 Next
  For i = 1 To 100
     dati(i) = ""
  Next
 For i = 1 To 100
 ckaoti(i) = ""
 dkaoti(i) = ""
  Next
 cdaoshu = 0
 daoshu = 0
 fenshu = 0
 Label1(1).ForeColor = RGB(29, 100, 166)
 ttime = 0
End Sub
Private Sub fxuan(i)
 Form4.MG1.TextMatrix(i, 1) = kaoti(i + 1, 1)
 Form4.MG1.TextMatrix(i, 2) = Trim(kaoti(i + 1, 2)) & Chr(13) & Trim(kaoti(i + 1, 3)) & Chr(13) & Trim(kaoti(i + 1, 4)) & Chr(13) & Trim(kaoti(i + 1, 5))
 Form4.MG1.TextMatrix(i, 4) = kaoti(i + 1, 6)
 Form4.MG1.TextMatrix(i, 5) = dati(i + 1)
 Form4.MG1.Row = i
 Form4.MG1.Col = 3
 If kaoti(i + 1, 7) <> "" Then
 Set Form4.MG1.CellPicture = LoadPicture(App.Path & kaoti(i + 1, 7))
 Else
  Set Form4.MG1.CellPicture = LoadPicture(App.Path & "\kuc.dll")
  End If
End Sub
Private Sub fpan(i)
 Form4.MG1.TextMatrix(i, 1) = kaoti(i + 1, 1)
 Form4.MG1.TextMatrix(i, 2) = "对" & Chr(13) & Chr(13) & "错" 'kaoti(i + 1, 2) & kaoti(i + 1, 3) & kaoti(i + 1, 4) & kaoti(i + 1, 5)
 If kaoti(i + 1, 2) = "q" Then Form4.MG1.TextMatrix(i, 4) = "A"
 If kaoti(i + 1, 2) = "w" Then Form4.MG1.TextMatrix(i, 4) = "B"
 If dati(i + 1) = "q" Then Form4.MG1.TextMatrix(i, 5) = "A"
 If dati(i + 1) = "w" Then Form4.MG1.TextMatrix(i, 5) = "B"
 Form4.MG1.Row = i
 Form4.MG1.Col = 3
 If kaoti(i + 1, 3) <> "" Then
 Set Form4.MG1.CellPicture = LoadPicture(App.Path & kaoti(i + 1, 3))
 Else
  Set Form4.MG1.CellPicture = LoadPicture(App.Path & "\kuc.dll")
  End If
End Sub

Private Sub Timer1_Timer()
ttime = ttime + 1
If ttime = 60 Then
   Label5(2) = Label5(2) - 1
   ttime = 0
   End If
If Label5(2) = 0 Then
   MsgBox "  时间到,开始批卷", 64, "  提示"
   Timer1.Enabled = False
   Label30_Click (2)
   End If
End Sub

Private Sub Timer2_Timer()
sckt
Pt1.Visible = False
Timer2.Enabled = False
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?