程序界面如下：

界面很简单：

一个长宽360像素的PICTUREBOX，     Name=picturebox1

2个label控件，名称分别为LABEL1、LABEL3，label3显示坐标用，label1用于显示得分

2个button控件，名称分别为BUTTON2、BUTTON3，BUTTON2的TEXT设为“开始”，BUTTON3的TEXT属性设为“显示数组”

窗体代码如下：

Public Class Form1
    Private idX As Integer
    Private idY As Integer
    Private canMove As Boolean = False
    Private gezi(2) As Integer
    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        drawWangGe(PictureBox1)
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        resetSUZU()
        drawWangGe(PictureBox1)
        deFen = 0
        get3p(PictureBox1)
    End Sub
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            If canMove Then
                idX = CInt(e.X \ 40)
                idY = CInt(e.Y \ 40)
                If idX = gezi(0) And idY = gezi(1) Then
                    canMove = False
                Else
                    getPath(gezi(0), gezi(1), idX, idY)
                    If CloseList.Items.Count >= 1 Then
                        showPath(PictureBox1, gezi(0), gezi(1), idX, idY)
                        get3p(PictureBox1)
                        HideWG(PictureBox1, idX, idY, 4)
                        Label1.Text = "空格数：" + suzukongNum().ToString + vbCrLf + "得分：" + deFen.ToString
                    End If

                    canMove = False
                End If
            Else
                idX = CInt(e.X \ 40)
                idY = CInt(e.Y \ 40)
                ' HideWG(PictureBox1, idX, idY, 3)
                gezi(0) = idX
                gezi(1) = idY
                gezi(2) = FGpandc(idX, idY, 1)
                If gezi(2) <> 0 Then
                    canMove = True
                Else
                    canMove = False
                End If
                Dim FGnum As Integer = suzukongNum()
                If FGnum = 0 Then
                    MsgBox("游戏结束了！")
                End If
            End If

        End If

    End Sub

    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        Label3.Text = "X=" + CInt(e.X \ 40).ToString + ", Y=" + CInt(e.Y \ 40).ToString
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        showSuzu()
    End Sub
    Public Sub showSuzu() '显示数组
        Dim str As String = ""
        Dim i As Integer, j As Integer
        For j = 0 To 8
            For i = 0 To 8
                str += FGpandc(i, j, 0).ToString & " "
            Next
            str += vbCrLf
        Next
        str += vbCrLf
        For j = 0 To 8
            For i = 0 To 8
                str += FGpandc(i, j, 1).ToString & " "
            Next
            str += vbCrLf
        Next

        For i = 0 To Openlist.Items.Count - 1
            str += Openlist.Items.Item(i).ToString & vbCrLf
        Next
        str += "" + vbCrLf
        For i = 0 To CloseList.Items.Count - 1
            str += CloseList.Items.Item(i).ToString & vbCrLf
        Next
        MsgBox(str)
    End Sub
End Class

一个模块名称为"FG" ,代码如下：

