TMandelbrot

Last Update:	Tuesday, 21-Sep-1999 01:21:27 MEST
Last Visitor:	gw.roentgenanalytik.de using Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727) from here on 20.8.2008 9:10 (2100)
Important:	This page is no longer maintained since I moved to www.clackas.de. Please use the new pages.

This is an example of PAS2HTML written in Delphi by me.

{Component TMandelbrot
© 1997 Christian Lackas, delta@earthling.net
This component is a child of TImage. It draws
the Mandelbrotset so you can easily save it as
a BitMap using SaveToFile.
You can also zoom into the graph.
additional properties:
BackColor: Color of the background
EnableZoom: Enables the zoom into the graph
ForeColor: Color of the Mandelbrotset
MaxIteration: Maximum of iterations TMandelbrot
calculates to guess the result,
the higher this value the better
the picture but this will slowdown
the painting
MaxX,MaxY, : Definition set that is maped
MinX,MinY
additional methods: NONE
}
UNIT Mandelbrot;

INTERFACE

USES
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

TYPE
TMandelbrot = CLASS(TImage)
PRIVATE
{ Private-Deklarationen }
FMAX_ITERATION: Word; {Anzahl der Iterationen bis endlicher Wert angenommen wird}
FMinX,FMaxX,FMinY,FMaxY: Double; {Definitionsmenge}
FBackColor, FForeColor: TColor; {Hintergrund- und Zeichenfarbe}
bMarquee: Boolean; {Hilfsvariable fürs Lasso}
FEnableZoom: Boolean; {Ist das Bild zoombar?}
ptOrigin,ptMove: TPoint; {Position des Zoomfensters}
fClicked: Boolean;
PROCEDURE WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
PROCEDURE WMLButtonDown(var Msg: TWMLButtonDown); message WM_LButtonDown;
PROCEDURE WMLButtonUp(var Msg: TWMLButtonUp); message WM_LButtonUp;
PROCEDURE DoMouseMove(X, Y: Integer);
PROCEDURE DoMouseDown(X, Y: Integer);
PROCEDURE DoMouseUp(X, Y: Integer);
PROTECTED
{ Protected-Deklarationen }
FUNCTION CALC_PIXEL(CA,CBi:Double):Boolean;
PROCEDURE SetMaxX(rNew:Double);
PROCEDURE SetMaxY(rNew:Double);
PROCEDURE SetMinY(rNew:Double);
PROCEDURE SetMinX(rNew:Double);
PROCEDURE DrawMarquee( mStart, mStop : TPoint; AMode : TPenMode);
PROCEDURE SetForeColor(rNew:TColor);
PROCEDURE SetBackColor(rNew:TColor);
PUBLIC
{ Public-Deklarationen }
CONSTRUCTOR Create(AOwner: TComponent); override;
PROCEDURE Start; {Startet die Berechnung und gibt sie in TImage aus}
PUBLISHED
{ Published-Deklarationen }
PROPERTY MaxX: Double read FMaxX write SetMaxX;
PROPERTY MaxY: Double read FMaxY write SetMaxY;
PROPERTY MinX: Double read FMinX write SetMinX;
PROPERTY MinY: Double read FMinY write SetMinY;
PROPERTY MaxIteration: Word read FMAX_ITERATION write FMAX_ITERATION;
PROPERTY ForeColor: TColor read FForeColor write SetForeColor;
PROPERTY BackColor: TColor read FBackColor write SetBackColor;
PROPERTY EnableZoom: Boolean read FEnableZoom write FEnableZoom;
END;

PROCEDURE Register;

IMPLEMENTATION

CONSTRUCTOR TMandelbrot.Create(AOwner:TComponent);
BEGIN
INHERITED Create(AOwner);
Width:=100;
Height:=50;
FMaxX:=1.25;
FMinX:=-2;
FMinY:=-1.25;
FMaxY:=1.25;
FMax_ITERATION:=128;
FForeColor:=clRed;
FBackColor:=clBlack;
bMarquee:=False;
EnableZoom:=True;
Center:=True;
Stretch:=False;
AutoSize:=False;
Start;
END;

PROCEDURE TMandelbrot.WMLButtonDown(var Msg: TWMLButtonDown);
BEGIN
DoMouseDown(Msg.XPos,Msg.YPos);
INHERITED;
END;
PROCEDURE TMandelbrot.WMLButtonUp(var Msg: TWMLButtonUp);
BEGIN
DoMouseUp(Msg.XPos,Msg.YPos);
INHERITED;
END;
PROCEDURE TMandelbrot.WMMouseMove(var Msg: TWMMouseMove);
BEGIN
DoMouseMove(Msg.XPos,Msg.YPos);
INHERITED;
END;

PROCEDURE TMandelbrot.DoMouseDown(X, Y: Integer);
BEGIN
IF FEnableZoom THEN
BEGIN
bMarquee := True;
ptOrigin := Point( X, Y );
ptMove := Point( X, Y );
WITH Canvas DO
BEGIN
Pen.Color := clBlack;
Pen.Width := 1;
Pen.Style := psDash;
Brush.Style := bsClear;
END;
DrawMarquee(ptOrigin, ptMove, pmNotXor );
END;
END;

PROCEDURE TMandelbrot.DoMouseMove(X, Y: Integer);
BEGIN
IF bMarquee = True THEN
BEGIN
DrawMarquee(ptOrigin, ptMove, pmNotXor );
DrawMarquee(ptOrigin, Point( X, Y ), pmNotXor );
ptMove := Point( X, Y );
Canvas.Pen.Mode := pmCopy;
END;
END;

