阿里云开启3306端口:如何编写（输入4个数，通过算法组成24，输出其方法，否则输出-1）

24点游戏的算法与源程序
高一7 高雅 Jan 5th. 2002
一、 任务说明
24点游戏是一个大众化的益智游戏。任意给四张扑克牌（不包括大小王），只能够用加、减、乘、除以及适当的括号连接这四张牌，无论顺序，使计算结果为24，或者宣布根本就是无解的。需要注意的是，每张牌必须运算，并且只能运算一次，J、Q、K可设置为11、12、13。
本程序目的就是算出一组牌的所有解（不同形式的式子算不同解），如没有则输出无解。
二、 算法说明
首先解决图形扑克牌的显示问题。我选择了Qcard.dll。运用其中的DrawCard过程可轻松实现扑克的显示问题，在源程序中会有具体用法。
接下来是24点算法的讨论。首先想到的是用穷举表达式的方法，然后求值。然而，由于括号的存在，使穷举表达式并非易事。实际上，括号的作用仅仅是提高运算的优先级而已，如果我们规定符号的优先级，一样可以达到要求。具体来说，设四张牌为a、b、c、d，运算符为①、②、③，表达式为a ① b ② c ③ 。如果强制规定①、②、③的优先顺序，就不必考虑括号问题了。而这3个运算符的运算顺序有3！=6种，分别是：
1．①②③ 2.①③② 3.②①③ 4.②③① 5.③①② 6.③②①
等价的表达式分别是：
1.((a①b②)c③) 2.(a①b)②(c③d) 3.(a①(b②c))③d
4.a①((b②c)③d) 5.(a①b)②(c③d) 6. a①(b②(c③d))
显然，2和5是相同的，因此只考虑5种情况。这样，括号的问题就解决了。
接下来，就是生成a、b、c、d的全排列，注意去掉其中的相同排列。去除的方法很多，比如字典排序等，我用的是另一种方法。
用循环的嵌套生成a、b、c、d的24种全排列，记录在数组中。把每一组数当作一个四位的14进制数，把这24个数全部转化为十进制（如（6529）14=6*143+5*142+2*14+9）。这样，如果两个排列完全相同，则得到的十进制数是相等的。这样，通过对这些十进制的比较，就可以比较这些排列的相同情况。一旦遇到相同的排列，就标记上。最后生成一组没有重复的排列。
对这组排列进行以上方法的运算，就可以得到所有的结果了。注意在运算过程中除法的特殊性——除数不能为零。因为可能会用到除法，所以要考虑精度问题，这里通过结果减去24取绝对值与一个接近0的小数比较，如小于它，即可判定结果是24。
附：其他待决的问题：
1、 图形扑克牌的遮挡问题。当窗口中的扑克牌被遮挡后，扑克牌不会重新画上，造成扑克牌遮挡后显示不全问题。应寻找Qcard.dll的有关参数。
2、 形式不同而实质相同的解的问题。有些解虽然形式不同，但其实质是完全相同的。如3*((11+4)-7)和3*(11+(4-7))，实际上只是一种解。去掉这些相同解的问题情况较多，其较为繁琐，有待解决。
3、 多余括号好问题。有些解的括号是多余的，应在输出前去掉。
4、 改进程序的可玩性。增加玩家输入表达式的功能，并判断对错，还可以加上时间限制，使玩家参与到游戏中。
三、 程序框图

四、 VB源程序代码

'需要声明所有用到的变量
Option Explicit

'声明全局变量、数组
Dim cards(1 To 4) As Single, card(1 To 4) As Single
Dim result(1 To 24, 0 To 4) As Integer, final(1 To 24, 1 To 4) As Integer, temp(1 To 24) As Long
Dim nokey As Boolean, total As Integer, n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, a As Integer, b As Integer, c As Integer, d As Integer, op1 As Integer, op2 As Integer, op3 As Integer, answer1 As Single, answer2 As Single, answer3 As Single, color As Integer
Dim i As Integer, j As Integer, t As Integer

