Nadesłany przez Tomasz Lubiński, 18 sierpnia 2008 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 - zbior Julii - Delphi/Julia.pas:
// Fraktale - zbior Julii // www.algorytm.org // Tomasz Lubinski (c) 2008 unit Julia; 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; Label7: TLabel; Label8: TLabel; cRe: TEdit; cIm: TEdit; Predefined: TComboBox; 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); procedure PredefinedChange(Sender: TObject); 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(3.2*i, 0.85, 0.6, 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 f(p)=p function f(p: complex_t): complex_t; begin Result := p; end; //function g(z) = z^2 + c function g(z: complex_t; c: complex_t): complex_t; begin Result.real := z.real*z.real - z.imaginary*z.imaginary + c.real; Result.imaginary := 2*z.real*z.imaginary + c.imaginary; end; //value is inside set in the returned level function levelSet(p: complex_t; c: complex_t): Integer; var z: complex_t; iteration: Integer; begin iteration := 0; z := f(p); repeat z := g(z, c); iteration := iteration + 1; until ((complexModSq(z) > 4) or (iteration > 120)); Result := iteration; end; procedure TForm1.Button1Click(Sender: TObject); var i, j, level: Integer; p, c: complex_t; begin min_X := StrToFloat(minx.Text); min_Y := StrToFloat(miny.Text); max_X := StrToFloat(maxx.Text); max_Y := StrToFloat(maxy.Text); c.real := StrToFloat(cRe.Text); c.imaginary := StrToFloat(cIm.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, c); Fractal.Canvas.Pixels[j, i] := colors[level]; end; end; Fractal.Refresh(); end; procedure TForm1.FormCreate(Sender: TObject); begin minx.Text := FloatToStr(-1.5); maxx.Text := FloatToStr(1.5); miny.Text := FloatToStr(-1.25); maxy.Text := FloatToStr(1.25); Predefined.ItemIndex := 0; cRe.Text := FloatToStr(-0.123); cIm.Text := FloatToStr(0.745); 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; procedure TForm1.PredefinedChange(Sender: TObject); begin case Predefined.ItemIndex of 0: begin cRe.Text := FloatToStr(-0.123); cIm.Text := FloatToStr(0.745); end; 1: begin cRe.Text := FloatToStr(-0.75); cIm.Text := FloatToStr(0.0); end; 2: begin cRe.Text := FloatToStr(-0.390541); cIm.Text := FloatToStr(-0.586788); end; 3: begin cRe.Text := FloatToStr(0); cIm.Text := FloatToStr(1); end; end; //redraw fractal Button1Click(Sender); end; end.