Imports System.Threading
Module FG
    Public deFen As Integer = 0
    Public FGbiao(8, 8) As Integer '用于标记的网格数组
    Public FGpandc(8, 8, 1) As Integer '网格数组
    Public HideID(35, 1) As Integer '存储相同颜色格子的坐标
    Const N As Integer = 9 '网格数
    Public CloseList As New System.Windows.Forms.ListBox '存放路径
    Public Openlist As New System.Windows.Forms.ListBox '存放备用路径
    Public HasPath As Boolean = True '用于判断某格子四周是否有空位
    Public Sub drawWangGe(ByVal pict As PictureBox)
        '画线，清除界面颜色
        Dim a As New Bitmap(360, 360)
        Dim mye As Graphics = Graphics.FromImage(a)
        mye.Clear(Color.WhiteSmoke)
        Dim i As Integer
        For i = 0 To 360 Step 40
            mye.DrawLine(Pens.RoyalBlue, 0, i, 360, i)
            mye.DrawLine(Pens.RoyalBlue, i, 0, i, 360)
        Next
        pict.Image = a
        mye.Dispose()
    End Sub
    Public Sub get3p(ByVal pic As PictureBox) '随机得到3个位置
        Dim xID(2) As Integer
        Dim yID(2) As Integer
        Dim xyColor(2) As Integer
        Dim n As Integer = 0
        Dim x As Integer, y As Integer
        Dim loopnum As Integer = 0
        loopnum = suzukongNum()
        Dim i As Integer, j As Integer
        If loopnum >= 3 Then
            Do While n < 3
                Randomize()
                x = Int(Rnd() * 9)
                Randomize()
                y = Int(Rnd() * 9)
                If FGpandc(x, y, 0) = 1 Then

                Else
                    xID(n) = x
                    yID(n) = y
                    xyColor(n) = Int(Rnd() * 5 + 1)
                    FGpandc(x, y, 0) = 1
                    FGpandc(x, y, 1) = xyColor(n)
                    HideWG(pic, x, y, 4)
                    n += 1
                End If

            Loop
        Else
            For i = 0 To 8
                For j = 0 To 8
                    If FGpandc(i, j, 0) = 0 Then
                        FGpandc(i, j, 0) = 1
                        FGpandc(i, j, 1) = Int(Rnd() * 5 + 1)
                    End If
                Next
            Next
        End If
        For i = 0 To 8
            For j = 0 To 8
                FillGe(pic, i, j, getcolor(i, j))
            Next
        Next
    End Sub
    Public Function suzukongNum() As Integer
        '判断整个数组还有几个空位
        Dim i As Integer
        Dim j As Integer
        Dim num As Integer = 0
        For i = 0 To 8
            For j = 0 To 8
                If FGpandc(i, j, 0) = 1 Then
                    num += 1
                End If
            Next
        Next
        Return 81 - num
    End Function
    '根据数组下标对网格填充
    Public Sub FillGe(ByVal pict As PictureBox, ByVal x As Integer, ByVal y As Integer, ByVal c As Color)
        Dim a As Bitmap = pict.Image
        Dim mye As Graphics = Graphics.FromImage(a)
        mye.FillRectangle(New SolidBrush(c), New Rectangle(x * 40, y * 40, 40, 40))
        Dim i As Integer
        For i = 0 To 360 Step 40
            mye.DrawLine(Pens.RoyalBlue, 0, i, 360, i)
            mye.DrawLine(Pens.RoyalBlue, i, 0, i, 360)
        Next
        pict.Image = a
        mye.Dispose()
    End Sub
    '得到颜色
    Public Function getcolor(ByVal x As Integer, ByVal y As Integer) As Color
        Select Case FGpandc(x, y, 1)
            Case 1
                Return Color.Red
            Case 2
                Return Color.Blue
            Case 3
                Return Color.Green
            Case 4
                Return Color.Yellow
            Case 5
                Return Color.Pink
            Case Else
                Return Color.WhiteSmoke
        End Select
    End Function
    Public Sub resetSUZU()
        '重置数组，全部为零
        Dim i As Integer
        Dim j As Integer

        For i = 0 To N - 1
            For j = 0 To N - 1
                FGpandc(i, j, 0) = 0
                FGpandc(i, j, 1) = 0
            Next
        Next
    End Sub

