VB五子棋代码.docx

1、VB五子棋代码界面设计：运行界面：代码如下：Option ExplicitConst SubWidth = 400 定义画五子棋表格的每格长度和宽度Private P2PlayColor As Integer 实现黑白棋子的交替进行Private MyColor As Integer 标记黑白双方棋子颜色Private IfSucceed As Boolean 表示是否胜利Const pi = 3.14159 定义字符常量pi=3.14159Private centerx As SinglePrivate centery As SinglePrivate radius As SinglePri

2、vate DataArray(14, 14) As Integer 保存棋盘中棋子的位置信息(空子=3 黑棋=1 白棋=0)Private sumtime As Integer 记录总时间来判断谁超时Private ifStarteasy As Boolean 标记简单难度下计时功能是否可以开启 （ifStarteasy=true时 每落子一次计时开启一次）Private ifStartnormal As Boolean 标记中等难度下计时功能是否可以开启 （ifStartnormal=true时 每落子一次计时开启一次）Private ifStarthard As Boolean 标记困难难

3、度下计时功能是否可以开启 （ifStarthard=true时 每落子一次计时开启一次） 单击命令按钮退出退出Private Sub CmdExit_Click() EndEnd SubPrivate Sub CmdStart_Click()Dim i As IntegerDim m As IntegerDim n As Integer绘制棋盘PicQiPan.ClsPicQiPan.ForeColor = vbBlackFor i = 1 To 14 PicQiPan.Line (SubWidth, SubWidth * i)-(SubWidth * 14, _SubWidth * i) P

4、icQiPan.Line (SubWidth * i, SubWidth)-(SubWidth * i, _SubWidth * 14)Next i棋盘落点信息初始化For m = 0 To 14 For n = 0 To 14 DataArray(m, n) = 3 Next n Next m 主要标记信息初始化 P2PlayColor = 0MyColor = 0IfSucceed = FalseifStarteasy = FalseifStartnormal = FalseifStarthard = FalseTimer2.Enabled = FalseTimer3.Enabled =

5、FalseTimer4.Enabled = FalseFrmMain.Clssumtime = -1End Sub简单难度Private Sub fileeasy_Click()ifStarteasy = Truesumtime = -1MsgBox 双方下每步棋的思考时间最多20秒，否则超时清盘End Sub通过文件退出退出Private Sub fileexit_Click() EndEnd Sub困难难度Private Sub filehard_Click()ifStarthard = Truesumtime = -1MsgBox 双方下每步棋的思考时间最多5秒，否则超时清盘End Su

6、b中等难度Private Sub filenormal_Click()ifStartnormal = Truesumtime = -1FrmMain.ClsMsgBox 双方下每步棋的思考时间最多10秒，否则超时清盘End Sub通过文件重新开始实现棋盘初始化Private Sub filerestart_Click() Call CmdStart_ClickEnd SubPrivate Sub Form_Load()Dim i As IntegerDim m As IntegerDim n As Integer绘制棋盘PicQiPan.ClsPicQiPan.ForeColor = vbBl

7、ackFor i = 1 To 14 PicQiPan.Line (SubWidth, SubWidth * i)-(SubWidth * 14, _SubWidth * i) PicQiPan.Line (SubWidth * i, SubWidth)-(SubWidth * i, _SubWidth * 14)Next i棋盘落点信息初始化For m = 0 To 14 For n = 0 To 14 DataArray(m, n) = 3 Next n Next mPrint确定表针位置的基本参量centerx = Pictime.Width / 2centery = Pictime.H

8、eight / 2radius = Pictime.Height / 2 * 0.9Pictime.PSet (centerx, centery)Pictime.Circle (centerx, centery), radiusEnd Sub棋子落点判断（出界和重子情况）Private Sub PicQipan_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)Dim x0 As IntegerDim y0 As IntegerDim i As IntegerDim j As IntegerIf X