PROCEDURE TMandelbrot.DoMouseUp(X, Y: Integer);
VAR ax,ay: Integer;
bx,by: Integer;
BEGIN
IF bMarquee = True THEN
BEGIN
bMarquee := False;
DrawMarquee(ptOrigin, Point( X, Y ), pmNotXor );
ptMove := Point( X, Y );
IF ptOrigin.X<X THEN BEGIN ax:=ptOrigin.X; bx:=x END ELSE BEGIN ax:=X; bx:=ptOrigin.X; END;
IF ptOrigin.Y<Y THEN BEGIN aY:=ptOrigin.Y; bY:=Y END ELSE BEGIN ay:=Y; bY:=ptOrigin.Y; END;
MinX:=MinX+(MaxX-MinX)*aX/Width;
MinY:=MinY+(MaxY-MinY)*aY/Height;
MaxX:=MaxX-(Width-bX)*(MaxX-MinX)/Width;
MaxY:=MaxY-(Height-bY)*(MaxY-MinY)/Height;
Start;
END;
END;

PROCEDURE TMandelbrot.DrawMarquee( mStart, mStop : TPoint; AMode : TPenMode);
BEGIN
WITH Canvas DO
BEGIN
Pen.Mode := AMode;
Rectangle( mStart.X, mStart.Y, mStop.X, mStop.Y );
END;
END;

PROCEDURE TMandelbrot.SetForeColor(rNew:TColor);
VAR OldMaxIt: Word;
BEGIN
IF rNew<>FBackColor THEN
BEGIN
FForeColor:=rNew;
OldMaxIt:=FMAX_ITERATION;
FMAX_ITERATION:=10;
Start;
FMAX_ITERATION:=OldMaxIt;
END;
Refresh;
END;

PROCEDURE TMandelbrot.SetBackColor(rNew:TColor);
VAR OldMaxIt: Word;
BEGIN
IF rNew<>FForeColor THEN
BEGIN
FBackColor:=rNew;
OldMaxIt:=FMAX_ITERATION;
FMAX_ITERATION:=10;
Start;
FMAX_ITERATION:=OldMaxIt;
END;
Refresh;
END;

PROCEDURE TMandelbrot.SetMaxX(rNew: Double);
BEGIN
IF rNew>FMinX THEN FMaxX:=rNew;
Refresh;
END;

PROCEDURE TMandelbrot.SetMinX(rNew: Double);
BEGIN
IF rNew<FMaxX THEN FMinX:=rNew;
Refresh;
END;

PROCEDURE TMandelbrot.SetMaxY(rNew: Double);
BEGIN
IF rNew>FMinY THEN FMaxY:=rNew;
Refresh;
END;

PROCEDURE TMandelbrot.SetMinY(rNew: Double);
BEGIN
IF rNew<FMaxY THEN FMinY:=rNew;
Refresh;
END;

FUNCTION TMandelbrot.CALC_PIXEL(CA,CBi:Double):Boolean; {CA = real value, CBi = imaginary}
VAR
OLD_A :Double; {just a variable to keep 'a' from being destroyed}
ITERATION :Word; {the iteration-counter}
A,B :Double; {function Z divided in real and imaginary parts}
LENGTH_Z :Double; {length of Z, sqrt(length_z)>2 => Z->infinity}
BEGIN
A:=0; {initialize Z(0) = 0}
B:=0;
ITERATION:=0; {initialize iteration}
REPEAT
OLD_A:=A; {saves the 'a' (Will be destroyed in next line}
A:= A*A - B*B + CA;
B:= 2*OLD_A*B + CBi;
length_z:= a*a + b*b; {note: We do not perform the squareroot here}
INC(ITERATION);
UNTIL (length_z > 4) OR (iteration > Fmax_iteration);
Calc_Pixel:=length_z>4;
END;

PROCEDURE TMandelbrot.Start;
VAR dx, dy:Real;
x, y :INTEGER;
bmpImage: TBitMap;
BEGIN
bmpImage:=TBitMap.Create;
bmpImage.Height:=Height;
bmpImage.Width:=Width;
dx:= (MaxX-MinX)/Width;
dy:= (Maxy-MinY)/Height;
bmpImage.Canvas.Pen.Color:=FBackColor;
bmpImage.Canvas.Brush.Color:=FBackColor;
bmpImage.Canvas.Brush.Style:=bsSolid;
bmpImage.Canvas.Rectangle(0,0,Width,Height);
FOR y:=0 TO Height DO
FOR x:=0 TO Width DO
IF NOT CALC_PIXEL(MinX+x*dx, MinY+y*dy) THEN bmpImage.Canvas.Pixels[x,y]:=FForeColor;
Canvas.CopyMode:=cmSrcCopy;
{MessageDlg('MandelHeight ='+IntToStr(Height)+#10+
'ClipRect BR.Y='+IntToStr(Canvas.ClipRect.BottomRight.X)+#10+
'BMPHeight ='+IntToStr(bmpImage.Height),
mtInformation,[mbOk],0);}
Picture.BitMap:=bmpImage;
bmpImage.Free;
END;

PROCEDURE Register;
BEGIN
RegisterComponents('Delta', [TMandelbrot]);
END;

END.