| Last Update: |
|
| Last Visitor: |
|
| Visitors: |
|
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.
Copyright © 1997 Christian Lackas, delta@earthling.net