'声明zero常量，设置0的标准，处理除法的精度问题
Const zero = 0.00001

'初始化QCARD32.DLL
Private Declare Function InitializeDeck Lib "qcard32.dll" (ByVal hwin As Long) As Integer

'DrawCard 子程序，画出扑克牌图样在FORM窗体及 窗体上的图片框
'用法：
'hwnd ---- 需要画图的对象句柄
'nCard --- 扑克牌编号 其编号如下
'1-13 梅花 14-26 方块 27-39 红心 40-52 黑桃 小王-110 大王-111
'x，y 位置
Private Declare Sub DrawCard Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nCard As Integer, ByVal x As Integer, ByVal y As Integer)

'DrawBack 子程序，画出扑克牌的背面图案，共六种 按 1--6 编号
Private Declare Sub DrawBack Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nCard As Long, ByVal x As Long, ByVal y As Long)

'GetCardSuit 函数，求 nCard 的点数 1-13
'Private Declare Function GetCardSuit Lib "qcard32.dll" (ByVal nCard As Long) As Long

'GetCardValue 函数，求 nCard 的花色 0∶鬼牌 1∶梅花 2∶方块 3∶红心 4∶黑桃
'Private Declare Function GetCardValue Lib "qcard32.dll" (ByVal nCard As Long) As Long

'Form_Load过程，初始化
Private Sub Form_Load()
Randomize Timer
Call InitializeDeck(Me.hwnd)
Command3.Enabled = False
End Sub

'answer函数，返回x与y做operator运算后的值，-100为错误标志
Private Function answer(x As Single, y As Single, operator As Integer) As Single
Select Case operator
Case 1
answer = x + y
Exit Function
Case 2
answer = x - y
Exit Function
Case 3
answer = x * y
Exit Function
Case 4
If y = 0 Then
answer = -100
Exit Function
Else
answer = x / y
Exit Function
End If
End Select
answer = -100
End Function

'operate函数，返回数值op所对应的四则运算符号
Private Function operate(op As Integer) As String
Select Case op
Case 1
operate = "+"
Case 2
operate = "-"
Case 3
operate = "*"
Case 4
operate = "/"
End Select
End Function

'search过程，去掉数组result中相同的元素，存入数组final中
Private Sub search()
For i = 1 To 24
result(i, 0) = 0
temp(i) = result(i, 1) * 14 ^ 3 + result(i, 2) * 14 ^ 2 + result(i, 3) * 14 + result(i, 4)
Next i
For i = 1 To 23
For j = i + 1 To 24
If temp(i) = temp(j) Then result(i, 0) = 1
Next j
Next i
For i = 1 To 24
If result(i, 0) = 1 Then GoTo 1
t = t + 1
For j = 1 To 4
final(t, j) = result(i, j)
Next j
1 Next i
End Sub

'Main过程，用于计算四个数通过不同运算得到24的所有情况，并输出结果
Private Sub Main()
For op1 = 1 To 4
For op2 = 1 To 4
For op3 = 1 To 4

'1•形如( a @ b ) @ c ) @ d 的表达式
answer1 = answer(cards(1), cards(2), op1)
answer2 = answer(answer1, cards(3), op2)
answer3 = answer(answer2, cards(4), op3)
If answer1 <> -100 And answer2 <> -100 And answer3 <> -100 Then
If Abs(answer3 - 24) < zero Then
nokey = False
total = total + 1
Text1.Text = Text1.Text + "((" + Trim$(Str$(cards(1))) + operate(op1) + Trim$(Str$(cards(2))) + ")" + operate(op2) + Trim$(Str$(cards(3))) + ")" + operate(op3) + Trim$(Str$(cards(4))) + " "
'若本行已有三个式子，就换行
If total Mod 3 = 0 Then
Text1.Text = Text1.Text + Chr$(13) + Chr$(10)
End If
End If
End If

