unit VCLImageUtils;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
PngImage, GifImg, Math, Jpeg, Types;

const
clAliceBlue = $FFF8F0;
clAntiqueWhite = $D7EBFA;
clAquamarine = $D4FF7F;
clAzure = $FFFFF0;
clBeige = $DCF5F5;
clBisque = $C4E4FF;
clBlanchedAlmond = $CDEBFF;
clBlueViolet = $E22B8A;
clBrown = $2A2AA5;
clBurlyWood = $87B8DE;
clCadetBlue = $A09E5F;
clChartreuse = $00FF7F;
clChocolate = $1E69D2;
clCoral = $507FFF;
clCornflowerBlue = $ED9564;
clCornsilk = $DCF8FF;
clCrimson = $3C14DC;
clCyan = $FFFF00;
clDarkBlue = $8B0000;
clDarkCyan = $8B8B00;
clDarkGoldenrod = $0B86B8;
clDarkGray = $A9A9A9;
clDarkGreen = $006400;
clDarkKhaki = $6BB7BD;
clDarkMagenta = $8B008B;
clDarkOliveGreen = $2F6B55;
clDarkOrange = $008CFF;
clDarkOrchid = $CC3299;
clDarkRed = $00008B;
clDarkSalmon = $7A96E9;
clDarkSeaGreen = $8BBC8F;
clDarkSlateBlue = $8B3D48;
clDarkSlateGray = $4F4F2F;
clDarkTurquoise = $D1CE00;
clDarkViolet = $D30094;
clDeepPink = $9314FF;
clDeepSkyBlue = $FFBF00;
clDimGray = $696969;
clDodgerBlue = $FF901E;
clFirebrick = $2222B2;
clFloralWhite = $F0FAFF;
clForestGreen = $228B22;
clGainsboro = $DCDCDC;
clGhostWhite = $FFF8F8;
clGold = $00D7FF;
clGoldenrod = $20A5DA;
clGreenYellow = $2FFFAD;
clHoneydew = $F0FFF0;
clHotPink = $B469FF;
clIndianRed = $5C5CCD;
clIndigo = $82004B;
clIvory = $F0FFFF;
clKhaki = $8CE6F0;
clLavender = $FAE6E6;
clLavenderBlush = $F5F0FF;
clLawnGreen = $00FC7C;
clLemonChiffon = $CDFAFF;
clLightBlue = $E6D8AD;
clLightCoral = $8080F0;
clLightCyan = $FFFFE0;
clLightGoldenrodYellow = $D2FAFA;
clLightGray = $D3D3D3;
clLightGreen = $90EE90;
clLightPink = $C1B6FF;
clLightSalmon = $7AA0FF;
clLightSeaGreen = $AAB220;
clLightSkyBlue = $FACE87;
clLightSlateGray = $998877;
clLightSteelBlue = $DEC4B0;
clLightYellow = $E0FFFF;
clLimeGreen = $32CD32;
clLinen = $E6F0FA;
clMagenta = $FF00FF;
clMediumAquamarine = $AACD66;
clMediumBlue = $CD0000;
clMediumOrchid = $D355BA;
clMediumPurple = $DB7093;
clMediumSeaGreen = $71B33C;
clMediumSlateBlue = $EE687B;
clMediumSpringGreen = $9AFA00;
clMediumTurquoise = $CCD148;
clMediumVioletRed = $8515C7;
clMidnightBlue = $701919;
clMintCream = $FAFFF5;
clMistyRose = $E1E4FF;
clMoccasin = $B5E4FF;
clNavajoWhite = $ADDEFF;
clOldLace = $E6F5FD;
clOliveDrab = $238E6B;
clOrange = $00A5FF;
clOrangeRed = $0045FF;
clOrchid = $D670DA;
clPaleGoldenrod = $AAE8EE;
clPaleGreen = $98FB98;
clPaleTurquoise = $EEEEAF;
clPaleVioletRed = $9370DB;
clPapayaWhip = $D5EFFF;
clPeachPuff = $B9DAFF;
clPeru = $3F85CD;
clPink = $CBC0FF;
clPlum = $DDA0DD;
clPowderBlue = $E6E0B0;
clPurple = $800080;
clRosyBrown = $8F8FBC;
clRoyalBlue = $E16941;
clSaddleBrown = $13458B;
clSalmon = $7280FA;
clSandyBrown = $60A4F4;
clSeaGreen = $578B2E;
 clSeaShell = $EEF5FF;
clSienna = $2D52A0;
clSkyBlue = $EBCE87;
clSlateBlue = $CD5A6A;
clSlateGray = $908070;
clSnow = $FAFAFF;
clSpringGreen = $7FFF00;
clSteelBlue = $B48246;
clTan = $8CB4D2;
clThistle = $D8BFD8;
clTomato = $4763FF;
clTurquoise = $D0E040;
clViolet = $EE82EE;
clWheat = $B3DEF5;
clWhiteSmoke = $F5F5F5;
clYellowGreen = $32CD9A;

type
TFlipType = (ftUpDown, ftLeftRight);
TRGBQuadArray = array[BYTE] of TRGBQuad;
TErrorDiffusion = (edNone, edFloydSteinberg, edStucki, edSierra, edJaJuNi);
TResizeMode = (rmNearest, rmBilinear, rmBicubic, rmLagrange,
rmBSpline, rmMitchell);
TRankMode = (rkMax, rkMin);
TPointF = packed record
X, Y: single;
end;
TMirrorType = (mtLeft, mtRight);
TCylinderDirection = (cdVertical, cdHorizontal);
TBathWindowMode = (bwVertical, bwHorizontal, bwBoth);
TWaveType = (wtVertical, wtHorizontal, wtBoth);
TSineMask = (smVert, smHorz, smBoth);

TBmpData24 = class(TObject)
private
sl: array of Pointer;
FWidth, FHeight: integer;
function GetData(x, y: integer):PRGBTriple;
protected
public
constructor Create(bmp: TBitmap);
destructor Destroy; override;
property Data[x, y: integer]: PRGBTriple read GetData; default;
property Width: integer read FWidth;
property Height: integer read FHeight;
end;

TBmpData8 = class(TObject)
private
sl: array of Pointer;
FWidth, FHeight: integer;
function GetData(x, y: integer):PByte;
protected
public
constructor Create(bmp: TBitmap);
destructor Destroy; override;
property Data[x, y: integer]: PByte read GetData; default;
property Width: integer read FWidth;
 property Height: integer read FHeight;
end;

TBmpData4 = class(TObject)
private
sl: array of Pointer;
function GetData(x, y: integer):Byte;
procedure SetData(x, y: integer; value: Byte);
protected
public
constructor Create(bmp: TBitmap);
destructor Destroy; override;
property Data[x, y: integer]: Byte read GetData write SetData; default;
end;

TBmpData1 = class(TObject)
private
sl: array of Pointer;
FWidth, FHeight: integer;
function GetData(x, y: integer):Boolean;
procedure SetData(x, y: integer; value: Boolean);
protected
public
constructor Create(bmp: TBitmap);
destructor Destroy; override;
property Data[x, y: integer]: Boolean read GetData write SetData; default;
property Width: integer read FWidth;
property Height: integer read FHeight;
end;

function LoadPng(filename: string): TBitmap;

function LoadGif(filename: string): TBitmap;
function LoadJpeg(filename: string): TBitmap;
function JAlphaBlend(dst: TCanvas; dstX, dstY: integer;
src: TBitmap; alpha: single):Boolean;
function LoadCheckedImage(filename: string): TBitmap;
function GetThumbnailImage(filename: string;
width, height: integer;
bkColor: TColor = clWhite;
frame: Boolean = true): TBitmap;

function BmpClone(bmp: TBitmap): TBitmap;

function AdjustByte(value: integer): Byte; overload;
function AdjustByte(value: extended): Byte; overload;
function ExeDir: string;

function Flip(bmp: TBitmap; FlipType: TFlipType):Boolean;

function Rotate90(var bmp: TBitmap; plus: Boolean = true):Boolean;
function Invert(bmp: TBitmap): Boolean;
function PaletteEntryBmp(bmp8: TBitmap): TBitmap;
procedure GrayScale8(bmp8: TBitmap);
procedure SetGrayPalette(bmp8: TBitmap);
function GrayScale4(var bmp: TBitmap):Boolean;
function GrayScale4FloydStucci(var bmp: TBitmap; Stretch: Boolean = true):Boolean;
function GrayScale(var bmp: TBitmap):Boolean;
function BlackWhiteFloydStucci2(var bmp: TBitmap; threshold: byte = 127;
Stretch: Boolean = true;
Dark: TColor = clBlack;
 Bright: TColor = clWhite):Boolean;
function BrightnessHistogram(bmp: TBitmap): TBitmap;
function RGBHistogram(bmp: TBitmap): TBitmap;
function Brightness(bmp: TBitmap; percent: integer = 10):Boolean;
function Contrast(bmp: TBitmap; nContrast: integer):Boolean;
function TwoColorGrayScale(var bmp: TBitmap; Dark, Bright: TColor):Boolean;
function Gamma(bmp: TBitmap; dGamma: single):Boolean;
function ColorFilter(bmp: TBitmap; fRed, fGreen, fBlue: single):Boolean;
function Saturation(bmp: TBitmap; percent: extended):Boolean;
procedure RGBToHSL(rgb: TRGBTriple; var h, s, l :integer);
procedure HSLToRGB(rgb: PRGBTriple; h, s, l :integer);
function Hue(bmp: TBitmap; angle: integer = 20):Boolean;
function HueHistogram(bmp24: TBitmap): TBitmap;
function Luminance(bmp: TBitmap; percent: integer = 20):Boolean;
function HistoStretch(grayBMP: TBitmap):Boolean;
function CountColors(bmp24: TBitmap):integer;
function BlackWhite(var bmp24: TBitmap; threshold: byte = 127): Boolean;
function RandomDither(var bmp24: TBitmap;
ErrorDiffusion: TErrorDiffusion = edStucki;
Dark: TColor = clBlack;
Bright: TColor = clWhite;
randomness: integer = 30;
Stretch: Boolean = true): Boolean;
function OrderedDither(var bmp24: TBitmap;
ErrorDiffusion: TErrorDiffusion = edStucki;
Dark: TColor = clBlack;
Bright: TColor = clWhite;
Stretch: Boolean = true):Boolean;
function Mirror(bmp: TBitmap;
mt: TMirrorType = mtLeft;
center: integer = 0): Boolean;
function RiceCake(bmp: TBitmap; factor: single = 0.8):Boolean;

function BmpResize(var bmp: TBitmap;

rwidth, rheight: integer;
mode: TResizeMode = rmBilinear):Boolean;
function PointF(X, Y: single): TPointF;
function Rotation(var bmp: TBitmap; angle: single; bkColor: TColor): Boolean;
function PtFInRect(pt: TPointF; r: TRect): Boolean;
function Caricature(bmp: TBitmap; factor: single = 100):Boolean;
function Fisheye(bmp: TBitmap; factor: single = 100):Boolean;
function SoftFisheye(bmp: TBitmap; factor: single = 0.8):Boolean;
function Swirl(bmp: TBitmap; factor: single = 0.05):Boolean;
function Shear(bmp: TBitmap; entropy: single = 0.4): Boolean;
function Cylinder(bmp: TBitmap; cd: TCylinderDirection = cdVertical):Boolean;
function BathroomWindow(bmp: TBitmap;
zone: integer = 10;
mode: TBathWindowMode = bwVertical):Boolean;
function BathroomWindow2(bmp: TBitmap; zone: integer = 8):Boolean;
function SpotLight(bmp: TBitmap; radius: integer):Boolean;
function Tile(bmp: TBitmap; area:integer = 16; entropy: integer = 2):Boolean;
function Ripple(bmp: TBitmap;
factor: single = 3.0;
frequency: single = 40):Boolean;
function Pixellate2(bmp: TBitmap; zone: integer = 6):Boolean;
function Ripple2(bmp: TBitmap;
factor: single = 0.2;
frequency: single = 40):Boolean;
function WaveGlass(bmp: TBitmap;
 WaveType: TWaveType = wtVertical;
factor: single = 3;
frequency: single = 30):Boolean;
function ColorSpotLight(bmp: TBitmap; radius: integer):Boolean;
function Explosion(bmp: TBitmap; factor: integer):Boolean;

function Emboss1(var bmp: TBitmap; fGray: Boolean = true):Boolean;

function Emboss2(var bmp: TBitmap; fGray: Boolean = true):Boolean;
function Sobel(var bmp: TBitmap; fGray: Boolean = true):Boolean;
function Laplacian(var bmp: TBitmap; fGray: Boolean = true):Boolean;
function EdgeEnhance(var bmp: TBitmap; percent: integer = 50):Boolean;
function Edge(var bmp: TBitmap; fGray: Boolean = true):Boolean;
function Sharpen(var bmp: TBitmap; percent: integer = 50):Boolean;
function Median(var bmp: TBitmap; area: integer = 1):Boolean;
function Rank(bmp: TBitmap; mode: TRankMode = rkMax; zone: integer = 1):Boolean;
function Range(var bmp: TBitmap; zone: integer = 1; Gray: Boolean = true):Boolean;
function OilPaint(bmp: TBitmap; zone: integer = 2):Boolean;
function Blur(bmp: TBitmap; zone: integer = 1):Boolean;
function GaussianBlur(bmp: TBitmap; zone:integer = 2): Boolean;
function Pixellate(bmp: TBitmap; area:integer):Boolean;
function Mosaic(bmp: TBitmap; area:integer; range: TRect):Boolean;
function Vaseline(bmp: TBitmap; radius: integer):Boolean;
function FrostedGlass(bmp: TBitmap; alpha: single;
fBlur: integer; rct: TRect): Boolean;
procedure ShadowFrame(var bmp: TBitmap;
Margin: integer = 10;
ShadowWidth: integer = 7;
BackColor: TColor = clWhite);
function MakeMask1(var bmp:TBitmap; threshold: byte = 100): Boolean;
procedure MaskedOverlay(dst, src, mask: TBitmap; dstX, dstY: integer);
function SpotMask(w, h: integer; Radius: integer): TBitmap;
function SineMask(w, h: integer; mode: TSineMask): TBitmap;

function Grid(bmp: TBitmap; area:integer):Boolean;

function Soften(bmp: TBitmap; percent:integer): Boolean;
function Contour1(var bmp: TBitmap; threshold: integer): Boolean;
function Contour2(var bmp: TBitmap; Stretch: Boolean = true): Boolean;
function Parallelogram1(var bmp: TBitmap; deform: single; bkColor: TColor):
Boolean;
function Parallelogram2(var bmp: TBitmap; deform: single; bkColor: TColor):
Boolean;
function AlphaTile(var bmp:TBitmap; partition: integer = 10): Boolean;
function Divide(var bmp:TBitmap;
bkImage: TBitmap;
hdiv, vdiv: integer;
margin: integer = 20;
framewidth: integer = 5): Boolean;
function RadialBlur(bmp: TBitmap; zone: integer = 3):Boolean;
function AngleBlur(bmp: TBitmap; zone: integer = 3):Boolean;
function BrightnessModulation(var bmp, modu: TBitmap;
percent: single;
negative: boolean = false):Boolean;
function PolarShear(bmp: TBitmap;
rentropy: single = 0.5;
aentropy: single = 0.5;
bInterpolation: Boolean = true): Boolean;
function Circle1(var bmp: TBitmap; bkColor: TColor = clGray): Boolean;
function Circle2(var bmp: TBitmap; bkColor: TColor = clGray): Boolean;
function Focus(bmp: TBitmap; percent: single = 20): Boolean;
function LineInvert(bmp: TBitmap; cx, cy, angle: single
; bkColor: TColor = clGray): Boolean;
function Mirror2(var bmp: TBitmap; angle: single; bkColor: TColor): Boolean;
function Mirror3(var bmp: TBitmap; cx, cy, angle: single; bkColor: TColor):
Boolean;

implementation

//---------- TBmpData24 ----------------------

constructor TBmpData24.Create(bmp: TBitmap);

var
i: integer;
begin
SetLength(sl, bmp.Height);
for i := 0 to bmp.Height-1 do sl[i] := bmp.ScanLine[i];
FWidth := bmp.Width;
FHeight := bmp.Height;
end;

destructor TBmpData24.Destroy;
begin

inherited;
end;

function TBmpData24.GetData(x, y: integer):PRGBTriple;

begin
result := sl[y];
Inc(result, x);
end;

//---------- TBmpData8 ----------------------

