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