batnball.frm

用VB写编的游戏： 打砖块 在此程序中包含了音乐和一些常用的控件

Dim Sheet As Integer
Dim Sizeadd As Integer
Dim Wadd As Integer
Dim PadYSpeed As Single
Dim YLast As Single
Dim Block1 As Integer
Dim Col1 As Variant
Dim Bordadd As Integer
Dim BallPos As Integer
Dim Bonus As Integer
Dim Secs As Integer
Dim Mins  As Integer
Dim Start As Boolean
Dim hassound As Boolean
Dim retval As Single

'Functions
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function PlaySound Lib "winmm.dll" Alias _
    "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, _
        ByVal dwFlags As Long) As Long
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal LpstrCommand As String, ByVal LpstrReturnString As String, ByVal UReturnLength As Long, ByVal HwndCallBack As Long) As Long

Public Function CanPlayWaves() As Boolean
 Dim x As Integer
 x = waveOutGetNumDevs()
  CanPlayWaves = x
End Function

Public Function PlayWaveFile(strFileName As String, _
    Optional blnAsync As Boolean) As Boolean
  Dim lngFlags As Long
  Const snd_sync = &H0
  Const snd_Async = &H1
  Const snd_Nodefault = &H2
  Const snd_Filename = &H20000
  lngFlags = snd_Nodefault Or snd_Filename Or snd_sync
  If blnAsync Then lngFlags = lngFlags Or snd_Async
  PlayWaveFile = PlaySound(strFileName, 0&, lngFlags)
End Function



Public Sub Delay(iAmtOfDelay As Integer, _
                 Optional sTypeOfDelay As String = "s")
End Sub

Private Sub Form_Load()
If CanPlayWaves <> 0 Then hassound = True
Start = True
subNewGame
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
PadSpeed = Last - x
shpPad.Left = shpPad.Left - PadSpeed * 4
If shpPad.Left < shpLeftBarrier.Left Then
  shpPad.Left = shpLeftBarrier.Left
End If
If shpPad.Left + shpPad.Width > shpRightBarrier.Left + shpRightBarrier.Width Then
  shpPad.Left = shpRightBarrier.Left + shpRightBarrier.Width - shpPad.Width
End If
Last = x
PadYSpeed = YLast - Y
If BallOnPad = False Then shpPad.Top = shpPad.Top - PadYSpeed * 4
If shpPad.Top < 1000 Then shpPad.Top = 1000
If shpPad.Top > 6000 Then shpPad.Top = 6000
YLast = Y

If BallOnPad = True And Button = 1 Then
  BallOnPad = False
  BallXadd = -PadSpeed * 4
  BallYadd = -PadYSpeed
End If
End Sub

Private Sub Timer1_Timer()
For j = 1 To BallSpeed
  subMain
Next j
End Sub

Public Sub subMain()
'Ball
If BallOnPad = True Then
  shpBall.Left = (shpPad.Left + shpPad.Width / 2) - (shpBall.Width / 2)
  shpBall.Top = (shpPad.Top - shpBall.Height)
End If
If BallXadd < -150 Then BallXadd = -150
If BallXadd > 150 Then BallXadd = 150
If BallYadd < -100 Then BallYadd = -100
If BallYadd > 100 Then BallYadd = 100

shpBall.Left = shpBall.Left + BallXadd
shpBall.Top = shpBall.Top + BallYadd

