Nadesłany przez Tomasz Lubiński, 16 stycznia 2009 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Fraktale - plonacy statek - Delphi/Burning_Ship.pas:
// Fraktale - plonacy statek - Michael Michelitsch, Otto E. Rössler
// www.algorytm.org
// Tomasz Lubinski (c) 2008
unit Burning_Ship;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Math;
type
TForm1 = class(TForm)
Fractal: TImage;
Label1: TLabel;
Label2: TLabel;
Selection: TShape;
Label3: TLabel;
minx: TEdit;
maxx: TEdit;
miny: TEdit;
maxy: TEdit;
Button1: TButton;
Label6: TLabel;
Label5: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FractalMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FractalMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FractalMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
//type for complex numbers
type complex_t = record
real: Extended;
imaginary: Extended;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
//---------------------------------------------------------------------------
//Describes places to render
ratioX, ratioY :Extended;
min_X, min_Y, max_X, max_Y :Extended;
downX, downY: Integer;
//colors
colors: array[1..120] of TColor;
//---------------------------------------------------------------------------
//for HSV colors
procedure hsv2rgb(hue: double; sat: double; val: double; var red: double; var grn: double; var blu: double);
var
i, f, p, q, t: double;
begin
red := 0;
grn := 0;
blu := 0;
if val=0 then
begin
red := 0;
grn := 0;
blu := 0;
end
else
begin
hue := hue/60;
i := floor(hue);
f := hue-i;
p := val*(1-sat);
q := val*(1-(sat*f));
t := val*(1-(sat*(1-f)));
if i=0 then begin red:=val; grn:=t; blu:=p; end
else if i=1 then begin red:=q; grn:=val; blu:=p; end
else if i=2 then begin red:=p; grn:=val; blu:=t; end
else if i=3 then begin red:=p; grn:=q; blu:=val; end
else if i=4 then begin red:=t; grn:=p; blu:=val; end
else if i=5 then begin red:=val; grn:=p; blu:=q; end;
end;
end;
procedure initializeColors();
var
i: Integer;
r, g, b: double;
begin
for i:=low(colors) to high(colors) do
begin
HSV2RGB(40, 0.8, 0.208*ln(i), r, g, b);
colors[i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
end;
colors[120] := 0;
end;
//calculate squared modus of given complex c
function complexModSq(c: complex_t): Extended;
begin
Result := c.real*c.real + c.imaginary*c.imaginary;
end;
//function z[0]=0
function f(p: complex_t): complex_t;
begin
Result.real := 0;
Result.imaginary := 0;
end;
//function z[n+1] = (|Re{z[n]}| + i|Im{z[n]|)^2 + p
function g(z: complex_t; p: complex_t): complex_t;
begin
Result.real := z.real*z.real - z.imaginary*z.imaginary + p.real;
Result.imaginary := 2*abs(z.real*z.imaginary) + p.imaginary;
end;
//value is inside set in the returned level
function levelSet(p: complex_t): Integer;
var
z: complex_t;
iteration: Integer;
begin
iteration := 0;
z := f(p);
repeat
z := g(z, p);
iteration := iteration + 1;
until ((complexModSq(z) > 4) or (iteration > 120));
Result := iteration;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, j, level: Integer;
p: complex_t;
begin
min_X := StrToFloat(minx.Text);
min_Y := StrToFloat(miny.Text);
max_X := StrToFloat(maxx.Text);
max_Y := StrToFloat(maxy.Text);
ratioX := (max_X - min_X) / Fractal.Width;
ratioY := (max_Y - min_Y) / Fractal.Height;
for i:=0 to Fractal.Height-1 do
begin
p.imaginary := i*ratioY + min_Y;
for j:=0 to Fractal.Width-1 do
begin
p.real := j*ratioX + min_X;
level := levelSet(p);
Fractal.Canvas.Pixels[j, i] := colors[level];
end;
end;
Fractal.Refresh();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
minx.Text := FloatToStr(-2.0);
maxx.Text := FloatToStr(1.5);
miny.Text := FloatToStr(-2.0);
maxy.Text := FloatToStr(1.5);
min_X := StrToFloat(minx.Text);
min_Y := StrToFloat(miny.Text);
max_X := StrToFloat(maxx.Text);
max_Y := StrToFloat(maxy.Text);
ratioX := (max_X - min_X) / Fractal.Width;
ratioY := (max_Y - min_Y) / Fractal.Height;
//initialize colors
initializeColors();
//render new fractal
Button1Click(Sender);
end;
procedure TForm1.FractalMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX := X;
downY := Y;
Selection.Width := 0;
Selection.Height := 0;
Selection.Visible := true;
end;
procedure TForm1.FractalMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//remove selection
Selection.Visible := false;
//get new range to render
minx.Text := FloatToStr(min(downX, X)*ratioX + min_X);
maxx.Text := FloatToStr(max(downX, X)*ratioX + min_X);
miny.Text := FloatToStr(min(downY, Y)*ratioY + min_Y);
maxy.Text := FloatToStr(max(downY, Y)*ratioY + min_Y);
min_X := StrToFloat(minx.Text);
min_Y := StrToFloat(miny.Text);
max_X := StrToFloat(maxx.Text);
max_Y := StrToFloat(maxy.Text);
//render new fractal
Button1Click(Sender);
end;
procedure TForm1.FractalMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
//if left mouse button is held then draw selection
if (ssLeft in Shift) then
begin
Selection.Width := abs(downX - X);
Selection.Height := abs(downY - Y);
Selection.Left := Fractal.Left + min(downX, X);
Selection.Top := Fractal.Top + min(downY, Y);
end;
end;
end.