VB6 八后棋(EightQueen)原碼與註解(慢動作播放執行檔)

有會員反應不會寫這類題目
故將我寫的原始程式與註解公佈
歡迎大家參予這次的活動
只要能符合八后棋的規則
都是可以加入比賽的

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)
            ..

訪客只能看到部份內容，免費 加入會員

x4

看起來有一點難度唷~~~
消化原碼中~~~謝謝三仙大大分享~~

x0

   

下面是引用students1於2008-11-14 01:37(1樓)發表的 :
看起來有一點難度唷~~~
消化原碼中~~~謝謝三仙大大分享~~

希望這帖能有拋磚引玉的功能
讓大家發揮自己的創意
不要有太大的壓力
把獎品拿回去

x0

你的好快
而且好齊全阿
大概要做出半自動完成才能比你的其全

x0

收件日期： 即日起 至 2008.12.1 00:00 (以系統時間為準，若參賽作品少於3件，將自動順延一個月)
請大家撥冗參加

x0

不太清楚八后棋的玩法

多謝 三仙 大分享源碼喔

x0

八後棋=八皇后
皇后=西洋棋的皇后棋
蠻多歷史根據的,而巴皇后規則是傳承西洋棋皇后規則

x0

1. 八后棋是在一個 8x8 的矩陣格中放入8個棋子，而這8個棋的水平、垂直、斜線都不能碰到別的棋子
座標解題將皇后設定為(0,0)
水平座標不能放(x,0)
垂直座標不能放(0,x)
斜線座標不能放(+x,+x)、(-x,-x)
斜線座標不能放(+x,-x)、(-x,+x)
判斷無值再將皇后放入

下面是引用rchockxm於2008-11-22 08:44(5樓)發表的 :
不太清楚八后棋的玩法

多謝 三仙 大分享源碼喔

x0

其時這學期剛學matlab課程
問老師稍有講一下因非關課程
還是有點想不清往那方面著手

x0

延遲的方法是不是利用DoEvents搭配上Timer@@?
我是順便想問一下，假如已經執行了DoEvents但是再擬另一邊的程序假如又呼叫了DoEvents似乎會出事情...
而每次這種情況我都直接改成Timer而非使用DoEvents (我是想問一下為什麼會跳出錯誤...)
(補:假如DoEvents頻率太高，可以再加上一個程序附加一個靜態變數減少次數應該是個不錯的法^^")

x0

下面是引用s3748679於2008-12-02 22:56(9樓)發表的 :
延遲的方法是不是利用DoEvents搭配上Timer@@?
我是順便想問一下，假如已經執行了DoEvents但是再擬另一邊的程序假如又呼叫了DoEvents似乎會出事情...
而每次這種情況我都直接改成Timer而非使用DoEvents (我是想問一下為什麼會跳出錯誤...)
(補:假如DoEvents頻率太高，可以再加上一個程序附加一個靜態變數減少次數應該是個不錯的法^^")

1.延遲的方法是不是利用DoEvents搭配上Timer@@?
Ans.延遲的方式我不是使用DoEvents 搭配上Timer
       因為除了要寫多工控制器之外，我不太喜歡用Timer!!

2.執行了DoEvents但是再擬另一邊的程序假如又呼叫了DoEvents似乎會出事情...
Ans.我還沒遇過，你能提供一下錯誤的程序嗎??

3.想問一下為什麼會跳出錯誤...
Ans.至於你提及的跳出錯誤，是指這支程式嗎??

x0

可惜不是用遞迴寫的，不然就可以交作業了

x0

下面是引用 年輕戰士 於 2010-08-21 12:16 發表的 :
可惜不是用遞迴寫的，不然就可以交作業了

就是這樣
所才不用遞迴來做範例
而且那種觀念很難解釋

x0

下面是引用 三仙 於 2010-08-21 22:01 發表的 :


就是這樣
所才不用遞迴來做範例
而且那種觀念很難解釋

那你可以寫出來給大家參考嗎

x0

對小弟而言，

這不只是利害

簡直就是超強

感謝分享~^^

x0

很好的教學啊...
相信造象棋也可以吧......

x0

哇！我校沒教這麼難的程式呢，好像只教了number guessing game……

x0

看起來有一點難度啊但
不太清楚八後棋怎玩

x0

有源碼，拿去收藏了

x0