Algorithmus zum rastern einer Ellipse

[Littellittel]

Hallo,
ich habe angefangen einen Welt-editor zu Bauen der dazu dient ein Level für eine eigene Engine zu erstellen.
Die Bodentypen sind als integer-werte in einem Array gespeichert (2D). Nun möchte ich die Funktion einbauen
Kreise bzw. Ellipsen zu Zeichnen, das heißt ich muss auch eine Ellipse in das Array Zeichnen. Ich habe gegoogelt,
konnte aber für mich kein brauchbares Ergebnis finden. Wäre schön wenn jemand einen Beispiel-Algorithmus für mich hat.

Vielen Dank im Voraus.

[Komoluna]

Schon Bresenham gefunden?
https://de.wikipedia.org/wiki/Bresenham ... lgorithmus

Edit: Bresenham zeichnet eine Kreislinie, wenn du einen gefüllten Kreis willst, würde ich folgendes machen:

Code: Alles auswählen

 
procedure ZeichneKreis(px, py, radius: Integer);
var
  minX, maxX, minY, maxY: Integer;
begin
  minX := px - radius;
  maxX := px + radius;
  minY := py - radius;
  maxY := py + radius;
  for x := minX to maxX do
    for y := minY to maxY do
    begin
      dist := sqrt(sqr(x - px)+sqr(y - py));
      if dist <= radius then
        FuelleZelle(x, y);  //<- Hier füllst du das Feld
    end;
end;

MFG

Komoluna

[Littellittel]

Doch habe ich ,
Nur das Bresenham wie du schon Sagst einen Kreis zeichnet und keine Ellipse (was eigentlich ein Kreis ist nur halt gestreckt).
Und nein ich möchte keine gefüllte Ellipse sondern nur den Außenkreis.

Aber Danke für die schnelle Antwort.

[Komoluna]

Wenn du auf der Wikipediaseite unter Kreis ein wenig runterscrollst, gibt es auch einen Abschnitt zum Thema Ellipsen.

[Littellittel]

ja, wie gesagt habe ich gegoogelt konnte für mich aber kein brauchbares Ergebnis finden.

Code: Alles auswählen

void ellipse(int xm, int ym, int a, int b)
{
   int dx = 0, dy = b; /* im I. Quadranten von links oben nach rechts unten */
   long a2 = a*a, b2 = b*b;
   long err = b2-(2*b-1)*a2, e2; /* Fehler im 1. Schritt */
 
   do {
       setPixel(xm+dx, ym+dy); /* I. Quadrant */
       setPixel(xm-dx, ym+dy); /* II. Quadrant */
       setPixel(xm-dx, ym-dy); /* III. Quadrant */
       setPixel(xm+dx, ym-dy); /* IV. Quadrant */
 
       e2 = 2*err;
       if (e2 <  (2*dx+1)*b2) { dx++; err += (2*dx+1)*b2; }
       if (e2 > -(2*dy-1)*a2) { dy--; err -= (2*dy-1)*a2; }
   } while (dy >= 0);
 
   while (dx++ < a) { /* fehlerhafter Abbruch bei flachen Ellipsen (b=1) */
       setPixel(xm+dx, ym); /* -> Spitze der Ellipse vollenden */
       setPixel(xm-dx, ym);
   }
}

der code ist ja nicht in free pascal geschrieben.
Ich habe versucht ihn umzuschreiben bin aber an den Werten "a,b,xm,ym" gescheitert, es wäre sehr hilfreich wenn du mir diese vielleicht erläutern könntest.

[corpsman]

Servus, in der Library von Greenfoot ist ein Ellipse Zeichen Code drin. ( ugreenfoot.pas -> TGreenfootImage.drawOval(..) )

Wenn ich mich recht erinnere ist da das Crosscompilat deines geposteten C-Codes verwendet.

[Michl]

Man könnte das auch rekursiv lösen. Und da mich das eben interessiert hat, habe ich das auch mal probiert:

Code: Alles auswählen

procedure TForm1.MyEllipse(x1, y1, x2, y2: Integer);
type
  TListPoint = record
    x, y: Integer;
    Next: Pointer;
    Angle: Double;
  end;
  PListPoint = ^TListPoint;
 
