{

   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit im_Effects;

{*********************************************}
{  This unit is a part of ImageE              }
{  Copyright © 2003-2004 R.Geurts             }
{  See Readme.txt for licence information     }
{*********************************************}

interface

uses
  sysutils,graphics,GR32, GR32_Filters,math,GR32_Blend,
  Windows, Messages, Classes, Controls, Forms, Dialogs, im_blending, im_convolution
;

  // Color Conversion
function  HSLtoRGB(H, S, L: Integer): TColor32;
procedure RGBtoHSL(RGB: TColor32; out H, S, L: Byte);
procedure Effect_Dither(src: TBitmap32);

function IntToByte(i:Integer):Byte;
function ArcTan2(xt,yt : Single): Single;
function ByteToInt(i:Byte):Integer;

procedure Effect_addmononoise(clip: tbitmap32; Amount: Integer);
procedure Effect_addcolornoise(clip: tbitmap32; Amount: Integer);
procedure Effect_Saturation(clip: tbitmap32; Amount: Integer);
procedure Effect_Posterize(src: tbitmap32; amount: integer);
procedure Effect_Solarize(src: tbitmap32; amount: integer);
procedure Effect_Emboss(src: tbitmap32);
procedure Effect_Splitblur(clip: tbitmap32; Amount: Integer);
procedure Effect_GaussianBlur(clip: tbitmap32; Amount: integer);
procedure Effect_ToBinary(src: tbitmap32; amount: integer);
procedure Effect_Mosaic(Bm:TBitmap32;size:Integer);
procedure Effect_IncDecRGB(clip:tbitmap32;r0,g0,b0:integer);
procedure Effect_IncDecHSL(clip:tbitmap32;h0,s0,l0:integer);
procedure Effect_WaveH(clip:tbitmap32;amount,inference,style:integer);
procedure Effect_WaveV(clip:tbitmap32;amount,inference,style:integer);

procedure Effect_Wave2(bmp: tbitmap32; amp,period,direction:integer);

procedure Effect_Twist(Bmp: TBitmap32; Amount: integer);
procedure Effect_FishEye(bmp: TBitmap32; Amount: Extended);
procedure Effect_Addborder(bmp:tbitmap32; new_width,new_height: integer);
procedure Effect_ShiftXY(bmp: tbitmap32; AmountX,AmountY: Integer);

procedure Effect_ConvertToPolar(bmp: tbitmap32);
procedure Effect_Gradient(bmp: tbitmap32; min,max,operation:integer);
procedure Effect_Test(bmp: tbitmap32);
procedure Effect_Average(bmp: tbitmap32);
procedure Effect_Median(bmp: tbitmap32);
procedure Effect_SplitColors(bmp:tbitmap32; c:integer);

procedure Effect_MandelBrot(src: Tbitmap32; factor: integer);
procedure Effect_ErosionDilation(bmp:tbitmap32; amount:integer; ftype:integer);

procedure Effect_FreiChen(src: TBitmap32);
procedure Effect_GreyScaleDilation(Src: TBitmap32);
procedure Effect_GreyScaleErosion(Src: TBitmap32);
procedure Effect_GreyScaleOpening(Src: TBitmap32);
procedure Effect_GreyScaleClosing(Src: TBitmap32);
procedure Effect_GreyScaleItandMiss(Src: TBitmap32);
procedure Effect_Outline(Src: TBitmap32);

procedure Effect_IncDecCMYK(clip:tbitmap32;c2,m2,y2,k2:integer);
procedure Effect_tile(src: TBitmap32; amount: integer);

procedure Effect_Heightmap(Src: TBitmap32; amount:integer);

//procedure Effect_FFT(Src:TBitmap32);
//procedure Effect_IFFT(Src:TBitmap32);

const
  MaxPixelCount = 32768;

implementation

type
    pRGBTripleArray = ^TRGBTripleArray;
    TRGBTripleArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;

 pRGBArray = ^TRGBArray; // Use SysUtils.pByteArray
 TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;

function IntToByte(i:Integer):Byte;
begin
  if      i>255 then Result:=255
  else if i<0   then Result:=0
  else               Result:=i;
end;

function ByteToInt(i:Byte):Integer;
begin
  result:=i;
end;

procedure Effect_Addborder(bmp:tbitmap32; new_width,new_height: integer);
var
temp:tbitmap32;
temp2:tbitmap32;
xoff,yoff:integer;
begin
if new_width<bmp.Width then exit;
if new_height<bmp.height then exit;
  temp := TBitMap32.create;
  temp2:= tbitmap32.create;
  temp2.Assign(bmp);

  temp.Width:=new_width;
  temp.height:=new_height;
  temp.fillrect(0,0,temp.width,temp.height,clblack);
  bmp.Assign(temp);

 xoff:=round((bmp.Width-temp2.width)/2);
 yoff:=round((bmp.height-temp2.height)/2);
 bmp.Draw(xoff,yoff,temp2);
 temp.Free;
 temp2.free;
end;


procedure Effect_Emboss(src: tbitmap32);
var x,y:integer;
    p1,p2:Pcolor32array;
    r1,g1,b1,r0,g0,b0,r,g,b:byte;
    SS:Pcolor32;
begin
  SS := @src.Bits[0];
  for y:=0 to src.height-2 do begin
    p1:=src.scanline[y];
    p2:=src.scanline[y+1];
   for x:=0 to src.width-1 do begin
      b0:=(p1[x] and $FF);
      g0:=(p1[x] shr 8) and $FF;
      r0:=(p1[x] shr 16) and $FF;
      b1:=(p2[x]and $FF);
      g1:=(p2[x] shr 8) and $FF;;
      r1:=(p2[x] shr 16) and $FF;;
       b:=(r0+(r1 xor $FFFFFFFF)and $FF)shr 1;
       g:=(g0+(g1 xor $FFFFFFFF)and $FF)shr 1;
       r:=(b0+(b1 xor $FFFFFFFF)and $FF)shr 1;
{      if r>$FF then r:=$FF;
      if g>$FF then g:=$FF;
      if b>$FF then b:=$FF;
}      SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
   end;
   src.Changed;
end;

procedure Effect_SplitColors(bmp:tbitmap32; c:integer);
var x,y:integer;
    p1:Pcolor32array;
    r,g,b:byte;
    SS:Pcolor32;
begin
  SS := @bmp.Bits[0];
  for y:=0 to bmp.height-2 do begin
    p1:=bmp.scanline[y];
   for x:=0 to bmp.width-1 do begin
      b:=(p1[x] and $FF);
      g:=(p1[x] shr 8) and $FF;
      r:=(p1[x] shr 16) and $FF;
//0:red;1:green;2:blue

      case c of
      0: begin b:=0; g:=0; end;
      1: begin b:=0; r:=0; end;
      2: begin g:=0; r:=0; end;
      end;

      SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
   end;
   bmp.Changed;
end;


procedure Effect_WaveH(clip:tbitmap32;amount,inference,style:integer);
var
  x,y : integer;
  BitMap : TBitMap32;
  P1,P2 : Pcolor32array;
  fangle:real;
  b:integer;
begin
if amount=0 then exit;
//if (inference<1) or (inference>50) then exit;
if (style<0) or (style>2) then exit;
  BitMap := TBitMap32.create;
  Bitmap.assign(clip);
  fangle:=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 := clip.scanline[y+amount+b];
       p2[x]:=p1[x];
        case style of
        0: b:=amount*variant(sin(fangle*x));
        1: b:=amount*variant(sin(fangle*x)*cos(fangle*x));
        2: b:=amount*variant(sin(fangle*x)*sin(inference*fangle*x));
        end;
      end;
    end;
  BitMap.free;
  clip.changed;
end;

procedure Effect_WaveV(clip:tbitmap32;amount,inference,style:integer);
var
  x,y : integer;
  BitMap : TBitMap32;
  P1,P2 : Pcolor32array;
  fangle:real;
  x2:integer;
begin
  BitMap := TBitMap32.create;
  Bitmap.assign(clip);
  fangle:=pi / 2 / amount;
    for y := BitMap.height-1 downto 0 do begin
    for x:=(2*amount) to Bitmap.width-1-amount do begin
      P1 := BitMap.ScanLine[y];
      P2 := clip.scanline[y];

      x2 := x+round( amount*variant(sin(fangle*inference)));
      p2[x]:=p1[x2];
      end;
      end;

  BitMap.free;
  clip.changed;
end;

  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;

procedure Effect_Twist(Bmp: TBitmap32; Amount: integer);
var
  fxmid, fymid : Single;
  txmid, tymid : Single;
  fx,fy : Single;
  tx2, ty2 : Single;
  rt : Single;
  theta : Single;
  ifx, ify : integer;
  dx, dy : Single;
  OFFSET : Single;
  ty, tx             : Integer;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : Integer;
  new_blue               : Integer;
  total_red, total_green : Single;
  total_blue             : Single;
  ix, iy                 : Integer;
  sli, slo : Pcolor32Array;
  dst : TBitMap32;
  SS:Pcolor32;
  r,g,b,d:byte;

begin
if amount=0 then exit;
   SS := @bmp.Bits[0];

  dst := TBitMap32.create;
  dst.assign(bmp);

  OFFSET := -(Pi/2);
  dx := Bmp.Width - 1;
  dy := Bmp.Height - 1;
  rt := Sqrt(dx * dx + dy * dy);
  tx2 := rt;
  ty2 := rt;
  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;
      rt := Sqrt(dx * dx + dy * dy);
      if rt = 0 then begin
        fx := 0;
        fy := 0;
      end
      else begin
        theta := ArcTan2(dx,dy) - rt/Amount - OFFSET;
        fx := rt * Cos(theta);
        fy := rt * Sin(theta);
      end;
      fx := fx + fxmid;
      fy := fy + fymid;

      ify := Trunc(fy);
      ifx := Trunc(fx);
                // Calculate the weights.
      if fy >= 0  then begin
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

      if ifx < 0 then
        ifx := 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:=round(sli[ifx+ix] and $FF);
      new_green:=round((sli[ifx+ix] shr 8) and $FF);
      new_blue:=round((sli[ifx+ix] shr 16) and $FF);
{            new_red := sli[(ifx + ix)*3];
            new_green := sli[(ifx + ix)*3+1];
            new_blue := sli[(ifx + ix)*3+2];
}          end
          else begin
      new_red:=round(sli[bmp.width-ifx-ix] and $FF);
      new_green:=round((sli[bmp.width-ifx-ix] shr 8) and $FF);
      new_blue:=round((sli[bmp.width-ifx-ix] shr 16) and $FF);
{            new_red := sli[(Bmp.Width - ifx - ix)*3];
            new_green := sli[(Bmp.Width - ifx - ix)*3+1];
            new_blue := sli[(Bmp.Width - ifx - ix)*3+2];
}          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
        end;
      end;
      slo := Dst.scanline[ty];
      r := Round(total_red);
      g := Round(total_green);
      b := Round(total_blue);
      slo[tx]:= $FF000000 + b shl 16 + g shl 8 + r;
    end;
  end;
  for ty:=0 to dst.Height-1 do
  begin
    slo:=dst.scanline[ty];
    for tx:=0 to dst.Width-1 do
    begin
      b:=(slo[tx] and $FF);
      g:=(slo[tx] shr 8) and $FF;
      r:=(slo[tx] shr 16) and $FF;
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
   end;
 bmp.Changed;
end;



procedure Effect_FishEye(bmp: TBitmap32; Amount: Extended);
var
xmid,ymid              : Single;
fx,fy                  : Single;
r1, r2                 : Single;
ifx, ify               : integer;
dx, dy                 : Single;
rmax                   : Single;
ty, tx                 : Integer;
weight_x, weight_y     : array[0..1] of Single;
weight                 : Single;
new_red, new_green     : Integer;
new_blue               : Integer;
total_red, total_green : Single;
total_blue             : Single;
ix, iy                 : Integer;
sli, slo : Pcolor32Array;
  dst : TBitMap32;
  SS:Pcolor32;
  r,g,b,d:byte;
  tmp:extended;
begin
  amount:=amount/10;
  if amount=0 then exit;
   SS := @bmp.Bits[0];

  dst := TBitMap32.create;
  dst.assign(bmp);

  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

        if rmax=0 then rmax:=1;
        tmp:=(1-r1/rmax)-1;
        if tmp=0 then tmp:=1;

        r2 := rmax/2 * (1 / tmp);
        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
        weight_y[1] := fy - ify;
        weight_y[0] := 1 - weight_y[1];
      end else begin
        weight_y[0] := -(fy - ify);
        weight_y[1] := 1 - weight_y[0];
      end;
      if fx >= 0 then begin
        weight_x[1] := fx - ifx;
        weight_x[0] := 1 - weight_x[1];
      end else begin
        weight_x[0] := -(fx - ifx);
        Weight_x[1] := 1 - weight_x[0];
      end;

      if ifx < 0 then
        ifx := 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_blue:=round(sli[ifx+ix] and $FF);
      new_green:=round((sli[ifx+ix] shr 8) and $FF);
      new_red:=round((sli[ifx+ix] shr 16) and $FF);
          end
          else begin
      new_blue:=round(sli[bmp.width-ifx-ix] and $FF);
      new_green:=round((sli[bmp.width-ifx-ix] shr 8) and $FF);
      new_red:=round((sli[bmp.width-ifx-ix] shr 16) and $FF);
          end;
          weight := weight_x[ix] * weight_y[iy];
          total_red   := total_red   + new_red   * weight;
          total_green := total_green + new_green * weight;
          total_blue  := total_blue  + new_blue  * weight;
        end;
      end;
      slo := dst.scanline[ty];
      r := Round(total_red);
      g := Round(total_green);
      b := Round(total_blue);
      slo[tx]:= $FF000000 + r shl 16 + g shl 8 + b;
//    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    end;
  end;
//
  for ty:=0 to dst.Height-1 do
  begin
    slo:=dst.scanline[ty];
    for tx:=0 to dst.Width-1 do
    begin
  {    b:=(slo[tx] and $FF);
      g:=(slo[tx] shr 8) and $FF;
      r:=(slo[tx] shr 16) and $FF;
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
   } SS^:=slo[tx];
    inc(SS);
    end;
   end;
   dst.Free;
   bmp.Changed;
end;

procedure Effect_GaussianBlur(clip: tbitmap32; Amount: integer);
var
i: Integer;
begin
  for i:=Amount downto 0 do
  Effect_SplitBlur(clip,1);
end;

procedure Effect_Splitblur(clip: tbitmap32; Amount: Integer);
var
p1,p2:Pcolor32array;
r,g,b:byte;
cx,x,y: Integer;
Buf:   array[0..3,0..2]of integer;
SS:Pcolor32;
begin
  SS := @clip.Bits[0];

  if Amount=0 then Exit;
  for y:=0 to clip.Height-1 do
  begin
//    p0:=clip.scanline[y];
    if y-Amount<0         then p1:=clip.scanline[y]
    else {y-Amount>0}          p1:=clip.ScanLine[y-Amount];
    if y+Amount<clip.Height    then p2:=clip.ScanLine[y+Amount]
    else {y+Amount>=Height}    p2:=clip.ScanLine[clip.Height-y];

    for x:=0 to clip.Width-1 do
    begin
      if x-Amount<0     then cx:=x
      else {x-Amount>0}      cx:=x-Amount;

      Buf[0,0]:=(p1[cx] and $FF);
      Buf[0,1]:=(p1[cx] shr 8) and $FF;
      Buf[0,2]:=(p1[cx] shr 16) and $FF;
      Buf[1,0]:=(p2[cx] and $FF);
      Buf[1,1]:=(p2[cx] shr 8) and $FF;
      Buf[1,2]:=(p2[cx] shr 16) and $FF;
      if x+Amount<clip.Width     then cx:=x+Amount
      else {x+Amount>=Width}     cx:=clip.Width-x;
      Buf[2,0]:=(p1[cx] and $FF);
      Buf[2,1]:=(p1[cx] shr 8) and $FF;
      Buf[2,2]:=(p1[cx] shr 16) and $FF;
      Buf[3,0]:=(p2[cx] and $FF);
      Buf[3,1]:=(p2[cx] shr 8) and $FF;
      Buf[3,2]:=(p2[cx] shr 16) and $FF;

      r:=(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0])shr 2;
      g:=(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1])shr 2;
      b:=(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2])shr 2;

      SS^ := $FF000000 + b shl 16 + g shl 8 + r;
      inc(SS);

    end;
  end;
     clip.Changed;
