Как сделать Twist / Swirl эффект?
01.01.2007
{ ... } 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;
Взято с Delphi Knowledge Base: https://www.baltsoft.com/