constructor TBmpData8.Create(bmp: TBitmap);

var
i: integer;
begin
SetLength(sl, bmp.Height);
for i := 0 to bmp.Height-1 do sl[i] := bmp.ScanLine[i];
FWidth := bmp.Width;
FHeight := bmp.Height;
end;

destructor TBmpData8.Destroy;
begin

inherited;
end;

function TBmpData8.GetData(x, y: integer):PByte;

begin
result := sl[y];
Inc(result, x);
end;

//---------- TBmpData4 ----------------------

constructor TBmpData4.Create(bmp: TBitmap);
var
i: integer;
begin
SetLength(sl, bmp.Height);
for i := 0 to bmp.Height-1 do sl[i] := bmp.ScanLine[i];
end;

destructor TBmpData4.Destroy;
begin

inherited;
end;

function TBmpData4.GetData(x, y: integer):Byte;

var
p: PByte;
begin
p := sl[y];
Inc(p, x div 2);
result := p^;
if (x mod 2) = 0 then
result := result shr 4
else
result := result and $0F;
end;

procedure TBmpData4.SetData(x, y: integer; value: Byte);

var
p: PByte;
v: Byte;
begin
p := sl[y];
Inc(p, x div 2);
v := p^;
if (x mod 2) = 0 then
v := (v and $0F) or (value shl 4)
else
v := (v and $F0) or value;
p^ := v;
end;

function GrayScale4FloydStucci(var bmp: TBitmap; Stretch: Boolean = true):Boolean;

var
tmp8, bmp4:TBitmap;
w, h, ix, iy, x, y, i: integer;
src: TBmpData8;
dst: TBmpData4;
ct: array[0..15] of TRGBQuad;
v: Byte;
dif: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
 begin
tmp8.Free;
exit;
end;
if Stretch then
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
tmp8.Free;
exit;
end;

bmp4 := TBitmap.Create;
bmp4.PixelFormat := pf4bit;
bmp4.Width := w;
bmp4.Height := h;

for i := 0 to 15 do
begin
ct[i].rgbBlue := i shl 4;
ct[i].rgbGreen := i shl 4;
ct[i].rgbRed := i shl 4;
ct[i].rgbReserved := 0;
end;
SetDIBColorTable(bmp4.Canvas.Handle,0,15,ct);
DeleteObject(bmp4.ReleasePalette);

src := TBmpData8.Create(tmp8);
dst := TBmpData4.Create(bmp4);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
v := src[ix,iy]^ shr 4;
if (src[ix,iy]^ and $F) > 8 then Inc(v);
if v > $F then v := $F;
dst[ix, iy] := v;

dif := src[ix,iy]^ - (v shl 4);

x := ix+1; y := iy;
if (x < w) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*7/16);

x := ix-1; y := iy+1;
if (x > -1) and (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*3/16);

x := ix; y := iy+1;
if (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*5/16);

x := ix+1; y := iy+1;
if (x < w) and (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif/16);
end;

dst.Free;
src.Free;
tmp8.Free;
bmp.Free;
bmp := bmp4;
result := true;
end;

//---------- TBmpData1 ----------------------

constructor TBmpData1.Create(bmp: TBitmap);

var
i: integer;
begin
SetLength(sl, bmp.Height);
for i := 0 to bmp.Height-1 do sl[i] := bmp.ScanLine[i];
FWidth := bmp.Width;
FHeight := bmp.Height;
end;

destructor TBmpData1.Destroy;
begin

inherited;
end;

function TBmpData1.GetData(x, y: integer):Boolean;

var
p: PByte;
begin
p := sl[y];
Inc(p, x div 8);
result := (p^ shr (7-(x mod 8)) and 1) = 1;
end;

procedure TBmpData1.SetData(x, y: integer; value: Boolean);

var
p: PByte;
begin
p := sl[y];
Inc(p, x div 8);
if value then
p^ := p^ or (1 shl (7-(x mod 8)))
else
p^ := p^ and not (1 shl (7-(x mod 8)));
end;

//-------------------------------------------------------------

function LoadPng(filename: string): TBitmap;

var
png: TPngImage;
begin
result := nil;
png := TPngImage.Create;
try
png.LoadFromFile(filename);
try
result := TBitmap.Create;
result.Assign(png);

except
FreeAndNil(result);
end;
 finally
png.Free;
end;
end;

function LoadGif(filename: string): TBitmap;

var
gif: TGifImage;
begin
result := nil;
gif := TGifImage.Create;
try
gif.LoadFromFile(filename);
result := TBitmap.Create;
try
result.Assign(gif);
except
FreeAndNil(result);
end;
finally
gif.Free;
end;
end;

function LoadJpeg(filename: string): TBitmap;

var
jpg: TJpegImage;
begin
result := nil;

jpg := TJpegImage.Create;
try
jpg.LoadFromFile(filename);
result := TBitmap.Create;
try
result.Assign(jpg);
except
FreeAndNil(result)
end;
finally
jpg.Free;
end;
end;

function BmpClone(bmp: TBitmap): TBitmap;

begin
result := TBitmap.Create;
result.Assign(bmp);
end;

function AdjustByte(value: integer): Byte;

begin
if value < 0 then
result := 0
else
if value > 255 then
result := 255
else
result := value;
end;

function AdjustByte(value: extended): Byte;

begin
if value < 0 then
result := 0
else
if value > 255 then
result := 255
else
result := Round(value);
end;

function ExeDir: string;

begin
result := ExtractFilePath(ParamStr(0));
end;

function Flip(bmp: TBitmap; FlipType: TFlipType):Boolean;

var
w, h, ix, iy: integer;
tmp :TBitmap;
dst, src: TBmpData24;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

dst := TBmpData24.Create(bmp);
src := TBmpData24.Create(tmp);

if FlipType = ftUpDown then

begin
for iy := 0 to h-1 do
for ix := 0 to w-1 do
dst[ix,h-1-iy]^ := src[ix,iy]^;
end
else
begin
for iy := 0 to h-1 do
for ix := 0 to w-1 do
dst[w-1-ix,iy]^ := src[ix,iy]^;
end;

src.Free;
dst.Free;

tmp.Free;
result := true;
end;

function Rotate90(var bmp: TBitmap; plus: Boolean = true):Boolean;

var
w, h, ix, iy: integer;
tmp :TBitmap;
dst, src: TBmpData24;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);
tmp.Width := h;
tmp.Height := w;

src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

if plus then
begin
for iy := 0 to h-1 do
for ix := 0 to w-1 do
dst[h-1-iy,ix]^ := src[ix,iy]^;
end
else
begin
for iy := 0 to h-1 do
for ix := 0 to w-1 do
dst[iy,w-1-ix]^ := src[ix,iy]^;
end;

src.Free;
dst.Free;

bmp.Free;
bmp := tmp;
result := true;
end;

function Invert(bmp: TBitmap): Boolean;

var
w, h, ix, iy: integer;
tmp :TBitmap;
dst, src: TBmpData24;
pd, ps: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
pd := dst[ix,iy]; ps := src[ix,iy];
pd^.rgbtRed := 255 - ps^.rgbtRed;
pd^.rgbtGreen := 255 - ps^.rgbtGreen;
pd^.rgbtBlue := 255 - ps^.rgbtBlue;
end;
 src.Free;
dst.Free;

tmp.Free;
result := true;
end;

function PaletteEntryBmp(bmp8: TBitmap): TBitmap;

var
num, i, x, y: integer;
pe: array[0..255] of TPaletteEntry;
begin
result := nil;
if bmp8.PixelFormat <> pf8bit then exit;
try
num := GetPaletteEntries(bmp8.Palette,0,256,pe);
except
exit;
end;
result := TBitmap.Create;
result.PixelFormat := pf24bit;
result.Width := 225;
result.Height := 225;

with result.Canvas do
begin
Pen.Color := clGray;
for i := 0 to num-1 do
begin
Brush.Color := RGB(pe[i].peRed, pe[i].peGreen, pe[i].peBlue);
x := 14*(i mod 16)+1; y := 14*(i div 16)+1;
Rectangle(x-1, y-1, x+14, y+14);
end;
end;
end;

procedure GrayScale8(bmp8: TBitmap);

var
num,i:integer;
pe: array[0..255] of TPaletteEntry;
ct: array[0..255] of TRGBQuad;
c:word;
begin
num := GetPaletteEntries(bmp8.Palette,0,256,pe);

for i := 0 to num-1 do
begin
c := trunc(pe[i].peRed*0.299+pe[i].peGreen*0.587+pe[i].peBlue*0.114);
ct[i].rgbBlue := c;
ct[i].rgbGreen := c;
ct[i].rgbRed := c;
ct[i].rgbReserved := 0;
end;

SetDIBColorTable(bmp8.Canvas.Handle,0,num,ct);
DeleteObject(bmp8.ReleasePalette);
end;
function GrayScale4(var bmp: TBitmap):Boolean;
var
tmp8, bmp4:TBitmap;
w, h, ix, iy, i: integer;
src: TBmpData8;
dst: TBmpData4;
ct: array[0..15] of TRGBQuad;
v: Byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
begin
tmp8.Free;
exit;
end;
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
tmp8.Free;
exit;
end;

bmp4 := TBitmap.Create;
bmp4.PixelFormat := pf4bit;
bmp4.Width := w;
bmp4.Height := h;

for i := 0 to 15 do
begin
ct[i].rgbBlue := i shl 4;
ct[i].rgbGreen := i shl 4;
ct[i].rgbRed := i shl 4;
ct[i].rgbReserved := 0;
end;
SetDIBColorTable(bmp4.Canvas.Handle,0,15,ct);
DeleteObject(bmp4.ReleasePalette);

src := TBmpData8.Create(tmp8);
dst := TBmpData4.Create(bmp4);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
v := src[ix,iy]^ shr 4;
if (src[ix,iy]^ and $F) > 8 then Inc(v);
if v > $F then v := $F;
dst[ix, iy] := v;
end;

dst.Free;
src.Free;
tmp8.Free;
bmp.Free;
bmp := bmp4;
 result := true;
end;

function BrightnessHistogram(bmp: TBitmap): TBitmap;

var
w, h, ix, iy, i, max: integer;
src: TBmpData24;
d: TRGBTriple;
Hist: array[0..255] of integer;
begin
for i := 0 to 255 do Hist[i] := 0;

w := bmp.Width;
h := bmp.Height;

src := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy]^;
inc(Hist[Trunc(0.299*d.rgbtRed + 0.587*d.rgbtGreen + 0.114*d.rgbtBlue)]);
end;

src.Free;

max := -1;
for i := 0 to 255 do if Hist[i] > max then max := Hist[i];

for i := 0 to 255 do Hist[i] := Round(Hist[i]*140/max);

result := TBitmap.Create;
result.PixelFormat := pf8bit;
result.Width := 275;
result.Height := 160;

with result.Canvas do
begin
Pen.Color := clGray;
for i := 0 to 255 do
begin
MoveTo(10+i,150);
LineTo(10+i,150-Hist[i]);
end;
Pen.Color := clBlack;
MoveTo(10, 150); LineTo(10, 10);
for i := 0 to 20 do
begin
MoveTo(10, 150-7*i);
if Odd(i) then LineTo(8, 150-7*i) else LineTo(6, 150-7*i);
end;
MoveTo(10, 150); LineTo(10+255, 150);
for i := 0 to 51 do
begin
MoveTo(10+5*i, 150);
if Odd(i) then LineTo(10+5*i, 152) else LineTo(10+5*i, 154);
end;
end;
end;
function RGBHistogram(bmp: TBitmap): TBitmap;
var
w, h, ix, iy, i, max: integer;
src: TBmpData24;
d: TRGBTriple;
L, R, G, B: array[0..255] of integer;
pt: array[0..255] of TPoint;
begin
for i := 0 to 255 do
begin
L[i] := 0; R[i] := 0; G[i] := 0; B[i] := 0;
end;

w := bmp.Width;
h := bmp.Height;

src := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy]^;
inc(R[d.rgbtRed]);
inc(G[d.rgbtGreen]);
inc(B[d.rgbtBlue]);
inc(L[Trunc(0.299*d.rgbtRed + 0.587*d.rgbtGreen + 0.114*d.rgbtBlue)]);
end;

src.Free;

max := -1;
for i := 0 to 255 do
begin
if R[i] > max then max := R[i];
if G[i] > max then max := G[i];
if B[i] > max then max := B[i];
if L[i] > max then max := L[i];
end;

result := TBitmap.Create;
result.PixelFormat := pf8bit;
result.Width := 275;
result.Height := 160;

with result.Canvas do
begin
Brush.Color := clSilver;
FillRect(Rect(0, 0, 275, 160));

Pen.Width := 2;

for i := 0 to 255 do pt[i] := Point(10+i,150-Round(R[i]*140/max));

Pen.Color := clRed;
PolyLine(pt);

for i := 0 to 255 do pt[i] := Point(10+i,150-Round(G[i]*140/max));

Pen.Color := RGB(0,$bb,0);
PolyLine(pt);
 for i := 0 to 255 do pt[i] := Point(10+i,150-Round(B[i]*140/max));
Pen.Color := clBlue;
PolyLine(pt);

for i := 0 to 255 do pt[i] := Point(10+i,150-Round(L[i]*140/max));

Pen.Color := clBlack;
PolyLine(pt);

Pen.Width := 1;

Pen.Color := clBlack;
MoveTo(10, 150); LineTo(10, 10);
for i := 0 to 20 do
begin
MoveTo(10, 150-7*i);
if Odd(i) then LineTo(8, 150-7*i) else LineTo(6, 150-7*i);
end;
MoveTo(10, 150); LineTo(10+255, 150);
for i := 0 to 51 do
begin
MoveTo(10+5*i, 150);
if Odd(i) then LineTo(10+5*i, 152) else LineTo(10+5*i, 154);
end;
end;
end;

procedure SetGrayPalette(bmp8: TBitmap);

var
i: integer;
ct: array[0..255] of TRGBQuad;
begin
for i := 0 to 255 do
begin
ct[i].rgbBlue := i;
ct[i].rgbGreen := i;
ct[i].rgbRed := i;
ct[i].rgbReserved := 0;
end;
SetDIBColorTable(bmp8.Canvas.Handle,0,255,ct);
DeleteObject(bmp8.ReleasePalette);
end;

function GrayScale(var bmp: TBitmap):Boolean;

var
bmp8:TBitmap;
w, h, ix, iy: integer;
d: PRGBTriple;
src: TBmpData24;
dst: TBmpData8;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

bmp8 := TBitmap.Create;
bmp8.PixelFormat := pf8bit;
bmp8.Width := w;
 bmp8.Height := h;

SetGrayPalette(bmp8);

src := TBmpData24.Create(bmp);
dst := TBmpData8.Create(bmp8);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
dst[ix, iy]^ := Trunc(0.299*d^.rgbtRed + 0.587*d^.rgbtGreen +
0.114*d^.rgbtBlue);
end;

dst.Free;
src.Free;

bmp.Free;
bmp := bmp8;
result := true;
end;

function BlackWhiteFloydStucci2(var bmp: TBitmap; threshold: byte = 127;

Stretch: Boolean = true;
Dark: TColor = clBlack;
Bright: TColor = clWhite):Boolean;
var
tmp8, bmp1:TBitmap;
w, h, ix, iy, x, y: integer;
src: TBmpData8;
dst: TBmpData1;
dif: integer;
ct: array[0..1] of TRGBQuad;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
begin
tmp8.Free;
exit;
end;
if stretch then
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
tmp8.Free;
exit;
end;

bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf1bit;
bmp1.Width := w;
bmp1.Height := h;
 Dark := ColorToRGB(Dark);
ct[0].rgbBlue := GetBValue(Dark);
ct[0].rgbGreen := GetGValue(Dark);
ct[0].rgbRed := GetRValue(Dark);
ct[0].rgbReserved := 0;

Bright := ColorToRGB(Bright);
ct[1].rgbBlue := GetBValue(Bright);
ct[1].rgbGreen :=GetGValue(Bright);
ct[1].rgbRed := GetRValue(Bright);
ct[1].rgbReserved := 0;

SetDIBColorTable(bmp1.Canvas.Handle,0,2,ct);
DeleteObject(bmp1.ReleasePalette);

src := TBmpData8.Create(tmp8);
dst := TBmpData1.Create(bmp1);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
dst[ix, iy] := src[ix,iy]^ > threshold;

if dst[ix, iy] then

dif := src[ix,iy]^ - 255
else
dif := src[ix,iy]^;

x := ix+1; y := iy;
if (x < w) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*7/16);

