Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / games1 / break.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1997-02-23 | 31.0 KB | 853 lines

VERSION 4.00 Begin VB.Form frmBreakThru Appearance = 0 'Flat BackColor = &H00C0C0C0& BorderStyle = 0 'None Caption = "BREAK-THRU!" ClientHeight = 5265 ClientLeft = 2670 ClientTop = 2025 ClientWidth = 3810 BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 5955 Icon = "BREAK.frx":0000 KeyPreview = -1 'True Left = 2610 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5265 ScaleWidth = 3810 ShowInTaskbar = 0 'False Top = 1395 Width = 3930 Begin VB.Timer JoyTimer Interval = 22 Left = 3060 Top = 5280 End Begin VB.PictureBox picPaddle Appearance = 0 'Flat AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 180 Left = 1320 Picture = "BREAK.frx":030A ScaleHeight = 12 ScaleMode = 3 'Pixel ScaleWidth = 30 TabIndex = 6 Top = 5460 Visible = 0 'False Width = 450 End Begin VB.PictureBox picBlack Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& FillStyle = 0 'Solid ForeColor = &H80000008& Height = 495 Left = 270 ScaleHeight = 465 ScaleWidth = 675 TabIndex = 8 Top = 5190 Visible = 0 'False Width = 705 End Begin VB.PictureBox picBall Appearance = 0 'Flat AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 120 Left = 1110 Picture = "BREAK.frx":044C ScaleHeight = 8 ScaleMode = 3 'Pixel ScaleWidth = 8 TabIndex = 7 Top = 5520 Visible = 0 'False Width = 120 End Begin VB.PictureBox picField Appearance = 0 'Flat BackColor = &H00000000& ClipControls = 0 'False ForeColor = &H80000008& Height = 3975 Left = 135 ScaleHeight = 263 ScaleMode = 3 'Pixel ScaleWidth = 234 TabIndex = 0 Tag = "/3d/" Top = 1140 Width = 3540 Begin VB.Label lblGameOver Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "GAME OVER" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 400 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = -30 TabIndex = 2 Top = 1260 Visible = 0 'False Width = 3525 End Begin VB.Image imgBlock Appearance = 0 'Flat Height = 210 Index = 0 Left = 1080 Picture = "BREAK.frx":04EE Top = 480 Visible = 0 'False Width = 300 End Begin VB.Label lblPaused Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "PAUSED" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 400 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 0 TabIndex = 12 Top = 1740 Visible = 0 'False Width = 3525 End End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 5 Left = 2520 Top = 5280 End Begin VB.Label lblHiScore Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "0000" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 255 Left = 1620 TabIndex = 11 Tag = "/3d/" Top = 540 Width = 1875 End Begin VB.Label Label4 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "High Score:" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 255 Left = 240 TabIndex = 10 Top = 540 Width = 1275 End Begin VB.Label lblPoints Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "0000" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 1140 TabIndex = 3 Top = 150 Width = 675 End Begin VB.Label Label2 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Points:" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 315 Left = 240 TabIndex = 5 Top = 150 Width = 885 End Begin VB.Label Label1 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Balls Used:" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 315 Left = 1830 TabIndex = 4 Top = 150 Width = 1485 End Begin VB.Label lblMisses Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "0" BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Left = 3240 TabIndex = 1 Top = 150 Width = 285 End Begin VB.Label Label3 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent ForeColor = &H80000008& Height = 795 Left = 120 TabIndex = 9 Tag = "/3d/" Top = 120 Width = 3525 End Begin VB.Menu mnuPlay Caption = "&Play" Begin VB.Menu mnuPlayNewGame Caption = "&New Game" Shortcut = {F2} End Begin VB.Menu mnuPauseGame Caption = "&Pause" Shortcut = {F3} End Begin VB.Menu mnuPlaySep1 Caption = "-" End Begin VB.Menu mnuPlayExit Caption = "E&xit" Shortcut = ^X End End Attribute VB_Name = "frmBreakThru" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit '-------------------------------------------------- ' Global constants and varaibles used within the ' game's main form. '-------------------------------------------------- ' Ball Information -------------------------------- Dim bmpBall As tBitMap ' The current ball speed Dim XSpeed As Integer Dim YSpeed As Integer ' The slowest allowable ball speed Dim MinXSpeed As Integer Dim MinYSpeed As Integer ' The units at which the ball speed can change Dim SpeedUnit As Integer ' Either +1 or -1, determines the direction ' that the ball is moving Dim Xdir As Integer Dim YDir As Integer ' The starting position of the ball. Dim XStartBall As Integer Dim YStartBall As Integer Dim NumBalls As Integer ' Paddle Information ------------------------------ Dim bmpPaddle As tBitMap ' The starting position of the paddle Dim XStartPaddle As Integer Dim YStartPaddle As Integer ' The current amount of "english" that the paddle ' will apply to the ball. Dim PaddleEnglish As Integer ' The amount that the paddle will move. Dim PaddleIncrement As Integer ' Block Information ------------------------------- Const BLOCKS_IN_ROW = 10 Const NUM_ROWS = 2 Const BLOCK_GAP = 3 ' Strings that store game wave audio files in memory. Dim wavPaddleHit As String Dim wavBlockHit As String Dim wavWall As String Dim wavMissed As String Dim wavSetup As String Dim wavNewLevel As String ' Use JoyStick? Dim UseJoystick As Integer ' Joystick Information Dim JoyInfo As tJoyInfo Dim JoyAtRestMin As Long Dim JoyAtRestMax As Long ' Used when calling the two API functions below. Const SECTION = "HiScore" Const ENTRY = "Score" Const INI_FILE = "BREAKTHR.INI" Dim HiScore As Integer Dim HiPlayer As String ' Boolean (True/False) value that indicates if game ' has been paused. Dim Paused As Integer Private Sub Bitmap_Move(ABitMap As tBitMap, ByVal NewLeft As Integer, ByVal NewTop As Integer, SourcePicture As PictureBox) '-------------------------------------------------- ' This routine uses the BitBlt API function to ' first remove a bitmap from its original location ' (by simply BitBlting a black rectangle over its ' current position), then BitBlting the picture ' to its new location. '-------------------------------------------------- Dim retcode As Integer ' Cover the image with a black rectangle, erasing it. retcode = BitBlt(picField.hDC, ABitMap.Left, ABitMap.Top, ABitMap.Width, ABitMap.Height, picBlack.hDC, 0, 0, SRCCOPY) ' Update the images location in its data structure. ABitMap.Left = NewLeft ABitMap.Top = NewTop ' Redisplay it at its new location. retcode = BitBlt(picField.hDC, ABitMap.Left, ABitMap.Top, ABitMap.Width, ABitMap.Height, SourcePicture.hDC, 0, 0, SRCCOPY) End Sub Private Function BlockCollided(A As tBitMap, B As Image) As Integer '-------------------------------------------------- ' Check if the bitmap, A, and the image control, B, ' overlap each other. '-------------------------------------------------- Dim ACenterY As Integer Dim BCenterY As Integer Dim ACenterX As Integer Dim BCenterX As Integer ACenterY = (A.Height \ 2) + A.Top BCenterY = (B.Height \ 2) + B.Top ACenterX = (A.Width \ 2) + A.Left BCenterX = (B.Width \ 2) + B.Left BlockCollided = False ' See if they intersect in the same Y range If Abs(ACenterY - BCenterY) < ((A.Height + B.Height) \ 2) Then ' See if the intersect in the same X range If Abs(ACenterX - BCenterX) < ((A.Width + B.Width) \ 2) Then BlockCollided = True End If End If End Function Private Function Collided(A As tBitMap, B As tBitMap) As Integer '-------------------------------------------------- ' Check if the two rectangles (bitmaps) intersect, ' using the IntersectRect API call. '-------------------------------------------------- ' Although we won't use it, we need a result ' rectangle to pass to the API routine. Dim ResultRect As tBitMap ' Calculate the right and bottoms of rectangles needed by the API call. A.Right = A.Left + A.Width - 1 A.Bottom = A.Top + A.Height - 1 B.Right = B.Left + B.Width - 1 B.Bottom = B.Top + B.Height - 1 ' IntersectRect will only return 0 (false) if the ' two rectangles do NOT intersect. Collided = IntersectRect(ResultRect, A, B) End Function Private Sub CreateBlocks() '-------------------------------------------------- ' Create all the imgBlock elements that we need. '-------------------------------------------------- Dim i As Integer For i = 1 To (NUM_ROWS * BLOCKS_IN_ROW) Load imgBlock(i) Next End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '-------------------------------------------------- ' All game play input is handled through the ' keyboard (left and right arrow keys). '-------------------------------------------------- Select Case KeyCode Case KEY_LEFT: ' Make sure we're not off the left side If (bmpPaddle.Left - PaddleIncrement) > 0 Then ' Move the paddle to the left. Bitmap_Move bmpPaddle, bmpPaddle.Left - PaddleIncrement, bmpPaddle.Top, picPaddle ' Discard any english the paddle might have had from the opposite direction. If PaddleEnglish > 0 Then PaddleEnglish = 0 PaddleEnglish = PaddleEnglish - 1 End If Case KEY_RIGHT: ' Make sure we're not off the right side. If (bmpPaddle.Left + bmpPaddle.Width + PaddleIncrement) < picField.ScaleWidth Then ' Move the paddle to the right. Bitmap_Move bmpPaddle, bmpPaddle.Left + PaddleIncrement, bmpPaddle.Top, picPaddle ' Discard any english the paddle might have had from the opposite direction. If PaddleEnglish < 0 Then PaddleEnglish = 0 PaddleEnglish = PaddleEnglish + 1 End If End Select End Sub Private Sub Form_Load() '-------------------------------------------------- ' Position the game form and initialize all game ' values '-------------------------------------------------- Dim JoyXRange As Long Dim JoyXCenter As Long Dim rc As Integer Dim ScoreStr As String Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 ' Display the form. Me.Show InitGeneralGameData CreateBlocks ' Read the current High Score. HiScore = 0 HiPlayer = "???" ScoreStr = Space$(25) rc = GetPrivateProfileString(SECTION, ENTRY, "", ScoreStr, Len(ScoreStr), INI_FILE) If rc > 0 Then ScoreStr = Left$(ScoreStr, rc) If IsNumeric(ScoreStr) Then HiScore = Val(ScoreStr) HiPlayer = Space$(255) rc = GetPrivateProfileString(SECTION, "Player", "", HiPlayer, Len(HiPlayer), INI_FILE) If rc > 0 Then HiPlayer = Left$(HiPlayer, rc) Else HiPlayer = "???" End If End If ' Set up the Joystick rc = GetJoyStickPos(JOYSTICK1, JoyInfo) JoyXRange = (JoyCaps.Xmax - JoyCaps.Xmin) JoyXCenter = JoyCaps.Xmin + (JoyXRange / 2) JoyAtRestMin = JoyXCenter - (JoyXRange * 0.08) JoyAtRestMax = JoyXCenter + (JoyXRange * 0.08) ' Boolean (True/False) value that indicates if game ' has been paused. Paused = False End Sub Private Sub Form_Paint() '-------------------------------------------------- ' Draw 3D effect around selected controls on form. '-------------------------------------------------- Dim i As Integer On Error Resume Next ' Look at the tag fields of all controls For i = 0 To Me.Controls.Count - 1 If InStr(UCase$(Me.Controls(i).Tag), "/3D/") Then Make3D Me, Me.Controls(i), BORDER_INSET ElseIf InStr(UCase$(Me.Controls(i).Tag), "/3DUP/") Then Make3D Me, Me.Controls(i), BORDER_RAISED End If Next End Sub Private Sub InitGeneralGameData() '-------------------------------------------------- ' Set up variables that don't change during game play. '-------------------------------------------------- ' Determine the ball's start position based on game board dimensions. XStartBall = (picField.ScaleWidth - picBall.ScaleWidth) / 2 YStartBall = (picField.ScaleHeight) / 4 ' Determine the paddle's start position based on game board dimensions. XStartPaddle = (picField.ScaleWidth - picPaddle.ScaleWidth) / 2 YStartPaddle = picField.ScaleHeight - picPaddle.ScaleHeight ' Load all the Game sounds into memory. wavSetup = NoiseGet(App.Path & "\" & "setup.wav") wavPaddleHit = NoiseGet(App.Path & "\" & "paddle.wav") wavBlockHit = NoiseGet(App.Path & "\" & "blockhit.wav") wavWall = NoiseGet(App.Path & "\" & "wallhit.wav") wavMissed = NoiseGet(App.Path & "\" & "missed.wav") wavNewLevel = NoiseGet(App.Path & "\" & "newlevel.wav") ' Get Ball dimensions from the picBall control bmpBall.Left = XStartBall bmpBall.Top = YStartBall bmpBall.Width = picBall.ScaleWidth bmpBall.Height = picBall.ScaleHeight ' Get Paddle dimensions from the picPaddle control bmpPaddle.Left = XStartPaddle bmpPaddle.Top = YStartPaddle bmpPaddle.Width = picPaddle.ScaleWidth bmpPaddle.Height = picPaddle.ScaleHeight ' Number of balls the user gets during the game. NumBalls = 4 End Sub Private Sub InitNewGameData() '-------------------------------------------------- ' Set up all the variable we need for a new game. '-------------------------------------------------- ' Reset the score counting labels. lblHiScore = Format$(HiScore, "0000") & " - " & Trim$(HiPlayer) lblMisses = 0 lblPoints = "0000" ' Turn off the "Game Over" sign. lblGameOver.Visible = False ' The slowest speed increment is one pixel. SpeedUnit = 1 ' Set the minimum speed. MinXSpeed = SpeedUnit * 6 MinYSpeed = MinXSpeed ' Initial Speed is as slow as allowable. XSpeed = MinXSpeed YSpeed = MinYSpeed ' Move ball to starting position. ResetBall ' Make sure the playing field is clear. picField.Cls ' Draw the paddle on the playing field. Bitmap_Move bmpPaddle, bmpPaddle.Left, bmpPaddle.Top, picPaddle ' Set up the initial state of the paddle. PaddleEnglish = 0 PaddleIncrement = 7 End Sub Private Sub JoyTimer_Timer() '-------------------------------------------------- '-------------------------------------------------- Dim rc As Integer If Not UseJoystick Then Exit Sub rc = GetJoyStickPos(JOYSTICK1, JoyInfo) If JoyInfo.X < JoyAtRestMin Then ' Make sure we're not off the left side If (bmpPaddle.Left - PaddleIncrement) > 0 Then ' Move the paddle to the left. Bitmap_Move bmpPaddle, bmpPaddle.Left - PaddleIncrement, bmpPaddle.Top, picPaddle ' Discard any english the paddle might have had from the opposite direction. If PaddleEnglish > 0 Then PaddleEnglish = 0 PaddleEnglish = PaddleEnglish - 1 End If ElseIf JoyInfo.X > JoyAtRestMax Then ' Make sure we're not off the right side. If (bmpPaddle.Left + bmpPaddle.Width + PaddleIncrement) < picField.ScaleWidth Then ' Move the paddle to the right. Bitmap_Move bmpPaddle, bmpPaddle.Left + PaddleIncrement, bmpPaddle.Top, picPaddle ' Discard any english the paddle might have had from the opposite direction. If PaddleEnglish < 0 Then PaddleEnglish = 0 PaddleEnglish = PaddleEnglish + 1 End If End If End Sub Private Sub MissedBall() '-------------------------------------------------- ' Move the ball back to its starting position. '-------------------------------------------------- Dim answer As String Dim rc As Integer ' Suspend game play Timer1.Enabled = False ' Play the "Missed Ball" sound. NoisePlay wavMissed, SND_SYNC ' Update the number of balls missed. lblMisses = lblMisses + 1 ' If there are more balls left, continue playing. If lblMisses < NumBalls Then ResetBall Timer1.Enabled = True ' if no balls left, the game is over. Else lblGameOver.Visible = True mnuPlayNewGame.Enabled = True If IsNumeric(lblPoints) Then If lblPoints > HiScore Then answer = InputBox$("Congratulations! This is a new HIGH SCORE! Enter Your Name:", "Great Game!") rc = WritePrivateProfileString(SECTION, "Player", answer, INI_FILE) rc = WritePrivateProfileString(SECTION, ENTRY, Format$(lblPoints), INI_FILE) HiScore = lblPoints HiPlayer = Trim$(answer) lblHiScore = Format$(HiScore, "0000") & " - " & Trim$(HiPlayer) End If End If End If End Sub Private Sub mnuPauseGame_Click() Paused = Not Paused If Paused Then lblPaused.Visible = True Else lblPaused.Visible = False End If End Sub Private Sub mnuPlayExit_Click() '-------------------------------------------------- ' Exit the program. '-------------------------------------------------- Unload Me End Sub Private Sub mnuPlayNewGame_Click() '-------------------------------------------------- ' When this menu item is selected, the program ' initializes and sets up a new game. '-------------------------------------------------- Dim retcode As Integer ' Disable this menu option so a new game can't ' be started when one is in progress. mnuPlayNewGame.Enabled = False ' Initialize the data needed for a new game. InitNewGameData ' Set up the game for the first level. SetupNextLevel End Sub Private Sub ResetBall() '-------------------------------------------------- ' Move the ball back to its starting position, ' and reset the starting ball direction. '-------------------------------------------------- ' The ball always starts out going down and right. Xdir = 1 YDir = 1 ' Move the ball to the starting position. bmpBall.Left = XStartBall bmpBall.Top = YStartBall End Sub Private Sub SetupBlocks() '-------------------------------------------------- ' Setup the blocks between each round of game play. '-------------------------------------------------- Dim XIncr As Integer Dim i As Integer Dim j As Integer Dim ArrPos As Integer ' Make sure any visible blocks are hidden. For j = 1 To (NUM_ROWS * BLOCKS_IN_ROW) imgBlock(j).Visible = False DoEvents Next XIncr = imgBlock(0).Width + BLOCK_GAP imgBlock(0).Top = BLOCK_GAP For j = 1 To NUM_ROWS For i = 1 To BLOCKS_IN_ROW ' Translate a 2-dimensional position to a 1-D array index. ArrPos = ((j - 1) * BLOCKS_IN_ROW) + i ' Place the block... imgBlock(ArrPos).Move BLOCK_GAP + ((i - 1) * XIncr), imgBlock(0).Top ' and make it visible. imgBlock(ArrPos).Visible = True ' Make a noise each time a block is displayed. NoisePlay wavSetup, SND_SYNC ' DoEvents makes sure that the screen has a chance to update ' between sounds. DoEvents Next ' Calculate the new row position imgBlock(0).Top = imgBlock(0).Top + imgBlock(0).Height + BLOCK_GAP Next End Sub Private Sub SetupNextLevel() '-------------------------------------------------- ' Each time the user moves to a new level (after ' clearing all the blocks at the current level) ' the blocks must be replaced and the '-------------------------------------------------- Dim retcode As Integer ' Suspend game play. Timer1.Enabled = False ' Hide the ball retcode = BitBlt(picField.hDC, bmpBall.Left, bmpBall.Top, bmpBall.Width, bmpBall.Height, picBlack.hDC, 0, 0, SRCCOPY) ' Put a fresh set of blocks on the screen. retcode = sndPlaySound(App.Path & "\" & "newlevel.wav", SND_SYNC) SetupBlocks ' Put the ball back at its starting position. ResetBall ' Resume game play. Timer1.Enabled = True End Sub Private Sub Timer1_Timer() '-------------------------------------------------- ' This event handles most of the game action, with ' the exception of paddle movement, which is ' handled by the form's Key_Down event. '-------------------------------------------------- Dim Xinc As Integer Dim Yinc As Integer Dim i As Integer Dim PaddleCollision As Integer Static MoreBlocks As Integer Static PrevPaddleCollision As Integer If Paused Then Exit Sub ' Determine how much, and in which direction, to move the ball. Xinc = Xdir * XSpeed Yinc = YDir * YSpeed ' Ball will hit the left wall If (bmpBall.Left + bmpBall.Width + Xinc) > picField.ScaleWidth Then Xdir = -Xdir Xinc = Xdir * XSpeed NoisePlay wavWall, SND_ASYNC End If ' Ball will hit the right wall If (bmpBall.Left + Xinc) < 0 Then Xdir = -Xdir Xinc = Xdir * XSpeed NoisePlay wavWall, SND_ASYNC End If ' Ball got past paddle (at the bottom of playing field) If (bmpBall.Top) > picField.ScaleHeight Then MissedBall End If ' Ball hit the back (top) wall If (bmpBall.Top + Yinc) < 0 Then YDir = -YDir Yinc = YDir * YSpeed NoisePlay wavWall, SND_ASYNC End If ' Check if the paddle and ball collided. PaddleCollision = Collided(bmpBall, bmpPaddle) ' Move the ball to its new position Bitmap_Move bmpBall, bmpBall.Left + Xinc, bmpBall.Top + Yinc, picBall ' If the paddle is hit, then redraw the paddle. If PaddleCollision Then Bitmap_Move bmpPaddle, bmpPaddle.Left, bmpPaddle.Top, picPaddle End If ' See if we've hit the paddle... If PaddleCollision And (Not PrevPaddleCollision) Then YDir = -Abs(YDir) ' Adjust ball dynamics for paddle english If Abs(PaddleEnglish) > 0 Then If PaddleEnglish > 0 Then If Xdir > 0 Then ' Speed it up. XSpeed = XSpeed + SpeedUnit Else ' Slow it down. XSpeed = XSpeed - SpeedUnit ' Reverse the ball's X direction. Xdir = -Xdir End If ElseIf PaddleEnglish < 0 Then If Xdir < 0 Then ' Speed it up. XSpeed = XSpeed + SpeedUnit Else ' Slow it down. XSpeed = XSpeed - SpeedUnit ' Reverse the ball's X direction. Xdir = -Xdir End If End If ' Don't let the ball go too slow If XSpeed < MinXSpeed Then XSpeed = MinXSpeed End If ' Play the paddle hit noise. NoisePlay wavPaddleHit, SND_ASYNC ' See if the ball collided with the blocks. ElseIf bmpBall.Top < ((NUM_ROWS + 1) * imgBlock(0).Height) Then MoreBlocks = False For i = 1 To (NUM_ROWS * BLOCKS_IN_ROW) If imgBlock(i).Visible Then MoreBlocks = True If BlockCollided(bmpBall, imgBlock(i)) Then ' "Turn off", or hide, this block. imgBlock(i).Visible = False ' If we hit a block, send the ball back down. YDir = Abs(YDir) ' Play the block hit noise. NoisePlay wavBlockHit, SND_ASYNC ' The player gets a point for each block hit. lblPoints = Format$(Val(lblPoints) + 1, "0000") End If End If Next ' Out of blocks and we've still got more balls, ' so rack 'em up again. If (Not MoreBlocks) And (lblMisses < NumBalls) Then SetupNextLevel End If End If ' This is used to avoid multiple collision detections ' for a single hit. PrevPaddleCollision = PaddleCollision End Sub