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