x := ix-1; y := iy+1;
if (x > -1) and (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*3/16);

x := ix; y := iy+1;
if (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif*5/16);

x := ix+1; y := iy+1;
if (x < w) and (y < h) then src[x,y]^ := AdjustByte(src[x,y]^+ dif/16);
end;

dst.Free;
src.Free;
tmp8.Free;
bmp.Free;
bmp := bmp1;
result := true;
end;

function Brightness(bmp: TBitmap; percent: integer = 10):Boolean;

var
w, h, ix, iy, rr: integer;
bd: TBmpData24;
d: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
 h := bmp.Height;

rr := 255*percent div 100;

bd := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := bd[ix,iy];
d^.rgbtRed := AdjustByte(d^.rgbtRed + rr);
d^.rgbtGreen := AdjustByte(d^.rgbtGreen + rr);
d^.rgbtBlue := AdjustByte(d^.rgbtBlue + rr);
end;

bd.Free;

result := true;
end;

function Contrast(bmp: TBitmap; nContrast: integer):Boolean;

var
w, h, ix, iy: integer;
bd: TBmpData24;
d: PRGBTriple;
value: Single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

if (nContrast>100) or (nContrast<-100) then exit;

value := (100.0+nContrast)/100.0;
value := value*value;

w := bmp.Width;
h := bmp.Height;

bd := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := bd[ix,iy];
d^.rgbtRed := AdjustByte(((d^.rgbtRed/255.0 - 0.5)*value + 0.5)*255.0);
d^.rgbtGreen := AdjustByte(((d^.rgbtGreen/255.0 - 0.5)*value + 0.5)*255.0);
d^.rgbtBlue := AdjustByte(((d^.rgbtBlue/255.0 - 0.5)*value + 0.5)*255.0);
end;

bd.Free;
result := true;
end;

function Emboss1(var bmp: TBitmap; fGray: Boolean = true):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y: integer;
src, dst: TBmpData24;
d: PRGBTriple;
 r, g, b: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
r := -d^.rgbtRed;
g := -d^.rgbtGreen;
b := -d^.rgbtBlue;

x := ix+1; y := iy+1;
if (x > w-1) then x := ix;
if (y > h-1) then y := iy;
d := src[x,y];
r := r - d^.rgbtRed;
g := g - d^.rgbtGreen;
b := b - d^.rgbtBlue;

x := ix-1; y := iy-1;
if (x < 0) then x := ix;
if (y < 0) then y := iy;
d := src[x,y];
r := r + 2*d^.rgbtRed;
g := g + 2*d^.rgbtGreen;
b := b + 2*d^.rgbtBlue;

d := dst[ix,iy];
d^.rgbtRed := AdjustByte(r+127);
d^.rgbtGreen := AdjustByte(g+127);
d^.rgbtBlue := AdjustByte(b+127);
end;

dst.Free;
src.Free;

tmp.Free;

if fGray then GrayScale(bmp);

result := true;
end;

function Emboss2(var bmp: TBitmap; fGray: Boolean = true):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
r := d^.rgbtRed;
g := d^.rgbtGreen;
b := d^.rgbtBlue;

x := ix+1; y := iy+1;
if (x > w-1) then x := ix;
if (y > h-1) then y := iy;
d := src[x,y];
r := r - d^.rgbtRed;
g := g - d^.rgbtGreen;
b := b - d^.rgbtBlue;

d := dst[ix,iy];
d^.rgbtRed := AdjustByte(r+127);
d^.rgbtGreen := AdjustByte(g+127);
d^.rgbtBlue := AdjustByte(b+127);
end;

dst.Free;
src.Free;

tmp.Free;

if fGray then GrayScale(bmp);

result := true;
end;

function CompInt(Item1, Item2: pointer):integer;

begin
result := integer(Item1) - integer(Item2);
end;

function CountColors(bmp24: TBitmap):integer;

var
i, x, y, w, h: integer;
tl: TList;
src: TBmpData24;
pData: PRGBTriple;
c: COLORREF;
begin
w := bmp24.Width;
h := bmp24.Height;
 src := TBmpData24.Create(bmp24);

tl := TList.Create;
try
tl.Capacity := w * h;
for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
pData := src[x, y];
c := RGB(pData^.rgbtRed, pData^.rgbtGreen, pData^.rgbtBlue);
tl.Add(pointer(c));
end;
end;
tl.Sort(CompInt);
result := 1;
for i := 1 to tl.Count-1 do
if integer(tl[i-1]) <> integer(tl[i]) then inc(result);
finally
tl.Free;
end;

src.Free;
end;

function TwoColorGrayScale(var bmp: TBitmap; Dark, Bright: TColor):Boolean;

var
bmp8: TBitmap;
w, h, ix, iy, i: integer;
d: PRGBTriple;
src: TBmpData24;
dst: TBmpData8;
ct: array[0..255] of TRGBQuad;
dr, dg, db, br, bg, bb: Byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

bmp8 := TBitmap.Create;
bmp8.PixelFormat := pf8bit;
bmp8.Width := w;
bmp8.Height := h;

Dark := ColorToRGB(Dark);
Bright := ColorToRGB(Bright);
dr := GetRValue(Dark); dg := GetGValue(Dark); db := GetBValue(Dark);
br := GetRValue(Bright); bg := GetGValue(Bright); bb := GetBValue(Bright);
for i := 0 to 255 do
begin
ct[i].rgbRed := Round(dr+(br-dr)*i/255);
ct[i].rgbGreen := Round(dg+(bg-dg)*i/255);
ct[i].rgbBlue := Round(db+(bb-db)*i/255);
ct[i].rgbReserved := 0;
end;
SetDIBColorTable(bmp8.Canvas.Handle,0,256,ct);
DeleteObject(bmp8.ReleasePalette);
 src := TBmpData24.Create(bmp);
dst := TBmpData8.Create(bmp8);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
dst[ix, iy]^ := Trunc(0.299*d^.rgbtRed + 0.587*d^.rgbtGreen +
0.114*d^.rgbtBlue);
end;

dst.Free;
src.Free;

bmp.Free;
bmp := bmp8;
result := true;
end;

function Gamma(bmp: TBitmap; dGamma: single):Boolean;

var
ga: array[0..255] of byte;
bd: TBmpData24;
d: PRGBTriple;
w, h, ix, iy, i: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (dGamma < 0.2) or (dGamma > 5.0) then exit;
w := bmp.Width;
h := bmp.Height;

for i := 0 to 255 do
ga[i] := Trunc(Min(255.0, ( 255.0 * Power(i/255.0, 1.0/dGamma)) + 0.5));

bd := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := bd[ix, iy];
d^.rgbtRed := ga[d^.rgbtRed];
d^.rgbtGreen := ga[d^.rgbtGreen];
d^.rgbtBlue := ga[d^.rgbtBlue];
end;

bd.Free;

result := true;
end;

function ColorFilter(bmp: TBitmap; fRed, fGreen, fBlue: single):Boolean;

var
bd: TBmpData24;
w, h, ix, iy: integer;
d: TRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
 w := bmp.Width;
h := bmp.Height;

bd := TBmpData24.Create(bmp);

fRed := 1.0+fRed/100;
fGreen := 1.0+fGreen/100;
fBlue := 1.0+fBlue/100;

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := bd[ix,iy]^;
bd[ix,iy]^.rgbtRed := AdjustByte(d.rgbtRed*fRed);
bd[ix,iy]^.rgbtGreen := AdjustByte(d.rgbtGreen*fGreen);
bd[ix,iy]^.rgbtBlue := AdjustByte(d.rgbtBlue*fBlue);
end;

bd.Free;

result := true;
end;

function Saturation(bmp: TBitmap; percent: extended):Boolean;

var
bd: TBmpData24;
w, h, ix, iy: integer;
d: TRGBTriple;
SatComp, SatCompR, SatCompG, SatCompB, level: extended;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

level := 1+percent/100;
SatComp := 1.0 - level;
SatCompR := 0.3086 * SatComp;
SatCompG := 0.6094 * SatComp;
SatCompB := 0.0820 * SatComp;

bd := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := bd[ix,iy]^;
bd[ix,iy]^.rgbtRed := AdjustByte(d.rgbtRed*(SatCompR+level)+
d.rgbtGreen*SatCompG+
d.rgbtBlue*SatCompB);

bd[ix,iy]^.rgbtGreen := AdjustByte(d.rgbtRed*SatCompR+
d.rgbtGreen*(SatCompG+level)+
d.rgbtBlue*SatCompB);

bd[ix,iy]^.rgbtBlue := AdjustByte(d.rgbtRed*SatCompR+
d.rgbtGreen*SatCompG+
d.rgbtBlue*(SatCompB+level));
end;
 bd.Free;

result := true;
end;

function Sobel(var bmp: TBitmap; fGray: Boolean = true):Boolean;

const
hmask: array[-1..1] of array[-1..1] of integer = ((-1,-2,-1),
( 0, 0, 0),
( 1, 2, 1));
vmask: array[-1..1] of array[-1..1] of integer = ((-1, 0, 1),
(-2, 0, 2),
(-1, 0, 1));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
rv, gv, bv, rh, gh, bh: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
rv := 0; gv := 0; bv := 0; rh := 0; gh := 0; bh := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

rv := rv + vmask[x-ix,y-iy]*d^.rgbtRed;
gv := gv + vmask[x-ix,y-iy]*d^.rgbtGreen;
bv := bv + vmask[x-ix,y-iy]*d^.rgbtBlue;

rh := rh + hmask[x-ix,y-iy]*d^.rgbtRed;
gh := gh + hmask[x-ix,y-iy]*d^.rgbtGreen;
bh := bh + hmask[x-ix,y-iy]*d^.rgbtBlue;
end;
d := dst[ix,iy];

d^.rgbtRed := AdjustByte(sqrt(rv*rv+rh*rh));
d^.rgbtGreen := AdjustByte(sqrt(gv*gv+gh*gh));
d^.rgbtBlue := AdjustByte(sqrt(bv*bv+bh*bh));

end;

dst.Free;
 src.Free;

tmp.Free;

if fGray then GrayScale(bmp);

result := true;
end;

function Laplacian(var bmp: TBitmap; fGray: Boolean = true):Boolean;

const
mask: array[-1..1] of array[-1..1] of integer = (( 0,-1, 0),
(-1, 4,-1),
( 0,-1, 0));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

r := r + mask[x-ix,y-iy]*d^.rgbtRed;
g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

end;
d := dst[ix,iy];

d^.rgbtRed := AdjustByte(r+127);
d^.rgbtGreen := AdjustByte(g+127);
d^.rgbtBlue := AdjustByte(b+127)
end;

dst.Free;
src.Free;

tmp.Free;
 if fGray then GrayScale(bmp);

result := true;
end;

function EdgeEnhance(var bmp: TBitmap; percent: integer = 50):Boolean;

const
mask: array[-1..1] of array[-1..1] of integer = (( 0,-1, 0),
(-1, 4,-1),
( 0,-1, 0));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
rate : Extended;
begin
result := false;
if (percent<0) or (percent>100) then exit;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

rate := percent/100;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

r := r + mask[x-ix,y-iy]*d^.rgbtRed;
g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

end;
d := dst[ix,iy];

d^.rgbtRed := AdjustByte(d^.rgbtRed + rate*r);

d^.rgbtGreen := AdjustByte(d^.rgbtGreen + rate*g);
d^.rgbtBlue := AdjustByte(d^.rgbtBlue + rate*b)
end;

dst.Free;
src.Free;

tmp.Free;
 result := true;
end;

function Edge(var bmp: TBitmap; fGray: Boolean = true):Boolean;

const
mask: array[-1..1] of array[-1..1] of integer = ((-1,-1,-1),
(-1, 8,-1),
(-1,-1,-1));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

r := r + mask[x-ix,y-iy]*d^.rgbtRed;
g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

end;
d := dst[ix,iy];

d^.rgbtRed := AdjustByte(r+127);
d^.rgbtGreen := AdjustByte(g+127);
d^.rgbtBlue := AdjustByte(b+127)
end;

dst.Free;
src.Free;

tmp.Free;

if fGray then GrayScale(bmp);

result := true;
end;

function Sharpen(var bmp: TBitmap; percent: integer = 50):Boolean;

const
mask: array[-1..1] of array[-1..1] of integer = ((-1,-1,-1),
(-1, 8,-1),
(-1,-1,-1));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
rate: extended;
begin
result := false;
if (percent<0) or (percent>100) then exit;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

rate := percent/100;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

r := r + mask[x-ix,y-iy]*d^.rgbtRed;
g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
b := b + mask[x-ix,y-iy]*d^.rgbtBlue;

end;
d := dst[ix,iy];

d^.rgbtRed := AdjustByte(d^.rgbtRed + rate*r);

d^.rgbtGreen := AdjustByte(d^.rgbtGreen + rate*g);
d^.rgbtBlue := AdjustByte(d^.rgbtBlue + rate*b)
end;

dst.Free;
src.Free;

tmp.Free;

result := true;
end;

function ColorSort(Item1, Item2: Pointer): Integer;

begin
result := byte(Item1)-byte(Item2);
end;

function Median(var bmp: TBitmap; area: integer = 1):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
rl, gl, bl: TList;
md, num, indx: integer;
begin
result := false;
if (area<1) or (area>4) then exit;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

num := (2*area+1)*(2*area+1);
md := Round(num/2);

rl := TList.Create; rl.Capacity := num; rl.Count := num;

gl := Tlist.Create; gl.Capacity := num; gl.Count := num;
bl := TList.Create; bl.Capacity := num; bl.Count := num;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
indx := 0;
for y := iy-area to iy+area do
for x := ix-area to ix+area do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

rl[indx] := pointer(d^.rgbtRed);
gl[indx] := pointer(d^.rgbtGreen);
bl[indx] := pointer(d^.rgbtBlue);
inc(indx);
end;

rl.Sort(ColorSort);
gl.Sort(ColorSort);
bl.Sort(ColorSort);

d := dst[ix,iy];

d^.rgbtRed := byte(rl[md]);
d^.rgbtGreen := byte(gl[md]);
d^.rgbtBlue := byte(bl[md]);
end;

dst.Free;
src.Free;
 rl.Free;
gl.Free;
bl.Free;

tmp.Free;

result := true;
end;

procedure RGBToHSL(rgb: TRGBTriple; var h, s, l :integer);

var
r, g, b, hh, ss, ll, maxc, minc, cr, cg, cb:extended;
begin
r := rgb.rgbtRed/255;
g := rgb.rgbtGreen/255;
b := rgb.rgbtBlue/255;

maxc := Max(Max(r,g),b);
minc := Min(Min(r,g),b);

ll := (maxc+minc)/2;

if (maxc - minc) < 0.000001 then

begin
ss := 0;
hh := 0;
end
else
begin
if ll<=0.5 then
ss := (maxc-minc)/(maxc+minc)
else
ss := (maxc-minc)/(2-maxc-minc);

cr := (maxc-r)/(maxc-minc);
cg := (maxc-g)/(maxc-minc);
cb := (maxc-b)/(maxc-minc);
if maxc=r then
hh := cb-cg
else
if maxc=g then
hh := 2+cr-cb
else
hh := 4+cg-cr;

hh := 60*hh;
if hh<0 then hh := hh+360;
end;

h := trunc(hh);
s := trunc(ss*100);
l := trunc(ll*100);

end;

procedure HSLToRGB(rgb: PRGBTriple; h, s, l :integer);

var
ss, ll, r, g, b, maxc, minc: extended;
 hh, hhh: integer;
begin
hh := h;
ss := s/100;
ll := l/100;

r := 0; g := 0; b := 0;

if s = 0 then
begin
r := ll;
g := ll;
b := ll;
end
else
begin
if ll<=0.5 then
maxc := ll*(1+ss)
else
maxc := ll*(1-ss)+ss;

minc := 2*ll-maxc;

hhh := hh+120;
if hhh>=360 then hhh := hhh-360;
case hhh of
0..59 : r := minc+(maxc-minc)*hhh/60;
60..179 : r := maxc;
180..239: r := minc+(maxc-minc)*(240-hhh)/60;
240..359: r := minc;
end;

hhh := hh;
case hhh of
0..59 : g := minc+(maxc-minc)*hhh/60;
60..179 : g := maxc;
180..239: g := minc+(maxc-minc)*(240-hhh)/60;
240..359: g := minc;
end;

