Code archives/Graphics/Lens Flares
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
8 functions to create 8 different types of Lens flares. | |||||
;************************************************************************* ; ; lens flare creation lib [kinda] ; ; by elias_t ; ;************************************************************************* ;the radius of the flare rad=128;radius Graphics rad*2,rad*2,32,2 ;set the buffer to write to ;[the functions work on the locked buffer] buffer=FrontBuffer() SetBuffer buffer ;examples----------------------------------------------------------------- ;rad,disk effect,r,g,b sun1(rad,0,buffer,255,255,255) SaveBuffer (buffer,"1.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;radius,size[1-100],brightness# [0.01 to 1.0],r,g,b sun2(rad,100 ,0.99 ,buffer ,255,255,255) SaveBuffer (buffer,"2.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;rad , smooth outline [.95 - .99],r,g,b ring1(rad,.97,buffer ,255,255,255) SaveBuffer (buffer,"3.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;radius,inner dark radius[1-10] , smooth outline [.95 - .99],r,g,b ring2(rad ,10,.98,buffer ,255,255,255) SaveBuffer (buffer,"4.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;rad , smooth outline [.95 - .99],r,g,b ring3(rad,.98,buffer ,255,255,255) SaveBuffer (buffer,"5.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;rad , size of ring [.01 - .9] (optional[0/1]: for sizes<.9 th#=thickness=1-size# ,r,g,b) ring4(rad,.9, False ,buffer ,255,255,255) SaveBuffer (buffer,"6.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;rad, size [=length of strikes] ;,no, [0-1.0]=strike start from center , [0-256]=brigtness [,r1,g1,b1,r2,g2,b2,r3,g3,b3] ) strikes(rad, 5,50 ,1.0 ,5 ,buffer ,255,255,255 ,245,245,245 ,240,240,240) SaveBuffer (buffer,"7.bmp") WaitKey():Delay 100:Cls:FlushKeys() ;rad,size [=length of strikes] ;,type=1,2,3,4,5 [0-1.0]=strike start from center , [0-256]=brigtness [,r1,g1,b1,r2,g2,b2,r3,g3,b3] ) ;type 1=cross [4 strikes] ;type 2=cross rotated 45 degrees ;type 3=above 2 together ;type 4=20 strikes ;type 5=20 strikes random strikes2(rad, 5,3, 1.0 ,30 ,buffer ,255,255,255 ,255,255,255 ,255,255,255) SaveBuffer (buffer,"8.bmp") WaitKey() End ;************************************************************************* Function sun1(r#, d#=0.0 ,buffer ,r1=255,g1=255,b1=255 ) LockBuffer buffer d#=Abs(d#) If d#>1.0 Then d#=1.0 For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# c# = 1.0-ri#; c# = c#*c#; If (ri#>1.0) Then c#=0.0; If ri#>d# rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) EndIf WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* ;************************************************************************* Function sun2(r#,f=100 ,b#=1.0 ,buffer ,r1=255,g1=255,b1=255) LockBuffer buffer ;============================ f=Abs(f) b#=Abs(b#) If f>100 Then f=100 If f<2 Then f=2 f=101-f If b#>1.0 Then b#=1.0 If b#<.02 Then b#=.02 b#=1.01-b# ;=========================== For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# ri#=ri# - b# ri#=Abs(ri#) If ri#<b# Then ri# = b# c# = 1.0-ri#-b#; c# = c#^f; If (ri#>1.0-b#) Then c#=0.0; If c#<>0.0 Then c#=c#+c#*b# c#=c#+(c#*f ) If c#>1.0 Then c#=1.0 rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* Function ring1(r#,s#=.95 ,buffer ,r1=255,g1=255,b1=255) LockBuffer buffer s#=Abs(s#) If s#<.95 Then s#=.95 If s#>.99 Then s#=.99 For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# If ri#>s# And ri#<1.0 ri# = (ri#-s#) / (1.0-s#) j#=(ri#*ri#) * (3.0-2.0*ri#) c# = 1.0-j# Else c# = ri# EndIf If (ri#>0.99999) Then c#=0.0 rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* Function ring2(r#,f=2,s# ,buffer ,r1=255,g1=255,b1=255) LockBuffer buffer f=Abs(f) If f<1 Then f=1 If f>10 Then f=10 For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# If ri#>s# And ri#<1.0 ri# = (ri#-s#) / (1.0-s#) j#=(ri#*ri#) * (3.0-2.0*ri#) c# = 1.0-j# Else c# = ri# EndIf If (ri#>0.99999) Then c#=0.0 c#=c#^f rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* Function ring3(r# ,s# ,buffer ,r1=255,g1=255,b1=255) LockBuffer buffer For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# If ri#>s# And ri#<1.0 ri# = (ri#-s#) / (1.0-s#) j#=(ri#*ri#) * (3.0-2.0*ri#) c# = 1.0-j# Else c# = ri#*ri#; c# = c#*c#; c# = c#*c#*c#; EndIf If (ri#>0.99999) Then c#=0.0 rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* Function ring4(r#,siz#=.9,th# ,buffer ,r1=255,g1=255,b1=255) LockBuffer buffer siz#=Abs(siz#) If siz#<.01 Then siz#=.01 If siz#>.9 Then siz#=.9 If th#=True th#=(1.0-siz#) Else th#=.1 EndIf For x#=0 To r#*2 For y#=0 To r#*2 dx# =r#-x# dy# =r#-y# ri# = Sqr( dx#*dx# + dy#*dy# )/r# c# = 1-Abs(ri#-siz#)/th#; If (c# < 0) c# = 0; c# = c#*c#; c# = c#*c#; If (ri#>1.0) Then c#=0.0; rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16) WritePixelFast(x, y, rgb ,buffer) Next Next UnlockBuffer buffer End Function ;************************************************************************* ;************************************************************************* Function strikes(r#, siz,no , f#=1.0 , of#=20 ,buffer ,r1=255,g1=255,b1=255 ,r2=255,g2=255,b2=255 ,r3=255,g3=255,b3=255) LockBuffer buffer f#=Abs(f#) If f#>1.0 Then f#=1.0 of#=Abs(of#) If of#>r# Then of#=r# For k=1 To no SeedRnd MilliSecs()*Rand(k) angle# = Rand(-180.0 , 180.0) dx# = Cos(angle#) dy# = Sin(angle#) fx# = r# fy# = r# c#=1.0 d#=1.0 e#=1.0 count=of# For y# = -siz To siz For x# =-siz To siz count=count-1 If count<0 c#=c#-.009 d#=d#-.01 e#=e#-.015 EndIf If c#<0.0 Then c#=0.0 If d#<0.0 Then d#=0.0 If e#<0.0 Then e#=0.0 If fx#<r#*2 And fx#>0 And fy#<r#*2 And fy#>0 If c#<=f# And count<0 Then rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16); If count>0 Then rgb = c#*255 Or (c#*255 Shl 8) Or (c#*255 Shl 16); If c#>f# Then rgb=0; WritePixelFast(fx#, fy#, rgb ,buffer) If d#<=f# Then rgb = d#*b2 Or (d#*g2 Shl 8) Or (d#*r2 Shl 16); If d#>f#Then rgb = 0; t=ReadPixelFast(fx#, fy#-1) If t=-16777216 Or t=0 Then WritePixelFast(fx#, fy#-1, rgb ,buffer) t=ReadPixelFast(fx#-1, fy#) If t=-16777216 Or t=0 Then WritePixelFast(fx#-1, fy#, rgb ,buffer) If e#<=f# Then rgb = e#*b3 Or (e#*g3 Shl 8) Or (e#*r3 Shl 16); If e#>f# Then rgb = 0; t=ReadPixelFast(fx#-1, fy#-2) If t=-16777216 Or t=0 Then WritePixelFast(fx#-1, fy#-2, rgb ,buffer) t=ReadPixelFast(fx#-2, fy#-1) If t=-16777216 Or t=0 Then WritePixelFast(fx#-2, fy#-1, rgb ,buffer) EndIf fx# = fx#+dx# fy# = fy#+dy# Next Next Next UnlockBuffer buffer End Function ;************************************************************************* ;************************************************************************* Function strikes2(r#, siz,t, f#=1.0 , of#=20 ,buffer ,r1=255,g1=255,b1=255 ,r2=255,g2=255,b2=255 ,r3=255,g3=255,b3=255) LockBuffer buffer f#=Abs(f#) If f#>1.0 Then f#=1.0 of#=Abs(of#) If of#>r# Then of#=r# t=Abs(t):If t>5 Then t=5 If t=1 no=4:an=90:o=0 EndIf If t=2 no=4:an=90:o=45 EndIf If t=3 no=8:an=45:o=0 EndIf If t=4 no=20:an=18:o=0 EndIf If t=5 no=20:an=18:o=0 EndIf For k=1 To no SeedRnd MilliSecs()*Rand(k) If t=5 Then o=Rand(5,15) angle# = Float(k*an+o);Rand(-180.0 , 180.0) dx# = Cos(angle#) dy# = Sin(angle#) fx# = r# fy# = r# c#=1.0 d#=1.0 e#=1.0 count=of# For y# = -siz To siz For x# =-siz To siz count=count-1 If count<0 c#=c#-.009 d#=d#-.01 e#=e#-.015 EndIf If c#<0.0 Then c#=0.0 If d#<0.0 Then d#=0.0 If e#<0.0 Then e#=0.0 If fx#<r#*2 And fx#>0 And fy#<r#*2 And fy#>0 If c#<=f# And count<0 Then rgb = c#*b1 Or (c#*g1 Shl 8) Or (c#*r1 Shl 16); If count>0 Then rgb = c#*255 Or (c#*255 Shl 8) Or (c#*255 Shl 16); If c#>f# Then rgb=0; WritePixelFast(fx#, fy#, rgb ,buffer) If d#<=f# Then rgb = d#*b2 Or (d#*g2 Shl 8) Or (d#*r2 Shl 16); If d#>f#Then rgb = 0; t=ReadPixelFast(fx#, fy#-1) If t=-16777216 Or t=0 Then WritePixelFast(fx#, fy#-1, rgb ,buffer) t=ReadPixelFast(fx#-1, fy#) If t=-16777216 Or t=0 Then WritePixelFast(fx#-1, fy#, rgb ,buffer) If e#<=f# Then rgb = e#*b3 Or (e#*g3 Shl 8) Or (e#*r3 Shl 16); If e#>f# Then rgb = 0; t=ReadPixelFast(fx#-1, fy#-2) If t=-16777216 Or t=0 Then WritePixelFast(fx#-1, fy#-2, rgb ,buffer) t=ReadPixelFast(fx#-2, fy#-1) If t=-16777216 Or t=0 Then WritePixelFast(fx#-2, fy#-1, rgb ,buffer) EndIf fx# = fx#+dx# fy# = fy#+dy# Next Next Next UnlockBuffer buffer End Function ;************************************************************************* |
Comments
None.
Code Archives Forum