8queen.frm

vb平台下用回溯法求解n皇后问题

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4485
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4485
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   495
      Left            =   2520
      TabIndex        =   2
      Top             =   2520
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   2295
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Top             =   120
      Width           =   3975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "运行"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   2520
      Width           =   1695
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'N皇后互不攻击问题的回溯算法
Option Explicit '强制定义变量
Private Sub Command1_Click()
Dim n As Long
Dim Judge As Boolean '判定是否符合条件
Dim i As Long, j As Long, Num As Long
Dim a() As Long, Out() As String 'out数组用于输出图
n = InputBox("请输入皇后的个数：")
ReDim a(1 To n)
ReDim Out(1 To n)
For i = 1 To n
    a(i) = 1
Next i
Judge = True
For i = 2 To n
Sign:
If a(i) <= n Then
    For j = 1 To i - 1
        If a(j) = a(i) Or Abs(a(i) - a(j)) = Abs(i - j) Then '循环判断有否两个皇后存在互吃
            a(i) = a(i) + 1: GoTo Sign '设i－1个皇后已经放好，判断第i个皇后的位置，如果和前面i－1个中的任意一个有攻击，则该皇后向后走一步
            Judge = False
        End If
    Next j
Else
    a(i) = 1 '如果该行没有位置可放，则表示前i－1个皇后的位置有问题，先将该第i个皇后回到第一列
    i = i - 1 '再回溯到第i－1个皇后
    a(i) = a(i) + 1 '将该皇后向前走一步
    If i = 1 Then
        If a(i) > n Then MsgBox "该问题无解！": Exit Sub '若无解则退出过程
        i = 2
    End If
    GoTo Sign
End If
Next
If Judge Then '满足条件时
    For j = 1 To n
        Out(j) = String(n, StrConv("+", vbWide))
        Mid(Out(j), a(j), 1) = StrConv("@", vbWide)
    Next j
    Text1 = Text1 & n & "个皇后的摆放方法之一如下：" & vbCrLf & Join(Out, vbCrLf) & vbCrLf '输出结果
End If
End Sub

Private Sub Command2_Click()
End '退出程序
End Sub