hhh := hh-120;
if hhh<0 then hhh := hhh+360;
case hhh of
0..59 : b := minc+(maxc-minc)*hhh/60;
60..179 : b := maxc;
180..239: b := minc+(maxc-minc)*(240-hhh)/60;
240..359: b := minc;
end;
end;

rgb^.rgbtRed := trunc(r*255);
rgb^.rgbtGreen := trunc(g*255);
rgb^.rgbtBlue := trunc(b*255);
end;

function Hue(bmp: TBitmap; angle: integer = 20):Boolean;

var
tmp:TBitmap;
w, h, ix, iy: integer;
 src, dst: TBmpData24;
d: PRGBTriple;
hh, ss, ll :integer;
begin
result := false;

if (angle<0) or (angle>360) then exit;

if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
RGBToHSL(d^, hh, ss, ll);
hh := (hh+angle) mod 360;
HSLToRGB(dst[ix,iy],hh,ss,ll);
end;

dst.Free;
src.Free;

tmp.Free;

result := true;
end;

function Luminance(bmp: TBitmap; percent: integer = 20):Boolean;

var
tmp:TBitmap;
w, h, ix, iy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
hh, ss, ll :integer;
begin
result := false;

if (percent<-100) or (percent>100) then exit;

if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
d := src[ix,iy];
 RGBToHSL(d^, hh, ss, ll);
ll := trunc(ll*(1+percent/100));
if ll>100 then ll := 100;
HSLToRGB(dst[ix,iy],hh,ss,ll);
end;

dst.Free;
src.Free;
tmp.Free;

result := true;
end;

function HistoStretch(grayBMP: TBitmap):Boolean;

var
bd: TBmpData8;
i, w, h, x, y: integer;
hist: array[0..255] of integer;
threshold, lt, ht, originalrange, stretchedrange: integer;
stretchfactor, scalefactor: single;
begin
result := false;
if grayBMP.PixelFormat <> pf8bit then exit;
w := grayBMP.Width;
h := grayBMP.Height;

for i := 0 to 255 do hist[i] := 0;

stretchfactor := 1.00;
threshold := Round(w*h*0.015);

bd := TBmpData8.Create(grayBMP);

for y := 0 to h-1 do
for x := 0 to w-1 do
inc(hist[bd[x,y]^]);

lt := 0;
for i := 0 to 255 do
begin
lt := lt + hist[i];
if lt > threshold then
begin
lt := i;
break;
end;
end;

ht := 0;
for i := 255 downto 0 do
begin
ht := ht + hist[i];
if ht > threshold then
begin
ht := i;
break;
end;
end;
 originalrange := ht - lt + 1;
stretchedrange := originalrange + Round(stretchfactor * (255 - originalrange));
scaleFactor := stretchedrange / originalrange;

for y := 0 to h-1 do
for x := 0 to w-1 do
bd[x,y]^ := AdjustByte(scalefactor * (bd[x,y]^ - lt));

bd.Free;

result := true;
end;

function BlackWhite(var bmp24: TBitmap; threshold: byte = 127): Boolean;

var
bmp1: TBitmap;
src: TBmpData8;
dst: TBmpData1;
ix, iy, w, h: integer;
begin
result := false;
if bmp24.PixelFormat <> pf24bit then exit;
w := bmp24.Width;
h := bmp24.Height;

bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf1bit;
bmp1.Width := w;
bmp1.Height := h;

GrayScale(bmp24);

src := TBmpData8.Create(bmp24);
dst := TBmpData1.Create(bmp1);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
dst[ix,iy] := src[ix,iy]^ > threshold;

dst.Free;
src.Free;

bmp24.Free;

bmp24 := bmp1;

result := true;
end;

function RandomDither(var bmp24: TBitmap;

ErrorDiffusion: TErrorDiffusion = edStucki;
Dark: TColor = clBlack;
Bright: TColor = clWhite;
randomness: integer = 30;
Stretch: Boolean = true): Boolean;
const
FSmask: array[-1..1,0..1] of single = ((0,3/16), (0,5/16), (7/16, 1/16));
STmask: array[-2..2,0..2] of single
= ((0, 2/42, 1/42), (0, 4/42, 2/42), (0, 8/42, 4/42),
 (8/42, 4/42, 2/42), (4/42, 2/42, 1/42));
SRmask: array[-2..2,0..2] of single
= ((0, 2/32, 0), (0, 4/32, 2/32), (0, 5/32, 3/32),
(5/32, 4/32, 2/32), (3/32, 2/32, 0));
JJmask: array[-2..2,0..2] of single
= ((0, 3/48, 1/48), (0, 5/48, 3/48), (0, 7/48, 5/48),
(7/48, 5/48, 3/48), (5/48, 3/48, 1/48));
var
bmp1: TBitmap;
src: TBmpData8;
dst: TBmpData1;
ix, iy, xx, yy, w, h: integer;
p8 : PByte;
d: Boolean;
err: integer;
ct: array[0..1] of TRGBQuad;
mfactor: integer;
begin
result := false;
if bmp24.PixelFormat <> pf24bit then exit;
w := bmp24.Width;
h := bmp24.Height;

bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf1bit;
bmp1.Width := w;
bmp1.Height := h;

Dark := ColorToRGB(Dark);
ct[0].rgbBlue := GetBValue(Dark);
ct[0].rgbGreen := GetGValue(Dark);
ct[0].rgbRed := GetRValue(Dark);
ct[0].rgbReserved := 0;

Bright := ColorToRGB(Bright);
ct[1].rgbBlue := GetBValue(Bright);
ct[1].rgbGreen :=GetGValue(Bright);
ct[1].rgbRed := GetRValue(Bright);
ct[1].rgbReserved := 0;

SetDIBColorTable(bmp1.Canvas.Handle,0,2,ct);
DeleteObject(bmp1.ReleasePalette);

GrayScale(bmp24);

if Stretch then HistoStretch(bmp24);

Randomize;
mfactor := (256-randomness) div 2;

src := TBmpData8.Create(bmp24);
dst := TBmpData1.Create(bmp1);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
p8 := src[ix,iy];
d := p8^ > (Random(randomness)+mfactor);
dst[ix,iy] := d;
 if ErrorDiffusion = edNone then continue;

if d then err := p8^-255 else err := p8^;

case ErrorDiffusion of
edFloydSteinberg: begin
for yy := iy to iy+1 do
for xx := ix-1 to ix+1 do
begin
if FSmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*FSmask[xx-ix,yy-iy]);
end;
end;
edStucki: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
if STmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*STmask[xx-ix,yy-iy]);
end;
end;
edSierra: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
if SRmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*SRmask[xx-ix,yy-iy]);
end;
end;
edJaJuNi: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
if JJmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*JJmask[xx-ix,yy-iy]);
end;
end;
end;
end;

dst.Free;
src.Free;
 bmp24.Free;

bmp24 := bmp1;

result := true;
end;

function OrderedDither(var bmp24: TBitmap;

ErrorDiffusion: TErrorDiffusion = edStucki;
Dark: TColor = clBlack;
Bright: TColor = clWhite;
Stretch: Boolean = true):Boolean;
const
//ptn: array[0..2] of array[0..2] of byte = ((64, 128, 64),(128, 196, 128),
// (64, 128, 64));
//ptn: array[0..1] of array[0..1] of byte = ((51, 153),(204, 102));
ptn: array[0..3] of array[0..3] of byte = (( 51, 204, 153, 102),
( 102, 153, 204, 51),
( 204, 51, 102, 153),
( 153, 102, 51, 204));

FSmask: array[-1..1,0..1] of single = ((0,3/16), (0,5/16), (7/16, 1/16));

STmask: array[-2..2,0..2] of single
= ((0, 2/42, 1/42), (0, 4/42, 2/42), (0, 8/42, 4/42),
(8/42, 4/42, 2/42), (4/42, 2/42, 1/42));
SRmask: array[-2..2,0..2] of single
= ((0, 2/32, 0), (0, 4/32, 2/32), (0, 5/32, 3/32),
(5/32, 4/32, 2/32), (3/32, 2/32, 0));
JJmask: array[-2..2,0..2] of single
= ((0, 3/48, 1/48), (0, 5/48, 3/48), (0, 7/48, 5/48),
(7/48, 5/48, 3/48), (5/48, 3/48, 1/48));
var
bmp1:TBitmap;
w, h, ix, iy, xx, yy, area: integer;
src: TBmpData8;
dst: TBmpData1;
ct: array[0..1] of TRGBQuad;
p8: PByte;
d: Boolean;
err: integer;
begin
result := false;
if bmp24.PixelFormat <> pf24bit then exit;
w := bmp24.Width;
h := bmp24.Height;

GrayScale(bmp24);

if stretch then HistoStretch(bmp24);

bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf1bit;
bmp1.Width := w;
bmp1.Height := h;

Dark := ColorToRGB(Dark);
ct[0].rgbBlue := GetBValue(Dark);
ct[0].rgbGreen := GetGValue(Dark);
ct[0].rgbRed := GetRValue(Dark);
ct[0].rgbReserved := 0;

Bright := ColorToRGB(Bright);
ct[1].rgbBlue := GetBValue(Bright);
ct[1].rgbGreen :=GetGValue(Bright);
ct[1].rgbRed := GetRValue(Bright);
ct[1].rgbReserved := 0;

SetDIBColorTable(bmp1.Canvas.Handle,0,2,ct);
DeleteObject(bmp1.ReleasePalette);

//area := 2;
//area := 3;
area := 4;

src := TBmpData8.Create(bmp24);
dst := TBmpData1.Create(bmp1);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
p8 := src[ix, iy];
d := p8^ > ptn[ix mod area, iy mod area];
dst[ix,iy] := d;

if ErrorDiffusion = edNone then continue;

if d then err := p8^-255 else err := p8^;

case ErrorDiffusion of
edFloydSteinberg: begin
for yy := iy to iy+1 do
for xx := ix-1 to ix+1 do
begin
if FSmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*FSmask[xx-ix,yy-iy]);
end;
end;
edStucki: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
if STmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*STmask[xx-ix,yy-iy]);
end;
end;
edSierra: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
 if SRmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*SRmask[xx-ix,yy-iy]);
end;
end;
edJaJuNi: begin
for yy := iy to iy+2 do
for xx := ix-2 to ix+2 do
begin
if JJmask[xx-ix,yy-iy] = 0 then continue;
if (xx<0) or (xx>w-1) then continue;
if yy>h-1 then continue;

p8 := src[xx,yy];
p8^ := AdjustByte(p8^ + err*JJmask[xx-ix,yy-iy]);
end;
end;
end;
end;

dst.Free;
src.Free;

bmp24.Free;
bmp24 := bmp1;

result := true;
end;

function BmpResize(var bmp: TBitmap;

rwidth, rheight: integer;
mode: TResizeMode = rmBilinear):Boolean;
var
tmp: TBitmap;
src, dst: TBmpData24;
wfactor, hfactor, coefx00, coefx01, coefy00, coefy01: extended;
ix, iy, fx, fy, x, y, w, h, x0, x1, y0, y1: integer;
xx, yy, r1, r2, g1, g2, b1, b2, r, g, b: extended;
dxx, dyy, dx, dy, wx, wy: extended;
d, d00, d10, d01, d11: PRGBTriple;

dxn: array[1..4] of extended;

dyn: array[0..3] of extended;
RX, RY: array[-1..2] of extended;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

wfactor := w/rwidth;
hfactor := h/rheight;

tmp := BmpClone(bmp);
tmp.Width := rwidth;
tmp.Height := rheight;
src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

for iy := 0 to rheight-1 do
for ix := 0 to rwidth-1 do
case mode of
rmNearest:
begin
x0 := Round(wfactor*ix); if x0>w-1 then x0 := w-1;
y0 := Round(hfactor*iy); if y0>h-1 then y0 := h-1;
dst[ix,iy]^ := src[x0,y0]^;
end;
rmBilinear:
begin
xx := wfactor*ix;
yy := hfactor*iy;

x0 := trunc(xx); if x0<0 then x0 := 0;

x1 := x0+1; if x1>w-1 then x1 := x0;
y0 := trunc(yy); if y0<0 then y0 := 0;
y1 := y0+1; if y1>h-1 then y1 := y0;

coefx01 := xx-x0; coefx00 := 1-coefx01;

coefy01 := yy-y0; coefy00 := 1-coefy01;

d := dst[ix,iy];
d00 := src[x0, y0]; d10 := src[x1,y0];
d01 := src[x0, y1]; d11 := src[x1,y1];

r1 := d00^.rgbtRed*coefx00 + d10^.rgbtRed*coefx01;
r2 := d01^.rgbtRed*coefx00 + d11^.rgbtRed*coefx01;
d^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := d00^.rgbtGreen*coefx00 + d10^.rgbtGreen*coefx01;
g2 := d01^.rgbtGreen*coefx00 + d11^.rgbtGreen*coefx01;
d^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := d00^.rgbtBlue*coefx00 + d10^.rgbtBlue*coefx01;
b2 := d01^.rgbtBlue*coefx00 + d11^.rgbtBlue*coefx01;
d^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
rmBicubic:
begin
xx := wfactor*ix; x := trunc(xx);
yy := hfactor*iy; y := trunc(yy);

r := 0; g := 0; b := 0;
for fy := y-1 to y+2 do
for fx := x-1 to x+2 do
begin
dx := Abs(xx-fx);
dy := Abs(yy-fy);

if dx<1 then
wx := (dx-1)*(dx*dx-dx-1)
else
wx := -(dx-1)*(dx-2)*(dx-2);
 if dy<1 then
wy := (dy-1)*(dy*dy-dy-1)
else
wy := -(dy-1)*(dy-2)*(dy-2);

x0 := fx; if (x0<0) or (x0>w-1) then x0 := x;

y0 := fy; if (y0<0) or (y0>h-1) then y0 := y;

d := src[x0,y0];

r := r + d^.rgbtRed*wx*wy;
g := g + d^.rgbtGreen*wx*wy;
b := b + d^.rgbtBlue*wx*wy;
end;

dst[ix,iy]^.rgbtRed := AdjustByte(r);
dst[ix,iy]^.rgbtGreen := AdjustByte(g);
dst[ix,iy]^.rgbtBlue := AdjustByte(b);
end;
rmMitchell:
begin
xx := wfactor*ix; x := trunc(xx);
yy := hfactor*iy; y := trunc(yy);

r := 0; g := 0; b := 0;
for fy := y-1 to y+2 do
for fx := x-1 to x+2 do
begin
dx := Abs(xx-fx);
dy := Abs(yy-fy);

if dx<1 then
wx := 7*dx*dx*dx/6-2*dx*dx+8/9
else
wx := 2*dx*dx-10*dx/3-7*dx*dx*dx/18+16/9;

if dy<1 then
wy := 7*dy*dy*dy/6-2*dy*dy+8/9
else
wy := 2*dy*dy-10*dy/3-7*dy*dy*dy/18+16/9;

x0 := fx; if (x0<0) or (x0>w-1) then x0 := x;

y0 := fy; if (y0<0) or (y0>h-1) then y0 := y;

r := r + src[x0,y0]^.rgbtRed*wx*wy;
g := g + src[x0,y0]^.rgbtGreen*wx*wy;
b := b + src[x0,y0]^.rgbtBlue*wx*wy;
end;

dst[ix,iy]^.rgbtRed := AdjustByte(r);
dst[ix,iy]^.rgbtGreen := AdjustByte(g);
dst[ix,iy]^.rgbtBlue := AdjustByte(b);
end;
rmLagrange:
begin
xx := wfactor*ix; x := trunc(xx);
yy := hfactor*iy; y := trunc(yy);

r := 0; g := 0; b := 0;
 for fy := y-1 to y+2 do
for fx := x-1 to x+2 do
begin
dx := Abs(xx-fx);
dy := Abs(yy-fy);

if dx<1 then
wx := 0.5*(dx-2)*(dx+1)*(dx-1)
else
wx := -(dx-3)*(dx-2)*(dx-1)/6;

if dy<1 then
wy := 0.5*(dy-2)*(dy+1)*(dy-1)
else
wy := -(dy-3)*(dy-2)*(dy-1)/6;

x0 := fx; if (x0<0) or (x0>w-1) then x0 := x;

y0 := fy; if (y0<0) or (y0>h-1) then y0 := y;

r := r + src[x0,y0]^.rgbtRed*wx*wy;
g := g + src[x0,y0]^.rgbtGreen*wx*wy;
b := b + src[x0,y0]^.rgbtBlue*wx*wy;
end;

