【VB6】如何用純VB代碼寫個五子棋程序？（三）

過了很久，哈里實在是記不得當時的全部邏輯了，直接上源碼吧QAQ
1、MF.frm（主窗體內的代碼如下）

Private 執棋顏色 As Integer, 摁住的棋子 As Long, 在移動棋子 As Boolean, 交換棋子顏色中 As Boolean, 需同意色 As Integer

Private 棋局() As 棋子, 字比 As Single, 線比 As Single, 進度比 As Single
Private 勝利字比 As Single, 勝利高比 As Single, 網線比 As Single, 網線寬 As Single
Private 移動繪製時間記憶 As Single

Private Sub Form_Load()
    Dim i As Long
    Me.Caption = Me.Caption & " - Ver." & App.Major & "." & App.Minor & "." & App.Revision
    方向向量(0).y = 1
    方向向量(1).x = 1
    方向向量(1).y = 1
    方向向量(2).x = 1
    方向向量(3).x = 1
    方向向量(3).y = -1
    方向向量(4).y = -1
    方向向量(5).x = -1
    方向向量(5).y = -1
    方向向量(6).x = -1
    方向向量(7).x = -1
    方向向量(7).y = 1
    字比 = 棋盤.FontSize / 棋盤.Width
    線比 = 持子提示框.BorderWidth / 棋盒(1).Width
    進度比 = 交換剩餘時間提示.BorderWidth / 棋盤.Width
    勝利字比 = 勝利提示.FontSize / 棋盤.Width
    勝利高比 = 勝利提示.Height / 棋盤.ScaleWidth
    網線比 = 1 / 棋盤.Width
    網線寬 = 1
    ReDim 棋局(0) '初始化動態數組棋局，使其擁有元素：棋局(0)
    棋盤.Scale (0, 0)-(16, 16)
    棋盤繪製
    移動繪製時間記憶 = Timer()
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState <> 1 Then
        棋盤.Height = Me.Height - 1198
        棋盤.Width = 棋盤.Height
        棋盤.Scale (0, 0)-(16, 16)
        棋盤.Left = Me.Width / 2 - 棋盤.Width / 2
        
        棋盒(1).Left = 棋盤.Left / 7
        棋盒(1).Width = 棋盤.Left / 7 * 5
        棋盒(1).Height = 棋盒(1).Width
        棋盒(1).Top = Me.Height - 棋盒(1).Height - 835
        
        棋盒(2).Left = 棋盤.Left + 棋盤.Width + 棋盤.Left / 7
        棋盒(2).Width = 棋盒(1).Width
        棋盒(2).Height = 棋盒(1).Height
        
        持子提示框.Width = 棋盒(1).Width * 1.1
        持子提示框.Height = 持子提示框.Width
        持子提示框.BorderWidth = 線比 * 棋盒(1).Width
        
        Dim tmp As Single
        tmp = 棋盒(1).Width * 0.05
        If 摁住的棋子 = 1 Or 執棋顏色 = 1 Then
            持子提示框.Top = 棋盒(1).Top - tmp
            持子提示框.Left = 棋盒(1).Left - tmp
        ElseIf 摁住的棋子 = 2 Or 執棋顏色 = 2 Then
            持子提示框.Top = 棋盒(2).Top - tmp
            持子提示框.Left = 棋盒(2).Left - tmp
        End If
        
        交換剩餘時間提示.BorderWidth = 進度比 * 棋盤.Width
        交換剩餘時間提示.X1 = 棋盤.ScaleHeight / 2
        交換剩餘時間提示.X2 = 棋盤.ScaleWidth / 2
        If 交換時鐘.Enabled = False Then
            交換剩餘時間提示.Y1 = 0
            交換剩餘時間提示.Y2 = 棋盤.ScaleHeight
        End If
        
        勝利提示.FontSize = 棋盤.Width * 勝利字比
        勝利提示.Left = 0
        勝利提示.Width = 棋盤.ScaleWidth
        勝利提示.Height = 棋盤.ScaleWidth * 勝利高比
        勝利提示.Top = 棋盤.ScaleHeight / 2 - 勝利提示.Height / 2
        
        網線寬 = 網線比 * 棋盤.Width
        
        棋盤繪製
    End If
End Sub

