VB开发抽奖程序,求大神给个完整的程序。

[雷霆红豹]

VB开发抽奖程序,求大神给个完整的程序。
要求如下：
按开始按钮在界面中随机快速滚动显示1.txt中的名字。
按停止按钮停止滚动，在界面中显示其中一个名字。并将其写入到2.txt中。
2.txt中的名字之后抽奖不再显示，除非按重置按钮。

[xumeibin_1]

Private Sub Start()
a = "D:\TEST\TEMP.csv"
Open a For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
Open a For Output As #2

b = UBound(arr) - 1
Randomize
d = arr(Int(b * Rnd) + 1)
Label1.Caption = d
For i = 0 To UBound(arr)
If Len(arr(i)) <> 0 Then

Print #2, arr(i)

End If
Next

Close #2
End Sub
Private Sub Command1_Click()
Timer1_Timer
End Sub

Private Sub Command2_Click()
stop_1
End Sub

Private Sub Command3_Click()
Timer1.Enabled = False
If Dir("D:\TEST\", vbDirectory) = "" Then MkDir ("D:\TEST\")
a = "D:\TEST\2.csv"
Open a For Output As #1
Print #1, "目录"
Close #1
a = "D:\TEST\1.csv"
Open a For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
a = "D:\TEST\TEMP.CSV"
Open a For Output As #2
For i = 0 To UBound(arr) - 1
Print #2, arr(i)
Next
Close #2
End Sub

Private Sub Form_Load()
If Dir("D:\TEST\", vbDirectory) = "" Then MkDir ("D:\TEST\")
a = "D:\TEST\2.csv"
Open a For Output As #1
Print #1, "目录"
Close #1
a = "D:\TEST\1.csv"
Open a For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1
a = "D:\TEST\TEMP.CSV"
Open a For Output As #2
For i = 0 To UBound(arr) - 1
Print #2, arr(i)
Next
Close #2
End Sub
Private Sub stop_1()
Timer1.Enabled = False
a = "D:\TEST\2.csv"
aa = "D:\TEST\TEMP.csv"
Open aa For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1

Open a For Input As #11
brr = Split(StrConv(InputB(LOF(11), 11), vbUnicode), vbCrLf)
Close #11

Open a For Output As #2
Open aa For Output As #22
For b = 0 To UBound(arr)
If Len(arr(b)) <> 0 Then
If arr(b) <> Label1.Caption Then
Print #22, arr(b)
End If
End If
Next

For b = 0 To UBound(brr) - 1
Print #2, brr(b)
Next
Print #2, Label1.Caption
Close #2
Close #22
End Sub



Private Sub Timer1_Timer()
Timer1.Enabled = True
Timer1.Interval = 200
Call Start
End Sub

你可以试试，我原文件用的.csv格式，.txt文件会乱码 别的基本可以符合你提出的要求，内容有些地方有些累赘你可以尝试改改 我也是一个新手，大家相互学习

[脆皮大雪糕]

一个数组或者一个集合，作为摇奖参与着清单 把名字都扔进去。 随机滚动显示，无非就是随机产生一个数组或集合下标范围内的下标，然后提取这个下标的内容显示一下。 确定抽奖，无非是随机产生一个数组或集合下标范围内的下标，把这个元素提取出来，放到中奖列表或变量中，并从前面的数组或者集合中删除。 提示如上，其实写的字比实现的代码多。但是作业要自己做。

[threenewbee]

https://jingyan.baidu.com/article/dca1fa6f720b72f1a440520f.html

[X-i-n]

可以试试excel。 第一列存名字，第二列用公式 =RAND()填充，打开筛选对第二列排序就可以，想抽几个就取几行。

[milaoshu1020]

我也写了一个,代码如下:

Option Explicit

Private fso As New FileSystemObject
Private mcolNames As New Collection
Private mintIndex As Integer

Private Property Get File1Path() As String
    File1Path = fso.BuildPath(App.Path, "1.txt")
End Property

Private Property Get File2Path() As String
    File2Path = fso.BuildPath(App.Path, "2.txt")
End Property

Private Sub cmdReset_Click()
    Dim objStream As TextStream
    Set objStream = fso.OpenTextFile(File2Path, ForWriting, True)
    objStream.Close
End Sub

Private Sub cmdStart_Click()
    Dim i As Long
    For i = 1 To mcolNames.Count
        mcolNames.Remove 1
    Next

    Dim objStream As TextStream
    Set objStream = fso.OpenTextFile(File1Path, ForReading, False)
    
    While Not objStream.AtEndOfStream
        Dim strName As String
        strName = objStream.ReadLine()
        
        mcolNames.Add strName
    Wend
    
    objStream.Close
    
    Set objStream = fso.OpenTextFile(File2Path, ForReading, False)
    
    While Not objStream.AtEndOfStream
        strName = objStream.ReadLine()
        
        For i = mcolNames.Count To 1 Step -1
            If mcolNames(i) = strName Then
                mcolNames.Remove i
                Exit For
            End If
        Next
    Wend
    
    objStream.Close
    
    If mcolNames.Count > 0 Then
        Timer1.Enabled = True
    Else
        MsgBox "已经全部抽取了!", vbExclamation
    End If
End Sub

Private Sub cmdStop_Click()
    Timer1.Enabled = False
    
    Dim objStream As TextStream
    Set objStream = fso.OpenTextFile(File2Path, ForAppending, True)
    
    objStream.WriteLine mcolNames(mintIndex)
    
    objStream.Close
End Sub

Private Function GetRandomNumber(ByVal intStart As Integer, ByVal intEnd As Integer) As Integer
    GetRandomNumber = Int(Rnd * (intEnd - intStart + 1) + intStart)
End Function

Private Sub Form_Load()
    Randomize
    Timer1.Enabled = False
    Timer1.Interval = 20
End Sub

Private Sub Timer1_Timer()
    mintIndex = GetRandomNumber(1, mcolNames.Count)
    Label1.Caption = mcolNames(mintIndex)
End Sub

下载地址:
链接：https://pan.baidu.com/s/1w5Lj6CE72tdQ6S9NrhU4CA
提取码：1ebe

运行示例:

[雷霆红豹]

那如果要再加一个需要指定一个中奖人。就是按开始时正常滚动，但是按停止无论抽奖多少次，只要按停止只显示预先指定的人，应该怎么编写呢？

[milaoshu1020]

你要增加2.txt中名字的数量吗?
还是一直都随机显示全部数据,直到点停止才显示特定的中奖人?