dst[ix,iy]^.rgbtRed := AdjustByte(r);
dst[ix,iy]^.rgbtGreen := AdjustByte(g);
dst[ix,iy]^.rgbtBlue := AdjustByte(b);
end;
rmBSpline:
begin
xx := wfactor*ix; x := trunc(xx);
yy := hfactor*iy; y := trunc(yy);

dxx := xx-x;
dyy := yy-y;

dxn[1] := 1-dxx; dxn[1] := dxn[1]*dxn[1]*dxn[1]/6;

dxn[2] := 2-dxx; dxn[2] := dxn[2]*dxn[2]*dxn[2]/6;
dxn[3] := 3-dxx; dxn[3] := dxn[3]*dxn[3]*dxn[3]/6;
dxn[4] := 4-dxx; dxn[4] := dxn[4]*dxn[4]*dxn[4]/6;

dyn[0] := 0+dyy; dyn[0] := dyn[0]*dyn[0]*dyn[0]/6;

dyn[1] := 1+dyy; dyn[1] := dyn[1]*dyn[1]*dyn[1]/6;
dyn[2] := 2+dyy; dyn[2] := dyn[2]*dyn[2]*dyn[2]/6;
dyn[3] := 3+dyy; dyn[3] := dyn[3]*dyn[3]*dyn[3]/6;

RX[-1] := dxn[1];
RX[0] := dxn[2]-4*dxn[1];
RX[1] := dxn[3]-4*dxn[2]+6*dxn[1];
RX[2] := dxn[4]-4*dxn[3]+6*dxn[2]-4*dxn[1];

RY[-1] := dyn[3]-4*dyn[2]+6*dyn[1]-4*dyn[0];
RY[0] := dyn[2]-4*dyn[1]+6*dyn[0];
RY[1] := dyn[1]-4*dyn[0];
RY[2] := dyn[0];

r := 0; g := 0; b := 0;
for fy := y-1 to y+2 do
for fx := x-1 to x+2 do
 begin
x0 := fx; if (x0<0) or (x0>w-1) then x0 := x;
y0 := fy; if (y0<0) or (y0>h-1) then y0 := y;

r := r + src[x0,y0]^.rgbtRed*RX[fx-x]*RY[fy-y];
g := g + src[x0,y0]^.rgbtGreen*RX[fx-x]*RY[fy-y];
b := b + src[x0,y0]^.rgbtBlue*RX[fx-x]*RY[fy-y];
end;

dst[ix,iy]^.rgbtRed := AdjustByte(r);
dst[ix,iy]^.rgbtGreen := AdjustByte(g);
dst[ix,iy]^.rgbtBlue := AdjustByte(b);
end;
end;

src.Free;
dst.Free;
bmp.Free;
bmp := tmp;
result := true;
end;

function HueHistogram(bmp24: TBitmap): TBitmap;

var
bd: TBmpData24;
c: TRGBTriple;
w, h, i, x, y, hh, ss, ll, max: integer;
ht: array[0..359] of integer;
begin
result := nil;
if bmp24.PixelFormat <> pf24bit then exit;

w := bmp24.Width;
h := bmp24.Height;

for i := 0 to 359 do ht[i] := 0;

bd := TBmpData24.Create(bmp24);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
c := bd[x,y]^;
RGBToHSL(c, hh, ss, ll);
inc(ht[hh]);
end;

bd.Free;

max := 0;
for i := 0 to 359 do
if ht[i] > max then max := ht[i];

result := TBitmap.Create;
result.PixelFormat := pf24bit;
result.Width := 370;
result.Height := 160;

for i := 0 to 359 do
 begin
HSLToRGB(@c, i, 60, 40);
result.Canvas.Pen.Color := RGB(c.rgbtRed, c.rgbtGreen, c.rgbtBlue);
result.Canvas.MoveTo(5+i, 155);
result.Canvas.LineTo(5+i, 155-Round(ht[i]*150/max));
end;
end;

function JAlphaBlend(dst: TCanvas; dstX, dstY: integer;

src: TBitmap; alpha: single):Boolean;
var
bf: TBlendFunction;
begin
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := Round(alpha*255/100);
bf.AlphaFormat := 0;
result := Windows.AlphaBlend(dst.Handle, dstX, dstY, src.Width,
src.Height,src.Canvas.Handle, 0, 0, src.Width, src.Height, bf);
end;

function Blur(bmp: TBitmap; zone: integer = 1):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b, v: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

v := zone*2+1;
v := v*v;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-zone to iy+zone do
for x := ix-zone to ix+zone do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];

r := r + d^.rgbtRed;
g := g + d^.rgbtGreen;
b := b + d^.rgbtBlue;
end;
d := dst[ix,iy];
 d^.rgbtRed := r div v;
d^.rgbtGreen := g div v;
d^.rgbtBlue := b div v;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Rank(bmp: TBitmap; mode: TRankMode = rkMax; zone: integer = 1):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
case mode of
rkMax: begin
r := 0; g := 0; b := 0;
end;
else begin
r := 255; g := 255; b := 255;
end;
end;
for y := iy-zone to iy+zone do
for x := ix-zone to ix+zone do
begin
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;
d := src[xx,yy];
case mode of
rkMax: begin
if r<d^.rgbtRed then r := d^.rgbtRed;
if g<d^.rgbtGreen then g := d^.rgbtGreen;
if b<d^.rgbtBlue then b := d^.rgbtBlue;
end;
else begin
if r>d^.rgbtRed then r := d^.rgbtRed;
if g>d^.rgbtGreen then g := d^.rgbtGreen;
if b>d^.rgbtBlue then b := d^.rgbtBlue;
end;
end;
 end;
d := dst[ix,iy];

d^.rgbtRed := r;
d^.rgbtGreen := g;
d^.rgbtBlue := b;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Range(var bmp: TBitmap; zone: integer = 1; Gray: Boolean = true):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y: integer;
src, dst: TBmpData24;
d: PRGBTriple;
rmax, gmax, bmax, rmin, gmin, bmin: byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
rmax := 0; gmax := 0; bmax := 0;
rmin := 255; gmin := 255; bmin := 255;
for y := iy-zone to iy+zone do
for x := ix-zone to ix+zone do
begin
if (y<0) or (y>h-1) then continue;
if (x<0) or (x>w-1) then continue;
d := src[x,y];

if rmax<d^.rgbtRed then rmax := d^.rgbtRed;

if gmax<d^.rgbtGreen then gmax := d^.rgbtGreen;
if bmax<d^.rgbtBlue then bmax := d^.rgbtBlue;

if rmin>d^.rgbtRed then rmin := d^.rgbtRed;

if gmin>d^.rgbtGreen then gmin := d^.rgbtGreen;
if bmin>d^.rgbtBlue then bmin := d^.rgbtBlue;
end;
d := dst[ix,iy];

d^.rgbtRed := rmax-rmin;
d^.rgbtGreen := gmax-gmin;
d^.rgbtBlue := bmax-bmin;
end;
 dst.Free;
src.Free;

tmp.Free;

if Gray then
result := GrayScale(bmp)
else
result := true;
end;

function PointF(X, Y: single): TPointF;

begin
result.X := X;
result.Y := Y;
end;

function Rotation(var bmp: TBitmap; angle: single; bkColor: TColor): Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
pts: array[0..3] of TPointF;
sn, cs: single;
srcRect: TRect;
w, h, ww, hh, i, ix, iy: integer;
sx, sy, rx, ry, xmin, xmax, ymin, ymax: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w+2;
tmp.Height := h+2;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,w+2,h+2));
tmp.Canvas.Draw(1, 1, bmp);
bmp.Free;
bmp := tmp;

pts[0] := PointF(0, 0);

pts[1] := PointF(w, 0);
pts[2] := PointF(w, h);
pts[3] := PointF(0, h);

angle := -angle;
sn := sin(pi*angle/180);
cs := cos(pi*angle/180);
for i := 0 to 3 do
pts[i] := PointF(pts[i].X*cs+pts[i].Y*sn, -pts[i].X*sn+pts[i].Y*cs);

xmin := 100000; xmax := -100000;

ymin := 100000; ymax := -100000;
 for i := 0 to 3 do
begin
if xmin>pts[i].X then xmin := pts[i].X;
if xmax<pts[i].X then xmax := pts[i].X;
if ymin>pts[i].Y then ymin := pts[i].Y;
if ymax<pts[i].Y then ymax := pts[i].Y;
end;

ww := Round(xmax-xmin+1);
hh := Round(ymax-ymin+1);

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := ww;
tmp.Height := hh;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,ww,hh));

angle := -angle;
sn := sin(pi*angle/180);
cs := cos(pi*angle/180);

src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

srcRect := Rect(0,0,w,h);

for iy := 0 to hh-1 do
for ix := 0 to ww-1 do
begin
rx := ix+xmin;
ry := iy+ymin;
sx := rx*cs+ry*sn;
sy := -rx*sn+ry*cs;
if PtInRect(srcRect, Point(Ceil(sx),Ceil(sy))) or
PtInRect(srcRect, Point(Floor(sx),Floor(sy)))
then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0+1, y0+1]^.rgbtRed*coefx00 + src[x1+1,y0+1]^.rgbtRed*coefx01;

r2 := src[x0+1, y1+1]^.rgbtRed*coefx00 + src[x1+1,y1+1]^.rgbtRed*coefx01;
dst[ix,iy]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0+1, y0+1]^.rgbtGreen*coefx00 +
src[x1+1,y0+1]^.rgbtGreen*coefx01;
g2 := src[x0+1, y1+1]^.rgbtGreen*coefx00 +
src[x1+1,y1+1]^.rgbtGreen*coefx01;
dst[ix,iy]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0+1, y0+1]^.rgbtBlue*coefx00 + src[x1+1,y0+1]^.rgbtBlue*coefx01;

b2 := src[x0+1, y1+1]^.rgbtBlue*coefx00 + src[x1+1,y1+1]^.rgbtBlue*coefx01;
dst[ix,iy]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
 end;
end;

dst.Free;
src.Free;

bmp.Free;
bmp := tmp;

result := true;
end;

function OilPaint(bmp: TBitmap; zone: integer = 2):Boolean;

var
tmp:TBitmap;
w, h, ix, iy, x, y: integer;
src, dst: TBmpData24;
d: PRGBTriple;
rh, gh, bh: array[0..15] of integer;
i, rmax, gmax, bmax: integer;
rind, gind, bind: byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
rmax := 0; gmax := 0; bmax := 0;
rind := 0; gind := 0; bind := 0;
for i := 0 to 15 do
begin
rh[i] := 0; gh[i] := 0; bh[i] := 0;
end;

for y := iy-zone to iy+zone do

for x := ix-zone to ix+zone do
begin
if (y<0) or (y>h-1) then continue;
if (x<0) or (x>w-1) then continue;
d := src[x,y];
inc(rh[d^.rgbtRed shr 4]);
inc(gh[d^.rgbtGreen shr 4]);
inc(bh[d^.rgbtBlue shr 4]);
end;

for i := 0 to 15 do
begin
if rmax < rh[i] then begin rmax := rh[i]; rind := i; end;
if gmax < gh[i] then begin gmax := gh[i]; gind := i; end;
if bmax < bh[i] then begin bmax := bh[i]; bind := i; end;
end;
 d := dst[ix,iy];

d^.rgbtRed := rind shl 4;

d^.rgbtGreen := gind shl 4;
d^.rgbtBlue := bind shl 4;
end;

dst.Free;
src.Free;

tmp.Free;

result := true;
end;

function GaussianBlur(bmp: TBitmap; zone:integer = 2): Boolean;

var
tmp: TBItmap;
src, dst: TBmpData24;
d: TRGBTriple;
w, h, i, x, y, ix, iy, range: integer;
count, sr, sg, sb, gauss: single;
gf: array of single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (zone < 1) or (zone > 30) then exit;

w := bmp.Width;
h := bmp.Height;

range := zone*3;
SetLength(gf,range+1);

for i := 0 to range do
gf[i] := exp(-i*i/(2*zone*zone));

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

// at first, bmp -> tmp (x blur)

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
count := 0;
sr := 0; sg := 0; sb := 0;
for ix := x-range to x+range do
begin
if (ix<0) or (ix>w-1) then continue;
d := dst[ix,y]^;
gauss := gf[abs(ix-x)];
sr := sr+d.rgbtRed*gauss;
sg := sg+d.rgbtGreen*gauss;
sb := sb+d.rgbtBlue*gauss;
count := count+gauss;
 end;
src[x,y]^.rgbtBlue := AdjustByte(sb/count);
src[x,y]^.rgbtGreen := AdjustByte(sg/count);
src[x,y]^.rgbtRed := AdjustByte(sr/count);
end;

// second, tmp -> bmp (y blur)

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
count := 0;
sr := 0; sg := 0; sb := 0;
for iy := y-range to y+range do
begin
if (iy<0) or (iy>h-1) then continue;
d := src[x, iy]^;
gauss := gf[abs(iy-y)];
sr := sr+d.rgbtRed*gauss;
sg := sg+d.rgbtGreen*gauss;
sb := sb+d.rgbtBlue*gauss;
count := count+gauss;
end;
dst[x,y]^.rgbtBlue := AdjustByte(sb/count);
dst[x,y]^.rgbtGreen := AdjustByte(sg/count);
dst[x,y]^.rgbtRed := AdjustByte(sr/count);
end;

src.Free;
dst.Free;
tmp.Free;

result := true;
end;

function Mirror(bmp: TBitmap;

mt: TMirrorType = mtLeft;
center: integer = 0): Boolean;
var
tmp:TBitmap;
w, h, ix, iy, w2: integer;
src, dst: TBmpData24;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

if center = 0 then w2 := w div 2 else w2 := center;

for iy := 0 to h-1 do
for ix := 0 to w-1 do
case mt of
mtLeft: if ix >= w2 then dst[ix,iy]^ := src[w-1-ix,iy]^;
mtRight: if ix < w2 then dst[ix,iy]^ := src[w-1-ix,iy]^;
 end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Pixellate(bmp: TBitmap; area:integer):Boolean;

var
src: TBmpData24;
w, h, x, y, r, g, b, count: integer;
ix, iy, nd, nw, nh: integer;
d: PRGBTriple;
t: TRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if area < 2 then exit;
w := bmp.Width;
h := bmp.Height;

src := TBmpData24.Create(bmp);

nd := area-1;
nw := w div area; if (w mod area)<>0 then inc(nw);
nh := h div area; if (h mod area)<>0 then inc(nh);

for y := 0 to nh-1 do
begin
for x := 0 to nw-1 do
begin

b := 0; g := 0; r := 0; count := 0;
for iy := y*area to y*area+nd do
begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd do
begin
if ix>w-1 then continue;
d := src[ix, iy];
b := b + d^.rgbtBlue;
g := g + d^.rgbtGreen;
r := r + d^.rgbtRed;
inc(count);
end;
end;

t.rgbtBlue := b div count;

t.rgbtGreen := g div count;
t.rgbtRed := r div count;

for iy := y*area to y*area+nd do

begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd do
begin
if ix>w-1 then continue;
 src[ix,iy]^ := t;
end;
end;

end;
end;

src.Free;
result := true;
end;

function Mosaic(bmp: TBitmap; area:integer; range: TRect):Boolean;

var
src: TBmpData24;
w, h, x, y, r, g, b, count: integer;
ix, iy, nd, nw, nh: integer;
d: PRGBTriple;
t: TRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if area < 2 then exit;
w := range.Right-range.Left+1;
h := range.Bottom-range.Top+1;

src := TBmpData24.Create(bmp);

nd := area-1;
nw := w div area; if (w mod area)<>0 then inc(nw);
nh := h div area; if (h mod area)<>0 then inc(nh);

for y := 0 to nh-1 do
begin
for x := 0 to nw-1 do
begin

b := 0; g := 0; r := 0; count := 0;
for iy := y*area to y*area+nd do
begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd do
begin
if ix>w-1 then continue;
d := src[range.Left+ix, range.Top+iy];
b := b + d^.rgbtBlue;
g := g + d^.rgbtGreen;
r := r + d^.rgbtRed;
inc(count);
end;
end;

t.rgbtBlue := b div count;

t.rgbtGreen := g div count;
t.rgbtRed := r div count;

for iy := y*area to y*area+nd do

begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd do
 begin
if ix>w-1 then continue;
src[range.Left+ix, range.Top+iy]^ := t;
end;
end;

end;
end;

src.Free;
result := true;
end;

function RiceCake(bmp: TBitmap; factor: single = 0.8):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y, xx, c: integer;
//d: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

