请问那位大虾用VB写的《摇奖系统》急，多谢！

[thinkvb]

摇奖的形式是身份证号码在一个文本框里循环显示，有开始和停止按钮。

[gump2000]

您把我的程序全部Copy成一个新的frm文件(用notepad啊)
等等，再用vb打开运行看看

[wenw]

thinkvb(其实我想懂),你肯定没有设定计时器的延时，不过我觉得没有必要用计时器，就直接启动循环可以了，如果怕看不清，用其sleep好了。

[lihonggen0]

用VB6.0编写电脑抽奖程序
近年来在娱乐节目之中常常见到利用电脑来抽奖，笔者对其发生了兴趣遂自己动手用VB编了一个小程序来实现电脑抽奖的小功能，其原理如下：
　　主要利用VB中的Rnd函数，来实现随机查找和打乱排序的功能，从而实现随机抽奖的目的。Rnd函数的语法结构是Rnd[(number)]，可选的number参数是 single或任何有效的数值表达式。Rnd函数返回小于1但大于或等于0的值。number 的值决定了 Rnd 生成随机数的方式。为了生成某个范围内的随机整数，可使用以下公式：
　　Int((upperbound － lowerbound ＋ 1) × Rnd ＋ lowerbound)
　　这里，upperbound 是随机数范围的上限，而 lowerbound 则是随机数范围的下限。
　　另外，程序中还使用了INI文件，Windows INI文件,可解释为Windows初始化文件。它是一种专门用来保存应用程序初始化信息和运行环境信息的文本文件。ini文件是一种文本文件,它可以通过Notepad等文本编辑器进行编辑。ini文件具有特定的格式。一个INI文件是由若干个段(section)组成的,每个段中包含若干关键字(key)及相应的值(value)。创建应用程序自己的INI文件,通过INI文件保存应用程序的一些运行环境信息,然后在程序中读取INI文件中的设置信息并据以处理。一旦程序的运行环境需要变更,则可以通过直接修改INI文件，或在程序中提供专门的界面间接地修改INI文件来保证程序的可用性。
　　程序运行时如图：
　　源程序及注释如下：
　　'窗体源程序
　　Option Explicit
　　Dim m_strNameArray() As MyName
　　Dim m_bIsStart As Boolean
　　Dim m_nNameIndex As Integer
　　Dim MAX_INDEX As Integer
　　Dim m_nSelectNum As Integer
　　 '被选定数
　　Dim nScrollStep As Integer
　　Dim nScrollWidth As Integer
　　Dim bScrollState As Boolean
　　Dim nEnableSecond As Integer
　　Dim m_strTitle As String
　　Dim m_strAppTitle As String
　　Dim m_strScrollTitleLeft As String
　　Dim m_strScrollTitleRight As String
　　Private Sub Command_Start_Stop_Click()
　　If m_bIsStart = True Then
　　'按停止钮
　　m_bIsStart = False
　　Command_Start_Stop.Caption =
　　“开始"
　　Label_FlashName.Visible = True
　　Timer_FlashName.Enabled = True
　　Timer_ScrollName.Enabled = False
　　Label_FlashName =
　　m_strNameArray（m_nNameIndex).strName ＋ “中奖了！"
　　m_strNameArray(m_nNameIndex).bIsSelect = True
　　m_nSelectNum = m_nSelectNum ＋ 1
　　Dim Temp As MyName
　　Temp =
　　m_strNameArray(MAX_INDEX)
　　m_str Name Array(MAX－INDEX) = m_strNameArray(m_nNameIndex)
　　m_strNameArray(m_nNameIndex) =
　　Temp
　　MAX_INDEX = MAX_INDEX － 1
　　If MAX_INDEX = 0 Then
　　MsgBox “非常感谢您使用本软件"
　　End If
　　Else '按开始钮
　　m_bIsStart = True
　　Command_Start_Stop.Caption = “停止"
　　Command_Start_Stop.Enabled = False
　　Timer_ScrollName.Enabled = True
　　Timer_FlashName.Enabled = False
　　Label_FlashName.Caption = “"
　　End If
　　End Sub
　　Private Sub Form_Load()
　　Form_Bouns.ScaleMode = 3
　　m_nNameIndex = 0
　　m_bIsStart = False
　　Timer_ScrollName.Enabled = True
　　Timer_ScrollTitle.Enabled = True
　　Label_FlashName.Visible = False
　　Label_ScrollName.Caption = “"
　　nEnableSecond = 0
　　'定义起始秒数
　　ReDimNameArray
　　'获得文本中的名字和打乱名字顺序
　　nScrollStep = 5 '设定滚动字的步长
　　nScrollWidth = Label_Congruation.Left
　　'设定title的移动宽度
　　bScrollState = False
　　'设定缺省的开始滚动方向为向左
　　m_nSelectNum = 0
　　'初始化被选定数为0
　　Init
　　'初始化本程序的界面
　　End Sub
　　Private Sub Timer_FlashName_Timer() '闪动中奖者姓名
　　If Label_FlashName.Visible = True Then
　　Label_FlashName.Visible = False
　　Else
　　Label_FlashName.Visible = True
　　End If
　　End Sub
　　Private Sub Timer_ScrollName_Timer() '滚动出现名字
　　If m_bIsStart = True Then
　　If m_nNameIndex >= MAX_INDEX Then
　　m_nNameIndex = 0
　　End If
　　m_nNameIndex =
　　m_nNameIndex ＋ 1
　　If m_strNameArray(m_nNameIndex).bIsSelect = True Then
　　If m_nNameIndex <
　　MAX－INDEX Then
　　m_nNameIndex =
　　m_nNameIndex ＋ 1
　　Else
　　m_nNameIndex = 0
　　End If
　　End If
　　Label_ScrollName.Caption = m_str
　　NameArray(m_nNameIndex).strName
　　'End If
　　End If
　　End Sub
　　Private Sub Timer_ScrollTitle_Timer() '滚动“恭喜发财"字样
　　If bScrollState = False Then '向左滚
　　nScrollStep = 10
　　Label_Congruation.Caption = m_strScrollTitleLeft
　　If nScrollWidth > 0 Then
　　nScrollWidth =
　　nScrollWidth － nScrollStep
　　Else
　　bScrollState = True
　　End If
　　Else '向右滚
　　nScrollStep = －10
　　Label_Congruation.Caption =
　　m_strScrollTitleRight
　　If nScrollWidth < Form_Bouns.ScaleWidth － Label_Congruation.Width Then
　　nScrollWidth =
　　nScrollWidth － nScrollStep
　　Else
　　bScrollState = False
　　End If
　　End If
　　Label_Congruation.Left = nScrollWidth
　　'以下为8秒钟内使“停止"按钮有效
　　If nEnableSecond <= 49 Then
　　If m_bIsStart = True Then
　　nEnableSecond =nEnableSecond ＋ 1
　　End If
　　Else
　　If m_bIsStart = True Then
　　Command_Start_Stop.Enabled = True
　　nEnableSecond = 0
　　End If
　　End If
　　End Sub
　　'动态定义数组
　　Private Sub ReDimNameArray()
　　Dim nMaxIndex As Integer
　　Dim strMaxIndex As String
　　Dim nIndex As Integer
　　Dim bIsBegin As Boolean
　　bIsBegin = False
　　nIndex = 0
　　Open App.Path ＋ “\name.txt" For Input As ＃1 '读文件
　　Do Until EOF(1)
　　If bIsBegin = False Then
　　Line Input ＃1, strMaxIndex
　　nMaxIndex = Val(strMaxIndex)
　　MAX_INDEX = nMaxIndex － 1
　　ReDim m_strNameArray(0 To nMaxIndex － 1)
　　bIsBegin = True
　　Else
　　Line Input ＃1, m_strNameArray(nIndex).strName
　　m_strNameArray(nIndex).bIsSelect = False
　　nIndex = nIndex ＋ 1
　　End If
　　Loop
　　'以下为打乱人员顺序10次
　　Dim i As Integer
　　Dim j As Integer
　　Dim Temp As String
　　Dim nRandomNum As Integer
　　For j = 0 To 10
　　For i = 0 To nMaxIndex － 1
　　nRandomNum = ((nMaxIndex － 1) × Rnd) '利用Rnd函数
　　Temp = m_strNameArray(i).strName
　　m_strNameArray(i).strName = m_strNameArray(nRandomNum).strName
　　m_strNameArray(nRandomNum).strName = Temp
　　Next i
　　Next j
　　End Sub
　　Private Sub Init() '读取INI文件
　　Dim X As Long
　　Dim lpFileName
　　Dim Temp As String × 50
　　lpFileName = App.Path ＋ “\Sortition.ini"
　　X = GetPrivateProfileString(“SYSTEM",“AppTitle",“抽奖程序", Temp, Len(Temp), lpFileName)
　　m_strAppTitle = Trim(Temp)
　　Temp =“"
　　X = GetPrivateProfileString(“SYSTEM", "Title", "欢迎使用抽奖程序", Temp, Len(Temp), lpFileName)
　　m_strTitle = Trim(Temp)
　　Temp = “"
　　X = GetPrivateProfileString(“SYSTEM",“ScrollTitleRight", “恭喜发财!!!", Temp, Len(Temp), lpFileName)
　　m_strScrollTitleRight = Trim(Temp)
　　X = GetPrivateProfileString(“SYSTEM",“ScrollTitleLeft", “龙年大发!!!", Temp, Len(Temp), lpFileName)
　　m_strScrollTitleLeft = Trim(Temp)
　　Form_Bouns.Caption = m_strAppTitle
　　Label_CompanyTitle.Caption = m_strTitle
　　End Sub
　　模块源程序：
　　'用于读取ini文件的API函数
　　Declare Function GetPrivateProfileString Lib “kernel32" Alias “GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
　　Public Type MyName
　　strName As String
　　bIsSelect As Boolean
　　End Type
　　由于程序利用的windows ini文件保存一些标题信息，因而可以方便的修改使用环境,及标题内容。
　　见ini文件内容：
　　[SYSTEM]
　　;应用程序的form名称
　　AppTitle=“风云电脑抽奖Test"
　　;窗口的内的标题(限9个字)
　　Title=“大抽奖"
　　;右滚动的文字(仅能为如下格式:XXXX!!!)
　　ScrollTitleRight=“恭喜发财!!!"
　　;左滚动的文字(仅能为如下格式:XXXX!!!)
　　ScrollTitleLeft=“祝您好运!!!"
　　如此一个小小的电脑抽奖程序便完成了。
　　以上程序在VB6.0 Windows98环境下编译通过

[vivan19781111]

'text2.multilin=true,text1.tabindex=0,在text1里按空格选择
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim s As Integer
Dim Flag As Boolean

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If Flag = True Then
If KeyCode = Asc(" ") Then
Timer1.Enabled = True
Timer1_Timer
End If
Flag = False
Else
If KeyCode = Asc(" ") Then
Timer1.Enabled = False
Text2.Text = Text2.Text & vbCrLf & Text1.Text
End If
Flag = True
End If

End Sub

Private Sub Form_Load()
Form1.Visible = True
Flag = True
Text1.Font.Size = 20
Text2.Font.Size = 20
Set cn = New ADODB.Connection
'cn.Open "Provider=sqloledb;data source=devserver;user ID=sa;initial catalog=infact;password=pass"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=数据库文件源;Mode=ReadWrite;Persist Security Info=False;Jet OLEDB:Encrypt Database=True"

Set rs = New ADODB.Recordset
Timer1.Enabled = False
Timer1.Interval = 10

End Sub

Private Sub Timer1_Timer()
Set rs = New ADODB.Recordset

rs.Open "SELECT 表名.身份证字段 FROM 表名 ", _
cn, adOpenStatic, adLockBatchOptimistic

If rs.RecordCount > 0 Then

s = Int(Rnd * (rs.RecordCount - 1) + 1)
rs.Move s
Text1.Text = rs("身份证字段")
End If
rs.Close
Set rs = Nothing
End Sub

[thinkvb]

感谢以上各位，我想要的摇奖系统是在一个文本框中，有个人，的身份证在循环显示，这样的功能如何实现？

[gump2000]

我的程序有什么问题啊？

[gump2000]

VERSION 5.00
Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 4005
ClientLeft = 60
ClientTop = 345
ClientWidth = 5880
LinkTopic = "Form2"
ScaleHeight = 4005
ScaleWidth = 5880
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 100
Left = 4680
Top = 1170
End
Begin VB.CommandButton Command2
Caption = "Stop"
Height = 420
Left = 2760
TabIndex = 1
Top = 2655
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Start"
Height = 405
Left = 960
TabIndex = 0
Top = 2670
Width = 1395
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "Label1"
Height = 180
Left = 1095
TabIndex = 2
Top = 1890
Width = 2910
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim tmp() As String
Dim ii As Long


Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Form_Load()
Dim count As Long
Dim tmpstr As String

count = 0
Open "g:\tmp.txt" For Input As #1
Do Until EOF(1)
Line Input #1, tmpstr
ReDim Preserve tmp(count)
tmp(count) = Trim(tmpstr)
count = count + 1
Loop
Close #1
ii = -1
End Sub

Private Sub Timer1_Timer()
ii = ii + 1
If ii > UBound(tmp) Then ii = 0
Label1.Caption = tmp(ii)
End Sub


请在 Open "g:\tmp.txt" For Input As #1
修改您的身份证的存放位置

仅供参考

[thinkvb]

多谢gump2000：
为什么，当我Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
时

Private Sub Timer1_Timer()
ii = ii + 1
If ii > UBound(tmp) Then ii = 0
Label1.Caption = tmp(ii)
End Sub
不能执行？