9、14.5 * SubWidth Or y 14.5 * SubWidth Then MsgBox 超出棋盘界限，请重新下！ Exit SubEnd IfIf Abs(Int(X / SubWidth) - X / SubWidth) 0.5 Then x0 = Int(X / SubWidth)Else x0 = Int(X / SubWidth) + 1End IfIf Abs(Int(y / SubWidth) - y / SubWidth) 0.5 Then y0 = Int(y / SubWidth)Else y0 = Int(y / SubWidth) + 1End IfIf Dat

10、aArray(x0, y0) 3 Then 当前位置已经有棋子了, MsgBox 当前位置已经有棋子了，请重新走!, vbCritical, NOTE! Exit SubEnd Ifsumtime = -1Call DrawPill(x0, y0) 画棋子Call RemenberCrossData(x0, y0) 记录棋子信息Call WhoWin 判断谁赢判断是否开启相应难度计时功能If ifStarteasy = True Then Timer2.Enabled = TrueEnd IfIf ifStartnormal = True Then Timer3.Enabled = TrueE

11、nd IfIf ifStarthard = True Then Timer4.Enabled = TrueEnd IfEnd Sub画棋子Private Sub DrawPill(xx0 As Integer, yy0 As Integer)If P2PlayColor Then PicQiPan.ForeColor = vbWhite DoEvents PicQiPan.FillColor = vbWhite PicQiPan.FillStyle = 0 MyColor = 0 Else PicQiPan.ForeColor = vbBlack DoEvents PicQiPan.FillC

12、olor = vbBlack PicQiPan.FillStyle = 0 MyColor = 1 End IfP2PlayColor = Not P2PlayColorPicQiPan.Circle (xx0 * SubWidth, yy0 * SubWidth), SubWidth * 0.5End Sub以下A B C 三个事件共同实现下棋的同时听音乐功能APrivate Sub Dir1_Change() File1.Path = Dir1.PathEnd SubBPrivate Sub Drv_Change() Dir1.Path = Drv.DriveEnd SubCPrivate

13、 Sub File1_Click() mp3.URL = File1.Path & & File1.FileNameEnd Sub棋盘皮肤Private Sub qipanstylefurA_Click()PicQiPan.BackColor = &HC0FFFFCall CmdStart_ClickEnd SubPrivate Sub qipanstylefurB_Click()PicQiPan.BackColor = &HC0C000Call CmdStart_ClickEnd SubPrivate Sub qipanstylefurC_Click()PicQiPan.BackColor

14、= &HE0E0E0Call CmdStart_ClickEnd SubPrivate Sub qipanstylefurD_Click()PicQiPan.BackColor = &H8080FFCall CmdStart_ClickEnd Sub添加四种背景音乐Private Sub stylemusicA_Click()mp3.URL = App.Path & & music01.mp3End SubPrivate Sub stylemusicB_Click()mp3.URL = App.Path & & music02.mp3End SubPrivate Sub stylemusicC

15、_Click()mp3.URL = App.Path & & music03.mp3End SubPrivate Sub stylemusicD_Click()mp3.URL = App.Path & & music04.mp3End Sub表针走动 Timer1.Enabled=true在属性框中设定Private Sub Timer1_Timer()Dim s As IntegerDim m As IntegerDim h As IntegerDim sngLenS As SingleDim sngLenM As SingleDim sngLenH As SingleDim i As In

