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