Draw Particel Flames

const MaxX = 520;
      MaxY = 520;
      NF   = 16;



type FireBall = Record
                 dx    : Integer;
                 dy    : Integer;
                 incx  : Integer;
                 incy  : Integer;
                 Count : Extended;
                 Incer : Extended;
                 xfac  : Integer;
                 yfac  : Integer;
                 xinc  : Integer;
                 yinc  : Integer;
End;

public
  { Public declarations }
    Col          : Array[0..1515] Of TColor;
    Mat          : Array[-5..MaxX+5,-5..MaxY+5] Of Integer;
    FBall        : Array[0..NF] Of FireBall;
    DoFlame      : Boolean;
    DoFireBalls  : Boolean;
    DoRandFlames : Boolean;
    FlameCnt     : Integer;
    First        : Boolean;
    Procedure SetupColors;
    Procedure SetupPalette;
    Procedure DoFlameSweep;
    Procedure Circle(x,y,r:Integer);
    Procedure DoBall2(N:Integer);
    Procedure SetupFireBalls;
    Function GetPixelAv2(x,y:Integer):Integer;
    Function Distance(x1,y1,x2,y2:Integer):Integer;
    Function XComp(t:Extended):Extended;
    Function YComp(t:Extended):Extended;
  end;
  
  //
  
  // In die ComboBox kommen zwei Einträge
Function TForm1.XComp(t:Extended):Extended;
Begin
 If ComboBox1.ItemIndex = 0 Then Result:=sin(3/4*t)
  Else
   If ComboBox1.ItemIndex = 1 Then Result:=cos(t)
    Else
     Result := 0;
End;

Function TForm1.YComp(t:Extended):Extended;
Begin
 If ComboBox1.ItemIndex = 0 Then Result:=sin(4/4*t)
  Else
   If ComboBox1.ItemIndex = 1 Then Result:=sin(t)
    Else
     Result := 0;
End;

Procedure TForm1.SetupColors;
Var x,y:Integer;
Begin
 Randomize;
 For x:= -5 to MaxX+5 Do
  For y:= -5 to MaxY+5 Do Mat[x,y]:=0;

 For x:= 0 To MaxX Do
  Begin
   Mat[x,MaxY]:=127;
   Mat[x,MaxY-1]:=127;
   Mat[x,MaxY-2]:=127;
  End;

 SetupPalette;
 SetUpFireBalls;
End;

Procedure TForm1.SetupPalette;
Var I:Integer;
Begin
 For I:= 1 to 32 Do
  Begin
   Col[I]    := 4+(i-1)*8;
   Col[I+32] := 1276+(i+32-1)*2048;
   Col[I+64] := 326908+(i+64-1)*524288;
   Col[I+96] := 16579836;
   Col[I+128]:= 16579836;
   Col[I+160]:= 16579836;
   Col[I+192]:= 16579836;
   Col[I+224]:= 16579836;
   Col[I+256]:= 16579836;
   Col[I+288]:= 16579836;
   Col[I+320]:= 16579836;
   Col[I+352]:= 16579836;
   Col[I+384]:= 326908+(i+64-1)*524288;
   Col[I+416]:= 326908+(i+64-1)*524288;
   Col[I+448]:= 326908+(i+64-1)*524288;
   Col[I+480]:= 326908+(i+64-1)*524288;
  End;
End;

Function TForm1.GetPixelAv2(x,y:Integer):Integer;
 Begin
   Result:=((Mat[x,y-1]+
             Mat[x-1,y]+
             Mat[x+1,y]+
             Mat[x,y+1]+
             Mat[x-2,y]+
             Mat[x+2,y]+
             Mat[x,y+2]+
             Mat[x,y-2]+
             Mat[x-1,y+1]+
             Mat[x+1,y+1]+
             Mat[x-1,y-1]+
             Mat[x+1,y-1]) Div 12);
End;

