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

解决方案 »

  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 #2b = UBound(arr) - 1
    Randomize
    d = arr(Int(b * Rnd) + 1)
    Label1.Caption = d
    For i = 0 To UBound(arr)
    If Len(arr(i)) <> 0 ThenPrint #2, arr(i)End If
    NextClose #2
    End Sub
    Private Sub Command1_Click()
    Timer1_Timer
    End SubPrivate Sub Command2_Click()
    stop_1
    End SubPrivate 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 SubPrivate 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 #1Open a For Input As #11
    brr = Split(StrConv(InputB(LOF(11), 11), vbUnicode), vbCrLf)
    Close #11Open 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
    NextFor b = 0 To UBound(brr) - 1
    Print #2, brr(b)
    Next
    Print #2, Label1.Caption
    Close #2
    Close #22
    End SubPrivate Sub Timer1_Timer()
    Timer1.Enabled = True
    Timer1.Interval = 200
    Call Start
    End Sub你可以试试,我原文件用的.csv格式,.txt文件会乱码  别的基本可以符合你提出的要求,内容有些地方有些累赘你可以尝试改改 我也是一个新手,大家相互学习
      

  2.   

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

  3.   

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

  4.   

    我也写了一个,代码如下:Option ExplicitPrivate fso As New FileSystemObject
    Private mcolNames As New Collection
    Private mintIndex As IntegerPrivate Property Get File1Path() As String
        File1Path = fso.BuildPath(App.Path, "1.txt")
    End PropertyPrivate Property Get File2Path() As String
        File2Path = fso.BuildPath(App.Path, "2.txt")
    End PropertyPrivate Sub cmdReset_Click()
        Dim objStream As TextStream
        Set objStream = fso.OpenTextFile(File2Path, ForWriting, True)
        objStream.Close
    End SubPrivate 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 SubPrivate Sub cmdStop_Click()
        Timer1.Enabled = False
        
        Dim objStream As TextStream
        Set objStream = fso.OpenTextFile(File2Path, ForAppending, True)
        
        objStream.WriteLine mcolNames(mintIndex)
        
        objStream.Close
    End SubPrivate Function GetRandomNumber(ByVal intStart As Integer, ByVal intEnd As Integer) As Integer
        GetRandomNumber = Int(Rnd * (intEnd - intStart + 1) + intStart)
    End FunctionPrivate Sub Form_Load()
        Randomize
        Timer1.Enabled = False
        Timer1.Interval = 20
    End SubPrivate Sub Timer1_Timer()
        mintIndex = GetRandomNumber(1, mcolNames.Count)
        Label1.Caption = mcolNames(mintIndex)
    End Sub下载地址:
    链接:https://pan.baidu.com/s/1w5Lj6CE72tdQ6S9NrhU4CA 
    提取码:1ebe运行示例: