为什么我做的这段抽奖程序会出现cpu 100%的假死机呢？

xiepengyu 2012-01-17 02:03:18 


Private Sub Timer1_Timer()

  Label2.Alignment = 2

  Label3.Alignment = 2

  Label4.Alignment = 2

  

If ten_flag = False Then

  Do

    num = Int(660 * Rnd + 1)

    num4 = num

    num1 = num4 Mod 10  '个位

    num4 = Int(num4 / 10)

    num2 = num4 Mod 10  '十位

    num4 = Int(num4 / 10)

    num3 = num4 Mod 10  '百位

  Loop While tempnum(num) = 1

    tempnum(num) = 1

  Label4.Caption = num1

  Label3.Caption = num2

  Label2.Caption = num3

  str_temp = Label2.Caption + Label3.Caption + Label4.Caption

  

Else

    str_temp = ""

    For ten_i = 1 To 10

      Do

        num = Int(660 * Rnd + 1)

        num4 = num

        num1 = num4 Mod 10  '个位

        num4 = Int(num4 / 10)

        num2 = num4 Mod 10  '十位

        num4 = Int(num4 / 10)

        num3 = num4 Mod 10  '百位

      Loop While tempnum(num) = 1

        tempnum(num) = 1

        Label4.Caption = num1

        Label3.Caption = num2

        Label2.Caption = num3

        str_temp = str_temp + Label2.Caption + Label3.Caption + Label4.Caption + " " 

    Next ten_i

End If


后半段是连续抽出10名。
求帮助！
...全文
339 28 打赏 收藏 转发到动态 举报
写回复
用AI写文章
28 条回复
切换为时间正序
请发表友善的回复…
发表回复
cqq_chen 2012-01-19
  • 打赏
  • 举报
 回复
好多年没看到这么热闹的帖子了，不容易啊！

让人很是怀念当年的csdn，当年的vb...
KiteGirl 2012-01-18
  • 打赏
  • 举报
 回复
这个是网页版的。



<html>



<head>

<meta http-equiv="Content-Language" content="zh-cn">

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<title>抓奖</title>

</head>



<body>



<p><a href="#" id="idButton">开始</a></p>

<p id="idOutText">列表</p>



</body>

<script language="VBScript">

  Dim priNumList()

  Dim priOutList()

  Dim priWorking

  Dim priTimer  



  tNumCount = 660

  tOutCount = 10

  ReDim priNumList(tNumCount - 1)

  ReDim priOutList(tOutCount - 1)

  

  For tIndex = 0 To tNumCount - 1

    priNumList(tIndex) = tIndex

  Next

  

  idButton.innerText = "开始"

  priWorking = False



  Sub idButton_onClick()

    priWorking = Not priWorking

    idButton.innerText = Split("开始,停止", ",")(priWorking And 1)

    If priWorking Then Web_TimeLoop

  End Sub



  Sub ListSwap(pList(), pIndex)

    tDesIndex = Int(Rnd * (UBound(pList) - pIndex)) + pIndex

    ValueSwap pList(pIndex), pList(tDesIndex)

  End Sub



  Sub ValueSwap(pA, pB)

    tT = pA: pA = pB: pB = tT

  End Sub



  Sub Web_TimeLoop()

    For tIndex = 0 To 9

      ListSwap priNumList, tIndex

      priOutList(tIndex) = tIndex + 1 & " " & priNumList(tIndex)

    Next

    idOutText.innerText = Join(priOutList, vbCrLf)

    If priWorking Then priTimer = window.setTimeout("Web_TimeLoop", 10)

  End Sub

</script>

</html>
KiteGirl 2012-01-18
  • 打赏
  • 举报
 回复
这是10个一起抓的代码。
需要一个Command1按钮、一个Timer1控件、一个Text1文本框。
Text1.MultiLine需要设置为True。



Option Explicit



Private priNumList() As Long

Private priOutList() As String



Private Sub Form_Load()

  '需要设置Text1.MultiLine = True

  Timer1.Enabled = False

  Dim tIndex As Long

  Dim tNumCount As Long

  Dim tOutCount As Long

  tNumCount = 660 '可以把这个数字设置成10来测试它是否准确。

  tOutCount = 10

  ReDim priNumList(tNumCount - 1)

  ReDim priOutList(tOutCount - 1)

  

  For tIndex = 0 To tNumCount - 1

    priNumList(tIndex) = tIndex

  Next

  

  Command1.Caption = "开始"

  Timer1.Interval = 10

