VB五子棋代码.docx
《VB五子棋代码.docx》由会员分享，可在线阅读，更多相关《VB五子棋代码.docx（15页珍藏版）》请在冰豆网上搜索。
VB五子棋代码
界面设计：
运行界面：
代码如下：
OptionExplicit
ConstSubWidth=400'定义画五子棋表格的每格长度和宽度
PrivateP2PlayColorAsInteger'实现黑白棋子的交替进行
PrivateMyColorAsInteger'标记黑白双方棋子颜色
PrivateIfSucceedAsBoolean'表示是否胜利
Constpi=3.14159'定义字符常量pi=3.14159
PrivatecenterxAsSingle
PrivatecenteryAsSingle
PrivateradiusAsSingle
PrivateDataArray（14,14）AsInteger'保存棋盘中棋子的位置信息（空子=3黑棋=1白棋=0）
PrivatesumtimeAsInteger'记录总时间来判断谁超时
PrivateifStarteasyAsBoolean'标记简单难度下计时功能是否可以开启（ifStarteasy=true时每落子一次计时开启一次）
PrivateifStartnormalAsBoolean'标记中等难度下计时功能是否可以开启（ifStartnormal=true时每落子一次计时开启一次）
PrivateifStarthardAsBoolean'标记困难难度下计时功能是否可以开启（ifStarthard=true时每落子一次计时开启一次）
'单击命令按钮"退出"退出
PrivateSubCmdExit_Click（）
End
EndSub
PrivateSubCmdStart_Click（）
DimiAsInteger
DimmAsInteger
DimnAsInteger
'绘制棋盘
PicQiPan.Cls
PicQiPan.ForeColor=vbBlack
Fori=1To14
PicQiPan.Line（SubWidth,SubWidth*i）-（SubWidth*14,_
SubWidth*i）
PicQiPan.Line（SubWidth*i,SubWidth）-（SubWidth*i,_
SubWidth*14）
Nexti
'棋盘落点信息初始化
Form=0To14
Forn=0To14
DataArray（m,n）=3
Nextn
Nextm
'主要标记信息初始化
P2PlayColor=0
MyColor=0
IfSucceed=False
ifStarteasy=False
ifStartnormal=False
ifStarthard=False
Timer2.Enabled=False
Timer3.Enabled=False
Timer4.Enabled=False
FrmMain.Cls
sumtime=-1
EndSub
'简单难度
PrivateSubfileeasy_Click（）
ifStarteasy=True
sumtime=-1
MsgBox"双方下每步棋的思考时间最多20秒，否则超时清盘"
EndSub
'通过文件"退出"退出
PrivateSubfileexit_Click（）
End
EndSub
'困难难度
PrivateSubfilehard_Click（）
ifStarthard=True
sumtime=-1
MsgBox"双方下每步棋的思考时间最多5秒，否则超时清盘"
EndSub
'中等难度
PrivateSubfilenormal_Click（）
ifStartnormal=True
sumtime=-1
FrmMain.Cls
MsgBox"双方下每步棋的思考时间最多10秒，否则超时清盘"
EndSub
'通过文件"重新开始"实现棋盘初始化
PrivateSubfilerestart_Click（）
CallCmdStart_Click
EndSub
PrivateSubForm_Load（）
DimiAsInteger
DimmAsInteger
DimnAsInteger
'绘制棋盘
PicQiPan.Cls
PicQiPan.ForeColor=vbBlack
Fori=1To14
PicQiPan.Line（SubWidth,SubWidth*i）-（SubWidth*14,_
SubWidth*i）
PicQiPan.Line（SubWidth*i,SubWidth）-（SubWidth*i,_
SubWidth*14）
Nexti
'棋盘落点信息初始化
Form=0To14
Forn=0To14
DataArray（m,n）=3
Nextn
Nextm
Print
'确定表针位置的基本参量
centerx=Pictime.Width/2
centery=Pictime.Height/2
radius=Pictime.Height/2*0.9
Pictime.PSet（centerx,centery）
Pictime.Circle（centerx,centery）,radius
EndSub
'棋子落点判断（出界和重子情况）
PrivateSubPicQipan_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,yAsSingle）
Dimx0AsInteger
Dimy0AsInteger
DimiAsInteger
DimjAsInteger
IfX14.5*SubWidthOry14.5*SubWidthThen
MsgBox"超出棋盘界限，请重新下！
"
ExitSub
EndIf
IfAbs（Int（X/SubWidth）-X/SubWidth）<0.5Then
x0=Int（X/SubWidth）
Else
x0=Int（X/SubWidth）+1
EndIf
IfAbs（Int（y/SubWidth）-y/SubWidth）<0.5Then
y0=Int（y/SubWidth）
Else
y0=Int（y/SubWidth）+1
EndIf
IfDataArray（x0,y0）<>3Then
'当前位置已经有棋子了,
MsgBox"当前位置已经有棋子了，请重新走!
",vbCritical,"NOTE!
"
ExitSub
EndIf
sumtime=-1
CallDrawPill（x0,y0）'画棋子
CallRemenberCrossData（x0,y0）'记录棋子信息
CallWhoWin'判断谁赢
'判断是否开启相应难度计时功能
IfifStarteasy=TrueThen
Timer2.Enabled=True
EndIf
IfifStartnormal=TrueThen
Timer3.Enabled=True
EndIf
IfifStarthard=TrueThen
Timer4.Enabled=True
EndIf
EndSub
'画棋子
PrivateSubDrawPill（xx0AsInteger,yy0AsInteger）
IfP2PlayColorThen
PicQiPan.ForeColor=vbWhite
DoEvents
PicQiPan.FillColor=vbWhite
PicQiPan.FillStyle=0
MyColor=0
Else
PicQiPan.ForeColor=vbBlack
DoEvents
PicQiPan.FillColor=vbBlack
PicQiPan.FillStyle=0
MyColor=1
EndIf
P2PlayColor=NotP2PlayColor
PicQiPan.Circle（xx0*SubWidth,yy0*SubWidth）,SubWidth*0.5
EndSub
'以下ABC三个事件共同实现下棋的同时听音乐功能
'A
PrivateSubDir1_Change（）
File1.Path=Dir1.Path
EndSub
'B
PrivateSubDrv_Change（）
Dir1.Path=Drv.Drive
EndSub
'C
PrivateSubFile1_Click（）
mp3.URL=File1.Path&"\"&File1.FileName
EndSub
'棋盘皮肤
PrivateSubqipanstylefurA_Click（）
PicQiPan.BackColor=&HC0FFFF
CallCmdStart_Click
EndSub
PrivateSubqipanstylefurB_Click（）
PicQiPan.BackColor=&HC0C000
CallCmdStart_Click
EndSub
PrivateSubqipanstylefurC_Click（）
PicQiPan.BackColor=&HE0E0E0
CallCmdStart_Click
EndSub
PrivateSubqipanstylefurD_Click（）
PicQiPan.BackColor=&H8080FF
CallCmdStart_Click
EndSub
'添加四种背景音乐
PrivateSubstylemusicA_Click（）
mp3.URL=App.Path&"\"&"music01.mp3"
EndSub
PrivateSubstylemusicB_Click（）
mp3.URL=App.Path&"\"&"music02.mp3"
EndSub
PrivateSubstylemusicC_Click（）
mp3.URL=App.Path&"\"&"music03.mp3"
EndSub
PrivateSubstylemusicD_Click（）
mp3.URL=App.Path&"\"&"music04.mp3"
EndSub
'表针走动Timer1.Enabled=true在属性框中设定
PrivateSubTimer1_Timer（）
DimsAsInteger
DimmAsInteger
DimhAsInteger
DimsngLenSAsSingle
DimsngLenMAsSingle
DimsngLenHAsSingle
DimiAsInteger
'调试几次并查询VB常用函数，最后确定应该使用Now而不是Time（不过之前使用Time确实可以）
s=Second（Now）
m=Minute（Now）
h=Hour（Now）+m/60
sngLenS=radius*0.8
sngLenM=radius*0.6
sngLenH=radius*0.4
Pictime.Cls
Pictime.Scale（-centerx,centery）-（centerx,-centery）
Pictime.Line（0,0）-（sngLenS*Sin（2*pi*s/60）,sngLenS*Cos（2*pi*s/60））,vbGreen
Pictime.Line（0,0）-（sngLenM*Sin（2*pi*m/60）,sngLenM*Cos（2*pi*m/60））,vbGreen
Ifh>12Then
h=h-12
EndIf
Pictime.Line（0,0）-（sngLenH*Sin（2*pi*h/12）,sngLenH*Cos（2*pi*h/12））,vbGreen
Pictime.Circle（0,0）,radius*0.9
Fori=1To12
Pictime.Circle（radius*0.9*0.85*Sin（2*pi*i/12）,radius*0.9*0.85*Cos（2*pi*i/12））,radius*0.01,vbGreen
Nexti
EndSub
'判断谁赢了
PrivateSubWhoWin（）
DimiAsInteger
DimjAsInteger
Forj=1To14
Fori=1To14
IfDataArray（i,j）=MyColorAndNotIfSucceedThen
If（14-i）>=4And（14-j）>=4Then
IfDataArray（i+1,j+1）=MyColorThen
IfDataArray（i+2,j+2）=MyColorThen
IfDataArray（i+3,j+3）=MyColorThen
IfDataArray（i+4,j+4）=MyColorThen
IfSucceed=True
ExitFor
ExitFor
EndIf
EndIf
EndIf
EndIf
EndIf
Ifi>4And（14-j）>=4Then
IfDataArray（i-1,j+1）=MyColorThen
IfDataArray（i-2,j+2）=MyColorThen
IfDataArray（i-3,j+3）=MyColorThen
IfDataArray（i-4,j+4）=MyColorThen
IfSucceed=True
ExitFor
ExitFor
EndIf
EndIf
EndIf
EndIf
EndIf
If（14-i）>=4Then
IfDataArray（i+1,j）=MyColorThen
IfDataArray（i+2,j）=MyColorThen
IfDataArray（i+3,j）=MyColorThen
IfDataArray（i+4,j）=MyColorThen
IfSucceed=True
ExitFor
ExitFor
EndIf
EndIf
EndIf
EndIf
EndIf
If（14-j）>=4Then
IfDataArray（i,j+1）=MyColorThen
IfDataArray（i,j+2）=MyColorThen
IfDataArray（i,j+3）=MyColorThen
IfDataArray（i,j+4）=MyColorThen
IfSucceed=True
ExitFor
ExitFor
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
Nexti
Nextj
IfIfSucceedThen
IfNotP2PlayColorThen
Timer2.Enabled=False'白方赢计时停止
Timer3.Enabled=False
Timer4.Enabled=False
MsgBox"白方胜!
",vbOKOnly
CmdStart_Click
Else
Timer2.Enabled=False'黑方赢计时停止
Timer3.Enabled=False
Timer4.Enabled=False
MsgBox"黑方胜!
",vbOKOnly
CmdStart_Click
EndIf
EndIf
EndSub
'分别记录黑白棋子的分布
PrivateSubRemenberCrossData（x0_AsInteger,y0_AsInteger）
IfMyColorThen
DataArray（x0_,y0_）=1
Else
DataArray（x0_,y0_）=0
EndIf
EndSub
'简单难度思考时间20秒
PrivateSubTimer2_Timer（）
DimiAsInteger
i=1
sumtime=sumtime+i'计时
FrmMain.Cls
Print20-sumtime'剩余时间提示
Ifsumtime=20Then
IfMyColor=1Then
Timer2.Enabled=False'白方超时计时停止
MsgBox"白棋超时"
CallCmdStart_Click
Else
Timer2.Enabled=False'黑方超时计时停止
MsgBox"黑棋超时"
CallCmdStart_Click
EndIf
EndIf
EndSub
'中等难度思考时间10秒
PrivateSubTimer3_Timer（）
DimiAsInteger
i=1
sumtime=sumtime+i'计时
FrmMain.Cls
Print10-sumtime'剩余时间提示
Ifsumtime=10Then
IfMyColor=1Then
Timer3.Enabled=False'白方超时计时停止
MsgBox"白棋超时"
CallCmdStart_Click
Else
Timer3.Enabled=False'黑方超时计时停止
MsgBox"黑棋超时"
CallCmdStart_Click
EndIf
EndIf
EndSub
'困难难度思考时间5秒
PrivateSubTimer4_Timer（）
DimiAsInteger
i=1
sumtime=sumtime+i'计时
FrmMain.Cls
Print5-sumtime'剩余时间提示
Ifsumtime=5Then
IfMyColor=1Then
Timer4.Enabled=False'白方超时计时停止
MsgBox"白棋超时"
CallCmdStart_Click
Else
Timer4.Enabled=False'黑方超时计时停止
MsgBox"黑棋超时"
CallCmdStart_Click
EndIf
EndIf
EndSub
升级会员 