0% found this document useful (0 votes)
62 views104 pages

VCL Image Utilities and Color Constants

VCLImageUtils pascal

Uploaded by

lexman 771
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
62 views104 pages

VCL Image Utilities and Color Constants

VCLImageUtils pascal

Uploaded by

lexman 771
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd

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 [Link](bmp: TBitmap);


var
i: integer;
begin
SetLength(sl, [Link]);
for i := 0 to [Link]-1 do sl[i] := [Link][i];
FWidth := [Link];
FHeight := [Link];
end;

destructor [Link];
begin

inherited;
end;

function [Link](x, y: integer):PRGBTriple;


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

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

constructor [Link](bmp: TBitmap);


var
i: integer;
begin
SetLength(sl, [Link]);
for i := 0 to [Link]-1 do sl[i] := [Link][i];
FWidth := [Link];
FHeight := [Link];
end;

destructor [Link];
begin

inherited;
end;

function [Link](x, y: integer):PByte;


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

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


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

destructor [Link];
begin

inherited;
end;

function [Link](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 [Link](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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
begin
[Link];
exit;
end;
if Stretch then
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
[Link];
exit;
end;

bmp4 := [Link];
[Link] := pf4bit;
[Link] := w;
[Link] := 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([Link],0,15,ct);
DeleteObject([Link]);

src := [Link](tmp8);
dst := [Link](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;

[Link];
[Link];
[Link];
[Link];
bmp := bmp4;
result := true;
end;

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

constructor [Link](bmp: TBitmap);


var
i: integer;
begin
SetLength(sl, [Link]);
for i := 0 to [Link]-1 do sl[i] := [Link][i];
FWidth := [Link];
FHeight := [Link];
end;

destructor [Link];
begin

inherited;
end;

function [Link](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 [Link](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 := [Link];
try
[Link](filename);
try
result := [Link];
[Link](png);

except
FreeAndNil(result);
end;
finally
[Link];
end;
end;

function LoadGif(filename: string): TBitmap;


var
gif: TGifImage;
begin
result := nil;
gif := [Link];
try
[Link](filename);
result := [Link];
try
[Link](gif);
except
FreeAndNil(result);
end;
finally
[Link];
end;
end;

function LoadJpeg(filename: string): TBitmap;


var
jpg: TJpegImage;
begin
result := nil;

jpg := [Link];
try
[Link](filename);
result := [Link];
try
[Link](jpg);
except
FreeAndNil(result)
end;
finally
[Link];
end;
end;

function BmpClone(bmp: TBitmap): TBitmap;


begin
result := [Link];
[Link](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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

dst := [Link](bmp);
src := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);
[Link] := h;
[Link] := w;

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;
[Link];
[Link];

[Link];
result := true;
end;

function PaletteEntryBmp(bmp8: TBitmap): TBitmap;


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

with [Link] do
begin
[Link] := clGray;
for i := 0 to num-1 do
begin
[Link] := 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([Link],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([Link],0,num,ct);
DeleteObject([Link]);
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
begin
[Link];
exit;
end;
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
[Link];
exit;
end;

bmp4 := [Link];
[Link] := pf4bit;
[Link] := w;
[Link] := 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([Link],0,15,ct);
DeleteObject([Link]);

src := [Link](tmp8);
dst := [Link](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;

[Link];
[Link];
[Link];
[Link];
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 := [Link];
h := [Link];

src := [Link](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*[Link] + 0.587*[Link] + 0.114*[Link])]);
end;

[Link];

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 := [Link];
[Link] := pf8bit;
[Link] := 275;
[Link] := 160;

with [Link] do
begin
[Link] := clGray;
for i := 0 to 255 do
begin
MoveTo(10+i,150);
LineTo(10+i,150-Hist[i]);
end;
[Link] := 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 := [Link];
h := [Link];

src := [Link](bmp);

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

[Link];

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 := [Link];
[Link] := pf8bit;
[Link] := 275;
[Link] := 160;

with [Link] do
begin
[Link] := clSilver;
FillRect(Rect(0, 0, 275, 160));

[Link] := 2;

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


[Link] := clRed;
PolyLine(pt);

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


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

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


[Link] := clBlack;
PolyLine(pt);

[Link] := 1;

[Link] := 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([Link],0,255,ct);
DeleteObject([Link]);
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

bmp8 := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := h;

SetGrayPalette(bmp8);

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp8 := BmpClone(bmp);
if not GrayScale(tmp8) then
begin
[Link];
exit;
end;
if stretch then
// if not HistoStretchGray(tmp8) then
if not HistoStretch(tmp8) then
begin
[Link];
exit;
end;

bmp1 := [Link];
[Link] := pf1bit;
[Link] := w;
[Link] := 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([Link],0,2,ct);
DeleteObject([Link]);

src := [Link](tmp8);
dst := [Link](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;

[Link];
[Link];
[Link];
[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

rr := 255*percent div 100;

bd := [Link](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;

[Link];

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 [Link] <> pf24bit then exit;

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

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

w := [Link];
h := [Link];

bd := [Link](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;

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 := [Link];
h := [Link];
src := [Link](bmp24);

tl := [Link];
try
[Link] := 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);
[Link](pointer(c));
end;
end;
[Link](CompInt);
result := 1;
for i := 1 to [Link]-1 do
if integer(tl[i-1]) <> integer(tl[i]) then inc(result);
finally
[Link];
end;

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

bmp8 := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := 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([Link],0,256,ct);
DeleteObject([Link]);
src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
if (dGamma < 0.2) or (dGamma > 5.0) then exit;
w := [Link];
h := [Link];

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

bd := [Link](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;

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

bd := [Link](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([Link]*fRed);
bd[ix,iy]^.rgbtGreen := AdjustByte([Link]*fGreen);
bd[ix,iy]^.rgbtBlue := AdjustByte([Link]*fBlue);
end;

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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

bd := [Link](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([Link]*(SatCompR+level)+
[Link]*SatCompG+
[Link]*SatCompB);

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

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

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

rate := percent/100;

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

rate := percent/100;

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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

rl := [Link]; [Link] := num; [Link] := num;


gl := [Link]; [Link] := num; [Link] := num;
bl := [Link]; [Link] := num; [Link] := num;

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link](ColorSort);
[Link](ColorSort);
[Link](ColorSort);

d := dst[ix,iy];

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

[Link];
[Link];
[Link];
[Link];
[Link];

[Link];

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 := [Link]/255;
g := [Link]/255;
b := [Link]/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 [Link] <> pf24bit then exit;


w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;


w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];
[Link];

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 [Link] <> pf8bit then exit;
w := [Link];
h := [Link];

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

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

bd := [Link](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));

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

bmp1 := [Link];
[Link] := pf1bit;
[Link] := w;
[Link] := h;

GrayScale(bmp24);

src := [Link](bmp24);
dst := [Link](bmp1);

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

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

bmp1 := [Link];
[Link] := pf1bit;
[Link] := w;
[Link] := 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([Link],0,2,ct);
DeleteObject([Link]);

GrayScale(bmp24);

if Stretch then HistoStretch(bmp24);

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

src := [Link](bmp24);
dst := [Link](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;

[Link];
[Link];
[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

GrayScale(bmp24);

if stretch then HistoStretch(bmp24);

bmp1 := [Link];
[Link] := pf1bit;
[Link] := w;
[Link] := 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([Link],0,2,ct);
DeleteObject([Link]);

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

src := [Link](bmp24);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);
[Link] := rwidth;
[Link] := rheight;
src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];
[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

bd := [Link](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;

[Link];

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

result := [Link];
[Link] := pf24bit;
[Link] := 370;
[Link] := 160;

for i := 0 to 359 do
begin
HSLToRGB(@c, i, 60, 40);
[Link] := RGB([Link], [Link], [Link]);
[Link](5+i, 155);
[Link](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
[Link] := AC_SRC_OVER;
[Link] := 0;
[Link] := Round(alpha*255/100);
[Link] := 0;
result := [Link]([Link], dstX, dstY, [Link],
[Link],[Link], 0, 0, [Link], [Link], 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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;
[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf24bit;
[Link] := w+2;
[Link] := h+2;
[Link] := bkColor;
[Link](Rect(0,0,w+2,h+2));
[Link](1, 1, bmp);
[Link];
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 := [Link];
[Link] := pf24bit;
[Link] := ww;
[Link] := hh;
[Link] := bkColor;
[Link](Rect(0,0,ww,hh));

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

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
if (zone < 1) or (zone > 30) then exit;

w := [Link];
h := [Link];

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 := [Link](tmp);
dst := [Link](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+[Link]*gauss;
sg := sg+[Link]*gauss;
sb := sb+[Link]*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+[Link]*gauss;
sg := sg+[Link]*gauss;
sb := sb+[Link]*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;

[Link];
[Link];
[Link];

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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
if area < 2 then exit;
w := [Link];
h := [Link];

src := [Link](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;

[Link] := b div count;


[Link] := g div count;
[Link] := 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;

[Link];
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 [Link] <> pf24bit then exit;
if area < 2 then exit;
w := [Link]+1;
h := [Link]+1;

src := [Link](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[[Link]+ix, [Link]+iy];
b := b + d^.rgbtBlue;
g := g + d^.rgbtGreen;
r := r + d^.rgbtRed;
inc(count);
end;
end;

[Link] := b div count;


[Link] := g div count;
[Link] := 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[[Link]+ix, [Link]+iy]^ := t;
end;
end;

end;
end;

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
result := true;
end;

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


begin
result := (pt.X >= [Link]) and (pt.X <= [Link]) and
(pt.Y >= [Link]) and (pt.Y <= [Link]);
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;
[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);
[Link] := clGray;
[Link](rct);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
if (factor<0.1) or (factor>1.1) then exit;

w := [Link];
h := [Link];

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);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);
[Link] := clBlack;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
if area < 10 then exit;

w := [Link];
h := [Link];

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;
[Link](Rect(xx, yy, xx+nd, yy+nd), [Link],
Rect(ix, iy, ix+nd, iy+nd));

end;
end;

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

dst := [Link](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;

[Link];

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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

dst := [Link](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([Link]*(SatCompR+c)+
[Link]*SatCompG+
[Link]*SatCompB);

bd^.rgbtGreen := AdjustByte([Link]*SatCompR+
[Link]*(SatCompG+c)+
[Link]*SatCompB);

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

b := Trunc(0.3086*[Link] + 0.6094*[Link] + 0.0820*[Link]);


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

[Link];

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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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 := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

result := true;
end;

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


Boolean;
var
tmp: TBitmap;
w, h: integer;
begin
result := false;
if [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf24bit;
[Link] := w;
[Link] := h;
[Link] := RGB($ee,$ee,$ee);
[Link](Rect(0,0,w,h));

JAlphaBlend([Link], 0, 0, bmp, alpha);


GaussianBlur(tmp, fBlur);

[Link](rct,[Link],rct);

[Link];
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 := [Link];
h := [Link];
ww := w + ShadowWidth+2+Margin*2;
hh := h + ShadowWidth+2+Margin*2;

tmp := [Link];
[Link] := pf24bit;
[Link] := ww;
[Link] := hh;
[Link] := backcolor;
[Link](Rect(0,0,ww,hh));

p := ShadowWidth+Margin;
if ShadowWidth > 5 then
[Link] := $606060
else
[Link] := $404040;
[Link](Rect(p, p, p+w, p+h));

GaussianBlur(tmp, 3);

[Link](Margin, Margin, bmp);

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf24bit;
[Link] := w;
[Link] := h;

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];
[Link];
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 := [Link];
dh := [Link];
sw := [Link];
sh := [Link];

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

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

if ([Link]<sw) or ([Link]<sh) then exit;

d := [Link](dst);
s := [Link](src);
m := [Link](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;

[Link];
[Link];
[Link];
end;

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


var
bd: TBmpData8;
x, y: integer;
r, cx, cy, rr: single;
c: integer;
begin
result := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := h;
SetGrayPalette(result);

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

bd := [Link](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;

[Link];
end;

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


var
bd: TBmpData8;
x, y: integer;
begin
result := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := h;

SetGrayPalette(result);

bd := [Link](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;

[Link];
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 := [Link];
try
try
[Link](filename);
a := [Link];
result := [Link];
if AsCodecBmpCheckFileHeader18(a) then
begin
[Link](ms);
end
else
if AsCodecGifCheckFileHeader6(a) then
begin
gif := [Link];
try
[Link](ms);
[Link](gif);
finally
[Link];
end;
end
else
if AsCodecJpgCheckFileHeader2(a) then
begin
jpg := [Link];
try
[Link](ms);
[Link](jpg);
finally
[Link];
end;
end
else
begin
png := [Link];
try
try
[Link](ms);
[Link](png);
except
FreeAndNil(result)
end;
finally
[Link];
end;
end;
except
FreeAndNil(result);
end;
finally
[Link];
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 := [Link];
[Link] := pf24bit;
[Link] := width;
[Link] := height;
rct := Rect(0,0,width, height);
[Link] := bkColor;
[Link](rct);
img := LoadCheckedImage(filename);
if Assigned(img) then
begin
[Link] := pf24bit;
s1 := width/height;
w := [Link];
h := [Link];
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);
[Link](Round((width-w)/2),Round((height-h)/2), img);
[Link];
end
else
DrawText([Link],'No Image', 8, rct,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);

if frame then begin


[Link] := bsClear;
[Link](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 [Link] <> pf24bit then exit;
if area < 2 then exit;
w := [Link];
h := [Link];

bd := [Link](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 + [Link];
g := g + [Link];
r := r + [Link];
inc(count);
end;
end;

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

[Link] := b;
[Link] := g;
[Link] := r;

[Link] := AdjustByte([Link]*1.2);
[Link] := AdjustByte([Link]*1.2);
[Link] := AdjustByte([Link]*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;

[Link];
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 [Link] <> pf24bit then exit;
if (percent<0) or (percent>100) then exit;

w := [Link];
h := [Link];

r := percent/100;

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

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf1bit;
[Link] := w;
[Link] := h;

r3 := sqrt(3.0);

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := h;
SetGrayPalette(tmp);

r3 := sqrt(3.0);

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

if Stretch then HistoStretch(tmp);

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

tmp := [Link];
[Link] := pf24bit;
[Link] := w+2;
[Link] := h+2;
[Link] := bkColor;
[Link](Rect(0,0,w+2,h+2));
[Link](1, 1, bmp);
[Link];
bmp := tmp;

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

tmp := [Link];
[Link] := pf24bit;
[Link] := ww;
[Link] := hh;
[Link] := bkColor;
[Link](Rect(0,0,ww,hh));

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];
if deform > h*0.8 then exit;

angle := ArcTan2(deform, h);

tmp := [Link];
[Link] := pf24bit;
[Link] := w+2;
[Link] := h+2;
[Link] := bkColor;
[Link](Rect(0,0,w+2,h+2));
[Link](1, 1, bmp);
[Link];
bmp := tmp;

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

tmp := [Link];
[Link] := pf24bit;
[Link] := ww;
[Link] := hh;
[Link] := bkColor;
[Link](Rect(0,0,ww,hh));

src := [Link](bmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

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

tmp2 := [Link];
[Link] := pf8bit;
[Link] := w;
[Link] := h;
SetGrayPalette(tmp2);

for x := 0 to partition-1 do
for y := 0 to partition-1 do
[Link](ww*x, hh*y, tmp1);
[Link];

dst := [Link];
[Link] := pf24bit;
[Link] := w;
[Link] := h;

src := [Link](bmp);
tgt := [Link](dst);
mask := [Link](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;

[Link];
[Link];
[Link];

[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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 := [Link];
[Link] := pf24bit;
[Link] := www;
[Link] := hhh;
[Link](0,0,www, hhh);

dst := [Link];
[Link] := pf24bit;
[Link] := www*hdiv + margin*2;
[Link] := hhh*vdiv + margin*2;

for x := 0 to [Link] div [Link] do


for y := 0 to [Link] div [Link] do
[Link]([Link]*x, [Link]*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));
[Link](dstRct, [Link], srcRct);
[Link](margin+www*x+Random(5)-2, margin+hhh*y+Random(5)-2, tmp);
end;

[Link];
[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];
[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];
[Link];
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 [Link] <> pf24bit then exit;
if [Link] <> pf24bit then exit;
if ([Link]>[Link]) or ([Link]>[Link]) then exit;

w := [Link];
h := [Link];

p := percent/100;

if negative then Invert(modu);


GrayScale(modu);
HistoStretch(modu);

src := [Link](bmp);
mdu := [Link](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;

[Link];
[Link];

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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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);
[Link] := clGray;
[Link](Rect(0,0,w,h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
w := [Link];
h := [Link];

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);
[Link] := bkColor;
[Link](Rect(0,0,q,q));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;

w := [Link];
h := [Link];

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

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

tmp := BmpClone(bmp);
[Link] := bkColor;
[Link](Rect(0,0,q,q));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
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 [Link] <> pf24bit then exit;
if (percent<0) or (percent>100) then exit;
w := [Link];
h := [Link];

p := percent/100;

tmp := BmpClone(bmp);

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];

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 [Link] <> pf24bit then exit;
if (angle<0) or (angle>360) then exit;

w := [Link];
h := [Link];

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 := [Link];
[Link] := pf24bit;
[Link] := w+2;
[Link] := h+2;
[Link] := bkColor;
[Link](Rect(0,0,w+2, h+2));
[Link](1,1,bmp);

[Link] := bkColor;
[Link](Rect(0,0,w, h));

src := [Link](tmp);
dst := [Link](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;

[Link];
[Link];
[Link];
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 [Link] <> pf24bit then exit;

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

w := [Link];
h := [Link];

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([Link], rgn);
[Link](Round([Link]/2), Round([Link]/2), tmp);
SelectClipRgn([Link], 0);
DeleteObject(rgn);

[Link];
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 [Link] <> pf24bit then exit;

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

w := [Link];
h := [Link];

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 := [Link](tmp);
dst := [Link](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;

[Link];
[Link];

[Link];
result := true;
end;

end.

Common questions

Powered by AI

The function AdjustByte plays a critical role in image transformations by ensuring that pixel intensity values stay within the valid range (0 to 255) after calculations. When modifying pixel components through algorithms that increase or decrease intensity, AdjustByte verifies and bounds these values to prevent overflow or underflow, which could result in display errors or artifacts. This step is essential in maintaining image data integrity after applying operations like contrast adjustment, filtering, and color alterations .

Although not explicitly stated in the provided document summaries, functions like those for edge detection (e.g., Sobel, Laplacian) implicitly rely on Fourier Transform principles. The Fourier Transform would decompose the image into frequency components, allowing analysis of high-frequency areas corresponding to edges. By applying convolution in the spatial domain, these methods exploit principles similar to those in frequency domain transformations but instead directly compute edge magnitude and direction .

The BlackWhiteFloydStucci2 function uses the Floyd-Steinberg dithering algorithm. It first converts the image to grayscale and applies histogram stretching. The function processes each pixel, comparing its intensity to a threshold to decide whether to set it to the dark or bright color. The error (difference between the original and converted value) is calculated and distributed to neighboring pixels using predefined coefficients (7/16, 5/16, 3/16, and 1/16) to ensure smoother transitions and reduce visual artifacts .

The Fisheye function distorts an image by applying a non-linear transformation that simulates the effect of a fisheye lens. The transformation is centered at the image's midpoint; each pixel is relocated based on its radial distance from the center. The new position is calculated using the square root of the distance and scaled by a constant factor, adjusting both x and y coordinates with trigonometric functions (cosine and sine) of the angle. This distortion compresses regions towards the center while expanding peripheral areas, creating a spherical appearance characteristic of fisheye effects .

The Swirl function applies a nonlinear transformation to an image, producing a swirling effect around its center. This distortion is achieved by adjusting the position of each pixel based on radial distance and angle. For each pixel, the angle is incremented proportional to its distance from the center, a factor that introduces a rotation while maintaining radial integrity. The transformation uses cosine and sine functions to compute new coordinates, resulting in a twisted appearance that visually spirals the image content .

The Laplacian function differs from the Sobel function as it uses a single convolution mask that detects edges by emphasizing regions where intensity values significantly diverge from the surrounding pixels. Unlike Sobel, which uses directional gradients, Laplacian focuses on areas with sharp intensity changes in all directions. It strengthens edges but can be more sensitive to noise. The output adds 127 to the calculated value for normalization, converting negative values for display purposes. The function can optionally convert the image to grayscale after processing .

The Grayscale function first checks if the image's pixel format is 24-bit. It then creates an 8-bit bitmap of the same dimensions as the original. The function uses the SetGrayPalette procedure to set the grayscale palette for the new image. It iterates over each pixel, calculates a weighted sum of the red, green, and blue components using the formula 0.299*Red + 0.587*Green + 0.114*Blue, and assigns this value to the corresponding pixel in the 8-bit image. This process ensures that the converted image maintains the luminance of the original colors .

The Contrast function adjusts the contrast of a bitmap by scaling pixel intensity based on a user-defined contrast value. The provided contrast level is transformed into a multiplication factor through the relation (100 + nContrast) / 100, which is then squared for increased sensitivity. The function iterates over each pixel, modifying its red, green, and blue components using the formula ((component/255 - 0.5) * factor + 0.5) * 255, which centers the pixel intensity, scales it, and re-centers it. This approach stretches or compresses the dynamic range around midtones to enhance or reduce contrast .

To enhance edges, the EdgeEnhance function applies a convolution mask that emphasizes the difference between each pixel and its neighbors. By attenuating the contributions of the central pixel and enhancing neighboring pixels, it increases contrast along edges. The resulting values are scaled by a factor derived from the input percentage to control enhancement intensity, modifying the original pixel values accordingly. The function iteratively applies this process to improve edge definition while reducing the impact on uniform regions of the image .

The Sobel function is an edge detection technique in image processing that emphasizes the edges by calculating the gradient magnitude of the bitmap. It applies horizontal and vertical convolution masks to identify changes in intensity, marking areas where there is a significant change. For each pixel, it calculates horizontal and vertical gradient components, combines them to determine edge strength, and assigns adjusted values to highlight edges. If fGray is true, the resulting image is converted to grayscale to simplify viewing of the detected edges .

You might also like