分享
 
 
 

用VB6.0编写电脑抽奖程序

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

用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环境下编译通过!(武汉 蒋锦霞)

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有