Private Sub 交換時鐘_Timer()
    If 交換剩餘時間提示.Y1 <= 12 Then
        交換剩餘時間提示.Y1 = 交換剩餘時間提示.Y1 + 6
        交換剩餘時間提示.Y2 = 交換剩餘時間提示.Y2 + 6
    Else
        停止交換棋子等待
    End If
End Sub

Private Sub 交換顏色一_Click()
    需同意色 = 2
    交換棋子顏色中 = True
    交換剩餘時間提示.Visible = True
    交換時鐘.Enabled = True
End Sub

Private Sub 交換顏色二_Click()
    需同意色 = 1
    交換棋子顏色中 = True
    交換剩餘時間提示.Visible = True
    交換時鐘.Enabled = True
End Sub

Private Sub 停止交換棋子等待()
    交換棋子顏色中 = False
    交換時鐘.Enabled = False
    交換剩餘時間提示.Visible = False
    交換剩餘時間提示.Y1 = 0
    交換剩餘時間提示.Y2 = 16
End Sub

Private Sub 棋子回盒(棋子ID As Long)
    Dim 棋局緩存() As 棋子, i As Long
    棋局緩存 = 棋局
    ReDim 棋局(UBound(棋局) - 1)
    For i = 1 To 棋子ID - 1
        棋局(i) = 棋局緩存(i)
    Next
    For i = 棋子ID + 1 To UBound(棋局緩存)
        棋局(i - 1) = 棋局緩存(i)
    Next
    摁住的棋子 = 0
    棋盤繪製
End Sub

Private Function 已有棋子檢查(ByVal x As Long, ByVal y As Long) As Boolean
    Dim i As Long
    For i = 1 To UBound(棋局)
        With 棋局(i)
            If Int(.x + 0.5) = x And Int(.y + 0.5) = y And i <> 摁住的棋子 Then
                '檢查到有棋子立馬反饋該棋子標識並退出函數
                已有棋子檢查 = True
                Exit Function
            End If
        End With
    Next
End Function

Private Sub 棋盒_DblClick(Index As Integer)
    If Index = 1 Then
        認輸一_Click
    Else
        認輸二_Click
    End If
End Sub

Private Sub 棋盒_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        If 交換棋子顏色中 Then
            If 需同意色 = Index Then
                Dim cT As Long
                cT = 棋盒(需同意色).BackColor
                If 需同意色 = 1 Then
                    棋盒(1).BackColor = 棋盒(2).BackColor
                    棋盒(2).BackColor = cT
                Else
                    棋盒(2).BackColor = 棋盒(1).BackColor
                    棋盒(1).BackColor = cT
                End If
                停止交換棋子等待
            End If
        Else
            If 摁住的棋子 > 0 Then
                '手上有棋盤上拿的子
                棋子回盒 摁住的棋子
                持子提示框.Visible = False
            ElseIf 執棋顏色 > 0 Then
                '手上有棋盒那的子
                執棋顏色 = 0
                持子提示框.Visible = False
            Else
                '手上沒有棋子
                執棋顏色 = Index
                持子提示框.Top = 棋盒(Index).Top - 棋盒(Index).Width * 0.05
                持子提示框.Left = 棋盒(Index).Left - 棋盒(Index).Width * 0.05
                持子提示框.Visible = True
            End If
        End If
    Else
        If Index = 1 Then
            PopupMenu 棋盒菜單一
        Else
            PopupMenu 棋盒菜單二
        End If
    End If
End Sub

Private Sub 棋跡_Click()
    棋跡.Checked = Not 棋跡.Checked
    棋盤繪製
End Sub

Private Sub 棋盤_DblClick()
    整理棋盤
    棋盤繪製
End Sub

