type 
  prozent = 0..100; 
 
var 
  farr: array of array of boolean; 
 
procedure EllipseX(bm: TBitmap; x1, y1, x2, y2, penwidth: integer; 
  pencolor, fillcolor: Tcolor; transp, transf: prozent); 
var 
  x, y, k, a, b, ab, a2, b2, mx, my, x11, x22, y11, y22: integer; 
  rp, gp, bp, rf, gf, bf: byte; 
  rstp, rstf: prozent; 
  procedure go(xx1, yy1, xx2, yy2: integer; r, g, b: byte; 
    trans, rst: prozent); 
  var 
    i, j, x13, x23: integer; 
    p: PBytearray; 
  begin 
    if xx1 < 0 then xx1 := 0; 
    if xx2 > bm.width then xx2 := bm.width; 
    if yy1 < 0 then yy1 := 0; 
    if yy2 > bm.height then yy2 := bm.height; 
    x13 := xx1 * 3; 
    x23 := xx2 * 3; 
    for j := yy1 to yy2 - 1 do begin 
      p := bm.scanline[j]; 
      k := x13; 
      while k < x23 do begin 
        i := k div 3; 
        if not farr[i - x1, j - y1] 
          and (b2 * sqr(mx - i) + a2 * sqr(my - j) <= ab) 
          then begin 
          farr[i - x1, j - y1] := true; 
          p[k] := (b * rst + p[k] * trans) div 100; 
          p[k + 1] := (g * rst + p[k + 1] * trans) div 100; 
          p[k + 2] := (r * rst + p[k + 2] * trans) div 100; 
        end; 
        inc(k, 3); 
      end; 
    end; 
  end; 
  procedure rechnen(xx1, yy1, xx2, yy2: integer); 
  begin 
    a := (xx2 - xx1) div 2; 
    b := (yy2 - yy1) div 2; 
    a2 := sqr(a); 
    b2 := sqr(b); 
    ab := a2 * b2 - ord(odd(penwidth)); 
    mx := xx1 + a; 
    my := yy1 + b; 
  end; 
begin 
  rstp := 100 - transp; 
  rstf := 100 - transf; 
  if x1 > x2 then begin 
    x := x1; 
    x1 := x2; 
    x2 := x; 
  end; 
  if y1 > y2 then begin 
    y := y1; 
    y1 := y2; 
    y2 := y; 
  end; 
  setlength(farr, x2 - x1 + 1, y2 - y1 + 1); 
  for x := 0 to x2 - x1 do 
    for y := 0 to y2 - y1 do 
      farr[x, y] := false; 
  x11 := x1 + penwidth; 
  x22 := x2 - penwidth; 
  y11 := y1 + penwidth; 
  y22 := y2 - penwidth; 
  pencolor := ColorToRGB(pencolor); 
  fillcolor := ColorToRGB(fillcolor); 
  rp := getrvalue(pencolor); 
  gp := getgvalue(pencolor); 
  bp := getbvalue(pencolor); 
  rf := getrvalue(fillcolor); 
  gf := getgvalue(fillcolor); 
  bf := getbvalue(fillcolor); 
  bm.pixelformat := pf24bit; 
  rechnen(x11, y11, x22, y22); 
  go(x11, y11, x22, y22, rf, gf, bf, transf, rstf); 
  if penwidth > 0 then begin 
    rechnen(x1, y1, x2, y2); 
    go(x1, y1, x2, y2, rp, gp, bp, transp, rstp); 
  end; 
  farr := nil; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  with image1.picture do begin 
 
    // solide Ellipse 
    EllipseX(bitmap, 11, 20, 50, 74, 5, clwhite, clblue, 0, 0); 
 
    // Füllung durchscheinend 
    EllipseX(bitmap, 51, 20, 90, 74, 5, clwhite, clblue, 0, 70); 
 
    // Füllung und Rand durchscheinend 
    EllipseX(bitmap, 91, 20, 130, 74, 5, clwhite, clblue, 60, 70); 
 
    refresh; 
  end; 
end;