DBR Delphi-Ecke

// Getestet mit D4 unter XP

// 1. Zeichnen eines Ellipse-Quadranten nach Bresenham:

procedure DrawEllipseQuadrant(cnv: TCanvas; x0, y0, rx, ry: integer); 
var 
  rx2, ry2, rx4, ry4, F, Fx, Fy, x, y, yy: integer; 
  xx: single; 
begin 
  rx2 := rx * rx; 
  ry2 := ry * ry; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  F := Round(ry2 - rx2 * ry + 0.25 * rx); 
  Fx := 0; 
  Fy := rx4 * ry; 
  x := 0; 
  y := ry; 
  SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
  while Fx < Fy do begin 
    if F >= 0 then begin 
      dec(y); 
      Fy := Fy - rx4; 
      F := F - Fy; 
    end; 
    inc(x); 
    Fx := Fx + ry4; 
    F := F + Fx + ry2; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
  end; 
  xx := x + 0.5; 
  yy := pred(y); 
  F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
  while y > 0 do begin 
    if F <= 0 then begin 
      inc(x); 
      Fx := Fx + ry4; 
      F := F + Fx; 
    end; 
    dec(y); 
    Fy := Fy - rx4; 
    F := F + rx2 - Fy; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
  end; 
end; 

// Beispielaufruf

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Canvas.pen.color := clRed; 
  DrawEllipseQuadrant(canvas, 200, 100, 80, 40); 
end; 
 
 
// 2. Wenn man das Zeichnen mit wechselnden Vorzeichen von x und y
// entsprechend wiederholt, erhält man eine komplette Ellipse.
// r0 und y0 bestimmen den Mittelpunkt, rx und ry die beiden Radien.

procedure DrawEllipse(cnv: TCanvas; x0, y0: integer; rx, ry: word); 
var 
  rx2, ry2, rx4, ry4, F, Fx, Fy, x, y, yy: integer; 
  xx: single; 
begin 
  rx2 := rx * rx; 
  ry2 := ry * ry; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  F := Round(ry2 - rx2 * ry + 0.25 * rx); 
  Fx := 0; 
  Fy := rx4 * ry; 
  x := 0; 
  y := ry; 
  SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
  SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  while Fx < Fy do begin 
    if F >= 0 then begin 
      dec(y); 
      Fy := Fy - rx4; 
      F := F - Fy; 
    end; 
    inc(x); 
    Fx := Fx + ry4; 
    F := F + Fx + ry2; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
  xx := x + 0.5; 
  yy := pred(y); 
  F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
  while y > 0 do begin 
    if F <= 0 then begin 
      inc(x); 
      Fx := Fx + ry4; 
      F := F + Fx; 
    end; 
    dec(y); 
    Fy := Fy - rx4; 
    F := F + rx2 - Fy; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
end; 

// Beispielaufruf

procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Canvas.pen.color := clRed; 
  DrawEllipse(canvas, 200, 100, 80, 40); 
end; 

 
// 3. Mit erweitertem Code kann man eine gefüllte Ellipse zeichnen:

procedure DrawFilledEllipse 
  (cnv: TCanvas; x0, y0: integer; rx, ry: word; fill: Boolean); 
var 
  rx2, ry2, rx4, ry4, F, Fx, Fy, x, y, yy: integer; 
  xx: single; 
begin 
  rx2 := rx * rx; 
  ry2 := ry * ry; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  F := Round(ry2 - rx2 * ry + 0.25 * rx); 
  Fx := 0; 
  Fy := rx4 * ry; 
  x := 0; 
  y := ry; 
  SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
  SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  while Fx < Fy do begin 
    if F >= 0 then begin 
      dec(y); 
      Fy := Fy - rx4; 
      F := F - Fy; 
    end; 
    inc(x); 
    Fx := Fx + ry4; 
    F := F + Fx + ry2; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
  xx := x + 0.5; 
  yy := pred(y); 
  F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
  while y > 0 do begin 
    if F <= 0 then begin 
      inc(x); 
      Fx := Fx + ry4; 
      F := F + Fx; 
    end; 
    dec(y); 
    Fy := Fy - rx4; 
    F := F + rx2 - Fy; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
  if fill then 
    ExtFloodfill(cnv.handle, x0, y0, cnv.pen.color, FLOODFILLBORDER); 
end; 

// Beispielaufruf 

procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Canvas.pen.color := clRed; 
  Canvas.brush.color := clBlack; 
  DrawFilledEllipse(canvas, 200, 100, 80, 40, true); 
end; 
 
 
// 4. Variante 3 hat einen entscheidenden Nachteil. Wenn beispielsweise
// Linien (gleicher Farbe) die Ellipse schneiden, wird diese nicht
// vollständig gefüllt.



// Das überwindet der folgende Code:

procedure DrawFilledEllipseX 
  (cnv: TCanvas; x0, y0: integer; rx, ry: word; fill: Boolean); 
