新建一工程，窗口左上角放一按钮，拷贝下列代码，运行即可
'********************************************************
Dim qpX As Integer, qpY As Integer, qpL As Integer, qzR As Integer '用于存储棋盘左上角坐标、棋盘边长和棋子半径
Dim QJ(2, 2) As Integer '用3*3的数组存储棋局，数组中无棋子为0，人下的棋子为1，电脑棋子为2，这里参考了风兄提议，我以前设计围棋时通常是黑棋-1，白棋1
Dim runFlg As Boolean
'可以走棋标志
Private Function Winner() As Integer
'判断输赢，并将赢家棋子颜色返回
Dim i As Integer, j As Integer, c As Integer, k As Integer
Winner = 0
For i = 0 To 2
'分别判断行列是否相同
If QJ(i, 0) <> 0 Then
c = QJ(i, 0)
If QJ(i, 1) = c And QJ(i, 2) = c Then
Winner = c
Exit Function
End If
End If
If QJ(0, i) <> 0 Then
c = QJ(0, i)
If QJ(1, i) = c And QJ(2, i) = c Then
Winner = c
Exit Function
End If
End If
Next
'再判断两个斜线是否相同
If QJ(0, 0) <> 0 Then
c = QJ(0, 0)
If QJ(1, 1) = c And QJ(2, 2) = c Then
Winner = c
Exit Function
End If
End If
If QJ(2, 0) <> 0 Then
c = QJ(2, 0)
If QJ(1, 1) = c And QJ(0, 2) = c Then
Winner = c
Exit Function
End If
End If
End Function
Private Sub DrawQJ()
'画棋盘和棋子
Dim i As Integer, j As Integer, l As Integer, k As Integer, x As Integer, y As Integer
Me.Cls
l = Me.ScaleWidth
If l > Me.ScaleHeight Then l = Me.ScaleHeight
qpL = 0.9 * l
j = qpL / 3
qzR = j * 0.6 * 0.5
qpX = (Me.ScaleWidth - qpL) / 2
qpY = (Me.ScaleHeight - qpL) / 2
For i = 0 To 3
Me.Line (qpX + i * j, qpY)-(qpX + i * j, qpY + qpL), vbBlue
Me.Line (qpX, qpY + i * j)-(qpX + qpL, qpY + i * j), vbBlue
Next
For i = 0 To 2
For k = 0 To 2
x = i * j + qpX + j * 0.5
y = k * j + qpY + j * 0.5
If QJ(i, k) = 1 Then
'人下的棋
Me.FillStyle = 0
Me.FillColor = vbWhite
Me.Circle (x, y), qzR, vbBlack
End If
If QJ(i, k) = 2 Then
'电脑下的棋
Me.FillStyle = 0
Me.FillColor = vbBlack
Me.Circle (x, y), qzR, vbRed
End If
Next
Next
End Sub
Private Sub autoComputer()
'电脑自动下棋
Dim i As Integer, j As Integer, k As Integer, c As Integer, b(8, 1) As Integer
If Not runFlg Then Exit Sub
c = 0
For i = 0 To 2
For j = 0 To 2
If QJ(i, j) = 0 Then
QJ(i, j) = 2
'首先判定电脑下任何一步能不能赢
If Winner = 2 Then
DrawQJ
MsgBox "电脑赢了！"
runFlg = False
Exit Sub
Else
QJ(i, j) = 0
End If
End If
Next
Next
For i = 0 To 2
For j = 0 To 2
If QJ(i, j) = 0 Then
QJ(i, j) = 1
'其次判断对手下任何一步是否会赢
If Winner = 1 Then
QJ(i, j) = 2
DrawQJ
Exit Sub
Else
QJ(i, j) = 0
End If
b(c, 0) = i
b(c, 1) = j
c = c + 1
End If
Next
Next
If c < 2 Then
MsgBox "和棋！"
runFlg = False
Exit Sub
End If
Randomize
c = Rnd * c
'电脑随机走一步
QJ(b(c, 0), b(c, 1)) = 2
DrawQJ
If Winner = 2 Then
runFlg = False
MsgBox "电脑赢了！"
End If
End Sub
Private Sub Command1_Click()
Dim i As Integer, j As Integer
For i = 0 To 2
For j = 0 To 2
QJ(i, j) = 0
Next
Next
'初始化棋局为无棋子状态
Randomize
If Rnd > 0.5 Then autoComputer
'如果随机数大于0.5则电脑先下，否则等待人先下
DrawQJ
'画棋局
runFlg = True
End Sub
Private Sub Form_Load()
Command1_Click
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer, j As Integer, k As Integer, x1 As Integer, y1 As Integer, c As Integer
If Button = 1 And runFlg Then
For i = 0 To 2
For k = 0 To 2
j = qpL / 3
x1 = i * j + qpX
y1 = k * j + qpY
If x > x1 And y > y1 And x < x1 + j And y < y1 + j Then
If QJ(i, k) = 0 Then
QJ(i, k) = 1
DrawQJ
If Winner = 1 Then
MsgBox "你赢了！"
runFlg = False
End If
autoComputer
End If
End If
Next
Next
End If
End Sub
Private Sub Form_Resize()
DrawQJ
End Sub
井字棋.rar