c := Round(w*factor);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
xx := Round(x + w*cos((x-c)*2*pi*2/w)/6);
if (xx>=0) and (xx<w) then
dst[x,y]^ := src[xx,y]^;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function PtFInRect(pt: TPointF; r: TRect): Boolean;

begin
result := (pt.X >= r.Left) and (pt.X <= r.Right) and
(pt.Y >= r.Top) and (pt.Y <= r.Bottom);
end;

function Caricature(bmp: TBitmap; factor: single = 100):Boolean;

var
tmp: TBitmap;
 src, dst: TBmpData24;
w, h, x, y: integer;
r, a, c, cx, cy, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx); // radian
sx := Sqrt(r*c)*Cos(a) + cx;
sy := Sqrt(r*c)*Sin(a) + cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;
 dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Fisheye(bmp: TBitmap; factor: single = 100):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, rr, a, c, cx, cy, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);
rr := Sqrt(cx*cx+cy*cy);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx); // radian
sx := c*r*r/rr*Cos(a) + cx;
sy := c*r*r/rr*Sin(a) + cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);
 g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;
g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Swirl(bmp: TBitmap; factor: single = 0.05):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, rr, a, c, cx, cy, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);
rr := Sqrt(cx*cx+cy*cy);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx); // radian
a := a + c*r;
sx := r*Cos(a) + cx;
sy := r*Sin(a) + cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
 x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Shear(bmp: TBitmap; entropy: single = 0.4): Boolean;

var
tmp:TBitmap;
w, h, x, y: integer;
src, dst: TBmpData24;
yshift: array of single;
sx, sy, r, dr: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

Randomize;
r := 0;
dr := entropy;
SetLength(yshift, w);
for x := 0 to w-1 do
begin
if Random(1001) > 500 then r := r+dr else r := r-dr;
yshift[x] := r;
end;
rct := Rect(0,0,w-2,h-2);
 //r := 0;

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
if Random(1001) > 500 then r := r+dr else r := r-dr;
for x := 0 to w-1 do
begin
sx := x+r;
sy := y+yshift[x];
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Cylinder(bmp: TBitmap; cd: TCylinderDirection = cdVertical):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, a, xx, yy, sx, sy: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

rct := Rect(0,0,w,h);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(rct);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

if cd = cdVertical then
begin
r := w/2;

for x := 0 to w-1 do
begin
xx := x-r;
a := ArcTan2(sqrt(r*r-xx*xx),xx); // radian
sx := 2*r*(1-a/pi);
if (sx<0) or (sx>w-2) then continue;

for y := 0 to h-2 do
begin
sy := y;
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end
else
begin
r := h/2;

for y := 0 to h-1 do
begin
 yy := y-r;
a := ArcTan2(sqrt(r*r-yy*yy),yy); // radian
sy := 2*r*(1-a/pi);
if (sy<0) or (sy>h-2) then continue;

for x := 0 to w-2 do
begin
sx := x;
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function SoftFisheye(bmp: TBitmap; factor: single = 0.8):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, a, c, e, cx, cy, rr, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (factor<0.1) or (factor>1.1) then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
cx := w/2;
cy := h/2;
 rr := Sqrt(cx*cx+cy*cy);
rct := Rect(0,0,w-2,h-2);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx); // radian
e := sin(c*r*pi/(2*rr)); e := sqrt(e)+0.1;
sx := r*e*Cos(a) + cx;
sy := r*e*Sin(a) + cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function BathroomWindow(bmp: TBitmap;

zone: integer = 10;
mode: TBathWindowMode = bwVertical):Boolean;
var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
xx, yy, rnd: integer;
 rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

rnd := zone*2+1;
rct := Rect(0,0,w-1,h-1);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
xx := x; yy := y;
case mode of
bwVertical: xx := x + (x mod rnd) - zone;
bwHorizontal:yy := y + (y mod rnd) - zone;
bwBoth: begin
xx := x + (x mod rnd) - zone;
yy := y + (y mod rnd) - zone;
end;
end;
if PtInRect(rct,Point(xx,yy)) then dst[x,y]^ := src[xx,yy]^;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function BathroomWindow2(bmp: TBitmap; zone: integer = 8):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, a, cx, cy, sx, sy: single;
rnd: integer;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

rnd := zone*2+1;
 cx := w/2;
cy := h/2;
rct := Rect(0,0,w-2,h-2);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx); // radian
sx := x + (Round(((a+pi)*180/pi+0.1*r)) mod rnd) + zone;
sy := y;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function SpotLight(bmp: TBitmap; radius: integer):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, c, cx, cy, rr: single;
d, s: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
 w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rr := radius*radius;

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clBlack;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := (x-cx)*(x-cx)+(y-cy)*(y-cy);
c :=1.1*(1-r/rr);
if c<0 then continue;
d := dst[x,y];
s := src[x,y];
d^.rgbtRed := AdjustByte(s^.rgbtRed*c);
d^.rgbtGreen := AdjustByte(s^.rgbtGreen*c);
d^.rgbtBlue := AdjustByte(s^.rgbtBlue*c);
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Tile(bmp: TBitmap; area:integer = 16; entropy: integer = 2):Boolean;

var
tmp: TBitmap;
w, h, x, y, ix, iy, xx, yy,nd, nw, nh, ne: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if area < 10 then exit;

w := bmp.Width;
h := bmp.Height;

tmp := BmpClone(bmp);

Invert(bmp);

nd := area-1;
ne := entropy*2+1;
nw := w div area; if (w mod area)<>0 then inc(nw);
nh := h div area; if (h mod area)<>0 then inc(nh);
Randomize;

for y := 0 to nh-1 do
begin
 for x := 0 to nw-1 do
begin
ix := x*area;
iy := y*area;
xx := ix+Random(ne)-entropy;
yy := iy+Random(ne)-entropy;
bmp.Canvas.CopyRect(Rect(xx, yy, xx+nd, yy+nd), tmp.Canvas,
Rect(ix, iy, ix+nd, iy+nd));

end;
end;

tmp.Free;
result := true;
end;

function Ripple(bmp: TBitmap;

factor: single = 3.0;
frequency: single = 40):Boolean;
var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, a, c, f, cx, cy, rr, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
f := frequency;
cx := w/2;
cy := h/2;
rct := Rect(0,0,w-2,h-2);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2(y-cy,x-cx);
rr := r+c*sin(f*r*pi/180);
sx := rr*Cos(a) + cx;
sy := rr*Sin(a) + cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
 y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Pixellate2(bmp: TBitmap; zone: integer = 6):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
r, a, rr, aa, cx, cy: single;
xx, yy: integer;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
rr := (Trunc(r) div zone)*zone;
a := ArcTan2((y-cy),(x-cx))*180/pi; // degree
aa := (Trunc(a) div zone)*zone*pi/180; // radian
 xx := Round(rr*cos(aa)+cx);
yy := Round(rr*sin(aa)+cy);
if PtInRect(rct,Point(xx,yy)) then
dst[x,y]^ := src[xx,yy]^;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Ripple2(bmp: TBitmap;

factor: single = 0.2;
frequency: single = 40):Boolean;
var
dst: TBmpData24;
w, h, x, y: integer;
r, c, f, cx, cy, bb: single;
d: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
f := frequency;
cx := w/2;
cy := h/2;

dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
r := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
bb := 1+c*sin(f*r*pi/180);
d := dst[x,y];
d^.rgbtRed := AdjustByte(d^.rgbtRed*bb);
d^.rgbtGreen := AdjustByte(d^.rgbtGreen*bb);
d^.rgbtBlue := AdjustByte(d^.rgbtBlue*bb);
end;
end;

dst.Free;

result := true;
end;

function WaveGlass(bmp: TBitmap;

WaveType: TWaveType = wtVertical;
factor: single = 3;
frequency: single = 30):Boolean;
var
tmp: TBitmap;
 src, dst: TBmpData24;
w, h, x, y: integer;
c, f, sx, sy: single;
x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

c := factor;
f := frequency;
rct := Rect(0,0,w-2,h-2);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
begin
for x := 0 to w-1 do
begin
sx := x;
sy := y;
case WaveType of
wtVertical : sx := x + c*sin(f*x*pi/180);
wtHorizontal: sy := y + c*sin(f*y*pi/180);
wtBoth : begin
sx := x + c*sin(f*x*pi/180);
sy := y + c*sin(f*y*pi/180);
end;
end;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
 end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function ColorSpotLight(bmp: TBitmap; radius: integer):Boolean;

var
dst: TBmpData24;
w, h, x, y: integer;
r, c, cx, cy, rr: single;
d: TRGBTriple;
bd: PRGBTriple;
SatComp, SatCompR, SatCompG, SatCompB: extended;
b: byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rr := radius*radius;

dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := (x-cx)*(x-cx)+(y-cy)*(y-cy);
c :=1.1*(1-r/rr);
if c>0 then
begin
SatComp := 1.0 - c;
SatCompR := 0.3086 * SatComp;
SatCompG := 0.6094 * SatComp;
SatCompB := 0.0820 * SatComp;

d := dst[x,y]^;
bd := dst[x,y];
bd^.rgbtRed := AdjustByte(d.rgbtRed*(SatCompR+c)+
d.rgbtGreen*SatCompG+
d.rgbtBlue*SatCompB);

bd^.rgbtGreen := AdjustByte(d.rgbtRed*SatCompR+
d.rgbtGreen*(SatCompG+c)+
d.rgbtBlue*SatCompB);

bd^.rgbtBlue := AdjustByte(d.rgbtRed*SatCompR+
d.rgbtGreen*SatCompG+
d.rgbtBlue*(SatCompB+c));
end
else
 begin
d := dst[x,y]^;
bd := dst[x,y];

b := Trunc(0.3086*d.rgbtRed + 0.6094*d.rgbtGreen + 0.0820*d.rgbtBlue);

bd^.rgbtRed := b;
bd^.rgbtGreen := b;
bd^.rgbtBlue := b;
end;
end;

dst.Free;

result := true;
end;

function Vaseline(bmp: TBitmap; radius: integer):Boolean;

var
tmp: TBitmap;
dst, src: TBmpData24;
w, h, x, y: integer;
r, cx, cy, rr: single;
d, s: PRGBTriple;
z, ix, iy, sr, sg, sb, count: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rr := radius*radius;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
z :=Round(0.3*r*r*r/rr);
if (z>1) then
begin
if z>10 then z := 10;
count := 0;
sr := 0; sg := 0; sb := 0;
for iy := y-z to y+z do
begin
if (iy<0) or (iy>h-1) then continue;
for ix := x-z to x+z do
begin
if (ix<0) or (ix>w-1) then continue;
s := src[ix,iy];
sr := sr + s^.rgbtRed;
sg := sg + s^.rgbtGreen;
 sb := sb + s^.rgbtBlue;
inc(count);
end;
end;
d := dst[x,y];
d^.rgbtRed := sr div count;
d^.rgbtGreen := sg div count;
d^.rgbtBlue := sb div count;
end;
end;

dst.Free;
src.Free;

result := true;
end;

function Explosion(bmp: TBitmap; factor: integer):Boolean;

var
tmp: TBitmap;
dst, src: TBmpData24;
w, h, x, y, xx, yy, rf: integer;
r, a, b, cx, cy: single;
d, s: PRGBTriple;
deg: single;
ss, sss: single;
sft: array[-1..361] of integer;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rct := Rect(0,0,w,h);

rf := factor;

Randomize;
for x := -1 to 361 do sft[x] := Random(rf);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2((y-cy),(x-cx));
deg := (a+pi)*180/pi;
sss := Trunc(deg)-deg;
ss := (1-sss)*sft[Trunc(deg)]+sss*sft[Trunc(deg)+1];
if r<ss then continue;
r := r-ss;
 xx := Round(r*cos(a)+cx);
yy := Round(r*sin(a)+cy);
if PtInRect(rct, Point(xx,yy)) then
begin
b := 1+(ss-rf/2)/(rf*4);
d := dst[x,y];
s := src[xx,yy];
d^.rgbtRed := AdjustByte(s^.rgbtRed*b);
d^.rgbtGreen := AdjustByte(s^.rgbtGreen*b);
d^.rgbtBlue := AdjustByte(s^.rgbtBlue*b);
end;
end;

dst.Free;
src.Free;

result := true;
end;

function FrostedGlass(bmp: TBitmap; alpha: single; fBlur: integer; rct: TRect):

Boolean;
var
tmp: TBitmap;
w, h: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w;
tmp.Height := h;
tmp.Canvas.Brush.Color := RGB($ee,$ee,$ee);
tmp.Canvas.FillRect(Rect(0,0,w,h));

JAlphaBlend(tmp.Canvas, 0, 0, bmp, alpha);

GaussianBlur(tmp, fBlur);

bmp.Canvas.CopyRect(rct,tmp.Canvas,rct);

tmp.Free;
result := true;
end;

procedure ShadowFrame(var bmp: TBitmap;

Margin: integer = 10;
ShadowWidth: integer = 7;
BackColor: TColor = clWhite);
var
tmp: TBitmap;
w, h, ww, hh: integer;

p: integer;
begin
w := bmp.Width;
h := bmp.Height;
 ww := w + ShadowWidth+2+Margin*2;
hh := h + ShadowWidth+2+Margin*2;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := ww;
tmp.Height := hh;
tmp.Canvas.Brush.Color := backcolor;
tmp.Canvas.FillRect(Rect(0,0,ww,hh));

p := ShadowWidth+Margin;
if ShadowWidth > 5 then
tmp.Canvas.Brush.Color := $606060
else
tmp.Canvas.Brush.Color := $404040;
tmp.Canvas.FillRect(Rect(p, p, p+w, p+h));

GaussianBlur(tmp, 3);

tmp.Canvas.Draw(Margin, Margin, bmp);

bmp.Free;
bmp := tmp;
end;

function MakeMask1(var bmp:TBitmap; threshold: byte = 100): Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
w, h, x, y: integer;
s: PRGBTriple;
b: byte;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w;
tmp.Height := h;

src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
s := src[x,y];
b := Trunc(0.299*s^.rgbtRed + 0.587*s^.rgbtGreen + 0.114*s^.rgbtBlue);
if b< threshold then dst[x,y]^ := s^;
end;

dst.Free;
src.Free;
 bmp.Free;
bmp := tmp;
result := true;
end;

procedure MaskedOverlay(dst, src, mask: TBitmap; dstX, dstY: integer);

var
w, h, dw, dh, sw, sh, x, y:integer;
d, s: TBmpData24;
m: TBmpData8;
a: byte;
pd, ps: PRGBTriple;
begin
dw := dst.Width;
dh := dst.Height;
sw := src.Width;
sh := src.Height;

w := Min(dw-dstX, sw);
h := Min(dh-dstY, sh);

if (w<1) or (h<1) then exit;

if (mask.Width<sw) or (mask.Height<sh) then exit;

d := TBmpData24.Create(dst);
s := TBmpData24.Create(src);
m := TBmpData8.Create(mask);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
a := m[x,y]^;
if a = 0 then continue;
if (x+dstX<0) or (y+dstY<0) then continue;
pd := d[x+dstX,y+dstY];
ps := s[x,y];
pd^.rgbtRed := AdjustByte(((255-a)*pd^.rgbtRed + a*ps^.rgbtRed)/255);
pd^.rgbtGreen := AdjustByte(((255-a)*pd^.rgbtGreen + a*ps^.rgbtGreen)/255);
pd^.rgbtBlue := AdjustByte(((255-a)*pd^.rgbtBlue + a*ps^.rgbtBlue)/255);
end;

m.Free;
s.Free;
d.Free;
end;

function SpotMask(w, h: integer; Radius: integer): TBitmap;

var
bd: TBmpData8;
x, y: integer;
r, cx, cy, rr: single;
c: integer;
begin
result := TBitmap.Create;
result.PixelFormat := pf8bit;
result.Width := w;
result.Height := h;
 SetGrayPalette(result);

cx := w/2;
cy := h/2;
rr := Radius*Radius;

bd := TBmpData8.Create(result);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := (x-cx)*(x-cx)+(y-cy)*(y-cy);
c :=Round(255*(1-r/rr));
if c<0 then
bd[x,y]^ := 0
else
bd[x,y]^ := c;
end;

bd.Free;
end;

function SineMask(w, h: integer; mode: TSineMask): TBitmap;

var
bd: TBmpData8;
x, y: integer;
begin
result := TBitmap.Create;
result.PixelFormat := pf8bit;
result.Width := w;
result.Height := h;

SetGrayPalette(result);

bd := TBmpData8.Create(result);

