frmmain.vb

重排九宫问题的启发式搜索算法求解

        '任务完成退出

        cData = strBD.Substring(BD.c, conL)
        If cData.Equals(conS) Then
            SeekBest()
            MsgBox("任务完成")
            Exit Sub
        End If


        '扩展节点

        colIn = Extension(strBD)
        '不存在接点不能扩展，即colin.count>0


        '接点能扩展
        intCount = colOpen.Count

        If intCount < 1 Then
            colOpen.Add(colIn(1))

            colIn.Remove(1)

        End If


        For Each strBD In colIn '给open表排序
            bln1 = True


            Preference = strBD.Substring(BD.p, conL)

            For n = 1 To colOpen.Count
                strBD1 = colOpen(n)

                intP = strBD1.Substring(BD.p, conL)



                If Preference <= intP Then
                    colOpen.Add(strBD, , n)
                    n += 1
                    intCount += 1
                    bln1 = False
                    Exit For
                End If

            Next

            If bln1 Then
                colOpen.Add(strBD)
            End If
        Next


        n = colOpen.Count
        m = 50
        Do While n > m
            colOpen.Remove(n)
            n -= 1
        Loop
        Go()

    End Sub

    '输入数据放入 tArray(2,2) 中
    Private Sub cmdDisplay_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Dim str1 = txtIN.Text

    End Sub


    '开始搜索
    Private Sub cmdOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdOK.Click

   

        colOpen = New Collection
        colClose = New Collection

        colOpen.Add(strBD)

        cmdOK.Enabled = False


        txtSavePath.Text = "正在进行搜索……"
        Go()
    End Sub

    '初始化
    Private Sub frmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.MaximizeBox = False
        txtSavePath.Text = "请输入初始值："
        '初始化显示文本框
        arrayTxt(0) = txt1
        arrayTxt(1) = txt2
        arrayTxt(2) = txt3
        arrayTxt(3) = txt4
        arrayTxt(4) = txt5
        arrayTxt(5) = txt6
        arrayTxt(6) = txt7
        arrayTxt(7) = txt8
        arrayTxt(8) = txt9

        arrayTxtGo(0) = txt11
        arrayTxtGo(1) = txt22
        arrayTxtGo(2) = txt33
        arrayTxtGo(3) = txt44
        arrayTxtGo(4) = txt55
        arrayTxtGo(5) = txt66
        arrayTxtGo(6) = txt77
        arrayTxtGo(7) = txt88
        arrayTxtGo(8) = txt99

      


        cmdOK.Enabled = False


      

    End Sub

    '数据录入
    Private Sub txtIN_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtIN.TextChanged
        Dim str1 As String
        Dim chrT(), chrV As Char
        Dim bytV As Byte
        cData = txtIN.Text
        bytV = cData.Length
        chrT = cData.ToCharArray
        intCount = cData.Length
        If bytV > 9 Then
            ErrS("输入参数只能是八位！")
            Exit Sub
        End If
        m = 0
        For Each chrV In chrT
            If Not chrV.IsNumber(chrV) Then
                ErrS("只能输入数字！")
                Exit Sub
            End If
            str1 = chrV
            If CInt(str1) > 8 Then
                ErrS("数字必须在0-8之间！（0表示空格）")
                Exit Sub
            End If

            m = m + 1
            For n = m To bytV - 1
                If chrV = chrT(n) Then
                    ErrS("输入的参数不合法！有重复！")
                    Exit Sub
                End If
            Next

        Next

        If bytV = 9 Then
            cmdOK.Enabled = True

            fData = conEndSign
            Dim strs, strp As String
            strs = "0"
            strp = "0"
            strs = strs.PadLeft(conL)
            strp = strp.PadLeft(conL)
            strBD = cData & fData & strs & strp
            txtSavePath.Text = "初始状态输入正确！"
        Else
            cmdOK.Enabled = False

        End If



        ShowT(bytV)


    End Sub

    Private Sub ErrS(ByVal str As String)
        MsgBox(str)

    End Sub

    Private Sub ShowT(ByVal bytL As Byte)
        Dim chrC(8) As Char
        chrC = cData.ToCharArray
        For n = 0 To bytL - 1
            If chrC(n) <> conSpace Then
                arrayTxt(n).Text = chrC(n)
                arrayTxtGo(n).Text = chrC(n)
            Else
                arrayTxt(n).Text = ""
                arrayTxtGo(n).Text = ""

            End If
        Next



    End Sub
    Private Sub showTGo()
        Dim chrC(8) As Char
        strBD = colClose(1)
        chrC = strBD.Substring(BD.c, conL).ToCharArray

        For n = 0 To 8
            If chrC(n) <> conSpace Then

                arrayTxtGo(n).Text = chrC(n)
            Else

                arrayTxtGo(n).Text = ""

            End If
        Next
    End Sub
    Private Sub ShowLstGo()
        lstGo.Text = ""
        For Each strBD In colClose
            cData = strBD.Substring(BD.c, conL)
            fData = strBD.Substring(BD.f, conL)
            strC = cData.Insert(9, "-" & fData)

            lstGo.Text &= (strC & Chr(13))
        Next
        lblGo.Text = colClose.Count
    End Sub

    Public Sub SeekBest()



        lstbest.Text = ""

        Dim temp As Collection
        strBD = colClose(1)
        fData = strBD.Substring(BD.f, conL)

        lstbest.Text = conS & Chr(13)
        intCount = colClose.Count
        m = 1
        Do


            For n = 2 To intCount
                strBD = colClose(n)
                strC = strBD.Substring(BD.c, conL)


                If fData.Equals(strC) Then

                    lstbest.Text &= (fData & Chr(13))
                    fData = strBD.Substring(BD.f, conL)
                    m += 1
                    Exit For
                End If

            Next

        Loop While fData <> conEndSign
        showTGo()
        ShowLstGo()
        lblBest.Text = m
        cmdOK.Enabled = True
        txtSavePath.Text = "完成！可以保存路径，也可以再输入初始状态……"
    End Sub





    Private Sub mnuexit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuexit.Click
        End
    End Sub



    Private Sub mnuSaveBest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSaveBest.Click
        SFD1.Filter = "*.txt|*.txt"
        SFD1.ShowDialog()
        Dim str1 As String = SFD1.FileName
        lstbest.SaveFile(str1)
    End Sub

    Private Sub mnuSaveGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSaveGo.Click
        SFD1.Filter = "*.txt|*.txt"
        SFD1.ShowDialog()
        Dim str1 As String = SFD1.FileName
        lstGo.SaveFile(str1)
    End Sub

    Private Sub mnuHow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuHow.Click
        Dim frm1 As New frmHelp
        frm1.Show()
    End Sub

    Private Sub mnuAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAbout.Click
        Dim frm1 As New frmAbout
        frm1.Show()
    End Sub



  
    
    Private Sub txtIN_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtIN.KeyPress
        Dim chr1 As Char = e.KeyChar.ToString
        Dim bln0 As Boolean = (chr1 = Chr(13))

        If bln0 And cmdOK.Enabled Then

            colOpen = New Collection
            colClose = New Collection

            colOpen.Add(strBD)

            cmdOK.Enabled = False


            txtSavePath.Text = "正在进行搜索……"
            Go()
        End If
    End Sub

    
End Class