If shpBall.Left <= shpLeftBarrier.Left + shpLeftBarrier.Width Then
  BallXadd = -BallXadd
  shpLeftBarrier.FillColor = &HFFFF00
  Dis1 = 2
  If hassound Then retval = PlayWaveFile(App.Path & "\" & "bounce.wav", True)
End If

If shpBall.Left + shpBall.Width >= shpRightBarrier.Left Then
  BallXadd = -BallXadd
  shpRightBarrier.FillColor = &HFFFF00
  Dis2 = 2
  If hassound Then retval = PlayWaveFile(App.Path & "\" & "bounce.wav", True)
End If

shpBall.Top = shpBall.Top + BallYadd
If shpBall.Top <= shpTopBarrier.Top + shpTopBarrier.Height Then
  BallYadd = -BallYadd
  shpTopBarrier.FillColor = &HFFFF00
  Dis3 = 2
  If hassound Then retval = PlayWaveFile(App.Path & "\" & "bounce.wav", True)
End If
If BallOnPad = False And shpBall.Top < shpPad.Top + shpPad.Height And shpBall.Top + shpBall.Height >= shpPad.Top And (shpBall.Left + (shpBall.Width / 2)) >= shpPad.Left And (shpBall.Left + (shpBall.Width / 2) <= shpPad.Left + shpPad.Width) Then
  BallPos = Abs((shpPad.Left + shpPad.Width / 2) - (shpBall.Left + shpBall.Width / 2))
  BallXadd = BallXadd - PadSpeed * (BallPos / (shpPad.Width / 10))
  BallYadd = -Abs(BallYadd) - PadYSpeed
  If hassound Then retval = PlayWaveFile(App.Path & "\" & "bounce2.wav", True)
End If
If shpBall.Top > frmBounce.Height Then subBallLost
subHitCheck
End Sub
Public Sub subHitCheck()
'top
If Point((shpBall.Left + shpBall.Width / 2), shpBall.Top) = &HFF00& Then
  Block = fncFindBlock((shpBall.Left + shpBall.Width / 2), shpBall.Top)
  subKillBlock
  BallYadd = -BallYadd
  GoTo 20
End If
'bottom
If Point((shpBall.Left + shpBall.Width / 2), shpBall.Top + shpBall.Height) = &HFF00& Then
  Block = fncFindBlock((shpBall.Left + shpBall.Width / 2), shpBall.Top + shpBall.Height)
  subKillBlock
  BallYadd = -BallYadd
  GoTo 20
End If
'Left
If Point((shpBall.Left - 1), shpBall.Top + shpBall.Height / 2) = &HFF00& Then
  Block = fncFindBlock((shpBall.Left - 1), shpBall.Top + shpBall.Height / 2)
  subKillBlock
  BallXadd = -BallXadd
  GoTo 20
End If
'Right
If Point((shpBall.Left + shpBall.Width + 1), shpBall.Top + shpBall.Height / 2) = &HFF00& Then
  Block = fncFindBlock((shpBall.Left + shpBall.Width + 1), shpBall.Top + shpBall.Height / 2)
  subKillBlock
  BallXadd = -BallXadd
  GoTo 20
End If

20:
End Sub
Public Sub subKillBlock()
shpBlock(Block).Visible = False
BlockAlive(Block) = False
Hits = Hits + 1
Score = Score + 1
If Score > Highscore Then Highscore = Score
If Hits = 65 Then subNewSheet
End Sub
Public Sub subNewSheet()
If Score > 0 Then
  txtCount.Visible = True
  For i = 0 To Bonus
    txtCount.Text = "BONUS =" & Str(i)
    txtCount.Refresh
    Sleep 30&
  Next i
  Sleep 2500&
End If
txtCount.Visible = False
Sheet = Sheet + 1
Score = Score + Bonus
If Sheet / 5 = Int(Sheet / 5) Then
  Balls = Balls + 1
  Timer8.Enabled = True
Else
  Timer8.Enabled = False
  For i = 0 To 64
    shpBlock(i).FillColor = &HFF00&
  Next i
End If
If Sheet / 4 = Int(Sheet / 4) Then
  Timer4.Enabled = True
Else
  Timer4.Enabled = False
  shpBall.Height = 255
  shpBall.Width = 255
End If
If Sheet / 2 = Int(Sheet / 2) Then
  Timer6.Enabled = True
Else
  Timer6.Enabled = False
  shpPad.Width = 1455
End If
If Sheet / 3 = Int(Sheet / 3) Then
  Timer7.Enabled = True
Else
  Timer7.Enabled = False
  For i = 0 To 64
    shpBlock(Block1).FillColor = &HFF00&
  Next i
End If
If Sheet = 7 Or Sheet = 11 Or Sheet = 13 Or Sheet = 17 Or Sheet = 23 Then
  Timer9.Enabled = True
Else
  Timer9.Enabled = False
  For i = 0 To 64
    shpBlock(i).BorderWidth = 3
  Next i
End If
Hits = 0
For i = 0 To 64
  BlockAlive(i) = True
  shpBlock(i).Visible = True
Next i
Last = 0
BallOnPad = True

Timer1.Interval = Int(Timer1.Interval * 0.91)
If Timer1.Interval < 20 Then Timer1.Interval = 20

If Sheet / 12 = Int(Sheet / 12) Then
  BallSpeed = BallSpeed + 1
  If BallSpeed > 2 Then BallSpeed = 2
  Timer1.Interval = 60
End If
shpBall.Left = shpPad.Left + (shpPad.Width / 2)
shpBall.Top = shpPad.Top - shpBall.Height
BallXadd = 0: BallYadd = 0
Beep
Hits = 0
PadSpeed = 0
PadYSpeed = 0
shpPad.Top = 5500
Bordadd = -1
Bonus = 180
Secs = 0
shpTime.Width = 0
Timer10.Enabled = True
End Sub

Public Function fncFindBlock(Xb As Single, Yb As Single) As Integer
For i = 0 To 64
  If BlockAlive(i) = True Then
    If Xb <= shpBlock(i).Left + shpBlock(i).Width And Xb >= shpBlock(i).Left And Yb >= shpBlock(i).Top And Yb <= shpBlock(i).Top + shpBlock(i).Height + 5 Then
      fncFindBlock = i
      If hassound Then retval = PlayWaveFile(App.Path & "\" & "bounce.wav", True)
      GoTo 10
    End If
  End If
Next i
10:
End Function
Public Sub subBallLost()
BallOnPad = True
shpPad.Top = 5500
shpBall.Left = shpPad.Left + (shpPad.Width / 2)
shpBall.Top = shpPad.Top - shpBall.Height
BallXadd = 0: BallYadd = 0
Balls = Balls - 1
If Balls = 0 Then subNewGame
End Sub
Public Sub subNewGame()
If Start = False Then
  txtDisplay.Visible = True
  txtDis2.Visible = True
  txtDis1.Visible = True
  txtDis2.Visible = True
  txtDis1.Text = "SCORE:" & Str(Score)
  txtDis2.Text = "SHEET:" & Str(Sheet)
  txtDisplay.Refresh
  txtDis1.Refresh
  txtDis2.Refresh
  Sleep 5000&
End If
txtDisplay.Visible = False
txtDis1.Visible = False
txtDis2.Visible = False

Bonus = 0
Balls = 5
Score = 0
Sheet = 0
BallSpeed = 1
subNewSheet
Sizeadd = 15
Wadd = 50

Start = False
End Sub

Private Sub Timer10_Timer()
shpTime.Width = shpTime.Width + 43.4
If shpTime.Width >= 7815 Then shpTime.Width = 7815
Secs = Secs + 1
Bonus = Bonus - 1
If Bonus < 0 Then Bonus = 0
Mins = Int(Secs / 60)
If Mins <= 2 Then
  txtTime = Right(Str(Mins), 2) & ":" & Right(Str(Secs - (Int(Secs / 60)) * 60), 2)
Else
  txtTime = "AGES"
End If
txtBonus = Str(Bonus)
End Sub

Private Sub Timer2_Timer()
'Resore barriers
Dis1 = Dis1 - 1
If Dis1 < 0 Then Dis1 = 0: shpLeftBarrier.FillColor = &H800000
Dis2 = Dis2 - 1
If Dis2 < 0 Then Dis2 = 0: shpRightBarrier.FillColor = &H800000
Dis3 = Dis3 - 1
If Dis3 < 0 Then Dis3 = 0: shpTopBarrier.FillColor = &H800000

End Sub

Private Sub Timer3_Timer()
If Score > Highscore Then Highscore = Score
lblScore.Caption = "SCORE:" & Str(Score)
lblBalls.Caption = "BALLS:" & Str(Balls)
lblHighscore.Caption = "HIGHSCORE:" & Str(Highscore)
lblSheet.Caption = "SHEET:" & Str(Sheet)
End Sub

Private Sub Timer4_Timer()
shpBall.Height = shpBall.Height + Sizeadd
If shpBall.Height > 500 Then shpBall.Height = 500: Sizeadd = -Sizeadd
If shpBall.Height < 150 Then shpBall.Height = 150: Sizeadd = -Sizeadd
shpBall.Width = shpBall.Width + Sizeadd
If shpBall.Width > 500 Then shpBall.Width = 500: Sizeadd = -Sizeadd
If shpBall.Width < 150 Then shpBall.Width = 150: Sizeadd = -Sizeadd
End Sub

Private Sub Timer5_Timer()
PadSpeed = 0
PadYSpeed = 0
End Sub

Private Sub Timer6_Timer()
shpPad.Width = shpPad.Width + Wadd
If shpPad.Width > 2000 Then Wadd = -Wadd
If shpPad.Width < 800 Then Wadd = -Wadd
shpPad.Left = shpPad.Left - Wadd / 2
End Sub

Private Sub Timer7_Timer()
shpBlock(Block1).FillColor = &HFF00&
If Hits < 64 Then
  Block1 = Int(Rnd(1) * 65)
    While BlockAlive(Block1) = False
      Block1 = Int(Rnd(1) * 65)
    Wend
  If shpBlock(Block1).FillColor = &HFF00& Then
    shpBlock(Block1).FillColor = &HFF&
  Else
    shpBlock(Block1).FillColor = &HFF00&
  End If
End If
End Sub

Private Sub Timer8_Timer()
i = Int(Rnd(1) * 65)
Col1 = Int(Rnd(1) * 18) + 1
If Col1 = 1 Then Col1 = &H80FF&: GoTo 40
If Col1 = 2 Then Col1 = &HFF0000: GoTo 40
If Col1 = 3 Then Col1 = &HFFFF&: GoTo 40
If Col1 = 4 Then Col1 = &HFF00FF: GoTo 40
If Col1 = 5 Then Col1 = &HFFFF00: GoTo 40
If Col1 > 5 Then Col1 = &HFF00&
40:
shpBlock(i).FillColor = Col1

End Sub

Private Sub Timer9_Timer()
For i = 0 To 64
  shpBlock(i).BorderWidth = shpBlock(i).BorderWidth + Bordadd
Next i
If shpBlock(1).BorderWidth < 3 Or shpBlock(1).BorderWidth > 28 Then Bordadd = -Bordadd
End Sub