#Region "消格子"
    Private Sub hideWGH(ByVal x As Integer, ByVal y As Integer, ByRef a(,) As Integer)
        ReDim a(8, 1)
        ReSetSZ(a)
        Dim idx As Integer = x, xNum As Integer = 0
        Do While idx < 8
            idx += 1
            If FGpandc(idx, y, 1) = FGpandc(x, y, 1) Then
                xNum += 1
                a(xNum - 1, 0) = idx
                a(xNum - 1, 1) = y
            Else
                idx = 8
            End If
        Loop
        idx = x
        Do While idx > 0
            idx -= 1
            If FGpandc(idx, y, 1) = FGpandc(x, y, 1) Then
                xNum += 1
                a(xNum - 1, 0) = idx
                a(xNum - 1, 1) = y
            Else
                idx = 0
            End If
        Loop
    End Sub

    Private Sub hideWGS(ByVal x As Integer, ByVal y As Integer, ByRef a(,) As Integer)
        ReDim a(8, 1)
        ReSetSZ(a)
        Dim idy As Integer = y, yNum As Integer = 0
        Do While idy < 8
            idy += 1
            If FGpandc(x, idy, 1) = FGpandc(x, y, 1) Then
                yNum += 1
                a(yNum - 1, 0) = x
                a(yNum - 1, 1) = idy
            Else
                idy = 8
            End If
        Loop
        idy = y
        Do While idy > 0
            idy -= 1
            If FGpandc(x, idy, 1) = FGpandc(x, y, 1) Then
                yNum += 1
                a(yNum - 1, 0) = x
                a(yNum - 1, 1) = idy
            Else
                idy = 0
            End If
        Loop
    End Sub
    Private Sub ReSetSZ(ByRef D(,) As Integer)
        ReDim D(8, 1)
        Dim i As Integer
        For i = 0 To 8
            D(i, 0) = -1
            D(i, 1) = -1
        Next
    End Sub
    Private Sub ReSetSZ11()
        Dim I As Integer
        For I = 0 To 35
            HideID(I, 0) = -2
            HideID(I, 1) = -2
        Next
    End Sub
    Private Sub hideWGXZ(ByVal x As Integer, ByVal y As Integer, ByRef a(,) As Integer)
        ReDim a(8, 1)
        ReSetSZ(a)
        Dim idX As Integer = x, Num As Integer = 0, idY As Integer = y
        Do While idY > 0 And idX > 0
            idY -= 1
            idX -= 1
            If FGpandc(idX, idY, 1) = FGpandc(x, y, 1) Then
                Num += 1
                a(Num - 1, 0) = idX
                a(Num - 1, 1) = idY
            Else
                idY = 0
            End If
        Loop
        idX = x : idY = y
        Do While idX < 8 And idY < 8
            idX += 1
            idY += 1
            If FGpandc(idX, idY, 1) = FGpandc(x, y, 1) Then
                Num += 1
                a(Num - 1, 0) = idX
                a(Num - 1, 1) = idY
            Else
                idX = 8
            End If
        Loop
    End Sub
    Private Sub hideWGXY(ByVal x As Integer, ByVal y As Integer, ByRef a(,) As Integer)
        ReDim a(8, 1)
        ReSetSZ(a)
        Dim idX As Integer = x, Num As Integer = 0, idY As Integer = y
        Do While idY > 0 And idX < 8
            idY -= 1
            idX += 1
            If FGpandc(idX, idY, 1) = FGpandc(x, y, 1) Then
                Num += 1
                a(Num - 1, 0) = idX
                a(Num - 1, 1) = idY
            Else
                idY = 0
            End If
        Loop
        idX = x : idY = y
        Do While idY < 8 And idX > 0
            idX -= 1
            idY += 1
            If FGpandc(idX, idY, 1) = FGpandc(x, y, 1) Then
                Num += 1
                a(Num - 1, 0) = idX
                a(Num - 1, 1) = idY
            Else
                idY = 8
            End If
        Loop
    End Sub
    Public Sub HideWG(ByVal pic As PictureBox, ByVal x As Integer, ByVal y As Integer, ByVal nnn As Integer)
        Dim aaH(8, 1) As Integer, aaS(8, 1) As Integer, aaXY(8, 1) As Integer, aaXZ(8, 1) As Integer
        Dim i As Integer
        hideWGH(x, y, aaH)
        hideWGS(x, y, aaS)
        hideWGXZ(x, y, aaXY)
        hideWGXY(x, y, aaXZ)
        ReSetSZ11()
        Dim NUM As Integer
        NUM = 0
        For i = 0 To 8
            If getnumSZ(aaH) >= nnn - 1 Then
                If aaH(i, 0) <> -1 Then
                    NUM += 1
                    HideID(NUM - 1, 0) = aaH(i, 0)
                    HideID(NUM - 1, 1) = aaH(i, 1)
                End If
            End If
            If getnumSZ(aaS) >= nnn - 1 Then
                If aaS(i, 0) <> -1 Then
                    NUM += 1
                    HideID(NUM - 1, 0) = aaS(i, 0)
                    HideID(NUM - 1, 1) = aaS(i, 1)
                End If
            End If
            If getnumSZ(aaXY) >= nnn - 1 Then
                If aaXY(i, 0) <> -1 Then
                    NUM += 1
                    HideID(NUM - 1, 0) = aaXY(i, 0)
                    HideID(NUM - 1, 1) = aaXY(i, 1)
                End If
            End If
            If getnumSZ(aaXZ) >= nnn - 1 Then
                If aaXZ(i, 0) <> -1 Then
                    NUM += 1
                    HideID(NUM - 1, 0) = aaXZ(i, 0)
                    HideID(NUM - 1, 1) = aaXZ(i, 1)
                End If
            End If
        Next
        For i = 0 To 35
            If HideID(i, 0) <> -2 Then
                FillGe(pic, HideID(i, 0), HideID(i, 1), Color.WhiteSmoke)
                FGpandc(HideID(i, 0), HideID(i, 1), 0) = 0
                FGpandc(HideID(i, 0), HideID(i, 1), 1) = 0
            End If
        Next
        If NUM >= nnn - 1 Then
            FillGe(pic, x, y, Color.WhiteSmoke)
            FGpandc(x, y, 0) = 0
            FGpandc(x, y, 1) = 0
            ' MsgBox(NUM)
            Select Case NUM
                Case 3
                    deFen += 10
                Case 4
                    deFen += 15
                Case 5
                    deFen += 20
                Case 6
                    deFen += 25
                Case 7
                    deFen += 30
                Case 8
                    deFen += 35
                Case 9
                    deFen += 40
            End Select
        End If
       
    End Sub
    Private Function getnumSZ(ByVal a(,) As Integer) As Integer
        Dim i As Integer, NUM As Integer = 0
        For i = 0 To 8
            If a(i, 0) <> -1 Then
                NUM += 1
            End If
        Next
        Return NUM
    End Function