'2•形如( a @ b ) @ (c @ d) 的表达式
answer1 = answer(cards(1), cards(2), op1)
answer2 = answer(cards(3), cards(4), op3)
answer3 = answer(answer1, answer2, op2)
If answer1 <> -100 And answer2 <> -100 And answer3 <> -100 Then
If Abs(answer3 - 24) < zero Then
nokey = False
total = total + 1
Text1.Text = Text1.Text + "(" + Trim$(Str$(cards(1))) + operate(op1) + Trim$(Str$(cards(2))) + ")" + operate(op2) + "(" + Trim$(Str$(cards(3))) + operate(op3) + Trim$(Str$(cards(4))) + ")" + " "
'若本行已有三个式子，就换行
If total Mod 3 = 0 Then
Text1.Text = Text1.Text + Chr$(13) + Chr$(10)
End If
End If
End If

'3•形如( a @ ( b @ c ) ) @ d 的表达式
answer1 = answer(cards(2), cards(3), op2)
answer2 = answer(cards(1), answer1, op1)
answer3 = answer(answer2, cards(4), op3)
If answer1 <> -100 And answer2 <> -100 And answer3 <> -100 Then
If Abs(answer3 - 24) < zero Then
nokey = False
total = total + 1
Text1.Text = Text1.Text + "(" + Trim$(Str$(cards(1))) + operate(op1) + "(" + Trim$(Str$(cards(2))) + operate(op2) + Trim$(Str$(cards(3))) + "))" + operate(op3) + Trim$(Str$(cards(4))) + " "
'若本行已有三个式子，就换行
If total Mod 3 = 0 Then
Text1.Text = Text1.Text + Chr$(13) + Chr$(10)
End If
End If
End If
'4•形如 a @ ( ( b @ c ) @ d ) 的表达式
answer1 = answer(cards(2), cards(3), op2)
answer2 = answer(answer1, cards(4), op3)
answer3 = answer(cards(1), answer2, op1)
If answer1 <> -100 And answer2 <> -100 And answer3 <> -100 Then
If Abs(answer3 - 24) < zero Then
nokey = False
total = total + 1
Text1.Text = Text1.Text + Trim$(Str$(cards(1))) + operate(op1) + "((" + Trim$(Str$(cards(2))) + operate(op2) + Trim$(Str$(cards(3))) + ")" + operate(op3) + Trim$(Str$(cards(4))) + ")" + " "
'若本行已有三个式子，就换行
If total Mod 3 = 0 Then
Text1.Text = Text1.Text + Chr$(13) + Chr$(10)
End If
End If
End If
'5•形如 a @ ( b @ ( c @ d ) ) 的表达式
answer1 = answer(cards(3), cards(4), op3)
answer2 = answer(cards(2), answer1, op2)
answer3 = answer(cards(1), answer2, op1)
If answer1 <> -100 And answer2 <> -100 And answer3 <> -100 Then
If Abs(answer3 - 24) < zero Then
nokey = False
total = total + 1
Text1.Text = Text1.Text + Trim$(Str$(cards(1))) + operate(op1) + "(" + Trim$(Str$(cards(2))) + operate(op2) + "(" + Trim$(Str$(cards(3))) + operate(op3) + Trim$(Str$(cards(4))) + "))" + " "
'若本行已有三个式子，就换行
If total Mod 3 = 0 Then
Text1.Text = Text1.Text + Chr$(13) + Chr$(10)
End If
End If
End If
Next op3
Next op2
Next op1
End Sub

'Card1_MouseDown过程，按左键点击纸牌加1，按右键减1
Private Sub Card1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Button
'按左键
Case 1
If card(4) = 13 Then
card(4) = 1
Else
card(4) = card(4) + 1
End If
'按右键
Case 2
If card(4) = 1 Then
card(4) = 13
Else
card(4) = card(4) - 1
End If
End Select
'随机产生变化后的花色
color = Int(Rnd() * 4)
'重画纸牌
Call DrawCard(Me.hwnd, color * 13 + card(4), 10, 10)
End Sub

