运行界面：
代码如下：
Option Explicit
C定义画五子棋表格的每格长度和宽度
P实现黑白棋子的交替进行
P标记黑白双方棋子颜色
P表示是否胜利
C定义字符常量pi=3.14159
Private centerx As Single
Private centery As Single
Private radius As Single
P保存棋盘中棋子的位置信息(空子=3 黑棋=1 白棋=0)
P记录总时间来判断谁超时
P标记简单难度下计时功能是否可以开启 （ifStarteasy=true时 每落子一次计时开启一次）
P标记中等难度下计时功能是否可以开启 （ifStartnormal=true时 每落子一次计时开启一次）
P标记困难难度下计时功能是否可以开启 （ifStarthard=true时 每落子一次计时开启一次）
'单击命令按钮"退出"退出
Private Sub CmdExit_Click()
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
SubWidth * i)
SubWidth * 14)
Next i
'棋盘落点信息初始化
For m = 0 To 14
'主要标记信息初始化
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 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()
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
SubWidth * i)
SubWidth * 14)
Next i
'棋盘落点信息初始化
For m = 0 To 14
'确定表针位置的基本参量
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
超出棋盘界限，请重新下！"
End If
If Abs(Int(X / SubWidth) - X / SubWidth) < 0.5 Then
Else
End If
If Abs(Int(y / SubWidth) - y / SubWidth) < 0.5 Then
Else
End If
If DataArray(x0, y0) <> 3 Then
当前位置已经有棋子了,
当前位置已经有棋子了，请重新走!", vbCritical, "NOTE!"
End If
sumtime = -1
C画棋子
C记录棋子信息
C判断谁赢
'判断是否开启相应难度计时功能
If ifStarteasy = True Then
End If
If ifStartnormal = True Then
End If
If ifStarthard = True Then
End If
End Sub
'画棋子
Private Sub DrawPill(xx0 As Integer, yy0 As Integer)
If P2PlayColor Then
Else
End If
P2PlayColor = Not P2PlayColor
PicQiPan.Circle (xx0 * SubWidth, yy0 * SubWidth), SubWidth * 0.5
End Sub
'以下A B C 三个事件共同实现下棋的同时听音乐功能
'A
Private Sub Dir1_Change()
End Sub
'B
Private Sub Drv_Change()
End Sub
'C
Private Sub File1_Click()
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
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
Next j
If IfSucceed Then
Timer2.Enabled = False '白方赢计时停止
白方胜!", vbOKOnly
Timer2.Enabled = False '黑方赢计时停止
黑方胜!", vbOKOnly
End If
End Sub
'分别记录黑白棋子的分布
Private Sub RemenberCrossData(x0_ As Integer, y0_ As Integer)
If MyColor Then
Else
End If
End Sub
'简单难度思考时间20秒
Private Sub Timer2_Timer()
Dim i As Integer
i = 1
s计时
FrmMain.Cls
P剩余时间提示
If sumtime = 20 Then
Timer2.Enabled = False '白方超时计时停止
白棋超时"
Timer2.Enabled = False '黑方超时计时停止
黑棋超时"
End If
End Sub
'中等难度思考时间10秒
Private Sub Timer3_Timer()
Dim i As Integer
i = 1
s计时
FrmMain.Cls
P剩余时间提示
If sumtime = 10 Then
Timer3.Enabled = False '白方超时计时停止
白棋超时"
Timer3.Enabled = False '黑方超时计时停止
黑棋超时"
End If
End Sub
'困难难度思考时间5秒
Private Sub Timer4_Timer()
Dim i As Integer
i = 1
s计时
FrmMain.Cls
P剩余时间提示
If sumtime = 5 Then
Timer4.Enabled = False '白方超时计时停止
白棋超时"
Timer4.Enabled = False '黑方超时计时停止
黑棋超时"
End If
End Sub下载本文
