Home > Programming > Fractals > Mandel |
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 Mandel2(ABitmap: TBitmap);
var
tymax,txmax,x,y,count,maxcount : integer;
xscale,yscale,lleft,ttop,xside,yside,zx,zy,tempx,cx,cy:double;
tx,ty : double;
Rect : TRect;
MaxX,
MaxY : integer;
xValue,
yValue :integer;
curColor : TColorRef;
colorLimit : 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;
lleft:=-1.85;
ttop:=1.25;
xside:=2.5;
yside:=-2.5;
xscale:=xside/MaxX;
yscale:=yside/MaxY;
MAXCOUNT:=15;
y:=0;
tymax:=(MaxY div 2);
txmax:=MaxX-2;
colorLimit := -1;
repeat
inc(y);
x:=0;
while x<=txmax do
begin
inc(x);
cx:=x*xscale+lleft;
cy:=y*yscale+ttop;
zx:=0;
zy:=0;
count:=0;
tx:=0;
ty:=0;
repeat
tempx:=tx-ty+cx;
zy:=2*zx*zy+cy;
zx:=tempx;
tx:=sqr(zx);
ty:=sqr(zy);
inc(count);
until (tx+ty>2.82) or (count=MAXCOUNT);
if count>colorLimit
then
begin
curColor :=
GetRGBColor(count-1);
xValue := x+Left;
yValue := y + top;
ABitmap.Canvas.Pixels[xValue,yValue]
:= curcolor;
ABitmap.Canvas.Pixels[xValue,bottom
- y] := curcolor;
end;
end;
until y>=tymax;
end;
end;
////////////////////////////////////////////////////////////////////////////////
� 2004 Jim Valavanis