Dim pi
Dim pColor
Dim dir As String '移動方向
Dim xx, yy As Integer
Dim mouseOpen As Boolean '動態旗標
Dim sita1, sita2 '小精靈張口角度
Dim eye1x, eye1y, eye2x, eye2y As Integer '眼睛座標
Dim Bomb(10, 2) As Integer '炸彈座標陣列
Dim Pcount As Integer '寶物個數
Dim Score As Integer '分數
Private Sub BtnReset_Click()
Call GameInit
End Sub
Private Sub BtnStart_Click()
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Pic.ScaleHeight = 30 * 300
Pic.ScaleWidth = 40 * 300
Call GameInit
End Sub
Private Sub GameInit()
Pic.Cls
Pic.BackColor = vbGreen + vbBlue '底色
GColor(0).Value = True
pColor = GColor(0).BackColor
xx = 0 '初始座標
yy = 300
ww = Pic.ScaleWidth - 300
hh = Pic.ScaleHeight - 300
'---------------------------------------------------------------------------------------
Randomize
i = 0
Do While i <= 10 '放置隨機炸彈10個
Bomb(i, 1) = 300 + Fix(Rnd * 20) * 600
Bomb(i, 2) = 300 + Fix(Rnd * 15) * 600
If Not checkRepeat(i, Bomb(i, 1), Bomb(i, 2)) Then i = i + 1
Loop
For i = 300 To ww Step 600
For j = 300 To hh Step 600
If checkBomb(i, j) Then '是否為炸彈座標
Pic.DrawWidth = 5
Pic.PSet (i, j), vbRed '放置炸彈
Else
Pic.DrawWidth = 3 '放置寶物
Pic.PSet (i, j), vbBlue
End If
Next
Next
Pcount = 20 * 15 - 10
lblPcount = Pcount
pi = 4 * Atn(1)
Timer1.Enabled = False
Timer1.Interval = 300
Speed(0).Value = True
mouseOpen = True
dir = "右" '初始方向
Call Draw(dir) '放置小精靈
End Sub
Private Function checkRepeat(ii, ix, iy) As Boolean '炸彈座標是否重複
If ii = 1 Then
checkRepeat = False
Exit Function
End If
For i = 1 To ii - 1
If ix = Bomb(i, 1) And iy = Bomb(i, 2) Then
checkRepeat = True
Exit Function
End If
Next
checkRepeat = False
End Function
Private Function checkBomb(ii, jj) As Boolean '是否吃到炸彈
For i = 1 To 10
If ii = Bomb(i, 1) And jj = Bomb(i, 2) Then
checkBomb = True
Exit Function
End If
Next
checkBomb = False
End Function
Private Sub Draw(dir)
Pic.DrawWidth = 3
Select Case dir
Case "右"
eye1x = xx + 50 '眼睛位置
eye1y = yy - 150
eye2x = xx + 50
eye2y = yy - 150
If mouseOpen Then '向右開口
sita1 = -1 / 4 * pi
sita2 = -7 / 4 * pi
Else
sita1 = -(1 / 4 - 1 / 4.5) * pi '向右閉口
sita2 = -(7 / 4 + 1 / 4.5) * pi
End If
Case "上"
eye1x = xx + 150 '眼睛位置
eye1y = yy - 50
eye2x = xx - 150
eye2y = yy - 50
If mouseOpen Then '向上開口
sita1 = -(1 / 2 + 1 / 4) * pi
sita2 = -1 / 4 * pi
Else '向上閉口
sita1 = -(1 / 2 + 1 / 4 - 1 / 4.5) * pi
sita2 = -(1 / 4 + 1 / 4.5) * pi
End If
Case "左"
eye1x = xx - 50 '眼睛位置
eye1y = yy - 150
eye2x = xx - 50
eye2y = yy - 150
If mouseOpen Then '向左開口
sita1 = -(1 + 1 / 4) * pi
sita2 = -(1 / 2 + 1 / 4) * pi
Else '向左閉口
sita1 = -(1 + 1 / 4 - 1 / 4.5) * pi
sita2 = -(1 / 2 + 1 / 4 + 1 / 4.5) * pi
End If
Case "下"
eye1x = xx + 150 '眼睛位置
eye1y = yy + 50
eye2x = xx - 150
eye2y = yy + 50
If mouseOpen Then '向下開口
sita1 = -7 / 4 * pi
sita2 = -(1 + 1 / 4) * pi
Else '向下閉口
sita1 = -(7 / 4 - 1 / 4.5) * pi
sita2 = -(1 + 1 / 4 + 1 / 4.5) * pi
End If
End Select
Call checkPcount
Pic.Line (xx - 50, yy - 50)-(xx + 50, yy + 50), Pic.BackColor, BF
Pic.Circle (xx, yy), 200, pColor, sita1, sita2 '繪圖
Pic.PSet (eye1x, eye1y), vbRed '精睛
Pic.PSet (eye2x, eye2y), vbRed
End Sub
Private Sub checkPcount()
If Pic.Point(xx, yy) = vbBlue Then
Pcount = Pcount - 1
Score = Score + 10
Caption = "分數：" & Score
End If
lblPcount = Pcount
If Pcount <= 0 Then
MsgBox "恭喜過關!"
Timer1.Enabled = False
End If
End Sub
Private Sub GColor_Click(Index As Integer)
pColor = GColor(Index).BackColor
End Sub
Private Sub Pic_KeyDown(KeyCode As Integer, Shift As Integer)
Pic.DrawWidth = 3
Pic.Circle (xx, yy), 200, Pic.BackColor, sita1, sita2 '清除原圖
Pic.PSet (eye1x, eye1y), Pic.BackColor '清除眼睛
Pic.PSet (eye2x, eye2y), Pic.BackColor
Select Case KeyCode
Case vbKeyRight '向右鍵
dir = "右"
Case vbKeyUp '向上鍵
dir = "上"
Case vbKeyLeft '向左鍵
dir = "左"
Case vbKeyDown '向下鍵
dir = "下"
End Select
Call Draw(dir) '小精靈
End Sub
Private Sub Speed_Click(Index As Integer)
Select Case Index '速度等級選項
Case 0
Timer1.Interval = 300
Case 1
Timer1.Interval = 200
Case 2
Timer1.Interval = 100
End Select
End Sub
Private Sub Timer1_Timer()
Pic.SetFocus
mouseOpen = Not mouseOpen
Pic.Circle (xx, yy), 200, Pic.BackColor, sita1, sita2 '清除原圖
Pic.PSet (eye1x, eye1y), Pic.BackColor
Pic.PSet (eye2x, eye2y), Pic.BackColor
Select Case dir
Case "右"
xx = xx + 300
If xx > Pic.ScaleWidth - 300 Then xx = Pic.ScaleWidth - 300
Case "上"
yy = yy - 300
If yy <= 300 Then yy = 300
Case "左"
xx = xx - 300
If xx <= 300 Then xx = 300
Case "下"
yy = yy + 300
If yy > Pic.ScaleHeight - 300 Then yy = Pic.ScaleHeight - 300
End Select
Call Draw(dir)
For i = 1 To 10
If xx = Bomb(i, 1) And yy = Bomb(i, 2) Then
Pic.Circle (xx, yy), 200, vbYellow, sita1, sita2
MsgBox "Bomb.....!"
Timer1.Enabled = False
End If
Next
End Sub
字體：小 中 大
