type
 TRGB = packed record
   B, G, R: Byte;
 end;
 pRGB = ^TRGB;

function ILimit(Val, AMin, AMax: Integer): Integer;
begin
 Result := Min(Max(Val, AMin), AMax);
end;

procedure Lens(Bitmap: TBitmap; xx, yy, Width, Height: Integer; Refraction: Double);

 procedure find_projected_pos(Refraction, a, b, x, y: Double; projx, projy: pDouble);
 var c, ri1, ri2, nxangle, nyangle, theta1, theta2: Double;
     n: array [0..2] of Double;
 begin
   ri1 := 1.0;
   ri2 := Refraction;
   c := DMin(a, b);
   n[0] := x;
   n[1] := y;
   n[2] := Sqrt((1 - x*x/(a*a) - y*y/(b*b))*(c*c));
   nxangle := Cos(n[0]/Sqrt(n[0]*n[0] + n[2]*n[2]));
   theta1 := PI/2 - nxangle;
   theta2 := ArcSin(Sin(theta1)*ri1/ri2);
   theta2 := PI/2 - nxangle - theta2;
   projx^ := x - Tan(theta2)*n[2];
   nyangle := ArcCos(n[1] / Sqrt(n[1]*n[1] + n[2]*n[2]));
   theta1 := PI/2 - nyangle;
   theta2 := ArcSin(Sin(theta1) * ri1/ri2);
   theta2 := PI/2 - nyangle - theta2;
   projy^ := y - Tan(theta2) * n[2];
 end;
var row, col, scol, srow,
   RegionWidth, RegionHeight, x1, y1, x2, y2: Integer;
   px1, px2: pRGB;
   dx, dy, xsqr, ysqr, a, b, asqr, bsqr, x, y: Double;
   Bmp: TBitmap;
begin
 x1 := Width div 2;
 y1 := Height div 2;
 x2 := xx + x1;
 y2 := yy + y1;
 if Refraction < 1 then Refraction := 1;
 RegionWidth := x2 - x1;
 a := RegionWidth / 2;
 RegionHeight := y2 - y1;
 b := RegionHeight / 2;
 asqr := Sqr(a);
 bsqr := Sqr(b);
 Bmp := TBitmap.Create;
 Bmp.PixelFormat := Bitmap.PixelFormat;
 Bmp.Width := RegionWidth;
 Bmp.Height := RegionHeight;
 try
   for col := 0 to RegionWidth - 1 do begin
     dx := col - a + 0.5;
     xsqr := Sqr(dx);
     for row := 0 to RegionHeight - 1 do begin
       dy := -(row - b) - 0.5;
       ysqr := Sqr(dy);
       px1 := Bmp.ScanLine[row];
       Inc(px1, col);
       if (ysqr < (bsqr - (bsqr*xsqr)/asqr)) then begin
  find_projected_pos(refraction, a, b, dx, dy, @x, @y);
         y := -y;
         srow := Trunc(y + b);
         srow := ILimit(srow, 0, Bitmap.Height - 1);
         scol := Trunc(x + a);
         scol := ILimit(scol, 0, Bitmap.Width - 1);
         px2 := Bitmap.ScanLine[y1 + srow];
         Inc(px2, x1 + scol);
         px1^ := px2^;
       end
       else begin
         px2 := Bitmap.ScanLine[y1 + row];
         Inc(px2, x1 + col);
         px1^ := px2^;
       end;
     end;
   end;
   Bitmap.Canvas.Draw(x1, y1, Bmp);
 finally
   Bmp.Free;
 end;
end;