How to create a Twist / Swirl effect in Delphi

Problem/Question/Abstract:

How to create a Twist / Swirl effect in Delphi

Answer:

Here's an effect I call 'Twist'. It operates on 24-bit bitmaps using scanline. b and tBufr are TBitmaps, declared and instantiated elsewhere. It assumes b has the original bitmap on which to perform the Twist. tBufr is used as a work area. Results are displayed in a TImage. You would use this in a button click something like:


{ ... }
try
  try
    begin
      b := TBitmap.Create;
      tBufr := TBitmap.Create;
      CopyMe(b, Image1.Picture.Graphic); {copy image to b}
      Twist(100);
    end;
  finally
    begin
      b.Free;
      tBufr.Free;
    end;
  end;
except
  raise ESomeErrorWarning.Create('Kaboom!');
end;
{ ... }


Hope this is what you were looking for:


{A procedure to copy a graphic to a bitmap}

procedure TForm1.CopyMe(tobmp: TBitmap; frbmp: TGraphic);
begin
  tobmp.PixelFormat := pf24bit;
  tobmp.Width := frbmp.Width;
  tobmp.Height := frbmp.Height;
  tobmp.Canvas.Draw(0, 0, frbmp);
end;

procedure TForm1.Twist(Amount: integer);
var
  fxmid, fymid: Single;
  txmid, tymid: Single;
  fx, fy: Single;
  tx2, ty2: Single;
  r: Single;
  theta: Single;
  ifx, ify: Integer;
  dx, dy: Single;
  K: integer;
  Offset: Single;
  ty, tx: Integer;
  weight_x, weight_y: array[0..1] of Single;
  weight: Single;
  new_red, new_green: Integer;
  new_blue: Integer;
  total_red, total_green: Single;
  total_blue: Single;
  ix, iy: Integer;
  sli, slo: pRGBArray;

  function ArcTan2(xt, yt: Single): Single;
  begin
    if xt = 0 then
      if yt > 0 then
        Result := Pi / 2
      else
        Result := -(Pi / 2)
    else
    begin
      Result := ArcTan(yt / xt);
      if xt < 0 then
        Result := Pi + ArcTan(yt / xt);
    end;
  end;

begin
  Screen.Cursor := crHourGlass;
  CopyMe(tBufr, b);
  K := Amount; {Adjust this for 'amount' of twist}
  Offset := -(Pi / 2);
  dx := b.Width - 1;
  dy := b.Height - 1;
  r := Sqrt(dx * dx + dy * dy);
  tx2 := r;
  ty2 := r;
  txmid := (b.Width - 1) / 2; {Adjust these to move center of rotation}
  tymid := (b.Height - 1) / 2; {Adjust these to move}
  fxmid := (b.Width - 1) / 2;
  fymid := (b.Height - 1) / 2;
  if tx2 >= b.Width then
    tx2 := b.Width - 1;
  if ty2 >= b.Height then
    ty2 := b.Height - 1;
  for ty := 0 to Round(ty2) do
  begin
    for tx := 0 to Round(tx2) do
    begin
      dx := tx - txmid;
      dy := ty - tymid;
      r := Sqrt(dx * dx + dy * dy);
      if r = 0 then
      begin
        fx := 0;
        fy := 0;
      end
      else
      begin
        theta := ArcTan2(dx, dy) - r / K - Offset;
        fx := r * Cos(theta);
        fy := r * Sin(theta);
      end;
      fx := fx + fxmid;
      fy := fy + fymid;
      ify := Trunc(fy);
      ifx := Trunc(fx);
      {Calculate the weights}
      if fy >= 0 then
      begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end
      else
      begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then
      begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end
      else
      begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;
      if ifx < 0 then
        ifx := b.Width - 1 - (-ifx mod b.Width)
      else if ifx > b.Width - 1 then
        ifx := ifx mod b.Width;
      if ify < 0 then
        ify := b.Height - 1 - (-ify mod b.Height)
      else if ify > b.Height - 1 then
        ify := ify mod b.Height;
      total_red := 0.0;
      total_green := 0.0;
      total_blue := 0.0;
      for ix := 0 to 1 do
      begin
        for iy := 0 to 1 do
        begin
          if ify + iy < b.Height then
            sli := tBufr.Scanline[ify + iy]
          else
            sli := tBufr.ScanLine[b.Height - ify - iy];
          if ifx + ix < b.Width then
          begin
            new_red := sli[ifx + ix].rgbtRed;
            new_green := sli[ifx + ix].rgbtGreen;
            new_blue := sli[ifx + ix].rgbtBlue;
          end
          else
          begin
            new_red := sli[b.Width - ifx - ix].rgbtRed;
            new_green := sli[b.Width - ifx - ix].rgbtGreen;
            new_blue := sli[b.Width - ifx - ix].rgbtBlue;
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red := total_red + new_red * weight;
          total_green := total_green + new_green * weight;
          total_blue := total_blue + new_blue * weight;
        end;
      end;
      slo := b.ScanLine[ty];
      slo[tx].rgbtRed := Round(total_red);
      slo[tx].rgbtGreen := Round(total_green);
      slo[tx].rgbtBlue := Round(total_blue);
    end;
  end;
  Image1.Picture.Assign(b);
  Screen.Cursor := crDefault;
end;