跪求 五子棋vb代码
发布网友
发布时间：2022-04-20 05:25
共1个回答
热心网友
时间：2023-07-12 12:58
代码如下：
Option Explicit
Const SubWidth = 400 '定义画五子棋表格的每格长度和宽度
Private P2PlayColor As Integer '实现黑白棋子的交替进行
Private MyColor As Integer '标记黑白双方棋子颜色
Private IfSucceed As Boolean '表示是否胜利
Const pi = 3.14159 '定义字符常量pi=3.14159
Private centerx As Single
Private centery As Single
Private radius As Single
Private 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 '标记困难难度下计时功能是否可以开启 （ifStarthard=true时 每落子一次计时开启一次）
'单击命令按钮"退出"退出
Private Sub CmdExit_Click()
End
End Sub
Private Sub CmdStart_Click()
Dim i As Integer
Dim m As Integer
Dim n As Integer
'绘制棋盘
PicQiPan.Cls
PicQiPan.ForeColor = vbBlack
For 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 m
'主要标记信息初始化
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
End Sub
'简单难度
Private Sub fileeasy_Click()
ifStarteasy = True
sumtime = -1
MsgBox "双方下每步棋的思考时间最多20秒，否则超时清盘"
End Sub
'通过文件"退出"退出
Private Sub fileexit_Click()
End
End Sub
'困难难度
Private Sub filehard_Click()
ifStarthard = True
sumtime = -1
MsgBox "双方下每步棋的思考时间最多5秒，否则超时清盘"
End Sub
'中等难度
Private Sub filenormal_Click()
ifStartnormal = True
sumtime = -1
FrmMain.Cls
MsgBox "双方下每步棋的思考时间最多10秒，否则超时清盘"
End Sub
'通过文件"重新开始"实现棋盘初始化
Private Sub filerestart_Click()
Call CmdStart_Click
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim m As Integer
Dim n As Integer
'绘制棋盘
PicQiPan.Cls
PicQiPan.ForeColor = vbBlack
For 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 m
Print
'确定表针位置的基本参量
centerx = Pictime.Width / 2
centery = Pictime.Height / 2
radius = Pictime.Height / 2 * 0.9
Pictime.PSet (centerx, centery)
Pictime.Circle (centerx, centery), radius
End Sub
'棋子落点判断（出界和重子情况）
Private Sub PicQipan_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
Dim x0 As Integer
Dim y0 As Integer
Dim i As Integer
Dim j As Integer
If X < SubWidth Or X > 14.5 * SubWidth Or y < SubWidth Or y > 14.5 * SubWidth Then
MsgBox "超出棋盘界限，请重新下！"
Exit Sub
End If
If Abs(Int(X / SubWidth) - X / SubWidth) < 0.5 Then
x0 = Int(X / SubWidth)
Else
x0 = Int(X / SubWidth) + 1
End If
If Abs(Int(y / SubWidth) - y / SubWidth) < 0.5 Then
y0 = Int(y / SubWidth)
Else
y0 = Int(y / SubWidth) + 1
End If
If DataArray(x0, y0) <> 3 Then
'当前位置已经有棋子了,
MsgBox "当前位置已经有棋子了，请重新走!", vbCritical, "NOTE!"
Exit Sub
End If
sumtime = -1
Call DrawPill(x0, y0) '画棋子
Call RemenberCrossData(x0, y0) '记录棋子信息
Call WhoWin '判断谁赢
'判断是否开启相应难度计时功能
If ifStarteasy = True Then
Timer2.Enabled = True
End If
If ifStartnormal = True Then
Timer3.Enabled = True
End If
If ifStarthard = True Then
Timer4.Enabled = True
End If
End 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.FillColor = vbBlack
PicQiPan.FillStyle = 0
MyColor = 1
End If
P2PlayColor = Not P2PlayColor
PicQiPan.Circle (xx0 * SubWidth, yy0 * SubWidth), SubWidth * 0.5
End Sub
'以下A B C 三个事件共同实现下棋的同时听音乐功能
'A
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
'B
Private Sub Drv_Change()
Dir1.Path = Drv.Drive
End Sub
'C
Private Sub File1_Click()
mp3.URL = File1.Path & "\" & File1.FileName
End Sub
'棋盘皮肤
Private Sub qipanstylefurA_Click()
PicQiPan.BackColor = &HC0FFFF
Call CmdStart_Click
End Sub
Private Sub qipanstylefurB_Click()
PicQiPan.BackColor = &HC0C000
Call CmdStart_Click
End Sub
Private Sub qipanstylefurC_Click()
PicQiPan.BackColor = &HE0E0E0
Call CmdStart_Click
End Sub
Private Sub qipanstylefurD_Click()
PicQiPan.BackColor = &H8080FF
Call CmdStart_Click
End Sub
'添加四种背景音乐
Private Sub stylemusicA_Click()
mp3.URL = App.Path & "\" & "music01.mp3"
End Sub
Private Sub stylemusicB_Click()
mp3.URL = App.Path & "\" & "music02.mp3"
End Sub
Private Sub stylemusicC_Click()
mp3.URL = App.Path & "\" & "music03.mp3"
End Sub
Private Sub stylemusicD_Click()
mp3.URL = App.Path & "\" & "music04.mp3"
End Sub
'表针走动 Timer1.Enabled=true在属性框中设定
Private Sub Timer1_Timer()
Dim s As Integer
Dim m As Integer
Dim h As Integer
Dim sngLenS As Single
Dim sngLenM As Single
Dim sngLenH As Single
Dim i As Integer
'调试几次并查询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
If h > 12 Then
h = h - 12
End If
Pictime.Line (0, 0)-(sngLenH * Sin(2 * pi * h / 12), sngLenH * Cos(2 * pi * h / 12)), vbGreen
Pictime.Circle (0, 0), radius * 0.9
For i = 1 To 12
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
Next i
End Sub
'判断谁赢了
Private Sub WhoWin()
Dim i As Integer
Dim j As Integer
For 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) >= 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 + 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) = MyColor 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 DataArray(i, j + 4) = MyColor Then
IfSucceed = True
Exit For
Exit For
End If
End If
End If
End If
End If
End If
Next i
Next j
If IfSucceed Then
If Not P2PlayColor Then
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
End If
End If
End Sub
'分别记录黑白棋子的分布
Private Sub RemenberCrossData(x0_ As Integer, y0_ As Integer)
If MyColor Then
DataArray(x0_, y0_) = 1
Else
DataArray(x0_, y0_) = 0
End If
End Sub
'简单难度思考时间20秒
Private Sub Timer2_Timer()
Dim i As Integer
i = 1
sumtime = sumtime + i '计时
FrmMain.Cls
Print 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 If
End If
End Sub
'中等难度思考时间10秒
Private Sub Timer3_Timer()
Dim i As Integer
i = 1
sumtime = sumtime + i '计时
FrmMain.Cls
Print 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 If
End If
End Sub
'困难难度思考时间5秒
Private Sub Timer4_Timer()
Dim i As Integer
i = 1
sumtime = sumtime + i '计时
FrmMain.Cls
Print 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 If
End If
End Sub
