vlambda博客
学习文章列表

实现代码

Option Explicit

Dim blackturn As Boolean    '是否轮到黑方下子

Dim whiteturn As Boolean    '是否轮到黑方下子

Dim qipan(0 To 15, 0 To 15) As Integer '用二维数组表示棋盘

Dim inti As Integer     '数组元素

Dim intj As Integer

Dim boolF As Boolean     '表示棋局状态：进行/结束

Private Sub begin_Click() '重新开始

Me.Cls '清除窗口

For inti = 0 To 15

    For intj = 0 To 15

        qipan(inti, intj) = 0 '数组清零

    Next

Next

Form_Load '重画棋盘

End Sub

Private Sub exit_Click() '退出

Unload Me

Set Form1 = Nothing

End Sub

Private Sub Form_Load()

Form_Paint '画棋盘

blackturn = True    '黑方先下

boolF = True   '开始

Label1.Caption = "黑方先下"

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '下子

Dim intx As Integer  '落子横向位置

Dim inty As Integer  '落子竖向位置

If boolF = False Then '确定棋局是否在进行中，否，跳出

    Label1.Caption = "结束"

    Exit Sub

End If

'确定落子的确切位置

'如果鼠标点击位置不在棋盘中，则跳出

If x < 10 Or x > 310 Or y < 10 Or y > 310 Then

    Exit Sub

End If

'如果鼠标点击位置在棋盘中，则转化为相应棋盘落子点的坐标

If (x - 10) Mod 20 < 10 Then

   intx = x - (x - 10) Mod 20

Else

   intx = x + 20 - (x - 10) Mod 20

End If

If (y - 10) Mod 20 < 10 Then

   inty = y - (y - 10) Mod 20

Else

   inty = y + 20 - (y - 10) Mod 20

End If

'把坐标转换成数组中的相应元素

inti = (intx - 10) / 20

intj = (inty - 10) / 20

'如果该数组元素不为零，即表示棋盘中相应点已有棋子，则跳出

If qipan(inti, intj) <> 0 Then

    Exit Sub

End If

'画子（圆）

If blackturn = True Then

    '黑色

    Me.FillColor = RGB(0, 0, 0)

    qipan(inti, intj) = 1   '黑子赋1

    Label1.Caption = "白方"

Else

    '白色

    Me.FillColor = RGB(255, 255, 255)

    qipan(inti, intj) = 2   '白子赋2

    Label1.Caption = "黑方"

End If

Me.FillStyle = 0   '不可缺

Me.Circle (intx, inty), 8

'判断是否有五子连线

Call IfFiveLine

'轮流

blackturn = Not blackturn  '取反

End Sub

Private Sub IfFiveLine()   '判断是否有五子连线

Dim strwho As String        '下子方名称

If qipan(inti, intj) = 1 Then   '表示黑方下的子

    strwho = "黑方"

Else

    strwho = "白方"

End If

'分别判断横竖，对角线是否有五子，此段代码比较复杂，可能那以理解，但其执行效率极高

'非常适合与棋盘格子很多的情况

If samelinenums(1, 0) >= 5 Or samelinenums(0, 1) >= 5 Or samelinenums(1, 1) >= 5 Or samelinenums(-1, 1) >= 5 Then

    MsgBox strwho & "胜！"

    boolF = False  '棋局结束

End If

End Sub

Function samelinenums(changei As Integer, changej As Integer)   '判断同一直线上的棋子数

Dim i As Integer

Dim j As Integer

Dim num As Integer  '同一线上相同颜色棋子数

'计算落子一边同颜色的棋子数

i = inti: j = intj

Do

    If qipan(i, j) <> qipan(inti, intj) Then

        num = max(Abs(inti - i), Abs(intj - j))

        Exit Do

    End If

    i = i + changei: j = j + changej

Loop Until i < 0 Or i > 15 Or j < 0 Or j > 15

'计算落子另一边同颜色的棋子数

i = inti: j = intj

Do

    If qipan(i, j) <> qipan(inti, intj) Then

        num = num - 1 + max(Abs(inti - i), Abs(intj - j))

        Exit Do

    End If

    i = i - changei: j = j - changej

Loop Until i < 0 Or i > 15 Or j < 0 Or j > 15

'MsgBox num

samelinenums = num

End Function

'求较大值

Function max(inta As Integer, intb As Integer)

    max = inta

    If max < intb Then max = intb

End Function

Private Sub Form_Paint() '以(10,10)为左上角坐标画一个16*16,每格边长为20象素的棋盘

Cls         '清除

Dim i As Integer

ScaleMode = 3   '设定窗体画布的单位为象素

For i = 10 To 330 Step 20

    Me.Line (10, i)-(330, i)

    Me.Line (i, 10)-(i, 330)

Next

End Sub