#End Region
#Region "查找路径"
    Public Sub getPath(ByVal x0 As Integer, ByVal y0 As Integer, ByVal x1 As Integer, ByVal y1 As Integer)
        '得到最短路径
        Dim endTag As Boolean = False

        Openlist.Items.Clear() 'close表清零
        CloseList.Items.Clear() 'open表清零
        resBiaoji()
        getOpenlist(x0, y0)
        CloseList.Items.Add(x0.ToString + "," + y0.ToString)
        Do Until Openlist.Items.Count < 1 Or endTag
            setCloseList(x1, y1)
            Dim i As Integer
            For i = 0 To CloseList.Items.Count - 1
                Dim xx As Integer = CInt(CloseList.Items.Item(i).ToString.Substring(0, 1))
                Dim yy As Integer = CInt(CloseList.Items.Item(i).ToString.Substring(2, 1))
                'MsgBox(xx.ToString + "," + yy.ToString)
                If xx = x1 And yy = y1 Then
                    endTag = True
                Else

                End If
            Next
            If endTag Then
            Else
                Dim xx1 As Integer = CInt(CloseList.Items.Item(CloseList.Items.Count - 1).ToString.Substring(0, 1))
                Dim yy1 As Integer = CInt(CloseList.Items.Item(CloseList.Items.Count - 1).ToString.Substring(2, 1))
                getOpenlist(xx1, yy1)
            End If

        Loop
        If endTag Then
            Dim i As Integer, strr As String = ""
            If CloseList.Items.Count >= 1 Then
                For i = 0 To CloseList.Items.Count - 1
                    strr += CloseList.Items.Item(i) + "|"
                Next
                ' MsgBox(strr)
            Else
                MsgBox("no data")
            End If
        Else
            MsgBox("no path")
            CloseList.Items.Clear()
        End If

    End Sub
    Public Sub showPath(ByVal pict As PictureBox, ByVal X As Integer, ByVal Y As Integer, ByVal X1 As Integer, ByVal Y1 As Integer)
        '显示路径
        Dim i As Integer
        If CloseList.Items.Count >= 1 Then
            Dim s1 As String = CloseList.Items.Item(CloseList.Items.Count - 1)
            Dim xx0 As Integer = Val(s1.Substring(0, 1))
            Dim yy0 As Integer = Val(s1.Substring(2, 1))
            Dim forNum As Integer
            If xx0 = X1 And yy0 = Y1 Then
                forNum = CloseList.Items.Count - 1
            Else
                forNum = CloseList.Items.Count - 2
            End If
            For i = 0 To forNum
                Dim s As String = CloseList.Items.Item(i)
                Dim xx As Integer = Val(s.Substring(0, 1))
                Dim yy As Integer = Val(s.Substring(2, 1))
                'FillGe(pict, xx, yy, getcolor(X, Y))
                FillGe(pict, xx, yy, Color.Bisque)
                'Thread.Sleep(500)
                FillGe(pict, xx, yy, Color.WhiteSmoke)
            Next
            FillGe(pict, X1, Y1, getcolor(X, Y))
            FGpandc(X1, Y1, 0) = 1
            FGpandc(X1, Y1, 1) = FGpandc(X, Y, 1)
            FillGe(pict, X, Y, Color.WhiteSmoke)
            FGpandc(X, Y, 0) = 0
            FGpandc(X, Y, 1) = 0
        Else
            MsgBox("no path")
        End If
    End Sub
    Private Function getJuli(ByVal x As Integer, ByVal y As Integer, ByVal x0 As Integer, ByVal y0 As Integer) As Double
        '得到两点的距离
        Return ((x - x0) ^ 2 + (y - y0) ^ 2) ^ 0.5
    End Function
    Private Sub getOpenlist(ByVal x As Integer, ByVal y As Integer)
        '得到点x，y 周围4个点,并将之加入OPEN表
        If x - 1 >= 0 Then
            If FGbiao(x - 1, y) <> 1 Then
                If inList(x - 1, y, Openlist) Then
                Else
                    If inList(x - 1, y, CloseList) Then
                    Else
                        Openlist.Items.Add((x - 1).ToString + "," + y.ToString)
                    End If
                End If

            End If
        End If
        If x + 1 <= 8 Then
            If FGbiao(x + 1, y) <> 1 Then
                If inList(x + 1, y, Openlist) Then
                Else
                    If inList(x + 1, y, CloseList) Then
                    Else
                        Openlist.Items.Add((x + 1).ToString + "," + y.ToString)
                    End If
                End If
            End If
        End If
        If y - 1 >= 0 Then
            If FGbiao(x, y - 1) <> 1 Then
                If inList(x, y - 1, Openlist) Then
                Else
                    If inList(x, y - 1, CloseList) Then
                    Else
                        Openlist.Items.Add(x.ToString + "," + (y - 1).ToString)
                    End If
                End If
            End If
        End If
        If y + 1 <= 8 Then
            If FGbiao(x, y + 1) <> 1 Then
                If inList(x, y + 1, Openlist) Then
                Else
                    If inList(x, y + 1, CloseList) Then
                    Else
                        Openlist.Items.Add(x.ToString + "," + (y + 1).ToString)
                    End If
                End If
            End If
        End If
    End Sub
    Private Sub setCloseList(ByVal x1 As Integer, ByVal y1 As Integer)
        '从开放列表中查找一最小的值，放入到CLOSE列表中
        Dim i As Integer, s As String = ""
        Dim xx As Integer, yy As Integer
        Dim b As Double
        If Openlist.Items.Count >= 1 Then
            Dim xx2 As Integer = Val((Openlist.Items.Item(0)).ToString.Substring(0, 1))
            Dim yy2 As Integer = Val((Openlist.Items.Item(0)).ToString.Substring(2, 1))
            b = getJuli(xx2, yy2, x1, y1)
            For i = 0 To Openlist.Items.Count - 1
                s = Openlist.Items.Item(i).ToString
                xx = Val(s.Substring(0, 1))
                yy = Val(s.Substring(2, 1))
                If getJuli(xx, yy, x1, y1) <= b Then
                    b = getJuli(xx, yy, x1, y1)
                Else

                End If
            Next
            For i = 0 To Openlist.Items.Count - 1
                s = Openlist.Items.Item(i).ToString
                xx = Val(s.Substring(0, 1))
                yy = Val(s.Substring(2, 1))
                If getJuli(xx, yy, x1, y1) = b Then
                    CloseList.Items.Add(s)
                    Openlist.Items.Remove(s)
                    FGbiao(xx, yy) = 1
                    Exit For
                End If
            Next
        End If

    End Sub
    Private Function inList(ByVal xx As Integer, ByVal yy As Integer, ByVal aList As ListBox) As Boolean
        '判断某点（x,y）是否在某列表中
        Dim i As Integer
        Dim s As String = xx.ToString + "," + yy.ToString
        Dim a As Boolean = False
        For i = 0 To aList.Items.Count - 1
            If s = aList.Items.Item(i) Then
                a = True
            End If
        Next
        Return a
    End Function
    Private Sub resBiaoji() '建立网格数组的拷贝
        Dim i As Integer, j As Integer
        For i = 0 To 8
            For j = 0 To 8
                FGbiao(i, j) = FGpandc(i, j, 0)
            Next
        Next
    End Sub
#End Region
   

End Module

模块FG中的SHOWPATH()显示路径中的 “Thread.Sleep(500)”这句执行时有问题。

不能显示动画效果。。。。