{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvPaintFX.PAS, released on 2002-06-15. The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. All Rights Reserved. Contributor(s): Robert Love [rlove att slcdug dott org]. You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} // $Id: JvPaintFX.pas 10612 2006-05-19 19:04:09Z jfudickar $ unit JvPaintFX; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} Windows, Messages, Graphics, Controls, Forms, SysUtils, Classes; type // Type of a filter for use with Stretch() TFilterProc = function(Value: Single): Single; TLightBrush = (lbBrightness, lbContrast, lbSaturation, lbFisheye, lbrotate, lbtwist, lbrimple, mbHor, mbTop, mbBottom, mbDiamond, mbWaste, mbRound, mbRound2, mbSplitRound, mbSplitWaste); TJvPaintFX = class(TComponent) public class procedure Solarize(const Src: TBitmap; var Dst: TBitmap; Amount: Integer); class procedure Posterize(const Src: TBitmap; var Dst: TBitmap; Amount: Integer); class procedure Blend(const Src1, Src2: TBitmap; var Dst: TBitmap; Amount: Single); class procedure Blend2(const Src1, Src2: TBitmap; var Dst: TBitmap; Amount: Single); class procedure ExtractColor(const Dst: TBitmap; AColor: TColor); class procedure ExcludeColor(const Dst: TBitmap; AColor: TColor); class procedure Turn(Src, Dst: TBitmap); class procedure TurnRight(Src, Dst: TBitmap); class procedure HeightMap(const Dst: TBitmap; Amount: Integer); class procedure TexturizeTile(const Dst: TBitmap; Amount: Integer); class procedure TexturizeOverlap(const Dst: TBitmap; Amount: Integer); class procedure RippleRandom(const Dst: TBitmap; Amount: Integer); class procedure RippleTooth(const Dst: TBitmap; Amount: Integer); class procedure RippleTriangle(const Dst: TBitmap; Amount: Integer); class procedure Triangles(const Dst: TBitmap; Amount: Integer); class procedure DrawMandelJulia(const Dst: TBitmap; x0, y0, x1, y1: Single; Niter: Integer; Mandel: Boolean); class procedure FilterXBlue(const Dst: TBitmap; Min, Max: Integer); class procedure FilterXGreen(const Dst: TBitmap; Min, Max: Integer); class procedure FilterXRed(const Dst: TBitmap; Min, Max: Integer); class procedure FilterBlue(const Dst: TBitmap; Min, Max: Integer); class procedure FilterGreen(const Dst: TBitmap; Min, Max: Integer); class procedure FilterRed(const Dst: TBitmap; Min, Max: Integer); class procedure Emboss(var Bmp: TBitmap); class procedure Plasma(Src1, Src2, Dst: TBitmap; Scale, Turbulence: Single); class procedure Shake(Src, Dst: TBitmap; Factor: Single); class procedure ShakeDown(Src, Dst: TBitmap; Factor: Single); class procedure KeepBlue(const Dst: TBitmap; Factor: Single); class procedure KeepGreen(const Dst: TBitmap; Factor: Single); class procedure KeepRed(const Dst: TBitmap; Factor: Single); class procedure Mandelbrot(const Dst: TBitmap; Factor: Integer); class procedure MaskMandelbrot(const Dst: TBitmap; Factor: Integer); class procedure FoldRight(Src1, Src2, Dst: TBitmap; Amount: Single); class procedure QuartoOpaque(Src, Dst: TBitmap); class procedure SemiOpaque(Src, Dst: TBitmap); class procedure ShadowDownLeft(const Dst: TBitmap); class procedure ShadowDownRight(const Dst: TBitmap); class procedure ShadowUpLeft(const Dst: TBitmap); class procedure ShadowUpRight(const Dst: TBitmap); class procedure Darkness(const Dst: TBitmap; Amount: Integer); class procedure Trace(const Dst: TBitmap; Intensity: Integer); class procedure FlipRight(const Dst: TBitmap); class procedure FlipDown(const Dst: TBitmap); class procedure SpotLight(const Dst: TBitmap; Amount: Integer; Spot: TRect); class procedure SplitLight(const Dst: TBitmap; Amount: Integer); class procedure MakeSeamlessClip(var Dst: TBitmap; Seam: Integer); class procedure Wave(const Dst: TBitmap; Amount, Inference, Style: Integer); class procedure Mosaic(const Bm: TBitmap; Size: Integer); class procedure SmoothRotate(var Src, Dst: TBitmap; CX, CY: Integer; Angle: Single); class procedure SmoothResize(var Src, Dst: TBitmap); class procedure Twist(var Bmp, Dst: TBitmap; Amount: Integer); class procedure SplitBlur(const Dst: TBitmap; Amount: Integer); class procedure GaussianBlur(const Dst: TBitmap; Amount: Integer); class procedure Smooth(const Dst: TBitmap; Weight: Integer); class procedure GrayScale(const Dst: TBitmap); class procedure AddColorNoise(const Dst: TBitmap; Amount: Integer); class procedure AddMonoNoise(const Dst: TBitmap; Amount: Integer); class procedure Contrast(const Dst: TBitmap; Amount: Integer); class procedure Lightness(const Dst: TBitmap; Amount: Integer); class procedure Saturation(const Dst: TBitmap; Amount: Integer); class procedure Spray(const Dst: TBitmap; Amount: Integer); class procedure AntiAlias(const Dst: TBitmap); class procedure AntiAliasRect(const Dst: TBitmap; XOrigin, YOrigin, XFinal, YFinal: Integer); class procedure SmoothPoint(const Dst: TBitmap; XK, YK: Integer); class procedure FishEye(var Bmp, Dst: TBitmap; Amount: Single); class procedure Marble(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble2(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble3(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble4(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble5(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble6(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble7(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure Marble8(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); class procedure SqueezeHor(Src, Dst: TBitmap; Amount: Integer; Style: TLightBrush); class procedure SplitRound(Src, Dst: TBitmap; Amount: Integer; Style: TLightBrush); class procedure Tile(Src, Dst: TBitmap; Amount: Integer); // Interpolator // Src: Source bitmap // Dst: Destination bitmap // Filter: Weight calculation filter // AWidth: Relative sample radius class procedure Stretch(Src, Dst: TBitmap; Filter: TFilterProc; AWidth: Single); class procedure Grow(Src1, Src2, Dst: TBitmap; Amount: Single; X, Y: Integer); class procedure Invert(Src: TBitmap); class procedure MirrorRight(Src: TBitmap); class procedure MirrorDown(Src: TBitmap); end; // Sample filters for use with Stretch() function SplineFilter(Value: Single): Single; function BellFilter(Value: Single): Single; function TriangleFilter(Value: Single): Single; function BoxFilter(Value: Single): Single; function HermiteFilter(Value: Single): Single; function Lanczos3Filter(Value: Single): Single; function MitchellFilter(Value: Single): Single; const ResampleFilters: array [0..6] of record Name: string; // Filter name Filter: TFilterProc; // Filter implementation Width: Single; // Suggested sampling width/radius end = ( (Name: 'Box'; Filter: BoxFilter; Width: 0.5), (Name: 'Triangle'; Filter: TriangleFilter; Width: 1.0), (Name: 'Hermite'; Filter: HermiteFilter; Width: 1.0), (Name: 'Bell'; Filter: BellFilter; Width: 1.5), (Name: 'B-Spline'; Filter: SplineFilter; Width: 2.0), (Name: 'Lanczos3'; Filter: Lanczos3Filter; Width: 3.0), (Name: 'Mitchell'; Filter: MitchellFilter; Width: 2.0) ); {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvPaintFX.pas $'; Revision: '$Revision: 10612 $'; Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses Math, JvJCLUtils, JvResources, JvTypes; const // TJvRGBTriple = TRGBQuad for VisualCLX bpp = SizeOf(TJvRGBTriple); function TrimInt(N, Min, Max: Integer): Integer; begin if N > Max then Result := Max else if N < Min then Result := Min else Result := N; end; function IntToByte(N: Integer): Byte; begin if N > 255 then Result := 255 else if N < 0 then Result := 0 else Result := N; end; // Just a small function to map the numbers to colors function ConvertColor(Value: Integer): TColor; const Colors: array [0..15] of TColor = ( clBlack, clNavy, clGreen, clAqua, clRed, clPurple, clMaroon, clSilver, clGray, clBlue, clLime, clOlive, clFuchsia, clTeal, clYellow, clWhite ); begin if (Value < 0) or (Value > High(Colors)) then Result := clWhite else Result := Colors[Value]; end; function BellFilter(Value: Single): Single; begin if Value < 0.0 then Value := -Value; if Value < 0.5 then Result := 0.75 - Sqr(Value) else if Value < 1.5 then begin Value := Value - 1.5; Result := 0.5 * Sqr(Value); end else Result := 0.0; end; // a.k.a. "Nearest Neighbour" filter // anme: I have not been able to get acceptable // results with this filter for subsampling. function BoxFilter(Value: Single): Single; begin if (Value > -0.5) and (Value <= 0.5) then Result := 1.0 else Result := 0.0; end; function HermiteFilter(Value: Single): Single; begin // f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 if Value < 0.0 then Value := -Value; if Value < 1.0 then Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0 else Result := 0.0; end; function Lanczos3Filter(Value: Single): Single; function SinC(Value: Single): Single; begin if Value <> 0.0 then begin Value := Value * Pi; Result := Sin(Value) / Value; end else Result := 1.0; end; begin if Value < 0.0 then Value := -Value; if Value < 3.0 then Result := SinC(Value) * SinC(Value / 3.0) else Result := 0.0; end; function MitchellFilter(Value: Single): Single; const B = 1.0 / 3.0; C = 1.0 / 3.0; var T: Single; begin if Value < 0.0 then Value := -Value; T := Sqr(Value); if Value < 1.0 then begin Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * T)) + ((-18.0 + 12.0 * B + 6.0 * C) * T) + (6.0 - 2 * B)); Result := Value / 6.0; end else if Value < 2.0 then begin Value := (((-1.0 * B - 6.0 * C) * (Value * T)) + ((6.0 * B + 30.0 * C) * T) + ((-12.0 * B - 48.0 * C) * Value) + (8.0 * B + 24 * C)); Result := Value / 6.0; end else Result := 0.0; end; // B-spline filter function SplineFilter(Value: Single): Single; var T: Single; begin if Value < 0.0 then Value := -Value; if Value < 1.0 then begin T := Sqr(Value); Result := 0.5 * T * Value - T + 2.0 / 3.0; end else if Value < 2.0 then begin Value := 2.0 - Value; Result := 1.0 / 6.0 * Sqr(Value) * Value; end else Result := 0.0; end; // Triangle filter // a.k.a. "Linear" or "Bilinear" filter function TriangleFilter(Value: Single): Single; begin if Value < 0.0 then Value := -Value; if Value < 1.0 then Result := 1.0 - Value else Result := 0.0; end; class procedure TJvPaintFX.AddColorNoise(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; X, Y: Integer; OPF: TPixelFormat; begin Randomize; OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin Line[X].rgbRed := IntToByte(Line[X].rgbRed + (Random(Amount) - (Amount shr 1))); Line[X].rgbGreen := IntToByte(Line[X].rgbGreen + (Random(Amount) - (Amount shr 1))); Line[X].rgbBlue := IntToByte(Line[X].rgbBlue + (Random(Amount) - (Amount shr 1))); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.AddMonoNoise(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; X, Y, A: Integer; OPF: TPixelFormat; begin Randomize; OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin A := Random(Amount) - (Amount shr 1); Line[X].rgbRed := IntToByte(Line[X].rgbRed + A); Line[X].rgbGreen := IntToByte(Line[X].rgbGreen + A); Line[X].rgbBlue := IntToByte(Line[X].rgbBlue + A); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.AntiAlias(const Dst: TBitmap); begin JvJCLUtils.AntiAlias(Dst); end; class procedure TJvPaintFX.AntiAliasRect(const Dst: TBitmap; XOrigin, YOrigin, XFinal, YFinal: Integer); begin {$IFDEF VCL} JvJCLUtils.AntiAliasRect(Dst, XOrigin, YOrigin, XFinal, YFinal); {$ENDIF VCL} {$IFDEF VisualCLX} JvQJCLUtils.AntiAliasRect(Dst, XOrigin, YOrigin, XFinal, YFinal); {$ENDIF VisualCLX} end; class procedure TJvPaintFX.Contrast(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; RG, GG, BG, R, G, B, X, Y: Integer; OPF: TPixelFormat; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin R := Line[X].rgbRed; G := Line[X].rgbGreen; B := Line[X].rgbBlue; RG := (Abs(127 - R) * Amount) div 255; GG := (Abs(127 - G) * Amount) div 255; BG := (Abs(127 - B) * Amount) div 255; if R > 127 then R := R + RG else R := R - RG; if G > 127 then G := G + GG else G := G - GG; if B > 127 then B := B + BG else B := B - BG; Line[X].rgbRed := IntToByte(R); Line[X].rgbGreen := IntToByte(G); Line[X].rgbBlue := IntToByte(B); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.FishEye(var Bmp, Dst: TBitmap; Amount: Single); var xmid, ymid: Single; fx, fy: Single; r1, r2: Single; ifx, ify: Integer; DX, DY: Single; rmax: Single; ty, tx: Integer; WeightX, WeightY: 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: PJvRGBArray; begin xmid := Bmp.Width / 2; ymid := Bmp.Height / 2; rmax := Dst.Width * Amount; for ty := 0 to Dst.Height - 1 do begin for tx := 0 to Dst.Width - 1 do begin DX := tx - xmid; DY := ty - ymid; r1 := Sqrt(DX * DX + DY * DY); if r1 = 0 then begin fx := xmid; fy := ymid; end else begin r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1); fx := DX * r2 / r1 + xmid; fy := DY * r2 / r1 + ymid; end; ify := Trunc(fy); ifx := Trunc(fx); // Calculate the weights. if fy >= 0 then begin WeightY[1] := fy - ify; WeightY[0] := 1 - WeightY[1]; end else begin WeightY[0] := -(fy - ify); WeightY[1] := 1 - WeightY[0]; end; if fx >= 0 then begin WeightX[1] := fx - ifx; WeightX[0] := 1 - WeightX[1]; end else begin WeightX[0] := -(fx - ifx); WeightX[1] := 1 - WeightX[0]; end; if ifx < 0 then ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width) else if ifx > Bmp.Width - 1 then ifx := ifx mod Bmp.Width; if ify < 0 then ify := Bmp.Height - 1 - (-ify mod Bmp.Height) else if ify > Bmp.Height - 1 then ify := ify mod Bmp.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 < Bmp.Height then sli := Bmp.ScanLine[ify + iy] else sli := Bmp.ScanLine[Bmp.Height - ify - iy]; if ifx + ix < Bmp.Width then begin new_red := sli[ifx + ix].rgbRed; new_green := sli[ifx + ix].rgbGreen; new_blue := sli[ifx + ix].rgbBlue; end else begin new_red := sli[Bmp.Width - ifx - ix].rgbRed; new_green := sli[Bmp.Width - ifx - ix].rgbGreen; new_blue := sli[Bmp.Width - ifx - ix].rgbBlue; end; Weight := WeightX[ix] * WeightY[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 := Dst.ScanLine[ty]; slo[tx].rgbRed := Round(total_red); slo[tx].rgbGreen := Round(total_green); slo[tx].rgbBlue := Round(total_blue); end; end; end; class procedure TJvPaintFX.GaussianBlur(const Dst: TBitmap; Amount: Integer); var I: Integer; OPF: TPixelFormat; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for I := Amount downto 0 do SplitBlur(Dst, 3); Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.GrayScale(const Dst: TBitmap); var Line: PJvRGBArray; Gray, X, Y: Integer; OPF: TPixelFormat; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin Gray := Round(Line[X].rgbRed * 0.3 + Line[X].rgbGreen * 0.59 + Line[X].rgbBlue * 0.11); Line[X].rgbRed := Gray; Line[X].rgbGreen := Gray; Line[X].rgbBlue := Gray; end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.Lightness(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; R, G, B, X, Y: Integer; OPF: TPixelFormat; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin R := Line[X].rgbRed; G := Line[X].rgbGreen; B := Line[X].rgbBlue; Line[X].rgbRed := IntToByte(R + ((255 - R) * Amount) div 255); Line[X].rgbGreen := IntToByte(G + ((255 - G) * Amount) div 255); Line[X].rgbBlue := IntToByte(B + ((255 - B) * Amount) div 255); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.Darkness(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; R, G, B, X, Y: Integer; OPF: TPixelFormat; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin R := Line[X].rgbRed; G := Line[X].rgbGreen; B := Line[X].rgbBlue; Line[X].rgbRed := IntToByte(R - (R * Amount) div 255); Line[X].rgbGreen := IntToByte(G - (G * Amount) div 255); Line[X].rgbBlue := IntToByte(B - (B * Amount) div 255); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.Marble(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Cos((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -Scale * Sin((X mod Turbulence) / Scale); XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble2(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Cos((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -Scale * Sin((X mod Turbulence) / Scale); XM := Round(Abs(X + XX - YY)); YM := Round(Abs(Y + YY - XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble3(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Cos((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -Scale * Sin((X mod Turbulence) / Scale); XM := Round(Abs(X - XX + YY)); YM := Round(Abs(Y - YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble4(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Sin((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -Scale * Cos((X mod Turbulence) / Scale); XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble5(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := H - 1 downto 0 do begin YY := Scale * Cos((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := W - 1 downto 0 do begin XX := -Scale * Sin((X mod Turbulence) / Scale); XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble6(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Cos((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -tan((X mod Turbulence) / Scale) / Scale; XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble7(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin YY := Scale * Sin((Y mod Turbulence) / Scale); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin XX := -tan((X mod Turbulence) / Scale) / (Scale * Scale); XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Marble8(const Src: TBitmap; var Dst: TBitmap; Scale: Single; Turbulence: Integer); var X, XM, Y, YM: Integer; XX, YY: Single; Line1, Line2: PJvRGBArray; W, H: Integer; ax: Single; Source: TBitmap; begin if Src = nil then Exit; if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Source := TBitmap.Create; Source.Assign(Src); Dst.PixelFormat := pf24bit; Source.PixelFormat := pf24bit; H := Src.Height; W := Src.Width; for Y := 0 to H - 1 do begin ax := (Y mod Turbulence) / Scale; YY := Scale * Sin(ax) * Cos(1.5 * ax); Line1 := Source.ScanLine[Y]; for X := 0 to W - 1 do begin ax := (X mod Turbulence) / Scale; XX := -Scale * Sin(2 * ax) * Cos(ax); XM := Round(Abs(X + XX + YY)); YM := Round(Abs(Y + YY + XX)); if (YM < H) and (XM < W) then begin Line2 := Dst.ScanLine[YM]; Line2[XM] := Line1[X]; end; end; end; Source.Free; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Saturation(const Dst: TBitmap; Amount: Integer); var Line: PJvRGBArray; Gray, R, G, B, X, Y: Integer; begin for Y := 0 to Dst.Height - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin R := Line[X].rgbRed; G := Line[X].rgbGreen; B := Line[X].rgbBlue; Gray := (R + G + B) div 3; Line[X].rgbRed := IntToByte(Gray + (((R - Gray) * Amount) div 255)); Line[X].rgbGreen := IntToByte(Gray + (((G - Gray) * Amount) div 255)); Line[X].rgbBlue := IntToByte(Gray + (((B - Gray) * Amount) div 255)); end; end; end; class procedure TJvPaintFX.Smooth(const Dst: TBitmap; Weight: Integer); var Line, Line1, Line2, Line3: PJvRGBArray; W, H, X, Y: Integer; Src: TBitmap; OPF: TPixelFormat; begin if (Dst.Height < 2) or (Dst.Width < 2) then Exit; W := Dst.Width; H := Dst.Height; Src := TBitmap.Create; Src.Assign(Dst); OPF := Dst.PixelFormat; Src.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; for Y := 1 to H - 2 do begin Line := Dst.ScanLine[Y]; Line1 := Src.ScanLine[Y-1]; Line2 := Src.ScanLine[Y]; Line3 := Src.ScanLine[Y+1]; Line[0].rgbRed := (Line2[0].rgbRed + Line2[1].rgbRed + Line1[0].rgbRed + Line3[0].rgbRed) div 4; Line[0].rgbGreen := (Line2[0].rgbGreen + Line2[1].rgbGreen + Line1[0].rgbGreen + Line3[0].rgbGreen) div 4; Line[0].rgbBlue := (Line2[0].rgbBlue + Line2[1].rgbBlue + Line1[0].rgbBlue + Line3[0].rgbBlue) div 4; Line[W-1].rgbRed := (Line2[W-2].rgbRed + Line2[W-1].rgbRed + Line1[W-1].rgbRed + Line3[W-1].rgbRed) div 4; Line[W-1].rgbGreen := (Line2[W-2].rgbGreen + Line2[W-1].rgbGreen + Line1[W-1].rgbGreen + Line3[W-1].rgbGreen) div 4; Line[W-1].rgbBlue := (Line2[W-2].rgbBlue + Line2[W-1].rgbBlue + Line1[W-1].rgbBlue + Line3[W-1].rgbBlue) div 4; for X := 1 to W - 2 do begin Line[X].rgbRed := (Line2[X-1].rgbRed + Line2[X+1].rgbRed + Line1[X].rgbRed + Line3[X].rgbRed) div 4; Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4; Line[X].rgbBlue := (Line2[X-1].rgbBlue + Line2[X+1].rgbBlue + Line1[X].rgbBlue + Line3[X].rgbBlue) div 4; end; end; Line := Dst.ScanLine[0]; Line1 := Src.ScanLine[0]; Line2 := Src.ScanLine[0]; Line3 := Src.ScanLine[1]; for X := 1 to Dst.Width - 2 do begin Line[X].rgbRed := (Line2[X-1].rgbRed + Line2[X+1].rgbRed + Line1[X].rgbRed + Line3[X].rgbRed) div 4; Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4; Line[X].rgbBlue := (Line2[X-1].rgbBlue + Line2[X+1].rgbBlue + Line1[X].rgbBlue + Line3[X].rgbBlue) div 4; end; Line := Dst.ScanLine[H-1]; Line1 := Src.ScanLine[H-2]; Line2 := Src.ScanLine[H-1]; Line3 := Src.ScanLine[H-1]; for X := 1 to Dst.Width - 2 do begin Line[X].rgbRed := (Line2[X-1].rgbRed + Line2[X+1].rgbRed + Line1[X].rgbRed + Line3[X].rgbRed) div 4; Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4; Line[X].rgbBlue := (Line2[X-1].rgbBlue + Line2[X+1].rgbBlue + Line1[X].rgbBlue + Line3[X].rgbBlue) div 4; end; Src.Free; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.SmoothPoint(const Dst: TBitmap; XK, YK: Integer); var Pixel: TColor; B, G, R: Cardinal; begin if (XK > 0) and (YK > 0) and (XK < Dst.Width - 1) and (YK < Dst.Height - 1) then with Dst.Canvas do begin Pixel := ColorToRGB(Pixels[XK, YK - 1]); R := GetRValue(Pixel); B := GetGValue(Pixel); G := GetBValue(Pixel); Pixel := ColorToRGB(Pixels[XK + 1, YK]); R := R + GetRValue(Pixel); G := G + GetGValue(Pixel); B := B + GetBValue(Pixel); Pixel := ColorToRGB(Pixels[XK, YK + 1]); R := R + GetRValue(Pixel); G := G + GetGValue(Pixel); B := B + GetBValue(Pixel); Pixel := ColorToRGB(Pixels[XK - 1, YK]); R := R + GetRValue(Pixel); G := G + GetGValue(Pixel); B := B + GetBValue(Pixel); Pixels[XK, YK] := RGB(R div 4, G div 4, B div 4); end; end; class procedure TJvPaintFX.SmoothResize(var Src, Dst: TBitmap); var X, Y, xP, yP, yP2, xP2: Integer; Read, Read2: PByteArray; T, z, z2, iz2: Integer; pc: PByteArray; w1, w2, w3, w4: Integer; Col1r, Col1g, Col1b, Col2r, Col2g, Col2b: Byte; begin xP2 := ((Src.Width - 1) shl 15) div Dst.Width; yP2 := ((Src.Height - 1) shl 15) div Dst.Height; yP := 0; for Y := 0 to Dst.Height - 1 do begin xP := 0; Read := Src.ScanLine[yP shr 15]; if yP shr 16 < Src.Height - 1 then Read2 := Src.ScanLine[yP shr 15 + 1] else Read2 := Src.ScanLine[yP shr 15]; pc := Dst.ScanLine[Y]; z2 := yP and $7FFF; iz2 := $8000 - z2; for X := 0 to Dst.Width - 1 do begin T := xP shr 15; Col1r := Read[T * bpp]; Col1g := Read[T * bpp + 1]; Col1b := Read[T * bpp + 2]; Col2r := Read2[T * bpp]; Col2g := Read2[T * bpp + 1]; Col2b := Read2[T * bpp + 2]; z := xP and $7FFF; w2 := (z * iz2) shr 15; w1 := iz2 - w2; w4 := (z * z2) shr 15; w3 := z2 - w4; pc[X * bpp + 2] := (Col1b * w1 + Read[(T + 1) * bpp + 2] * w2 + Col2b * w3 + Read2[(T + 1) * bpp + 2] * w4) shr 15; pc[X * bpp + 1] := (Col1g * w1 + Read[(T + 1) * bpp + 1] * w2 + Col2g * w3 + Read2[(T + 1) * bpp + 1] * w4) shr 15; pc[X * bpp] := (Col1r * w1 + Read2[(T + 1) * bpp] * w2 + Col2r * w3 + Read2[(T + 1) * bpp] * w4) shr 15; Inc(xP, xP2); end; Inc(yP, yP2); end; end; class procedure TJvPaintFX.SmoothRotate(var Src, Dst: TBitmap; CX, CY: Integer; Angle: Single); type TFColor = record B, G, R: Byte end; var Top, Bottom, Left, Right, eww, nsw, fx, fy, wx, wy: Single; cAngle, sAngle: Double; xDiff, yDiff, ifx, ify, PX, PY, ix, iy, X, Y: Integer; nw, ne, sw, se: TFColor; P1, P2, P3: PByteArray; begin Angle := Angle; Angle := -Angle * Pi / 180; sAngle := Sin(Angle); cAngle := Cos(Angle); xDiff := (Dst.Width - Src.Width) div 2; yDiff := (Dst.Height - Src.Height) div 2; for Y := 0 to Dst.Height - 1 do begin P3 := Dst.ScanLine[Y]; PY := 2 * (Y - CY) + 1; for X := 0 to Dst.Width - 1 do begin PX := 2 * (X - CX) + 1; fx := (((PX * cAngle - PY * sAngle) - 1) / 2 + CX) - xDiff; fy := (((PX * sAngle + PY * cAngle) - 1) / 2 + CY) - yDiff; ifx := Round(fx); ify := Round(fy); if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then begin eww := fx - ifx; nsw := fy - ify; iy := TrimInt(ify + 1, 0, Src.Height - 1); ix := TrimInt(ifx + 1, 0, Src.Width - 1); P1 := Src.ScanLine[ify]; P2 := Src.ScanLine[iy]; nw.R := P1[ifx * bpp]; nw.G := P1[ifx * bpp + 1]; nw.B := P1[ifx * bpp + 2]; ne.R := P1[ix * bpp]; ne.G := P1[ix * bpp + 1]; ne.B := P1[ix * bpp + 2]; sw.R := P2[ifx * bpp]; sw.G := P2[ifx * bpp + 1]; sw.B := P2[ifx * bpp + 2]; se.R := P2[ix * bpp]; se.G := P2[ix * bpp + 1]; se.B := P2[ix * bpp + 2]; Top := nw.B + eww * (ne.B - nw.B); Bottom := sw.B + eww * (se.B - sw.B); P3[X * bpp + 2] := IntToByte(Round(Top + nsw * (Bottom - Top))); Top := nw.G + eww * (ne.G - nw.G); Bottom := sw.G + eww * (se.G - sw.G); P3[X * bpp + 1] := IntToByte(Round(Top + nsw * (Bottom - Top))); Top := nw.R + eww * (ne.R - nw.R); Bottom := sw.R + eww * (se.R - sw.R); P3[X * bpp] := IntToByte(Round(Top + nsw * (Bottom - Top))); end; end; end; end; class procedure TJvPaintFX.SplitBlur(const Dst: TBitmap; Amount: Integer); var p0, P1, P2: PByteArray; CX, X, Y: Integer; Buf: array [0..3, 0..2] of Byte; begin if Amount = 0 then Exit; for Y := 0 to Dst.Height - 1 do begin p0 := Dst.ScanLine[Y]; if Y - Amount < 0 then P1 := Dst.ScanLine[Y] else {Y-Amount>0} P1 := Dst.ScanLine[Y - Amount]; if Y + Amount < Dst.Height then P2 := Dst.ScanLine[Y + Amount] else {Y+Amount>=Height} P2 := Dst.ScanLine[Dst.Height - Y]; for X := 0 to Dst.Width - 1 do begin if X - Amount < 0 then CX := X else {X-Amount>0} CX := X - Amount; Buf[0, 0] := P1[CX * bpp]; Buf[0, 1] := P1[CX * bpp + 1]; Buf[0, 2] := P1[CX * bpp + 2]; Buf[1, 0] := P2[CX * bpp]; Buf[1, 1] := P2[CX * bpp + 1]; Buf[1, 2] := P2[CX * bpp + 2]; if X + Amount < Dst.Width then CX := X + Amount else {X+Amount>=Width} CX := Dst.Width - X; Buf[2, 0] := P1[CX * bpp]; Buf[2, 1] := P1[CX * bpp + 1]; Buf[2, 2] := P1[CX * bpp + 2]; Buf[3, 0] := P2[CX * bpp]; Buf[3, 1] := P2[CX * bpp + 1]; Buf[3, 2] := P2[CX * bpp + 2]; p0[X * bpp] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2; p0[X * bpp + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2; p0[X * bpp + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2; end; end; end; class procedure TJvPaintFX.Spray(const Dst: TBitmap; Amount: Integer); var I, J, X, Y, W, H, Val: Integer; begin H := Dst.Height; W := Dst.Width; for I := 0 to W - 1 do for J := 0 to H - 1 do begin Val := Random(Amount); X := I + Val - Random(Val * 2); Y := J + Val - Random(Val * 2); if (X > -1) and (X < W) and (Y > -1) and (Y < H) then Dst.Canvas.Pixels[I, J] := Dst.Canvas.Pixels[X, Y]; end; end; class procedure TJvPaintFX.Mosaic(const Bm: TBitmap; Size: Integer); var X, Y, I, J: Integer; P1, P2: PJvRGBArray; P1Val: TJvRGBTriple; begin Y := 0; repeat P1 := Bm.ScanLine[Y]; repeat J := 1; repeat P2 := Bm.ScanLine[Y]; X := 0; repeat P1Val := P1[X]; I := 1; repeat P2[X] := P1Val; Inc(X); Inc(I); until (I > Size) or (X >= Bm.Width); until X >= Bm.Width; Inc(J); Inc(Y); until (J > Size) or (Y >= Bm.Height); until (Y >= Bm.Height) or (X >= Bm.Width); until Y >= Bm.Height; end; class procedure TJvPaintFX.Twist(var Bmp, Dst: TBitmap; 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; OFFSET: Single; ty, tx: Integer; WeightX, WeightY: 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: PByteArray; 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 OFFSET := -(Pi / 2); DX := Bmp.Width - 1; DY := Bmp.Height - 1; R := Sqrt(DX * DX + DY * DY); tx2 := R; ty2 := R; txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation tymid := (Bmp.Height - 1) / 2; //Adjust these to move ...... fxmid := (Bmp.Width - 1) / 2; fymid := (Bmp.Height - 1) / 2; if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1; if ty2 >= Bmp.Height then ty2 := Bmp.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 / Amount - 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 WeightY[1] := fy - ify; WeightY[0] := 1 - WeightY[1]; end else begin WeightY[0] := -(fy - ify); WeightY[1] := 1 - WeightY[0]; end; if fx >= 0 then begin WeightX[1] := fx - ifx; WeightX[0] := 1 - WeightX[1]; end else begin WeightX[0] := -(fx - ifx); WeightX[1] := 1 - WeightX[0]; end; if ifx < 0 then ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width) else if ifx > Bmp.Width - 1 then ifx := ifx mod Bmp.Width; if ify < 0 then ify := Bmp.Height - 1 - (-ify mod Bmp.Height) else if ify > Bmp.Height - 1 then ify := ify mod Bmp.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 < Bmp.Height then sli := Bmp.ScanLine[ify + iy] else sli := Bmp.ScanLine[Bmp.Height - ify - iy]; if ifx + ix < Bmp.Width then begin new_red := sli[(ifx + ix) * bpp]; new_green := sli[(ifx + ix) * bpp + 1]; new_blue := sli[(ifx + ix) * bpp + 2]; end else begin new_red := sli[(Bmp.Width - ifx - ix) * bpp]; new_green := sli[(Bmp.Width - ifx - ix) * bpp + 1]; new_blue := sli[(Bmp.Width - ifx - ix) * bpp + 2]; end; Weight := WeightX[ix] * WeightY[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 := Dst.ScanLine[ty]; slo[tx * bpp] := Round(total_red); slo[tx * bpp + 1] := Round(total_green); slo[tx * bpp + 2] := Round(total_blue); end; end; end; class procedure TJvPaintFX.Wave(const Dst: TBitmap; Amount, Inference, Style: Integer); var X, Y: Integer; Bitmap: TBitmap; P1, P2: PByteArray; B: Integer; Angle: Extended; wavex: Integer; begin Bitmap := TBitmap.Create; Bitmap.Assign(Dst); wavex := Style; Angle := Pi / 2 / Amount; for Y := Bitmap.Height - 1 - (2 * Amount) downto Amount do begin P1 := Bitmap.ScanLine[Y]; B := 0; for X := 0 to Bitmap.Width - 1 do begin P2 := Dst.ScanLine[Y + Amount + B]; P2[X * bpp] := P1[X * bpp]; P2[X * bpp + 1] := P1[X * bpp + 1]; P2[X * bpp + 2] := P1[X * bpp + 2]; case wavex of 0: B := Amount * Variant(Sin(Angle * X)); 1: B := Amount * Variant(Sin(Angle * X) * Cos(Angle * X)); 2: B := Amount * Variant(Sin(Angle * X) * Sin(Inference * Angle * X)); end; end; end; Bitmap.Free; end; class procedure TJvPaintFX.MakeSeamlessClip(var Dst: TBitmap; Seam: Integer); var p0, P1, P2: PByteArray; H, W, I, J, sv, sh: Integer; f0, f1, f2: real; begin H := Dst.Height; W := Dst.Width; sv := H div Seam; sh := W div Seam; P1 := Dst.ScanLine[0]; P2 := Dst.ScanLine[H - 1]; for I := 0 to W - 1 do begin P1[I * bpp] := P2[I * bpp]; P1[I * bpp + 1] := P2[I * bpp + 1]; P1[I * bpp + 2] := P2[I * bpp + 2]; end; p0 := Dst.ScanLine[0]; P2 := Dst.ScanLine[sv]; for J := 1 to sv - 1 do begin P1 := Dst.ScanLine[J]; for I := 0 to W - 1 do begin f0 := (P2[I * bpp] - p0[I * bpp]) / sv * J + p0[I * bpp]; P1[I * bpp] := Round(f0); f1 := (P2[I * bpp + 1] - p0[I * bpp + 1]) / sv * J + p0[I * bpp + 1]; P1[I * bpp + 1] := Round(f1); f2 := (P2[I * bpp + 2] - p0[I * bpp + 2]) / sv * J + p0[I * bpp + 2]; P1[I * bpp + 2] := Round(f2); end; end; for J := 0 to H - 1 do begin P1 := Dst.ScanLine[J]; P1[(W - 1) * bpp] := P1[0]; P1[(W - 1) * bpp + 1] := P1[1]; P1[(W - 1) * bpp + 2] := P1[2]; for I := 1 to sh - 1 do begin f0 := (P1[(W - sh) * bpp] - P1[(W - 1) * bpp]) / sh * I + P1[(W - 1) * bpp]; P1[(W - 1 - I) * bpp] := Round(f0); f1 := (P1[(W - sh) * bpp + 1] - P1[(W - 1) * bpp + 1]) / sh * I + P1[(W - 1) * bpp + 1]; P1[(W - 1 - I) * bpp + 1] := Round(f1); f2 := (P1[(W - sh) * bpp + 2] - P1[(W - 1) * bpp + 2]) / sh * I + P1[(W - 1) * bpp + 2]; P1[(W - 1 - I) * bpp + 2] := Round(f2); end; end; end; class procedure TJvPaintFX.SplitLight(const Dst: TBitmap; Amount: Integer); var X, Y, I: Integer; P: PJvRGBArray; OPF: TPixelFormat; function Sinus(A: Integer): Integer; begin Result := Round(Sin(A / 255 * Pi / 2) * 255); end; begin OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; for I := 1 to Amount do for Y := 0 to Dst.Height - 1 do begin P := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin P[X].rgbBlue := Sinus(P[X].rgbBlue); P[X].rgbGreen := Sinus(P[X].rgbGreen); P[X].rgbRed := Sinus(P[X].rgbRed); end; end; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.SqueezeHor(Src, Dst: TBitmap; Amount: Integer; Style: TLightBrush); var DX, X, Y, C, CX: Integer; R: TRect; Bm: TBitmap; p0, P1: PByteArray; begin if Amount > (Src.Width div 2) then Amount := Src.Width div 2; Bm := TBitmap.Create; Bm.PixelFormat := pf24bit; Bm.Height := 1; Bm.Width := Src.Width; CX := Src.Width div 2; p0 := Bm.ScanLine[0]; for Y := 0 to Src.Height - 1 do begin P1 := Src.ScanLine[Y]; for X := 0 to Src.Width - 1 do begin C := X * bpp; p0[C] := P1[C]; p0[C + 1] := P1[C + 1]; p0[C + 2] := P1[C + 2]; end; case Style of mbHor: begin DX := Amount; R := Rect(DX, Y, Src.Width - DX, Y + 1); end; mbTop: begin DX := Round((Src.Height - 1 - Y) / Src.Height * Amount); R := Rect(DX, Y, Src.Width - DX, Y + 1); end; mbBottom: begin DX := Round(Y / Src.Height * Amount); R := Rect(DX, Y, Src.Width - DX, Y + 1); end; mbDiamond: begin DX := Round(Amount * Abs(Cos(Y / (Src.Height - 1) * Pi))); R := Rect(DX, Y, Src.Width - DX, Y + 1); end; mbWaste: begin DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi))); R := Rect(DX, Y, Src.Width - DX, Y + 1); end; mbRound: begin DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi))); R := Rect(CX - DX, Y, CX + DX, Y + 1); end; mbRound2: begin DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi * 2))); R := Rect(CX - DX, Y, CX + DX, Y + 1); end; end; Dst.Canvas.StretchDraw(R, Bm); end; Bm.Free; end; class procedure TJvPaintFX.Tile(Src, Dst: TBitmap; Amount: Integer); var w2, h2, I, J: Integer; Bmp: TBitmap; begin Dst.Assign(Src); if (Amount <= 0) or ((Src.Width div Amount) < 5) or ((Src.Height div Amount) < 5) then Exit; h2 := Src.Width div Amount; w2 := Src.Height div Amount; Bmp := TBitmap.Create; Bmp.Width := w2; Bmp.Height := h2; Bmp.PixelFormat := pf24bit; SmoothResize(Src, Bmp); for J := 0 to Amount - 1 do for I := 0 to Amount - 1 do Dst.Canvas.Draw(I * w2, J * h2, Bmp); Bmp.Free; end; // --------------------------------------------------------------------------- // Interpolator // --------------------------------------------------------------------------- type // Contributor for a pixel TContributor = record Pixel: Integer; // Source pixel Weight: Single; // Pixel Weight end; TContributorList = array [0..0] of TContributor; PContributorList = ^TContributorList; // List of source pixels contributing to a destination pixel TCList = record N: Integer; P: PContributorList; end; TCListList = array [0..0] of TCList; PCListList = ^TCListList; TRGB = packed record R: Single; G: Single; B: Single; end; // Physical bitmap pixel TColorRGB = packed record R: Byte; G: Byte; B: Byte; end; PColorRGB = ^TColorRGB; // Physical bitmap ScanLine (row) TRGBList = packed array [0..0] of TColorRGB; PRGBList = ^TRGBList; class procedure TJvPaintFX.Stretch(Src, Dst: TBitmap; Filter: TFilterProc; AWidth: Single); var xscale, yscale: Single; // Zoom Scale factors I, J, k: Integer; // Loop variables Center: Single; // Filter calculation variables Width, fscale, Weight: Single; // Filter calculation variables Left, Right: Integer; // Filter calculation variables N: Integer; // Pixel number Work: TBitmap; Contrib: PCListList; RGB: TRGB; Color: TColorRGB; SourceLine, DestLine: PRGBList; SourcePixel, DestPixel: PColorRGB; Delta, DestDelta: Integer; SrcWidth, SrcHeight, DstWidth, DstHeight: Integer; function Color2RGB(Color: TColor): TColorRGB; begin Result.R := Color and $000000FF; Result.G := (Color and $0000FF00) shr 8; Result.B := (Color and $00FF0000) shr 16; end; function RGB2Color(Color: TColorRGB): TColor; begin Result := Color.R or (Color.G shl 8) or (Color.B shl 16); end; begin DstWidth := Dst.Width; DstHeight := Dst.Height; SrcWidth := Src.Width; SrcHeight := Src.Height; if (SrcWidth < 1) or (SrcHeight < 1) then raise Exception.CreateRes(@RsESourceBitmapTooSmall); // Create intermediate image to hold horizontal zoom Work := TBitmap.Create; try Work.Height := SrcHeight; Work.Width := DstWidth; // xscale := DstWidth / SrcWidth; // yscale := DstHeight / SrcHeight; // Improvement suggested by David Ullrich: if (SrcWidth = 1) then xscale := DstWidth / SrcWidth else xscale := (DstWidth - 1) / (SrcWidth - 1); if (SrcHeight = 1) then yscale := DstHeight / SrcHeight else yscale := (DstHeight - 1) / (SrcHeight - 1); // This implementation only works on 24-bit images because it uses // TBitmap.ScanLine Src.PixelFormat := pf24bit; Dst.PixelFormat := Src.PixelFormat; Work.PixelFormat := Src.PixelFormat; // -------------------------------------------- // Pre-calculate filter contributions for a row // ----------------------------------------------- GetMem(Contrib, DstWidth * SizeOf(TCList)); // Horizontal sub-sampling // Scales from bigger to smaller Width if (xscale < 1.0) then begin Width := AWidth / xscale; fscale := 1.0 / xscale; for I := 0 to DstWidth - 1 do begin Contrib^[I].N := 0; GetMem(Contrib^[I].P, Trunc(Width * 2.0 + 1) * SizeOf(TContributor)); Center := I / xscale; // Original code: // Left := Ceil(Center - Width); // Right := Floor(Center + Width); Left := Floor(Center - Width); Right := Ceil(Center + Width); for J := Left to Right do begin Weight := Filter((Center - J) / fscale) / fscale; if (Weight = 0.0) then Continue; if (J < 0) then N := -J else if (J >= SrcWidth) then N := SrcWidth - J + SrcWidth - 1 else N := J; k := Contrib^[I].N; Contrib^[I].N := Contrib^[I].N + 1; Contrib^[I].P^[k].Pixel := N; Contrib^[I].P^[k].Weight := Weight; end; end; end else // Horizontal super-sampling // Scales from smaller to bigger Width begin for I := 0 to DstWidth - 1 do begin Contrib^[I].N := 0; GetMem(Contrib^[I].P, Trunc(AWidth * 2.0 + 1) * SizeOf(TContributor)); Center := I / xscale; // Original code: // Left := Ceil(Center - AWidth); // Right := Floor(Center + AWidth); Left := Floor(Center - AWidth); Right := Ceil(Center + AWidth); for J := Left to Right do begin Weight := Filter(Center - J); if (Weight = 0.0) then Continue; if J < 0 then N := -J else if J >= SrcWidth then N := SrcWidth - J + SrcWidth - 1 else N := J; if N < 0 then N := -N; k := Contrib^[I].N; Contrib^[I].N := Contrib^[I].N + 1; Contrib^[I].P^[k].Pixel := N; Contrib^[I].P^[k].Weight := Weight; end; end; end; // ---------------------------------------------------- // Apply filter to sample horizontally from Src to Work // ---------------------------------------------------- for k := 0 to SrcHeight - 1 do begin SourceLine := Src.ScanLine[k]; DestPixel := Work.ScanLine[k]; for I := 0 to DstWidth - 1 do begin RGB.R := 0.0; RGB.G := 0.0; RGB.B := 0.0; for J := 0 to Contrib^[I].N - 1 do begin Color := SourceLine^[Contrib^[I].P^[J].Pixel]; Weight := Contrib^[I].P^[J].Weight; if (Weight = 0.0) then Continue; RGB.R := RGB.R + Color.R * Weight; RGB.G := RGB.G + Color.G * Weight; RGB.B := RGB.B + Color.B * Weight; end; if RGB.R > 255.0 then Color.R := 255 else if RGB.R < 0.0 then Color.R := 0 else Color.R := Round(RGB.R); if RGB.G > 255.0 then Color.G := 255 else if RGB.G < 0.0 then Color.G := 0 else Color.G := Round(RGB.G); if RGB.B > 255.0 then Color.B := 255 else if RGB.B < 0.0 then Color.B := 0 else Color.B := Round(RGB.B); // Set new Pixel value DestPixel^ := Color; // Move on to next column Inc(DestPixel); end; end; // Free the memory allocated for horizontal filter weights for I := 0 to DstWidth - 1 do FreeMem(Contrib^[I].P); FreeMem(Contrib); // ----------------------------------------------- // Pre-calculate filter contributions for a column // ----------------------------------------------- GetMem(Contrib, DstHeight * SizeOf(TCList)); // Vertical sub-sampling // Scales from bigger to smaller Height if (yscale < 1.0) then begin Width := AWidth / yscale; fscale := 1.0 / yscale; for I := 0 to DstHeight - 1 do begin Contrib^[I].N := 0; GetMem(Contrib^[I].P, Trunc(Width * 2.0 + 1) * SizeOf(TContributor)); Center := I / yscale; // Original code: // Left := Ceil(Center - Width); // Right := Floor(Center + Width); Left := Floor(Center - Width); Right := Ceil(Center + Width); for J := Left to Right do begin Weight := Filter((Center - J) / fscale) / fscale; if Weight = 0.0 then Continue; if J < 0 then N := -J else if J >= SrcHeight then N := SrcHeight - J + SrcHeight - 1 else N := J; k := Contrib^[I].N; Contrib^[I].N := Contrib^[I].N + 1; Contrib^[I].P^[k].Pixel := N; Contrib^[I].P^[k].Weight := Weight; end; end end else // Vertical super-sampling // Scales from smaller to bigger Height begin for I := 0 to DstHeight - 1 do begin Contrib^[I].N := 0; GetMem(Contrib^[I].P, Trunc(AWidth * 2.0 + 1) * SizeOf(TContributor)); Center := I / yscale; // Original code: // Left := Ceil(Center - AWidth); // Right := Floor(Center + AWidth); Left := Floor(Center - AWidth); Right := Ceil(Center + AWidth); for J := Left to Right do begin Weight := Filter(Center - J); if Weight = 0.0 then Continue; if J < 0 then N := -J else if J >= SrcHeight then N := SrcHeight - J + SrcHeight - 1 else N := J; k := Contrib^[I].N; Contrib^[I].N := Contrib^[I].N + 1; Contrib^[I].P^[k].Pixel := N; Contrib^[I].P^[k].Weight := Weight; end; end; end; // -------------------------------------------------- // Apply filter to sample vertically from Work to Dst // -------------------------------------------------- SourceLine := Work.ScanLine[0]; if Work.Height > 1 then Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine) else Delta := 0; DestLine := Dst.ScanLine[0]; if Dst.Height > 1 then DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine) else DestDelta := 0; for k := 0 to DstWidth - 1 do begin DestPixel := pointer(DestLine); for I := 0 to DstHeight - 1 do begin RGB.R := 0; RGB.G := 0; RGB.B := 0; // Weight := 0.0; for J := 0 to Contrib^[I].N - 1 do begin Color := PColorRGB(Integer(SourceLine) + Contrib^[I].P^[J].Pixel * Delta)^; Weight := Contrib^[I].P^[J].Weight; if (Weight = 0.0) then Continue; RGB.R := RGB.R + Color.R * Weight; RGB.G := RGB.G + Color.G * Weight; RGB.B := RGB.B + Color.B * Weight; end; if RGB.R > 255.0 then Color.R := 255 else if RGB.R < 0.0 then Color.R := 0 else Color.R := Round(RGB.R); if RGB.G > 255.0 then Color.G := 255 else if RGB.G < 0.0 then Color.G := 0 else Color.G := Round(RGB.G); if RGB.B > 255.0 then Color.B := 255 else if RGB.B < 0.0 then Color.B := 0 else Color.B := Round(RGB.B); DestPixel^ := Color; Inc(Integer(DestPixel), DestDelta); end; Inc(SourceLine, 1); Inc(DestLine, 1); end; // Free the memory allocated for vertical filter weights for I := 0 to DstHeight - 1 do FreeMem(Contrib^[I].P); FreeMem(Contrib); finally Work.Free; end; end; class procedure TJvPaintFX.Grow(Src1, Src2, Dst: TBitmap; Amount: Single; X, Y: Integer); var Bmp: TBitmap; begin Dst.Assign(Src1); Bmp := TBitmap.Create; Bmp.Width := Round(Amount * Src1.Width); Bmp.Height := Round(Amount * Src1.Height); Stretch(Src2, Bmp, ResampleFilters[4].Filter, ResampleFilters[4].Width); Dst.Canvas.Draw(X, Y, Bmp); Bmp.Free; end; class procedure TJvPaintFX.SpotLight(const Dst: TBitmap; Amount: Integer; Spot: TRect); var Bmp: TBitmap; begin Darkness(Dst, Amount); Bmp := TBitmap.Create; Bmp.Width := Dst.Width; Bmp.Height := Dst.Height; Bmp.Canvas.Brush.Color := clBlack; Bmp.Canvas.FillRect(Rect(0, 0, Dst.Width, Dst.Height)); Bmp.Canvas.Brush.Color := clWhite; Bmp.Canvas.Ellipse(Spot.Left, Spot.Top, Spot.Right, Spot.Bottom); Bmp.Transparent := True; Bmp.TransparentColor := clWhite; Dst.Canvas.Draw(0, 0, Bmp); Bmp.Free; end; class procedure TJvPaintFX.FlipDown(const Dst: TBitmap); var Bmp: TBitmap; W, H, X, Y: Integer; PD, PS: PByteArray; begin W := Dst.Width; H := Dst.Height; Bmp := TBitmap.Create; Bmp.Width := W; Bmp.Height := H; Bmp.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin PD := Bmp.ScanLine[Y]; PS := Dst.ScanLine[H - 1 - Y]; for X := 0 to W - 1 do begin PD[X * bpp] := PS[X * bpp]; PD[X * bpp + 1] := PS[X * bpp + 1]; PD[X * bpp + 2] := PS[X * bpp + 2]; end; end; Dst.Assign(Bmp); Bmp.Free; end; class procedure TJvPaintFX.FlipRight(const Dst: TBitmap); var dest: TBitmap; W, H, X, Y: Integer; PD, PS: PByteArray; begin W := Dst.Width; H := Dst.Height; dest := TBitmap.Create; dest.Width := W; dest.Height := H; dest.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin PD := dest.ScanLine[Y]; PS := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin PD[X * bpp] := PS[(W - 1 - X) * bpp]; PD[X * bpp + 1] := PS[(W - 1 - X) * bpp + 1]; PD[X * bpp + 2] := PS[(W - 1 - X) * bpp + 2]; end; end; Dst.Assign(dest); dest.Free; end; class procedure TJvPaintFX.Trace(const Dst: TBitmap; Intensity: Integer); var X, Y, I: Integer; P1, P2, P3, P4: PByteArray; tb, TraceB: Byte; hasb: Boolean; Bitmap: TBitmap; begin Bitmap := TBitmap.Create; Bitmap.Width := Dst.Width; Bitmap.Height := Dst.Height; Bitmap.Canvas.Draw(0, 0, Dst); Bitmap.PixelFormat := pf8bit; Dst.PixelFormat := pf24bit; hasb := False; TraceB := $00; tb := 0; for I := 1 to Intensity do begin for Y := 0 to Bitmap.Height - 2 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y + 1]; P3 := Dst.ScanLine[Y]; P4 := Dst.ScanLine[Y + 1]; X := 0; repeat if P1[X] <> P1[X + 1] then begin if not hasb then begin tb := P1[X + 1]; hasb := True; P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin if P1[X] <> tb then begin P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin P3[(X + 1) * bpp] := TraceB; P3[(X + 1) * bpp + 1] := TraceB; P3[(X + 1) * bpp + 1] := TraceB; end; end; end; if P1[X] <> P2[X] then begin if not hasb then begin tb := P2[X]; hasb := True; P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin if P1[X] <> tb then begin P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin P4[X * bpp] := TraceB; P4[X * bpp + 1] := TraceB; P4[X * bpp + 2] := TraceB; end; end; end; Inc(X); until X >= (Bitmap.Width - 2); end; // do the same in the opposite direction // only when Intensity > 1 if I > 1 then for Y := Bitmap.Height - 1 downto 1 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y - 1]; P3 := Dst.ScanLine[Y]; P4 := Dst.ScanLine[Y - 1]; X := Bitmap.Width - 1; repeat if P1[X] <> P1[X - 1] then begin if not hasb then begin tb := P1[X - 1]; hasb := True; P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin if P1[X] <> tb then begin P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin P3[(X - 1) * bpp] := TraceB; P3[(X - 1) * bpp + 1] := TraceB; P3[(X - 1) * bpp + 2] := TraceB; end; end; end; if P1[X] <> P2[X] then begin if not hasb then begin tb := P2[X]; hasb := True; P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin if P1[X] <> tb then begin P3[X * bpp] := TraceB; P3[X * bpp + 1] := TraceB; P3[X * bpp + 2] := TraceB; end else begin P4[X * bpp] := TraceB; P4[X * bpp + 1] := TraceB; P4[X * bpp + 2] := TraceB; end; end; end; Dec(X); until X <= 1; end; end; Bitmap.Free; end; class procedure TJvPaintFX.ShadowUpLeft(const Dst: TBitmap); var X, Y: Integer; Bitmap: TBitmap; P1, P2: PByteArray; begin Bitmap := TBitmap.Create; Bitmap.Width := Dst.Width; Bitmap.Height := Dst.Height; Bitmap.PixelFormat := pf24bit; Bitmap.Canvas.Draw(0, 0, Dst); for Y := 0 to Bitmap.Height - 5 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y + 4]; for X := 0 to Bitmap.Width - 5 do if P1[X * bpp] > P2[(X + 4) * bpp] then begin P1[X * bpp] := P2[(X + 4) * bpp] + 1; P1[X * bpp + 1] := P2[(X + 4) * bpp + 1] + 1; P1[X * bpp + 2] := P2[(X + 4) * bpp + 2] + 1; end; end; Dst.Assign(Bitmap); Bitmap.Free; end; class procedure TJvPaintFX.ShadowUpRight(const Dst: TBitmap); var X, Y: Integer; Bitmap: TBitmap; P1, P2: PByteArray; begin Bitmap := TBitmap.Create; Bitmap.Width := Dst.Width; Bitmap.Height := Dst.Height; Bitmap.PixelFormat := pf24bit; Bitmap.Canvas.Draw(0, 0, Dst); for Y := 0 to Bitmap.Height - 5 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y + 4]; for X := Bitmap.Width - 1 downto 4 do if P1[X * bpp] > P2[(X - 4) * bpp] then begin P1[X * bpp] := P2[(X - 4) * bpp] + 1; P1[X * bpp + 1] := P2[(X - 4) * bpp + 1] + 1; P1[X * bpp + 2] := P2[(X - 4) * bpp + 2] + 1; end; end; Dst.Assign(Bitmap); Bitmap.Free; end; class procedure TJvPaintFX.ShadowDownLeft(const Dst: TBitmap); var X, Y: Integer; Bitmap: TBitmap; P1, P2: PByteArray; begin Bitmap := TBitmap.Create; Bitmap.Width := Dst.Width; Bitmap.Height := Dst.Height; Bitmap.PixelFormat := pf24bit; Bitmap.Canvas.Draw(0, 0, Dst); for Y := Bitmap.Height - 1 downto 4 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y - 4]; for X := 0 to Bitmap.Width - 5 do if P1[X * bpp] > P2[(X + 4) * bpp] then begin P1[X * bpp] := P2[(X + 4) * bpp] + 1; P1[X * bpp + 1] := P2[(X + 4) * bpp + 1] + 1; P1[X * bpp + 2] := P2[(X + 4) * bpp + 2] + 1; end; end; Dst.Assign(Bitmap); Bitmap.Free; end; class procedure TJvPaintFX.ShadowDownRight(const Dst: TBitmap); var X, Y: Integer; Bitmap: TBitmap; P1, P2: PByteArray; begin Bitmap := TBitmap.Create; Bitmap.Width := Dst.Width; Bitmap.Height := Dst.Height; Bitmap.PixelFormat := pf24bit; Bitmap.Canvas.Draw(0, 0, Dst); for Y := Bitmap.Height - 1 downto 4 do begin P1 := Bitmap.ScanLine[Y]; P2 := Bitmap.ScanLine[Y - 4]; for X := Bitmap.Width - 1 downto 4 do if P1[X * bpp] > P2[(X - 4) * bpp] then begin P1[X * bpp] := P2[(X - 4) * bpp] + 1; P1[X * bpp + 1] := P2[(X - 4) * bpp + 1] + 1; P1[X * bpp + 2] := P2[(X - 4) * bpp + 2] + 1; end; end; Dst.Assign(Bitmap); Bitmap.Free; end; class procedure TJvPaintFX.SemiOpaque(Src, Dst: TBitmap); var B: TBitmap; P: PByteArray; X, Y: Integer; begin B := TBitmap.Create; B.Width := Src.Width; B.Height := Src.Height; B.PixelFormat := pf24bit; B.Canvas.Draw(0, 0, Src); for Y := 0 to B.Height - 1 do begin P := B.ScanLine[Y]; if (Y mod 2) = 0 then begin for X := 0 to B.Width - 1 do if (X mod 2) = 0 then begin P[X * bpp] := $FF; P[X * bpp + 1] := $FF; P[X * bpp + 2] := $FF; end; end else begin for X := 0 to B.Width - 1 do if ((X + 1) mod 2) = 0 then begin P[X * bpp] := $FF; P[X * bpp + 1] := $FF; P[X * bpp + 2] := $FF; end; end; end; B.Transparent := True; B.TransparentColor := clWhite; Dst.Canvas.Draw(0, 0, B); B.Free; end; class procedure TJvPaintFX.QuartoOpaque(Src, Dst: TBitmap); var B: TBitmap; P: PByteArray; X, Y: Integer; begin B := TBitmap.Create; B.Width := Src.Width; B.Height := Src.Height; B.PixelFormat := pf24bit; B.Canvas.Draw(0, 0, Src); for Y := 0 to B.Height - 1 do begin P := B.ScanLine[Y]; if (Y mod 2) = 0 then begin for X := 0 to B.Width - 1 do if (X mod 2) = 0 then begin P[X * bpp] := $FF; P[X * bpp + 1] := $FF; P[X * bpp + 2] := $FF; end; end else begin for X := 0 to B.Width - 1 do begin P[X * bpp] := $FF; P[X * bpp + 1] := $FF; P[X * bpp + 2] := $FF; end; end; end; B.Transparent := True; B.TransparentColor := clWhite; Dst.Canvas.Draw(0, 0, B); B.Free; end; class procedure TJvPaintFX.FoldRight(Src1, Src2, Dst: TBitmap; Amount: Single); var W, H, X, Y, xf, xf0: Integer; PS1, PS2, PD: PByteArray; begin Src1.PixelFormat := pf24bit; Src2.PixelFormat := pf24bit; W := Src1.Width; H := Src2.Height; Dst.Width := W; Dst.Height := H; Dst.PixelFormat := pf24bit; xf := Round(Amount * W); for Y := 0 to H - 1 do begin PS1 := Src1.ScanLine[Y]; PS2 := Src2.ScanLine[Y]; PD := Dst.ScanLine[Y]; for X := 0 to xf do begin xf0 := xf + (xf - X); if xf0 < W then begin PD[xf0 * bpp] := PS1[X * bpp]; PD[xf0 * bpp + 1] := PS1[X * bpp + 1]; PD[xf0 * bpp + 2] := PS1[X * bpp + 2]; PD[X * bpp] := PS2[X * bpp]; PD[X * bpp + 1] := PS2[X * bpp + 1]; PD[X * bpp + 2] := PS2[X * bpp + 2]; end; end; if (2 * xf) < W - 1 then for X := 2 * xf + 1 to W - 1 do begin PD[X * bpp] := PS1[X * bpp]; PD[X * bpp + 1] := PS1[X * bpp + 1]; PD[X * bpp + 2] := PS1[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.Mandelbrot(const Dst: TBitmap; Factor: Integer); const MaxX = 1.25; MinX = -2; MaxY = 1.25; MinY = -1.25; var W, H, X, Y: Integer; DX, DY: Extended; Line: PByteArray; Color: Integer; function IsMandel(CA, CBi: Extended): Integer; const MAX_ITERATION = 64; var OldA: Extended; {just a variable to keep 'a' from being destroyed} A, B: Extended; {function Z divided in real and imaginary parts} LengthZ: Extended; {length of Z, sqrt(length_z)>2 => Z->infinity} Iteration: Integer; begin A := 0; {initialize Z(0) = 0} B := 0; Iteration := 0; {initialize Iteration} repeat OldA := A; {saves the 'a' (Will be destroyed in next line} A := A * A - B * B + CA; B := 2 * OldA * B + CBi; Iteration := Iteration + 1; LengthZ := A * A + B * B; until (LengthZ >= 4) or (Iteration > MAX_ITERATION); Result := Iteration; end; begin W := Dst.Width; H := Dst.Height; Dst.PixelFormat := pf24bit; DX := (MaxX - MinX) / W; DY := (MaxY - MinY) / H; for Y := 0 to H - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin Color := IsMandel(MinX + X * DX, MinY + Y * DY); if Color > Factor then Color := $FF else Color := $00; Line[X * bpp] := Color; Line[X * bpp + 1] := Color; Line[X * bpp + 2] := Color; end; end; end; class procedure TJvPaintFX.MaskMandelbrot(const Dst: TBitmap; Factor: Integer); var Bm: TBitmap; begin Bm := TBitmap.Create; Bm.Width := Dst.Width; Bm.Height := Dst.Height; Mandelbrot(Bm, Factor); Bm.Transparent := True; Bm.TransparentColor := clWhite; Dst.Canvas.Draw(0, 0, Bm); Bm.Free; end; class procedure TJvPaintFX.KeepBlue(const Dst: TBitmap; Factor: Single); var X, Y, W, H: Integer; Line: PByteArray; begin Dst.PixelFormat := pf24bit; W := Dst.Width; H := Dst.Height; for Y := 0 to H - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin Line[X * bpp] := Round(Factor * Line[X * bpp]); Line[X * bpp + 1] := 0; Line[X * bpp + 2] := 0; end; end; end; class procedure TJvPaintFX.KeepGreen(const Dst: TBitmap; Factor: Single); var X, Y, W, H: Integer; Line: PByteArray; begin Dst.PixelFormat := pf24bit; W := Dst.Width; H := Dst.Height; for Y := 0 to H - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin Line[X * bpp + 1] := Round(Factor * Line[X * bpp + 1]); Line[X * bpp] := 0; Line[X * bpp + 2] := 0; end; end; end; class procedure TJvPaintFX.KeepRed(const Dst: TBitmap; Factor: Single); var X, Y, W, H: Integer; Line: PByteArray; begin Dst.PixelFormat := pf24bit; W := Dst.Width; H := Dst.Height; for Y := 0 to H - 1 do begin Line := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin Line[X * bpp + 2] := Round(Factor * Line[X * bpp + 2]); Line[X * bpp + 1] := 0; Line[X * bpp] := 0; end; end; end; class procedure TJvPaintFX.Shake(Src, Dst: TBitmap; Factor: Single); var X, Y, H, W, DX: Integer; P: PByteArray; begin Dst.Canvas.Draw(0, 0, Src); Dst.PixelFormat := pf24bit; W := Dst.Width; H := Dst.Height; DX := Round(Factor * W); if DX = 0 then Exit; if DX > (W div 2) then Exit; for Y := 0 to H - 1 do begin P := Dst.ScanLine[Y]; if (Y mod 2) = 0 then for X := DX to W - 1 do begin P[(X - DX) * bpp] := P[X * bpp]; P[(X - DX) * bpp + 1] := P[X * bpp + 1]; P[(X - DX) * bpp + 2] := P[X * bpp + 2]; end else for X := W - 1 downto DX do begin P[X * bpp] := P[(X - DX) * bpp]; P[X * bpp + 1] := P[(X - DX) * bpp + 1]; P[X * bpp + 2] := P[(X - DX) * bpp + 2]; end; end; end; class procedure TJvPaintFX.ShakeDown(Src, Dst: TBitmap; Factor: Single); var X, Y, H, W, DY: Integer; P, P2, P3: PByteArray; begin Dst.Canvas.Draw(0, 0, Src); Dst.PixelFormat := pf24bit; W := Dst.Width; H := Dst.Height; DY := Round(Factor * H); if DY = 0 then Exit; if DY > (H div 2) then Exit; for Y := DY to H - 1 do begin P := Dst.ScanLine[Y]; P2 := Dst.ScanLine[Y - DY]; for X := 0 to W - 1 do if (X mod 2) = 0 then begin P2[X * bpp] := P[X * bpp]; P2[X * bpp + 1] := P[X * bpp + 1]; P2[X * bpp + 2] := P[X * bpp + 2]; end; end; for Y := H - 1 - DY downto 0 do begin P := Dst.ScanLine[Y]; P3 := Dst.ScanLine[Y + DY]; for X := 0 to W - 1 do if (X mod 2) <> 0 then begin P3[X * bpp] := P[X * bpp]; P3[X * bpp + 1] := P[X * bpp + 1]; P3[X * bpp + 2] := P[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.Plasma(Src1, Src2, Dst: TBitmap; Scale, Turbulence: Single); var cval, sval: array [0..255] of Integer; I, X, Y, W, H, XX, YY: Integer; Asin, Acos: Extended; PS1, PS2, PD: PByteArray; begin W := Src1.Width; H := Src1.Height; if Turbulence < 10 then Turbulence := 10; if Scale < 5 then Scale := 5; for I := 0 to 255 do begin sincos(I / Turbulence, Asin, Acos); sval[I] := Round(-Scale * Asin); cval[I] := Round(Scale * Acos); end; for Y := 0 to H - 1 do begin PD := Dst.ScanLine[Y]; PS2 := Src2.ScanLine[Y]; for X := 0 to W - 1 do begin XX := X + sval[PS2[X * bpp]]; YY := Y + cval[PS2[X * bpp]]; if (XX >= 0) and (XX < W) and (YY >= 0) and (YY < H) then begin PS1 := Src1.ScanLine[YY]; PD[X * bpp] := PS1[XX * bpp]; PD[X * bpp + 1] := PS1[XX * bpp + 1]; PD[X * bpp + 2] := PS1[XX * bpp + 2]; end; end; end; ; end; class procedure TJvPaintFX.SplitRound(Src, Dst: TBitmap; Amount: Integer; Style: TLightBrush); var X, Y, W, C, c00, DX, CX: Integer; R, R00: TRect; Bm, bm2: TBitmap; p0, p00, P1: PByteArray; begin if Amount = 0 then begin Dst.Canvas.Draw(0, 0, Src); Exit; end; CX := Src.Width div 2; if Amount > CX then Amount := CX; W := Src.Width; Bm := TBitmap.Create; Bm.PixelFormat := pf24bit; Bm.Height := 1; Bm.Width := CX; bm2 := TBitmap.Create; bm2.PixelFormat := pf24bit; bm2.Height := 1; bm2.Width := CX; p0 := Bm.ScanLine[0]; p00 := bm2.ScanLine[0]; DX := 0; for Y := 0 to Src.Height - 1 do begin P1 := Src.ScanLine[Y]; for X := 0 to CX - 1 do begin C := X * bpp; c00 := (CX + X) * bpp; p0[C] := P1[C]; p0[C + 1] := P1[C + 1]; p0[C + 2] := P1[C + 2]; p00[C] := P1[c00]; p00[C + 1] := P1[c00 + 1]; p00[C + 2] := P1[c00 + 2]; end; case Style of mbSplitRound: DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi))); mbSplitWaste: DX := Round(Amount * Abs(Cos(Y / (Src.Height - 1) * Pi))); end; R := Rect(0, Y, DX, Y + 1); Dst.Canvas.StretchDraw(R, Bm); R00 := Rect(W - 1 - DX, Y, W - 1, Y + 1); Dst.Canvas.StretchDraw(R00, bm2); end; Bm.Free; bm2.Free; end; class procedure TJvPaintFX.Emboss(var Bmp: TBitmap); var X, Y: Integer; P1, P2: PByteArray; begin for Y := 0 to Bmp.Height - 2 do begin P1 := Bmp.ScanLine[Y]; P2 := Bmp.ScanLine[Y + 1]; for X := 0 to Bmp.Width - 4 do begin P1[X * bpp] := (P1[X * bpp] + (P2[(X + bpp) * bpp] xor $FF)) shr 1; P1[X * bpp + 1] := (P1[X * bpp + 1] + (P2[(X + bpp) * bpp + 1] xor $FF)) shr 1; P1[X * bpp + 2] := (P1[X * bpp + 2] + (P2[(X + bpp) * bpp + 2] xor $FF)) shr 1; end; end; end; class procedure TJvPaintFX.FilterRed(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C + 2] > Min) and (P1[C + 2] < Max) then P1[C + 2] := $FF else P1[C + 2] := 0; P1[C] := 0; P1[C + 1] := 0; end; end; end; class procedure TJvPaintFX.FilterGreen(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C + 1] > Min) and (P1[C + 1] < Max) then P1[C + 1] := $FF else P1[C + 1] := 0; P1[C] := 0; P1[C + 2] := 0; end; end; end; class procedure TJvPaintFX.FilterBlue(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C] > Min) and (P1[C] < Max) then P1[C] := $FF else P1[C] := 0; P1[C + 1] := 0; P1[C + 2] := 0; end; end; end; class procedure TJvPaintFX.FilterXRed(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C + 2] > Min) and (P1[C + 2] < Max) then P1[C + 2] := $FF else P1[C + 2] := 0; end; end; end; class procedure TJvPaintFX.FilterXGreen(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C + 1] > Min) and (P1[C + 1] < Max) then P1[C + 1] := $FF else P1[C + 1] := 0; end; end; end; class procedure TJvPaintFX.FilterXBlue(const Dst: TBitmap; Min, Max: Integer); var C, X, Y: Integer; P1: PByteArray; begin for Y := 0 to Dst.Height - 1 do begin P1 := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := X * bpp; if (P1[C] > Min) and (P1[C] < Max) then P1[C] := $FF else P1[C] := 0; end; end; end; class procedure TJvPaintFX.DrawMandelJulia(const Dst: TBitmap; x0, y0, x1, y1: Single; Niter: Integer; Mandel: Boolean); const //Number if colors. If this is changed, the number of mapped colors must also be changed nc = 16; type TJvRGBTriplet = record R: Byte; G: Byte; B: Byte; end; var X, XX, Y, YY, CX, CY, DX, DY, XSquared, YSquared: Double; NX, NY, PY, PX, I: Integer; Line: PByteArray; cc: array [0..15] of TJvRGBTriplet; AColor: TColor; begin Dst.PixelFormat := pf24bit; for I := 0 to 15 do begin AColor := ConvertColor(I); cc[I].B := GetBValue(ColorToRGB(AColor)); cc[I].G := GetGValue(ColorToRGB(AColor)); cc[I].R := GetRValue(ColorToRGB(AColor)); end; if Niter < nc then Niter := nc; try NX := Dst.Width; NY := Dst.Height; CX := 0; CY := 1; DX := (x1 - x0) / NX; DY := (y1 - y0) / NY; PY := 0; while PY < NY do begin Line := Dst.ScanLine[PY]; PX := 0; while (PX < NX) do begin X := x0 + PX * DX; Y := y0 + PY * DY; if Mandel then begin CX := X; CY := Y; X := 0; Y := 0; end; XSquared := 0; YSquared := 0; I := 0; while (I <= Niter) and (XSquared + YSquared < (4)) do begin XSquared := X * X; YSquared := Y * Y; XX := XSquared - YSquared + CX; YY := (2 * X * Y) + CY; X := XX; Y := YY; I := I + 1; end; I := I - 1; if (I = Niter) then I := 0 else I := Round(I / (Niter / nc)); // Canvas.Pixels[PX,PY] := ConvertColor(I); Line[PX * 3] := cc[I].B; Line[PX * 3 + 1] := cc[I].G; Line[PX * 3 + 2] := cc[I].R; PX := PX + 1; end; PY := PY + 1; end; finally end; end; class procedure TJvPaintFX.Invert(Src: TBitmap); var W, H, X, Y: Integer; P: PByteArray; begin W := Src.Width; H := Src.Height; Src.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin P := Src.ScanLine[Y]; for X := 0 to W - 1 do begin P[X * bpp] := not P[X * bpp]; P[X * bpp + 1] := not P[X * bpp + 1]; P[X * bpp + 2] := not P[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.MirrorRight(Src: TBitmap); var W, H, X, Y: Integer; P: PByteArray; begin W := Src.Width; H := Src.Height; Src.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin P := Src.ScanLine[Y]; for X := 0 to W div 2 do begin P[(W - 1 - X) * bpp] := P[X * bpp]; P[(W - 1 - X) * bpp + 1] := P[X * bpp + 1]; P[(W - 1 - X) * bpp + 2] := P[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.MirrorDown(Src: TBitmap); var W, H, X, Y: Integer; P1, P2: PByteArray; begin W := Src.Width; H := Src.Height; Src.PixelFormat := pf24bit; for Y := 0 to H div 2 do begin P1 := Src.ScanLine[Y]; P2 := Src.ScanLine[H - 1 - Y]; for X := 0 to W - 1 do begin P2[X * bpp] := P1[X * bpp]; P2[X * bpp + 1] := P1[X * bpp + 1]; P2[X * bpp + 2] := P1[X * bpp + 2]; end; end; end; // resample image as triangles class procedure TJvPaintFX.Triangles(const Dst: TBitmap; Amount: Integer); type TTriplet = record R: Byte; G: Byte; B: Byte; end; var W, H, X, Y, tb, tm, te: Integer; PS: PByteArray; T: TTriplet; begin W := Dst.Width; H := Dst.Height; Dst.PixelFormat := pf24bit; if Amount < 5 then Amount := 5; Amount := (Amount div 2) * 2 + 1; tm := Amount div 2; for Y := 0 to H - 1 do begin PS := Dst.ScanLine[Y]; T.R := PS[0]; T.G := PS[1]; T.B := PS[2]; tb := Y mod (Amount - 1); if tb > tm then tb := 2 * tm - tb; if tb = 0 then tb := Amount; te := tm + Abs(tm - (Y mod Amount)); for X := 0 to W - 1 do begin if (X mod tb) = 0 then begin T.R := PS[X * bpp]; T.G := PS[X * bpp + 1]; T.B := PS[X * bpp + 2]; end; if ((X mod te) = 1) and (tb <> 0) then begin T.R := PS[X * bpp]; T.G := PS[X * bpp + 1]; T.B := PS[X * bpp + 2]; end; PS[X * bpp] := T.R; PS[X * bpp + 1] := T.G; PS[X * bpp + 2] := T.B; end; end; end; class procedure TJvPaintFX.RippleTooth(const Dst: TBitmap; Amount: Integer); var X, Y: Integer; P1, P2: PByteArray; B: Byte; begin Dst.PixelFormat := pf24bit; Amount := Min(Dst.Height div 2, Amount); for Y := Dst.Height - 1 - Amount downto 0 do begin P1 := Dst.ScanLine[Y]; B := 0; for X := 0 to Dst.Width - 1 do begin P2 := Dst.ScanLine[Y + B]; P2[X * bpp] := P1[X * bpp]; P2[X * bpp + 1] := P1[X * bpp + 1]; P2[X * bpp + 2] := P1[X * bpp + 2]; Inc(B); if B > Amount then B := 0; end; end; end; class procedure TJvPaintFX.RippleTriangle(const Dst: TBitmap; Amount: Integer); var X, Y: Integer; P1, P2: PByteArray; B: Byte; doinc: Boolean; begin Amount := Min(Dst.Height div 2, Amount); for Y := Dst.Height - 1 - Amount downto 0 do begin P1 := Dst.ScanLine[Y]; B := 0; doinc := True; for X := 0 to Dst.Width - 1 do begin P2 := Dst.ScanLine[Y + B]; P2[X * bpp] := P1[X * bpp]; P2[X * bpp + 1] := P1[X * bpp + 1]; P2[X * bpp + 2] := P1[X * bpp + 2]; if doinc then begin Inc(B); if B > Amount then begin doinc := False; B := Amount - 1; end; end else begin if B = 0 then begin doinc := True; B := 2; end; Dec(B); end; end; end; end; class procedure TJvPaintFX.RippleRandom(const Dst: TBitmap; Amount: Integer); var X, Y: Integer; P1, P2: PByteArray; B: Byte; begin Amount := Min(Dst.Height div 2, Amount); Dst.PixelFormat := pf24bit; Randomize; for Y := Dst.Height - 1 - Amount downto 0 do begin P1 := Dst.ScanLine[Y]; B := 0; for X := 0 to Dst.Width - 1 do begin P2 := Dst.ScanLine[Y + B]; P2[X * bpp] := P1[X * bpp]; P2[X * bpp + 1] := P1[X * bpp + 1]; P2[X * bpp + 2] := P1[X * bpp + 2]; B := Random(Amount); end; end; end; class procedure TJvPaintFX.TexturizeOverlap(const Dst: TBitmap; Amount: Integer); var W, H, X, Y, xo: Integer; Bm: TBitmap; ARect: TRect; begin Bm := TBitmap.Create; Amount := Min(Dst.Width div 2, Amount); Amount := Min(Dst.Height div 2, Amount); xo := Round(Amount * 2 / 3); Bm.Width := Amount; Bm.Height := Amount; W := Dst.Width; H := Dst.Height; ARect := Rect(0, 0, Amount, Amount); Bm.Canvas.StretchDraw(ARect, Dst); Y := 0; repeat X := 0; repeat Dst.Canvas.Draw(X, Y, Bm); X := X + xo; until X >= W; Y := Y + xo; until Y >= H; Bm.Free; end; class procedure TJvPaintFX.TexturizeTile(const Dst: TBitmap; Amount: Integer); var W, H, X, Y: Integer; Bm: TBitmap; ARect: TRect; begin Bm := TBitmap.Create; Amount := Min(Dst.Width div 2, Amount); Amount := Min(Dst.Height div 2, Amount); Bm.Width := Amount; Bm.Height := Amount; W := Dst.Width; H := Dst.Height; ARect := Rect(0, 0, Amount, Amount); Bm.Canvas.StretchDraw(ARect, Dst); Y := 0; repeat X := 0; repeat Dst.Canvas.Draw(X, Y, Bm); X := X + Bm.Width; until X >= W; Y := Y + Bm.Height; until Y >= H; Bm.Free; end; class procedure TJvPaintFX.HeightMap(const Dst: TBitmap; Amount: Integer); var Bm: TBitmap; W, H, X, Y: Integer; pb, PS: PByteArray; C: Integer; begin H := Dst.Height; W := Dst.Width; Bm := TBitmap.Create; Bm.Width := W; Bm.Height := H; Bm.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; Bm.Canvas.Draw(0, 0, Dst); for Y := 0 to H - 1 do begin pb := Bm.ScanLine[Y]; for X := 0 to W - 1 do begin C := Round((pb[X * bpp] + pb[X * bpp + 1] + pb[X * bpp + 2]) / 3 / 255 * Amount); if (Y - C) >= 0 then begin PS := Dst.ScanLine[Y - C]; PS[X * bpp] := pb[X * bpp]; PS[X * bpp + 1] := pb[X * bpp + 1]; PS[X * bpp + 2] := pb[X * bpp + 2]; end; end; end; Bm.Free; end; class procedure TJvPaintFX.Turn(Src, Dst: TBitmap); var W, H, X, Y: Integer; PS, PD: PByteArray; begin H := Src.Height; W := Src.Width; Src.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; Dst.Height := W; Dst.Width := H; for Y := 0 to H - 1 do begin PS := Src.ScanLine[Y]; for X := 0 to W - 1 do begin PD := Dst.ScanLine[W - 1 - X]; PD[Y * bpp] := PS[X * bpp]; PD[Y * bpp + 1] := PS[X * bpp + 1]; PD[Y * bpp + 2] := PS[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.TurnRight(Src, Dst: TBitmap); var W, H, X, Y: Integer; PS, PD: PByteArray; begin H := Src.Height; W := Src.Width; Src.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; Dst.Height := W; Dst.Width := H; for Y := 0 to H - 1 do begin PS := Src.ScanLine[Y]; for X := 0 to W - 1 do begin PD := Dst.ScanLine[X]; PD[(H - 1 - Y) * bpp] := PS[X * bpp]; PD[(H - 1 - Y) * bpp + 1] := PS[X * bpp + 1]; PD[(H - 1 - Y) * bpp + 2] := PS[X * bpp + 2]; end; end; end; class procedure TJvPaintFX.ExtractColor(const Dst: TBitmap; AColor: TColor); var X, Y: Integer; P: PJvRGBArray; EColor: TColor; R, G, B: Byte; OPF: TPixelFormat; Val: Byte; begin EColor := ColorToRGB(AColor); R := GetRValue(EColor); G := GetGValue(EColor); B := GetBValue(EColor); OPF := Dst.PixelFormat; Dst.PixelFormat := pf24bit; if EColor = 0 then Val := $FF else Val := 0; for Y := 0 to Dst.Height - 1 do begin P := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin if ((P[X].rgbBlue <> B) or (P[X].rgbGreen <> G) or (P[X].rgbRed <> R)) then begin P[X].rgbBlue := Val; P[X].rgbGreen := Val; P[X].rgbRed := Val; end; end end; if AColor = clBlack then Dst.TransparentColor := clWhite else Dst.TransparentColor := clBlack; Dst.Transparent := True; Dst.PixelFormat := OPF; end; class procedure TJvPaintFX.ExcludeColor(const Dst: TBitmap; AColor: TColor); begin Dst.TransparentColor := AColor; Dst.Transparent := True; end; class procedure TJvPaintFX.Blend(const Src1, Src2: TBitmap; var Dst: TBitmap; Amount: Single); var W, H, X, Y: Integer; PS1, PS2, PD: PByteArray; begin W := Src1.Width; H := Src1.Height; Dst.Width := W; Dst.Height := H; Src1.PixelFormat := pf24bit; Src2.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin PS1 := Src1.ScanLine[Y]; PS2 := Src2.ScanLine[Y]; PD := Dst.ScanLine[Y]; for X := 0 to W - 1 do begin PD[X * bpp] := Round((1 - Amount) * PS1[X * bpp] + Amount * PS2[X * bpp]); PD[X * bpp + 1] := Round((1 - Amount) * PS1[X * bpp + 1] + Amount * PS2[X * bpp + 1]); PD[X * bpp + 2] := Round((1 - Amount) * PS1[X * bpp + 2] + Amount * PS2[X * bpp + 2]); end; end; end; class procedure TJvPaintFX.Blend2(const Src1, Src2: TBitmap; var Dst: TBitmap; Amount: Single); var W, H, X, Y: Integer; PS1, PS2, PD: PByteArray; begin W := Src1.Width; H := Src1.Height; Dst.Width := W; Dst.Height := H; Src1.PixelFormat := pf24bit; Src2.PixelFormat := pf24bit; Dst.PixelFormat := pf24bit; for Y := 0 to H - 1 do begin PS1 := Src1.ScanLine[Y]; PS2 := Src2.ScanLine[Y]; PD := Dst.ScanLine[Y]; for X := 0 to W - 1 do if ((PS2[X * bpp] = $FF) and (PS2[X * bpp + 1] = $FF) and (PS2[X * bpp + 2] = $FF)) then begin PD[X * bpp] := $FF; PD[X * bpp + 2] := $FF; PD[X * bpp + 2] := $FF; end else begin PD[X * bpp] := Round((1 - Amount) * PS1[X * bpp] + Amount * PS2[X * bpp]); PD[X * bpp + 1] := Round((1 - Amount) * PS1[X * bpp + 1] + Amount * PS2[X * bpp + 1]); PD[X * bpp + 2] := Round((1 - Amount) * PS1[X * bpp + 2] + Amount * PS2[X * bpp + 2]); end; end; end; class procedure TJvPaintFX.Solarize(const Src: TBitmap; var Dst: TBitmap; Amount: Integer); var X, Y: Integer; P: PJvRGBArray; C: Integer; begin if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin P := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin C := (P[X].rgbBlue + P[X].rgbGreen + P[X].rgbRed) div 3; if C > Amount then begin P[X].rgbBlue := 255 - P[X].rgbBlue; P[X].rgbGreen := 255 - P[X].rgbGreen; P[X].rgbRed := 255 - P[X].rgbRed; end; end; end; Dst.PixelFormat := Src.PixelFormat; end; class procedure TJvPaintFX.Posterize(const Src: TBitmap; var Dst: TBitmap; Amount: Integer); var X, Y: Integer; PD: PJvRGBArray; begin if Dst = nil then Dst := TBitmap.Create; Dst.Assign(Src); Dst.PixelFormat := pf24bit; for Y := 0 to Dst.Height - 1 do begin PD := Dst.ScanLine[Y]; for X := 0 to Dst.Width - 1 do begin PD[X].rgbBlue := Round(PD[X].rgbBlue / Amount) * Amount; PD[X].rgbGreen := Round(PD[X].rgbGreen / Amount) * Amount; PD[X].rgbRed := Round(PD[X].rgbRed / Amount) * Amount; end; end; Dst.PixelFormat := Src.PixelFormat; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.