End Sub



Private Sub Command1_Click()

  '开始

  Timer1.Enabled = Not Timer1.Enabled

  Command1.Caption = Split("开始,停止", ",")(Timer1.Enabled And 1)

End Sub



Private Sub ListSwap(ByRef pList() As Long, ByRef pIndex As Long)

  '将pIndex指定的元素与后面的随机元素交换。

  Dim tDesIndex As Long

  tDesIndex = Int(Rnd * (UBound(pList()) - pIndex)) + pIndex

  ValueSwap pList(pIndex), pList(tDesIndex)

End Sub



Private Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)

  '交换两个Long的值。

  Dim tT As Long

  tT = pA: pA = pB: pB = tT

End Sub



Private Sub Timer1_Timer()

  Dim tIndex As Long

  For tIndex = 0 To 9

    ListSwap priNumList(), tIndex

    priOutList(tIndex) = Format(tIndex + 1, "00") & " " & Format(priNumList(tIndex), "000")

  Next

  Text1.Text = Join(priOutList, vbCrLf)

End Sub
noah_ma 2012-01-18
  • 打赏
  • 举报
 回复
　　哟哎，楼上小仙妹……你怎么不早出现！您的代码跟俺的算法，竟然如出一辙……早知道有您的代码，俺就不用那么用功练手啦……呵呵。

对比结果：俺的代码呢，按钮只有一个，比较简洁；２２楼代码，用文本框的连接，实现了抓奖结果的记忆。俺觉得，可以相互借鉴改进得更好！

　　另外，俺想跟楼主一块谈谈体会（都新手嘛，说得不好，也不怕别人笑话）。相信楼主看了俺的代码跟２２楼提供的代码，对 Timer　作为循环体，一定会有更加深刻的理解。

　　一、Timer本身作为循环体，内部千万不要嵌入复杂的循环！否则timer的时间间隔到了，循环还未结束……很可能会出现严重的意外现象。
　　二、这是个特殊的循环体，特殊就特殊在，人家的循环，以计算出结果为停止条件，而timer却是固定时间间隔，至于你运算到哪儿，管你！……
　　所以，个人感觉，使用Timer呢，是个学问。

感谢楼主，跟各位跟贴都给俺的启发。谢谢啦。
KiteGirl 2012-01-18
  • 打赏
  • 举报
 回复
如果你想让10个数字同时滚动，一次抓成，也可以。但没有上面这个办法好玩。
你可以让老总或者经理之类的嘉宾点“抓取”。但最后一个要按“停止”。
（如果你觉得最后一个按“停止”不好用，把priOutCount=10改成11就可以了。最后那个不算。）
KiteGirl 2012-01-18
  • 打赏
  • 举报
 回复
试试这个吧，可能是你想要的。
需要把Text1文本框拉得大一些，字体可以设置得大一些。要使它的尺寸能容纳下10行。
然后将Text1.MultiLine设置为True，否则无法显示多行。
需要三个按钮Command1、Command2、Command3，还有一个Timer1控件。
使用方法是：先点“开始”按钮，然后你点“抓取”，直到抓够10个。最后点“停止”。



Private priNumList() As Long

Private priNumList_Index As Long

Private priOutList() As String



Private Sub Form_Load()

  '需要设置Text1.MultiLine = True

  Timer1.Enabled = False

  Dim tNumCount As Long

  Dim tOutCount As Long

  tNumCount = 660 '可以把这个数字设置成10来测试它是否准确。

  tOutCount = 10

  ReDim priNumList(tNumCount - 1)

  ReDim priOutList(tOutCount - 1)

  

  For tIndex = 0 To tNumCount - 1

    priNumList(tIndex) = tIndex

  Next

  

  Command1.Caption = "开始"

  Command2.Caption = "停止"

  Command3.Caption = "抓取"

  Timer1.Interval = 10

End Sub



Private Sub Command1_Click()

  '开始

  Timer1.Enabled = True

  Command1.Enabled = False

  Command2.Enabled = True

  Command3.Enabled = True

End Sub



