注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

沉默蜂B4A安卓编程

国内资料最全的B4A资料库

 
 
 

日志

 
 

[例程]跳动的球体(GameManager模块)  

2015-08-19 14:48:42|  分类: B.游戏 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
'Class module
Sub Class_Globals
Public gv As GameView
Private mainTimer As Timer
Private fps As Float = 30
Private lastTime As Long
Private lblFPS As Label
Private sounds As SoundPool
Private smiley1 As Smiley
Private bricks As List
Private regularBrickImage, disappearBrickImage As Bitmap
Public BOUNCE_SOUND As Int
Private background As BitmapData
Private backgroundScale As Float
Private wake As PhoneWakeState
End Sub

Public Sub Initialize (vGV As GameView, vlblFPS As Label)
gv = vGV
lblFPS = vlblFPS
mainTimer.Initialize("MainTimer", 15)
background = CreateBackground
gv.BitmapsData.Add(background)
StartGame
bricks.Initialize
regularBrickImage = CreateBrickImage(Colors.Gray, Colors.LightGray)
disappearBrickImage = CreateBrickImage(Colors.Blue, Colors.Magenta)
For i = 1 To 7
CreateBrick(PerYToCurrent(100 - i * 15))
Next
sounds.Initialize(4)
BOUNCE_SOUND = sounds.Load(File.DirAssets, "bounce.mp3")
End Sub

Private Sub CreateBrickImage (Color1 As Int, Color2 As Int) As Bitmap
Dim bmp As Bitmap
bmp.InitializeMutable(10%x, 2%y)
Dim c As Canvas
c.Initialize2(bmp)
Dim gd As GradientDrawable
gd.Initialize("TR_BL", Array As Int(Color1, Color2))
gd.CornerRadius = 5dip
Dim r As Rect
r.Initialize(0, 0, bmp.Width, bmp.Height)
c.DrawDrawable(gd, r)
Return bmp
End Sub
Private Sub StartGame
Dim bd As BitmapData
gv.BitmapsData.Add(bd)
smiley1.Initialize(bd, bricks, Me)
End Sub

Public Sub StartTimer
mainTimer.Enabled = True
smiley1.StartSensor
wake.KeepAlive(True) 'keep the screen on while playing
End Sub

Public Sub StopTimer
mainTimer.Enabled = False
smiley1.StopSensor
wake.ReleaseKeepAlive
End Sub

Public Sub ScrollDown(y As Float)
For Each brck As Brick In bricks
brck.vy = y
Next
'move the background stars
background.SrcRect.Top = (background.SrcRect.Top - y / 5 + background.Bitmap.Height - 100%y / backgroundScale) Mod _
(background.Bitmap.Height - 100%y / backgroundScale)
background.SrcRect.Bottom = background.SrcRect.Top + 100%y / backgroundScale
End Sub

Private Sub mainTimer_Tick
'calculate the frames per second
fps = (1000 / Max(10, (DateTime.Now - lastTime)) + 20 * fps) / 21
lblFPS.Text = NumberFormat(fps, 0, 0)
lastTime = DateTime.Now
smiley1.Tick
Dim i As Int = 0
Do While i < bricks.Size
Dim b As Brick = bricks.Get(i)
Dim delete As Boolean = b.Tick
If delete Then
'remove this brick and create a new one.
bricks.RemoveAt(i)
Dim distance As Float = PerYToCurrent(Rnd(10, 40))
Dim lastBrick As Brick = bricks.Get(bricks.Size - 1)
CreateBrick(lastBrick.bd.DestRect.Top - distance)
Else
i = i + 1
End If
Loop
'mark the GameView as "dirty". This will cause it to redraw itself.
gv.Invalidate
End Sub

Public Sub PlaySound(sound As Int, volume As Float)
sounds.Play(sound, volume, volume, 0, 0, 1)
End Sub

Private Sub CreateBrick(y As Int) As Brick
Dim brck As Brick
Dim bd As BitmapData
Dim size As Float = Rnd(15%x, 25%x)
Dim x As Float = Rnd(0, 100%x - size)
bd.DestRect.Initialize(x, y, x + size, y + 2%y)
gv.BitmapsData.Add(bd)
Dim animator As SpriteAnimator
animator.Initialize
animator.width = size
animator.height = 2%y
Dim r As Rect
Dim bmp As Bitmap
brck.Initialize(bd, animator)
If Rnd(1, 5) = 4 Then
'disappearing brick
bmp = disappearBrickImage
brck.disappearing = True
Else
bmp = regularBrickImage
End If
animator.SetFrames(bd, Array As Rect(r), Array As Bitmap(bmp))
bricks.Add(brck)
If Rnd(1, 5) = 4 Then animator.vx = PerXToCurrent(Rnd(-12, 12) / 10)
End Sub


'Create the stars background
Private Sub CreateBackground As BitmapData
'The background image is a wide image with random circles.
'To avoid creating a very large image the image is scaled down.
'Bitmaps larger than 2048x2048 (in any dimension) will not be drawn.
backgroundScale = 1dip
Dim bd As BitmapData
bd.Bitmap.InitializeMutable(100%x / backgroundScale, 100%y * 3 / backgroundScale) 'create a wide image
bd.srcRect.Initialize(0, 0, 100%x / backgroundScale, 100%y / backgroundScale)
bd.destRect.Initialize(0, 0, 100%x, 100%y)
Dim cvs As Canvas
cvs.Initialize2(bd.Bitmap)
For i = 1 To 200
cvs.DrawCircle(Rnd(0, bd.Bitmap.Width), _
Rnd(0, bd.Bitmap.Height - 100%y / backgroundScale), _
Rnd(1, 4), Colors.White, True, 0)
Next
Dim destRect As Rect
'Copy the first section of the image to the last section (to allow "endless" scrolling).
destRect.Initialize(0, 100%y * 2 / backgroundScale, bd.Bitmap.Width, 100%y * 3 / backgroundScale)
cvs.DrawBitmap(cvs.Bitmap, bd.SrcRect, destRect)
Return bd
End Sub



  评论这张
 
阅读(52)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017