Procedure TForm1.SetupFireBalls;
Var I:Integer;
Begin
 Randomize;
 For I:= 1 to NF do
  With FBall[I] Do
   Begin
    dx:=Random(maxx-16)+8;
    dy:=6;
    If random(1) = 0 then incx:=-(random(3))
     Else incx:=random(3);
    incy:=random(3)+1;
    If ComboBox1.ItemIndex = 0 Then Count:=(I-1)*60;
    If ComboBox1.ItemIndex = 1 Then Count:=(I-1)*((360/NF)*90/120);
    Incer:=0.032;
    xfac:=135;
    yfac:=135;
    xinc:=-2;
    yinc:=-2;
   End;
End;

Function TForm1.Distance(x1,y1,x2,y2:Integer):Integer;
Begin
 Result := Round(Sqrt(sqr(x1+x2)+sqr(y1+y2)));
End;

Function cxcom(t:Extended):Extended;
Begin
 Result:=cos(t);
End;

Function cycom(t:Extended):Extended;
Begin
 Result:=sin(t);
End;

Procedure TForm1.Circle(x,y,r:Integer);
Var rx,ry:Integer;
    i:Integer;
Begin
 For I:= 1 to 360 Do
  Begin
   rx:=Round(r*cxcom(i))+x;
   ry:=Round(r*cycom(i))+y;
   Mat[rx,ry]:=Random(40)+100;
  end;
End;

Procedure TForm1.DoBall2(N:Integer);
Var I :Integer;
Begin
 Randomize;
 With FBall[N] Do
  Begin
   If ComboBox1.ItemIndex = 0 Then
    Begin
     dx:=Round(xcomp(count)*185)+(MaxX Div 2);
     dy:=Round(ycomp(count)*185)+(MaxY Div 2);
    End;

   If ComboBox1.ItemIndex = 1 Then
    Begin
     dx:=Round(xcomp(count)*xfac)+(MaxX Div 2);
     dy:=Round(ycomp(count)*yfac)+(MaxY Div 2);
    End;

   Count:=Count+Incer;

   If (xfac < 10) Or (xfac > 235) Then xinc:=-xinc;
   If (yfac < 10) Or (yfac > 235) Then yinc:=-yinc;
   xfac:=xfac+xinc;
   yfac:=yfac+yinc;

   For I:= 1 to 8 Do  Circle(dx,dy,I);

  End;
End;

Procedure TForm1.DoFlameSweep;
Var x,y:Integer;
    c:Integer;
Begin
 Randomize;
 With PaintBox1.Canvas Do
  Begin
   For x:= 0 to MaxX  Do
     For y:= 2 to MaxY Do
      If Mat[x,y] > 3 Then
       Begin
        C:=GetPixelAv2(x,y);
        Mat[x,y]   := (((C Shr 12) ) mod 256 + C);
        Pixels[x,y]:= Col[Mat[x,y]];
       End;
  End;
 Inc(FlameCnt);
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
 SetupColors;
 DoFlame:=True;
 DoFireBalls:=True;
 FlameCnt:=0;
 First:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var N:Integer;
begin
 If First Then
  Begin
   PaintBox1.Canvas.Brush.Color:=clBlack;
   PaintBox1.Canvas.Rectangle(PaintBox1.Canvas.Cliprect);
   First:=False;
  End;
 If DoFlame Then DoFlameSweep;
 If FlameCnt Mod 70  = 0 Then SetupPalette;
 If (DoFireBalls) Then
  For N:= 1 to NF do DoBall2(N);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 If CheckBox1.Checked Then
  Begin
   DoFireBalls:=True;
   SetUpFireBalls;
  End
  Else
   DoFireBalls:=False;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 PaintBox1.Canvas.Brush.Color:=clBlack;
 PaintBox1.Canvas.Rectangle(PaintBox1.Canvas.Cliprect);
 If DoFlame Then DoFlameSweep;
end;