24 点问题
在想，如何列出 24 点的所有答案，或者说 给 4个数，然后给出是否组合成 24 点。想啊想，就想到先把表达式列出来，然后再测试。代码如下：
程序代码：Option Explicit
'工程需要引用microsoft script control
Dim rs As String '所有的表达式
Private Sub Command1_Click()
'列出所有的可能
Dim a As Long, b As Long, c As Long, d As Long
Dim s As String
Dim FJ() As String
Open App.Path & "\24点.txt" For Output As #1
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10
s = Test24(a, b, c, d) '测试去
If Len(s) > 0 Then
Print #1, s; '有结果就写入，因为结果是带回车的，所以不能再写入回车了
End If
Next d
Next c
Next b
Next a
Close #1
MsgBox "计算完成！请检查 24点.txt 文件。", vbInformation
End Sub
Private Sub Command2_Click()
'测试4个数
Dim s2 As String
Dim a As Long, b As Long, c As Long, d As Long
'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))
'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub
Text1.Text = "运算中..."
DoEvents
'按排列组合去测试
s2 = s2 & Test24(a, b, c, d)
s2 = s2 & Test24(a, b, d, c)
s2 = s2 & Test24(a, c, b, d)
s2 = s2 & Test24(a, c, d, b)
s2 = s2 & Test24(a, d, b, c)
s2 = s2 & Test24(a, d, c, b)
s2 = s2 & Test24(b, a, c, d)
s2 = s2 & Test24(b, a, d, c)
s2 = s2 & Test24(b, c, d, a)
s2 = s2 & Test24(b, c, a, d)
s2 = s2 & Test24(b, d, a, c)
s2 = s2 & Test24(b, d, c, a)
s2 = s2 & Test24(c, b, a, d)
s2 = s2 & Test24(c, b, d, a)
s2 = s2 & Test24(c, a, b, d)
s2 = s2 & Test24(c, a, d, b)
s2 = s2 & Test24(c, d, b, a)
s2 = s2 & Test24(c, d, a, b)
s2 = s2 & Test24(d, b, c, a)
s2 = s2 & Test24(d, b, a, c)
s2 = s2 & Test24(d, c, b, a)
s2 = s2 & Test24(d, c, a, b)
s2 = s2 & Test24(d, a, b, c)
s2 = s2 & Test24(d, a, c, b)
'检查测试结果
If Len(s2) > 0 Then
Text1.Text = s2
Else
Text1.Text = "无解！"
End If
End Sub
Private Sub Form_Load()
Open App.Path & "\表达式.txt" For Binary As #1
rs = StrConv(InputB$(LOF(1), #1), vbUnicode)
Close #1
End Sub
Public Function Test24(a As Long, b As Long, c As Long, d As Long) As String
Dim s As String
Dim o As Long
Dim m As Long
Dim s2 As String
Dim FJ() As String
Dim ScriptControl1 As New scriptcontrol
ScriptControl1.Language = "VBScript"
s = rs '所有的表达式
s = Replace(s, "a", a) '把数字填进去
s = Replace(s, "b", b)
s = Replace(s, "c", c)
s = Replace(s, "d", d)
FJ = Split(s, vbCrLf) '分解成一个一个的表达式
For o = 0 To UBound(FJ)
If Len(FJ(o)) > 0 Then '是有效表达式
m = ScriptControl1.Eval(FJ(o)) '运算
If m = 24 Then '结果是24吗
s2 = s2 & FJ(o) & " = 24" & vbCrLf
End If
End If
Next o
Test24 = s2 '返回结果
End Function
