Re: Inseln auf ein Image malen
Zitat:
|
Re: Inseln auf ein Image malen
So... Ich bins wieder ;) Und zwar bekomme ich jetzt ein Problem mit dem Zeiger-Code... (AV):
Delphi-Quellcode:
Der Fehler tritt je nach Zufall in den Zeilen 43, 44, 48 oder 49 auf.
procedure TForm1.DrawMap(const AWidth, AHeight : Word);
const MaxLoop = 500; type TGrid = array of array of SmallInt; var progress : Byte; i : integer; PGrid : ^TGrid; Step : array of integer; x, y : integer; a, b : double; Ma : integer; UpDown: Boolean; begin try New(PGrid); except MessageBox(Handle, PChar('Not enough memory' + #13#10 + 'Error: 1'), PChar('Error - 1'), MB_OK or MB_ICONERROR); exit; end; SetLength(PGrid^, AWidth, AHeight); SetLength(Step, AWidth); // Grundstruktur FillChar(PGrid^, SizeOf(TGrid), #0); FOR i := 1 TO MaxLoop DO BEGIN // Gleichung für Schnittgerade durch Landschaft a := Random * AHeight * 3 - AHeight; b := Random * 4 -2 ; // Für Schnittgerade die x/y Punktepaare berechnen FOR x := 1 TO AWidth DO Step[x - 1] := round(a + b*x); // Landschaft erhöhen/erniedrigen je nachdem, ob Punkt über unter unter Schnittgerade ist UpDown := random < 0.5; // Entscheidung Erhöhen/Erniedrigen pro Durchlauf variieren FOR y := AHeight DOWNTO 1 DO FOR x := AWidth downto 1 DO IF UpDown then begin IF Step[x - 1] < y then Inc(PGrid^[x - 1, y - 1]) else Dec(PGrid^[x - 1, y - 1]); end else begin IF Step[x - 1] >= y then Inc(PGrid^[x - 1, y - 1]) else Dec(PGrid^[x - 1, y - 1]); end; progress := Trunc(i/MaxLoop*100); lProgress.Caption := 'Progress: ' + IntToStr(progress) +'%'; pbProgress.Position := progress; lProgress.Repaint; pbProgress.Repaint; END; // Landschaft glätten // Filtern "vor Ort" (ohne zweites PGrid^) ist nicht ganz optimal, aber auf die Schnelle... FOR i := 1 TO 4 do begin FOR y := AHeight - 2 DOWNTO 12 DO FOR x := AWidth - 2 downto 1 DO PGrid^[x, y] := (PGrid^[x, y] * 4+ (PGrid^[x+1, y]+PGrid^[x-1, y]+PGrid^[x, y+1]+PGrid^[x, y-1]) * 2+ PGrid^[x+1, y+1]+PGrid^[x-1, y+1]+PGrid^[x+1, y-1]+PGrid^[x-1, y-1] ) div 16; end; // Maximum bestimmen Ma := 0; FOR y := AHeight - 1 DOWNTO 0 DO FOR x := AWidth - 1 downto 0 DO IF Ma < PGrid^[x, y] THEN Ma := PGrid^[x, y]; // Bitmap einfärben WITH iMap.Picture.Bitmap.Canvas DO FOR y := AHeight DOWNTO 1 DO FOR x := AWidth downto 1 DO IF PGrid^[x, y] <= 0 then Pixels[x, y] := clBlue else begin i := Trunc(PGrid^[x - 1, y - 1] * 160 / Ma); Pixels[x, y] := $0020F020 + $00010001 * (i div 4) - $00000100 * i; end; Dispose(PGrid); end; |
Re: Inseln auf ein Image malen
Hallo Fabian,
ein mehrdimensionales, dynamisches Array belegt keinen zusammenhängenden Speicherbereich. Das Löschen solltest du also besser so durchführen:
Delphi-Quellcode:
In der letzten Ebene (x) könntest du prinzipiell auch mit FillChar arbeiten.
for y := 0 to High(PGrid^) do
for x := 0 to High(PGrid^[y]) do PGrid^[x, y] := 0; In Zeile 63 ist wahrscheinlich der Endwert der y-Schleife falsch:
Delphi-Quellcode:
Bei der Schleife zum Einfärben der Bitmap solltest du die Schleifenparameter prüfen. Der Zugriff auf PGrid^[AWidth, AHeight] dürfte ebenfalls zu einem Fehler führen. Eine einfache Verschiebung beider Laufvariablen um 1 führt allerdings zu Problemen im ELSE-Zweig.
FOR y := AHeight - 2 DOWNTO 12 DO // 1 statt 12?
Gruß Hawkeye |
Re: Inseln auf ein Image malen
Hallo Hawkeye !
Danke erstmal für den Report! Zitat:
Zitat:
Zitat:
Danke :) Aber ich glaube kaum, dass es daran liegt... MfG, xZise |
Re: Inseln auf ein Image malen
Zitat:
Delphi-Quellcode:
Im obigen Beispiel ist Grid ein Zeiger auf ein Array mit 10 Zeigern auf jeweils ein Array mit 20 SmallInt-Elementen. In Wirklichkeit sind noch einige Verwaltungsdaten dabei, das tut aber nichts zur Sache. SizeOf(TGrid) wird immer den Wert 4 liefern - die Größe eines Zeigers.
type
TGrid = array of array of SmallInt; var Grid : TGrid; begin SetLength (Grid, 10, 20); end; Mit dem FillChar-Befehl in deinem Code löschst du nicht den Inhalt des Arrays, sondern einen Teil der Zeigerstruktur bzw. der Verwaltungsinformationen. Dies muß früher oder später zum Absturz führen. Gruß Hawkeye |
Re: Inseln auf ein Image malen
Jo :) Is mir auch aufgefallen! Funktioniert jetzt wunderbar! Danke!
|
Re: Inseln auf ein Image malen
Hallo,
Zitat:
Gruß Jörg |
Re: Inseln auf ein Image malen
Mittlerweile weiß ich wenigstens wieder, wo ich von diesem Verfahren gelesen hatte:
Benoît B. Mandelbrot, Die fraktale Geometrie der Natur, Birkhäuser Verlag, 1987. Irgendwo in der Mitte des Buches gibt es ein Kapitel "Die Erzeugung eines Brown-Reliefs", in dem der Algorithmus beschrieben wird (allerdings ein klein wenig anders, als ich ihn in Erinnerung hatte: Der Höhenunterschied zwischen den durch einen Schnitt entstehenden Seiten kann zufällig gewählt werden, außerdem wird noch eine Normierung bzgl. der Anzahl der Durchläufe angewandt (Multiplikation mit der Wurzel aus der Anzahl der Durchläufe)). Dieses Kapitel wiederum bezieht sich auf eine andere Veröffentlichung Mandelbrots: Fonctions aléatoires pluritemporelles: approximation poissonien ne du cas brownien et généralisations. Comptes Rendus (Paris), 280 A, 1075-1078, was mir nix nutzt, weil ich kein Französisch kann ;) Gruß Michael |
Re: Inseln auf ein Image malen
Übrigens hatte ich einmal eine verbesserte Variante mit Kreisen ;) Dann stand nicht von anfang an fest, wo viel Land sein wird. (Weil bei der obigen ist das meißte Land dort, wo als erstes Land erzeugt wurde). Leider ist der Code regelrecht "verbruzelt"... Und ich hatte leider keine Sicherungskopie auf'm Rechner :(
Aber als Tipp (welche das ummodifizieren wollen): Statt zu überprüfen, ob der Punkt im oder außerhalb des Kreises ist:
Delphi-Quellcode:
kann man das besser mit "a² + b² = c²" lösen:
if Sqrt(Power(x, 2) + Power(y, 2)) >{=} r then
// außerhalb
Delphi-Quellcode:
wobei ich nicht weiß, ob "IntPower(x, 2)", "Power(x, 2)" oder "x * x" schneller ist.
if Power(x, 2) + Power(y, 2) >{=} Power(r, 2) then
//außerhalb Aber die obige Verbesserung mach den Algo um ein vielfaches Schneller (Mensch hatte ich da gestaunt xD) |
Re: Inseln auf ein Image malen
Liste der Anhänge anzeigen (Anzahl: 3)
Falls doch mal jemand schnell mit dem Algorithmus von Herrn Mandelbrot ein wenig herumspielen will: Im Anhang ist der Source-Code zu meinem Testprogramm. (Testprogramm! d.h. keine Kommentare! ;))
Achtung: Wenn man Randseed nicht ändert, dann erhält man immer dieselbe Landkarte. Ein AVI mit der Erschaffung einer Insel gibt es hier (2MB). Gruß Michael |
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:06 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz