form1.frm

常见的小游戏

Case vbKeyC
  Timermove.Interval = 30
End Select
End Sub

Private Sub project()
Randomize
vecX = Round(6 * Rnd() - 3)
vecY = -Abs(Round(Sqr(step * step - vecX * vecX)))
multiplier = 0: presentscore = 5
king.Visible = True: king.Picture = king1.Picture
Timer2.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
MMControl1.Command = "stop": MMControl1.Command = "close"
End Sub

Private Sub king_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace And startword.Visible = True Then '图片在动时将获得焦点，故在此执行游戏重新开始的诸命令
  tostart = True
  startword.Visible = False: score = 0: lblscore.Caption = "0"
  For presentrow = 0 To row - 1 '以循环嵌套绘制砖墙
    For presentline = 0 To liner - 1
      Form1.PaintPicture Image1(Int(Rnd() * 2)).Picture, marginleft + presentrow * brickwidth, margintop + presentline * brickheight
      hit(presentrow, presentline) = False
    Next presentline
  Next presentrow
  counting = 72: prizeused = False
  board.Width = 80: board1.Width = 80
  project
  Timermove.Enabled = True: Timer1.Enabled = False
  remained(0).FillColor = vbWhite: remained(1).FillColor = vbWhite: life = 3
End If
If KeyCode = vbKeyLeft Then
  If board.Left > 40 Then
    board.Left = board.Left - 40: board1.Left = board1.Left - 40
  Else
    board.Left = 0
  End If
Else
  If KeyCode = vbKeyRight Then
    If board.Left + board.Width + 40 < Me.ScaleWidth Then
      board.Left = board.Left + 40: board1.Left = board1.Left + 40
    Else
      board.Left = Me.ScaleWidth - board.Width
    End If
  End If
End If
board1.Left = board.Left
Select Case KeyCode
Case vbKeyZ
  Timermove.Interval = 20
Case vbKeyX
  Timermove.Interval = 25
Case vbKeyC
  Timermove.Interval = 30
End Select
End Sub

Private Sub prize_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyLeft Then
  If board.Left > 40 Then
    board.Left = board.Left - 40: board1.Left = board1.Left - 40
  Else
    board.Left = 0
  End If
Else
  If KeyCode = vbKeyRight Then
    If board.Left + board.Width + 40 < Me.ScaleWidth Then
      board.Left = board.Left + 40: board1.Left = board1.Left + 40
    Else
      board.Left = Me.ScaleWidth - board.Width
    End If
  End If
End If
board1.Left = board.Left
Select Case KeyCode
Case vbKeyZ
  Timermove.Interval = 20
Case vbKeyX
  Timermove.Interval = 25
Case vbKeyC
  Timermove.Interval = 30
End Select
End Sub

Private Sub Timer1_Timer()
prize.Top = prize.Top + 10
If Abs(prize.Top + prize.Height - board.Top) < 5 And (prize.Left > board.Left And prize.Left + prize.Width < board.Left + board.Width) Then
  board.Width = board.Width + 40: board1.Width = board.Width
  MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
  MMControl1.FileName = App.Path + "\sound\lengthen.wav": MMControl1.Command = "play"
  prize.Visible = False: Timer1.Enabled = False
End If
If prize.Top > board.Top Then
  prize.Visible = False: Timer1.Enabled = False
End If
End Sub

Private Sub Timer2_Timer()
If king.Picture = king1.Picture Then
  king.Picture = king2.Picture
Else
  If king.Picture = king2.Picture Then king.Picture = king1.Picture
End If
End Sub

