Вот, в интернете нашлась интересная программа на
freebasic
, в которой реализован
эффект взрыва
. Даже, если быть точнее,
эффект феерверка
. Вот
листинг
программы:
'*****************************************
'******By Shendelyar Evgeniy - 2008 ******
'*****************************************
'********* Press Left Key Mouse **********
'*****************************************
screenres 640,480,32
Randomize timer
dim shared as single count
const as single gravity=.1,inten=90
Type Frag
dim as single x,y,xs,ys
dim as integer r,g,b
end type
dim shared as Frag f(100)
'*****************************************
Sub CreateFrags()
dim as Single anstep,an
dim as Integer x,y,but,k
count=int(RND(1)*inten)+1
anstep=360.0/count
an=int(RND(1)*anstep)+1
for k=1 to count
GetMouse(x,y,,but)
f(k).x=x
f(k).y=y
f(k).xs=cos(an)*(int(RND(1)*2)+3)
f(k).ys=sin(an)*(int(RND(1)*2)+3)
f(k).r=255:f(k).g=255:f(k).b=255
an=an+anstep
next k
end sub
'*****************************************
sub UpdateFrags()
dim as integer k
For k=1 to count
if (f(k).x<>-123) then
f(k).x=f(k).x+f(k).xs
f(k).y=f(k).y+f(k).ys
f(k).ys=f(k).ys+gravity
If ((f(k).x<0) Or (f(k).x>=640) Or (f(k).y>=480)) then
f(k).x=-123
ElseIf f(k).b>0 then
f(k).b=f(k).b-5
ElseIf f(k).g>0 then
f(k).g=f(k).g-3
ElseIf f(k).r>0 then
f(k).r=f(k).r-1
If f(k).r=0 Then f(k).x=-123
EndIf
endif
Next
End sub
'*****************************************
Sub RenderFrags()
dim as integer k
For k=1 to count
if (f(k).x<>-123) then
Line (f(k).x-1,f(k).y-1)-(f(k).x+3,f(k).y+3),rgb(f(k).r,f(k).g,f(k).b),bf
endif
Next
End sub
'*****************************************
dim as integer x,y,but,rez
While Not Multikey( 1 )
UpdateFrags()
Cls
GetMouse(x,y,,but)
If but and 1 then
CreateFrags()
Else
EndIf
RenderFrags()
Flip
sleep(1)
Wend
'*****************************************
При нажатии левой кнопки мышки, на месте стрелки курсора вспыхивают, и разлетаются в разные стороны искры, как на рисунке ниже.
Так же можно скачать эту программу:
скачать программу
эффект взрыва
(размер:1.3кб)
Ссылка на эту страницу:
как вернуть любимого
Добавить сайт freebasic в избранное
Сделать Freebasic стартовой
