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

沉默蜂B4A安卓编程

国内资料最全的B4A资料库

 
 
 

日志

 
 

[例程]火焰  

2015-09-06 11:33:01|  分类: 图形图像 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
#Region Module Attributes
#FullScreen: True
#IncludeTitle: False
#ApplicationLabel: Colour Blaze
#VersionCode: 1
#VersionName: 1.0
#SupportedOrientations: portrait
#CanInstallToExternalStorage: False
#End Region

' Colour blaze - Jim Brown - v1.0
' NOTE: Uses the "Phone" library

Sub Process_Globals
Dim col As List
Dim rDir,gDir,bDir As Int
Dim time As Timer
Dim awake As PhoneWakeState
End Sub

Sub Globals
' display-related variables
Dim can As Canvas
Dim rec As Rect
Dim cx,cy As Int
End Sub

Sub Activity_Create(FirstTime As Boolean)
If FirstTime=True Then
' set inital colours
col.Initialize
For n=1 To 28
col.Add(Colors.RGB(n*2,0,n*4))
Next
rDir=Rnd(1,4) : gDir=Rnd(1,4) : bDir=Rnd(1,4)
End If
can.Initialize(Activity)
cx=Activity.Width : cy=Activity.Height
time.Initialize("Timer1",30)
End Sub

Sub Activity_Resume
time.Enabled=True
awake.KeepAlive(True)
End Sub

Sub Activity_Pause (UserClosed As Boolean)
time.Enabled=False
awake.ReleaseKeepAlive
End Sub

Sub Timer1_Tick
' update colors
col.RemoveAt(0)
Dim newcol As Int
newcol=col.Get(col.Size-1)
newcol=AdjustColor(newcol)
col.Add(newcol)
' render rects
Dim sx,sy,aspX,aspY As Float
aspX=(cx/2)/col.Size : aspY=(cy/2)/col.Size
sx=0 : sy=0
For i=0 To col.Size-1
rec.Initialize(sx,sy,cx-sx,cy-sy)
can.DrawRect(rec,col.Get(i),True,0)
sx=sx+aspX : sy=sy+aspY
Next
Activity.Invalidate
End Sub

Sub AdjustColor(Color As Int) As Int
    Dim r,g,b As Int
    ' a = Bit.UnsignedShiftRight(Bit.And(Color, 0xff000000), 24)
    r = Bit.UnsignedShiftRight(Bit.AND(Color, 0xff0000), 16)
    g = Bit.UnsignedShiftRight(Bit.AND(Color, 0xff00), 8)
    b = Bit.AND(Color, 0xff)
    r=r+rDir : g=g+gDir : b=b+bDir
If r<0 Then
r=0 : rDir=Rnd(8,30)
End If
If g<0 Then
g=0 : gDir=Rnd(8,30)
End If
If b<0 Then
b=0 : bDir=Rnd(8,30)
End If
If r>255 Then
r=255 : rDir=-Rnd(8,30)
End If
If g>255 Then
g=255 : gDir=-Rnd(8,30)
End If
If b>255 Then
b=255 : bDir=-Rnd(8,30)
End If
Return Colors.RGB(r,g,b)
End Sub
  评论这张
 
阅读(91)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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