Private Sub Timermove_Timer()
ball.Left = ball.Left + vecX: ball.Top = ball.Top + vecY
If vecX <= 0 And vecY <= 0 Then '计算球往左上方移动时遇障碍的反弹情况
  ballleft = GetPixel(Me.hdc, ball.Left, ball.Top + radius)
  balltop = GetPixel(Me.hdc, ball.Left + radius, ball.Top)
  If ballleft <> vbBlack Or ((ball.Left < marginleft And ball.Top < marginbottom) Or (ball.Left + 2 * radius > marginright And ball.Top < marginbottom)) Then '左遇障碍物
    alwaysreflection
    vecX = -vecX
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or ball.Left + 2 * radius > marginright Then Exit Sub
    presentrow = (ball.Left - marginleft) \ brickwidth
    presentline = (ball.Top + radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  If balltop <> vbBlack Or ((ball.Left < marginleft And ball.Top < marginbottom) Or (ball.Left + 2 * radius > marginright And ball.Top < marginbottom)) Then '上遇障碍物
    alwaysreflection
    vecY = -vecY
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or ball.Left + 2 * radius > marginright Then Exit Sub
    presentrow = (ball.Left + radius - marginleft) \ brickwidth
    presentline = (ball.Top - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
End If
If vecX <= 0 And vecY > 0 Then '计算球往左下方移动时遇障碍的反弹情况
  ballleft = GetPixel(Me.hdc, ball.Left, ball.Top + radius)
  ballbottom = GetPixel(Me.hdc, ball.Left + radius, ball.Top + 2 * radius)
  If ballleft <> vbBlack Then '左遇障碍物
    vecX = -vecX
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or (ball.Left + 2 * radius > marginright Or ball.Top + 2 * radius > marginbottom) Then Exit Sub
    presentrow = (ball.Left - marginleft) \ brickwidth
    presentline = (ball.Top + radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  If ballleft = vbBlack And ballbottom <> vbBlack Then '下遇障碍物
    vecY = -vecY
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or (ball.Left + 2 * radius > marginright Or ball.Top + 2 * radius > marginbottom) Then Exit Sub
    presentrow = (ball.Left + radius - marginleft) \ brickwidth
    presentline = (ball.Top + 2 * radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  '检测是否被挡板挡回
  If ball.Top + 2 * radius > board.Top And (ball.Left + radius > board.Left And ball.Left + radius < board.Left + board.Width) Then
    vecX = vecX + Round(Rnd() * 2 - 1) '变化反弹角度
    If vecX >= 5 Then vecX = 4
    If vecX <= -5 Then vecX = -4
    vecY = -Abs(Round(Sqr(step * step - vecX * vecX)))
    multiplier = 0: presentscore = 5
    MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
    MMControl1.FileName = App.Path + "\sound\hit.wav": MMControl1.Command = "play"
  End If
  If ball.Top + 2 * radius > board.Top + step Then
    Timermove.Enabled = False
    life = life - 1
    king.Picture = king4.Picture
    MsgBox "任务失败,还有小球" + Str(life) + "个", vbOKOnly, "回合结束"
    board.Width = 80: board1.Width = 80 '板长恢复原始状态
    If life = 2 Then remained(0).FillColor = vbBlack
    If life = 1 Then remained(1).FillColor = vbBlack
    If life = 0 Then
      startword.Visible = True
      tostart = False
      ball.Left = board.Left + board.Width \ 2: ball.Top = board.Top - 2 * radius
      Exit Sub
    End If
    ball.Left = board.Left + board.Width \ 2: ball.Top = board.Top - 2 * radius
    project
    Timermove.Enabled = True
  End If
End If
If vecX > 0 And vecY <= 0 Then '计算球往右上方移动时遇障碍的反弹情况
  ballright = GetPixel(Me.hdc, ball.Left + 2 * radius, ball.Top + radius)
  balltop = GetPixel(Me.hdc, ball.Left + radius, ball.Top)
  If ballright <> vbBlack Or ((ball.Left < marginleft And ball.Top < marginbottom) Or (ball.Left + 2 * radius > marginright And ball.Top < marginbottom)) Then '右遇障碍物
    alwaysreflection
    vecX = -vecX
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or ball.Left + 2 * radius > marginright Then Exit Sub
    presentrow = (2 * radius + ball.Left - marginleft) \ brickwidth
    presentline = (ball.Top + radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  If balltop <> vbBlack Or ((ball.Left < marginleft And ball.Top < marginbottom) Or (ball.Left + 2 * radius > marginright And ball.Top < marginbottom)) Then
    alwaysreflection
    vecY = -vecY
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or ball.Left + 2 * radius > marginright Then Exit Sub
    presentrow = (ball.Left + radius - marginleft) \ brickwidth
    presentline = (ball.Top - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
End If
If vecX > 0 And vecY > 0 Then '计算球往右下方移动时遇障碍的反弹情况
  ballright = GetPixel(Me.hdc, ball.Left + 2 * radius, ball.Top + radius)
  ballbottom = GetPixel(Me.hdc, ball.Left + radius, ball.Top + 2 * radius)
  If ballright <> vbBlack Then '右遇障碍物
    vecX = -vecX
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or (ball.Left + 2 * radius > marginright Or ball.Top + 2 * radius > marginbottom) Then Exit Sub
    presentrow = (2 * radius + ball.Left - marginleft) \ brickwidth
    presentline = (ball.Top + radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  If ballright = vbBlack And ballbottom <> vbBlack Then '下遇障碍物
    vecY = -vecY
    '*********确保被击中的砖消失************************
    If (ball.Left < marginleft Or ball.Top < margintop) Or (ball.Left + 2 * radius > marginright Or ball.Top + 2 * radius > marginbottom) Then Exit Sub
    presentrow = (ball.Left + radius - marginleft) \ brickwidth
    presentline = (ball.Top + 2 * radius - margintop) \ brickheight
    Line (presentrow * brickwidth + marginleft, presentline * brickheight + margintop)-Step(brickwidth, brickheight), vbBlack, BF
    '***************************************************
    recordscore
  End If
  If ball.Top + 2 * radius > board.Top And (ball.Left + radius > board.Left And ball.Left + radius < board.Left + board.Width) Then
    vecX = vecX + Round(Rnd() * 2 - 1) '变化反弹角度
    If vecX >= 5 Then vecX = 4
    If vecX <= -5 Then vecX = -4
    vecY = -Abs(Round(Sqr(step * step - vecX * vecX)))
    multiplier = 0: presentscore = 5
    MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
    MMControl1.FileName = App.Path + "\sound\hit.wav": MMControl1.Command = "play"
  End If
  If ball.Top + 2 * radius > board.Top + step Then '处理回合失败的情形
    Timermove.Enabled = False
    life = life - 1
    Timer2.Enabled = False
    king.Picture = king4.Picture
    MsgBox "任务失败,还有小球" + Str(life) + "个", vbOKOnly, "回合结束"
    board.Width = 80: board1.Width = 80 '板长恢复原始状态
    If life = 2 Then remained(0).FillColor = vbBlack
    If life = 1 Then remained(1).FillColor = vbBlack
    If life = 0 Then
      startword.Visible = True
      tostart = False
      ball.Left = board.Left + board.Width \ 2: ball.Top = board.Top - 2 * radius
      Exit Sub
    End If
    ball.Left = board.Left + board.Width \ 2: ball.Top = board.Top - 2 * radius
    project
    Timermove.Enabled = True
  End If
End If
If ball.Top < 96 Then '96即margintop,要求小球不超过最上面的城墙
    vecY = Abs(vecY)
    ball.Top = 97
End If
End Sub

Private Sub recordscore()
'若小球弹起一次撞掉多个砖头，每撞一次得分应翻倍
MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
MMControl1.FileName = App.Path + "\sound\hit.wav": MMControl1.Command = "play"
If prizeused = False Then
    Randomize
    If Rnd() * 60 > 59 Then
      prizeused = True
      prize.Visible = True: prize.Left = marginleft + presentrow * brickwidth: prize.Top = margintop + presentline * brickheight
      Timer1.Enabled = True
    End If
End If
If hit(presentrow, presentline) = False Then
    hit(presentrow, presentline) = True
    multiplier = multiplier + 1
    caculation = multiplier
    Do While caculation > 0
      presentscore = presentscore * 2
      caculation = caculation - 1
    Loop
    score = score + presentscore
    If score = 5 Then score = 0
    lblscore.Caption = Str(score)
    counting = counting - 1
    If counting = 0 Then
      king.Picture = king3.Picture
      MsgBox "你完成任务了！", vbOKOnly, "游戏结束"
      startword.Visible = True
      tostart = False: Timermove.Enabled = False
      ball.Left = board.Left + board.Width \ 2: ball.Top = board.Top - 2 * radius
      MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
      MMControl1.FileName = App.Path + "\sound\win.wav": MMControl1.Command = "play"
    Else
      MMControl1.Command = "stop": MMControl1.Command = "close": MMControl1.Command = "open"
      MMControl1.FileName = App.Path + "\sound\hit.wav": MMControl1.Command = "play"
    End If
'******************************************************
End If
End Sub

Private Sub alwaysreflection()
If (ball.Left < marginleft Or ball.Left + 2 * radius > marginright) And (ball.Top + 2 * radius < marginbottom And ball.Top + 2 * radius > marginbottom - 5) Then
  vecY = -vecY
End If
If (ball.Left < marginleft And ball.Left > marginleft + 5) Or (ball.Left + 2 * radius > marginright And ball.Left + 2 * radius < marginright + 5) And ball.Top + 2 * radius < marginbottom Then
  vecX = -vecX
End If
End Sub