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
'確定表針位置的基本參量
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