'Card2_MouseDown过程，按左键点击纸牌加1，按右键减1
Private Sub Card2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Button
'按左键
Case 1
If card(3) = 13 Then
card(3) = 1
Else
card(3) = card(3) + 1
End If
'按右键
Case 2
If card(3) = 1 Then
card(3) = 13
Else
card(3) = card(3) - 1
End If
End Select
'随机产生变化后的花色
color = Int(Rnd() * 4)
'重画纸牌
Call DrawCard(Me.hwnd, color * 13 + card(3), 10 + 85, 10)
End Sub

'Card3_MouseDown过程，按左键点击纸牌加1，按右键减1
Private Sub Card3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Button
'按左键
Case 1
If card(2) = 13 Then
card(2) = 1
Else
card(2) = card(2) + 1
End If
'按右键
Case 2
If card(2) = 1 Then
card(2) = 13
Else
card(2) = card(2) - 1
End If
End Select
'随机产生变化后的花色
color = Int(Rnd() * 4)
'重画纸牌
Call DrawCard(Me.hwnd, color * 13 + card(2), 10 + 2 * 85, 10)
End Sub

'Card4_MouseDown过程，按左键点击纸牌加1，按右键减1
Private Sub Card4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Button
'按左键
Case 1
If card(1) = 13 Then
card(1) = 1
Else
card(1) = card(1) + 1
End If
'按右键
Case 2
If card(1) = 1 Then
card(1) = 13
Else
card(1) = card(1) - 1
End If
End Select
'随机产生变化后的花色
color = Int(Rnd() * 4)
'重画纸牌
Call DrawCard(Me.hwnd, color * 13 + card(1), 10 + 3 * 85, 10)
End Sub

'Command1_Click过程，点击洗牌按钮画出纸牌背面
Private Sub Command1_Click()
'随机产生纸牌背面的样式
color = Int(Rnd() * 6 + 1)
'画出纸牌背面
Call DrawBack(Me.hwnd, color, 10, 10)
Call DrawBack(Me.hwnd, color, 95, 10)
Call DrawBack(Me.hwnd, color, 180, 10)
Call DrawBack(Me.hwnd, color, 265, 10)
'禁用答案按钮
Command3.Enabled = False
End Sub

'Command2_Click过程，点击发牌按钮画出随机产生的纸牌
Private Sub Command2_Click()
'清空答案
Text1.Text = ""
'随机产生的纸牌，并画出
For i = 1 To 4
card(i) = Int(Rnd() * 13 + 1)
color = Int(Rnd() * 4)
Call DrawCard(Me.hwnd, color * 13 + card(i), 10 + (4 - i) * 85, 10)
Next i
'开启答案按钮
Command3.Enabled = True
End Sub

'Command3_Click过程，点击答案按钮计算结果
Private Sub Command3_Click()
'清空解的数量
Label1.Caption = ""
'默认设置为无解
nokey = True
'解的计数器清零
total = 0
'临时变量清零
i = 0
j = 0
t = 0
'产生24种全排列
For n1 = 1 To 4
For n2 = 1 To 4
If n2 = n1 Then GoTo 2
For n3 = 1 To 4
If n3 = n1 Or n3 = n2 Then GoTo 3
n4 = 10 - n1 - n2 - n3
i = i + 1
result(i, 1) = card(n1)
result(i, 2) = card(n2)
result(i, 3) = card(n3)
result(i, 4) = card(n4)
3 Next n3
2 Next n2
Next n1
'调用search过程，去掉重复排列
Call search
'调用Main过程,寻找答案
For i = 1 To t
For j = 1 To 4
cards(j) = final(i, j)
Next j
Call Main
Next i
'输出解的情况
If nokey = False Then Label1.Caption = "共有" + Trim$(Str$(total)) + "组解!" Else Label1.Caption = "无解!"
'禁止答案按钮
Command3.Enabled = False
End Sub

五、程序界面