黑白棋V1.0 源程序

我开发的黑白棋V1.0

对游戏比较感兴趣，闲则没事开发用vb.net练练.

                         黑白棋V1.0 源程序

 作者：夏敏捷  [e-mail]

                                            转载时请注明作者和出处。未经许可，请勿用于商业用途

Imports System.Math
Imports Microsoft.VisualBasic.Strings
Public Class Form1Class Form1
    Private x1 As Integer
    Private y1 As Integer
    Private Map(9, 9) As Integer
    Private MyColor As Integer
    Dim Info(20) As String
    Private Sub Show_Can_Position()Sub Show_Can_Position()
        Dim i, j As Integer
        Dim g As Graphics = Me.PictureBox1.CreateGraphics()
        Dim bitmap As New Bitmap("Info2.png")
        Dim n As Integer = 0
        For i = 1 To 8
            For j = 1 To 8
                If Map(i, j) = 0 And Can_go(i, j) Then
                    Info(n) = i & "|" & j
                    n = n + 1
                    g.DrawImage(bitmap, (i - 1) * 45 + 26, (j - 1) * 45 + 26, 30, 30)
                End If
            Next
        Next
    End Sub
    Private Function Show_Can_Num()Function Show_Can_Num() As Integer
        Dim i, j As Integer
        Dim n As Integer = 0
        For i = 1 To 8
            For j = 1 To 8
                If Can_go(i, j) Then
                    Info(n) = i & "|" & j
                    n = n + 1
                End If
            Next
        Next
        Return n
    End Function
    Private Sub Cls_Can_Position()Sub Cls_Can_Position()
        Dim n As Integer
        Dim a, b As String
        Dim x, y As Integer
        Dim s As String
        Dim g As Graphics = Me.PictureBox1.CreateGraphics()
        Dim bitmap As New Bitmap("BackColor.png")
        For n = 0 To 20
            s = Info(n)
            If s = "" Then Exit For
            a = s.Substring(0, 1)
            b = s.Substring(InStr(s, "|"), 1)
            x = Convert.ToInt16(a)
            y = Convert.ToInt16(b)
            If Map(x, y) = 0 Then
                g.DrawImage(bitmap, (x - 1) * 45 + 26, (y - 1) * 45 + 26, 30, 30)
            End If
            'Me.Text = CInt(x) & y
        Next
    End Sub
    Private Sub Button2_Click()Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Show_Can_Position()
    End Sub

    Private Sub Button3_Click()Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Cls_Can_Position()
    End Sub
    Private Function Can_go()Function Can_go(ByVal x1 As Integer, ByVal y1 As Integer) As Boolean
        Dim x, y As Integer
        Dim flag As Boolean
        '(1)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x, y1) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True

        '(2)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            y = y - 1
            If Map(x, y) = 0 Then Exit For
            If y < 1 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True

        '(3)
        flag = False
        x = x1
        y = y1
        For y = y1 - 1 To 1 Step -1
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x1, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(y - y1) > 1 Then Return True

        '(4)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            y = y - 1
            If Map(x, y) = 0 Then Exit For
            If y < 1 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True

        '(5)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x, y1) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True

        '(6)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            y = y + 1
            If Map(x, y) = 0 Then Exit For
            If y > 8 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True

        '(7)
        flag = False
        x = x1
        y = y1
        For y = y1 + 1 To 8
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x1, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(y - y1) > 1 Then Return True

        '(8)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            y = y + 1
            If Map(x, y) = 0 Then Exit For
            If y > 8 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True And Abs(x - x1) > 1 Then Return True
        Return False
    End Function
    Private Sub PictureBox1_MouseDown()Sub PictureBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        Dim x, y As Integer
        Dim flag As Boolean
        x1 = (e.X - 22)  45 + 1
        y1 = (e.Y - 22)  45 + 1
        If Not Can_go(x1, y1) Then
            ToolStripStatusLabel1.Text = "此处不能走棋子"
            Exit Sub
        End If
        Me.Text = e.X & "  " & e.Y & "  " & x1 & "  " & y1
        '(1)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x, y1) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(2)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            y = y - 1
            If Map(x, y) = 0 Then Exit For
            If y < 1 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(3)
        flag = False
        x = x1
        y = y1
        For y = y1 - 1 To 1 Step -1
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x1, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(4)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            y = y - 1
            If Map(x, y) = 0 Then Exit For
            If y < 1 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(5)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x, y1) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)
        '(6)
        flag = False
        x = x1
        y = y1
        For x = x1 + 1 To 8
            y = y + 1
            If Map(x, y) = 0 Then Exit For
            If y > 8 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(7)
        flag = False
        x = x1
        y = y1
        For y = y1 + 1 To 8
            If Map(x, y) = 0 Then Exit For
            If Ismychess(x1, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)

        '(8)
        flag = False
        x = x1
        y = y1
        For x = x1 - 1 To 1 Step -1
            y = y + 1
            If Map(x, y) = 0 Then Exit For
            If y > 8 Then
                Exit For
            End If
            If Ismychess(x, y) Then
                flag = True
                Exit For
            End If
        Next
        If flag = True Then Reverse(x, y)
        '清除提示
        Cls_Can_Position()
        '该对方走棋
        If MyColor = 1 Then
            MyColor = 2
            ToolStripStatusLabel1.Text = "白色棋子走"

        Else
            MyColor = 1
            ToolStripStatusLabel1.Text = "黑色棋子走"
        End If
        '显示提示
        Show_Can_Position()
    End Sub
    Private Sub FanQi()Sub FanQi(ByVal x As Integer, ByVal y As Integer)
        Dim g As Graphics = Me.PictureBox1.CreateGraphics()
        Dim bitmap As New Bitmap("WhiteStone.png")
        '(x1,y1)处原色处理
        If x = x1 And y = y1 Then
            If MyColor = 2 Then
                Map(x, y) = 2
                g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
            End If
            If MyColor = 1 Then
                Map(x, y) = 1
                bitmap = New Bitmap("BlackStone.png")
                g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
            End If
            Exit Sub
        End If
        'If Map(x, y) = 0 Then
        '    Exit Sub
        'End If
        '1黑色 2白色
        If Map(x, y) = 1 Then
            Map(x, y) = 2
            g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        Else
            Map(x, y) = 1
            bitmap = New Bitmap("BlackStone.png")
            g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        End If
        ListBox1.Items.Add(x & "  " & y)
    End Sub
    Private Sub Reverse()Sub Reverse(ByVal x As Integer, ByVal y As Integer)
        Dim a, b, i As Integer
        If (x - x1) * (y1 - y) = 0 Then '直线方向翻转棋子
            '直线x方向
            If x1 <> x Then
                If Abs(x1 - x) = 1 Then
                    Exit Sub
                End If
                If x1 < x Then
                    a = x1 : b = x
                End If
                If x1 > x Then
                    a = x : b = x1
                End If
                For i = a To b
                    If i <> x Then FanQi(i, y1) '(x,y)处不需要翻转
                Next
            End If
            '直线y方向
            If y1 <> y Then
                If Abs(y1 - y) = 1 Then
                    Exit Sub
                End If
                If y1 < y Then
                    a = y1 : b = y
                End If
                If y1 > y Then
                    a = y : b = y1
                End If
                For i = a To b
                    If i <> y Then FanQi(x1, i) '(x,y)处不需要翻转
                    'FanQi(x1, i)
                Next
            End If
        Else '斜线方向翻转棋子
            If (x - x1) = (y - y1) Then
                '45度正斜线
                If Abs(x1 - x) = 1 Then
                    Exit Sub
                End If
                If x1 < x Then
                    a = x1 : b = x
                    y = y1
                End If
                If x1 > x Then
                    a = x : b = x1
                End If
                For i = a To b
                    If i <> x Then FanQi(i, y) '(x,y)处不需要翻转
                    y = y + 1
                    'FanQi(i, i)
                Next
            End If
            If (x - x1) = -(y - y1) Then
                '45度反斜线
                If Abs(x1 - x) = 1 Then
                    Exit Sub
                End If
                If x1 < x Then
                    a = x1 : b = x
                    y = y1
                End If
                If x1 > x Then
                    a = x : b = x1
                End If
                For i = a To b
                    If i <> x Then FanQi(i, y) '(x,y)处不需要翻转
                    y = y - 1
                    'FanQi(i, 9 - i)
                Next
            End If
        End If
    End Sub
    Private Function Ismychess()Function Ismychess(ByVal x As Integer, ByVal y As Integer) As Boolean
        If Map(x, y) = MyColor Then
            Return True
        Else
            Return False
        End If
    End Function

    Private Sub Form1_Load()Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Map(4, 4) = 2   '0无子 1黑色 2白色
        Map(5, 5) = 2
        Map(4, 5) = 1
        Map(5, 4) = 1
        MyColor = 1    '自己棋子颜色--黑色
        ToolStripStatusLabel1.Text = "黑色棋子走"
    End Sub


    Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim x, y As Integer
        Dim g As Graphics = Me.PictureBox1.CreateGraphics()
        Dim bitmap As New Bitmap("WhiteStone.png")
        x = 4 : y = 4
        g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        x = 5 : y = 5
        g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        bitmap = New Bitmap("BlackStone.png")
        x = 5 : y = 4
        g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        x = 4 : y = 5
        g.DrawImage(bitmap, (x - 1) * 45 + 22, (y - 1) * 45 + 22, 45, 45)
        Me.Text = "begin"
        Show_Can_Position()
    End Sub
End Class