end;




procedure Effect_addmononoise(clip: tbitmap32; Amount: Integer);
var
p0:Pcolor32array;
x,y:integer;
r,g,b,a:byte;
SS:Pcolor32;
begin
  SS := @clip.Bits[0];

  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      a:=inttobyte(Random(Amount)-(Amount shr 1));
      b:=inttobyte((p0[x] and $FF)+a);
      g:=inttobyte((p0[x] shr 8) and $FF+a);
      r:=inttobyte((p0[x] shr 16) and $FF+a);

    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
  end;
  clip.Changed;
end;

procedure Effect_addcolornoise(clip: tbitmap32; Amount: Integer);
var
p0:Pcolor32array;
x,y:integer;
i,r,g,b:byte;
SS:Pcolor32;
begin
  SS := @clip.Bits[0];

  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
       i:=inttobyte(Random(Amount)-(Amount shr 1));
      b:=(p0[x] and $FF)+i;
       i:=inttobyte(Random(Amount)-(Amount shr 1));
      g:=((p0[x] shr 8) and $FF)+i;
       i:=inttobyte(Random(Amount)-(Amount shr 1));
      r:=((p0[x] shr 16) and $FF)+i;

    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
  end;
  clip.Changed;
end;

procedure Effect_Posterize(src: tbitmap32; amount: integer);
var x,y:integer;
    ps:Pcolor32array;
    r,g,b:byte;
    SS:Pcolor32;
