请教VB随机函数的问题,关于抽奖程序。。

maifans 2004-09-15 03:41:32
我写了个函数生成mNumber个mlowerbound 到mupperbound的不重复随机数,这样没调用一次函数可以生成不重复的随机数,但现在如果说我要抽1等奖和2等奖,调用2次这个函数,那么这2次生成的数可能重复(1等奖和2等奖总不好一个人得吧),怎么样才能使每次调用函数后生成的数在下次在调用函数时不在生成。

'=============================

'生成mNumber个mlowerbound 到mupperbound的不重复随机数

'=============================

Private Function getNumber(mNumber As Long, mupperbound As Long, mlowerbound As Long) As String
Dim i, j As Long
ReDim ran(1 To mNumber) As Long
Dim tNum As Long
Dim isExist As Boolean
Randomize

For i = 1 To mNumber
isExist = False
tNum = Int((mupperbound - mlowerbound + 1) * Rnd + mlowerbound)
Debug.Print tNum
For j = 1 To i
If ran(j) = tNum Then
isExist = True
i = i - 1
Exit For
End If
Next
If isExist = False Then
ran(i) = tNum
End If
Next

For i = 1 To mNumber
getNumber = getNumber & ran(i) & ","
Next

End Function
...全文
1316 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
starsoulxp 2004-09-15
  • 打赏
  • 举报
回复
用VB 6.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环境下编译通过
maifans 2004-09-15
  • 打赏
  • 举报
回复
我在讲清楚一点,函数里mNumber相当与中奖的人数,生成的每个数字都想对应与一个获奖者
allan80 2004-09-15
  • 打赏
  • 举报
回复
你把ReDim ran(1 To mNumber) As Long定义为模块变量(也就是定义在过程外)就行了
frankwong 2004-09-15
  • 打赏
  • 举报
回复
如果抽奖数据是保存在数据库的话,被抽中后删除中奖记录
maifans 2004-09-15
  • 打赏
  • 举报
回复
关键是每次抽出的gerNumber是由一组数字组成,里面每个数字就想对应一个得奖的人,如果第2次抽的时候有一个数字和前面重复就要重新抽》
tztz520 2004-09-15
  • 打赏
  • 举报
回复
肯定会有重复的,你如果调用两次,就判断一下,第二次得出的如果跟第一次相同,就再执行一次,直到得出不同的.

7,762

社区成员

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

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