就是單純採用VB5設計的，原本以為有HiPoint設計，結果發現有原始函數庫，可是主程式並沒有呼叫它。
HiPoint 在筆記本裡是這樣描述的
IF 存在HiPoint THEN
score = 計算每一個HiPoint的值，選出最高分的
ELSE
掃描所有存在的空點，如果加入之後會造成4子連線，或者兩個(以上)的三子連線就加入 HiPoint
ENDIF
HiPoint Souce 5Ch.bas
Attribute VB_Name = "ModProcess"
Option Explicit
Dim HiPointCount As Integer
Dim HiPoint(0 To 400) As Integer
Sub ClsHiPoint()
HiPointCount = 0
End Sub
Function IsAHiPoint(ByVal x As Integer, ByVal y As Integer) As Boolean
Dim St As Integer
Dim Ed As Integer
Dim Mi As Integer
St = 1
Ed = HiPointCount
Do
If Ed < St Then
IsAHiPoint = False
Exit Function
Else
Mi = (St + Ed) / 2
If HiPoint(Mi) = x * 19 + y Then
IsAHiPoint = True
Exit Function
ElseIf HiPoint(Mi) < x * 19 + y Then
St = Mi + 1
Else
Ed = Mi - 1
End If
End If
Loop
End Function
Function FindHiPoint(ByVal x As Integer, ByVal y As Integer) As Integer
Dim St As Integer
Dim Ed As Integer
Dim Mi As Integer
St = 1
Ed = HiPointCount
Do
If Ed < St Then
FindHiPoint = 0
Exit Function
Else
Mi = (St + Ed) / 2
If HiPoint(Mi) = x * 19 + y Then
FindHiPoint = Mi
Exit Function
ElseIf HiPoint(Mi) < x * 19 + y Then
St = Mi + 1
Else
Ed = Mi - 1
End If
End If
Loop
End Function
Sub InsHiPoint(ByVal x As Integer, ByVal y As Integer)
Dim n As Integer
Dim i As Integer
If IsAHiPoint(x, y) Then Exit Sub
' MsgBox "Ins:>>>" & x & "." & y
n = x * 19 + y
HiPoint(0) = n
HiPointCount = HiPointCount + 1
HiPoint(HiPointCount) = n
i = HiPointCount - 1
While n < HiPoint(i)
HiPoint(i + 1) = HiPoint(i)
i = i - 1
Wend
'MsgBox i & ":" & x & "," & n
HiPoint(i + 1) = n
End Sub
Sub DelnHiPoint(n As Integer) '刪除第n個
Dim i As Integer
If n = HiPointCount Then
HiPointCount = HiPointCount - 1
Else
i = n + 1
While i <= HiPointCount
HiPoint(i - 1) = HiPoint(i)
i = i + 1
Wend
HiPointCount = HiPointCount - 1
End If
End Sub
Sub DelHipoint(x As Integer, y As Integer)
Dim i As Integer
i = FindHiPoint(x, y)
If i = 0 Then Exit Sub
DelnHiPoint (i)
End Sub
Function GetHiPointX(n As Integer) As Integer
GetHiPointX = HiPoint(n) \ 19
End Function
Function GetHiPointY(n As Integer) As Integer
GetHiPointY = HiPoint(n) Mod 19
End Function
Function GetHiPointCount() As Integer
GetHiPointCount = HiPointCount
End Function
接下來就來看遊戲是怎樣設計的，首先看畫面
Private Sub imgSet_Click()
If Not IsGameOver Then
If MsgBox("遊戲尚在進行中 ,確定要結束嗎 ?", vbOKCancel, "五子棋") = vbOK Then
ClearBoard
IsGameOver = True
Else
Exit Sub
End If
End If
ClearBoard
PlayerOne = Not PlayerOne
If PlayerOne Then
imgBlackStart.Visible = False
imgWhiteStart.Visible = False
imgComStart.Visible = True
imgUsrStart.Visible = True
Else
imgBlackStart.Visible = True
imgWhiteStart.Visible = True
imgComStart.Visible = False
imgUsrStart.Visible = False
End If
End Sub
基本上就是切換變數PlayOne，當然還有圖片。至於ClearBoard就是把Board陣列歸零，當然畫面也要。
Private Sub ClearBoard()
Dim i As Integer, j As Integer
For i = 0 To 18
For j = 0 To 18
shpChess(i + j * 19).Visible = False
Board(i, j) = 0
Next
Next
End Sub
初始化
Private Sub Form_Load()
'Init Calute Data
T_Died(0) = 1 '死1
T_Died(1) = 3 '死2
T_Died(2) = 5 '死3
T_Died(3) = 90 '死4
T_Life(0) = 4 '活1
T_Life(1) = 10 '活2
T_Life(2) = 80 '活3
T_Life(3) = 1000 '活4
GapX = 300
GapY = 300
StartX = 30
StartY = 30
IsGameOver = True
PlayerOne = True
End Sub
遊戲進行的主要部分，是根據滑鼠按下的位置，可同時控制雙人遊戲或單人遊戲
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsGameOver Then
Exit Sub
End If
ClickX = Int(x / GapX)
ClickY = Int(y / GapY)
If ClickX > 18 Then Exit Sub '超出棋盤的範圍
If ClickY > 18 Then Exit Sub
If PlayerOne Then
If Board(ClickX, ClickY) = 0 Then
UsrPut ClickX, ClickY
If CheckWin(ClickX, ClickY) Then
lblmsg.Caption = StrUsrWin
IsGameOver = True
Exit Sub
End If
ComputerGo3 ClickX, ClickY
If CheckWin(ClickX, ClickY) Then
lblmsg.Caption = StrComWin
IsGameOver = True
Exit Sub
End If
Else
Beep
End If
Else
If Board(ClickX, ClickY) = 0 Then
PlayerPut ClickX, ClickY, player
If CheckWin(ClickX, ClickY) Then
If player = playBlack Then
lblmsg.Caption = "黑子勝利"
Else
lblmsg.Caption = "白子勝利"
End If
IsGameOver = True
Else
player = 0 - player
If player = playBlack Then
lblmsg.Caption = "黑子下棋"
Else
lblmsg.Caption = "白子下棋"
End If
End If
Else
Beep
End If
End If
End Sub
其中CheckWin(X,Y) 用來檢查是否勝利
Function CheckWin(x As Integer, y As Integer, Optional tag As Integer) As Boolean
Dim Win As Boolean
Dim sty As Integer, edy As Integer
Dim stx As Integer, edx As Integer
Dim diff As Integer
Dim connect As Integer
Dim i As Integer
If tag = Empty Then tag = Board(x, y)
'Check Setup
sty = MaxInt(y - 4, 0)
edy = MinInt(y + 4, 18)
stx = MaxInt(x - 4, 0)
edx = MinInt(x + 4, 18)
'Check Vertical
connect = 0
For i = y - 1 To sty Step -1
If Board(x, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
For i = y + 1 To edy Step 1
If Board(x, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
If connect >= 4 Then GoTo ExitWin
'Check Horizal-
connect = 0
For i = x - 1 To stx Step -1
If Board(i, y) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
For i = x + 1 To edx Step 1
If Board(i, y) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
If connect >= 4 Then GoTo ExitWin
'Check \
diff = y - x
If x < y Then sty = MaxInt(diff, sty)
If x > y Then edy = MinInt(18 + diff, edy)
connect = 0
For i = y - 1 To sty Step -1
If Board(i - diff, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
For i = y + 1 To edy Step 1
If Board(i - diff, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
If connect >= 4 Then GoTo ExitWin
'Check /
diff = x + y
sty = MaxInt(y - 4, 0)
If diff > 18 Then
sty = MaxInt(diff - 18, sty)
End If
edy = MinInt(y + 4, 18)
If diff < 18 Then
edy = MinInt(diff, y + 4)
End If
connect = 0
For i = y - 1 To sty Step -1
If Board(diff - i, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
For i = y + 1 To edy Step 1
If Board(diff - i, i) = tag Then
connect = connect + 1
Else
Exit For
End If
Next
If connect >= 4 Then GoTo ExitWin
CheckWin = False
Exit Function
ExitWin:
CheckWin = True
Exit Function
End Function
雙人的部分較單純 PlayerPut 就會把旗子下下去：
Sub PlayerPut(x As Integer, y As Integer, player As Integer)
If player < 0 Then '白子
shpChess(x + 19 * y).FillColor = QBColor(15)
shpChess(x + 19 * y).Visible = True
Board(x, y) = bUsr
Else
shpChess(x + 19 * y).FillColor = QBColor(0)
shpChess(x + 19 * y).Visible = True
Board(x, y) = bCom
End If
End Sub
電腦和人互下的方式是：
人一落子，檢查是否勝利，若否電腦以 ComputerGo3 ClickX, ClickY 進行落子，同樣電腦未達勝利則繼續等待。
ComputerGo3 才是 AI 的核心
Sub ComputerGo3(cx As Integer, cy As Integer)
Dim i As Integer
Dim j As Integer
Dim maxScore As Integer
Dim temp As Integer
Dim Px As Integer
Dim Py As Integer
maxScore = -1
AddScore ClickX, ClickY
For i = 0 To 18
For j = 0 To 18
If Score(i, j, 0) = 1 Then
temp = CalScore3(i, j)
If temp > maxScore Then
maxScore = temp
cx = i
cy = j
End If
End If
Next j, i
WillPut:
ComPut cx, cy
AddScore cx, cy
End Sub
其中 AddScore是增加搜尋的範圍
'*******************************************
'程序：AddScore ( x, y )
'目的：增加搜尋的範圍
'參數：(x,y) 下棋的座標位置
'*******************************************
Sub AddScore(ByVal x As Integer, ByVal y As Integer)
Dim stx As Integer
Dim sty As Integer
Dim edx As Integer
Dim edy As Integer
Dim i As Integer, j As Integer
Dim SearchRange As Integer
SearchRange = 1 '改變這個值可以增減搜尋的範圍
stx = x - SearchRange
sty = y - SearchRange
edx = x + SearchRange
edy = y + SearchRange
If stx < 0 Then stx = 0
If sty < 0 Then sty = 0
If edx > 18 Then edx = 18 '2001.02.06 校正
If edy > 18 Then edy = 18
For i = stx To edx
For j = sty To edy
If Board(i, j) <> 0 Then
Score(i, j, 0) = 0
Else
Score(i, j, 0) = 1
End If
Next
Next
End Sub
若Score(i,j,0)=1 表示(i,j)這個位置要進行CalScore3(i, j)評分
'**********************************************
'函數：CalScore3 (x,y)
'目的：計算下棋點的分數
'**********************************************
Function CalScore3(ByVal x As Integer, ByVal y As Integer)
Dim s As Integer
Dim s2 As Integer
Dim s3 As Integer
If Board(x, y) <> 0 Then
CalScore3 = 0
Exit Function
End If
s = 0
s2 = 0
s3 = 0
If CheckWin(x, y, bCom) Then
s = 20000
ElseIf CheckWin(x, y, bUsr) Then
s = 19000
Else
If CheckLife4(x, y, bCom) Then
s = 18000
Else
s2 = Vstatus + Hstatus + Astatus + Sstatus
End If
If CheckLife4(x, y, bUsr) Then
' MsgBox x & y
s = 17000
Else
s3 = Vstatus + Hstatus + Astatus + Sstatus
End If
End If
If s = 0 Then
If s2 > 150 Then
s = 1000 + s2
ElseIf s3 > 150 Then
s = 1000 + s3
Else
s = s2 + s3
End If
End If
CalScore3 = s
End Function
Vstatus Hstatus Astatus Sstatus 是在CheckLife4中計算出的數值
檢查是否為活4 ，其實包含了其他狀態
Function CheckLife4(x As Integer, y As Integer, Optional tag As Integer) As Boolean
Dim Win As Boolean
Dim sty As Integer, edy As Integer
Dim stx As Integer, edx As Integer
Dim diff As Integer
Dim connect As Integer
Dim i As Integer
Dim Break1 As Boolean
Dim Break2 As Boolean
Dim Ext As Boolean
If tag = Empty Then tag = Board(x, y)
'Check Setup
sty = MaxInt(y - 4, 0)
edy = MinInt(y + 4, 18)
stx = MaxInt(x - 4, 0)
edx = MinInt(x + 4, 18)
'Check Vertical |
connect = 0
'Break1 = True
i = y - 1
Do
If i < 0 Then
Break1 = True
Exit Do
End If
If Board(x, i) = tag Then
connect = connect + 1
Else
If Board(x, i) = 0 Then
Break1 = False
Else
Break1 = True
End If
Exit Do
End If
i = i - 1
Loop
i = y + 1
Do
If i > 18 Then
Break2 = True
Exit Do
End If
If Board(x, i) = tag Then
connect = connect + 1
Else
If Board(x, i) = 0 Then
Break2 = False
Else
Break2 = True
End If
Exit Do
End If
i = i + 1
Loop
If connect >= 3 And Break1 = False And Break2 = False Then GoTo ExitWin
If Break1 And Break2 Then
Vstatus = 0
ElseIf Break1 Or Break2 Then
Vstatus = T_Died(connect)
Else
Vstatus = T_Life(connect)
End If
'Check Horizal-
connect = 0
i = x - 1
Do
If i < 0 Then
Break1 = True
Exit Do
End If
If Board(i, y) = tag Then
connect = connect + 1
Else
If Board(i, y) = 0 Then
Break1 = False
Else
Break1 = True
End If
Exit Do
End If
i = i - 1
Loop
i = x + 1
Do
If i > 18 Then
Break2 = True
Exit Do
End If
If Board(i, y) = tag Then
connect = connect + 1
Else
If Board(i, y) = 0 Then
Break2 = False
Else
Break2 = True
End If
Exit Do
End If
i = i + 1
Loop
If connect >= 3 And Break1 = False And Break2 = False Then GoTo ExitWin
If Break1 And Break2 Then
Hstatus = 0
ElseIf Break1 Or Break2 Then
Hstatus = T_Died(connect)
Else
Hstatus = T_Life(connect)
End If
'Check \
diff = y - x
connect = 0
i = y - 1
Do
If i < 0 Or i - diff < 0 Then
Break1 = True
Exit Do
End If
If Board(i - diff, i) = tag Then
connect = connect + 1
Else
If Board(i - diff, i) = 0 Then
Break1 = False
Else
Break1 = True
End If
Exit Do
End If
i = i - 1
Loop
i = y + 1
Do
If i > 18 Or i - diff > 18 Then
Break2 = True
Exit Do
End If
If Board(i - diff, i) = tag Then
connect = connect + 1
Else
If Board(i - diff, i) = 0 Then
Break2 = False
Else
Break2 = True
End If
Exit Do
End If
i = i + 1
Loop
If connect >= 3 And Break1 = False And Break2 = False Then GoTo ExitWin
If Break1 And Break2 Then
Astatus = 0
ElseIf Break1 Or Break2 Then
Astatus = T_Died(connect)
Else
Astatus = T_Life(connect)
End If
'Check /
diff = x + y
connect = 0
Ext = False
i = y - 1
Do
If diff - i < 0 Or i < 0 Then
Break1 = True
Exit Do
End If
If Board(diff - i, i) = tag Then
connect = connect + 1
Else
If Board(diff - i, i) = 0 Then
Break1 = False
If (i - 2) >= 0 And (diff - (i - 2)) >= 0 And (diff - (i - 2)) >= 18 And (i - 2) >= 18 Then
If Board(diff - (i - 1), i - 1) = tag And Board(diff - (i - 2), i - 2) = 0 Then
Ext = True
End If
End If
Else
Break1 = True
End If
Exit Do
End If
i = i - 1
Loop
i = y + 1
Do
If diff - i > 18 Or i > 18 Or (diff - i) < 0 Then
Break2 = True
Exit Do
End If
If Board(diff - i, i) = tag Then
connect = connect + 1
Else
If Board(diff - i, i) = 0 Then
Break2 = False
If (i + 2) <= 18 And (diff - (i + 2)) <= 18 And (diff - (i + 2)) >= 0 Then
If Board(diff - (i + 1), i + 1) = tag And Board(diff - (i + 2), i + 2) = 0 Then
Ext = True
End If
End If
Else
Break2 = True
End If
Exit Do
End If
i = i + 1
Loop
' MsgBox connect
If connect >= 3 And Break1 = False And Break2 = False Then GoTo ExitWin
If Break1 And Break2 Then
Sstatus = 0
ElseIf Break1 Or Break2 Then
Sstatus = T_Died(connect)
Else '兩者為False
If connect = 1 And Ext Then '已經有2連棋了
Sstatus = T_Life(2) - 5
Else
Sstatus = T_Life(connect)
End If
End If
ExitFail:
CheckLife4 = False
Exit Function
ExitWin:
CheckLife4 = True
Exit Function
End Function
這個程式其實只是使用貪心法，先檢查是否勝利(自己先然後對手)，不然就檢查哪一個位置會造成活四(自己先然後對手)，其他情況就看造成連線的數量多的位置就先選。整個程式核心是CheckLife4 但是分成四種很類似的程式碼，應該有機會可以合併。試著修改如下
原來的程式碼是有錯誤的 一個方向是break1, 另一個方向是break2才對
原來的程式碼是有錯誤的 一個方向是break1, 另一個方向是break2才對
'Check \
connect=0
connect=0
CHECK(x, y, +1, +1, connect,Break1)
CHECK(x, y, -1, -1, connect,Break2)
If connect >= 3 And Break1 = False And Break2 = False Then GoTo ExitWin
If Break1 And Break2 Then
Astatus = 0
ElseIf Break1 Or Break2 Then
Astatus = T_Died(connect)
Else
Astatus = T_Life(connect)
End If
CHECH(x, y, dx, dy,connect,Break):
i=x+dx
j=y+dy
DO
IF out_range(i,j) THEN
Break = True
Exit Do
ENDIF
IF Board(i, j) = tag THEN
connect = connect + 1
ELSE
IF Board(i , j) = 0 Then
Break = False
Else
Break = True
End If
Exit Do
ENDIF
i=x+dx
j=y+dy
LOOP
out_range 則檢查超出範圍，即 i>18 or j>18 or i<0 or j<0
在筆記裡為了使用單一變數運作，使用了diff的方式反而不容易理解程式碼的意義。
沒有留言:
張貼留言