|
在最后slide
用放映模式方可抽奖- Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形(毫秒数)。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
- Dim arr, f As Boolean, j%, n%, temp '接受函数返回数组的temp不能 As String
- Private Sub CommandButton1_Click()
- Dim i%, r%
- If IsEmpty(arr) Then
- TextBox1.Visible = True
- TextBox3.Visible = True
- TextBox2.Text = ""
- TextBox4.Text = ""
- TextBox5.Text = ""
- TextBox6.Text = ""
- TextBox7.Text = ""
- TextBox8.Text = ""
- ReDim arr(1 To 50)
- For i = 1 To 50
- arr(i) = 800 + i
- Next
- j = 1
- TextBox4.Text = "三等奖"
- End If
- If Me.CommandButton1.Caption = "停止" Then
- Me.CommandButton1.Caption = "开始"
- f = True
- 'MsgBox f & j '因只能在放映模式使用按钮,调试设置变量监控点
- Select Case j
- Case 1
- TextBox5.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
- TextBox1.Text = ""
- TextBox2.Text = ""
- TextBox3.Text = ""
- Case 2
- TextBox6.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
- TextBox1.Text = ""
- TextBox2.Text = ""
- TextBox3.Text = ""
- Case 3
- TextBox7.Text = arr(temp(0)) & " " & arr(temp(1))
- TextBox1.Text = ""
- TextBox3.Text = ""
- Case 4
- TextBox8.Text = arr(temp(0))
- TextBox2.Text = ""
- End Select
- 'MsgBox n & j '变量监控点
- For i = 0 To n - 1
- arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
- Next
- If j = 4 Then
- MsgBox "抽奖完毕!"
- Exit Sub
- End If
- j = j + 1
- TextBox4.Text = Mid("三二一特", j, 1) & "等奖"
- Else
- Me.CommandButton1.Caption = "停止"
- f = False
- 'MsgBox f & j '变量监控点
- n = --Mid(3321, j, 1) '抽取奖等个数
- r = Mid("0368", j, 1) '抽剩应扣减样本数量
- 'MsgBox r '变量监控点
- Do
- Sleep 10
- If f Then Exit Do
- temp = choose(50 - r, n)
- Select Case n
- Case 3
- TextBox1.Visible = True
- TextBox2.Visible = True
- TextBox3.Visible = True
- TextBox1.Text = arr(temp(0))
- TextBox2.Text = arr(temp(1))
- TextBox3.Text = arr(temp(2))
- Case 2
- TextBox1.Text = arr(temp(0))
- TextBox2.Visible = False
- TextBox3.Text = arr(temp(1))
- Case 1
- TextBox1.Visible = False
- TextBox2.Visible = True
- TextBox3.Visible = False
- TextBox2.Text = arr(temp(0))
- End Select
- DoEvents
- Loop
- End If
- End Sub
- Function choose(m%, n%) '传回数组的函数不能声明为String,必须为vaiant
- Dim i%, dt
- Set dt = CreateObject("Scripting.Dictionary")
- Randomize
- Do
- i = Int(Rnd * (m - 1)) + 1
- dt(i & "") = "" '用字典的key来确保不重复抽取
- Loop Until dt.Count = n
- choose = dt.keys
- End Function
复制代码 |
|