break.frm

breakthrough游戏(保持小球在屏幕上跳动)源程序

    ' 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