這個程式是我 93 年要訓練選手所出的題目。現在把它放上來，給有興趣的人觀看吧。
物件有 a(0) ~ a(8) command1 , command2 , form1 , option1 , option2
原始程式碼如下:
Dim i As Integer ' i 變數Dim xo(8) As String ' 存放資料格
Dim locate As Integer ' 電腦最佳解
Dim counter As Integer ' 目前可下的空格數目
Dim b(8) As Integer ' 記錄目前的空格狀態
Dim win(8) As Integer ' 記錄八種勝利的狀態
Private Sub a_Click(Index As Integer)
game_ov = 0
'=========
' 人下
'=========
If b(Index) = 0 Then
a(Index).Caption = "O"
b(Index) = 1
Else
MsgBox "此地已下過,不可再下!!"
End If
Call see_stat(flag)
' 玩家勝利了
If flag = 1 Then
MsgBox "你好厲害哦!!大玩家!!"
game_ov = 1
End If
' 無空格可下了
Call count_counter(counter)
Debug.Print counter
If counter = 0 Then
game_ov = 1
GoTo pg_ov
End If
'=============
' 電腦下子
'=============
Call think(locate) '電腦求最佳解.
b(locate) = -1
a(locate).Caption = "X"
Call see_stat(flag)
' 玩家勝利了
If flag = -1 Then
MsgBox "哈哈!我贏了!!", 0, ""
game_ov = 1
End If
' 無空格可下了
Call count_counter(counter)
Debug.Print counter
If counter = 0 Then
game_ov = 1
GoTo pg_ov
End If
pg_ov:
If game_ov = 1 Then
Call again
End If
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
For i = 0 To 8
a(i).Visible = True
a(i).Caption = ""
b(i) = 0
Next i
If Option1.Value = True Then
Call chess_one
End If
End Sub
Private Sub Form_Load()
Randomize Timer '亂數種子
For j = 0 To 8
b(j) = 0
a(j).Caption = ""
a(j).Visible = False
Next j
End Sub
Sub again()
xx = MsgBox("是否還要玩?", vbYesNo, "")
If xx = 6 Then
For i = 0 To 8
b(i) = 0
a(i).Caption = ""
a(i).Visible = False
Next i
Else
End
End If
End Sub
Sub see_stat(flag)
'============================================
' 記錄目前可下的空格數目是否有勝利的狀態
' flag= 0 --> 無勝負
' flag= 1 --> O 勝利
' flag=-1 --> X 勝利
'============================================
Call count_win
'計算是否有人勝利
flag = 0
For i = 1 To 8
If win(i) = 3 Or win(i) = -3 Then
If win(i) = 3 Then
flag = 1
Else
flag = -1
End If
End If
Next i
End Sub
Sub count_counter(x)
'計算尚有格數
x = 0
For i = 0 To 8
If b(i) = 0 Then x = x + 1
Next
End Sub
Sub count_win()
win(1) = b(0) + b(1) + b(2)
win(2) = b(3) + b(4) + b(5)
win(3) = b(6) + b(7) + b(8)
win(4) = b(0) + b(3) + b(6)
win(5) = b(1) + b(4) + b(7)
win(6) = b(2) + b(5) + b(8)
win(7) = b(0) + b(4) + b(8)
win(8) = b(2) + b(4) + b(6)
End Sub
Sub chess_one()
'================
' 電腦下第一子
'================
t = Int(Rnd(1) * 5) * 2
b(t) = -1
a(t).Caption = "X"
End Sub
Sub think(what)
'設定位置
xo(1) = "012"
xo(2) = "345"
xo(3) = "678"
xo(4) = "036"
xo(5) = "147"
xo(6) = "258"
xo(7) = "048"
xo(8) = "246"
'特例處理
Call count_counter(counter)
If counter = 6 Then
If b(4) = -1 And b(0) = 1 And b(8) = 1 Then
what = 3
GoTo pg_ov
End If
If b(4) = -1 And b(2) = 1 And b(6) = 1 Then
what = 3
GoTo pg_ov
End If
If b(4) = -1 And b(1) = 1 And b(3) = 1 Then
what = 0
GoTo pg_ov
End If
If b(4) = -1 And b(1) = 1 And b(5) = 1 Then
what = 2
GoTo pg_ov
End If
If b(4) = -1 And b(3) = 1 And b(7) = 1 Then
what = 6
GoTo pg_ov
End If
If b(4) = -1 And b(5) = 1 And b(7) = 1 Then
what = 8
GoTo pg_ov
End If
End If
'電腦快連成一直線了，所以先連
For i = 1 To 8
If win(i) = -2 Then
sel = xo(i)
num1 = Val(Mid(sel, 1, 1))
num2 = Val(Mid(sel, 2, 1))
num3 = Val(Mid(sel, 3, 1))
If b(num1) = 0 Then what = num1
If b(num2) = 0 Then what = num2
If b(num3) = 0 Then what = num3
GoTo pg_ov
End If
Next i
'對方快連成一直線了，所以快阻止
For i = 1 To 8
If win(i) = 2 Then
sel = xo(i)
num1 = Val(Mid(sel, 1, 1))
num2 = Val(Mid(sel, 2, 1))
num3 = Val(Mid(sel, 3, 1))
If b(num1) = 0 Then what = num1
If b(num2) = 0 Then what = num2
If b(num3) = 0 Then what = num3
GoTo pg_ov
End If
Next i
'求最小值，決定下那裏
Min = 99
For i = 0 To 8
If b(i) = 0 Then
b(i) = -1
'計算分數
score = 0
'計算 win(1)~win(8) 分數
Call count_win
For wi = 1 To 8
score = score + win(wi)
Next wi
If score < Min Then
what = i
Min = score
End If
b(i) = 0
End If
Next i
pg_ov:
End Sub
沒有留言:
張貼留言