begin
if amount=0 then exit;
  SS := @src.Bits[0];

  for y:=0 to src.height-1 do begin
   ps:=src.scanline[y];
   for x:=0 to src.width-1 do begin
      b:=round((((ps[x] and $FF))/amount)*amount);
      g:=round(((ps[x] shr 8) and $FF)/amount)*amount;
      r:=round(((ps[x] shr 16) and $FF)/amount)*amount;
      SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
   end;
   src.Changed;
end;

procedure Effect_Solarize(src: tbitmap32; amount: integer);
var x,y:integer;
    ps:Pcolor32array;
    c:integer;
    r0,g0,b0:integer;
    r,g,b:byte;
    SS:Pcolor32;
begin
  SS := @src.Bits[0];

  for y:=0 to src.height-1 do begin
   ps:=src.scanline[y];
   for x:=0 to src.width-1 do begin
      b0:=(ps[x] and $FF);
      g0:=(ps[x] shr 8) and $FF;
      r0:=(ps[x] shr 16) and $FF;
      c:=(r0+g0+b0)div 3;
    if c>amount then begin
      b:=255-b0;
      g:=255-g0;
      r:=255-r0;
      end
      else begin
      b:=b0;
      g:=g0;
      r:=r0;
      end;
      SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
   end;
   src.Changed;
end;

procedure Effect_ToBinary(src: tbitmap32; amount: integer);
var x,y:integer;
    ps:Pcolor32array;
    c:integer;
    r0,g0,b0:integer;
    r:byte;
    SS:Pcolor32;
begin
  SS := @src.Bits[0];

  for y:=0 to src.height-1 do begin
   ps:=src.scanline[y];
   for x:=0 to src.width-1 do begin
      b0:=(ps[x] and $FF);
      g0:=(ps[x] shr 8) and $FF;
      r0:=(ps[x] shr 16) and $FF;
      c:=(r0+g0+b0)div 3;
      if (c>amount) then r:=$ff
    else r:=$00;

      SS^ := $FF000000 + r shl 16 + r shl 8 + r;
    inc(SS);
    end;
   end;
   src.Changed;
end;

procedure Effect_Mosaic(Bm:TBitmap32;size:Integer);
var
   x,y,i,j:integer;
   p1:Pcolor32array;
   r,g,b:byte;
   SS:Pcolor32;
begin
  SS := @bm.Bits[0];

  y:=0;
  repeat
    p1:=bm.scanline[y];
    repeat
      j:=1;
      repeat
      x:=0;
      repeat
        b:=(p1[x] and $FF);
        g:=(p1[x] shr 8) and $FF;
        r:=(p1[x] shr 16) and $FF;
        i:=1;
       repeat
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
       inc(x);
       inc(i);
       until (x>=bm.width) or (i>size);
      until x>=bm.width;
      inc(j);
      inc(y);
      until (y>=bm.height) or (j>size);
    until (y>=bm.height) or (x>=bm.width);
  until y>=bm.height;
end;

procedure Effect_Saturation(clip: tbitmap32; Amount: Integer);
var
p0:Pcolor32array;
x,y:integer;
r,g,b:byte;
gray:integer;
SS:Pcolor32;
begin
  SS := @clip.Bits[0];

  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      b:=(p0[x] and $FF);
      g:=(p0[x] shr 8) and $FF;
      r:=(p0[x] shr 16) and $FF;
      Gray:=(r+g+b)div 3;
      r:=IntToByte(Gray+(((r-Gray)*Amount)div 255));
      g:=IntToByte(Gray+(((g-Gray)*Amount)div 255));
      b:=IntToByte(Gray+(((b-Gray)*Amount)div 255));

    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
  end;
  clip.Changed;
end;

procedure Effect_ShiftXY(bmp: tbitmap32; AmountX,AmountY: Integer);
var
p0:Pcolor32array;
x,y:integer;
r,g,b: byte;
SS:Pcolor32;
x1,y1:integer;
temp:tbitmap32;
begin
  temp:=tbitmap32.create;
  temp.assign(bmp);

  for y:=0 to temp.Height-1 do
  begin
    p0:=temp.scanline[y];
    for x:=0 to temp.Width-1 do
    begin
      b:=(p0[x] and $FF);
      g:=(p0[x] shr 8) and $FF;
      r:=(p0[x] shr 16) and $FF;

    x1:=x+amountx;
    y1:=y+amounty;

    if x1>temp.width-1 then x1:=x1-temp.Width;
    if y1>temp.height-1 then y1:=y1-temp.height;

    x1:=ensurerange(x1,0,temp.width-1);
    y1:=ensurerange(y1,0,temp.height-1);
    SS:=bmp.PixelPtr[x1,y1];
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    end;
  end;
  temp.free;
  bmp.Changed;
end;

procedure Effect_Test(bmp: tbitmap32);
var
x,y:integer;
r,g,b:byte;
SrcPixel,DstPixel:Pcolor32;
temp:tbitmap32;
begin
//  DstPixel:= @bmp.Bits[0];
  temp:=tbitmap32.create;
  temp.assign(bmp);
//  SrcPixel:= @temp.Bits[0];

  for y:=0 to temp.Height-1 do
    for x:=0 to temp.Width-1 do
    begin
//get
      SrcPixel:=temp.pixelptr[x,y];
      R := (SrcPixel^ shr 16) and $FF;
      G := (SrcPixel^ shr 8 ) and $FF;
      B := (SrcPixel^       ) and $FF;
      R:=255-R;
      G:=255-G;
      B:=255-B;

//set

      DstPixel:=bmp.pixelptr[temp.Width-x-1,y];
      DstPixel^ := $FF000000 + R shl 16 + G shl 8 + B;
  end;
  temp.free;
  bmp.Changed;
