VB2008打磚塊小遊戲問題 - 伊莉討論區

Public Class Form1
'表單載入
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
For i As Integer = 0 To 4 '五個橫列
For j As Integer = 0 To 4 '五個直行
Brick(100 * i, 50 * j) '製作磚塊(100x50點大小)
Next
Next
Me.Width = (Me.Width - Me.ClientSize.Width) + 100 * 5 '調整表單寬度
Me.Height = (Me.Height - Me.ClientSize.Height) + 50 * 5 + 200 '調整表單高度
B.Top = 50 * 5 + 30 '調整球的高度，五排磚塊下30點
B.Left = (Me.ClientSize.Width - B.Width) / 2 '球水平置中
P.Top = Me.ClientSize.Height - 30 '調整球拍的高度
P.Left = (Me.ClientSize.Width - P.Width) / 2 '球拍水平置中
Timer1.Start() '啟動球的運動
End Sub
'製作指定位置磚塊的副程序
Sub Brick(ByVal X As Integer, ByVal Y As Integer)
Dim Q As New Label '建置新的磚塊物件
With Q
.Width = 100 '寬
.Height = 50 '高
.BackColor = Color.DarkRed '磚紅色
.BorderStyle = BorderStyle.FixedSingle '邊框
.Left = X '座標X
.Top = Y '座標Y
End With
Me.Controls.Add(Q) '磚塊加入表單
End Sub
Dim Vx As Single = 5, Vy As Single = 5 '速度值 '球的運動控制
Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles Timer1.Tick
B.Left += Vx 'X方向移動
B.Top += Vy 'Y方向移動
If B.Left < 0 Then Vx = Math.Abs(Vx) '碰左牆
If B.Right > Me.ClientSize.Width Then Vx = -Math.Abs(Vx) '碰右牆
If B.Top < 0 Then Vy = Math.Abs(Vy) '碰屋頂
Dim C As Single = (B.Left + B.Right) / 2 '球的中心點X座標
If B.Bottom > P.Top And C > P.Left And C < P.Right Then '撞到球拍
My.Computer.Audio.Play(My.Resources.Bang, AudioPlayMode.Background) '擊球音效
Vy = -Math.Abs(Vy) '向上彈
Dim F As Single = (C - P.Left) / P.Width '計算擊球點
If Vx < 0 Then F = 1 - F '方向調整
Vx = Vx * (F + 0.5) 'X速度修正
End If
If B.Top > Me.ClientSize.Height Then '漏接了，球掉出畫面
Timer1.Stop()
MsgBox("Game over!")
End If
'檢查磚塊碰撞情況
For Each q In Me.Controls '每一個控制項
If TypeOf (q) Is Label Then '如果是Label(磚塊)
If chkHit(q) Then '檢查是否擊中磚塊
My.Computer.Audio.Play(My.Resources.Bee, AudioPlayMode.Background) '破磚音效
End If
End If
Next
End Sub
'檢查球與磚塊或牆壁碰撞的程式
Function chkHit(ByVal Q As Label) As Boolean
If B.Right < Q.Left Then Return False '偏左未碰到
If B.Left > Q.Right Then Return False '偏右未碰到
If B.Top > Q.Bottom Then Return False '偏下未碰到
If B.Bottom < Q.Top Then Return False '偏上未碰到
'碰撞目標左側(剛剛越過左邊界)往左彈
If B.Right >= Q.Left And (B.Right - Q.Left) <= Math.Abs(Vx) Then Vx = -Math.Abs(Vx)
'碰撞目標右側(剛剛越過右邊界)往右彈
If B.Left <= Q.Right And (Q.Right - B.Left) <= Math.Abs(Vx) Then Vx = Math.Abs(Vx)
'碰撞目標底部(剛剛越過底邊界)往下彈
If B.Top <= Q.Bottom And (Q.Bottom - B.Top) <= Math.Abs(Vy) Then Vy = Math.Abs(Vy)
'碰撞目標頂部(剛剛越過頂邊界)往上彈
If B.Bottom >= Q.Top And (B.Bottom - Q.Top) <= Math.Abs(Vy) Then Vy = -Math.Abs(Vy)
Q.Dispose() '刪除磚塊物件
Return True '回傳有碰撞
End Function
'拖曳球拍的程式
Dim mdx As Integer '拖曳起點
Private Sub P_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles P.MouseDown
mdx = e.X '拖曳起點
End Sub
'拖曳中
Private Sub P_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles P.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim X As Integer = P.Left + (e.X - mdx) '試算拖曳位置
If X < 0 Then X = 0 '左移極限控制
If X > Me.ClientSize.Width - P.Width Then
X = Me.ClientSize.Width - P.Width '右移極限控制
End If
P.Left = X '球拍位置(不超出邊界)
End If
End Sub
End Class

複製代碼