[Страдалецъ]

В общем сам процесс слияния и увеличения радиуса пузыря засчет слияния площадей я вроде сделал, но теперь надо артефакты устранять.
Добавил еще плавный разогрев/остывание плитки.

Код:

unit Unit27;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms,
  ExtCtrls, Buttons, StdCtrls, ComCtrls, Controls;

type
  TBubble = class
   Size,MaxSize: Integer;
   Pos: TPoint;
   constructor Create;
   procedure PullUp;
   procedure Paint;
   procedure Free;
  end;

  TForm27 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    BubbleTimer: TTimer;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    HotTimer: TTimer;
    Label2: TLabel;
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BubbleTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure HotTimerTimer(Sender: TObject);
  private
    ABubbles: Array of TBubble;
    HotColor: Byte;
  end;

Const H = 400;
      W = 400;
      D = 10;
      PX = 50;
      PY = 50;
      T = 1;
      R = 25;
var
  Form27: TForm27;

implementation

{$R *.dfm}

procedure TForm27.Button1Click(Sender: TObject);
begin
 if Button1.Caption = 'Выкл.'
 then begin
      PaintBox1.Canvas.Brush.Color := clBlack;
      Button1.Caption := 'Вкл.';
      TrackBar1.Position := 20;
      HotColor := 150;
      end
 else begin
      Button1.Caption := 'Выкл.';
      TrackBar1.Position := 100;
      end;
end;

procedure TForm27.FormCreate(Sender: TObject);
begin
 SetLength(ABubbles, 0);
end;

procedure TForm27.HotTimerTimer(Sender: TObject);
begin
 if TrackBar1.SelEnd > TrackBar1.Position
 then begin
      TrackBar1.SelEnd := TrackBar1.SelEnd - 1;
      Dec(HotColor,1);
      end
 else begin
      TrackBar1.SelEnd := TrackBar1.SelEnd + 1;
      Inc(HotColor,3);
      end;
 PaintBox1.Canvas.Brush.Color := RGB(HotColor,0,0);
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D));
 if TrackBar1.Position = TrackBar1.SelEnd
 then HotTimer.Enabled := False;
 Label2.Caption := IntToStr(TrackBar1.SelEnd)+#$B0;
end;

procedure TForm27.PaintBox1Paint(Sender: TObject);
begin
 // Кастрюлька
 PaintBox1.Canvas.Pen.Width := T;
 PaintBox1.Canvas.Pen.Color := clBlack;
 PaintBox1.Canvas.MoveTo(PX,PY);
 PaintBox1.Canvas.LineTo(PX+D,PY+D);
 PaintBox1.Canvas.LineTo(PX+D,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+H+2*D);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+2*D);
 PaintBox1.Canvas.LineTo(PX+3*D+W,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+3*D+W,PY+D);
 PaintBox1.Canvas.LineTo(PX+4*D+W,PY);

 PaintBox1.Canvas.LineTo(PX+3*D+W,PY);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+D);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+D);
 PaintBox1.Canvas.LineTo(PX+D,PY);
 PaintBox1.Canvas.LineTo(PX,PY);

 PaintBox1.Canvas.Brush.Style := bsBDiagonal;
 PaintBox1.Canvas.Brush.Color := clRed;
 PaintBox1.Canvas.FloodFill(PX+D+T+1,PY+D,clBlack,fsBorder);
 // Жидкость
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.Brush.Color := clAqua;
 PaintBox1.Canvas.FillRect(Rect(PX+2*D+T,PY+3*D-T,PX+W+2*D,PY+H+D));
 // Плитка
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.Brush.Color := clBlack;
 PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D));
end;

procedure TForm27.TrackBar1Change(Sender: TObject);
begin
 HotTimer.Enabled := True;
end;

procedure TForm27.BubbleTimerTimer(Sender: TObject);
Var i,j,n,m: Integer;
    B0,B1,B2: TRect;
begin
 Randomize;
 for i := 0 to Length(ABubbles)-1
 do ABubbles[i].PullUp;
 if TrackBar1.SelEnd > 40
 then case Random(TrackBar1.Max - TrackBar1.SelEnd)
      of 0: begin
            SetLength(ABubbles, Length(ABubbles)+1);
            ABubbles[High(ABubbles)] := TBubble.Create;
            ABubbles[High(ABubbles)].Pos := Point(PX+2*D+Random(W-R),PY+H+D);
            ABubbles[High(ABubbles)].Paint;
            end;
      end;

 i := 0;
 while i <= Length(ABubbles)-1
 do begin
    if ABubbles[i].Pos.Y < PX+2*D+T+R
    then begin
         ABubbles[i].Free;
         for n := i+1 to Length(ABubbles)-1
         do ABubbles[n-1] := ABubbles[n];
         SetLength(ABubbles,Length(ABubbles)-1);
         end;

    n := 0;
    while n <= Length(ABubbles)-2
    do begin
       with ABubbles[n]
       do B1 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1);
       m := n+1;
       while m <= Length(ABubbles)-1
       do begin
          with ABubbles[m]
          do B2 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1);
          if IntersectRect(B0,B1,B2)
          then begin
               if ABubbles[n].Size >= ABubbles[m].Size
               then begin
                    ABubbles[m].Free;
                    for j := m+1 to Length(ABubbles)-1
                    do ABubbles[j-1] := ABubbles[j];
                    SetLength(ABubbles,Length(ABubbles)-1);
                    ABubbles[n].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi));
                    end
               else begin
                    ABubbles[n].Free;
                    for j := n+1 to Length(ABubbles)-1
                    do ABubbles[j-1] := ABubbles[j];
                    SetLength(ABubbles,Length(ABubbles)-1);
                    ABubbles[m].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi));
                    end;
               end;
          Inc(m);
          end;
       Inc(n);
       end;
    Inc(i);
    end;
 Label1.Caption := Format('Напузыряли: %d',[Length(ABubbles)]);
end;

constructor TBubble.Create;
begin
 Size := 0;
 MaxSize := R;
 inherited;
end;

procedure TBubble.Free;
begin
 Paint;
 inherited;
end;

procedure TBubble.Paint;
begin
 Form27.PaintBox1.Canvas.Pen.Width := 1;
 Form27.PaintBox1.Canvas.Pen.Mode := pmXor;
 Form27.PaintBox1.Canvas.Pen.Color := clRed;
 Form27.PaintBox1.Canvas.Brush.Style := bsClear;
 Form27.PaintBox1.Canvas.Ellipse(Pos.X,Pos.Y-Size,Pos.X+Size,Pos.Y);
end;

procedure TBubble.PullUp;
begin
 Paint;
 Dec(Pos.Y,2);
 if Size < MaxSize then Inc(Size);
 if Size < MaxSize then Inc(Size);
 Paint;
end;

end.