| Autor |
Beitrag |
Jakob_Ullmann
 
Beiträge: 1747
Erhaltene Danke: 15
Win 7, *Ubuntu GNU/Linux*
*Anjuta* (C, C++, Python), Geany (Vala), Lazarus (Pascal), Eclipse (Java)
|
Verfasst: Sa 04.09.10 16:04
Einleitung
Immer wieder wird von Anfängern gefragt, was sie „mal eben machen können“. Und oft ist unter den Antworten
- eine Adressverwaltung
- ein E-Mail-Client
- ein eigenes Betriebssystem
- ein Taschenrechner
- ein Fraktalgenerator
Häufig sind Anfänger mit solchen Sachen überfordert. Sie haben keine Lust auf sinnlose Programme wie einen elektronischen Psychiater (nein, ich beziehe mich hier nicht auf ein ganz bestimmtes Delphi-Buch...), aber haben noch zu wenig Erfahrung mit der Delphi-Programmierung und wissen auch nicht, wonach sie suchen sollen. Wie im Titel erkennbar, will ich hier auf den Fraktalgenerator (bzw. nur auf die Mandelbrot-Menge z(n+1) = z(n)² + c) eingehen.
Mathematischer Exkurs
Ich würde es ziemlich sinnlos finden, wenn jemand die Quellcodes einfach kopiert und nichts verstanden hat. Deshalb werde ich mit einer mathematischen Beschreibung der komplexen Zahlen und Mandelbrot-Menge anfangen. Ich denke aber, viele werden mindestens den Komplexe-Zahlen-Abschnitt überspringen können.
Komplexe Zahlen
Um die Wurzel aus negativen reellen Zahlen ziehen zu können, definiert man die imaginäre Einheit i (in der Physik: j, um Verwechslungen mit der Stromstärke I zu verwechseln). Diese ist so definiert, dass i² = -1. Eine imaginäre Zahl ist dann das Produkt einer reellen Zahl mit der imaginären Einheit, also a*i. Somit sind die Zahlen +i*sqrt(2) [sqrt = Wurzel] die beiden Lösungen der Gleichung x²=-2. Nach dem Fundamentalsatz der Algebra gibt es ja genau zwei. Das könnt ihr leicht durch eine Probe bestätigen. Addiert man nun eine reelle Zahl a zu einer imaginären Zahl b*i so erhält man die komplexe Zahl a+bi ∈ C.
Wer sich für das Thema interessiert, findet im Web ganz sicher Material (z. B. Polardarstellung, Euler-Relation, …).
Die Mandelbrot-Menge
Die Mandelbrot-Menge wird über die komplexen Zahlen definiert. Sie ist die Menge aller komplexer Zahlen c, für die die Folge
  Quelltext