for y := 0 to h-1 do
for x := 0 to w-1 do
case mode of
smVert: bd[x,y]^ := Round(255*sin(x*pi/(w-1)));
smHorz: bd[x,y]^ := Round(255*sin(y*pi/(h-1)));
smBoth:bd[x,y]^ := Round(255*sin(x*pi/(w-1))*sin(y*pi/(h-1)));
end;

bd.Free;
end;

function AsCodecBmpCheckFileHeader18(const a: Pointer): Boolean;

{$IFDEF DELPHI_5}
type
PCardinal = ^Cardinal;
{$ENDIF}
var
m: Pointer;
begin
result := False;
if (PBitmapFileHeader(a)^.bfType <> 19778) then exit;
m := Pointer(Cardinal(a)+SizeOf(TBitmapFileHeader));
if (PCardinal(m)^ = SizeOf(TBitmapInfoHeader)) or
 (PCardinal(m)^ = SizeOf(TBitmapCoreHeader)) then
result := true;
end;

function AsCodecJpgCheckFileHeader2(const a: Pointer): Boolean;

begin
result := ((PByte(a)^ = 255) and (PByte(Cardinal(a)+1)^ = 216));
end;

function AsCodecGifCheckFileHeader6(const a: Pointer): Boolean;

const
gifver: array[0..5] of Char = 'GIF87A';
var
m: PByte;
n: Integer;
begin
result := False;
m := a;
for n := 0 to 5 do
begin
if m^ <> Integer(gifver[n]) then
begin
if n = 3 then
exit
else
if n = 4 then
begin
if m^ <> Ord('9') then exit;
end
else
begin
if m^ <> Integer(gifver[n])+32 then exit;
end;
end;
Inc(m);
end;
result := true;
end;

function LoadCheckedImage(filename: string): TBitmap;

var
ms: TMemoryStream;
a: Pointer;
gif: TGifImage;
jpg: TJpegImage;
png: TPngImage;
begin
result := nil;
ms := TMemoryStream.Create;
try
try
ms.LoadFromFile(filename);
a := ms.Memory;
result := TBitmap.Create;
if AsCodecBmpCheckFileHeader18(a) then
begin
result.LoadFromStream(ms);
end
else
 if AsCodecGifCheckFileHeader6(a) then
begin
gif := TGifImage.Create;
try
gif.LoadFromStream(ms);
result.Assign(gif);
finally
gif.Free;
end;
end
else
if AsCodecJpgCheckFileHeader2(a) then
begin
jpg := TJpegImage.Create;
try
jpg.LoadFromStream(ms);
result.Assign(jpg);
finally
jpg.Free;
end;
end
else
begin
png := TPngImage.Create;
try
try
png.LoadFromStream(ms);
result.Assign(png);
except
FreeAndNil(result)
end;
finally
png.Free;
end;
end;
except
FreeAndNil(result);
end;
finally
ms.Free;
end;
end;

function GetThumbnailImage(filename: string;

width, height: integer;
bkColor: TColor = clWhite;
frame: Boolean = true): TBitmap;
var
img: TBitmap;
w, h, s1, s2: extended;
rct: TRect;
begin
result := TBitmap.Create;
result.PixelFormat := pf24bit;
result.Width := width;
result.Height := height;
rct := Rect(0,0,width, height);
result.Canvas.Brush.Color := bkColor;
result.Canvas.FillRect(rct);
 img := LoadCheckedImage(filename);
if Assigned(img) then
begin
img.PixelFormat := pf24bit;
s1 := width/height;
w := img.Width;
h := img.Height;
s2 := w/h;
if s1 > s2 then
begin
w := height*s2;
h := height;
end
else
begin
w := width;
h := width/s2;
end;
BmpResize(img, Trunc(w),Trunc(h), rmLagrange);
result.Canvas.Draw(Round((width-w)/2),Round((height-h)/2), img);
img.Free;
end
else
DrawText(result.Canvas.Handle,'No Image', 8, rct,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);

if frame then begin

result.Canvas.Brush.Style := bsClear;
result.Canvas.Rectangle(rct);
end;
end;

function Grid(bmp: TBitmap; area:integer):Boolean;

var
bd: TBmpData24;
w, h, x, y, r, g, b, count: integer;
ix, iy, nd, nw, nh: integer;
d, e: TRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if area < 2 then exit;
w := bmp.Width;
h := bmp.Height;

bd := TBmpData24.Create(bmp);

nd := area-1;
nw := w div area; if (w mod area)<>0 then inc(nw);
nh := h div area; if (h mod area)<>0 then inc(nh);

for y := 0 to nh-1 do
begin
for x := 0 to nw-1 do
begin

b := 0; g := 0; r := 0; count := 0;
for iy := y*area to y*area+nd do
 begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd do
begin
if ix>w-1 then continue;
d := bd[ix, iy]^;
b := b + d.rgbtBlue;
g := g + d.rgbtGreen;
r := r + d.rgbtRed;
inc(count);
end;
end;

b := b div count;
g := g div count;
r := r div count;

d.rgbtBlue := b;
d.rgbtGreen := g;
d.rgbtRed := r;

e.rgbtBlue := AdjustByte(d.rgbtBlue*1.2);
e.rgbtGreen := AdjustByte(d.rgbtGreen*1.2);
e.rgbtRed := AdjustByte(d.rgbtRed*1.2);

for iy := y*area to y*area+nd-1 do

begin
if iy>h-1 then continue;
for ix := x*area to x*area+nd-1 do
begin
if ix>w-1 then continue;
bd[ix,iy]^ := d;
end;
end;

iy := y*area+nd;
if iy<=h-1 then
begin
for ix := x*area to x*area+nd do
begin
if ix>w-1 then continue;
bd[ix,iy]^ := e;
end;
end;

ix := x*area+nd;
if ix<=w-1 then
begin
for iy := y*area to y*area+nd-1 do
begin
if iy>h-1 then continue;
bd[ix,iy]^ := e;
end;
end;

end;
end;

bd.Free;
 result := true;
end;

function Soften(bmp: TBitmap; percent:integer): Boolean;

var
tmp: TBitmap;
dst, src: TBmpData24;
w, h, x, y: integer;
d, s: PRGBTriple;
r: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (percent<0) or (percent>100) then exit;

w := bmp.Width;
h := bmp.Height;

r := percent/100;

tmp := BmpClone(bmp);
GaussianBlur(tmp, 1);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
d := dst[x,y];
s := src[x,y];
d^.rgbtRed := AdjustByte((1-r)*d^.rgbtRed + r*s^.rgbtRed);
d^.rgbtGreen := AdjustByte((1-r)*d^.rgbtGreen + r*s^.rgbtGreen);
d^.rgbtBlue := AdjustByte((1-r)*d^.rgbtBlue + r*s^.rgbtBlue);
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Contour1(var bmp: TBitmap; threshold: integer): Boolean;

var
tmp: TBitmap;
src: TBmpData24;
dst: TBmpData1;
w, h, x, y: integer;
s, t: PRGBTriple;
r1, r2, r3, rr, gg, bb: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
 tmp.PixelFormat := pf1bit;
tmp.Width := w;
tmp.Height := h;

r3 := sqrt(3.0);

src := TBmpData24.Create(bmp);
dst := TBmpData1.Create(tmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
s := src[x,y];

if x+1>w-1 then
r1 := 0
else
begin
t := src[x+1,y];
bb := s^.rgbtBlue - t^.rgbtBlue;
gg := s^.rgbtGreen - t^.rgbtGreen;
rr := s^.rgbtRed - t^.rgbtRed;
r1 := trunc(sqrt(rr*rr+gg*gg+bb*bb)/r3);
end;

if y+1>h-1 then
r2 := 0
else
begin
t := src[x,y+1];
bb := s^.rgbtBlue - t^.rgbtBlue;
gg := s^.rgbtGreen - t^.rgbtGreen;
rr := s^.rgbtRed - t^.rgbtRed;
r2 := trunc(sqrt(rr*rr+gg*gg+bb*bb)/r3);
end;

if (r1>=threshold) or (r2>=threshold) then

dst[x,y] := false;
end;

dst.Free;
src.Free;

bmp.Free;
bmp := tmp;
result := true;
end;

function Contour2(var bmp: TBitmap; Stretch: Boolean = true): Boolean;

var
tmp: TBitmap;
src: TBmpData24;
dst: TBmpData8;
w, h, x, y: integer;
s, t: PRGBTriple;
r1, r2, r3, rr, gg, bb: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
 w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
tmp.PixelFormat := pf8bit;
tmp.Width := w;
tmp.Height := h;
SetGrayPalette(tmp);

r3 := sqrt(3.0);

src := TBmpData24.Create(bmp);
dst := TBmpData8.Create(tmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
s := src[x,y];

if x+1>w-1 then
r1 := 0
else
begin
t := src[x+1,y];
bb := s^.rgbtBlue - t^.rgbtBlue;
gg := s^.rgbtGreen - t^.rgbtGreen;
rr := s^.rgbtRed - t^.rgbtRed;
r1 := trunc(sqrt(rr*rr+gg*gg+bb*bb)/r3);
end;

if y+1>h-1 then
r2 := 0
else
begin
t := src[x,y+1];
bb := s^.rgbtBlue - t^.rgbtBlue;
gg := s^.rgbtGreen - t^.rgbtGreen;
rr := s^.rgbtRed - t^.rgbtRed;
r2 := trunc(sqrt(rr*rr+gg*gg+bb*bb)/r3);
end;

dst[x,y]^ := AdjustByte(255-r1-r2);
end;

dst.Free;
src.Free;

if Stretch then HistoStretch(tmp);

bmp.Free;
bmp := tmp;
result := true;
end;

function Parallelogram1(var bmp: TBitmap; deform: single; bkColor: TColor):

Boolean;
var
tmp: TBitmap;
 src, dst: TBmpData24;
srcRect: TRect;
w, h, ww, hh, i, ix, iy: integer;

sx, sy: single;

x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w+2;
tmp.Height := h+2;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,w+2,h+2));
tmp.Canvas.Draw(1, 1, bmp);
bmp.Free;
bmp := tmp;

ww := Round(w+Abs(deform));;
hh := h;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := ww;
tmp.Height := hh;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,ww,hh));

src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

srcRect := Rect(0,0,w,h);

for iy := 0 to hh-1 do
for ix := 0 to ww-1 do
begin
if deform > 0 then
sx := ix+deform*iy/h-deform
else
sx := ix+deform*iy/h;
sy := iy;

if PtInRect(srcRect, Point(Ceil(sx),Ceil(sy))) or
PtInRect(srcRect, Point(Floor(sx),Floor(sy)))
then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;
 r1 := src[x0+1, y0+1]^.rgbtRed*coefx00 + src[x1+1,y0+1]^.rgbtRed*coefx01;
r2 := src[x0+1, y1+1]^.rgbtRed*coefx00 + src[x1+1,y1+1]^.rgbtRed*coefx01;
dst[ix,iy]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0+1, y0+1]^.rgbtGreen*coefx00 +
src[x1+1,y0+1]^.rgbtGreen*coefx01;
g2 := src[x0+1, y1+1]^.rgbtGreen*coefx00 +
src[x1+1,y1+1]^.rgbtGreen*coefx01;
dst[ix,iy]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0+1, y0+1]^.rgbtBlue*coefx00 + src[x1+1,y0+1]^.rgbtBlue*coefx01;

b2 := src[x0+1, y1+1]^.rgbtBlue*coefx00 + src[x1+1,y1+1]^.rgbtBlue*coefx01;
dst[ix,iy]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
src.Free;

bmp.Free;
bmp := tmp;

result := true;
end;

function Parallelogram2(var bmp: TBitmap; deform: single; bkColor: TColor):

Boolean;
var
tmp: TBitmap;
src, dst: TBmpData24;
srcRect: TRect;
w, h, ww, hh, i, ix, iy: integer;
angle: single;

sx, sy: single;

x0, x1, y0, y1: integer;
r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;
if deform > h*0.8 then exit;

angle := ArcTan2(deform, h);

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w+2;
tmp.Height := h+2;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,w+2,h+2));
tmp.Canvas.Draw(1, 1, bmp);
bmp.Free;
bmp := tmp;

ww := Round(w+Abs(deform));;
 hh := h;

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := ww;
tmp.Height := hh;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,ww,hh));

src := TBmpData24.Create(bmp);
dst := TBmpData24.Create(tmp);

srcRect := Rect(0,0,w,h);

for iy := 0 to hh-1 do
for ix := 0 to ww-1 do
begin
if deform > 0 then
sx := ix+deform*iy/h-deform
else
sx := ix+deform*iy/h;
sy := iy;

if PtInRect(srcRect, Point(Ceil(sx),Ceil(sy))) or
PtInRect(srcRect, Point(Floor(sx),Floor(sy)))
then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0+1, y0+1]^.rgbtRed*coefx00 + src[x1+1,y0+1]^.rgbtRed*coefx01;

r2 := src[x0+1, y1+1]^.rgbtRed*coefx00 + src[x1+1,y1+1]^.rgbtRed*coefx01;
dst[ix,iy]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0+1, y0+1]^.rgbtGreen*coefx00 +
src[x1+1,y0+1]^.rgbtGreen*coefx01;
g2 := src[x0+1, y1+1]^.rgbtGreen*coefx00 +
src[x1+1,y1+1]^.rgbtGreen*coefx01;
dst[ix,iy]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0+1, y0+1]^.rgbtBlue*coefx00 + src[x1+1,y0+1]^.rgbtBlue*coefx01;

b2 := src[x0+1, y1+1]^.rgbtBlue*coefx00 + src[x1+1,y1+1]^.rgbtBlue*coefx01;
dst[ix,iy]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
src.Free;

bmp.Free;
bmp := tmp;

result := BmpResize(bmp, ww, Trunc(hh*cos(angle)));

end;
function AlphaTile(var bmp:TBitmap; partition: integer = 10): Boolean;
var
tmp1, tmp2, dst: TBitmap;
w, h, ww, hh, x, y: integer;
src, tgt: TBmpData24;
mask: TBmpData8;
r: byte;
d, s: PRGBTriple;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

ww := Ceil(w/partition);
hh := Ceil(h/partition);

tmp1 := BmpClone(bmp);
BmpResize(tmp1, ww, hh, rmBicubic);
Invert(tmp1);
GrayScale(tmp1);
//HistoStretch(tmp1);

tmp2 := TBitmap.Create;
tmp2.PixelFormat := pf8bit;
tmp2.Width := w;
tmp2.Height := h;
SetGrayPalette(tmp2);

for x := 0 to partition-1 do
for y := 0 to partition-1 do
tmp2.Canvas.Draw(ww*x, hh*y, tmp1);
tmp1.Free;

dst := TBitmap.Create;
dst.PixelFormat := pf24bit;
dst.Width := w;
dst.Height := h;

src := TBmpData24.Create(bmp);
tgt := TBmpData24.Create(dst);
mask := TBmpData8.Create(tmp2);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
r := mask[x,y]^;
s := src[x,y];
d := tgt[x,y];

d^.rgbtRed := AdjustByte((255-r)*0.85+s^.rgbtRed*r/255);
d^.rgbtGreen := AdjustByte((255-r)*0.85+s^.rgbtGreen*r/255);
d^.rgbtBlue := AdjustByte((255-r)*0.85+s^.rgbtBlue*r/255);
end;

mask.Free;
tgt.Free;
 src.Free;

tmp2.Free;

bmp.Free;
bmp := dst;
result := true;
end;

function Divide(var bmp:TBitmap;

bkImage: TBitmap;
hdiv, vdiv: integer;
margin: integer = 20;
framewidth: integer = 5): Boolean;
var
dst, tmp: TBitmap;
w, h, ww, hh, www, hhh, x, y: integer;
dstRct, srcRct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

ww := w div hdiv;
hh := h div vdiv;
www := ww + framewidth*2;
hhh := hh + framewidth*2;

dstRct := Rect(framewidth, framewidth, framewidth+ww, framewidth+hh);

tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := www;
tmp.Height := hhh;
tmp.Canvas.Rectangle(0,0,www, hhh);

dst := TBitmap.Create;
dst.PixelFormat := pf24bit;
dst.Width := www*hdiv + margin*2;
dst.Height := hhh*vdiv + margin*2;

for x := 0 to dst.Width div bkImage.Width do

for y := 0 to dst.Height div bkImage.Height do
dst.Canvas.Draw(bkImage.Width*x, bkImage.Height*y, bkImage);

Randomize;

for x := 0 to hdiv-1 do
for y := 0 to vdiv-1 do
begin
srcRct := Rect(ww*x, hh*y, ww*(x+1), hh*(y+1));
tmp.Canvas.CopyRect(dstRct, bmp.Canvas, srcRct);
dst.Canvas.Draw(margin+www*x+Random(5)-2, margin+hhh*y+Random(5)-2, tmp);
end;

tmp.Free;
 bmp.Free;
bmp := dst;
result := true;
end;

function RadialBlur(bmp: TBitmap; zone: integer = 3):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
s, d: PRGBTriple;
w, h, x, y: integer;
a, cx, cy: single;
rr, i, xx, yy, count, r, g, b: integer;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
rr := Round(Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy)));
a := ArcTan2((y-cy),(x-cx)); // radian
count := 0; r := 0; g := 0; b := 0;
for i := rr-zone to rr+zone do
begin
if i<0 then continue;
xx := Round(i*cos(a)+cx);
yy := Round(i*sin(a)+cy);
if PtInRect(rct,Point(xx,yy)) then
begin
s := src[xx,yy];
r := r + s^.rgbtRed;
g := g + s^.rgbtGreen;
b := b + s^.rgbtBlue;
inc(count);
end;
end;
if count = 0 then continue;
d := dst[x,y];
d^.rgbtRed := r div count;
d^.rgbtGreen := g div count;
d^.rgbtBlue := b div count;
end;

dst.Free;
src.Free;
 tmp.Free;
result := true;
end;

function AngleBlur(bmp: TBitmap; zone: integer = 3):Boolean;

var
tmp: TBitmap;
src, dst: TBmpData24;
s, d: PRGBTriple;
w, h, x, y: integer;
rr, cx, cy: single;
a, i, xx, yy, count, r, g, b: integer;
rct: TRect;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

cx := w/2;
cy := h/2;
rct := Rect(0,0,w-1,h-1);

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
rr := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := Round(ArcTan2((y-cy),(x-cx))*180/pi); // degree
count := 0; r := 0; g := 0; b := 0;
for i := a-zone to a+zone do
begin
xx := Round(rr*cos(i*pi/180)+cx);
yy := Round(rr*sin(i*pi/180)+cy);
if PtInRect(rct,Point(xx,yy)) then
begin
s := src[xx,yy];
r := r + s^.rgbtRed;
g := g + s^.rgbtGreen;
b := b + s^.rgbtBlue;
inc(count);
end;
end;
if count = 0 then continue;
d := dst[x,y];
d^.rgbtRed := r div count;
d^.rgbtGreen := g div count;
d^.rgbtBlue := b div count;
end;

dst.Free;
src.Free;
 tmp.Free;
result := true;
end;

function BrightnessModulation(var bmp, modu: TBitmap;

percent: single;
negative: boolean = false):Boolean;
var
src: TBmpData24;
mdu: TBmpData8;
s: PRGBTriple;
m: byte;
r, p: single;
w, h, x, y: integer;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if modu.PixelFormat <> pf24bit then exit;
if (bmp.Width>modu.Width) or (bmp.Height>modu.Height) then exit;

w := bmp.Width;
h := bmp.Height;

p := percent/100;

if negative then Invert(modu);

GrayScale(modu);
HistoStretch(modu);

src := TBmpData24.Create(bmp);
mdu := TBmpData8.Create(modu);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
m := mdu[x,y]^;
r := (1-p) + 2*p*m/255;
s := src[x,y];
s^.rgbtRed := AdjustByte(r*s^.rgbtRed);
s^.rgbtGreen := AdjustByte(r*s^.rgbtGreen);
s^.rgbtBlue := AdjustByte(r*s^.rgbtBlue);
end;

mdu.Free;
src.Free;

result := true;
end;

function PolarShear(bmp: TBitmap;

rentropy: single = 0.5;
aentropy: single = 0.5;
bInterpolation: Boolean = true): Boolean;
var
tmp:TBitmap;
w, h, x, y, p, q: integer;
src, dst: TBmpData24;
rshift: array of single;
ashift: array[0..181] of single;
 a, rr, cx, cy, f: single;
sx, sy, r, dr: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

q := Round(Sqrt(w*w+h*h)/2)+3;
SetLength(rshift, q);

Randomize;

r := 0;
dr := rentropy;
for x := 0 to q-1 do
begin
p := Random(1500);
if p < 500 then r := r-dr
else
if p > 1000 then r := r+dr;
rshift[x] := r;
end;

r := 0;
dr := aentropy;
for x := 0 to 181 do
begin
p := Random(1500);
if p < 500 then r := r-dr
else
if p > 1000 then r := r+dr;
ashift[x] := r;
end;

cx := w/2;
cy := h/2;
rct := Rect(0,0,w-2,h-2);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := clGray;
bmp.Canvas.FillRect(Rect(0,0,w,h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
rr := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2((y-cy),(x-cx))*180/pi; // degree
if bInterpolation then
begin
 f := rr - Trunc(rr);
rr := rr + (1-f)*rshift[Trunc(rr)] + f*rshift[Trunc(rr)+1];
f := Abs(a) - Trunc(Abs(a));
a := a + (1-f)*ashift[Trunc(Abs(a))] + f*ashift[Trunc(Abs(a)+1)];
end
else
begin
rr := rr + rshift[Round(rr)];
a := a + ashift[Round(Abs(a))];
end;
sx := rr*cos(a*pi/180)+cx;
sy := rr*sin(a*pi/180)+cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

function Circle1(var bmp: TBitmap; bkColor: TColor = clGray): Boolean;

var
tmp:TBitmap;
w, h, x, y, q: integer;
src, dst: TBmpData24;
a, rr, cx, cy, c: single;
sx, sy: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
w := bmp.Width;
h := bmp.Height;

q := max(w,h);
BmpResize(bmp,q,q);

cx := q/2;
cy := q/2;
rct := Rect(0,0,q-2,q-2);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := bkColor;
bmp.Canvas.FillRect(Rect(0,0,q,q));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to q-1 do
for x := 0 to q-1 do
begin
rr := Sqrt((x-cx)*(x-cx)+(y-cy)*(y-cy));
a := ArcTan2((y-cy),(x-cx))*180/pi; // degree

if Abs(a)<45 then
c := 1/cos(a*pi/180)
else
if Abs(a)<135 then
c := 1/sin(Abs(a)*pi/180)
else
c := -1/cos(a*pi/180);

rr := rr*c;
sx := rr*cos(a*pi/180)+cx;
sy := rr*sin(a*pi/180)+cy;
if PtFInRect(PointF(sx, sy), rct) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
 src.Free;

tmp.Free;
result := true;
end;

function Circle2(var bmp: TBitmap; bkColor: TColor = clGray): Boolean;

var
tmp:TBitmap;
w, h, x, y, q: integer;
src, dst: TBmpData24;
sx, sy, r, l: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

w := bmp.Width;
h := bmp.Height;

q := max(w,h);
BmpResize(bmp,q,q);

r := q/2;
rct := Rect(0,0,q-2,q-2);

tmp := BmpClone(bmp);
bmp.Canvas.Brush.Color := bkColor;
bmp.Canvas.FillRect(Rect(0,0,q,q));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 1 to q-1 do
for x := 0 to q-1 do
begin
l := sqrt(2*r*y-y*y);
if l = 0 then sx := 0 else sx := r*(x-r)/l+r;
sy := y;

if PtFInRect(PointF(sx, sy), rct) then

begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0, y0]^.rgbtRed*coefx00 + src[x1,y0]^.rgbtRed*coefx01;

r2 := src[x0, y1]^.rgbtRed*coefx00 + src[x1,y1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0, y0]^.rgbtGreen*coefx00 + src[x1,y0]^.rgbtGreen*coefx01;

 g2 := src[x0, y1]^.rgbtGreen*coefx00 + src[x1,y1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0, y0]^.rgbtBlue*coefx00 + src[x1,y0]^.rgbtBlue*coefx01;

b2 := src[x0, y1]^.rgbtBlue*coefx00 + src[x1,y1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
src.Free;

tmp.Free;
result := BmpResize(bmp, w, h);
end;

function Focus(bmp: TBitmap; percent: single = 20): Boolean;

const
mask: array[-1..1] of array[-1..1] of integer = (( -1, 0, -1),
( 0, 4, 0),
( -1, 0, -1));
var
tmp:TBitmap;
w, h, ix, iy, x, y, xx, yy: integer;
src, dst: TBmpData24;
d: PRGBTriple;
r, g, b: integer;
p: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (percent<0) or (percent>100) then exit;
w := bmp.Width;
h := bmp.Height;

p := percent/100;

tmp := BmpClone(bmp);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for iy := 0 to h-1 do
for ix := 0 to w-1 do
begin
r := 0; g := 0; b := 0;
for y := iy-1 to iy+1 do
for x := ix-1 to ix+1 do
begin
if mask[x-ix,y-iy] = 0 then continue;
if (y<0) or (y>h-1) then yy := iy else yy := y;
if (x<0) or (x>w-1) then xx := ix else xx := x;

d := src[xx,yy];

r := r + mask[x-ix,y-iy]*d^.rgbtRed;
g := g + mask[x-ix,y-iy]*d^.rgbtGreen;
b := b + mask[x-ix,y-iy]*d^.rgbtBlue;
end;
 d := dst[ix,iy];

d^.rgbtRed := AdjustByte(d^.rgbtRed + p*r);

d^.rgbtGreen := AdjustByte(d^.rgbtGreen + p*g);
d^.rgbtBlue := AdjustByte(d^.rgbtBlue + p*b)
end;

dst.Free;
src.Free;

tmp.Free;

result := true;
end;

function LineInvert(bmp: TBitmap; cx, cy, angle: single

; bkColor: TColor = clGray): Boolean;
var
tmp:TBitmap;
w, h, x, y: integer;
src, dst: TBmpData24;
a, b, dd: single;
sx, sy, sn, cs: single;
rct: TRect;

x0, x1, y0, y1: integer;

r1, r2, g1, g2, b1, b2: single;
coefx00, coefx01, coefy00, coefy01: single;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;
if (angle<0) or (angle>360) then exit;

w := bmp.Width;
h := bmp.Height;

if not PtFInRect(PointF(cx, cy), Rect(0,0,w,h)) then exit;

if Abs(cos(angle*pi/180)) < 1.0E-20 then

a := 1.0E20
else
a := sin(angle*pi/180)/cos(angle*pi/180);

b := cy- a*cx;

if (90<=angle) and (angle<270) then

begin
sn := sin((angle-90)*pi/180);
cs := cos((angle-90)*pi/180);
end
else
begin
sn := sin((angle+90)*pi/180);
cs := cos((angle+90)*pi/180);
end;

rct := Rect(0,0,w,h);

tmp := TBitmap.Create;
 tmp.PixelFormat := pf24bit;
tmp.Width := w+2;
tmp.Height := h+2;
tmp.Canvas.Brush.Color := bkColor;
tmp.Canvas.FillRect(Rect(0,0,w+2, h+2));
tmp.Canvas.Draw(1,1,bmp);

bmp.Canvas.Brush.Color := bkColor;
bmp.Canvas.FillRect(Rect(0,0,w, h));

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
begin
dd := Abs(y-a*x-b)/sqrt(1+a*a);

if y < a*x+b then

begin
sx := x + 2*dd*cs;
sy := y + 2*dd*sn;
end
else
begin
sx := x - 2*dd*cs;
sy := y - 2*dd*sn;
end;

if PtInRect(rct, Point(Ceil(sx),Ceil(sy))) or
PtInRect(rct, Point(Floor(sx),Floor(sy))) then
begin
x0 := floor(sx);
x1 := x0+1;
y0 := floor(sy);
y1 := y0+1;

coefx01 := sx-x0; coefx00 := 1-coefx01;

coefy01 := sy-y0; coefy00 := 1-coefy01;

r1 := src[x0+1, y0+1]^.rgbtRed*coefx00 + src[x1+1,y0+1]^.rgbtRed*coefx01;

r2 := src[x0+1, y1+1]^.rgbtRed*coefx00 + src[x1+1,y1+1]^.rgbtRed*coefx01;
dst[x,y]^.rgbtRed := AdjustByte(r1*coefy00 + r2*coefy01);

g1 := src[x0+1, y0+1]^.rgbtGreen*coefx00 +
src[x1+1,y0+1]^.rgbtGreen*coefx01;
g2 := src[x0+1, y1+1]^.rgbtGreen*coefx00 +
src[x1+1,y1+1]^.rgbtGreen*coefx01;
dst[x,y]^.rgbtGreen := AdjustByte(g1*coefy00 + g2*coefy01);

b1 := src[x0+1, y0+1]^.rgbtBlue*coefx00 + src[x1+1,y0+1]^.rgbtBlue*coefx01;

b2 := src[x0+1, y1+1]^.rgbtBlue*coefx00 + src[x1+1,y1+1]^.rgbtBlue*coefx01;
dst[x,y]^.rgbtBlue := AdjustByte(b1*coefy00 + b2*coefy01);
end;
end;

dst.Free;
src.Free;
 tmp.Free;
result := true;
end;

function Mirror2(var bmp: TBitmap; angle: single; bkColor: TColor): Boolean;

var
tmp: TBitmap;
w, h: integer;
a, b, cx, cy, sn, cs: single;
pt: array[0..3] of TPoint;
rgn: HRGN;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

if (angle<0) or (angle>360) then exit;

w := bmp.Width;
h := bmp.Height;

pt[0] := Point(0,0);
pt[1] := Point(w,0);
pt[2] := Point(w,h);
pt[3] := Point(0,h);

sn := sin(angle*pi/180);
cs := cos(angle*pi/180);

cx := w/2;
cy := h/2;

if sn = 0 then
begin
if angle = 0 then
begin
pt[0] := Point(0, Round(cy));
pt[1] := Point(w, Round(cy));
end
else
begin
pt[2] := Point(w, Round(cy));
pt[3] := Point(0, Round(cy));
end;
end
else
if cs = 0 then
begin
if angle = 90 then
begin
pt[1] := Point(Round(cx), 0);
pt[2] := Point(Round(cx), h);
end
else
begin
pt[0] := Point(Round(cx), 0);
pt[3] := Point(Round(cx), h);
end;
end
else
 begin
a := sn/cs;
b := cy-a*cx;
if (b >=0) and (b < h) then
begin
if (angle < 90) or (angle > 270) then
begin
pt[0] := Point(0, Round(b));
pt[1] := Point(w, Round(a*w+b));
end
else
begin
pt[3] := Point(0, Round(b));
pt[2] := Point(w, Round(a*w+b));
end;
end
else
begin
if angle < 180 then
begin
pt[1] := Point(Round(-b/a),0);
pt[2] := Point(Round((h-b)/a), h);
end
else
begin
pt[0] := Point(Round(-b/a),0);
pt[3] := Point(Round((h-b)/a), h);
end;
end;
end;

tmp := BmpClone(bmp);
LineInvert(tmp, cx, cy, angle, bkColor);

rgn := CreatePolygonRgn(pt, 4, WINDING);

SelectClipRgn(bmp.Canvas.Handle, rgn);
bmp.Canvas.Draw(Round(cx-tmp.Width/2), Round(cy-tmp.Height/2), tmp);
SelectClipRgn(bmp.Canvas.Handle, 0);
DeleteObject(rgn);

tmp.Free;
result := true;
end;

function Mirror3(var bmp: TBitmap; cx, cy, angle: single; bkColor: TColor):
Boolean;
var
tmp: TBitmap;
w, h, x, y: integer;
src, dst: TBmpData24;
a, b, sn, cs: single;
fUp: Boolean;
begin
result := false;
if bmp.PixelFormat <> pf24bit then exit;

if (angle<0) or (angle>360) then exit;

w := bmp.Width;
 h := bmp.Height;

sn := sin(angle*pi/180);
cs := cos(angle*pi/180);

if Abs(cs) < 1.0E-20 then a := 1.0E20 else a := sn/cs;

b := cy- a*cx;

if (90<=angle) and (angle<270) then fUp := true else fUp := false;

tmp := BmpClone(bmp);
LineInvert(tmp, cx, cy, angle, bkColor);

src := TBmpData24.Create(tmp);
dst := TBmpData24.Create(bmp);

for y := 0 to h-1 do
for x := 0 to w-1 do
if fUp then
begin
if (a*x+b>y) then dst[x,y]^ := src[x,y]^;
end
else
begin
if (a*x+b<y) then dst[x,y]^ := src[x,y]^;
end;

dst.Free;
src.Free;

tmp.Free;
result := true;
end;

end.