?? frmmian.frm
字號:
VERSION 5.00
Begin VB.Form frmMian
BorderStyle = 1 'Fixed Single
Caption = " 智能五子棋"
ClientHeight = 6435
ClientLeft = 150
ClientTop = 435
ClientWidth = 6465
Icon = "frmMian.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "frmMian.frx":0CCA
ScaleHeight = 6435
ScaleWidth = 6465
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 200
Left = 0
Top = 120
End
Begin VB.Image imgW
Height = 330
Index = 0
Left = 360
Picture = "frmMian.frx":894A4
Top = 240
Visible = 0 'False
Width = 330
End
Begin VB.Image imgB
Height = 330
Index = 0
Left = 120
Picture = "frmMian.frx":89B1E
Top = 240
Visible = 0 'False
Width = 330
End
Begin VB.Menu numGame
Caption = "游 戲(&G)"
Begin VB.Menu numNew
Caption = "開 始(&N)"
Shortcut = {F1}
End
Begin VB.Menu numCou
Caption = "繼 續(&C)"
Shortcut = {F2}
End
Begin VB.Menu numBarGa1
Caption = "-"
End
Begin VB.Menu numExit
Caption = "退 出(&E)"
End
End
Begin VB.Menu numSet
Caption = "設 置(&S)"
Begin VB.Menu numBack
Caption = " 悔 棋(&B)"
Shortcut = {F4}
End
Begin VB.Menu numBar2
Caption = "-"
End
Begin VB.Menu numSetP
Caption = "人落子(&P)"
Enabled = 0 'False
Index = 0
Shortcut = {F5}
Visible = 0 'False
End
Begin VB.Menu numSetP
Caption = "電腦走(&C)"
Index = 1
Shortcut = {F6}
End
Begin VB.Menu numBar3
Caption = "-"
End
Begin VB.Menu numFlash
Caption = "棋子閃爍(&F)"
Checked = -1 'True
End
End
Begin VB.Menu numMode
Caption = "電腦狀態(&M)"
Enabled = 0 'False
Visible = 0 'False
Begin VB.Menu numM1
Caption = "指點新手(&N)"
Index = 0
End
Begin VB.Menu numM1
Caption = "以棋會友(&F)"
Index = 1
End
Begin VB.Menu numM1
Caption = "正式比賽(&R)"
Index = 2
End
End
Begin VB.Menu numMsg
Caption = ""
End
End
Attribute VB_Name = "frmMian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************
' 說 明
'---------------------------------------
' 菜單操作
' 1 點擊“游戲”->“開始”菜單之后，才可已下子
' 2 點擊“游戲”->“繼續”菜單，可以繼續上一次沒有結束的游戲
' 3 為了研究需要，“設置”->“悔棋”菜單每次只悔棋一步
' 4 游戲中“設置”->“電腦走”菜單可以命令電腦走棋
' 5 “設置”->“電腦走”菜單沒有使用
' 6 “電腦狀態”菜單沒有使用
'--------------------------------------
' 算法說明
' 算法設計時有3部分
' 1 基本知識庫(Base) 用來表示五子棋基本概念,解決基本攻防問題
' 2 棋局記憶庫(QiJu) 用來記憶棋局,解決電腦開局和學習進攻的問題
' 3 陷阱知識庫(XianJ) 解決電腦對陷阱識別和學習設置問題
' 目前程序只實現了第一部分。
'程序使用ACCESS數據庫，數據庫名“BW.mdb”，
'數據庫使用MS-office中的ACCESS編輯
'--------------------------------------
'基本知識庫數據庫(Base)是用：工程"check.vbp"建立的
'"Txet"字段 表示五子棋的基本形狀“*”表示己方棋子，“O”表示空，對手棋子視為邊界
'"Index"字段 表示基本形狀索引號,算法工程"check.vbp"中的“Check1_Click”事件
'"Mode"字段 表示各形狀狀態判斷，"Mode"值是人為指定的
'"XY"字段 表示各形狀必須落子或可以落子的位置,人為指定
'--------------------------------------
'知識庫的使用
'1 電腦通過對“形狀”識別計算"Index"，匹配數據庫中的"Index"，從而取得各點的"Mode"
'2 通過對各點的"Mode"的比較，取出"Mode"最小的一點
'3 判斷和處理對手是否設置陷阱
'4 根據"Mode"最小點數據庫"XY"字段的記錄下子
'5 游戲結束時自動分析陷阱,并記入陷阱庫
'--------------------------------------
'需要實現的部分
'1 在知識庫的使用的3和4之間實現'
' (1) 選擇和設置陷阱
' (2) 選擇和設置多重陷阱
'--------------------------------------
'使用“知識庫”后算法被極大簡化了。
'*******************************
Dim AppPath As String, mUserCtrl
Dim dbsS As Database, dbsR As Recordset
Dim mIDs As Long, mIndex As Integer
'*******************************
Dim mPCountB As Integer, mPCountW As Integer '黑子、白子數目
Dim mWidthStr As Long, mWidthEnd As Long, mWidth As Integer '棋盤起始位置、結束位置、棋格寬度
Dim mModel As Integer '系統狀態：0 停止，1 人落子，2 系統落子
Dim mBW(15, 15) As Byte '棋盤數組
Dim mBP(225, 3) As Byte '棋局數組
Dim mBT(9) As Byte, mBShar As Integer '
Dim mBase(163, 6) As Byte, mBaseDa(6) As Byte
Dim mTest As Byte, mWin As Byte '狀態判斷
Dim mModeC As Byte, mModeIndex As Integer '電腦狀態
Dim mSpxy(999, 1) As Byte, mSpxyCu As Integer '落子坐標，坐標記數
Dim mSpxyLu As Integer, meUser As Integer, mErrTx As String
Dim mGetx As Byte, mGety As Byte '取舍后坐標
'*******************************
'基本對策
Private Sub meComP1()
Dim Tsx As Byte, Tsy As Byte
Dim Ts As Integer, Tt As Integer
Dim I As Integer, L As Integer
Dim Tsx1 As Integer, Tsy1 As Integer
Dim Tsx2 As Integer, Tsy2 As Integer
Dim Ts1 As Integer, Ts2 As Integer
Dim Tn1 As Integer, Tn2 As Integer
Dim Tu1 As Integer, Tu2 As Integer
Me.Enabled = False
'********************對手搜索
If mSpxyCu > 0 Then
Tt = 1
meComPut
Ts1 = mTest
Tu1 = meUser
Tsx1 = mGetx
Tsy1 = mGety
Tn1 = mSpxyLu
Else:
Tt = 0
Ts1 = 99
Tn1 = 0
End If
For L = 2 To mIndex Step 2
Ts = mIndex - L
If Ts > 0 Then
Ts = meTest1(mBP(Ts, 0), mBP(Ts, 1), 0)
If Ts <= Ts1 And mSpxyCu > 0 Then
If Ts = Ts1 Then
If mSpxyLu > Tn1 Then
Tn1 = mSpxyLu
Else:
Ts = 0
End If
Else:
Tn1 = mSpxyLu
Tt1 = Ts
End If
If Ts > 0 Then
meComPut
Ts1 = Ts
Tu1 = meUser
Tsx1 = mGetx
Tsy1 = mGety
Tt = 1
End If
If Ts1 < 6 Then Exit For
End If
End If
Next
'*******************己方搜索
Ts2 = 99
Tn2 = 0
For L = 1 To mIndex Step 2
Ts = mIndex - L
If Ts > 0 Then
Ts = meTest1(mBP(Ts, 0), mBP(Ts, 1), 0)
If Ts <= Ts2 And mSpxyCu > 0 Then
If Ts = Ts2 Then
If mSpxyLu > Tn2 Then
Tn2 = mSpxyLu
Else:
Ts = 0
End If
Else:
Tn2 = mSpxyLu
Tt2 = Ts
End If
If Ts > 0 Then
meComPut
Tu2 = meUser
Ts2 = Ts
Tsx2 = mGetx
Tsy2 = mGety
End If
If Ts2 < 6 Then Exit For
End If
End If
Next
'********************比較
If Ts2 < 99 Then
If Ts2 < 5 Then
Tt = 2
Else:
If Ts1 < 5 Then
Tt = 1
Else:
If Ts1 = 5 Then
If Ts2 = 5 Then
Tt = 2
Else:
Tt = 1
End If
Else:
If Ts2 <= Ts1 Then Tt = 2
End If
End If
End If
End If
If Tt = 2 And Ts2 <> 99 Then
Tsx = Tsx2
Tsy = Tsy2
mTest = Ts2
meUser = Tu2
Else:
If Tt = 1 Then
Tsx = Tsx1
Tsy = Tsy1
mTest = Ts1
meUser = Tu1
End If
End If
If Tt > 0 Then
Tt = mTest
If Ts1 > 4 And Ts2 > 4 And mIndex > 4 Then
'分析下一步棋
Tt = mIndex - 1
Ts = meThink1(mBW(mBP(Tt, 0), mBP(Tt, 1)))
If Ts > 0 Then
If Tt = 5 Then
If mTest < 5 Then Ts = 0
End If
If Ts > 0 Then
Tsx = mGetx
Tsy = mGety
End If
End If
End If
meShow Tsx, Tsy
mTest = meTest1(Tsx, Tsy, 0)
meSave Tsx, Tsy
Else:
MsgBox " 游戲結束！", 64
End If
Me.Enabled = True
End Sub
'中心原則取舍坐標
Private Sub meComPut()
Dim I As Integer, Ts As Byte, Tt As Byte
Ts = 99
meUser = 0
mGetx = 99
mGety = 99
For I = 1 To mSpxyCu
Tt = Abs(mSpxy(I, 0) - 7) + Abs(mSpxy(I, 1) - 7)
If Ts > Tt Then
Tx = "A" & I & "B"
If InStr(1, mErrTx, Tx) = 0 Then '陷阱修正
If mSpxy(I, 0) <> mGetx And mSpxy(I, 1) <> mGety Then
mGetx = mSpxy(I, 0)
mGety = mSpxy(I, 1)
meUser = I
Ts = Tt
End If
End If
End If
Next
If mGetx = 99 Then
mGetx = mSpxy(1, 0)
mGety = mSpxy(1, 1)
meUser = 1
End If
End Sub
'分析下一步棋
Private Function meThink1(ByVal Index As Integer) As Integer
Dim I As Integer, L As Integer
Dim Tsx1 As Integer, Tsy1 As Integer
Dim Tsx2 As Integer, Tsy2 As Integer
Dim Ts1 As Integer, Ts2 As Integer
Dim Tu1 As Integer, Tu2 As Integer
Dim Tt As Integer, Tn As Integer
Tn = 0
Tt = 99
For I = 0 To 14
For L = 0 To 14
If mBW(I, L) = 0 Then
mBW(I, L) = Index
Ts = meTest1(I, L, 1)
mBW(I, L) = 0
If mErrTx = "" Or Ts = 2 Then
If Ts <= Tt Then
If Ts = Tt Then
If mSpxyLu > Tn Then
Tn = mSpxyLu
Else:
Ts = 0
End If
Else:
Tn = mSpxyLu
Tt = Ts
End If
If Ts > 0 Then
Tu1 = meUser
Tsx1 = I
Tsy1 = L
Ts1 = Ts
End If
End If
Else:
Tu1 = meUser
Tsx1 = I
Tsy1 = L
L = 15
I = 15
End If
End If
Next
Next
If Ts1 > 4 Or Ts1 = 0 Then
If Index = 1 Then
Index = 2
Else:
Index = 1
End If
Tn = 0
Tt = 99
For I = 0 To 14
For L = 0 To 14
If mBW(I, L) = 0 Then
mBW(I, L) = Index
Ts = meTest1(I, L, 1)
mBW(I, L) = 0
If mErrTx = "" Or Ts = 2 Then
If Ts <= Tt Then
If Ts = Tt Then
If mSpxyLu > Tn Then
Tn = mSpxyLu
Else:
Ts = 0
End If
Else:
Tn = mSpxyLu
Tt = Ts
End If
If Ts > 0 Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -