Искажение видео

[zumm]

Доброго всем! Народ, возникла необходимость искажать видео записываемое с веб камеры. Искажения типа "выпуклая линза". Как это сделать - ума не приложу. Для записи видео используется TVideoGrabber, если что. Как вообще происходит процесс искажения? Что для этого стоит использовать? Есть какие нибудь идеи?

[raxp]

...идеи, они конечно есть: приложить линзу выпуклую к объективу , а вообще добавить в цепочку соответствующий фильтр-обработчик (если бы речь шла о видеозахвате средствами DirectShow). По сути, выхватить изображение-кадр, провести обработку и передать дальше.

Как основа, пример над изображением:

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;

А кстати, вот тут http://algolist.manual.ru/graphics/effect/overlens.php хорошо расписан алгоритм линзы с примерами кода.

[Вадим Мошев]

Программа WebCam Max

[zumm]

raxp, спасибо. теперь хоть понятно что к чему. с линзой получилось. а вот с закручиванием что то не очень. не могли бы вы посоветовать алгоритм?

[raxp]

...в смысле, вот это скручивание http://algolist.manual.ru/graphics/effect/bend.php ?

[NetSpace]

мой приятель просто отломал от какой-то ненужной детсткой игрушки прозрачную выпуклую пластмасску и прицепил скотчем на свою веб-камеру. и получил очень забавный эффект - выпуклость своего лица, как в мыльном пузыре.