24点问题我写的完整代码
首先,感谢 lianyicq 的提醒和例子。再次,感谢 wmf2014 的测试。
开个百分散分贴,两位版主进来接分。
24点问题的规则:刚百度了一下,发现我前面搞错了范围。但以前在 计算器上玩的时候只有 一位数。
规则:给出4个数字,所给数字均为有整数(1至13之间),用加、减、乘、除(可加括号)把给出的数算成24,每个数必须用一次且只能用一次。
我们一般计算过程中,不能在计算过程出现小数、负数 ,只能出现自然数(包括 0 )。
现在,平时,可以考虑几个人用扑克玩一会儿,特别陪着孩子玩,很开动脑筋的。
========================
窗体:控件:
Label ,四个,用于提示 输入4个值。当然,按 一次性输入 ,之间用空格输入也是可以了。
我标签的 Caption 分别是:&A= 、&B=、&C=、&D= ,可以用键盘 ALT+A、B、C、D 在这四个输入框中任何切换。
IntTxt :TextBox ,控件数组,下标从 0 到 3,对应 四个值。
Command1:CommandButton,求解按钮, Caption:求解
Text1:TextBox,显示结果用,MultiLine =True(允许多行) ;ScrollBars =2(竖滚动条)
---------------窗体代码---------------------
程序代码:
Option Explicit Private Sub Command1_Click() '测试4个数 Dim s As String Dim a(0 To 4) As Long Dim i As Long, j As Long, k As Long, o As Long For i = 0 To 3 If Not IsNumeric(IntTXT(i)) Then Exit Sub '输入的不是数字 a(i) = Val(IntTXT(i)) If a(i) < 0 Or a(i) > 13 Then Exit Sub Next i Text1.Text = "运算中..." DoEvents For i = 0 To 3 For j = 0 To 3 For k = 0 To 3 For o = 0 To 3 If j <> i And k <> j And k <> i And o <> i And o <> j And o <> k Then '之间全不相同,则去运算 s = s & Test24_2(a(i), a(j), a(k), a(o)) End If Next o Next k Next j Next i '去掉括号之间的空格 s = Replace(s, "( (", "((") '去多余的空格 Do i = Len(s) s = Replace(s, " ", " ") Loop While Len(s) <> i '去重 Dim fj() As String '分行 fj = Split(s, vbCrLf) '扫描 For i = 0 To UBound(fj) For j = i + 1 To UBound(fj) If fj(i) = fj(j) Then '扫描到后面有相同的 fj(j) = "" '后面的清空 End If Next j Next i '重新组合,不能使用 join 函数是因为有空行在 s = "" For i = 0 To UBound(fj) If Len(fj(i)) > 0 Then s = s & fj(i) & vbCrLf End If Next i '检查测试结果 If Len(s) > 0 Then Text1.Text = s Else Text1.Text = "无解!" End If End Sub Private Sub IntTXT_GotFocus(Index As Integer) '获得焦点时选中所有的文本 With IntTXT(Index) .SelStart = 0 .SelLength = Len(.Text) End With End Sub Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) '全选和复制 If Shift = 2 Then '经测试,Ctrl =2 If KeyCode = vbKeyA Then Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) ElseIf KeyCode = vbKeyC Then Clipboard.Clear Clipboard.SetText Text1.Text Else KeyCode = 0 End If End If End Sub
----------------模块代码---------------------
程序代码:
Option Explicit Public Type T24type s As String '用来组合的表达式或单变量 v As Long '计算用的值 End Type Public Function Test24_2(a As Long, b As Long, c As Long, d As Long) As String Dim r1(4) As T24type, r2(4) As T24type, r3(4) As T24type Dim l1 As T24type, l2 As T24type Dim l3 As T24type, l4 As T24type Dim i As Long, j As Long, m As Long Dim s As String '第一个数 l1.s = CStr(a) l1.v = a '第二个数 l2.s = CStr(b) l2.v = b '第三个数 l3.s = CStr(c) l3.v = c '第四个数 l4.s = CStr(d) l4.v = d '第一个数与第二个数计算 Call operation(l1, l2, r1) '第一分支,第1、2数运算后与第3、4数运算 '第三个数与第四个数计算 Call operation(l3, l4, r2) For i = 1 To 4 If r1(i).v > 0 Then For j = 1 To 4 If r2(j).v >= 0 Then Call operation(r1(i), r2(j), r3) For m = 1 To 4 If r3(m).v = 24 Then s = s & r3(m).s & " = 24" & vbCrLf End If Next m End If Next j End If Next i '第二分支,第1、2数运算后与第3数运算,再与第4数运算 For i = 1 To 4 If r1(i).v >= 0 Then Call operation(r1(i), l3, r2) For j = 1 To 4 If r2(j).v >= 0 Then Call operation(r2(j), l4, r3) For m = 1 To 4 If r3(m).v = 24 Then s = s & r3(m).s & " = 24" & vbCrLf End If Next m End If Next j End If Next i '先第2、3数运算后,再与第1数运算,第4数运算。 Call operation(l2, l3, r1) For i = 1 To 4 If r1(i).v > 0 Then Call operation(l1, r1(i), r2) For j = 1 To 4 If r2(j).v > 0 Then Call operation(r2(j), l4, r3) For m = 1 To 4 If r3(m).v = 24 Then s = s & r3(m).s & " = 24" & vbCrLf End If Next m End If Next j End If Next i '先第2、3数运算后,再与第4数运算,第1数运算。 Call operation(l2, l3, r1) For i = 1 To 4 If r1(i).v > 0 Then Call operation(r1(i), l4, r2) For j = 1 To 4 If r2(j).v > 0 Then Call operation(l1, r2(j), r3) For m = 1 To 4 If r3(m).v = 24 Then s = s & r3(m).s & " = 24" & vbCrLf End If Next m End If Next j End If Next i '先第3、4数运算后,再与第2数运算,第1数运算。 Call operation(l3, l4, r1) For i = 1 To 4 If r1(i).v > 0 Then Call operation(l2, r1(i), r2) For j = 1 To 4 If r2(j).v > 0 Then Call operation(l1, r2(j), r3) For m = 1 To 4 If r3(m).v = 24 Then s = s & r3(m).s & " = 24" & vbCrLf End If Next m End If Next j End If Next i Test24_2 = s End Function Public Sub operation(a As T24type, b As T24type, r() As T24type) Dim t As Single Dim s1 As String, s2 As String '如果前一次没做乘除法,并且是表达式,则先加好括号,留给 减 乘 除 用 If Len(a.s) > 2 And (InStr(1, a.s, "+") > 0 Or InStr(1, a.s, "-") > 0) Then '>2,是因为10=2,而表达式,去掉空格也最少=3 s1 = "( " & a.s & " )" Else s1 = a.s End If If Len(b.s) > 2 And (InStr(1, b.s, "+") > 0 Or InStr(1, b.s, "-") > 0) Then s2 = "( " & b.s & " )" Else s2 = b.s End If '加法 r(1).v = a.v + b.v r(1).s = " " & a.s & " + " & b.s & " " '减法,不考虑负数 If a.v > b.v Then r(2).v = a.v - b.v r(2).s = " " & a.s & " - " & s2 & " " Else r(2).v = -1 End If '乘法 r(3).v = a.v * b.v r(3).s = " " & s1 & " * " & s2 & " " '使用可能增加了括号的表达式组合 '除法,只允许整除 If a.v >= b.v And b.v > 0 Then If a.v Mod b.v = 0 Then r(4).v = a.v / b.v r(4).s = " " & s1 & " / " & s2 & " " '使用可能增加了括号的表达式组合 Else r(4).v = -1 End If Else r(4).v = -1 End If End Sub
[ 本帖最后由 风吹过b 于 2015-6-18 22:57 编辑 ]