end;



procedure Effect_MandelBrot(src: Tbitmap32; factor: integer);
const maxX=1.25;
      minX=-2;
      maxY=1.25;
      minY=-1.25;
var
   SS:Pcolor32;
   w,h,x,y:integer;
   dx,dy:extended;
   color:integer;
   b,g,r:byte;
FUNCTION IsMandel(CA,CBi:extended):integer;
const MAX_ITERATION=64;

VAR
  OLD_A		:extended;	  {just a variable to keep 'a' from being destroyed}
  A,B		:extended;	  {function Z divided in real and imaginary parts}
  LENGTH_Z	: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
    OLD_A:=A;		  {saves the 'a'  (Will be destroyed in next line}

    A:= A*A - B*B + CA;
    B:= 2*OLD_A*B + CBi;
    ITERATION := ITERATION + 1;
    LENGTH_Z:= A*A + B*B;
  UNTIL (LENGTH_Z >= 4) OR (ITERATION > MAX_ITERATION);
 result:=iteration;
END;

begin
 SS := @src.Bits[0];
 w:=src.width;
 h:=src.height;
 dx := (MaxX-MinX)/w;
 dy := (Maxy-MinY)/h;
 for y:=0 to h-1 do begin
   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;
     r:=255-color*7;
     g:=255-color*12;
     b:=255-color*25;
     SS^ := $FF000000 + r shl 16 + g shl 8 + b;
     inc(SS);
     end;
   end;
    src.Changed;
end;


procedure Effect_Wave2(bmp: tbitmap32; amp,period,direction:integer);
var
x,y,x1,y1:integer;
r,g,b:byte;
SrcPixel,DstPixel:Pcolor32;
temp:tbitmap32;
h,w:integer;
freq:extended;
begin
//  DstPixel:= @bmp.Bits[0];
  temp:=tbitmap32.create;
  temp.assign(bmp);
//  SrcPixel:= @temp.Bits[0];
w:=temp.width-1;
h:=temp.height-1;
if period<=0 then period:=1;
freq:=period;
  for y:=0 to h do
    for x:=0 to w do
    begin
//get
      SrcPixel:=temp.pixelptr[x,y];
      R := (SrcPixel^ shr 16) and $FF;
      G := (SrcPixel^ shr 8 ) and $FF;
      B := (SrcPixel^       ) and $FF;
//set
//    amp:=5;
//    direction=0 hor; direction=1 ver; direction=2 both;
     x1:=x;
     y1:=y;
     case direction of
     0:  x1 := x+round( amp*sin(y*(1/freq)) );
     1:  y1 := y+round( amp*cos(y*(1/freq)) );
     2: begin
          x1 := x+round( amp*sin(y*(1/freq)) );
          y1 := y+round( amp*cos(y*(1/freq)) );
        end;
     end;

    if x1>w then x1:=x1-w;
    if y1>h then y1:=y1-h;
    x1:=ensurerange(x1,0,w);
    y1:=ensurerange(y1,0,h);

      DstPixel:=bmp.pixelptr[x1,y1];
      DstPixel^ := $FF000000 + R shl 16 + G shl 8 + B;
  end;
  temp.free;
  bmp.Changed;
end;



procedure QSortByte(var A: array of byte; iLo, iHi: integer);
var
  Lo, Hi: integer;
  Mid, T: byte;
begin
  Lo := iLo;
  Hi := iHi;
  Mid := A[(Lo + Hi) shr 1];
  repeat
    while A[Lo] < Mid do Inc(Lo);
    while A[Hi] > Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := A[Lo];
      A[Lo] := A[Hi];
      A[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then QSortByte(A, iLo, Hi);
  if Lo < iHi then QSortByte(A, Lo, iHi);
end;

procedure NSort(var A:array of byte; Count:integer);
var i,j,half,minpos:integer;
minval:byte;
begin
   half := round(Count / 2);
   for i:=0 to half do
   begin
      minpos := i;
      minval := A[minpos];
      for j:=i+1 to count do
      begin
     	 if A[j] < minval then
       begin
	       minpos := j;
	       minval := A[j];
       end;
      end;
      A[minpos] := A[i];
      A[i] := round(minval);
   end;
end;

procedure Effect_Median(bmp: tbitmap32);
var
x,y:integer;
r,g,b:byte;
i:integer;
srcpixel,DstPixel:Pcolor32;
temp:tbitmap32;
dy,dx,xdim,ydim,xsize,ysize,xhalf,yhalf:integer;
arrRed,arrBlue,arrGreen:array[0..1000] of byte;
begin
//  DstPixel:= @bmp.Bits[0];
  temp:=tbitmap32.create;
  temp.assign(bmp);
//  SrcPixel:= @temp.Bits[0];
xsize:=3;
ysize:=3;
Xdim:=temp.width-1;
Ydim:=temp.height-1;
Xhalf := round(Xsize / 2);
Yhalf := round(Ysize / 2);

  for y:=0 to ydim do
    for x:=0 to xdim do
    begin
 	 i := 0;
	 for dy:=-Yhalf to (Ysize - Yhalf+1) do
	    for dx:=-Xhalf to (Xsize - Xhalf+1) do
      begin
      if ((x+dx>=0) AND (y+dy>=0) AND (x + dx <= Xdim) AND(y + dy <= Ydim)) then
        begin
         SrcPixel:=temp.pixelptr[x+dx,y+dy];
         ArrRed[i]:= (SrcPixel^ shr 16) and $FF;
         ArrGreen[i]:= (SrcPixel^ shr 8) and $FF;
         ArrBlue[i]:= (SrcPixel^ ) and $FF;
         inc(i);
        end;
       end;
{
QsortByte(ArrRed,0,i);
QsortByte(ArrGreen,0,i);
QsortByte(ArrBlue,0,i);
}
NSort(ArrRed,i);
NSort(ArrGreen,i);
NSort(ArrBlue,i);

   R:=(ArrRed[round(i/2)]);
   G:=(ArrGreen[round(i/2)]);
   B:=(ArrBlue[round(i/2)] );
//set
      DstPixel:=bmp.pixelptr[x,y];
      DstPixel^ := $FF000000 + R shl 16 + G shl 8 + B;
  end;
  temp.free;
  bmp.Changed;
end;

function Set255(Clr : integer) : integer;
asm
  MOV  EAX,Clr  // store value in EAX register (32-bit register)
  CMP  EAX,254  // compare it to 254
  JG   @SETHI   // if greater than 254 then go set to 255 (max value)
  CMP  EAX,1    // if less than 255, compare to 1
  JL   @SETLO   // if less than 1 go set to 0 (min value)
  RET           // otherwise it doesn't change, just exit
@SETHI:         // Set value to 255
  MOV  EAX,255  // Move 255 into the EAX register
  RET           // Exit (result value is the EAX register value)
@SETLO:         // Set value to 0
  MOV  EAX,0    // Move 0 into EAX register
end;            // Result is in EAX


procedure Effect_ErosionDilation(bmp:tbitmap32; amount:integer; ftype:integer);
var
  O, T, C, B : PColor32Array; // Scanlines
  x, y              : integer;
  tBufr             : TBitmap32; // temp bitmap
  Red,green,blue,max    : Integer;
  ray: array [0..8] of integer;
  i,center:integer;
  erosion:boolean;
begin
//ftype 0 : erosion; 1 dilation;
erosion:=true;
if ftype=1 then erosion:=false;

for i:=0 to amount do begin
  tBufr := TBitmap32.Create;
//  CheckParams(tBufr,aBmp);
  tBufr.Assign(Bmp);
  ray[0]:=1;    ray[1]:=1;    ray[2]:=1;
  ray[3]:=1;    ray[4]:=1;    ray[5]:=1;
  ray[6]:=1;    ray[7]:=1;    ray[8]:=1;
//  z:=9;
  for x := 1 to Bmp.Height - 2 do begin // Walk scanlines
    O := Bmp.ScanLine[x];     // New Target (Original)
    T := tBufr.ScanLine[x-1];  //old x-1  (Top)
    C := tBufr.ScanLine[x];    //old x    (Center)
    B := tBufr.ScanLine[x+1];  //old x+1  (Bottom)

    for y := 1 to (tBufr.Width - 2) do begin  // Walk pixels

    Red := Set255(
         (
RedComponent( T[y-1])*ray[0]+ RedComponent( T[y])*ray[1]+ RedComponent( T[y+1])*ray[2] +
RedComponent( C[y-1])*ray[3]+ RedComponent(C[y])*Ray[4] + RedComponent( C[y+1])*ray[5]+
RedComponent( B[y-1])*ray[6]+ RedComponent( B[y])*ray[7]+ RedComponent( B[y+1])*ray[8]
          )div 9);
    Green := Set255(
         (
GreenComponent( T[y-1])*ray[0]+ GreenComponent( T[y])*ray[1]+ GreenComponent( T[y+1])*ray[2] +
GreenComponent( C[y-1])*ray[3]+ GreenComponent(C[y])*Ray[4] + GreenComponent( C[y+1])*ray[5]+
GreenComponent( B[y-1])*ray[6]+ GreenComponent( B[y])*ray[7]+ GreenComponent( B[y+1])*ray[8]
          )div 9);
    Blue := Set255(
         (
BlueComponent( T[y-1])*ray[0]+ BlueComponent( T[y])*ray[1]+ BlueComponent( T[y+1])*ray[2] +
BlueComponent( C[y-1])*ray[3]+ BlueComponent(C[y])*Ray[4] + BlueComponent( C[y+1])*ray[5]+
BlueComponent( B[y-1])*ray[6]+ BlueComponent( B[y])*ray[7]+ BlueComponent( B[y+1])*ray[8]
          )div 9);


    max:=round((red+green+blue) div 3);
    Center:=round((set255(redcomponent(C[y]))+set255(greencomponent(C[y]))+set255(bluecomponent(C[y]))) div 3);

    if (center>max) AND (Erosion=true) then center:=max;
    if (center<max) AND (Erosion=false) then center:=max;

   O[y]:=Color32(max, max,max);
   end;
  end;
  bmp.Changed;
  tBufr.Free;
 end;
end;




procedure Effect_Average(bmp: tbitmap32);
//Binomial Filter
var
x,y:integer;
r,g,b:byte;
DstPixel:Pcolor32;
temp:tbitmap32;
  PixelArray: array[0..8] of PColor32;

begin
//  DstPixel:= @bmp.Bits[0];
  temp:=tbitmap32.create;
  temp.assign(bmp);
//  SrcPixel:= @temp.Bits[0];

  for y:=1 to temp.Height-2 do
    for x:=1 to temp.Width-2 do
    begin
//get
      PixelArray[0] := Temp.PixelPtr[x-1, y-1];
      PixelArray[1] := Temp.PixelPtr[x+1, y-1];
      PixelArray[2] := Temp.PixelPtr[x-1, y+1];
      PixelArray[3] := Temp.PixelPtr[x+1, y+1];
      PixelArray[4] := Temp.PixelPtr[x, y-1];
      PixelArray[5] := Temp.PixelPtr[x, y+1];
      PixelArray[6] := Temp.PixelPtr[x-1, y];
      PixelArray[7] := Temp.PixelPtr[x+1, y];
      PixelArray[8] := Temp.PixelPtr[x, y];
      R:=inttobyte(round(
         ((pixelarray[0]^ shr 16) and $FF+
          (pixelarray[1]^ shr 16) and $FF+
          (pixelarray[2]^ shr 16) and $FF+
          (pixelarray[3]^ shr 16) and $FF+
         ((pixelarray[4]^ shr 16) and $FF+
          (pixelarray[5]^ shr 16) and $FF+
          (pixelarray[6]^ shr 16) and $FF+
          (pixelarray[7]^ shr 16) and $FF)*2+
          ((pixelarray[8]^ shr 16) and $FF)*4)/16));
      G:=inttobyte(round(
         ((pixelarray[0]^ shr 8) and $FF+
          (pixelarray[1]^ shr 8) and $FF+
          (pixelarray[2]^ shr 8) and $FF+
          (pixelarray[3]^ shr 8) and $FF+
         ((pixelarray[4]^ shr 8) and $FF+
          (pixelarray[5]^ shr 8) and $FF+
          (pixelarray[6]^ shr 8) and $FF+
          (pixelarray[7]^ shr 8) and $FF)*2+
          ((pixelarray[8]^ shr 8) and $FF)*4)/16));
      B:=inttobyte(round(
         ((pixelarray[0]^ ) and $FF+
          (pixelarray[1]^ ) and $FF+
          (pixelarray[2]^ ) and $FF+
          (pixelarray[3]^ ) and $FF+
         ((pixelarray[4]^ ) and $FF+
          (pixelarray[5]^ ) and $FF+
          (pixelarray[6]^ ) and $FF+
          (pixelarray[7]^ ) and $FF)*2+
          ((pixelarray[8]^) and $FF)*4)/16));
//set
        R:=Ensurerange(R,0,255);
        G:=Ensurerange(G,0,255);
        B:=Ensurerange(B,0,255);
      DstPixel:=bmp.pixelptr[x,y];
      DstPixel^ := $FF000000 + R shl 16 + G shl 8 + B;
  end;
  temp.free;
  bmp.Changed;
end;




procedure Effect_Gradient(bmp: tbitmap32; min,max,operation:integer);
var
x,y:integer;
r: byte;
SS:Pcolor32;
temp:tbitmap32;
sg:integer;
ti,tj,fx,fy:extended;
begin
  SS := @bmp.Bits[0];

  fx:=0;
  fy:=0;
  temp:=tbitmap32.create;
  temp.assign(bmp);

  sg:=1;
  if max<min then
  begin
  sg:=-1;
{  tmpi:=max;
  max:=min;
  min:=tmpi;
}  end;

  for y:=0 to temp.Height-1 do
  begin
    for x:=0 to temp.Width-1 do
    begin
//range 0..1
ti:=(x/(temp.width-1));
tj:=(y/(temp.height-1));
if sg=-1 then
begin
  ti:=(((temp.width-1)-x)/(temp.width-1));
  tj:=(((temp.height-1)-y)/(temp.height-1));
end;

case operation of
0:  begin
      fx:=ti;
      fy:=0;
    end;
1:  begin
      fx:=0;
      fy:=tj;
    end;
2:  begin
      fx:=ti/2;
      fy:=tj/2;
    end;
3:  begin
    if ti<0.5 then fx:=ti/2;
    if ti>=0.5 then fx:=(1-ti)/2;
    if tj<0.5 then fy:=tj/2;
    if tj>=0.5 then fy:=(1-tj)/2;
    end;
end;

    r:=round((fx+fy)*(max-min)+min);

    SS^ := $FF000000 + r shl 16 + r shl 8 + r;
    inc(SS);
    end;
  end;
  temp.free;
  bmp.Changed;
end;

procedure Effect_ConvertToPolar(bmp: tbitmap32);
var
x,y,x1,y1:integer;
r,g,b:byte;
rt,theta,dx,dy,txmid,tymid:extended;
SrcPixel,DstPixel:Pcolor32;
temp:tbitmap32;
begin
//  DstPixel:= @bmp.Bits[0];
  temp:=tbitmap32.create;
  temp.assign(bmp);
//  SrcPixel:= @temp.Bits[0];
  txmid:=(temp.width-1)/2;
  tymid:=(temp.height-1)/2;


  for y:=0 to temp.Height-1 do
    for x:=0 to temp.Width-1 do
    begin
//get
      SrcPixel:=temp.pixelptr[x,y];
      R := (SrcPixel^ shr 16) and $FF;
      G := (SrcPixel^ shr 8 ) and $FF;
      B := (SrcPixel^       ) and $FF;
{      R:=255-R;
      G:=255-G;
      B:=255-B;
}
      dx := x - txmid;
      dy := y - tymid;
      rt := Sqrt(dx * dx + dy * dy);
//    rt:=sqrt(x*x+y*y);
    theta := ArcTan2(dx,dy)-rt;
    x1 :=round(temp.Width/2+( rt * Cos(theta)));
    y1 :=round(temp.height/2+( rt * Sin(theta)));

//set
    x1:=ensurerange(x1,0,bmp.width-1);
    y1:=ensurerange(y1,0,bmp.height-1);
    DstPixel:=bmp.pixelptr[x1,y1];
    DstPixel^ := $FF000000 + R shl 16 + G shl 8 + B;
  end;
  temp.free;
  bmp.Changed;
end;


 // == HLS / RGB =======================================================
  //
  // Based on C Code in "Computer Graphics -- Principles and Practice,"
  // Foley et al, 1996, p. 596.

function HSLtoRGB(H, S, L: Integer): TColor32;
var
  V, M, M1, M2, VSF: Integer;
begin
  if L <= $7F then
    V := L * (256 + S) shr 8
  else
    V := L + S - L * S div 255;
  if V <= 0 then
    Result := Color32(0, 0, 0, 0)
  else
  begin
    M := L * 2 - V;
    H := H * 6;
    VSF := (V - M) * (H and $ff) shr 8;
    M1 := M + VSF;
    M2 := V - VSF;
    case H shr 8 of
      0: Result := Color32(V, M1, M, 0);
      1: Result := Color32(M2, V, M, 0);
      2: Result := Color32(M, V, M1, 0);
      3: Result := Color32(M, M2, V, 0);
      4: Result := Color32(M1, M, V, 0);
      5: Result := Color32(V, M, M2, 0);
    end;
  end;
end;

function Max(const A, B, C: Integer): Integer;
asm
      CMP       EDX,EAX
      CMOVG     EAX,EDX
      CMP       ECX,EAX
      CMOVG     EAX,ECX
end;

function Min(const A, B, C: Integer): Integer;
asm
      CMP       EDX,EAX
      CMOVL     EAX,EDX
      CMP       ECX,EAX
      CMOVL     EAX,ECX
end;

procedure RGBtoHSL(RGB: TColor32; out H, S, L: Byte);
var
  R, G, B, D, Cmax, Cmin, HL: Integer;
begin
  R := (RGB shr 16) and $ff;
  G := (RGB shr 8) and $ff;
  B := RGB and $ff;

  Cmax := Max(R, G, B);
  Cmin := Min(R, G, B);
  L := (Cmax + Cmin) div 2;

  if Cmax = Cmin then
  begin
    H := 0;
    S := 0
  end
  else
  begin
    D := (Cmax - Cmin) * 255;
    if L <= $7F then
      S := D div (Cmax + Cmin)
    else
      S := D div (255 * 2 - Cmax - Cmin);

    D := D * 6;
    if R = Cmax then
      HL := (G - B) * 255 * 255 div D
    else if G = Cmax then
      HL := 255 * 2 div 6 + (B - R) * 255 * 255 div D
    else
      HL := 255 * 4 div 6 + (R - G) * 255 * 255 div D;

    if HL < 0 then HL := HL + 255 * 2;
    H := HL;
  end;
end;

procedure Effect_IncDecRGB(clip:tbitmap32;r0,g0,b0:integer);
var
p0:Pcolor32array;
x,y:integer;
r,g,b: byte;
SS:Pcolor32;
begin
  SS := @clip.Bits[0];

  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      b:=(p0[x] and $FF);
      g:=(p0[x] shr 8) and $FF;
      r:=(p0[x] shr 16) and $FF;
    r := EnsureRange(r+r0, 0,255);
    g := EnsureRange(g+g0, 0, 255);
    b := EnsureRange(b+b0, 0, 255);
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
  end;
  clip.Changed;
end;

procedure Effect_IncDecHSL(clip:tbitmap32;h0,s0,l0:integer);
var
p0:Pcolor32array;
x,y: Integer;
hd,sd,vd:byte;
SS:Pcolor32;
ps:TColor32; //singlepixel

begin
  SS := @clip.Bits[0];
  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
    RGBToHSL(p0[x],hd,sd,vd);
//    hd := ensurerange(hd + (h0),-180,180);
    sd := round(ensurerange(sd + (s0),0,255));
    vd := round(ensurerange(vd + (l0),0,255));
    hd := hd + (h0);
    if hd>255 then hd:=hd-255;
    if hd<0 then hd:=255-hd;


    ps:=HSLtoRGB(hd,sd,vd);
    SS^ := ps;
    inc(SS);
    end;
  end;
  clip.Changed;
end;

procedure RGBTOCMYK(R : byte;
                    G : byte;
                    B : byte;
                    var C : byte;
                    var M : byte;
                    var Y : byte;
                    var K : byte);
begin
  C := 255 - R;
  M := 255 - G;
  Y := 255 - B;
  if C < M then
    K := C else
    K := M;
  if Y < K then
    K := Y;
  if k > 0 then begin
    c := c - k;
    m := m - k;
    y := y - k;
  end;
end;

procedure CMYKTORGB(C : byte;
                    M: byte;
                    Y : byte;
                    K : byte;
                    var R : byte;
                    var G : byte;
                    var B : byte);
begin
   if (Integer(C) + Integer(K)) < 255 then
     R := 255 - (C + K) else
     R := 0;
   if (Integer(M) + Integer(K)) < 255 then
     G := 255 - (M + K) else
     G := 0;
   if (Integer(Y) + Integer(K)) < 255 then
     B := 255 - (Y + K) else
     B := 0;
end;

procedure Effect_IncDecCMYK(clip:tbitmap32;c2,m2,y2,k2:integer);
var
p0:Pcolor32array;
x,y:integer;
r,g,b: byte;
SS:Pcolor32;
c0,m0,y0,k0,c1,m1,y1,k1:byte;
begin
  SS := @clip.Bits[0];

  for y:=0 to clip.Height-1 do
  begin
    p0:=clip.scanline[y];
    for x:=0 to clip.Width-1 do
    begin
      b:=(p0[x] and $FF);
      g:=(p0[x] shr 8) and $FF;
      r:=(p0[x] shr 16) and $FF;
    RGBTOCMYK(r,g,b,c0,m0,y0,k0);
    c1 := round(ensurerange(c0 + (c2),0,255));
    m1 := round(ensurerange(m0 + (m2),0,255));
    y1 := round(ensurerange(y0 + (y2),0,255));
    k1 := round(ensurerange(k0 + (k2),0,255));
    CMYKTORGB(c1,m1,y1,k1,r,g,b);
    SS^ := $FF000000 + r shl 16 + g shl 8 + b;
    inc(SS);
    end;
  end;
  clip.Changed;
end;


procedure Effect_Dither(src: TBitmap32);
Const
     MY = 500;
     RP = 0.2989;
     GP = 0.5866;
     BP = 1 - RP - GP;
var
  x, y: Integer;
  p0: PColor32array;
  R, G, B: Integer;
  L0, L1: array[-1..MY+1] of Integer;
  light: Integer;
SS:Pcolor32;
begin
  SS := @src.Bits[0];
  for y:=0 to src.Height-1 do
  begin
    p0:=src.scanline[y];
    L0 := L1;
    FillChar(L1, SizeOf(L1), #0);
    for x:=0 to src.Width-1 do
    begin
      b:=(p0[x] and $FF);
      g:=(p0[x] shr 8) and $FF;
      r:=(p0[x] shr 16) and $FF;
       light := Trunc(r * rp+ g * gp + b * bp);
       light := light + L0[Y];
      if light > 255 then
      begin
      SS^ := $FF000000 + 255 shl 16 + 255 shl 8 + 255;
          inc(SS);
      light:=light-255;
      end else
      begin
      SS^ := $FF000000 + 0 shl 16 + 0 shl 8 + 0;
          inc(SS);
      end;
          Inc(L0[x+1], light div 4);
          Inc(L1[x-1], light div 4);
          Inc(L1[x  ], light div 4);
          Inc(L1[x+1], light - 3*(light div 4) );
     end;
   end;
   src.changed;
end;

procedure Effect_FreiChen(src: TBitmap32);
var
 temp:tbitmap32;
 temp2:tbitmap32;
 temp3:tbitmap32;
 temp4:tbitmap32;
begin
 temp:=tbitmap32.create;
 temp2:=tbitmap32.create;
 temp3:=tbitmap32.create;
 temp4:=tbitmap32.create;
 temp.Assign(src);
 temp2.Assign(src);
 temp3.Assign(src);
 temp4.Assign(src);

ApplyConvolution3x3(temp,[2, 3, 2,
                          0, 0, 0,
                         -2,-3,-2],9);
ApplyConvolution3x3(temp2,[2, 0, -2,
                          3, 0, -3,
                          2, 0, -2],9);
ApplyConvolution3x3(temp3,[0, -2, -3,
                          2, 0, -2,
                         -3, 2, 0],9);
ApplyConvolution3x3(temp4,[3, -2, 0,
                         -2, 0, 2,
                          0, 2, -3],9);
Arithmetic_MergeBitmaps(temp,temp2,'additive');
Arithmetic_MergeBitmaps(temp3,temp4,'additive');
Arithmetic_MergeBitmaps(temp2,temp4,'additive');
src.Assign(temp4);

  temp.Free;
  temp2.free;
end;

procedure Effect_GreyScaleDilation(Src: TBitmap32);
var
  I,j,k: Integer;
  D, S: PColor32;
  dst:tbitmap32;
  b,r,g,max:byte;
  sz:array of integer;
  sznr:integer;
begin
  dst:=tbitmap32.Create;
  dst.SetSize(Src.Width, Src.Height);
//init;
  S := @Src.Bits[0];
  sznr:=src.width*src.height;
  sz:=nil;
  SetLength(sz, sznr);

  for I:=0 to sznr-1 do
  begin
      b:=(S^ and $FF);
      g:=(S^ shr 8) and $FF;
      r:=(S^ shr 16) and $FF;
      max:=round((b+g+r) div 3);
    sz[i]:=max;
    Inc(S);
  end;
//proc
  D := @dst.Bits[0];
  for J:= 1 to src.Height-1 do
  for I := 1 to src.width-1 do
  begin
//   /* Dilation */
   max:= sz[(J*(src.Width-1))+I];

   if (sz[(J*(src.Width-1))+I-1]>max) then max:=sz[(J*(src.Width-1))+I-1];
   if (sz[(J*(src.Width-1))+I+1]>max) then max:=sz[(J*(src.Width-1))+I+1];
   if (sz[((J-1)*(src.Width-1))+I]>max) then max:=sz[((J-1)*(src.Width-1))+I];
   k:=((J+1)*(src.Width-1))+I;
   if (k<sznr) and (sz[k]>max) then max:=sz[k];

   if (sz[((J-1)*(src.Width-1))+I-1]>max) then max:=sz[((J-1)*(src.Width-1))+I-1];
   k:=((J+1)*(src.Width-1))+I-1;
   if (k<sznr) and (sz[k]>max) then max:=sz[k];
   if (sz[((J-1)*(src.Width-1))+I+1]>max) then max:=sz[((J-1)*(src.Width-1))+I+1];
   k:=((J+1)*(src.Width-1))+I+1;
   if (k<sznr) and (sz[k]>max) then max:=sz[k];

 //  if max>$ff then max:=$ff;

   D^ := $FF000000 + max shl 16 + max shl 8 + max;
  Inc(D);
  end;

  src.assign(dst);
  src.Changed;
end;

procedure Effect_GreyScaleErosion(Src: TBitmap32);
var
  I,j,k: Integer;
  D, S: PColor32;
  dst:tbitmap32;
  b,r,g,min:byte;
  sz:array of integer;
  sznr:integer;
begin
  dst:=tbitmap32.Create;
  dst.SetSize(Src.Width, Src.Height);
//init;
  S := @Src.Bits[0];
  sznr:=src.width*src.height;
  sz:=nil;
  SetLength(sz, sznr);

  for I:=0 to sznr-1 do
  begin
      b:=(S^ and $FF);
      g:=(S^ shr 8) and $FF;
      r:=(S^ shr 16) and $FF;
      min:=round((b+g+r) div 3);
    sz[i]:=min;
    Inc(S);
  end;
//proc
  D := @dst.Bits[0];
  for J:= 1 to src.Height-1 do
  for I := 1 to src.width-1 do
  begin
//   /* Dilation */
   min:= sz[(J*(src.Width-1))+I];

   if (sz[(J*(src.Width-1))+I-1]<min) then min:=sz[(J*(src.Width-1))+I-1];
   if (sz[(J*(src.Width-1))+I+1]<min) then min:=sz[(J*(src.Width-1))+I+1];
   if (sz[((J-1)*(src.Width-1))+I]<min) then min:=sz[((J-1)*(src.Width-1))+I];
   k:=((J+1)*(src.Width-1))+I;
   if (k<sznr) and (sz[k]<min) then min:=sz[k];

   if (sz[((J-1)*(src.Width-1))+I-1]<min) then min:=sz[((J-1)*(src.Width-1))+I-1];
   k:=((J+1)*(src.Width-1))+I-1;
   if (k<sznr) and (sz[k]<min) then min:=sz[k];
   if (sz[((J-1)*(src.Width-1))+I+1]<min) then min:=sz[((J-1)*(src.Width-1))+I+1];
   k:=((J+1)*(src.Width-1))+I+1;
   if (k<sznr) and (sz[k]<min) then min:=sz[k];

 //  if max>$ff then max:=$ff;

   D^ := $FF000000 + min shl 16 + min shl 8 + min;
  Inc(D);
  end;

  src.assign(dst);
  src.Changed;
end;

procedure Effect_GreyScaleOpening(Src: TBitmap32);
var
tmp:tbitmap32;
begin
 tmp:=tbitmap32.Create;
 tmp.Assign(src);
  Effect_GreyScaleErosion(tmp);
  Effect_GreyScaleDilation(tmp);
 src.assign(tmp);
 tmp.free;
end;

procedure Effect_GreyScaleClosing(Src: TBitmap32);
var
tmp:tbitmap32;
begin
 tmp:=tbitmap32.Create;
 tmp.Assign(src);
  Effect_GreyScaleDilation(tmp);
  Effect_GreyScaleErosion(tmp);
 src.assign(tmp);
 tmp.free;
end;

procedure Effect_GreyScaleItandMiss(Src: TBitmap32);
var
tmp,tmp2:tbitmap32;
begin
 tmp:=tbitmap32.Create;
 tmp.Assign(src);
 tmp2:=tbitmap32.Create;
 tmp2.Assign(src);

  Effect_GreyScaleDilation(tmp);
  Effect_GreyScaleErosion(tmp2);

 Arithmetic_MergeBitmaps(tmp,tmp2,'difference');
 src.assign(tmp2);

 tmp.free;
 tmp2.free;
end;

procedure Effect_Outline(Src: TBitmap32);
var
  I,j,k,l: Integer;
  D, S: PColor32;
  dst:tbitmap32;
  b,r,g,max,center:byte;
  sz:array of integer;
  sznr:integer;
  ray:array[0..8] of integer;
begin
  dst:=tbitmap32.Create;
  dst.SetSize(Src.Width, Src.Height);
//init;
  S := @Src.Bits[0];
  sznr:=src.width*src.height;
  sz:=nil;
  SetLength(sz, sznr);

  for I:=0 to sznr-1 do
  begin
      b:=(S^ and $FF);
      g:=(S^ shr 8) and $FF;
      r:=(S^ shr 16) and $FF;
      max:=round((b+g+r) div 3);
    sz[i]:=max;
    Inc(S);
  end;
//proc
  D := @dst.Bits[0];
  for J:= 1 to src.Height-1 do
  for I := 1 to src.width-1 do
  begin
// createmask
   for K:=0 to 2 do
    for L:=0 to 2 do begin
   ray[k*3+L]:=sz[((J+k-1)*(src.Width-1))+(I+l-1)];
    end;

   center:=ray[4];
   if center=$ff then begin
     if (ray[0]=0)or(ray[1]=0)or(ray[2]=0)or(ray[3]=0)or(ray[5]=0)or
        (ray[6]=0)or(ray[7]=0)or(ray[8]=0) then
        center:=$ff else center:=0;
   end;

   D^ := $FF000000 + center shl 16 + center shl 8 + center;
  Inc(D);
  end;

  src.assign(dst);
  src.Changed;
end;

procedure Effect_HeightMap(Src: TBitmap32;amount:integer);
var
  I,j,k,l: Integer;
  D, S: PColor32;
  dst:tbitmap32;
  b,r,g,max,center:byte;
  sz:array of integer;
  sznr:integer;
  ray:array[0..8] of integer;
begin
  dst:=tbitmap32.Create;
  dst.SetSize(Src.Width, Src.Height);
//init;
  S := @Src.Bits[0];
  sznr:=src.width*src.height;
  sz:=nil;
  SetLength(sz, sznr);

  for I:=0 to sznr-1 do
  begin
      b:=(S^ and $FF);
      g:=(S^ shr 8) and $FF;
      r:=(S^ shr 16) and $FF;
      max:=round((b+g+r) div 3);
//      max:=round(max/8)*8; //colorreduction;
    sz[i]:=max;
    inc(s);
  end;
//proc
  D := @dst.Bits[0];
  for I:=0 to sznr-1 do
  begin
    max:=sz[i];
    sz[i]:=0;
    center:=max*amount;
    center:=ensurerange(center,0,255);
    D^ := $FF000000 + center shl 16 + center shl 8 + center;
  Inc(D);
  end;

  src.assign(dst);
  src.Changed;
end;


procedure Effect_tile(src: TBitmap32; amount: integer);
var w,h,w2,h2,i,j:integer;
    bm:tbitmap32;
    dst:tbitmap32;
begin
  dst:=tbitmap32.create;
  bm:=tbitmap32.create;
  w:=src.width;
  h:=src.height;
  dst.Assign(src);
  bm.Assign(dst);

  if (amount<=0) or ((w div amount)<5)or ((h div amount)<5) then exit;
  h2:=h div amount;
  w2:=w div amount;

//  ResizeCtrlForm.Resample(Src,bm,w2,h2,sflanczos);

  for j:=0 to amount-1 do
   for i:=0 to amount-1 do
     dst.Draw (i*w2,j*h2,bm);
  src.assign(dst);
  src.Changed;
  bm.free;
  dst.free;
end;

{
procedure Effect_FFT(Src:TBitmap32);
var
  x, y,i,j,k: Integer;
  areal,img,f2_abs,K2:real;
  SS: PColor32;
  ps: pcolor32array;
  C, R, G, B: Integer;
  D: double;
  x2, f2        : pflt_array;
  nbr_points  : longint;
  fft         : TFFTReal;
  max,min,h1,h2,h3:integer;
  dst:tbitmap32;
  PI:real;
begin
  dst:=tbitmap32.create;

  Dst.Assign(Src);

  nbr_points := 2*dst.height*dst.width; //power of 2;
  GetMem(x2, nbr_points * sizeof_flt);
  GetMem(f2, nbr_points * sizeof_flt);
  fft := TFFTReal.Create(nbr_points);

  SS := @dst.Bits[0];

  PI:=arctan(1)*4;

  for I:=0 to (nbr_points div 2)-1 do
  begin
      b:=(SS^ and $FF);
      g:=(SS^ shr 8) and $FF;
      r:=(SS^ shr 16) and $FF;
       D:= trunc((b+g+r)div 3);
       x2^[I*2] :=D/255;
       if I<20 then logform.Memo1.Lines.Add(floattostr(x2^[i]));
    Inc(SS);
  end;
  for I:=0 to (nbr_points div 2)-1 do
  begin
       x2^[I*2+1] :=0;
  end;

  fft.do_fft(f2, x2);
  fft.rescale(x2);

  SS := @dst.Bits[0];

max:=0; min:=0;
for I:=0 to (nbr_points div 2)-1 do
begin
    areal := f2^[i];
    if (i > 0) and (i < nbr_points div 2) then
      img := f2^[i+nbr_points div 2]
    else
    f2_abs := Sqrt(areal * areal + img * img);

    K2:=areal;
    K2:=sqrt(K2*K2);
    K2:=K2/(dst.width);
    K2:=K2*255;
       if k2>max then max:=round(k2);
       if k2<min then min:=round(k2);
       if I<20 then logform.Memo1.Lines.Add(floattostr(K2));
       c := ensurerange(round(K2),0,255);
       SS^ := $FF000000 + c shl 16 + c shl 8 + c;
       inc(SS);
  end;
       logform.Memo1.Lines.Add('min/max'+inttostr(min)+' '+inttostr(max));

  FreeMem(x2);
  FreeMem(f2);
  fft.free;

  //swap 1&4 and 2&3
  Effect_shiftxy(dst,dst.width div 2,dst.Height div 2);

  src.Assign(dst);
  dst.free;

end;

procedure Effect_IFFT(Src:TBitmap32);
var
  x, y,i,j,k: Integer;
  areal,img,f2_abs,K2:real;
  SS: PColor32;
  ps: pcolor32array;
  C, R, G, B: Integer;
  D: double;
  x2, f2        : pflt_array;
  nbr_points  : longint;
  fft         : TFFTReal;
  max,min,h1,h2,h3:integer;
  dst:tbitmap32;
  PI:real;
begin
  dst:=tbitmap32.create;

  Dst.Assign(Src);

  nbr_points := 2*dst.height*dst.width; //power of 2;
  GetMem(x2, nbr_points * sizeof_flt);
  GetMem(f2, nbr_points * sizeof_flt);
  fft := TFFTReal.Create(nbr_points);

  SS := @dst.Bits[0];

  PI:=arctan(1)*4;

  //swap 1&4 and 2&3
  Effect_shiftxy(dst,-dst.width div 2,-dst.Height div 2);

  for I:=0 to (nbr_points div 2)-1 do
  begin
      b:=(SS^ and $FF);
      g:=(SS^ shr 8) and $FF;
      r:=(SS^ shr 16) and $FF;
       D:= trunc((b+g+r)div 3);
       x2^[I*2] :=D/255;

       if I<20 then logform.Memo1.Lines.Add(floattostr(x2^[i]));
    Inc(SS);
  end;
  for I:=0 to (nbr_points div 2)-1 do
  begin
       x2^[I*2+1] :=0;
  end;

  fft.do_ifft(f2, x2);
  fft.rescale(x2);

//  dst.Height:=round(dst.height/2);
//  dst.Width:=round(dst.width/2);
  SS := @dst.Bits[0];
{  for J:=0 to dst.Height-1 do
  for I:=0 to dst.width-1 do
  begin
}
{
max:=0; min:=0;
for I:=0 to (nbr_points div 2)-1 do
begin
    K2:=f2^[i]*255;
       if k2>max then max:=round(k2);
       if k2<min then min:=round(k2);
       if I<20 then logform.Memo1.Lines.Add(floattostr(K2));
       c := ensurerange(round(K2),0,255);
       SS^ := $FF000000 + c shl 16 + c shl 8 + c;
       inc(SS);
  end;
       logform.Memo1.Lines.Add('min/max'+inttostr(min)+' '+inttostr(max));
  FreeMem(x2);
  FreeMem(f2);
  fft.free;

  src.Assign(dst);
  dst.free;
  //  FreeMem(x2);
//  FreeMem(f2);

end;
//////
}




end.
