VB五子棋代码Word文件下载.docx
《VB五子棋代码Word文件下载.docx》由会员分享，可在线阅读，更多相关《VB五子棋代码Word文件下载.docx（15页珍藏版）》请在冰豆网上搜索。
'
单击命令按钮"
退出"
退出
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
简单难度
PrivateSubfileeasy_Click（）
ifStarteasy=True
MsgBox"
双方下每步棋的思考时间最多20秒，否则超时清盘"
通过文件"
PrivateSubfileexit_Click（）
困难难度
PrivateSubfilehard_Click（）
ifStarthard=True
双方下每步棋的思考时间最多5秒，否则超时清盘"
中等难度
PrivateSubfilenormal_Click（）
ifStartnormal=True
双方下每步棋的思考时间最多10秒，否则超时清盘"
重新开始"
实现棋盘初始化
PrivateSubfilerestart_Click（）
CallCmdStart_Click
PrivateSubForm_Load（）
Print
确定表针位置的基本参量
centerx=Pictime.Width/2
centery=Pictime.Height/2
radius=Pictime.Height/2*0.9
Pictime.PSet（centerx,centery）
Pictime.Circle（centerx,centery）,radius
棋子落点判断（出界和重子情况）
PrivateSubPicQipan_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,yAsSingle）
Dimx0AsInteger
Dimy0AsInteger
DimjAsInteger
IfX<
SubWidthOrX>
14.5*SubWidthOry<
SubWidthOry>
14.5*SubWidthThen
MsgBox"
超出棋盘界限，请重新下！
"
ExitSub
EndIf
IfAbs（Int（X/SubWidth）-X/SubWidth）<
0.5Then
x0=Int（X/SubWidth）
Else
x0=Int（X/SubWidth）+1
IfAbs（Int（y/SubWidth）-y/SubWidth）<
y0=Int（y/SubWidth）
y0=Int（y/SubWidth）+1
IfDataArray（x0,y0）<
>
3Then
当前位置已经有棋子了,
当前位置已经有棋子了，请重新走!
vbCritical,"
NOTE!
CallDrawPill（x0,y0）'
画棋子
CallRemenberCrossData（x0,y0）'
记录棋子信息
CallWhoWin'
判断谁赢
判断是否开启相应难度计时功能
IfifStarteasy=TrueThen
Timer2.Enabled=True
IfifStartnormal=TrueThen
Timer3.Enabled=True
IfifStarthard=TrueThen
Timer4.Enabled=True
PrivateSubDrawPill（xx0AsInteger,yy0AsInteger）
IfP2PlayColorThen
PicQiPan.ForeColor=vbWhite
DoEvents
PicQiPan.FillColor=vbWhite
PicQiPan.FillStyle=0
MyColor=0
PicQiPan.ForeColor=vbBlack
PicQiPan.FillColor=vbBlack
MyColor=1
P2PlayColor=NotP2PlayColor
PicQiPan.Circle（xx0*SubWidth,yy0*SubWidth）,SubWidth*0.5
以下ABC三个事件共同实现下棋的同时听音乐功能
A
PrivateSubDir1_Change（）
File1.Path=Dir1.Path
B
PrivateSubDrv_Change（）
Dir1.Path=Drv.Drive
C
PrivateSubFile1_Click（）
mp3.URL=File1.Path&
"
\"
&
File1.FileName
棋盘皮肤
PrivateSubqipanstylefurA_Click（）
PicQiPan.BackColor=&
HC0FFFF
CallCmdStart_Click
PrivateSubqipanstylefurB_Click（）
HC0C000
PrivateSubqipanstylefurC_Click（）
HE0E0E0
PrivateSubqipanstylefurD_Click（）
H8080FF
添加四种背景音乐
PrivateSubstylemusicA_Click（）
mp3.URL=App.Path&
music01.mp3"
PrivateSubstylemusicB_Click（）
music02.mp3"
PrivateSubstylemusicC_Click（）
music03.mp3"
PrivateSubstylemusicD_Click（）
music04.mp3"
表针走动Timer1.Enabled=true在属性框中设定
PrivateSubTimer1_Timer（）
DimsAsInteger
DimhAsInteger
DimsngLenSAsSingle
DimsngLenMAsSingle
DimsngLenHAsSingle
调试几次并查询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
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
判断谁赢了
PrivateSubWhoWin（）
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
EndIf
Ifi>
4And（14-j）>
IfDataArray（i-1,j+1）=MyColorThen
IfDataArray（i-2,j+2）=MyColorThen
IfDataArray（i-3,j+3）=MyColorThen
IfDataArray（i-4,j+4）=MyColorThen
IfDataArray（i+1,j）=MyColorThen
IfDataArray（i+2,j）=MyColorThen
IfDataArray（i+3,j）=MyColorThen
IfDataArray（i+4,j）=MyColorThen
If（14-j）>
IfDataArray（i,j+1）=MyColorThen
IfDataArray（i,j+2）=MyColorThen
IfDataArray（i,j+3）=MyColorThen
IfDataArray（i,j+4）=MyColorThen
Nexti
Nextj
IfIfSucceedThen
IfNotP2PlayColorThen
Timer2.Enabled=False'
白方赢计时停止
Timer3.Enabled=False
Timer4.Enabled=False
白方胜!
vbOKOnly
CmdStart_Click
Else
黑方赢计时停止
黑方胜!
分别记录黑白棋子的分布
PrivateSubRemenberCrossData（x0_AsInteger,y0_AsInteger）
IfMyColorThen
DataArray（x0_,y0_）=1
DataArray（x0_,y0_）=0
EndSub
简单难度思考时间20秒
PrivateSubTimer2_Timer（）
i=1
sumtime=sumtime+i'
计时
Print20-sumtime'
剩余时间提示
Ifsumtime=20Then
IfMyColor=1Then
白方超时计时停止
白棋超时"
黑方超时计时停止
黑棋超时"
中等难度思考时间10秒
PrivateSubTimer3_Timer（）
Print10-sumtime'
Ifsumtime=10Then
Timer3.Enabled=False'
困难难度思考时间5秒
PrivateSubTimer4_Timer（）
Print5-sumtime'
Ifsumtime=5Then
Timer4.Enabled=False'
升级会员 