Private Sub 棋盤_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        If 執棋顏色 > 0 And 已有棋子檢查(Int(x + 0.5), Int(y + 0.5)) = False Then
            '手中有子,落點無子
            '每落一子，棋局數組增加一個元素用來存放新棋子
            ReDim Preserve 棋局(UBound(棋局) + 1)
            With 棋局(UBound(棋局)) 'with方法可不比每次取用類屬性時鍵全類名
                .x = x '等價於：棋局(UBound(棋局)).x=x
                .y = y
                .c = 執棋顏色
            End With
            執棋顏色 = 0 '棋子落下後手上棋子清空
            摁住的棋子 = UBound(棋局) '將落下的棋子作爲當前摁住的棋子
            在移動棋子 = True
        ElseIf 摁住的棋子 > 0 And 已有棋子檢查(Int(x + 0.5), Int(y + 0.5)) = False Then
            '手中有取子,落點無子
            With 棋局(摁住的棋子)
                .x = x
                .y = y
            End With
            摁住的棋子 = 0
            持子提示框.Visible = False
        ElseIf 摁住的棋子 = 0 And 執棋顏色 = 0 Then
            '手中無子
            摁住的棋子 = 獲得點上棋子(x, y)
            在移動棋子 = False
            If 摁住的棋子 > 0 Then
                '根據摁住棋子顏色，改變持子提示框位置
                持子提示框.Top = 棋盒(棋局(摁住的棋子).c).Top - 棋盒(棋局(摁住的棋子).c).Width * 0.05
                持子提示框.Left = 棋盒(棋局(摁住的棋子).c).Left - 棋盒(棋局(摁住的棋子).c).Width * 0.05
                持子提示框.Visible = True
            End If
        End If
        棋盤繪製
    Else
        PopupMenu 棋盤菜單
    End If
End Sub

Private Sub 棋盤_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 And 摁住的棋子 > 0 And 已有棋子檢查(Int(x + 0.5), Int(y + 0.5)) = False And Timer() - 移動繪製時間記憶 > 0.01 Then
        '按住鼠標且有摁住棋子時，不斷修改摁住棋子的座標到鼠標現在的位置上，造成移動
        在移動棋子 = True
        With 棋局(摁住的棋子)
            .x = x
            .y = y
        End With
        棋盤繪製
        移動繪製時間記憶 = Timer()
    End If
End Sub

Private Sub 棋盤_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '沒有按住棋子咯，因爲手離開了棋盤
    If Button = 1 And 在移動棋子 = True Then
        在移動棋子 = False
        摁住的棋子 = 0
        持子提示框.Visible = False
        棋盤繪製
    End If
End Sub

Private Function 獲得點上棋子(x As Single, y As Single) As Long
    Dim i As Long
    For i = 1 To UBound(棋局)
        With 棋局(i)
            If x >= .x - 0.4 And x <= .x + 0.4 And y >= .y - 0.4 And y <= .y + 0.4 Then
                獲得點上棋子 = i '函數將返回i的值
                Exit Function '找到點上棋子後立馬結束函數，不再遍歷後面的棋子是否符合
            End If
        End With
    Next
End Function

Private Sub 棋盤繪製()
    Dim i As Long
    
    If 整理.Checked Then
        整理棋盤
    End If
    
    棋盤.Cls '清空棋盤內容
    
    '繪製棋盤線
    棋盤.DrawWidth = 網線寬
    棋盤.ForeColor = vbBlack
    棋盤.FontSize = 棋盤.Width * 字比
    For i = 1 To 15
        棋盤.Line (i, 1)-(i, 15)
        棋盤.Line (1, i)-(15, i)
        棋盤.CurrentX = 0
        棋盤.CurrentY = i - 0.4
        棋盤.Print i
        棋盤.CurrentX = i - 0.2
        棋盤.CurrentY = 0
        棋盤.Print Chr(64 + i)
    Next
    '加粗四周邊線
    棋盤.DrawWidth = 網線寬 * 3
    棋盤.Line (1, 1)-(1, 15)
    棋盤.Line (15, 1)-(15, 15)
    棋盤.Line (1, 1)-(15, 1)
    棋盤.Line (1, 15)-(15, 15)
    棋盤.DrawWidth = 網線寬
    
    '繪製輔助點
    棋盤.FillColor = vbBlack
    棋盤.Circle (4, 4), 0.1, vbBlack
    棋盤.Circle (12, 4), 0.1, vbBlack
    棋盤.Circle (4, 12), 0.1, vbBlack
    棋盤.Circle (12, 12), 0.1, vbBlack
    棋盤.Circle (8, 8), 0.1, vbBlack
    
    If 摁住的棋子 > 0 Then
        棋盤.FillColor = vbRed
        棋盤.Circle (棋局(摁住的棋子).x, 棋局(摁住的棋子).y), 0.5, vbRed
    End If
    
    '根據棋局記錄的棋子屬性來繪製棋子
    棋盤.FontSize = 棋盤.Width * 字比 * 0.625
    For i = 1 To UBound(棋局)
        棋盤.FillColor = 棋盒(棋局(i).c).BackColor
        棋盤.Circle (棋局(i).x, 棋局(i).y), 0.4, 棋盒(棋局(i).c).BackColor
        If 棋跡.Checked Then
            棋盤.ForeColor = &H80000005 - 棋盒(棋局(i).c).BackColor
            棋盤.CurrentX = 棋局(i).x - Len(Str(i)) / 9 + 0.07
            棋盤.CurrentY = 棋局(i).y - 0.25
            棋盤.Print i
        End If
    Next
    
    If UBound(棋局) > 8 Then
        勝負檢查
    End If
