有會員反應不會寫這類題目
故將我寫的原始程式與註解公佈
歡迎大家參予這次的活動
只要能符合八后棋的規則
都是可以加入比賽的
Option Explicit
Dim xy(1 To 8, 1 To 8) As String
Dim i As Integer, j As Integer, k As Integer, cnt As Integer, rule As Integer, tot As Integer
Dim g As Integer, h As Integer
Dim tmpx As Integer, tmpy As Integer
Private Sub Check1_Click() '開關座標
Text1.Visible = Not Text1.Visible
Text3.Visible = Not Text3.Visible
End Sub
Private Sub Command1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) '座標效果
With Command1(Index)
Text1.Top = .Top + 220: Text1.Left = .Left - 3500
Text3.Top = .Top - 3500: Text3.Left = .Left + 220
End With
End Sub
Private Sub Command1_Click(Index As Integer) '單局八后棋
judgequeen Index
If cnt Mod 8 = 0 And rule = 0 Then
Text2.Text = Text2.Text & "恭禧完成一組八后棋!!": cnt = 0
ElseIf cnt Mod 8 = 4 And rule = 0 Then
Text2.Text = Text2.Text & " 加油 ^^ 剩 " & 8 - cnt & Chr(13) & Chr(10)
ElseIf cnt Mod 8 <> 0 And rule = 0 Then
Text2.Text = Text2.Text & " 剩 " & 8 - cnt & Chr(13) & Chr(10)
End If
End Sub
Private Sub Command2_Click() '列出組合清單
Dim i1 As Integer, j1 As Integer
Dim startime As Date
startime = Now
clsxyicon 1, 1
Text2.Text = "": Text2.Text = "開始時間 " & Format(Now, "hh:mm:ss") & Chr(13) & Chr(10)
Text2.Text = Text2.Text & "-------------------------------------------------" & Chr(13) & Chr(10)
tot = 0
For i = 1 To 8 '四面的組合都是一樣，只求一面即可
tmpx = i: tmpy = 1: recxy
For i1 = 1 To 8 '二元樹規範取得八后
For j1 = 1 To 8
tmpx = i1: tmpy = j1: recxy
If rule = 0 Then '取得每一Y軸所有皇后的位置
doxyicon
If i1 = 8 Then '當X軸在8且又可放皇后則列出組合
calarrQ
If Check2.Value = 1 Then
Dim yn As Integer
yn = MsgBox("第 " & tot & " 組，是否繼續!!", vbYesNo)
..
訪客只能看到部份內容，免費 加入會員 或由臉書 Google 
可以看到全部內容
