看到吧友命幽的贴子“脑力黑白棋”决定写一个功能更多一点的版本,可选难度，可自由设置关卡（不要设置过多，显示不下，步数也会不够用）
图片来自：绵阳特工的百度相册图片来自：绵阳特工的百度相册

form1:
Option Explicit
Private s As Boolean
Private Sub Combo1_Click()
SendKeys "{ENTER}"
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer) '重新选关时卸载现有棋子
Dim i As Integer
If KeyAscii = 13 Then
If num <> 0 Then
For i = 1 To counts(num - 1) - 1
Unload Command1(i)
Next i
End If
End If
KeyAscii = 0
Command2.Enabled = True
End Sub
Private Sub Command1_Click(Index As Integer) '主要游戏过程
Dim i As Integer
counts1 = counts1 + 1
If counts1 < Number Then
Label2.Caption = Number & "/" & Str(counts1)
For i = 0 To counts(num - 1) - 1
If i = Index Then
If Command1(i).BackColor = vbBlack Then
Command1(i).BackColor = vbWhite
Else
Command1(i).BackColor = vbBlack
End If
Else
If XianLing(Command1(i), Command1(Index)) Then
If Command1(i).BackColor = vbBlack Then
Command1(i).BackColor = vbWhite
Else
Command1(i).BackColor = vbBlack
End If
Else
GoTo ss '不相邻时，直接检查下一个棋子
End If
End If
ss:
Next i
If Win Then
MsgBox "赢了，用了" & Str(counts1) & "步."
s = True
Form1.Hide
Form2.Show
End If
Else
MsgBox "请再接再励！"
Form1.Hide
Form2.Show
counts1 = 0
For i = 0 To counts(num - 1) - 1
Command1(i).Enabled = False
Next i
End If
End Sub
Private Sub Command2_Click() '棋子排列
Dim i As Integer
num = Val(Combo1.Text)
Label2.Caption = Number & "/" & "0"
Command1(0).Enabled = True
For i = 1 To counts(num - 1) - 1
Load Command1(i)
If i Mod (num + 1) = 0 Then
Command1(i).Left = Command1(0).Left
Command1(i).Top = Command1(i - 1).Top + Command1(i - 1).Height
Command1(i).Visible = True
Command1(i).Enabled = True
Else
Command1(i).Left = Command1(i - 1).Left + Command1(i - 1).Width
Command1(i).Top = Command1(i - 1).Top
Command1(i).Visible = True
Command1(i).Enabled = True
End If
Next i
Command2.Enabled = False
End Sub
Private Sub Form_Activate() '重新游戏
Dim i As Integer
Command1(0).BackColor = vbBlack
If s Then
For i = 0 To counts(num - 1) - 1
Command1(i).Enabled = False
Next i
s = False
End If
End Sub
Private Sub Form_Load() '界面与数据初始化
Command2.Caption = "开始"
Dim i As Integer, j As Integer, n As Integer, m As Integer, k As Integer 'k:输入的关卡数
k = Val(InputBox("你要挑战多少关？", , "6"))
For j = 1 To k
Combo1.AddItem j
Next j
i = 4
n = 5
Do While i <= (k + 1) * (k + 1)
ReDim Preserve counts(m)
counts(m) = i
i = i + n
n = n + 2
m = m + 1
Loop
Command1(0).BackColor = vbBlack
End Sub
Private Function Win() '判断胜利
Dim i As Integer
For i = 0 To counts(num - 1) - 1
If Command1(i).BackColor = vbBlack Then
Win = False
Exit Function
End If
Next i
Win = True
End Function
form2:
Option Explicit
Private Sub Command1_Click()
Number = 20
Form2.Hide
Form1.Show
End Sub
Private Sub Command2_Click()
Number = 15
Form2.Hide
Form1.Show
End Sub
Private Sub Command3_Click()
Number = 10
Form2.Hide
Form1.Show
End Sub
Module1:
Option Explicit
Public Number As Integer
Public num As Integer '关卡数
Public counts() As Integer '每一关的图形数
Public counts1 As Integer '一共所用的步数
Public Function XianLing(a As CommandButton, b As CommandButton) As Boolean '是否相邻
If a.Left + a.Width = b.Left And a.Top = b.Top Then
XianLing = True
Exit Function
End If
If a.Left = b.Left + b.Width And a.Top = b.Top Then
XianLing = True
Exit Function
End If
If a.Top + a.Height = b.Top And a.Left = b.Left Then
XianLing = True
Exit Function
End If
If a.Top = b.Top + b.Height And a.Left = b.Left Then
XianLing = True
Exit Function
End If
XianLing = False
End Function

我就知道是Command做的，记得以前也写过。那时候我叫他翻方块。
好像只有奇数方块才有解

楼主能把设计好的程序发给我吗[email protected] 先纷了

厉害

不错，顶了

3X3的格子 过关密码 1 3 5 7 9
这五个数字次数随便 都能过关！ 还有 4X4的。。。