自制的24点游戏

楼主 amulee	去年写的一个游戏。这个游戏花了很大力气，功能也比较全面。学习这个游戏的代码，你可以学到： 1、自定义窗体右键菜单； 2、SQL查询； 3、类模块； 4、数组； 5、添加动态控件；。。可以说是一个教材吧（这也是我的初衷）这个游戏中最核心的就是24点算法，网上都可以搜到很多。我这个带了注释，帮助理解吧。 Const PRECISION = 0.000001 '精度 Public COUNT_OF_NUMBER As Integer '参与运算的数字个数 Public NUMBER_TO_BE_CAL '运算目标值 Public MyAnswer As String '参考计算式 Public Number_Scale As Integer '运算数字的范围 Public Number() As Double '运算数字数组 Public Expression() As String '运算表达式 '24点递归算法。 '思路如下： '采用遍历的方式，先从数组的N个元素中取出两个数，分别进行四则运算，其结果保存在数组中。该数组变换为N-1个元素 '再以新数组（N-1）个元素重复上述步骤的将上述两数运算结果与剩余数字组成的数组进行上述运算 '直至所有数组元素参与计算，即到最后仅剩2个元素时判断是否有计算结果 'Expression(i)中存放运算表达式，由于最终要计算到2个元素，所以最终表达式总是存放在Expression(0)中 'Number(i)中存放两辆运算后的结果，由于最终要计算到2个元素，所以最终结果总是存放在Number(0)中 Function Search(n As Integer) As Boolean Dim a As Double, b As Double Dim Expa As String, Expb As String If n = 1 Then If Abs(Number(0) - NUMBER_TO_BE_CAL) < PRECISION Then '当数字个数仅剩2个时，判断运算是否完成 Search = True Else Search = False End If Exit Function End If For i = 0 To n - 1 For j = i + 1 To n - 1 '存放参与计算的两个数至临时变量 a = Number(i) b = Number(j) Expa = Expression(i) Expb = Expression(j) '由于每次进行更深入递归都不再生成新数组，而是以数组N-1个元素进行运算，故将最后一个元素放到j位置 'i位置存放i和j位置的两个数的运算结果 Number(j) = Number(n - 1) Expression(j) = Expression(n - 1) '表达式赋值，运算结果赋值，进行递归运算 Expression(i) = "(" & Expa & "+" & Expb & ")" Number(i) = a + b '若有运算结果则结束程序 If Search(n - 1) Then '递归在这里 Search = True Exit Function End If '以下请参考上面 Expression(i) = "(" & Expa & "-" & Expb & ")" Number(i) = a - b If Search(n - 1) Then Search = True Exit Function End If Expression(i) = "(" & Expb & "-" & Expa & ")" Number(i) = b - a If Search(n - 1) Then Search = True Exit Function End If Expression(i) = "(" & Expa & "" & Expb & ")" Number(i) = a b If Search(n - 1) Then Search = True Exit Function End If If b <> 0 Then Expression(i) = "(" & Expa & "/" & Expb & ")" Number(i) = a / b If Search(n - 1) Then Search = True Exit Function End If End If If a <> 0 Then Expression(i) = "(" & Expb & "/" & Expa & ")" Number(i) = b / a If Search(n - 1) Then Search = True Exit Function End If End If '若没有运算结果,则将数组复原，继续进行循环遍历 Number(i) = a Number(j) = b Expression(i) = Expa Expression(j) = Expb Next j Next i Search = False '若上述运算都没有结果，则该数组无法满足运算要求 End Function Sub MakeNumbers(Optional ByVal XX As Integer) Dim i& ReDim Number(0 To COUNT_OF_NUMBER - 1) '定义数字数组 ReDim Expression(0 To COUNT_OF_NUMBER - 1) '定义表达式数组 Do For i = 0 To COUNT_OF_NUMBER - 1 Randomize Number(i) = Int(Rnd * Number_Scale + 1) '数字数组随即生成 Expression(i) = CStr(Number(i)) '表达式数组赋值 UserForm1.Controls("MyLabel" & i).Caption = Number(i) '标签赋值 Next i Loop Until Search(COUNT_OF_NUMBER) '直到有计算结果才停止 UserForm1.TextBox1 = "" UserForm1.TextBox1.SetFocus iDTS = iDTS + 1 MyAnswer = Expression(0) '将运算表达式存放在MyAnswer中 End Sub 24点游戏.rar
2楼 LOGO	我是V白,向前辈学习!
3楼 xyh9999	留个脚印
4楼 wqfzqgk	以前电脑报上有这个，呵呵
5楼 liuguansky	很强大。