OptionExplicit
'五子棋程序人机对战版本
'需要2个Label控件2个CommandButton控件
PrivateDeclareFunctionSetWindowRgnLibuser32(ByValhWndAsLong,ByValhRgnAsLong,ByValbRedrawAsBoolean)AsLong
PrivateDeclareFunctionCreateRoundRectRgnLibgdi32(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong,ByValX3AsLong,ByValY3AsLong)AsLong
'DimPlayStep()AsString'记录棋谱的数组
'DimLabel2CapAsString
PrivateConstBoxLAsSingle=50,BoxTAsSingle=50,BoxWAsSingle=25,BoxNAsInteger=18
DimTable()AsLong'棋盘(0-BoxN,0-BoxN)0-空1-黑子2-白子
DimPsCore()AsLong'定义当前玩家桌面空格的分数
DimCsCore()AsLong'定义当前电脑桌面空格的分数
DimpWin()AsBoolean'定义玩家的获胜组合
DimcWin()AsBoolean'定义电脑的获胜组合
DimpFlag()AsBoolean'定义玩家的获胜组合标志
DimcFlag()AsBoolean'定义电脑的获胜组合标志
DimThePlayFlagAsBoolean'定义游戏有效标志
PrivateSubCommand1_Click()
IfNotThePlayFlagThenCallInitPlayEnvironment:ExitSub
IfMsgBox(本局还没有下完，是否重新开始？(Y/N),vbYesNo)=vbNoThenExitSub
CallInitPlayEnvironment
EndSub
PrivateSubCommand2_Click()
End
EndSub
PrivateSubForm_Load()
DimiAsLong,lwAsLong,lhAsLong
'Label2Cap=000黑方行00列00
Me.Width=10815:Me.Height=8040
'Me.Caption=五子棋-人机对战:Me.Show
lw=Me.Width\Screen.TwipsPerPixelX:lh=Me.Height\Screen.TwipsPerPixelY
SetWindowRgnMe.hWnd,CreateRoundRectRgn(0,0,lw,lh,60,60),True
WithLabel1
.Alignment=vbCenter:.FontSize=12:.FontBold=True
.ForeColor=vbRed:.BackStyle=0:.AutoSize=True:.Move8910,510
EndWith
Label2.AutoSize=True:Label2.WordWrap=True
Label2.BackStyle=0:Label2.Move8040,1050,2280
Command1.Move8025,7035,1020,435:Command1.Caption=再来一局
Command2.Move9300,7035,1020,435:Command2.Caption=不玩了
CallDrawChessBoard:Me.FillStyle=0:CallInitPlayEnvironment
EndSub
PrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)
End
EndSub
PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimiRowAsLong,iColAsLong,iAsLong,kAsLong,tAsString
IfNotThePlayFlagThenExitSub
IfButton=vbLeftButtonThen'左键下棋
iRow=-1:iCol=-1
Fori=0ToBoxN'鼠标必须落在交叉点半径10以内若是则给出行列号
If(Y+10)>(BoxT+i*BoxW)And(Y-10)<=(BoxT+i*BoxW)TheniRow=i
If(X+10)>(BoxL+i*BoxW)And(X-10)<=(BoxL+i*BoxW)TheniCol=i
Next
If(iRow=-1)Or(iCol=-1)ThenBeep:ExitSub
IfTable(iCol,iRow)>0ThenExitSub
Table(iCol,iRow)=2:Label1.Caption=下一步黑方
Me.FillColor=vbWhite:Me.Circle(iCol*BoxW+BoxT,iRow*BoxW+BoxL),8
Fori=0ToUBound(cWin,3)
IfcWin(iCol,iRow,i)=TrueThencFlag(i)=False
Next
CallCheckWin:CallDianNao'检查当前玩家是否获胜调用电脑算法
EndIf
EndSub
PublicSubInitPlayEnvironment()
'*****************************************************************************
'模块名称:InitPlayEnvironment[初始化过程]
'
'描述:1.设置背景音乐。2.设置游戏状态有效。
'3.初始化游戏状态标签。4.直接指定电脑的第一步走法。
'5.初始化基本得分桌面。6.电脑和玩家获胜标志初始化。
'7.初始化所有获胜组合。8.重新设定玩家的获胜标志。
'*****************************************************************************
DimiAsLong,jAsLong,mAsLong,nAsLong
ThePlayFlag=True:Label1.Caption=下一步白方:Label2.Caption=
Me.FillColor=vbBlack:Me.FillStyle=0:Me.AutoRedraw=True
Me.Cls:Me.Circle(9*BoxW+BoxL,9*BoxW+BoxT),8
ReDimTable(0ToBoxN,0ToBoxN)AsLong
ReDimpFlag(NumsWin(BoxN+1)-1)AsBoolean
ReDimcFlag(UBound(pFlag))AsBoolean
ReDimPsCore(BoxN,BoxN)AsLong,CsCore(BoxN,BoxN)AsLong
ReDimpWin(BoxN,BoxN,UBound(pFlag))AsBoolean
ReDimcWin(BoxN,BoxN,UBound(pFlag))AsBoolean
Fori=0ToUBound(pFlag):pFlag(i)=True:cFlag(i)=True:Next
Table(9,9)=1'假定电脑先手并下了(9,9)位将其值设为1
'********初始化获胜组合****************************************
Fori=0ToBoxN:Forj=0ToBoxN-4
Form=0To4
pWin(j+m,i,n)=True:cWin(j+m,i,n)=True
Next
n=n+1
Next:Next
Fori=0ToBoxN:Forj=0ToBoxN-4
Form=0To4
pWin(i,j+m,n)=True:cWin(i,j+m,n)=True
Next
n=n+1
Next:Next
Fori=0ToBoxN-4:Forj=0ToBoxN-4
Form=0To4
pWin(j+m,i+m,n)=True:cWin(j+m,i+m,n)=True
Next
n=n+1
Next:Next
Fori=0ToBoxN-4:Forj=BoxNTo4Step-1
Form=0To4
pWin(j-m,i+m,n)=True:cWin(j-m,i+m,n)=True
Next
n=n+1
Next:Next
'********初始化获胜组合结束*************************************
Fori=0ToUBound(pWin,3)'由于电脑已下了(9,9)位所以需要重新设定玩家的获胜标志
IfpWin(9,9,i)=TrueThenpFlag(i)=False
Next
EndSub
PublicFunctionDrawChessBoard()AsLong
'容器的(BoxL,BoxT)为左上角坐标画一个BoxN*BoxN,每格边长为BoxW象素的棋盘
DimiAsLong,jAsLong,cxAsLong,cyAsLong
Me.ScaleMode=3:Me.FillStyle=1:Me.AutoRedraw=True:Me.Cls
Fori=0ToBoxN'画棋盘
Me.Line(BoxL+i*BoxW,BoxT)-(BoxL+i*BoxW,BoxT+BoxN*BoxW)
Me.Line(BoxL,BoxT+i*BoxW)-(BoxL+BoxN*BoxW,BoxT+i*BoxW)
Me.CurrentX=BoxL+i*BoxW-IIf(i>9,6,2)
Me.CurrentY=BoxT-20:Me.PrintFormat(i)
Me.CurrentX=BoxL-IIf(i>9,23,20)
Me.CurrentY=BoxT+i*BoxW-6:Me.PrintFormat(i)
Next
Fori=3To16Step6:Forj=3To16Step6'画小标志
cx=BoxL+j*BoxW-3:cy=BoxT+i*BoxW-3
Me.Line(cx,cy)-(cx+6,cy+6),,B
Next:Next
Me.AutoRedraw=False:SetMe.Picture=Me.Image
EndFunction
PublicSubCheckWin()
'*****************************************************************************
'模块名称:CheckWin[获胜检查算法]
'
'描述:1.检查是否和棋。2.检查电脑是否获胜。3.检查玩家是否获胜。
'*****************************************************************************
DimiAsLong,jAsLong,kAsLong,mAsLong,nAsLong
DimcAAsLong,pAAsLong,cNAsLong
Fori=0ToUBound(cFlag):cN=IIf(cFlag(i)=False,cN+1,cN):Next
IfcN=UBound(cFlag)-1Then'设定和棋规则
Label1.Caption=双方和棋！:ThePlayFlag=False:ExitSub
EndIf
Fori=0ToUBound(cFlag)'检查电脑是否获胜
IfcFlag(i)=TrueThen
cA=0:Forj=0ToBoxN:Fork=0ToBoxN
IfTable(j,k)=1AndcWin(j,k,i)=TrueThencA=cA+1
Next:Next
IfcA=5ThenLabel1.Caption=电脑获胜！:ThePlayFlag=False:ExitSub
EndIf
Next
Fori=0ToUBound(pFlag)'检查玩家是否获胜
IfpFlag(i)=TrueThen
pA=0:Forj=0ToBoxN:Fork=0ToBoxN
IfTable(j,k)=2AndpWin(j,k,i)=TrueThenpA=pA+1
Next:Next
IfpA=5ThenLabel1.Caption=玩家获胜！:ThePlayFlag=False:ExitSub
EndIf
Next
EndSub
PublicSubDianNao()
'*****************************************************************************
'模块名称:DianNao[电脑算法]
'描述:1.初始化赋值系统。2.赋值加强算法。3.计算电脑和玩家的最佳攻击位。
'4.比较电脑和玩家的最佳攻击位并决定电脑的最佳策略。5.执行检查获胜函数。
'*****************************************************************************
DimiAsLong,jAsLong,kAsLong,mAsLong,nAsLong
DimDcAsLong,cAbAsLong,pAbAsLong
ReDimPsCore(BoxN,BoxN)AsLong,CsCore(BoxN,BoxN)AsLong'初始化赋值数组
'********电脑加强算法********
Fori=0ToUBound(cFlag)
IfcFlag(i)=TrueThen
cAb=0
Forj=0ToBoxN:Fork=0ToBoxN
IfTable(j,k)=1AndcWin(j,k,i)=TrueThencAb=cAb+1
Next:Next
SelectCasecAb
Case3
Form=0ToBoxN:Forn=0ToBoxN
IfTable(m,n)=0AndcWin(m,n,i)=TrueThenCsCore(m,n)=CsCore(m,n)+5
Next:Next
Case4
Form=0ToBoxN:Forn=0ToBoxN
IfTable(m,n)=0AndcWin(m,n,i)=TrueThen
Table(m,n)=1:Label1.Caption=下一步白方
Me.FillColor=vbBlack:Me.Circle(m*BoxW+BoxL,n*BoxW+BoxT),8
ForDc=0ToUBound(pWin,3)
IfpWin(m,n,Dc)=TrueThenpFlag(Dc)=False:CallCheckWin:ExitSub
Next
EndIf
Next:Next
EndSelect
EndIf
Next
Fori=0ToUBound(pFlag)
IfpFlag(i)=TrueThen
pAb=0
Forj=0ToBoxN:Fork=0ToBoxN
IfTable(j,k)=2AndpWin(j,k,i)=TrueThenpAb=pAb+1
Next:Next
SelectCasepAb
Case3
Form=0ToBoxN:Forn=0ToBoxN
IfTable(m,n)=0AndpWin(m,n,i)=TrueThenPsCore(m,n)=PsCore(m,n)+30
Next:Next
Case4
Form=0ToBoxN:Forn=0ToBoxN
IfTable(m,n)=0AndpWin(m,n,i)=TrueThen
Table(m,n)=1:Label1.Caption=下一步白方
Me.FillColor=vbBlack:Me.Circle(m*BoxW+BoxL,n*BoxW+BoxT),8
ForDc=0ToUBound(pWin,3)
IfpWin(m,n,Dc)=TrueThenpFlag(Dc)=False:CallCheckWin:ExitSub
Next
EndIf
Next:Next
EndSelect
EndIf
Next
'********电脑加强算法结束********
'********赋值系统****************
Fori=0ToUBound(cFlag)
IfcFlag(i)=TrueThen
Forj=0ToBoxN:Fork=0ToBoxN
If(Table(j,k)=0)AndcWin(j,k,i)Then
Form=0ToBoxN:Forn=0ToBoxN
If(Table(m,n)=1)AndcWin(m,n,i)ThenCsCore(j,k)=CsCore(j,k)+1
Next:Next
EndIf
Next:Next
EndIf
Next
Fori=0ToUBound(pFlag)
IfpFlag(i)=TrueThen
Forj=0ToBoxN:Fork=0ToBoxN
If(Table(j,k)=0)AndpWin(j,k,i)Then
Form=0ToBoxN:Forn=0ToBoxN
If(Table(m,n)=2)AndpWin(m,n,i)ThenPsCore(j,k)=PsCore(j,k)+1
Next:Next
EndIf
Next:Next
EndIf
Next
'********赋值系统结束************
'********分值比较算法************
DimaAsLong,bAsLong,cAsLong,dAsLong
DimcSAsLong,pSAsLong
Fori=0ToBoxN:Forj=0ToBoxN
IfCsCore(i,j)>cSThencS=CsCore(i,j):a=i:b=j
Next:Next
Fori=0ToBoxN:Forj=0ToBoxN
IfPsCore(i,j)>pSThenpS=PsCore(i,j):c=i:d=j
Next:Next
IfcS>pSThen
Table(a,b)=1:Label1.Caption=下一步白方
Me.FillColor=vbBlack:Me.Circle(a*BoxW+BoxL,b*BoxW+BoxT),8
Fori=0ToUBound(pWin,3)
IfpWin(a,b,i)=TrueThenpFlag(i)=False
Next
Else
Table(c,d)=1:Label1.Caption=下一步白方
Me.FillColor=vbBlack:Me.Circle(c*BoxW+BoxL,d*BoxW+BoxL),8
Fori=0ToUBound(pWin,3)
IfpWin(c,d,i)=TrueThenpFlag(i)=False
Next
EndIf
'********分值比较算法结束********
CallCheckWin
EndSub
PublicFunctionNumsWin(ByValnAsLong)AsLong
'根据输入的棋盘布局n*n计算总共有多少种获胜组合
'假定棋盘为10*10相应的棋盘数组就是Table(9,9)
'水平方向每一列获胜组合是6共10列6*10=60
'垂直方向每一行获胜组合是6共10行8*10=60
'正对角线方向6+(5+4+3+2+1)*2=36
'反对角线方向6+(5+4+3+2+1)*2=36
'总的获胜组合数为60+60+36+36=192
DimiAsLong,tAsLong
Fori=n-5To1Step-1:t=t+i:Next
NumsWin=2*(2*t+n-4)+2*n*(n-4)
EndFunction
