'在窗体上加入以下控件
'image1(0),image1(0)-黑白棋图片
'image2,image3(0)
'form中的picture图片为棋盘。因无法上传请自行领会。
OptionExplicit
DimI,J,K,Counter,Firstmoved,Rt,Gen,r,flagAsInteger
DimGrid(225),H(224),V(224),RL(224),LR(224),Tb(2),Order(225)AsInteger
PrivateSubForm_Initialize()
lblHelp.Top=0
lblHelp.Left=0
Image1(0).Top=-1000
Image1(1).Top=-1000
lblHelp.Left=-lblHelp.Width
lblHelp=vbCrLf+vbCrLf+游戏帮助+vbCrLf_
+vbCrLf+vbCrLf+●游戏规则:黑方先行,轮流弈子,任一方向先连成五子者胜._
+vbCrLf+vbCrLf+vbCrLf+●操作提示:①可选择[先后]、[难度]和[对手]菜单设置游戏,_
+vbCrLf+vbCrLf+只有按[游戏]->[开始]后才可在棋盘上落子._
+vbCrLf+vbCrLf+②按[游戏]->[清盘]可重玩并设置游戏._
+vbCrLf+vbCrLf+③落子后按[动作]菜单下的选择可任意悔棋和恢复._
+vbCrLf+vbCrLf+④各功能菜单都提供了快捷键(Alt+相应字母)._
+vbCrLf+vbCrLf+vbCrLf+●有什么问题请与本人联系.电子邮件:xwwxyz@sina.com._
+vbCrLf+vbCrLf+vbCrLf+●本页面单击后隐藏.
EndSub
PrivateSubForm_Resize()
Me.Height=5800
Me.Width=5100
EndSub
PrivateSublblHelp_Click()
lblHelp.Visible=False
EndSub
PrivateSubmnuAfter_Click()
Firstmoved=0
mnuAfter.Checked=True
mnuFirst.Checked=False
EndSub
PrivateSubForm_Load()
DimIAsInteger
ForI=1To224
LoadImage3(I)'加载棋子控件
Image3(I).Top=(I\15)*22+5
Image3(I).Left=(IMod15)*22+5
Image3(I).Visible=True
Next
Ini
EndSub
'游戏初始化
SubIni()
ForI=0To224
Image3(I)=Image2
Image3(I).Enabled=False
Grid(I)=0
V(I)=0
H(I)=0
LR(I)=0
RL(I)=0
NextI
mnuBack.Enabled=False
Counter=0
Gen=0
IfmnuAfter.Checked=TrueThen
Firstmoved=0
Else
Firstmoved=1
EndIf
mnuStart.Enabled=True
EndSub
'一方是否可获胜
FunctionLineWin(PieceAsInteger)AsInteger
DimmunAsInteger
LineWin=225
'五子一线
mun=Piece*5
ForI=0To224
IfH(I)=munOrV(I)=munOrRL(I)=munOrLR(I)=munThen
LineWin=225+Piece
ExitFunction
EndIf
NextI
'四子一线
mun=Piece*4
ForI=0To224
IfH(I)=munThen
ForK=0To4
IfGrid(I+K)=0ThenLineWin=I+K:ExitFunction
NextK
EndIf
IfV(I)=munThen
ForK=0To4
IfGrid(I+K*15)=0ThenLineWin=I+K*15:ExitFunction
NextK
EndIf
IfRL(I)=munThen
ForK=0To4
IfGrid(I+K*14)=0ThenLineWin=I+K*14:ExitFunction
NextK
EndIf
IfLR(I)=munThen
ForK=0To4
IfGrid(I+K*16)=0ThenLineWin=I+K*16:ExitFunction
NextK
EndIf
NextI
EndFunction
'计算机走棋
SubComputerMove()
DimToMoveAsInteger
IfCounter=0Then
Randomize
I=Int(Rnd*7+4)
J=Int(Rnd*7+4)
IfGrid(I*15+J)=0ThenToMove=I*15+J
Else
IfmnuLower.Checked=TrueThenToMove=DefendElseToMove=Attempt
EndIf
Counter=Counter+1
IfFirstmoved=0ThenImage3(ToMove)=Image1(0)ElseImage3(ToMove)=Image1(1)
Grid(ToMove)=2
Order(Counter)=ToMove
LineGenToMove,6
IfLineWin(6)=231Then
MsgBox您输了!
Ini
ExitSub
EndIf
IfCounter=225Then
MsgBox和棋
Ini
ExitSub
EndIf
EndSub
'低级模式
FunctionDefend()AsInteger
Rt=LineWin(6)
IfRt<225ThenDefend=Rt:ExitFunction
Rt=LineWin(1)
IfRt<225ThenDefend=Rt:ExitFunction
'查找落子位置
Rt=FindBlank
IfRt<225ThenDefend=Rt:ExitFunction
EndFunction
'悔棋
PrivateSubmnuBack_Click()
mnuComeback.Enabled=True
If(Counter+Firstmoved)Mod2=0ThenRt=-1ElseRt=-6
Grid(Order(Counter))=0
Image3(Order(Counter))=Image2
LineGenOrder(Counter),Rt
Counter=Counter-1
IfmnuComputer.Checked=TrueThen
Grid(Order(Counter))=0
Image3(Order(Counter))=Image2
LineGenOrder(Counter),-1
Counter=Counter-1
Else
flag=1-flag
EndIf
r=r+1
IfCounter=1AndFirstmoved=0AndmnuComputer.Checked=TrueThenmnuBack.Enabled=False
IfCounter=0ThenmnuBack.Enabled=False
EndSub
'恢复棋子
PrivateSubmnuComeback_Click()
mnuBack.Enabled=True
Counter=Counter+1
If(Counter+Firstmoved)Mod2=0Then
Grid(Order(Counter))=1
Image3(Order(Counter))=Image1(1-Firstmoved)
LineGenOrder(Counter),1
Else
Grid(Order(Counter))=2
Image3(Order(Counter))=Image1(Firstmoved)
LineGenOrder(Counter),6
EndIf
IfmnuComputer.Checked=TrueThen
Counter=Counter+1
Grid(Order(Counter))=2
Image3(Order(Counter))=Image1(Firstmoved)
LineGenOrder(Counter),6
Else
flag=1-flag
EndIf
r=r-1
Ifr=0ThenmnuComeback.Enabled=False
EndSub
PrivateSubmnuComputer_Click()'对手
mnuComputer.Checked=True'电脑
mnuHuman.Checked=False'棋手
EndSub
PrivateSubmnuClear_Click()'清盘
Ini
mnuFirst.Enabled=True
mnuAfter.Enabled=True
mnuLower.Enabled=True
mnuHigher.Enabled=True
mnuComputer.Enabled=True
mnuHuman.Enabled=True
EndSub
PrivateSubmnuHuman_Click()
mnuHuman.Checked=True
mnuComputer.Checked=False
EndSub
PrivateSubmnuStart_Click()'开始
lblHelp.Visible=False
ForI=0To224
Image3(I).Enabled=True
NextI
mnuFirst.Enabled=False
mnuAfter.Enabled=False
mnuLower.Enabled=False
mnuHigher.Enabled=False
mnuComputer.Enabled=False
mnuHuman.Enabled=False
IfFirstmoved=0AndmnuComputer.Checked=TrueThenComputerMove
IfFirstmoved=0AndmnuHuman.Checked=TrueThenflag=1Elseflag=0
mnuStart.Enabled=False
EndSub
'玩家走棋
PrivateSubimage3_Click(IndexAsInteger)
IfGrid(Index)0ThenExitSub
Counter=Counter+1
IfFirstmoved=0Then
Image3(Index)=Image1(1-flag)
Else
Image3(Index)=Image1(flag)
EndIf
Grid(Index)=1+flag
Order(Counter)=Index
mnuBack.Enabled=True
mnuComeback.Enabled=False
r=0
LineGenIndex,(1+flag*5)
IfLineWin(1+flag*5)=226+flag*5Then
Ifflag=0ThenMsgBox您赢了!ElseMsgBox您输了!
Ini
ExitSub
EndIf
IfCounter=225Then
MsgBox和棋
Ini
ExitSub
EndIf
IfmnuComputer.Checked=TrueThenComputerMoveElseflag=1-flag
EndSub
'查找可以落子的空位
FunctionFindBlank()AsInteger
Dimwz,fs,lz,RndNumAsInteger
fs=-10000
Forwz=0To224
IfGrid(wz)=0Then
Grid(wz)=2
LineGenwz,6
Rt=Gen
IfRt>fsThenfs=Rt:lz=wz
Grid(wz)=0
LineGenwz,-6
EndIf
Nextwz
FindBlank=lz
EndFunction
'高级模式
FunctionAttempt()AsInteger
DimwzAsInteger
Rt=LineWin(6)
IfRt<225ThenAttempt=Rt:ExitFunction
Rt=LineWin(1)
IfRt<225ThenAttempt=Rt:ExitFunction
'查找落子位置
Rt=linethree(6)
IfRt<225ThenAttempt=Rt:ExitFunction
Rt=linethree(1)
IfRt<225Then
Grid(Tb(0))=2
LineGenTb(0),6
Rt=Gen:wz=Tb(0)
Grid(Tb(0))=0
LineGenTb(0),-6
Grid(Tb(1))=2
LineGenTb(1),6
IfRt<GenThenRt=Gen:wz=Tb(1)
Grid(Tb(1))=0
LineGenTb(1),-6
Grid(Tb(2))=2
LineGenTb(2),6
IfRt<GenThenRt=Gen:wz=Tb(2)
Grid(Tb(2))=0
LineGenTb(2),-6
Attempt=wz
ExitFunction
EndIf
Rt=FindBlank
IfRt<225ThenAttempt=Rt:ExitFunction
EndFunction
PrivateSubmnuFirst_Click()'先后手
Firstmoved=1
mnuAfter.Checked=False
mnuFirst.Checked=True
EndSub
PrivateSubmnuHigher_Click()
mnuLower.Checked=False
mnuHigher.Checked=True
EndSub
PrivateSubmnuLower_Click()'难度
mnuLower.Checked=True
mnuHigher.Checked=False
EndSub
'局势评估
FunctionLineGen(ij,Piece)
Dimb,e,munAsInteger
I=ij\15
J=ijMod15
'横线影响
b=IIf(J-4>0,J-4,0)
e=IIf(J>10,10,J)
ForK=bToe
mun=H(I*15+K)
Ifmun<6ThenGen=Gen+mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen-mun*2^mun
H(I*15+K)=H(I*15+K)+Piece
mun=H(I*15+K)
Ifmun<6ThenGen=Gen-mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen+mun*2^mun
NextK
'竖线影响
b=IIf(I-4>0,I-4,0)
e=IIf(I>10,10,I)
ForK=bToe
mun=V(K*15+J)
Ifmun<6ThenGen=Gen+mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen-mun*2^mun
V(K*15+J)=V(K*15+J)+Piece
mun=V(K*15+J)
Ifmun<6ThenGen=Gen-mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen+mun*2^mun
NextK
'撇线影响
b=IIf(I-4>0,I-4,0)
e=IIf(I>10,10,I)
b=IIf(b>J+I-IIf(J+4>14,14,J+4),b,J+I-IIf(J+4>14,14,J+4))
e=IIf(e>J+I-IIf(J>4,J,4),J+I-IIf(J>4,J,4),e)
ForK=bToe
mun=RL(K*15+I+J-K)
Ifmun<6ThenGen=Gen+mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen-mun*2^mun
RL(K*15+I+J-K)=RL(K*15+I+J-K)+Piece
mun=RL(K*15+I+J-K)
Ifmun<6ThenGen=Gen-mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen+mun*2^mun
NextK
'捺线影响
b=IIf(I-4>0,I-4,0)
e=IIf(I>10,10,I)
b=IIf(b>I-J+IIf(J-4>0,J-4,0),b,I-J+IIf(J-4>0,J-4,0))
e=IIf(e>I-J+IIf(J>10,10,J),I-J+IIf(J>10,10,J),e)
ForK=bToe
mun=LR(K*15-I+J+K)
Ifmun<6ThenGen=Gen+mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen-mun*2^mun
LR(K*15-I+J+K)=LR(K*15-I+J+K)+Piece
mun=LR(K*15-I+J+K)
Ifmun<6ThenGen=Gen-mun*2^mun
Ifmun>5AndmunMod6=0Thenmun=mun\6-1:Gen=Gen+mun*2^mun
NextK
EndFunction
'是否存在三子一线（可发展成五子联线）
Functionlinethree(PieceAsInteger)AsInteger
DimmunAsInteger
linethree=225
'三子一线
mun=Piece*3
ForI=0To224
IfH(I)=munThen
IfGrid(I)=0Then
IfIMod15<10Then
IfGrid(I+5)=0Then
ForK=1To4
IfGrid(I+K)=0Then
Tb(0)=I+K
Tb(1)=I
Tb(2)=I+5
linethree=Tb(0)
ExitFunction
EndIf
NextK
EndIf
EndIf
EndIf
EndIf
IfV(I)=munThen
IfGrid(I)=0Then
If(I\15)<10Then
IfGrid(I+75)=0Then
ForK=1To4
IfGrid(I+K*15)=0Then
Tb(0)=I+K*15
Tb(1)=I
Tb(2)=I+75
linethree=Tb(0)
ExitFunction
EndIf
NextK
EndIf
EndIf
EndIf
EndIf
IfRL(I)=munThen
IfGrid(I)=0Then
If(I\15)4Then
IfGrid(I+70)=0Then
ForK=1To4
IfGrid(I+K*14)=0Then
Tb(0)=I+K*14
Tb(1)=I
Tb(2)=I+70
linethree=Tb(0)
ExitFunction
EndIf
NextK
EndIf
EndIf
EndIf
EndIf
IfLR(I)=munThen
IfGrid(I)=0Then
If(I\15)<10AndIMod15<10Then
IfGrid(I+80)=0Then
ForK=1To4
IfGrid(I+K*16)=0Then
Tb(0)=I+K*16
Tb(1)=I
Tb(2)=I+80
linethree=Tb(0)
ExitFunction
EndIf
NextK
EndIf
EndIf
EndIf
EndIf
NextI
EndFunction
PrivateSubmunHelp_Click()'帮助
lblHelp.Visible=True
EndSub