Private Sub Command2_Click()

  '停止

  Timer1.Enabled = False

  Command1.Enabled = True

  Command2.Enabled = False

  Command3.Enabled = False

End Sub



Private Sub Command3_Click()

  '抓取

  Timer1.Enabled = False

  priNumList_Index = priNumList_Index + ((priNumList_Index < 9) And 1)

  Timer1.Enabled = True

End Sub



Private Sub ListSwap(ByRef pList() As Long, ByRef pIndex As Long)

  '将pIndex指定的元素与后面的随机元素交换。

  Dim tDesIndex As Long

  tDesIndex = Int(Rnd * (UBound(pList()) - pIndex)) + pIndex

  ValueSwap pList(pIndex), pList(tDesIndex)

End Sub



Private Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)

  '交换两个Long的值。

  Dim tT As Long

  tT = pA: pA = pB: pB = tT

End Sub



Private Sub Timer1_Timer()

  ListSwap priNumList(), priNumList_Index

  priOutList(priNumList_Index) = Format(priNumList_Index + 1, "00") & " " & Format(priNumList(priNumList_Index), "000")

  Text1.Text = Join(priOutList, vbCrLf)

End Sub
noah_ma 2012-01-18
  • 打赏
  • 举报
 回复
太好啦。向小仙妹学习啦！
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
cpu100%的问题解决了，多谢noah_ma。但是另一个问题来了：vb的label只能容纳下几十个数字，后面的数字显示不了了，难道是label能显示的字节是很少的吗？应该怎么扩大label显示的字节数呢？
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
哦，对不起，是我看错了
熊孩子开学喽 2012-01-17
  • 打赏
  • 举报
 回复
[Quote=引用 11 楼 xiepengyu 的回复:]

楼上的朋友你好，不单只要考虑抽出数字，还要考虑在界面上闪动数字，所以程序看起来繁杂。。。
加qq 16580490 ，传个你看罗
[/Quote]

.....
界面闪动什么滴,你不会是真得用程序跟踪每个随机数然后再"画"出来吧??
给你个简单方法: 自己做十个GIF(动画也行),从快到慢滚动的数字, 每个GIF最后停下来的数字对应0到9. 然后你抽中那个数字就放哪个GIF, 反正无论是几位数都是一位一位抽的,所以三位数就放三个动画,两位数就放两个动画.

像这种真正的内部抽取数字才是核心的计算,往往只占很少的代码量.速度也很快. 花力气的都是些个人机交互的东西.
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
其实：第i次抽取，为tempNum = i + int(rnd()*660 + 1 - i)，然后把temp(tempNum)与temp(i)交换。
不能保证已经抽出的数字再次被抽中呢!

比如：
i=1 rnd=0.1 tempNum=67;tempNum=67和temp[1]即1交换
i=2 rnd=0.1 tempNum=67;tempNum=67和temp[2]即2交换

这样67被抽中两次了。
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
问题可能就是出在10楼所说的比较是否已经抽过的算法上，使得到抽奖数量已经很多（要抽100多名）的时候频繁比较是否抽出过，然后再生成随机数。

但是我看不懂：第i次抽取，为tempNum = i + int(rnd()*660 + 1 - i)，然后把temp(tempNum)与temp(i)交换。

希望指点！
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
楼上的朋友你好，不单只要考虑抽出数字，还要考虑在界面上闪动数字，所以程序看起来繁杂。。。
加qq 16580490 ，传个你看罗
noah_ma 2012-01-17
  • 打赏
  • 举报
 回复
　　　偶明白了。原来所谓tempnum(num) = 1 就是个标志，表示已经抽中……晕，循环体似乎根本不起作用！看来程序要重新编写！你用循环的办法抽奖，实在效率奇低无比！而且很可能就是死循环。抽一次就得了嘛，为什么要循环呢？超级低效的算法。

　　给你个思路：
一、dim temp(1 to 660)，然后各元素顺序赋值为1至660
二、做个循环体（或者干脆就让timer做循环过程，但注意要声明窗体级变量i,tempnum,变量数组temp数组什么的。）
三、循环体。（可能把timer当循环体吧，自己看着办）
第i次抽取，为tempNum = i + int(rnd()*660 + 1 - i)，然后把temp(tempNum)与temp(i)交换。