End Sub

Private Sub 勝負檢查()
    Dim i As Long, v As Long, s As Long, 棋盤記憶 As New Dictionary
    For i = 1 To UBound(棋局)
        棋盤記憶.Add Int(棋局(i).x + 0.5) & "," & Int(棋局(i).y + 0.5), 棋局(i).c
    Next
    For i = 1 To UBound(棋局)
        For v = 0 To 7
            s = 方向遞歸(棋盤記憶, Int(棋局(i).x + 0.5), Int(棋局(i).y + 0.5), 棋局(i).c, v)
            If s >= 4 Then
                If 棋局(i).c = 1 Then
                    認輸二_Click
                Else
                    認輸一_Click
                End If
                Exit Sub
            End If
        Next
    Next
End Sub

Private Sub 清空_Click()
    ReDim 棋局(0)
    棋盤繪製
End Sub

Private Sub 認輸一_Click()
    勝利提示.ForeColor = 棋盒(2).BackColor
    勝利提示.Visible = True
End Sub

Private Sub 認輸二_Click()
    勝利提示.ForeColor = 棋盒(1).BackColor
    勝利提示.Visible = True
End Sub

Private Sub 勝利提示_Click()
    勝利提示.Visible = False
End Sub

Private Sub 整理棋盤()
    Dim i As Long
    '規整棋盤
    If 執棋顏色 = 0 And 摁住的棋子 = 0 Then
        For i = 1 To UBound(棋局)
            With 棋局(i)
                .x = Int(.x + 0.5)
                .y = Int(.y + 0.5)
            End With
        Next
    End If
End Sub
Private Sub 整理_Click()
    整理.Checked = Not 整理.Checked
    棋盤繪製
End Sub

2、MF.frm 的各項屬性的設置：

3、輔助AI.bas（模塊內代碼）

Public Type 棋子
    x As Single '棋盤上的x座標
    y As Single '棋盤上的y座標
    c As Integer '執棋類型/棋子顏色的索引
End Type
Public Type 向量
    x As Long
    y As Long
End Type
Public 方向向量(7) As 向量
Public Sub Ai提示(j() As 棋子, c As Long)
    '開發到這裏停止了
End Sub

Public Function Ai勝利檢測(j() As 棋子, c As Long) As Boolean
    Dim i As Long, v As Long, s As Long, 棋盤記憶 As New Dictionary
    For i = 1 To UBound(j)
        棋盤記憶.Add Int(j(i).x + 0.5) & "," & Int(j(i).y + 0.5), j(i).c
    Next
    For i = 1 To UBound(j)
        If j(i).c = c Then
            For v = 0 To 7
                s = 方向遞歸(棋盤記憶, Int(j(i).x + 0.5), Int(j(i).y + 0.5), j(i).c, v)
                If s >= 4 Then
                    Ai勝利檢測 = True
                    Exit Function
                End If
            Next
        End If
    Next
End Function

Public Function 方向遞歸(d As Dictionary, x As Long, y As Long, c As Integer, v As Long) As Long
    Dim tmp As String
    tmp = x + 方向向量(v).x & "," & y + 方向向量(v).y
    If d.Exists(tmp) Then
        If d(tmp) = c Then
            方向遞歸 = 方向遞歸(d, x + 方向向量(v).x, y + 方向向量(v).y, c, v) + 1
            Exit Function
        End If
    End If
End Function

3、使用了的控件一覽



各控件屬性如下：


















注意，可能有的小夥伴不知道Menu是啥，大家看這裏：



這裏的根菜單都是不可見的，需要注意一下。

編譯後的實例：https://download.csdn.net/download/HarryXYC/12527885。

以上。