16、teger调试几次并查询VB常用函数，最后确定应该使用Now 而不是Time(不过之前使用Time确实可以)s = Second(Now)m = Minute(Now)h = Hour(Now) + m / 60sngLenS = radius * 0.8sngLenM = radius * 0.6sngLenH = radius * 0.4Pictime.ClsPictime.Scale (-centerx, centery)-(centerx, -centery)Pictime.Line (0, 0)-(sngLenS * Sin(2 * pi * s / 60), sngLenS * C

17、os(2 * pi * s / 60), vbGreenPictime.Line (0, 0)-(sngLenM * Sin(2 * pi * m / 60), sngLenM * Cos(2 * pi * m / 60), vbGreenIf h 12 Then h = h - 12End IfPictime.Line (0, 0)-(sngLenH * Sin(2 * pi * h / 12), sngLenH * Cos(2 * pi * h / 12), vbGreenPictime.Circle (0, 0), radius * 0.9For i = 1 To 12Pictime.C

18、ircle (radius * 0.9 * 0.85 * Sin(2 * pi * i / 12), radius * 0.9 * 0.85 * Cos(2 * pi * i / 12), radius * 0.01, vbGreenNext iEnd Sub判断谁赢了Private Sub WhoWin()Dim i As IntegerDim j As IntegerFor j = 1 To 14 For i = 1 To 14 If DataArray(i, j) = MyColor And Not IfSucceed Then If (14 - i) = 4 And (14 - j)

19、= 4 Then If DataArray(i + 1, j + 1) = MyColor Then If DataArray(i + 2, j + 2) = MyColor Then If DataArray(i + 3, j + 3) = MyColor Then If DataArray(i + 4, j + 4) = MyColor Then IfSucceed = True Exit For Exit For End If End If End If End If End If If i 4 And (14 - j) = 4 Then If DataArray(i - 1, j +

20、1) = MyColor Then If DataArray(i - 2, j + 2) = MyColor Then If DataArray(i - 3, j + 3) = MyColor Then If DataArray(i - 4, j + 4) = MyColor Then IfSucceed = True Exit For Exit For End If End If End If End If End If If (14 - i) = 4 Then If DataArray(i + 1, j) = MyColor Then If DataArray(i + 2, j) = My

21、Color Then If DataArray(i + 3, j) = MyColor Then If DataArray(i + 4, j) = MyColor Then IfSucceed = True Exit For Exit For End If End If End If End If End If If (14 - j) = 4 Then If DataArray(i, j + 1) = MyColor Then If DataArray(i, j + 2) = MyColor Then If DataArray(i, j + 3) = MyColor Then If DataA

22、rray(i, j + 4) = MyColor Then IfSucceed = True Exit For Exit For End If End If End If End If End If End If Next iNext jIf IfSucceed Then If Not P2PlayColor Then Timer2.Enabled = False 白方赢计时停止 Timer3.Enabled = False Timer4.Enabled = False MsgBox 白方胜!, vbOKOnly CmdStart_Click Else Timer2.Enabled = Fal

23、se 黑方赢计时停止 Timer3.Enabled = False Timer4.Enabled = False MsgBox 黑方胜!, vbOKOnly CmdStart_Click End IfEnd IfEnd Sub 分别记录黑白棋子的分布Private Sub RemenberCrossData(x0_ As Integer, y0_ As Integer)If MyColor Then DataArray(x0_, y0_) = 1Else DataArray(x0_, y0_) = 0End If End Sub简单难度思考时间20秒Private Sub Timer2_Tim

24、er()Dim i As Integeri = 1sumtime = sumtime + i 计时FrmMain.ClsPrint 20 - sumtime 剩余时间提示If sumtime = 20 Then If MyColor = 1 Then Timer2.Enabled = False 白方超时计时停止 MsgBox 白棋超时 Call CmdStart_Click Else Timer2.Enabled = False 黑方超时计时停止 MsgBox 黑棋超时 Call CmdStart_Click End IfEnd IfEnd Sub中等难度思考时间10秒Private Sub

25、 Timer3_Timer()Dim i As Integeri = 1sumtime = sumtime + i 计时FrmMain.ClsPrint 10 - sumtime 剩余时间提示If sumtime = 10 Then If MyColor = 1 Then Timer3.Enabled = False 白方超时计时停止 MsgBox 白棋超时 Call CmdStart_Click Else Timer3.Enabled = False 黑方超时计时停止 MsgBox 黑棋超时 Call CmdStart_Click End IfEnd IfEnd Sub困难难度思考时间5秒Private Sub Timer4_Timer()Dim i As Integeri = 1sumtime = sumtime + i 计时FrmMain.ClsPrint 5 - sumtime 剩余时间提示If sumtime = 5 Then If MyColor = 1 Then Timer4.Enabled = False 白方超时计时停止 MsgBox 白棋超时 Call CmdStart_Click Else Timer4.Enabled = False 黑方超时计时停止 MsgBox 黑棋超时 Call CmdStart_Click End IfEnd IfEnd Sub