54 lines
1.3 KiB
ObjectPascal
54 lines
1.3 KiB
ObjectPascal
const
|
|
SIZE = 256;
|
|
NUM_PARTICLES = 1000;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
type
|
|
TByteArray = array[0..0] of Byte;
|
|
PByteArray = ^TByteArray;
|
|
var
|
|
B: TBitmap;
|
|
I: Integer;
|
|
P, D: TPoint;
|
|
begin
|
|
Randomize;
|
|
B := TBitmap.Create;
|
|
try
|
|
B.Width := SIZE;
|
|
B.Height := SIZE;
|
|
B.PixelFormat := pf8bit;
|
|
|
|
B.Canvas.Brush.Color := clBlack;
|
|
B.Canvas.FillRect(B.Canvas.ClipRect);
|
|
B.Canvas.Pixels[Random(SIZE), Random(SIZE)] := clWhite;
|
|
|
|
For I := 0 to NUM_PARTICLES - 1 do
|
|
Begin
|
|
P.X := Random(SIZE);
|
|
P.Y := Random(SIZE);
|
|
|
|
While true do
|
|
Begin
|
|
D.X := Random(3) - 1;
|
|
D.Y := Random(3) - 1;
|
|
Inc(P.X, D.X);
|
|
Inc(P.Y, D.Y);
|
|
|
|
If ((P.X or P.Y) < 0) or (P.X >= SIZE) or (P.Y >= SIZE) Then
|
|
Begin
|
|
P.X := Random(SIZE);
|
|
P.Y := Random(SIZE);
|
|
end
|
|
else if PByteArray(B.ScanLine[P.Y])^[P.X] <> 0 then
|
|
begin
|
|
PByteArray(B.ScanLine[P.Y-D.Y])^[P.X-D.X] := $FF;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Canvas.Draw(0, 0, B);
|
|
finally
|
|
FreeAndNil(B);
|
|
end;
|
|
end;
|