var 
  rx2, ry2, rx4, ry4, F, Fx, Fy, x, y, yy: integer; 
  xx: single; 
  procedure teil; 
  begin 
    if fill then begin 
      cnv.fillrect(rect(x0 + x + 1, y0 - y + 1, x0, y0 + y)); 
      cnv.fillrect(rect(x0 - x, y0 - y + 1, x0, y0 + y)); 
    end; 
    SetPixel(cnv.handle, x0 + x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
begin 
  rx2 := rx * rx; 
  ry2 := ry * ry; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  F := Round(ry2 - rx2 * ry + 0.25 * rx); 
  Fx := 0; 
  Fy := rx4 * ry; 
  x := 0; 
  y := ry; 
  SetPixel(cnv.handle, x0, y0 + y, cnv.pen.color); 
  SetPixel(cnv.handle, x0, y0 - y, cnv.pen.color); 
  if fill then 
    cnv.fillrect(rect(x0, y0 - y + 1, x0 + 1, y0 + y)); 
  while Fx < Fy do begin 
    if F >= 0 then begin 
      dec(y); 
      Fy := Fy - rx4; 
      F := F - Fy; 
    end; 
    inc(x); 
    Fx := Fx + ry4; 
    F := F + Fx + ry2; 
    Teil; 
  end; 
  xx := x + 0.5; 
  yy := pred(y); 
  F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
  while y > 0 do begin 
    if F <= 0 then begin 
      inc(x); 
      Fx := Fx + ry4; 
      F := F + Fx; 
    end; 
    dec(y); 
    Fy := Fy - rx4; 
    F := F + rx2 - Fy; 
    Teil; 
  end; 
end;

// Beispielaufruf

procedure TForm1.Button4Click(Sender: TObject); 
begin 
  Canvas.pen.color := clRed; 
  Canvas.brush.color := clBlack; 
  DrawFilledEllipseX(canvas, 200, 100, 80, 40, true); 
end; 
 

 
// 5. Da die meisten Progger gewöhnt sind, in Delphi die vier Eckpunkte des
// umschreibenden Rechtecks anzugeben, habe ich den Code entsprechend
// abgeändert. Außerdem kann man damit (im Gegensatz zu den anderen Varianten)
// auch Ellipsen zeichnen, welche ungerade Abmaße haben.

procedure DrawEllipseFR(cnv: TCanvas; x1, y1, x2, y2: integer; fill: boolean); 
var 
  rx, ry, rx2, ry2, rx4, ry4, F, Fx, Fy, x, y, yy, x0, y0, dx, dy: integer; 
  xx: single; 
  procedure teil; 
  begin 
    if fill then begin 
      cnv.fillrect(rect(x0 + x + 1 - dx, y0 - y + 1, x0, y0 + y - dy)); 
      cnv.fillrect(rect(x0 - x, y0 - y + 1, x0, y0 + y - dy)); 
    end; 
    SetPixel(cnv.handle, x0 + x - dx, y0 + y - dy, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 + y - dy, cnv.pen.color); 
    SetPixel(cnv.handle, x0 + x - dx, y0 - y, cnv.pen.color); 
    SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  end; 
begin 
  if x2 < x1 then begin 
    x := x1; 
    x1 := x2; 
    x2 := x; 
  end; 
  if y2 < y1 then begin 
    y := y1; 
    y1 := y2; 
    y2 := y; 
  end; 
  rx := (x2 - x1) div 2; 
  dx := ord(not odd(x2 - x1)); 
  ry := (y2 - y1) div 2; 
  dy := ord(not odd(y2 - y1)); 
  x0 := x1 + rx; 
  y0 := y1 + ry; 
  rx2 := rx * rx; 
  ry2 := ry * ry; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  F := Round(ry2 - rx2 * ry + 0.25 * rx); 
  Fx := 0; 
  Fy := 2 * rx2 * ry; 
  x := 0; 
  y := ry; 
  SetPixel(cnv.handle, x0 + x - dx, y0 + y - dy, cnv.pen.color); 
  SetPixel(cnv.handle, x0 - x, y0 - y, cnv.pen.color); 
  if fill then 
    cnv.fillrect(rect(x0, y0 - y + 1, x0 + 1, y0 + y)); 
  while Fx < Fy do begin 
    if F >= 0 then begin 
      dec(y); 
      Fy := Fy - rx4; 
      F := F - Fy; 
    end; 
    inc(x); 
    Fx := Fx + ry4; 
    F := F + Fx + ry2; 
    Teil; 
  end; 
  xx := x + 0.5; 
  yy := pred(y); 
  F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
  while y > 0 do begin 
    if F <= 0 then begin 
      inc(x); 
      Fx := Fx + ry4; 
      F := F + Fx; 
    end; 
    dec(y); 
    Fy := Fy - rx4; 
    F := F + rx2 - Fy; 
    Teil; 
  end; 
end; 

// Beispielaufruf

procedure TForm1.Button5Click(Sender: TObject); 
begin 
  Canvas.pen.color := clRed; 
  Canvas.brush.color := clBlack; 
  DrawEllipseFR(canvas, 120, 60, 281, 141, true); 
end;

// 6. Das Einfachste ist natürlich das übliche Zeichnen der Ellipse,
// wie es in Delphi (mittels GDI) vordefiniert ist. Wenn man Ellipsen beider
// Arten übereinanderlegt, sieht man aber minimale Unterschiede.

procedure TForm1.Button6Click(Sender: TObject);
begin
Canvas.pen.color := clBlack;
DrawEllipseFR(canvas, 120, 60, 281, 141, False);

Canvas.pen.color := clYellow;
Canvas.brush.Style := bsClear;
Canvas.Ellipse(120, 60, 281, 141);
end;

// Den Unterschied sieht man auch, wenn mehrere ungefüllte Ellipsen
// folgendermaßen ineinander gezeichnet werden:

procedure TForm1.Button7Click(Sender: TObject); 
var x: integer; 
begin 
  Canvas.pen.color := clnavy; 
  Canvas.brush.Style := bsClear; 
  for x := 0 to 60 do begin 
    DrawEllipseFR(canvas, 100 - x, 60, 100 + x, 150, False); 
    Canvas.Ellipse(230 - x, 60, 230 + x, 150); 
  end; 
end;


Bresenham	GDI

// Warum aber eine Ellipse von Hand konstruieren, wenn Delphi das ganz von
// alleine kann? Nun, manchmal braucht man die einzelnen Punkte der Ellipse,
// um etwas anderes damit zu machen, als nur eine Ellipse zu zeichnen.
// Siehe dazu: Bilder zu einer Röhre formen