const
   escape=4.0;                { escape value }
   attract=0.0001;            { attractor sensitivity }

const
   Black        = 0;
   Blue         = 1;
   Green        = 2;
   Cyan         = 3;
   Red          = 4;
   Magenta      = 5;
   Brown        = 6;
   LightGray    = 7;
   DarkGray     = 8;
   LightBlue    = 9;
   LightGreen   =10;
   LightCyan    =11;
   LightRed     =12;
   LightMagenta =13;
   Yellow       =14;
   White        =15;

function GetRGBColor(color:byte):longint;
begin
  case Color of
    black : GetRGBColor := RGB(0,0,0);
    blue  : GetRGBColor := RGB(0,0,128);
    green : GetRGBColor := RGB(0,128,0);
    cyan  : GetRGBColor := RGB(0,255,255);
    red   : GetRGBColor := RGB(128,0,0);
    magenta : GetRGBColor := RGB(128,0,128);
    brown : GetRGBColor := RGB(128,128,0);
    lightgray : GetRGBColor := RGB(192,192,192);
    darkgray : GetRGBColor := RGB(128,128,128);
    lightBlue : GetRGBColor := RGB(0,0,255);
    lightGreen : GetRGBColor := RGB(0,255,0);
    lightcyan : GetRGBColor := RGB(0,255,255);
    lightRed : GetRGBColor := RGB(255,0,0);
    lightmagenta : GetRGBColor := RGB(255,0,255);
    yellow: GetRGBColor := RGB(255,255,0);
    white : GetRGBColor := RGB(255,255,255);
  else
    GetRGBColor := RGB(0,0,255);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure Carpet(ABitmap: TBitmap);
{ compute and display Sierpinski carpet
  using Michael Barnsley's IFS algorithm
}
var
   x, y      : double;          { pixel coordinates }
   i         : integer;       { loop counters}
   k         : integer;       { row selector }
   d         : array[1..8,1..6] of double; { holds data of IFS attractor }
   Rect      : TRect;
   Multiplier : double;
   Iterations : word;
   MaxX,
   MaxY : integer;
   CurColor : TColorRef;
   xValue,
   yValue   : integer;
begin
  SetRect(Rect, 0, 0, ABitmap.Width, ABitmap.Height);
  with Rect do
  begin
    MaxX := right - left;
    MaxY := bottom - top;     { find maximum Y coordinate }
    if (MaxX=0) or (MaxY=0) then exit;
    MaxY := Max(MaxX,MaxY);
    bottom := top + MaxY;
    right  := left + MaxY;
{ initialize IFS data array }

    d[1,1]:=0.33; d[1,2]:=0; d[1,3]:=0; d[1,4]:=0.33; d[1,5]:=1;  d[1,6]:=1;
    d[2,1]:=0.33; d[2,2]:=0; d[2,3]:=0; d[2,4]:=0.33; d[2,5]:=MaxY; d[2,6]:=1;
    d[3,1]:=0.33; d[3,2]:=0; d[3,3]:=0; d[3,4]:=0.33; d[3,5]:=1;  d[3,6]:=MaxY;
    d[4,1]:=0.33; d[4,2]:=0; d[4,3]:=0; d[4,4]:=0.33; d[4,5]:=MaxY; d[4,6]:=MaxY;
    d[5,1]:=0.33; d[5,2]:=0; d[5,3]:=0; d[5,4]:=0.33; d[5,5]:=MaxY div 2; d[5,6]:=1;
    d[6,1]:=0.33; d[6,2]:=0; d[6,3]:=0; d[6,4]:=0.33; d[6,5]:=MaxY; d[6,6]:=MaxY div 2;
    d[7,1]:=0.33; d[7,2]:=0; d[7,3]:=0; d[7,4]:=0.33; d[7,5]:=1;  d[7,6]:=MaxY div 2;
    d[8,1]:=0.33; d[8,2]:=0; d[8,3]:=0; d[8,4]:=0.33; d[8,5]:=MaxY div 2; d[8,6]:=MaxY;

    x := 0;               {set starting coordinates}
    y := 0;

    Iterations := MaxY * 50;
    Multiplier := 2/3;

    for i := 1 to 10 do                     { skip first 10 iterations }
    begin
      k := random(8) + 1;                   { pick random row }
      x := d[k,1]*x + d[k,2]*y + d[k,5];   { transform coordinates }
      y := d[k,3]*x + d[k,4]*y + d[k,6];
    end;

    for i := 11 to Iterations do
    begin
      k := random(8) + 1;                   { pick random row }
      x := d[k,1]*x + d[k,2]*y + d[k,5];   { transform coordinates }
      y := d[k,3]*x + d[k,4]*y + d[k,6];
      CurColor := GetRGBColor( random(15)+ 1 );
      xValue := round(x*Multiplier)+Left;
      yValue := round(y*Multiplier);
      ABitmap.Canvas.Pixels[xValue,yValue+top] := curColor;
      ABitmap.Canvas.Pixels[xValue,bottom-yValue] := curColor;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////



� 2004 Jim Valavanis