Public Function f(ByVal m As Integer, ByVal x As Single, ByVal y As Single) As Single
Select Case m
Case 1
f = x + y
Case 2
f = x - y
Case 3
f = x * y
Case 4
f = x / y
End Select
End Function
Private Sub Command1_Click()
Dim s(1 To 4) As String
Dim cc1 As String
Dim tt1, tt2 As String
Dim a(1 To 7) As Single
Dim i, j, k, m, n, b, c, p, x, res As Integer
s(1) = "+"
s(2) = "-"
s(3) = "*"
s(4) = "/"
t = 0
res = 0
a(1) = Val(Combo1.Text)
a(2) = Val(Combo2.Text)
a(3) = Val(Combo3.Text)
a(4) = Val(Combo4.Text)
For i = 1 To 4
For j = 1 To 4
If j <> i Then
For m = 1 To 4
If ((m <> 4) Or a(j) <> 0) Then
a(5) = f(m, a(i), a(j))
For k = 1 To 5
If ((k <> i) And (k <> j)) Then
For b = 1 To 5
If ((b <> i) And (b <> j) And (b <> k)) Then
For n = 1 To 4
If ((n <> 4) Or (a(b) <> 0)) Then
a(6) = f(n, a(k), a(b))
For p = 1 To 6
If ((p <> i) And (p <> j) And (p <> k) And (p <> b)) Then
For c = 1 To 6
If ((c <> i) And (c <> j) And (c <> k) And (c <> b) And (c <> p)) Then
For x = 1 To 4
If ((x <> 4) Or (a(c) <> 0)) Then
a(7) = f(x, a(p), a(c))
If ((Abs(a(7) - 24)) < 0.0001) Then
res = 1
Exit For
End If
End If
Next x
End If
If res = 1 Then Exit For
Next c
End If
If res = 1 Then Exit For
Next p
End If
If res = 1 Then Exit For
Next n
End If
If res = 1 Then Exit For
Next b
End If
If res = 1 Then Exit For
Next k
End If
If res = 1 Then Exit For
Next m
End If
If res = 1 Then Exit For
Next j
If res = 1 Then Exit For
Next i
If res = 0 Then Text1.Text = "无解!"
If res = 1 Then
If k <> 5 And b <> 5 Then
tt1 = CStr(a(i)) + s(m) + CStr(a(j))
tt2 = CStr(a(k)) + s(n) + CStr(a(b))
If ((x = 3 Or x = 4) And (m = 1 Or m = 2) Or (c = 5 And (x = 2 Or x = 4))) Then
tt1 = "(" + tt1 + ")"
End If
If ((x = 3 Or x = 4) And (n = 1 Or n = 2) Or (p = 5 And (x = 2 Or x = 4))) Then
tt2 = "(" + tt2 + ")"
End If
If (p = 5) Then
cc1 = tt1 + s(x) + tt2
End If
If (c = 5) Then
cc1 = tt2 + s(x) + tt1
End If
Else
If (((n = 3 Or n = 4) And (m = 1 Or m = 2)) Or (b = 5 And (n = 2 Or n = 4))) Then
tt1 = "(" + CStr(a(i)) + s(m) + CStr(a(j)) + ")"
Else
tt1 = CStr(a(i)) + s(m) + CStr(a(j))
End If
If (k = 5) Then
tt2 = tt1 + s(n) + CStr(a(b))
End If
If (b = 5) Then
tt2 = CStr(a(k)) + s(n) + tt1
End If
If (((x = 3 Or x = 4) And (n = 1 Or n = 2)) Or (c = 5 And (x = 2 Or x = 4))) Then
tt2 = "(" + tt2 + ")"
End If
If (p = 6) Then
cc1 = tt2 + s(x) + CStr(a(c))
End If
If (c = 6) Then
cc1 = CStr(a(p)) + s(x) + tt2
End If
End If
Text1.Text = cc1
Debug.Print i, j, k, b, p, c, m, n, x
End If
End Sub