大致浏览了一下，发一篇我以前在百度空间上贴的代码吧。（原创！VB）

就是这段，一个算二十四点的程序

具体的说明以及截图请到我百度的空间上看吧：

http://hi.baidu.com/13924/blog/item/33d89b82fc1832bf6c811923.html

http://hi.baidu.com/13924/blog/item/a6915eeef58dbafbb2fb958c.html

Dim arr(1 To 24, 1 To 4) As Integer
Dim arr0(1 To 4) As Integer
Dim arr1(1 To 64, 1 To 3) As Integer
Dim sign(1 To 4) As String
Dim tmp, a, b, c, d, aa, bb, cc, t, tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, bl As Integer
Dim a1$, b1$, c1$, d1$, aa1$, bb1$, cc1$

Private Sub Command1_Click()
Text2.Text = ""
tmp5 = 0
For i = 1 To 4
   arr0(i) = Val(Text1(i - 1).Text)
Next
tmp = 0
For i = 1 To 4
For j = 1 To 4
For k = 1 To 4
For l = 1 To 4
   If (i <> j And i <> k And i <> l And j <> k And k <> l And j <> l) Then
     tmp = tmp + 1
     arr(tmp, 1) = arr0(i)
     arr(tmp, 2) = arr0(j)
     arr(tmp, 3) = arr0(k)
     arr(tmp, 4) = arr0(l)
   End If
Next
Next
Next
Next
tmp = 0
For i = 1 To 4
For j = 1 To 4
For k = 1 To 4
   tmp = tmp + 1
   arr1(tmp, 1) = i
   arr1(tmp, 2) = j
   arr1(tmp, 3) = k
Next
Next
Next
Open "buffer" For Output As #1
   For i = 1 To 24
   For j = 1 To 64
     a = arr(i, 1)
     b = arr(i, 2)
     c = arr(i, 3)
     d = arr(i, 4)
     aa = arr1(j, 1)
     bb = arr1(j, 2)
     cc = arr1(j, 3)
     If aa = 1 Then tmp0 = a + b
     If aa = 2 Then tmp0 = a - b
     If aa = 3 Then tmp0 = a * b
     If (aa = 4 And b <> 0) Then tmp0 = a / b
     If bb = 1 Then tmp1 = tmp0 + c
     If bb = 2 Then tmp1 = tmp0 - c
     If bb = 3 Then tmp1 = tmp0 * c
     If (bb = 4 And c <> 0) Then tmp1 = tmp0 / c
     If cc = 1 Then
       tmp2 = tmp1 + d
       tmp3 = c + d
     End If
     If cc = 2 Then
       tmp2 = tmp1 - d
       tmp3 = c - d
     End If
     If cc = 3 Then
       tmp2 = tmp1 * d
       tmp3 = c * d
     End If
     If (cc = 4 And d <> 0) Then
       tmp2 = tmp1 / d
       tmp3 = c / d
     End If
     If bb = 1 Then tmp4 = tmp0 + tmp3
     If bb = 2 Then tmp4 = tmp0 - tmp3
     If bb = 3 Then tmp4 = tmp0 * tmp3
     If (bb = 4 And tmp3 <> 0) Then tmp4 = tmp0 / tmp3
     If tmp2 = 24 Then
       Write #1, a, b, c, d, aa, bb, cc, 0
       tmp5 = tmp5 + 1
     End If
     If tmp4 = 24 Then
       Write #1, a, b, c, d, aa, bb, cc, 1
       tmp5 = tmp5 + 1
     End If
   Next
   Next
Close #1
sign$(1) = "+"
sign$(2) = "-"
sign$(3) = "*"
sign$(4) = "/"
If tmp5 <> 0 Then
   Open "buffer" For Input As #1
   Do
     Input #1, a, b, c, d, aa, bb, cc, bl
       a1$ = LTrim(Str(a))
       b1$ = LTrim(Str(b))
       c1$ = LTrim(Str(c))
       d1$ = LTrim(Str(d))
       aa1$ = sign$(aa)
       bb1$ = sign$(bb)
       cc1$ = sign$(cc)
       If aa < 3 Then aa = 1 Else aa = 2
       If bb < 3 Then bb = 1 Else bb = 2
       If cc < 3 Then cc = 1 Else cc = 2
       t = aa * 100 + bb * 10 + cc
       If bl = 0 Then
         If (t = 211 Or t = 221 Or t = 111 Or t = 222) Then
           Text2.Text = Text2.Text & a1$ & aa1$ & b1$ & bb1$ & c1$ & cc1$ & d1$ & Chr(13) & Chr(10)
         End If
         If (t = 112 Or t = 212) Then
           Text2.Text = Text2.Text & "(" & a1$ & aa1$ & b1$ & bb1$ & c1$ & ")" & cc1$ & d1$ & Chr(13) & Chr(10)
         End If
         If (t = 122 Or t = 121) Then
           Text2.Text = Text2.Text & "(" & a1$ & aa1$ & b1$ & ")" & bb1$ & c1$ & cc1$ & d1$ & Chr(13) & Chr(10)
         End If
       End If
       If bl = 1 Then
         If t = 121 Then
           Text2.Text = Text2.Text & "(" & a1$ & aa1$ & b1$ & ")" & bb1$ & "(" & c1$ & cc1$ & d1$ & ")" & Chr(13) & Chr(10)
         End If
         If t = 212 Then
           Text2.Text = Text2.Text & a1$ & aa1$ & b1$ & bb1$ & c1$ & cc1$ & d1$ & Chr(13) & Chr(10)
         End If
       End If
   Loop While EOF(1) = False
Close #1
Kill "buffer"
Else
   Beep
   Kill "buffer"
   If a * b * c * d <> 0 Then
     Text2.Text = "未找到符合该条件的解！"
   End If
End If
End Sub

Private Sub Text1_Change(Index As Integer)
tmp = Val(Text1(Index).Text)
   If (tmp < 1 Or tmp > 13 Or Int(tmp) <> tmp) Then
     Beep
     Text1(Index).Text = ""
   End If
End Sub