VB编写摇奖程序

学院搞活动，有个环节是抽奖，要求我帮他们写一个电脑摇奖的程序，就像电视的综艺界面一样按回车开始，按空格停下来。开始的时候没有仔细的想，以为没有什么难度就欣然的答应了，开始写的时候才发现，需要在外部通过条件判断强制的中断无限的循环。脑子里第一个想到的就是用多线程，可是大家都知道，如果用VB想使用多线程难度是非常大的。如果只用普通的单线程就必须找到一个方法捕捉到键盘的响应并中断循环。于是想到了去捕获消息，具体的想法就是想试一下在循环的过程中看看可不可以捕捉到键盘keydwon的消息。按照需求就有两个API可以使用一个是getmessage，一个是peekmessage，由于我们只是需要监视是否发生了键盘空格键keydown事件，并不需要拦截消息，所以这里选择peekmessage更为适合。

关键的问题解决了，其他的都好办了，备摇的号码用记事本事先记录，程序中在窗体load事件里读取到数组中，读取的时候因该打乱号码的顺序，这里简单的采用一前一后的方法读取。为了保证摇到的号码不会再摇到，所以要记录被摇到的号码在数组中的index以便在循环的时候跳过。大体的思路就是这个样子的。具体的代码如下：

Option Explicit

Dim data() As String, del() As Integer, index As Integer

 

‘API函数声明

Private Const PM_REMOVE = &H1

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Private Type POINTAPI

    x As Long

    y As Long

End Type

 

Private Type Msg

    hWnd As Long

    Message As Long

    wParam As Long

    lParam As Long

    time As Long

    pt As POINTAPI

End Type

 

Private Sub Form_KeyPress(KeyAscii As Integer)

Dim i As Integer, test As Long, j As Integer

Dim aMsg As Msg

'On Error Resume Next

'按回车开始滚动

If KeyAscii = 13 Then

    index = index + 1

    ReDim Preserve del(index)

    If UBound(del) - 1 >= UBound(data) Then

        MsgBox "没有数据可以摇了"

        Exit Sub

    End If

   

    Do

    PeekMessage aMsg, Me.hWnd, 0, 0, PM_REMOVE

    '按空格键停止滚动

        If aMsg.wParam = 32 Then

            Exit Do

        End If

lab:

        i = i + 1

        If i > UBound(data) Then

            i = 1

        End If

        For j = 0 To UBound(del)

            If i = del(j) Then

                GoTo lab

                End If

        Next j

 

        With lblno

            .Caption = data(i)

            .Refresh

        End With

    Loop

    Print Space(3) & data(i);

    del(index) = i

    If index Mod 8 = 0 Then Print

    lblprice.Caption = "恭喜" & data(i) & "获奖"

    lblprice.Left = (Screen.Width - lblprice.Width) / 2

End If

 

End Sub

 

Private Sub Form_Load()

lblname.Left = (Screen.Width - lblname.Width) / 2

lblname2.Left = (Screen.Width - lblname2.Width) / 2

lblno.Left = (Screen.Width - lblno.Width) / 2

Call readData

lblno.Caption = data(1)

lblprice.Caption = ""

Dim i As Integer

End Sub

'读取数据

Private Sub readData()

Dim FileNumber As Integer, i As Integer, temp() As String, j As Integer

FileNumber = FreeFile

Open App.Path & "/data.txt" For Input As FileNumber

'读取文本中的数据

Do While Not EOF(FileNumber)

i = i + 1

ReDim Preserve temp(i)

Input #FileNumber, temp(i)

Loop

'将读取中的数据打乱按照1,10,2,9,3,8,4,7,5,6的方法排列

ReDim data(UBound(temp))

'写入奇数位的数据

For i = 1 To UBound(data) Step 2

    If i > UBound(data) Then Exit For

    j = j + 1

    data(i) = temp(j)

Next i

'写入偶数位的数据

j = UBound(temp)

For i = 2 To UBound(data) Step 2

    If i > UBound(data) Then Exit For

    data(i) = temp(j)

     j = j - 1

Next i

End Sub