8quene.frm

暴力算法和回溯算法求解8皇后问题

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "8皇后问题"
   ClientHeight    =   5250
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   8700
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   8700
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "回溯法求解"
      Height          =   495
      Left            =   5760
      TabIndex        =   8
      Top             =   4560
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "暴力求解"
      Height          =   495
      Left            =   7080
      TabIndex        =   6
      Top             =   4560
      Width           =   1335
   End
   Begin VB.ListBox List1 
      Height          =   3660
      Left            =   5520
      TabIndex        =   5
      Top             =   360
      Width           =   3015
   End
   Begin VB.PictureBox Picture2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   630
      Index           =   3
      Left            =   3840
      Picture         =   "8quene.frx":0000
      ScaleHeight     =   600
      ScaleWidth      =   600
      TabIndex        =   4
      Top             =   1920
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.PictureBox Picture2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   630
      Index           =   2
      Left            =   3840
      Picture         =   "8quene.frx":1302
      ScaleHeight     =   600
      ScaleWidth      =   600
      TabIndex        =   3
      Top             =   1320
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.PictureBox Picture2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   630
      Index           =   1
      Left            =   3840
      Picture         =   "8quene.frx":2604
      ScaleHeight     =   600
      ScaleWidth      =   600
      TabIndex        =   2
      Top             =   720
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.PictureBox Picture2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   630
      Index           =   0
      Left            =   3840
      Picture         =   "8quene.frx":3906
      ScaleHeight     =   600
      ScaleWidth      =   600
      TabIndex        =   1
      Top             =   120
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.PictureBox Board 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   630
      Index           =   0
      Left            =   3840
      Picture         =   "8quene.frx":4C08
      ScaleHeight     =   600
      ScaleWidth      =   600
      TabIndex        =   0
      Top             =   2535
      Visible         =   0   'False
      Width           =   630
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   5520
      TabIndex        =   7
      Top             =   4080
      Width           =   3015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Queen(9) As Integer
Function row(n) As Integer
    row = 1 + (n - 1) \ 8
End Function
Function Col(n) As Integer
    Col = n - 8 * (row(n) - 1)
End Function
Function IsEven(n) As Boolean
    IsEven = (n / 2 = n \ 2)
End Function
Sub LoadPic(n)
    If IsEven(row(n) + Col(n)) Then
        Board(n).Picture = Picture2(2).Picture
    Else
        Board(n).Picture = Picture2(3).Picture
   End If
End Sub
Sub SetBoard()
    Dim mLeft, mTop
    Dim mWidth, mHeight
    mLeft = 100
    mTop = 100
    mWidth = Board(0).Width
    mHeight = Board(0).Height
    For i = 1 To 64
        Load Board(i)
        Board(i).Visible = True
        Board(i).Left = mLeft + mWidth * (Col(i) - 1)
        Board(i).Top = mTop + mHeight * (row(i) - 1)
        If IsEven(row(i) + Col(i)) Then
            Board(i).Picture = Picture2(0).Picture
        Else
            Board(i).Picture = Picture2(1).Picture
        End If
    Next
End Sub
Sub ResetBoard()
    For i = 1 To 64
        If IsEven(row(i) + Col(i)) Then
            Board(i).Picture = Picture2(0).Picture
        Else
            Board(i).Picture = Picture2(1).Picture
        End If
    Next
End Sub
Function IsIntersect(n, m)
    Dim Flag As Boolean
    Flag = (row(n) = row(m))
    Flag = Flag Or (Col(n) = Col(m))
    Flag = Flag Or (row(n) + Col(n) = row(m) + Col(m))
    Flag = Flag Or (row(n) - Col(n) = row(m) - Col(m))
    IsIntersect = Flag
End Function
Function Check(n, m) As Boolean
    Dim Flag As Boolean
    Flag = False
    For i = 1 To m
        If IsIntersect(n, Queen(i)) Then
            Flag = True
            Exit For
        End If
    Next
    Check = Flag
End Function
Function GetNo(r, c) As Integer
    GetNo = (r - 1) * 8 + c
End Function
Function GetName(n)
    GetName = Chr(64 + row(n)) + CStr(Col(n))
End Function
Sub BruteForce()
    MousePointer = 11
    List1.Clear
    For a = 1 To 8
        Queen(1) = a
        For b = 9 To 16
            Label1.Refresh
            If Check(b, 1) Then GoTo 10
            Queen(2) = b
            For c = 17 To 24
                If Check(c, 2) Then GoTo 11
                Queen(3) = c
                For d = 25 To 32
                    If Check(d, 3) Then GoTo 12
                    Queen(4) = d
                    For e = 33 To 40
                        If Check(e, 4) Then GoTo 13
                        Queen(5) = e
                        For f = 41 To 48
                            If Check(f, 5) Then GoTo 14
                            Queen(6) = f
                            For g = 49 To 56
                                If Check(g, 6) Then GoTo 15
                                Queen(7) = g
                                For h = 57 To 64
                                    If Not Check(h, 7) Then
                                        Queen(8) = h
                                        AddPos
                                    End If
                                Next
15                          Next
14                      Next
13                  Next
12              Next
11          Next
10      Next
    Next
    Label1.Caption = CStr(List1.ListCount) + " 种解法"
    MousePointer = 0
End Sub
Sub Recurse(c)
    For r = 1 To 8
        If Not Check(GetNo(r, c), c - 1) Then
            Queen(c) = GetNo(r, c)
            If c < 8 Then
                Recurse (c + 1)
            Else
                AddPos
            End If
        End If
    Next
End Sub
Sub AddPos()
    Dim mPos
    mPos = GetName(Queen(1))
    For i = 2 To 8
        mPos = mPos + "," + GetName(Queen(i))
    Next
    List1.AddItem mPos
End Sub
Function GetN(mName)
    r = Asc(Left(mName, 1)) - 64
    c = Val(Right(mName, 1))
    GetN = GetNo(r, c)
End Function
Sub ShowPos(mPos)
    For i = 1 To 8
        Queen(i) = GetN(Mid(mPos, 1 + 3 * (i - 1), 2))
        LoadPic (Queen(i))
    Next
End Sub
Private Sub Command1_Click()
    BruteForce
End Sub
Sub Recursion()
    MousePointer = 11
    List1.Clear
    Recurse 1
    Label1.Caption = CStr(List1.ListCount) + " 种解法"
    MousePointer = 0
End Sub

Private Sub Command2_Click()
    Recursion
End Sub

Private Sub Form_Load()
    SetBoard
End Sub

Private Sub List1_Click()
    ResetBoard
    ShowPos List1.Text
    Label1.Caption = "第 " + CStr(List1.ListIndex + 1) + " 种解法"
End Sub