type 
  Intensitaet = 1..7; 
 
procedure roteAugen(bm: TBitmap; x1, y1, x2, y2: integer; intensiv: Intensitaet); 
var x, y, z, a, b, a2, b2, ab, mx, my, gr: integer; 
  p: pbytearray; 
begin 
  bm.pixelformat := pf24bit; 
  if x1 > x2 then begin 
    x := x1; 
    x1 := x2; 
    x2 := x; 
  end; 
  if x1 < 0 then x1 := 0; 
  if x2 > bm.width - 1 then x2 := bm.width - 1; 
  if y1 > y2 then begin 
    y := y1; 
    y1 := y2; 
    y2 := y; 
  end; 
  if y1 < 0 then y1 := 0; 
  if y2 > bm.height - 1 then y2 := bm.height - 1; 
  a := round((x2 - x1) / 2); 
  b := round((y2 - y1) / 2); 
  a2 := sqr(a); 
  b2 := sqr(b); 
  ab := a2 * b2; 
  mx := x1 + a; 
  my := y1 + b; 
  for z := 1 to intensiv do 
    for y := y1 to y2 do 
    begin 
      p := bm.scanline[y]; 
      for x := x1 to x2 do begin 
        if b2 * sqr(mx - x) + a2 * sqr(my - y) <= ab then begin 
          gr := (p[x * 3 + 2] + p[x * 3 + 1] + p[x * 3]) div 3 - intensiv; 
          if gr < 0 then gr := 0; 
          if (gr < 182) 
            then begin 
            if (p[x * 3] > p[x * 3 + 1]) 
              and (p[x * 3] > p[x * 3 + 2]) 
              then p[x * 3] := gr else 
              if (p[x * 3 + 1] > p[x * 3]) and 
                (p[x * 3 + 1] > p[x * 3 + 2]) 
                then p[x * 3 + 1] := gr else 
                if (p[x * 3 + 2] > p[x * 3]) 
                  and (p[x * 3 + 2] > p[x * 3 + 1]) 
                  then 
                  p[x * 3 + 2] := gr 
                else begin 
                  p[x * 3] := gr; 
                  p[x * 3 + 1] := gr; 
                  p[x * 3 + 2] := gr; 
                end; 
          end; 
        end; 
      end; 
    end; 
end; 
 
 
// Beispielaufruf: 
// Es muss in die Mitte der Pupille geklickt werden. 
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var 
  groesse: integer; 
  bm: TBitmap; 
begin 
// -------- JPeg umwandeln ----------------- 
  bm := TBitmap.create; 
  bm.assign(Image1.picture.graphic); 
// ----------------------------------------- 
  groesse := 24; // je nach Pupillen-Größe 
  roteAugen(bm, x - groesse div 2, y - groesse div 2, 
    x + groesse div 2, y + groesse div 2, 4); 
  Image1.refresh; 
  bm.free; 
end;