var
  x, y: Integer;
  mx, my, rx, ry: Double;
  FirstListPoint: PListPoint;
 
  function NeedPoint(p1, p2: PListPoint): Boolean;
  begin
    if not Assigned(p1) then
      Exit(False);
    if not Assigned(p2) then
      if Assigned(FirstListPoint) then
        p2 := FirstListPoint
      else
        Exit(False);
 
    Result:=(Abs(p1^.x - p2^.x) > 1) or (Abs(p1^.y - p2^.y) > 1);
  end;
  function NewPoint(Prev, Next: PListPoint): PListPoint;
  var
    Dummy: PListPoint;
  begin
    New(Result);
    Result^.Next:=Next;
    if Assigned(Prev) then
      Prev^.Next:=Result;
    if not Assigned(Next) then
      Result^.Angle:=Pi * 4
    else
      Result^.Angle:=Next^.Angle;
    if not Assigned(Prev) then
      Result^.Angle:=Result^.Angle / 2
    else
      Result^.Angle:=(Result^.Angle + Prev^.Angle) / 2;
 
    Result^.x:=Round(mx + sin(Result^.Angle) * rx);
    Result^.y:=Round(my + cos(Result^.Angle) * ry);
 
    Dummy:=nil;
    if NeedPoint(Prev, Result) then begin
      Dummy:=NewPoint(Prev, Result);
    end;
    if NeedPoint(Result, Next) then begin
      Result:=NewPoint(Result, Next);
    end;
    if Assigned(Dummy) then Result:=Dummy;
  end;
  procedure DrawPoints;
  var
    p: PListPoint;
  begin
    p:=FirstListPoint;
    while Assigned(p) do begin
      Canvas.Pixels[p^.x, p^.y]:=clRed;  //hier könntest du jedes beliebiges Ziel z.B. ein Array nutzen
      p:=p^.Next;
    end;
  end;
  procedure ClearPoints;
  var
    p, pNext: PListPoint;
  begin
    p:=FirstListPoint;
    while Assigned(p) do begin
      pNext:=p^.Next;
      Dispose(p);
      p:=pNext;
    end;
  end;
 
begin
  if x2 < x1 then begin
    x:=x2;
    x2:=x1;
    x1:=x;
  end;
  if y2 < y1 then begin
    y:=y2;
    y2:=y1;
    y1:=y;
  end;
  rx:=(x2 - x1) / 2;
  ry:=(y2 - y1) / 2;
  mx:=(x2 + x1) / 2;
  my:=(y2 + y1) / 2;
 
  if (rx > 0) and (ry > 0) then begin
    FirstListPoint:=nil;
    FirstListPoint:=NewPoint(nil, nil);
    NewPoint(FirstListPoint, nil);
    DrawPoints;
    ClearPoints;
  end;
end;      

Testprojekt anbei

[Littellittel]

Danke für alle Antworten,
ich habe es mittlerweile geschafft den code von Bresenham umzuschreiben. Ich poste ihn mal hier falls Interesse besteht.

Code: Alles auswählen

  if (circle) and (x1<>x) and (y1<>y) then//abfrage was der Benuter zeichnen möchte
  begin
  a:=round(abs((x-x1)/2));  //a:=Halbachsenlänge x
  b:=round(abs((y-y1)/2));  //b:=Halbachsenlänge y
  if x<x1 then
  begin
    xm:=x+a                 //xm:=Mittelpunk x
  end else
  begin
    xm:=x1+a
  end;
  if y<y1 then              //ym:=Mittelpunkt y
  begin
    ym:=y+b
  end else
  begin
    ym:=y1+b
  end;
 
  a2:=a*a;                  //implementierung
  b2:=b*b;
  err:=b2-(2*b-1)*a2;
  dx:=0;
  dy:=b;
 
  while (dy>=0) do
  begin
    Feld[xm+dx,ym+dy].Groundtyp:=1;    //Zeichnen (nur die ersten 4 sind wichtig
    Feld[xm-dx,ym+dy].Groundtyp:=1;    //die andern 4 sind dazu da das nicht das
    Feld[xm-dx,ym-dy].Groundtyp:=1;    //ganze Feld neu gezeichnet wird
    Feld[xm+dx,ym-dy].Groundtyp:=1;
    Feld[xm+dx,ym+dy].AEnderung:=true;
    Feld[xm-dx,ym+dy].AEnderung:=true;
    Feld[xm-dx,ym-dy].AEnderung:=true;
    Feld[xm+dx,ym-dy].AEnderung:=true;
 
 
    e2:=err+err;                        //Ermittlung der einzufärbenden Pixel
    if (e2<(2*dx+1*b2)) then
    begin
      dx:=dx+1;
      err:=err+(2*dx+1)*b2;
    end;
    if (e2> -(2*dy-1)*a2) then
    begin
      dy:=dy-1;
      err:=err-(2*dy-1)*a2;
    end;
  end;
 
  //folgender code wird in dem Algorythmus von Bresenahm als correkter verwendet
  //führt aber bei meinem Beispiel nur zu abstürtzen, konnte auch ohne diesen
  //code keinen Fehler endecken.
 
  //while (dx+1 <a) do
  //begin
  //  Feld[xm+dx,ym].Groundtyp:=1;
  //  Feld[xm-dx,ym].Groundtyp:=1;
  //  Feld[xm+dx,ym].AEnderung:=true;
  //  Feld[xm-dx,ym].AEnderung:=true;
  //end;
 
  end; //circle end