　　循环体内的数据交换，保证了抽取的数字不会重复，一次完成。比你用循环，再比较是否已经抽过，那种算法真是糟糕透顶了。

　　以上只是算法上的考虑。界面设计就由自己发挥了。肯定的。
布衣散人 2012-01-17
  • 打赏
  • 举报
 回复
调试看看，数据在哪里循环出问题了
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
里面的Do Loop是防止抽出的数字重复
noah_ma 2012-01-17
  • 打赏
  • 举报
 回复
　　虽然俺是VB6初学者，但多少俺有asp的编程经验……
　　个人感觉，整个程序就一个字：乱！什么都乱，算法思路乱，变量乱，代码排版乱，代码使用习惯乱。呵呵。
　　建议楼主养成条理的编程习惯。

　　提个想法，没测试，就是：
　　既然楼主使用 Timer 计时器控件，当成随机抽奖的“循环”过程来使用，那么 Timer 里面的Do Loop又有什么意义呢？？？
　　总之感觉程序乱透了。感觉整个程序要重新来过。
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
还是不行，qq 16580490 ，帮看段程序，谢谢了
贝隆 2012-01-17
  • 打赏
  • 举报
 回复
这种问题一般都是出在循环上，退不出循环所致。
xiepengyu 2012-01-17
  • 打赏
  • 举报
 回复
看了，抽中num一次tempnum(num)置1，tempnum的定义以0下标为第一个元素。
加载更多回复（8）
VB 抽奖系统设计与开发（论文+源码）_Nueve
然而，语言的弹性和工具的便利性是密不可分的，只有便利的工具，却没有弹性的语言作支持，许多特殊化的处理动作必需要耗费数倍的工夫来处理，使得原来所标榜的效率提高的优点失去了作用；在应用程序中，可以使用结构化查询语言SQL数据标准，直接访问服务器上的数据库，并提供了简单的面向对象的库操作指令和多用户数据库访问的加锁机制和网络数据库的SQL的编程技术，为单机上运行的数据库提供了SQL网络接口，以便在分布式环境中快速而有效地实现客户/服务器(client/server)方案。
抽奖系统的设计与实现
然而，语言的弹性和工具的便利性是密不可分的，只有便利的工具，却没有弹性的语言作支持，许多特殊化的处理动作必需要耗费数倍的工夫来处理，使得原来所标榜的效率提高的优点失去了作用；
【杂谈】概率与随机以及手游抽卡机制的科普
原文：NGA的一篇随机科普，其中包含了对手游抽卡机制的探讨。本文摘选了我自己感兴趣的部分。 真随机 先说点题外话，请先看这个问题 一杯热水和一杯冷牛奶哪个热量更高？ 很显然这个问题从物理学和营养学的层面会得出相反的答案，( 先不考虑物理学层面说“一杯热水的热量”实际上是错误的 )，而关于“随机”的问题上的大部分疑惑与争论都恰如这个问题一般： 扔硬币算不算真随机？ 计算机是否只能生成伪随机？ 伪随机是不是就一定能找到规律？ 想要解决这些问题，就必须从两个层面去理解“随机”，接着看下面两句话： 1.让
多么痛的领悟：13 起惨痛的宕机案例
点击上方“民工哥技术之路”选择“置顶或星标”每天10点为你分享不一样的干货社区有很多兄弟分享惨痛宕机案例，提醒大家需警惕，以下介绍几起，满满都是血的教训。（以下案例来自社...
【3.7】Redis数据类型、CPU缓存一致性、哈希表
在计算机中，中断是系统用来响应硬件设备请求的一种机制，操作系统收到硬件的中断请求，会打断正在执行的进程，然后调用内核中的中断处理程序来响应请求。操作系统收到了中断请求，会打断其他进程的运行，所以中断请求的响应程序，也就是中断处理程序，要尽可能快的执行完，这样可以减少对正常进程运行调度地影响。而且，中断处理程序在响应中断时，可能还会「临时关闭中断」，这意味着，如果当前中断处理程序没有执行完之前，系统中其他的中断请求都无法被响应，也就说中断有可能会丢失，所以中断处理程序要短且快。那 Linux 系统。
VB基础类

7,763

社区成员

197,609

社区内容

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

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章