首先，我们先看看这个游戏的规则，给出4个1-9之间的自然数，例如：1，5，5，5（这是很经典的一个例子哦 ^_^）。在1，5，5，5中间用+、-、*、/来运算后得到24这个数。每个数只能使用一次。如果没有计算过的基本都会被难住吧。哈哈，答案是 5*（5-1/5）。是不是很经典呢？和它类似的还有3，3，8，8。
下面我们来看具体算法。一般我们考虑这样的问题的时候，都是直接写一个超大的select来判断。但重复性的工作是最无聊的！！我们来分析一下这个简单的游戏规则就可以找到一个简单的方法。
例如：4个数A、B、C、D，我们可以用F(A,B,C,D)=24来表示。那么。我们就可以把函数F拆解成F1(B,C,D)=P1(24,A)。（意思是：B，C，D之间的四则运算可以得到A和24之间的四则运算结果）。那么F1又可以继续拆解为C和D之间的四则运算关系得到结果后再和B来一次四则运算结果。这样，就可以得到很简单的一个数组6*6*6=216种结果而已。当然，这是A，B，C，D顺序固定的组合，那么把A，B，C，D换个位置，又一种组合。所以，所有的结果有6*6*6*12种。但，我们还是忽略了一种情况：A和B的值与C和D的值再进行四则运算，那么我们还需要再加一组6*6*6就可以了。
好了，不多说了，大家自己看下面的代码吧。
'--------------------------------计算24的算法---------------------------
' 算法作者：CSDN(penguinMII)--企鹅
' 开发时间：2005-3-23
' 如有引用此算法请保留此信息
'-----------------------------------------------------------------------
'关于F1(F2(F3(a1,a2),a3),a4)的变量定义
Dim f_f(0 To 5) As Double '2个数之间运算后的6种结果
Dim s_s(0 To 5) As String '2个数之间运算后的表达式
Dim f_f_f(0 To 5) As Double '第3个数和上面2数运算后的结果
Dim s_s_s(0 To 5) As String '第3个数和上面2数运算后的表达式
Dim f_f_f_f(0 To 5) As Double '第4个数和上面3数运算后的结果
Dim s_s_s_s(0 To 5) As String '第4个数和上面3数运算后的结果
'关于F1(F2(a1,a2),F3(a3,a4))的变量定义
Dim f_f1(0 To 5) As Double '第3个数第4个数运算结果
Dim s_s1(0 To 5) As String '第3个数第4个数运算后的表达式
Dim f_f2(0 To 5) As Double '第1、2数和第3、4个数运算后的结果
Dim s_s2(0 To 5) As String '第1、2数和第3、4个数运算后的表达式
Sub ff2(x As Double, y As Double, sx As String, sy As String)
On Error Resume Next
f_f2(0) = x + y
s_s2(0) = '(' + sx + '+' + sy + ')'
f_f2(1) = x - y
s_s2(1) = '(' + sx + '-' + sy + ')'
f_f2(2) = y - x
s_s2(2) = '(' + sy + '-' + sx + ')'
f_f2(3) = x * y
s_s2(3) = '(' + sx + '*' + sy + ')'
f_f2(4) = x / y
s_s2(4) = '(' + sx + '/' + sy + ')'
f_f2(5) = y / x
s_s2(5) = '(' + sy + '/' + sx + ')'
End Sub
Sub ff1(x As Integer, y As Integer)
On Error Resume Next
f_f1(0) = x + y
s_s1(0) = '(' + CStr(x) + '+' + CStr(y) + ')'
f_f1(1) = x - y
s_s1(1) = '(' + CStr(x) + '-' + CStr(y) + ')'
f_f1(2) = y - x
s_s1(2) = '(' + CStr(y) + '-' + CStr(x) + ')'
f_f1(3) = x * y
s_s1(3) = '(' + CStr(x) + '*' + CStr(y) + ')'
f_f1(4) = x / y
s_s1(4) = '(' + CStr(x) + '/' + CStr(y) + ')'
f_f1(5) = y / x
s_s1(5) = '(' + CStr(y) + '/' + CStr(x) + ')'
End Sub
Sub ff(x As Integer, y As Integer)
On Error Resume Next
f_f(0) = x + y
s_s(0) = '(' + CStr(x) + '+' + CStr(y) + ')'
f_f(1) = x - y
s_s(1) = '(' + CStr(x) + '-' + CStr(y) + ')'
f_f(2) = y - x
s_s(2) = '(' + CStr(y) + '-' + CStr(x) + ')'
f_f(3) = x * y
s_s(3) = '(' + CStr(x) + '*' + CStr(y) + ')'
f_f(4) = x / y
s_s(4) = '(' + CStr(x) + '/' + CStr(y) + ')'
f_f(5) = y / x
s_s(5) = '(' + CStr(y) + '/' + CStr(x) + ')'
End Sub
Sub fff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f(0) = x + y
s_s_s(0) = '(' + CStr(x) + '+' + s + ')'
f_f_f(1) = x - y
s_s_s(1) = '(' + CStr(x) + '-' + s + ')'
f_f_f(2) = y - x
s_s_s(2) = '(' + s + '-' + CStr(x) + ')'
f_f_f(3) = x * y
s_s_s(3) = '(' + CStr(x) + '*' + s + ')'
f_f_f(4) = x / y
s_s_s(4) = '(' + CStr(x) + '/' + s + ')'
f_f_f(5) = y / x
s_s_s(5) = '(' + s + '/' + CStr(x) + ')'
End Sub
Sub ffff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f_f(0) = x + y
s_s_s_s(0) = '(' + CStr(x) + '+' + s + ')'
f_f_f_f(1) = x - y
s_s_s_s(1) = '(' + CStr(x) + '-' + s + ')'
f_f_f_f(2) = y - x
s_s_s_s(2) = '(' + s + '-' + CStr(x) + ')'
f_f_f_f(3) = x * y
s_s_s_s(3) = '(' + CStr(x) + '*' + s + ')'
f_f_f_f(4) = x / y
s_s_s_s(4) = '(' + CStr(x) + '/' + s + ')'
f_f_f_f(5) = y / x
s_s_s_s(5) = '(' + s + '/' + CStr(x) + ')'
End Sub
Sub ppp(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer
tempp = 0
Call ff(a1, a2)
For i = 0 To 5
Call fff(a3, f_f(i), s_s(i))
For j = 0 To 5
Call ffff(a4, f_f_f(j), s_s_s(j))
For k = 0 To 5
If f_f_f_f(k) > 23.99999 And f_f_f_f(k) < 24.00001 Then
tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s_s_s(k) Then
tempp = tempp + 1
End If
Next xyz
If tempp = 0 Then
Me.List1.AddItem s_s_s_s(k)
End If
End If
Next k
Next j
Next i
End Sub
Sub qqq(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer
tempp = 0
Call ff(a1, a2)
Call ff1(a3, a4)
For i = 0 To 5
For j = 0 To 5
Call ff2(f_f(i), f_f1(j), s_s(i), s_s1(j))
For k = 0 To 5
If f_f2(k) > 23.9999 And f_f2(k) < 24.00001 Then
tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s2(k) Then
tempp = tempp + 1
End If
Next xyz
If tempp = 0 Then
Me.List1.AddItem s_s2(k)
End If
End If
Next k
Next j
Next i
End Sub
Private Sub Command1_Click()
Me.List1.Clear
Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(1).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(0).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(1).Text)
Call qqq(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)
End Sub
