VB開發抽獎程式,求大神給個完整的程式。
要求如下：
按開始按鈕在界面中隨機快速滾動顯示1.txt中的名字。
按停止按鈕停止滾動，在界面中顯示其中一個名字。并將其寫入到2.txt中。
2.txt中的名字之后抽獎不再顯示，除非按重置按鈕。
uj5u.com熱心網友回復：
一個陣列或者一個集合，作為搖獎參與著清單把名字都扔進去。
隨機滾動顯示，無非就是隨機產生一個陣列或集合下標范圍內的下標，然后提取這個下標的內容顯示一下。
確定抽獎，無非是隨機產生一個陣列或集合下標范圍內的下標，把這個元素提取出來，放到中獎串列或變數中，并從前面的陣列或者集合中洗掉。
提示如上，其實寫的字比實作的代碼多。但是作業要自己做。
uj5u.com熱心網友回復：
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檔案會亂碼 別的基本可以符合你提出的要求，內容有些地方有些累贅你可以嘗試改改 我也是一個新手，大家相互學習
uj5u.com熱心網友回復：
https://jingyan.baidu.com/article/dca1fa6f720b72f1a440520f.htmluj5u.com熱心網友回復：
可以試試excel。第一列存名字，第二列用公式 =RAND()填充，打開篩選對第二列排序就可以，想抽幾個就取幾行。
uj5u.com熱心網友回復：
我也寫了一個,代碼如下:
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
運行示例:
uj5u.com熱心網友回復：
那如果要再加一個需要指定一個中獎人。就是按開始時正常滾動，但是按停止無論抽獎多少次，只要按停止只顯示預先指定的人，應該怎么撰寫呢？uj5u.com熱心網友回復：
你要增加2.txt中名字的數量嗎?還是一直都隨機顯示全部資料,直到點停止才顯示特定的中獎人?
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/20055.html
標籤：資源
上一篇：VB編程