jvqpaintfx.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvQPaintFX.pas,v 1.19 2004/12/21 09:45:18 asnepvangers Exp $

unit JvQPaintFX;

{$I jvcl.inc}

interface

uses
  QWindows, QMessages, QGraphics, QControls, QForms,
  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)
    );

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Math,
  JvQJCLUtils, JvQResources, JvQTypes;

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
  JvQJCLUtils.AntiAlias(Dst);
end;

class procedure TJvPaintFX.AntiAliasRect(const Dst: TBitmap;
  XOrigin, YOrigin, XFinal, YFinal: Integer);
begin  
  JvQJCLUtils.AntiAliasRect(Dst, XOrigin, YOrigin, XFinal, YFinal); 
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;