📄 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 + -