Эффекты взрыва

Привет всем, решил выложить небольшой код:
Может кому пригодится для общественных дел

Код:

'*****************************************
'******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
'*****************************************

И вот несколько видоизмененный, но нужно еще кинуть картинку размером 24х24 вместе с файлом

Код:

'*****************************************
'******By Shendelyar Evgeniy - 2008 ******
'*****************************************
'********* Press Left Key Mouse **********
'*****************************************
screenres 640,480,32
Randomize timer
color ,RGB(255,255,255)
dim shared as single count
const as single gravity=0,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)
dim shared image as any ptr
image= ImageCreate(24,24,32)
bload "data/bbomb.bmp",image

'*****************************************
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)*5'*(int(RND(1)*2)+3)
    f(k).ys=sin(an)*5'*(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
        put(f(k).x,f(k).y),image 
      '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


Thanks

Нашел его в архиве "All Basic Code":

Для компиляции нужно использовать опцию -lang deprecated или qb

Код:

'**********************************************
' Description : Explosions - VGA mode 13 special effect
' Written by  : Andrew L. Ayers
' Date        : 10/22/96
'
' The name says it all!
'
' You may use this routine in any manner you like, as long
' as you give credit in an appropriate manner. Have phun!
'
SCREEN 13
'
' Set up arrays for our explosion data
'
DIM x(50), y(50), xv(50), yv(50), ox(50), oy(50)
dim dir1
'
DO
  '
  ' Initialize an explosion
  '
  FOR t% = 0 TO 50
    x(t%) = 0
    y(t%) = 0
    dir1 = RND * 6.28: vel = INT(RND * 5) + 1
    xv(t%) = SIN(dir1) * vel
    yv(t%) = COS(dir1) * vel
  NEXT t%
  '
  ' Initialize offsets and color
  '
  tx% = INT(RND * 320)
  ty% = INT(RND * 200)
  c% = 31: done% = 0
  '
  ' Print the title
  '
  LOCATE 1, 6: PRINT "Explosions by Andrew L. Ayers"
  LOCATE 23, 8: PRINT "Press any key to exit demo"
  '
  ' Explode!
  '
  DO
    '
    ' Move all the pieces
    '
    FOR t% = 0 TO 50
      '
      ' Erase an old piece
      '
      LINE (ox(t%) + tx%, oy(t%) + ty%)-(x(t%) + tx%, y(t%) + ty%), 0
      ox(t%) = x(t%): oy(t%) = y(t%)
      '
      ' Move the piece
      '
      x(t%) = x(t%) + xv(t%)
      y(t%) = y(t%) + yv(t%)
      '
      ' Draw it at new position
      '
      LINE -(x(t%) + tx%, y(t%) + ty%), c%
      '
    NEXT
    '
    ' Decrement color to "fade"
    '
    c% = c% - 1: IF c% < 16 THEN done% = 1 ' Do another explosion if done
    '
    IF INKEY$ <> "" THEN done% = 2 ' Exit on any key press
    '
  ' FOR dlay = 1 TO 5000: NEXT dlay ' Change to suit your machine
    sleep 30'
  LOOP UNTIL done%
 
LOOP UNTIL done% = 2
'
CLS
'*****************************