1:
2:
3:
4:
| z0 = 0
z = ( z )² + c
n+1 n |
konvergiert. Das heißt, der Betrag der komplexen Zahl c, der definiert ist als der Abstand zum Koordinatenursprung in der Gaußschen Zahlenebene, bleibt beschränkt. Ansonsten wird er irgendwann, nach einer entsprechend hohen Schrittzahl (n in der Formel oben), eine Größe überschreiten, die wir Bailout-Radius b nennen.
Die Gaußsche Zahlenebene wird benutzt, um komplexe Zahlen darzustellen. Es handelt sich um ein kartesisches Koordinatensystem, bei dem auf der Abszisse (waagerecht) der Realteil a und auf der Ordinate (senkrecht) der Imaginärteil b abgetragen wird.
Ich sagte, der Betrag ist der Abstand zum Ursprung. Für eine reelle Zahl ist das einfach die Zahl mit positivem Vorzeichen, da wir keine Ordinate haben. Bei der Gauß-Ebene haben wir ein (gedachtes) rechtwinkliges Dreieck und somit ist der Betrag nach dem Satz des Pythagoras
Quelltext
1:
2:
3:
4:
|
_________
|a + bi| := / a² + b²
\/ |
Der Bailout-Radius ist im einfachsten Fall 2. Dann hat man aber später oszillierende Farbbänder (was das heißt, könnt ihr herausfinden, wenn ihr das Programm geschrieben habt ). Es ist daher ästhetischer, für den Bailout-Radius zum Beispiel 1000 zu nehmen. Euch ist aber hoffentlich klar, dass sich damit auch die Rechenzeit erhöht, bzw. wenn man das nicht zulässt, indem man die maximale Schrittzahl zu niedrig wählt, die Genauigkeit sinkt. Notfalls muss man einen Kompromiss finden.
Das Quadrat einer komplexen Zahl: z²
Das Quadrat einer komplexen Zahl bildet man einfach mit der ersten binomischen Formel. Wir haben somit z² = (a + bi)² = a² + 2ab i + (-1) b² = (a² – b²) + (2ab) i.
Aufgabe. Ihr könnt schon mal die Theorie verdauen, indem ihr einen record für komplexe Zahlen definiert, und dazu die Funktionen KAbs() für den Betrag, KAdd für die Addition, KSqr für das Quadrat. Ich weiß, dass Delphi einen eigenen Typen Complex hat (und auch von AXMD und delfiphan haben wir im Forum wunderschöne Lösungen), aber erstens wäre das für unser kleines Projekt Overkill, und zweitens hilft es dem Verständnis, wenn man es selber macht.
Was dabei herauskommt, könnte etwa so aussehen (bitte versucht es erstmal selber und macht nicht einfach Copy & Paste!):
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
| type
TKomplex = record
Re, Im: Double;
end;
...
function KAbs(a: TKomplex): Double;
function KAdd(a, b: TKomplex): TKomplex;
function KSqr(a: TKomplex): TKomplex;
implementation
...
function KAbs(a: TKomplex): Double;
begin
Result := Sqrt(a.Re * a.Re + a.Im * a.Im);
end;
function KAdd(a, b: TKomplex): TKomplex;
begin
Result.Re := a.Re + b.Re;
Result.Im := a.Im + b.Im;
end;
function KSqr(a: TKomplex): TKomplex;
begin
Result.Re := a.Re * a.Re – a.Im * a.Im;
Result.Im := 2 * a.Re * a.Im;
end; |
Graphische Darstellung
Die normale graphische Darstellung der Mandelbrot-Menge, also das Apfelmännchen, entsteht, indem man für jeden Punkt c der Gauß-Ebene prüft, ob die Reihe konvergiert oder nicht. Wir wollen uns erst einmal mit einem Schwarz-Weiß-Bild begnügen. Wir gestalten erst einmal das Formular. Wir brauchen:
- eine PictureBox zum Zeichnen
- sieben Buttons: Links, Rechts, Hoch, Runter, Einzoomen, Wegzoomen, Zeichnen
Globale Variablen sollten vermieden werden. Daher definieren wir, jedoch im public-Bereich von TForm1, die Variablen
Delphi-Quelltext
1:
2:
3:
| public
ox, oy, stp: Integer;
end; |
- ox: die x-Koordinate des Ursprungs
- oy: die y-Koordinate des Ursprungs
- stp: wie viele Pixel entsprechen der Länge 1?
Im FormCreate-Ereignis werden diese initialisiert:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
| procedure TForm1.FormCreate(Sender: TObject);
begin
ox := Fract.Width div 2; oy := Fract.Height div 2;
stp := 50;
end; |
Was brauchen wir weiter? Definiert die Variablen b für den Bailout-Radius (erstmal 2) und MaxSteps für die maximale Anzahl der Rekursionsschritte. 100 sollte bei b = 2 locker reichen.
Dann brauchen wir weiter eine Funktion MandelIter(c: TKomplex), die einen Integer zurückgibt. Die machen wir gemeinsam. Schließlich brauchen wir eine Funktion MandelColor(n: Integer), die dem Ergebnis von MandelIter eine Farbe zuordnet.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
| function MandelColor(n: Integer): TColor;
begin
if n < Form1.MaxSteps then
Result := clWhite else
Result := clBlack; end;
function MandelIter(c: TKomplex): Integer;
var
n: Integer; z: TKomplex;
betrag: Double;
begin
n := 0;
z.Re := 0;
z.Im := 0;
betrag := 0;
while (n < Form1.MaxSteps) and (betrag < Form1.b) do
begin
z := KAdd( KSqr(z), c ); betrag := KAbs(z); inc(n);
end;
Result := n;
end; |
Weiterhin brauchen wir eine Funktion, die einem Pixel auf der PaintBox „Fract“ eine komplexe Zahl zuordnet.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
| function CalcCompl(X, Y: Integer): TKomplex;
begin
with Form1 do
begin
Result.Re := (X - ox) / stp;
Result.Im := (oy - Y) / stp;
end;
end; |
Die Funktionsweise sollte klar sein. Nun implementieren wir noch den Zeichnen-Button. Danach seid ihr dran: Ihr dürft die Features Links, Rechts, Hoch, Runter, Zoom-In, Zoom-Out implementieren.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
| procedure TForm1.btnDrawClick(Sender: TObject);
var
X, Y, n: Integer;
begin
for X := 0 to Fract.Width - 1 do
for Y := 0 to Fract.Height - 1 do
begin
n := MandelIter(CalcCompl(X, Y));
Fract.Canvas.Pixels[X, Y] :=
MandelColor(n);
end;
end; |
Jetzt sollte es schon ein schönes Ergebnis geben. Zumindest ist die Mandelbrot-Menge zu erkennen. Aber eben nur in schwarz-weiß. Etwas aufpeppen kann man das ganze, wenn man etwa die MandelColor-Methode etwas anpasst:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
| function MandelColor(n: Integer): TColor;
begin
if (n < Form1.MaxSteps) and (n mod 2 = 1) then
Result := clWhite else
Result := clBlack; end; |
Dann seht ihr aber auch, was mit oszillierenden Farbbändern gemeint war. Jetzt wollen wir den Bailout-Radius auf 100 erhöhen und die MaxSteps auf 200. Machen, compilieren, vergleichen. Die Mandelbrot-Menge selber ändert sich natürlich nicht. Die Umgebung sieht aber schöner (gleichmäßiger) aus. Will man, wie wir jetzt, die Umgebung farbig darstellen, empfiehlt es sich, ausschließlich mit höheren Bailout-Radien zu arbeiten, es sei denn, das Ergebnis ist so gewollt.
Wir wollen uns fließende Farbübergänge als Ziel setzen. Zunächst sollten wir eine Funktion für einen Farbübergang schreiben, die ich GradientValue(x1, y1, x2, y2: Byte; x: Double) nennen will. Sie gibt einen Byte zurück. Dass x ein Double sein soll, ist schon Zukunftsmusik, wenn n nicht mehr vom Typen Integer, sondern Double sein wird. Warum diese Notwendigkeit bestehen wird, werdet ihr ebenfalls sehen. Was macht nun diese Funktion? Wir betrachten zunächst eine lineare Funktion f(x).
Es sind von f(x) also die Punkte (x1, y1) und (x2, y2) bekannt. Sie ist dadurch eindeutig bestimmbar. Die Funktion GradientValue, in der Abbildung y, soll nun einen Zwischenwert bestimmen. Wir haben hier nur ein lineares Gleichungssystem zu lösen.
| Zitat: | m * x1 + n = y1
m * x2 + n = y2
n = y1 – m * x1
m = (y2 – n) / x2 = (y2 – y1 + m * x1) / x2; m = (y2 – y1) / (x2 – x1)
n = y1 – x1 * (y2 – y1) / (x2 – x1) |
Ganz ehrlich: das hätte man auch ablesen können. Auf jeden Fall sollte nun jedem klar sein, wie wir unsere Funktion zu implementieren haben.
Einloggen, um Attachments anzusehen!
Zuletzt bearbeitet von Jakob_Ullmann am So 05.09.10 11:15, insgesamt 4-mal bearbeitet
|
|
Jakob_Ullmann 
Beiträge: 1747
Erhaltene Danke: 15
Win 7, *Ubuntu GNU/Linux*
*Anjuta* (C, C++, Python), Geany (Vala), Lazarus (Pascal), Eclipse (Java)
|
Verfasst: Sa 04.09.10 16:10
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
| function GradientValue(x1, y1, x2, y2: Byte; x: Double): Byte;
var
m, n: Double;
begin
m := (y2 – y1) / (x2 – x1);
n := y1 – x1 * m;
Result := Trunc(m * x + n);
end; |
Nun können wir zum Beispiel (n mod 100) als Maß für die Farbe nehmen. Die Farben, die mir sehr gut gefallen (ähnlich den Bildern aus dem Wikipedia-Artikel):
Quelltext
1:
2:
3:
4:
5:
6:
| n mod 100 Rot (hex) Grün (hex) Blau (hex)
0 (dunkelblau) 0 0 55
60 (weiß) ff ff ff
65 (gelb) ff ff 0
90 (orange) ff 88 0
100 (= 0, dnklbl.) 0 0 55 |
Unsere Funktion MandelColor sieht dann so aus:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
| function MandelColor(Diver: Integer): TColor;
var
r, g, b: Byte; rest: Integer;
begin
if Diver < Form1.MaxSteps then
begin
rest := Diver mod 100;
if rest in [0..59] then
begin
r := GradientValue(0, $00, 60, $ff, rest);
g := r;
b := GradientValue(0, $55, 60, $ff, rest);
Result := RGB(r, g, b);
end
else if rest in [60..64] then
begin
r := $ff;
g := $ff;
b := GradientValue(60, $ff, 65, 00, rest);
Result := RGB(r, g, b);
end
else if rest in [65..89] then
begin
r := $ff;
g := GradientValue(65, $ff, 90, $88, rest);
b := $00;
Result := RGB(r, g, b);
end
else if rest in [90..99] then
begin
r := GradientValue(90, $ff, 100, $00, rest);
g := GradientValue(90, $88, 100, $00, rest);
b := GradientValue(90, $00, 100, $55, rest);
Result := RGB(r, g, b);
end
end
else
Result := clBlack;
end; |
Und ihr könnt das Programm laufen lassen. Jetzt habt ihr schon sehr schöne Bilder. Richtig schön sind die natürlich erst, wenn ihr zoomen könnt. Wenn ihr das noch nicht implementiert habt, solltet ihr das schleunigst tun. Denn erst dann könnt ihr die kleinen Mandelbrötchen sehen. Wo die sich befinden, findet ihr entweder selbst heraus, oder ihr schaut mal in den Wikipedia-Artikel zur Mandelbrot-Menge.
So richtig zufrieden sind wir aber noch nicht: die Farbüberläufe sind da, aber wir haben immer noch die hässlichen Farbbänder.
Normalized Iteration Count
Im Paper „Coloring Dynamical Systems in the Complex Plane“ finden wir die Lösung für dieses Problem: Normalized Iteration Count. Dabei wird der Wert n so modifiziert, dass wir fließende Übergänge bekommen. Das geschieht nach der Formel
w = n + (log log b - log log |zn|) / log 2
So können wir die Funktion MandelIter anpassen.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
| function MandelIter(c: TKomplex): Double;
var
n: Integer; z: TKomplex;
betrag: Double;
begin
n := 0;
z.Re := 0;
z.Im := 0;
betrag := 0;
while (n < Form1.MaxSteps) and (betrag < Form1.b) do
begin
z := KAdd( KSqr(z), c ); betrag := KAbs(z); inc(n);
end;
if n < Form1.MaxSteps then
Result := n + ( ln( ln(Form1.b)/ln(betrag) ) ) / ln(2)
else
Result := n + 1; end; |
Und unsere Funktion MandelColor ändert sich nun ein letztes Mal. Zuvor brauchen wir jedoch noch zwei Funktionen: DMod und DIn, da die Schlüsselwörter mod und in nur mit Integern Funktionieren (bzw. dass ein set nicht alle reellen Zahlen enthalten kann, dürfte ja klar sein).
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
| function DMod(x, y: Double): Double;
begin
Result := (Trunc(1000 * x) mod Trunc(1000 * y)) / 1000;
end;
function dIn(a, b, c: Double): Boolean;
begin
Result := (a >= b) and (a < c);
end;
function MandelColor(Diver: Double): TColor;
var
r, g, b: Byte; rest: Double;
begin
if Diver < Form1.MaxSteps then
begin
rest := DMod(Diver, 100);
if dIn(rest, 0, 60) then
begin
r := GradientValue(0, $00, 60, $ff, rest);
g := r;
b := GradientValue(0, $55, 60, $ff, rest);
Result := RGB(r, g, b);
end
else if dIn(rest, 60, 65) then
begin
r := $ff;
g := $ff;
b := GradientValue(60, $ff, 65, 00, rest);
Result := RGB(r, g, b);
end
else if dIn(rest, 65, 90) then
begin
r := $ff;
g := GradientValue(65, $ff, 90, $88, rest);
b := $00;
Result := RGB(r, g, b);
end
else if dIn(rest, 90, 100) then
begin
r := GradientValue(90, $ff, 100, $00, rest);
g := GradientValue(90, $88, 100, $00, rest);
b := GradientValue(90, $00, 100, $55, rest);
Result := RGB(r, g, b);
end
end
else
Result := clBlack;
end; |
in der btnDrawClick müsst ihr natürlich noch den Datentyp von n zu Double ändern.
Ihr dürft nun compilieren und euch über schöne Bilder freuen! Viel Spaß!
Fragen, Anregungen und Kritik bitte hier posten.
Noch ein Hinweis für Lazarus-Nutzer: Ich habe nicht gefunden, in welcher Unit RGB definiert ist. Wir können es uns aber einfach selber schreiben (aus Gründen der Klarheit habe ich absichtlich die Nullen stehen gelassen):
Delphi-Quelltext
1:
2:
3:
4:
| function RGB(r, g, b: Byte): TColor;
begin
Result := $010000 * b + $000100 * g + $000001 * r;
end; |
PS: Für alle, die schon verzweifelt sind, weil sie die Zoom-Funktion nicht geschafft haben (haha!   ), hier die Auflösung.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
| procedure TForm1.btnZoomInClick(Sender: TObject);
begin
ox := Trunc(Trunc(Fract.Width / 2) - (Trunc(Fract.Width / 2) - ox) * 1.1);
oy := Trunc(Trunc(Fract.Height / 2) - (Trunc(Fract.Height / 2) - oy) * 1.1);
stp := trunc(stp * 1.1);
end;
procedure TForm1.btnZoomOutClick(Sender: TObject);
begin
ox := Trunc(Trunc(Fract.Width / 2) - (Trunc(Fract.Width / 2) - ox) / 1.1);
oy := Trunc(Trunc(Fract.Height / 2) - (Trunc(Fract.Height / 2) - oy) / 1.1);
stp := trunc(stp / 1.1);
end; |
Ich gebe zu, das war nicht ganz einfach mit meinem Ansatz über ox und oy. Ich habe auch ganz schön nachdenken müssen, um eine korrekte Zoom-Funktion hinzukriegen. Davor hatte ich es quick-and-dirty und war deprimiert, als beim Zoomen der Ausschnitt weg war. Verschieben sollte aber jeder Schaffen, ist nur Verschieben des Ursprungs, also was addieren / subtrahieren zu ox / oy.
Noch ein Hinweis: Wenn ihr beim btnDrawClick ein Application.ProcessMessages einbaut, kann man auch (mit entsprechender Boolean-Variable, versteht sich) einen Abbrechen-Button einbauen. Und wer lange Weile hat, kann sich ja noch Julia-Mengen, Quaternionen / Mandelbulb, Buddhabrot anschauen oder einen Komplex-Parser schreiben, damit man auch andere Formeln als z'=z²+c nehmen kann.
Zuletzt bearbeitet von Jakob_Ullmann am Mo 22.11.10 18:54, insgesamt 2-mal bearbeitet
|
|
Jakob_Ullmann
Beiträge: 1747
Erhaltene Danke: 15
Win 7, *Ubuntu GNU/Linux*
*Anjuta* (C, C++, Python), Geany (Vala), Lazarus (Pascal), Eclipse (Java)
|
Verfasst: So 05.09.10 10:57
Hier nun der gesamte Quellcode (Lazarus):
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
| unit umain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls;
type
TKomplex = record
Re, Im: Double;
end;
TForm1 = class(TForm)
btnLeft: TButton;
btnRight: TButton;
btnUp: TButton;
btnDown: TButton;
btnDraw: TButton;
btnZoomIn: TButton;
btnZoomOut: TButton;
Fract: TPaintBox;
procedure btnDownClick(Sender: TObject);
procedure btnDrawClick(Sender: TObject);
procedure btnLeftClick(Sender: TObject);
procedure btnRightClick(Sender: TObject);
procedure btnUpClick(Sender: TObject);
procedure btnZoomInClick(Sender: TObject);
procedure btnZoomOutClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
ox, oy, stp: Integer;
b: Integer;
MaxSteps: Integer;
end;
var
Form1: TForm1;
function KAbs(a: TKomplex): Double;
function KAdd(a, b: TKomplex): TKomplex;
function KSqr(a: TKomplex): TKomplex;
implementation
function RGB(r, g, b: Byte): TColor;
begin
Result := $010000 * b + $000100 * g + $000001 * r;
end;
function KAbs(a: TKomplex): Double;
begin
Result := Sqrt(a.Re * a.Re + a.Im * a.Im);
end;
function KAdd(a, b: TKomplex): TKomplex;
begin
Result.Re := a.Re + b.Re;
Result.Im := a.Im + b.Im;
end;
function KSqr(a: TKomplex): TKomplex;
begin
Result.Re := a.Re * a.Re - a.Im * a.Im;
Result.Im := 2 * a.Re * a.Im;
end;
function GradientValue(x1, y1, x2, y2: Byte; x: Double): Byte;
var
m, n: Double;
begin
m := (y2 - y1) / (x2 - x1);
n := y1 - x1 * m;
Result := Trunc(m * x + n);
end;
function DMod(x, y: Double): Double;
begin
Result := (Trunc(1000 * x) mod Trunc(1000 * y)) / 1000;
end;
function dIn(a, b, c: Double): Boolean;
begin
Result := (a >= b) and (a < c);
end;
function MandelColor(Diver: Double): TColor;
var
r, g, b: Byte; rest: Double;
begin
if Diver < Form1.MaxSteps then
begin
rest := DMod(Diver, 100);
if dIn(rest, 0, 60) then
begin
r := GradientValue(0, $00, 60, $ff, rest);
g := r;
b := GradientValue(0, $55, 60, $ff, rest);
Result := RGB(r, g, b);
end
else if dIn(rest, 60, 65) then
begin
r := $ff;
g := $ff;
b := GradientValue(60, $ff, 65, 00, rest);
Result := RGB(r, g, b);
end
else if dIn(rest, 65, 90) then
begin
r := $ff;
g := GradientValue(65, $ff, 90, $88, rest);
b := $00;
Result := RGB(r, g, b);
end
else if dIn(rest, 90, 100) then
begin
r := GradientValue(90, $ff, 100, $00, rest);
g := GradientValue(90, $88, 100, $00, rest);
b := GradientValue(90, $00, 100, $55, rest);
Result := RGB(r, g, b);
end
end
else
Result := clBlack;
end;
function MandelIter(c: TKomplex): Double;
var
n: Integer; z: TKomplex;
betrag: Double;
begin
n := 0;
z.Re := 0;
z.Im := 0;
betrag := 0;
while (n < Form1.MaxSteps) and (betrag < Form1.b) do
begin
z := KAdd( KSqr(z), c ); betrag := KAbs(z); inc(n);
end;
if n < Form1.MaxSteps then
Result := n + ( ln( ln(Form1.b)/ln(betrag) ) ) / ln(2)
else
Result := n + 1; end;
function CalcCompl(X, Y: Integer): TKomplex;
begin
with Form1 do
begin
Result.Re := (X - ox) / stp;
Result.Im := (oy - Y) / stp;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ox := Fract.Width div 2; oy := Fract.Height div 2;
stp := 100;
b := 100;
MaxSteps := 200;
end;
procedure TForm1.btnDrawClick(Sender: TObject);
var
X, Y: Integer;
n: Double;
begin
for X := 0 to Fract.Width - 1 do
for Y := 0 to Fract.Height - 1 do
begin
n := MandelIter(CalcCompl(X, Y));
Fract.Canvas.Pixels[X, Y] :=
MandelColor(n);
end;
end;
procedure TForm1.btnDownClick(Sender: TObject);
begin
oy := oy - 20;
end;
procedure TForm1.btnLeftClick(Sender: TObject);
begin
ox := ox + 20;
end;
procedure TForm1.btnRightClick(Sender: TObject);
begin
ox := ox - 20;
end;
procedure TForm1.btnUpClick(Sender: TObject);
begin
oy := oy + 20;
end;
procedure TForm1.btnZoomInClick(Sender: TObject);
begin
ox := Trunc(Trunc(Fract.Width / 2) - (Trunc(Fract.Width / 2) - ox) * 1.1);
oy := Trunc(Trunc(Fract.Height / 2) - (Trunc(Fract.Height / 2) - oy) * 1.1);
stp := trunc(stp * 1.1);
end;
procedure TForm1.btnZoomOutClick(Sender: TObject);
begin
ox := Trunc(Trunc(Fract.Width / 2) - (Trunc(Fract.Width / 2) - ox) / 1.1);
oy := Trunc(Trunc(Fract.Height / 2) - (Trunc(Fract.Height / 2) - oy) / 1.1);
stp := trunc(stp / 1.1);
end;
initialization
{$I umain.lrs}
end. |
|
|
|
