Title: Animated blobs effect
Question: This is a piece of code I found on the internet by an unknown author. I revamped the code (made it readable) and encapsuated it into a object.
The code is fairly fast and can be used for medium sized windows.
Answer:
Usage:
Create object. Your bitmap will be converted to 8bit (to increase speed).
ASize: Size of blobs. Select a large number (50000 for example).
Set up a TTimer. For each onTimer() call Animate.
Also, remember to refresh the bitmap.
Enjoy.
unit blobs;
{ ------------------------------------------------------------------------- }
interface
{ ------------------------------------------------------------------------- }
uses
graphics, windows;
type
PScanLine = ^TScanLine;
TScanLine = array[0..65535] of byte;
TBlobs = class
private
fFrame : cardinal;
fDrawing : boolean;
fBlobs : array[0..5] of TPoint;
fBitmap : graphics.TBitmap;
fXOfs : integer;
fYOfs : integer;
fXSeed : integer;
fYSeed : integer;
fSize : integer;
procedure SetupBlobs;
public
constructor Create( ABitmap : graphics.TBitmap; ASize : integer );
procedure Animate;
end;
{ ------------------------------------------------------------------------- }
implementation
{ ------------------------------------------------------------------------- }
constructor TBlobs.Create( ABitmap : graphics.TBitmap; ASize : integer );
begin
fBitmap := ABitmap;
fFrame := 0;
fSize := ASize;
fDrawing := FALSE;
fXOfs := fBitmap.Width div 2;
fYOfs := fBitmap.Height div 2;
fXSeed := fXOfs - 10;
fYSeed := fYOfs - 10;
SetupBlobs;
end;
{ ------------------------------------------------------------------------- }
procedure TBlobs.SetupBlobs;
var
i : integer;
pal : PLogPalette;
hpal : HPALETTE;
begin
fBitmap.PixelFormat := pf8bit;
pal := nil;
try
GetMem( pal, sizeof( TLogPalette ) + sizeof(TPaletteEntry) * 255 );
pal.palVersion := $300;
pal.palNumEntries := 256;
for i := 0 to 255 do
begin
pal.palPalEntry[i].peRed := 255-i;
pal.palPalEntry[i].peGreen := 255-i;
pal.palPalEntry[i].peBlue := 128-i;
pal.palPalEntry[i].peFlags := PC_RESERVED;
end;
hpal := CreatePalette( pal^ );
if hpal 0 then
fBitmap.Palette := hpal;
finally
FreeMem( pal );
end;
end;
{ ------------------------------------------------------------------------- }
procedure TBlobs.Animate;
var
x, y, i : integer;
Value, t : integer;
Scan : PScanLine;
begin
inc(fFrame);
if fDrawing = FALSE then
begin
fBlobs[0].x := fXOfs + round( fXSeed * SIN( (2 * fFrame) *
0.01745329252222 ) );
fBlobs[0].y := fYOfs + round( fYSeed * SIN( (4 * fFrame) *
0.01745329252222 ) );
fBlobs[1].x := fXOfs + round( fXSeed * SIN( (6 * fFrame) *
0.01745329252222 ) );
fBlobs[1].y := fYOfs + round( fYSeed * SIN( (3 * fFrame) *
0.01745329252222 ) );
fBlobs[2].x := fXOfs + round( fXSeed * SIN( (7 * fFrame) *
0.01745329252222 ) );
fBlobs[2].y := fYOfs + round( fYSeed * SIN( (5 * fFrame) *
0.01745329252222 ) );
fBlobs[3].x := fXOfs + round( fXSeed * SIN( (3 * fFrame) *
0.01745329252222 ) );
fBlobs[3].y := fYOfs + round( fYSeed * SIN( (2 * fFrame) *
0.01745329252222 ) );
fBlobs[4].x := fXOfs + round( fXSeed * SIN( (4 * fFrame) *
0.01745329252222 ) );
fBlobs[4].y := fYOfs + round( fYSeed * SIN( (2 * fFrame) *
0.01745329252222 ) );
fBlobs[5].x := fXOfs + round( fXSeed * SIN( (2 * fFrame) *
0.01745329252222 ) );
fBlobs[5].y := fYOfs + round( fYSeed * SIN( (3 * fFrame) *
0.01745329252222 ) );
fDrawing := True;
try
For y := 0 to fBitmap.Height-1 do
begin
Scan := PScanLine( fBitmap.ScanLine[y] );
for x := 0 to fBitmap.Width-1 do
begin
t := 0;
For i := 0 to 5 do
begin
value := ( fBlobs[i].x - x ) * ( fBlobs[i].x - x );
value := value + ( fBlobs[i].y - y ) * ( fBlobs[i].y - y );
if value value := 1;
t := t + ( fSize div value );
end;
t := 255 - t;
if t t := 0;
Scan[x] := t;
end;
end;
except
end;
fDrawing := false;
end;
end;
end.