edit: in meinem Programm zieht man die Maus um so ein 4eck zu erzeugen in dem die Ellipse gezeichnet wird. x1,y1,x,y sind dabei die Koordinaten der Eckpunkte des 4ecks. Man muss natürlich auch noch eine draw funktion für das Array erstellen, meine sieht so aus:

Code: Alles auswählen

procedure TEditor.draw;
var
  i,j:integer;
begin
  for i := 1 to 480 do
  begin for j := 1 to 320 do
        begin
           if Feld[i,j].AEnderung then
           begin
                case Feld[i,j].Groundtyp of
                0:imFeld.Canvas.Draw(i,j,bmpweiss);
                1:imFeld.Canvas.Draw(i,j,bmpschwarz);
                end;
                Feld[i,j].AEnderung:=false;
           end;
        end;
  end;
end; 

[Ally]

Hallo,
so sollte es auch gehen.

Code: Alles auswählen

function Sinus(Winkel: extended): extended;
begin
  Sinus := sin(Winkel / (180 / pi));
end;
 
function Cosinus(Winkel: extended): extended;
begin
  Cosinus := cos(Winkel / (180 / pi));
end;
 
function KommaZuPunkt(Zahl: string): string;
begin
  Result := StringReplace(Zahl, ',', '.', [rfReplaceAll]);
end;
 
procedure TfrmMain.btnBerechnenClick(Sender: TObject);
var
  Alpha: integer;
  X: double;
  Y: double;
  RI: double;
  RA: double;
begin
  memAusgabe.Clear;
  RI := nedIRadius.Wert;
  RA := nedARadius.Wert;
 
  for Alpha := 0 to 360 do
  begin
    X := RA * Cosinus(Alpha);
    Y := RI * Sinus(Alpha);
    memAusgabe.Lines.Add('X ' + KommaZuPunkt(FormatFloat('0.000', X)) + ' Y ' + KommaZuPunkt(FormatFloat('0.000', Y)));
  end;
end;

[Mathias]

Wenn interesse, habe ich auch noch eine Lösung zur Ellipse:

Code: Alles auswählen

procedure Ellipse(canvas: TCanvas; x, y, rx, ry: word);
var
  dx, dy, i: integer;
  faktor: real;
 
const
  GrafColor = 0;
 
  procedure PutPixel(x, y, col: integer);
  begin
    Canvas.Pixels[x, y] := col;
  end;
 
begin
  if rx > ry then begin
    faktor := ry / rx;
    for i := 0 to rx - rx shr 2 do begin
      dx := Round(Sqrt((rx * rx) - (i * i)));
      dy := Round(faktor * i);
      PutPixel(x + dx, y + dy, GrafColor);
      PutPixel(x - dx, y + dy, GrafColor);
      PutPixel(x + dx, y - dy, GrafColor);
      PutPixel(x - dx, y - dy, GrafColor);
    end;
    for i := 0 to rx - rx shr 2 do begin
      dy := Round(faktor * Sqrt((rx * rx) - (i * i)));
      PutPixel(x + i, y + dy, GrafColor);
      PutPixel(x - i, y + dy, GrafColor);
      PutPixel(x + i, y - dy, GrafColor);
      PutPixel(x - i, y - dy, GrafColor);
    end;
  end else begin
    faktor := rx / ry;
    for i := 0 to ry - ry shr 2 do begin
      dy := Round(Sqrt((ry * ry) - (i * i)));
      dx := Round(faktor * i);
      PutPixel(x + dx, y + dy, GrafColor);
      PutPixel(x - dx, y + dy, GrafColor);
      PutPixel(x + dx, y - dy, GrafColor);
      PutPixel(x - dx, y - dy, GrafColor);
    end;
    for i := 0 to ry - ry shr 2 do begin
      dx := Round(faktor * Sqrt((ry * ry) - (i * i)));
      PutPixel(x + dx, y + i, GrafColor);
      PutPixel(x - dx, y + i, GrafColor);
      PutPixel(x + dx, y - i, GrafColor);
      PutPixel(x - dx, y - i, GrafColor);
    end;
  end;
end;   

Quelle von einem alten TP-Programm.