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

雷霆红豹 2019-11-24 08:37:54
VB开发抽奖程序,求大神给个完整的程序。
要求如下:
按开始按钮在界面中随机快速滚动显示1.txt中的名字。
按停止按钮停止滚动,在界面中显示其中一个名字。并将其写入到2.txt中。
2.txt中的名字之后抽奖不再显示,除非按重置按钮。
...全文
3110 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
milaoshu1020 2019-12-08
  • 打赏
  • 举报
回复
你要增加2.txt中名字的数量吗?
还是一直都随机显示全部数据,直到点停止才显示特定的中奖人?
雷霆红豹 2019-12-02
  • 打赏
  • 举报
回复
那如果要再加一个需要指定一个中奖人。就是按开始时正常滚动,但是按停止无论抽奖多少次,只要按停止只显示预先指定的人,应该怎么编写呢?
milaoshu1020 2019-12-01
  • 打赏
  • 举报
回复
我也写了一个,代码如下:

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

运行示例:
X-i-n 2019-12-01
  • 打赏
  • 举报
回复
可以试试excel。 第一列存名字,第二列用公式 =RAND()填充,打开筛选对第二列排序就可以,想抽几个就取几行。
threenewbee 2019-11-30
  • 打赏
  • 举报
回复
https://jingyan.baidu.com/article/dca1fa6f720b72f1a440520f.html
脆皮大雪糕 2019-11-25
  • 打赏
  • 举报
回复
一个数组或者一个集合,作为摇奖参与着清单 把名字都扔进去。 随机滚动显示,无非就是随机产生一个数组或集合下标范围内的下标,然后提取这个下标的内容显示一下。 确定抽奖,无非是随机产生一个数组或集合下标范围内的下标,把这个元素提取出来,放到中奖列表或变量中,并从前面的数组或者集合中删除。 提示如上,其实写的字比实现的代码多。但是作业要自己做。
xumeibin_1 2019-11-25
  • 打赏
  • 举报
回复


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文件会乱码 别的基本可以符合你提出的要求,内容有些地方有些累赘你可以尝试改改 我也是一个新手,大家相互学习

1,066

社区成员

发帖
与我相关
我的任务
社区描述
VB 资源
社区管理员
  • 资源
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