unit aspixmap;
{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}
interface
uses
Windows, SysUtils, Types, Classes, Math, Graphics, UITypes, ascolors, asnum,
Generics.Defaults, Generics.Collections, GenHelpers;
type
EPixmapException = class(Exception);
{$POINTERMATH ON}
PASPixel = ^TASPixel;
{$POINTERMATH OFF}
TASPixel = packed record
public
Blue,
Green,
Red,
Alpha: Byte;
class operator Implicit(const AColor: TColor): TASPixel; inline;
class operator Implicit(const APixel: TASPixel): TColor; inline;
class operator Implicit(const AColor: TRGB): TASPixel;
class operator Implicit(const APixel: TASPixel): TRGB;
class operator Add(const APixel1, APixel2: TASPixel): TASPixel; inline;
class operator Subtract(const APixel1, APixel2: TASPixel): TRealVector; inline;
class operator Multiply(const AFactor: Double;
const APixel: TASPixel): TASPixel; inline;
class operator Equal(const APixel1, APixel2: TASPixel): Boolean; inline;
class operator NotEqual(const APixel1, APixel2: TASPixel): Boolean; inline;
function WithoutAlpha: TASPixel; inline;
function Sum: Integer; inline;
function Average: Byte; inline;
function IsGrey: Boolean; inline;
class function GetRandomPixel: TASPixel; inline; static;
end;
function pxli(R, G, B: Byte; A: Byte = 255): TASPixel; overload; inline;
function pxlf(const R, G, B: Double; const A: Double = 1): TASPixel; overload; inline;
function pxli(AGreyLevel: Byte): TASPixel; overload; inline;
function pxlf(AGreyLevel: Double): TASPixel; overload; inline;
function ComparePixel(const A, B: TASPixel): TValueRelationship;
function SamePixel(const A, B: TASPixel): Boolean; inline;
type
TBlendMode = (bmNormal, bmAverage, bmGeometricMean, bmHarmonicMean, bmLighten,
bmDarken, bmAdd, bmAddRed, bmSubtract, bmInvSubtract, bmIncSubtract,
bmInvIncSubtract, bmDistance, bmNegation, bmExclusion, bmMultiply, bmScreen,
bmSoftLight, bmHardLight, bmOverlay, bmDodge, bmInvDodge, bmBurn, bmInvBurn,
bmReflect, bmInvReflect, bmFreeze, bmInvFreeze, bmStamp, bmInvStamp, bmCosine,
bmXor, bmAnd, bmOr, bmRed, bmYellow, bmGreen, bmCyan, bmBlue, bmMagenta,
bmHue, bmSaturation, bmValue, bmLightness, bmDissolve, bmPartialDissolve);
const
BlendModeNames: array[TBlendMode] of string = ('Normal', 'Average',
'Geometric mean', 'Harmonic mean', 'Lighten', 'Darken', 'Add', 'Reduced add',
'Subtract', 'Inverse subtract', 'Increased subtract',
'Inverse increased subtract', 'Distance', 'Negation', 'Exclusion', 'Multiply',
'Screen', 'Soft light', 'Hard light', 'Overlay', 'Dodge', 'Inverse dodge',
'Burn', 'Inverse burn', 'Reflect', 'Inverse reflect', 'Freeze',
'Inverse freeze', 'Stamp', 'Inverse Stamp', 'Cosine', 'Xor', 'And', 'Or',
'Red', 'Yellow', 'Green', 'Cyan', 'Blue', 'Magenta', 'Hue', 'Saturation',
'Value', 'Lightness', 'Dissolve', 'Partial dissolve');
type
TBlendModeHelper = record helper for TBlendMode
function AsString: string;
class function FromString(const AName: string): TBlendMode; static;
end;
const
clRandom = TColor($30000000);
type
TPredefinedKernel = (pkIdentity3, pkBoxBlur3, pkBoxBlur5, pkGaussianBlur3,
pkGaussianBlur5, pkUnsharpMasking5, pkSharpen3, pkEdgeDetect3_1,
pkEdgeDetect3_2,pkEdgeDetect3_3, pkEdgeDetect3_4, pkEdgeDetect3_5,
pkSobel3_1, pkSobel3_2, pkEmboss3);
const PredefinedKernelNames: array[TPredefinedKernel] of string = ('3×3 identity',
'3×3 box blur', '5×5 box blur', '3×3 Gaussian blur', '5×5 Gaussian blur',
'5×5 unsharp masking', '3×3 sharpen', '3×3 edge detector 1', '3×3 edge detector 2',
'3×3 edge detector 3', '3×3 edge detector 4', '3×3 edge detector 5',
'3×3 Sobel 1', '3×3 Sobel 2', '3×3 emboss');
type
TRGBAdjustmentParameter = record
Constant,
RedFactor,
GreenFactor,
BlueFactor: Double;
Overflow: Boolean;
end;
TRGBAdjustmentParameters = record
public
procedure Init;
var
case Boolean of
True: (ComponentParts: array[0..2] of TRGBAdjustmentParameter);
False:
(
RedParams,
GreenParams,
BlueParams: TRGBAdjustmentParameter;
)
end;
THSVAdjustmentParameter = record
Constant,
HueFactor,
SaturationFactor,
ValueFactor: Double;
Overflow: Boolean;
end;
THSVAdjustmentParameters = record
public
procedure Init;
var
case Boolean of
True: (ComponentParts: array[0..2] of THSVAdjustmentParameter);
False:
(
HueParams,
SaturationParams,
ValueParams: THSVAdjustmentParameter;
)
end;
TTransformFunc = reference to function(const AVect: TRealVector): TRealVector;
TEdgeDetectionDirection = (eddHorizontal, eddVertical);
TEdgeDetectionDirections = set of TEdgeDetectionDirection;
TRandomColorFunction = reference to function: TColor;
TIndexColorFunction = reference to function(Idx: Integer): TColor;
TPixmapColorFcn = reference to function(X, Y: Integer): TColor;
TRGBChannelType = (rgbRed, rgbGreen, rgbBlue);
THSVChannelType = (hsvHue, hsvSaturation, hsvValue);
THSLChannelType = (hslHue, hslSaturation, hslLightness);
TImageFormat = (ifFromExtension, ifBitmap, ifPNG, ifJPG);
TGetPixelFcn = reference to function(X, Y: Integer): TASPixel;
TASPixmap = record
strict private
type
TOpacitySource = (osParameter, osChannel);
TOpacitySources = set of TOpacitySource;
TRGBBlendFunc = function(const APixel1, APixel2: Double): Double;
var
FWidth,
FHeight: Integer;
FBackgroundColor: TASPixel;
FPixels: array of TASPixel;
FPenPos: TPoint;
procedure Alloc(AWidth: Integer; AHeight: Integer);
procedure SetHeight(const Value: Integer);
procedure SetWidth(const Value: Integer);
function GetData: PASPixel; inline;
function GetLineData(Line: Integer): PASPixel; inline;
function GetPixelCount: Integer; inline;
function GetColorCount: Integer;
function GetMemoryUsage: Integer; inline;
function GetPixel(X, Y: Integer): TASPixel; inline;
procedure SetPixel(X, Y: Integer; const Value: TASPixel); inline;
function GetPixelSafe(X, Y: Integer): TASPixel; inline;
procedure SetPixelSafe(X, Y: Integer; const Value: TASPixel); inline;
function GetPixelInR2(X, Y: Integer): TASPixel; inline;
procedure SetPixelInR2(X, Y: Integer; const Value: TASPixel); inline;
function RGBBlend(const APixel1, APixel2: TRGB;
AFunc: TRGBBlendFunc): TRGB; inline;
function PixelBlend(const APixel1, APixel2: TRGB;
const BlendMode: TBlendMode): TRGB; overload;
function PixelBlend(const APixel1, APixel2: TASPixel;
const BlendMode: TBlendMode;
const AOpacity: Double): TASPixel; overload; inline;
procedure InternalDraw(const APixmap: TASPixmap; X: Integer = 0;
Y: Integer = 0; AOpacitySources: TOpacitySources = [];
const AOpacity: Double = 1; ABlendMode: TBlendMode = bmNormal);
function ApplyRGBAdjustments(const APixel: TRGB;
const RGBAdjustment: TRGBAdjustmentParameters): TRGB;
function ApplyHSVAdjustments(const APixel: THSV;
const HSVAdjustment: THSVAdjustmentParameters): THSV;
function IsEmptyRow(ARow: Integer): Boolean; inline;
function IsEmptyCol(ACol: Integer): Boolean; inline;
procedure SetPixelsFrom(const tmp: TASPixmap); inline;
public
constructor Create(AWidth, AHeight: Integer; const AColor: TASPixel;
const ABackgroundColor: TASPixel); overload;
constructor Create(AWidth, AHeight: Integer; const AColor: TASPixel); overload;
constructor Create(AWidth, AHeight: Integer); overload;
constructor CreateUninitialized(AWidth, AHeight: Integer);
constructor Create(ABitmap: TBitmap); overload;
constructor Create(const APixmap: TASPixmap); overload;
class operator Implicit(ABitmap: TBitmap): TASPixmap;
class operator Equal(const APixmap1, APixmap2: TASPixmap): Boolean;
class operator NotEqual(const APixmap1, APixmap2: TASPixmap): Boolean; inline;
class function SameSize(const APixmaps: array of TASPixmap): Boolean; static;
function CreateGDIBitmap: TBitmap;
procedure SaveToFile(const AFileName: TFileName;
AFormat: TImageFormat = ifFromExtension); overload;
procedure SaveToFile(ADlgOwner: TComponent;
const ADefFileName: string = ''); overload;
procedure DrawTo(ACanvas: TCanvas; X: Integer = 0; Y: Integer = 0);
procedure AssignToBitmap(ABitmap: TBitmap);
procedure AssignFromBitmap(ABitmap: TBitmap);
procedure CopyToClipboard;
function Clone: TASPixmap;
function CloneWithBorder(ABorderWidth: Integer;
ABorderColor: TColor): TASPixmap; overload; inline;
function CloneWithBorder(ABorderWidthX, ABorderWidthY: Integer;
ABorderColor: TColor): TASPixmap; overload;
function CloneWithBorderExtension(ABorderWidth: Integer): TASPixmap; overload; inline;
function CloneWithBorderExtension(ABorderWidthX,
ABorderWidthY: Integer): TASPixmap; overload;
property Data: PASPixel read GetData;
property LineData[Line: Integer]: PASPixel read GetLineData;
property Pixels[X, Y: Integer]: TASPixel read GetPixel write SetPixel; default;
property SafePixels[X, Y: Integer]: TASPixel read GetPixelSafe write SetPixelSafe;
property PixelsInR2[X, Y: Integer]: TASPixel read GetPixelInR2
write SetPixelInR2;
property Width: Integer read FWidth write SetWidth;
property Height: Integer read FHeight write SetHeight;
property PixelCount: Integer read GetPixelCount;
function CreateColorFreqDict: TDictionary<TColor, integer>;
property ColorCount: Integer read GetColorCount;
property PenPos: TPoint read FPenPos write FPenPos;
property BackgroundColor: TASPixel read FBackgroundColor
write FBackgroundColor;
property MemoryUsage: Integer read GetMemoryUsage;
function PixelExists(const APoint: TPoint): Boolean; overload; inline;
function PixelExists(X, Y: Integer): Boolean; overload; inline;
procedure SetSize(AWidth, AHeight: Integer);
procedure Clear; inline;
procedure Fill(const AColor: TASPixel);
procedure FillRect(const ARect: TRect; const AColor: TASPixel);
procedure Free;
procedure Draw(const APixmap: TASPixmap; X: Integer = 0;
Y: Integer = 0); overload;
procedure Draw(const APixmap: TASPixmap; X: Integer; Y: Integer;
const AOpacity: Double; ABlendMode: TBlendMode = bmNormal); overload;
procedure AlphaDraw(const APixmap: TASPixmap; X: Integer = 0;
Y: Integer = 0); overload;
procedure AlphaDraw(const APixmap: TASPixmap; X, Y: Integer;
const AOpacity: Double; ABlendMode: TBlendMode = bmNormal); overload;
procedure FixHue(const AHue: Double);
procedure ToMonochromatic(const AHue: Double);
procedure ShiftHue(const AAmount: Double);
procedure ToGreyscale;
procedure Invert;
procedure InvertValue;
procedure InvertLightness;
procedure RGBAdjustments(const RGBAdjustments: TRGBAdjustmentParameters);
procedure HSVAdjustments(const HSVAdjustments: THSVAdjustmentParameters);
procedure Binarize(const AThreshold: Double = 0.5);
procedure FlipHorizontally;
procedure FlipVertically;
procedure Rot90P;
procedure Rot90N;
procedure Rot180;
procedure HorizontalRotation(AAmount: Integer);
procedure VerticalRotation(AAmount: Integer);
procedure CustomHorizontalRotation(AFunction: TFunc<Integer, Integer>);
procedure CustomVerticalRotation(AFunction: TFunc<Integer, Integer>);
procedure HorizontalSkewRotation(ADelta: Integer; ADenominator: Integer = 100);
procedure VerticalSkewRotation(ADelta: Integer; ADenominator: Integer = 100);
procedure Scale(const AFactor: Double); inline;
procedure Stretch(const AXFactor, AYFactor: Double);
procedure Rotate(const AAngle: Double);
procedure Shear(const AAngle: Double);
procedure LinearTransform(const AMatrix: TRealMatrix); overload;
procedure LinearTransform(const A, B, C, D: TASR); overload; inline;
procedure CustomTransform(const AFunc: TTransformFunc);
function GetRect(const ARect: TRect): TASPixmap;
function AverageColor(const ARect: TRect): TRGB; overload;
function AverageColor: TRGB; overload;
function AverageColorF(const ARect: TRect): TRGB; overload;
function AverageColorF: TRGB; overload;
procedure CropTo(const ARect: TRect);
function GetAutoCropRect: TRect;
procedure AutoCrop;
procedure ExpandCanvas(AByX, AByY: Integer); overload;
procedure ExpandCanvas(ABy: Integer); overload; inline;
procedure AddBorder(ABorderWidthX, ABorderWidthY: Integer; ABorderColor: TColor); overload;
procedure AddBorder(ABorderWidth: Integer; ABorderColor: TColor); overload; inline;
function OnlyBackground: Boolean;
procedure EdgeDetect(ADirections: TEdgeDetectionDirections);
procedure Emboss(ADirections: TEdgeDetectionDirections);
procedure Pixelate(APixelWidth, APixelHeight: Integer); overload;
procedure Pixelate(APixelSize: Integer); overload; inline;
procedure Noise(AProbability: Double = 0.5; AColor: TColor = clWhite);
procedure DistortMetric(ARadiusX, ARadiusY: Integer); overload;
procedure DistortMetric(ARadius: Integer); overload; inline;
procedure DistortColor(ARedDistance, AGreenDistance, ABlueDistance: Integer); overload;
procedure DistortColor(ADistance: Integer); overload; inline;
procedure Tiles(ANumRows, ANumCols: Integer; APadding: Integer = 1;
AShuffle: Boolean = True);
procedure ComponentHighlight(AIndexColorFcn: TIndexColorFunction = nil);
procedure FloodFill(const APoint: TPoint; const AColor: TColor);
procedure DrawLine(const AFrom, ATo: TPoint; const AColor: TColor = clBlack); overload;
procedure DrawLine(const ATo: TPoint; const AColor: TColor = clBlack); overload;
procedure RealtimePenDraw(const APoint: TPoint;
const AColor: TColor = clBlack);
procedure Convolve(const AKernel: TRealMatrix);
class function GetPredefinedKernel(AKernel: TPredefinedKernel): TRealMatrix; static;
procedure MotionBlurH(AAmount: Integer);
procedure MotionBlurV(AAmount: Integer); inline;
procedure BoxBlur(AAmount: Integer); inline;
procedure GaussianBlur(AAmount: Integer; AIterations: Integer = 6);
procedure QuickFadeToBlack;
procedure QuickFadeToWhite;
procedure FadeToColor(const AColor: TColor; const AFraction: Double = 0.5);
procedure EveryOtherToColor(const AColor: TColor = clWhite; N: Integer = 2); overload;
procedure EveryOtherToColor(AColorFcn: TPixmapColorFcn; N: Integer = 2); overload;
procedure RandomToColor(const AColor: TColor = clWhite; const AProb: TASR = 0.5); overload;
procedure RandomToColor(AColorFcn: TPixmapColorFcn; const AProb: TASR = 0.5); overload;
procedure ShufflePixels;
procedure ReversePixels;
procedure Wind(const AProbability: Double; const ADistance: Integer;
const AFading: Double);
procedure RandomHorizontalRotation(const AAmount: Integer);
procedure RandomVerticalRotation(const AAmount: Integer);
procedure RippleH(const AAmplitude, AWavelength: Integer);
procedure RippleV(const AAmplitude, AWavelength: Integer);
function ExtractRGBChannel(const AChannel: TRGBChannelType): TASPixmap;
function ExtractHSVChannel(const AChannel: THSVChannelType): TASPixmap;
function ExtractHSLChannel(const AChannel: THSLChannelType): TASPixmap;
function IsGreyscale: Boolean;
procedure DrawDisk(const APoint: TPoint; const AColor: TASPixel;
const ARadius: Integer = 2); overload;
procedure DrawDisk(const APoint: TPoint); overload; inline;
procedure DrawDisks(const APoints: array of TPoint; const AColor: TASPixel;
const ARadius: Integer = 2); overload;
procedure DrawDisks(const APoints: array of TPoint); overload;
procedure DrawSquare(const APoint: TPoint; const AColor: TASPixel;
const ASide: Integer = 4); overload; inline;
procedure DrawSquare(const APoint: TPoint); overload; inline;
procedure DrawSquares(const APoints: array of TPoint; const AColor: TASPixel;
const ASide: Integer = 4); overload;
procedure DrawSquares(const APoints: array of TPoint); overload;
class function RGBCombine(const ARed, AGreen, ABlue: TASPixmap): TASPixmap; static;
class function HSVCombine(const AHue, ASaturation, AValue: TASPixmap): TASPixmap; static;
class function CreateGradient(const AWidth, AHeight: Integer;
const AFromColor, AToColor: TColor): TASPixmap; static;
class function Generate(const AWidth, AHeight: Integer;
AFcn: TGetPixelFcn): TASPixmap; static;
class function PerlinNoise(const AWidth, AHeight: Integer): TASPixmap; static;
class function Voronoi(const AWidth, AHeight: Integer;
const ASites: array of TPoint; const AColors: array of TASPixel;
AMetric: TFunc<TPoint, TPoint, Double>): TASPixmap; overload; static;
class function Voronoi(const AWidth, AHeight: Integer;
const ASites: array of TPoint; const AColors: array of TASPixel): TASPixmap; overload; static;
end;
procedure SaveGraphicToFile(AGraphics: TGraphic; const AFileName: TFileName;
AFormat: TImageFormat); overload;
procedure SaveGraphicToFile(AGraphics: TGraphic; ADlgOwner: TComponent;
const ADefFilename: TFileName = ''); overload;
function LoadGraphicsFromFile(const AFileName: TFileName): TBitmap;
implementation
uses
Vcl.Clipbrd, PngImage, Jpeg, StrUtils, Dialogs;
function pxli(R, G, B, A: Byte): TASPixel;
begin
PCardinal(@Result)^ := (A shl 24) or (R shl 16) or (G shl 8) or B;
end;
function pxlf(const R, G, B, A: Double): TASPixel;
begin
PCardinal(@Result)^ := (Round(255*A) shl 24) or (Round(255*R) shl 16) or (Round(255*G) shl 8) or Round(255*B);
end;
function pxli(AGreyLevel: Byte): TASPixel;
begin
Result := pxli(AGreyLevel, AGreyLevel, AGreyLevel);
end;
function pxlf(AGreyLevel: Double): TASPixel;
begin
Result := pxlf(AGreyLevel, AGreyLevel, AGreyLevel);
end;
function ComparePixel(const A, B: TASPixel): TValueRelationship;
begin
Result := CompareColor(A, B);
if Result = 0 then
Result := CompareValue(A.Alpha, B.Alpha);
end;
function SamePixel(const A, B: TASPixel): Boolean;
begin
Result := A = B;
end;
type
PScanLine = ^TScanline;
TScanLine = array[0..High(Word)] of TRGBQuad;
function imod(const x, y: Integer): Integer; inline;
begin
Result := x - Floor(x / y) * y;
end;
function rmod(const x, y: Double): Double; inline;
begin
Result := x - Floor(x / y) * y;
end;
procedure modd(var val: Integer); inline;
begin
if not Odd(val) then Inc(val);
end;
function InlinedEnsureRange(const AValue, AMin, AMax: Integer): Integer; inline; overload;
begin
Result := AValue;
if Result > AMax then
Result := AMax
else if Result < AMin then
Result := AMin;
end;
function InlinedEnsureRange(const AValue, AMin, AMax: Double): Double; inline; overload;
begin
Result := AValue;
if Result > AMax then
Result := AMax
else if Result < AMin then
Result := AMin;
end;
constructor TASPixmap.Create(AWidth, AHeight: Integer; const AColor: TASPixel;
const ABackgroundColor: TASPixel);
var
i: Integer;
begin
Alloc(AWidth, AHeight);
FBackgroundColor := ABackgroundColor;
for i := 0 to Length(FPixels) - 1 do
FPixels[i] := AColor;
end;
constructor TASPixmap.Create(AWidth, AHeight: Integer; const AColor: TASPixel);
var
i: Integer;
begin
Alloc(AWidth, AHeight);
FBackgroundColor := clWhite;
for i := 0 to Length(FPixels) - 1 do
FPixels[i] := AColor;
end;
constructor TASPixmap.Create(AWidth, AHeight: Integer);
var
i: Integer;
begin
Alloc(AWidth, AHeight);
FBackgroundColor := clWhite;
for i := 0 to Length(FPixels) - 1 do
FPixels[i] := clWhite;
end;
constructor TASPixmap.CreateUninitialized(AWidth: Integer; AHeight: Integer);
begin
Alloc(AWidth, AHeight);
FBackgroundColor := clWhite;
end;
constructor TASPixmap.Create(ABitmap: TBitmap);
begin
AssignFromBitmap(ABitmap);
end;
constructor TASPixmap.Create(const APixmap: TASPixmap);
begin
Alloc(APixmap.Width, APixmap.Height);
FBackgroundColor := APixmap.FBackgroundColor;
FPenPos := APixmap.FPenPos;
Move(APixmap.FPixels[0], FPixels[0], Length(FPixels) * sizeof(FPixels[0]));
end;
class operator TASPixmap.Implicit(ABitmap: TBitmap): TASPixmap;
begin
Result.AssignFromBitmap(ABitmap);
end;
class operator TASPixmap.Equal(const APixmap1, APixmap2: TASPixmap): Boolean;
begin
Result :=
(APixmap1.Height = APixmap2.Height)
and
(APixmap1.Width = APixmap2.Width)
and
CompareMem(@APixmap1.FPixels[0], @APixmap2.FPixels[0], APixmap1.PixelCount * sizeof(TASPixel));
end;
class operator TASPixmap.NotEqual(const APixmap1, APixmap2: TASPixmap): Boolean;
begin
Result := not (APixmap1 = APixmap2);
end;
class function TASPixmap.SameSize(const APixmaps: array of TASPixmap): Boolean;
var
w, h: Integer;
i: Integer;
begin
if Length(APixmaps) < 2 then
Exit(True);
w := APixmaps[0].Width;
h := APixmaps[0].Height;
for i := 1 to High(APixmaps) do
if (APixmaps[i].Width <> w) or (APixmaps[i].Height <> h) then
Exit(False);
Result := True;
end;
procedure SaveGraphicToFile(AGraphics: TGraphic; const AFileName: TFileName;
AFormat: TImageFormat);
const
exts: array[TImageFormat] of string =
(
'',
'bmp',
'png',
'jpg|jpeg'
);
clss: array[TImageFormat] of TGraphicClass =
(
nil,
TBitmap,
TPngImage,
TJPEGImage
);
var
ext: string;
&if: TImageFormat;
TargetGraphic: TGraphic;
begin
if AFormat = ifFromExtension then
begin
ext := ExtractFileExt(AFileName).TrimLeft(['.']);
for &if := Low(TImageFormat) to High(TImageFormat) do
if IndexText(ext, exts[&if].Split(['|'])) <> -1 then
begin
AFormat := &if;
Break;
end;
end;
if AFormat = ifFromExtension then
raise EPixmapException.CreateFmt('Unsupported file extension: "%s".', [ext]);
if AGraphics.InheritsFrom(clss[AFormat]) then
AGraphics.SaveToFile(AFileName)
else
begin
TargetGraphic := clss[AFormat].Create;
try
TargetGraphic.Assign(AGraphics);
TargetGraphic.SaveToFile(AFileName);
finally
TargetGraphic.Free;
end;
end;
end;
procedure SaveGraphicToFile(AGraphics: TGraphic; ADlgOwner: TComponent;
const ADefFilename: TFileName); overload;
const
ImageFormats: array[0..2] of TImageFormat = (ifBitmap, ifPng, ifJpg);
var
dlg: TFileSaveDialog;
begin
dlg := TFileSaveDialog.Create(ADlgOwner);
try
with dlg.FileTypes.Add do
begin
FileMask := '*.bmp';
DisplayName := 'Bitmap images';
end;
with dlg.FileTypes.Add do
begin
FileMask := '*.png';
DisplayName := 'PNG images';
end;
with dlg.FileTypes.Add do
begin
FileMask := '*.jpg;*.jpeg';
DisplayName := 'JPEG images';
end;
dlg.DefaultExtension := '.bmp';
dlg.FileName := ADefFilename;
if dlg.Execute and InRange(Pred(dlg.FileTypeIndex), Ord(Low(ImageFormats)), Ord(High(ImageFormats))) then
SaveGraphicToFile(AGraphics, dlg.FileName, ImageFormats[Pred(dlg.FileTypeIndex)]);
finally
dlg.Free;
end;
end;
function LoadGraphicsFromFile(const AFileName: TFileName): TBitmap;
var
Image: TWICImage;
begin
Image := TWICImage.Create;
try
Image.LoadFromFile(AFileName);
Result := TBitmap.Create;
try
Result.Assign(Image);
except
Result.Free;
raise;
end;
finally
Image.Free;
end;
end;
procedure TASPixmap.SaveToFile(const AFileName: TFileName;
AFormat: TImageFormat);
var
bm: TBitmap;
begin
bm := CreateGDIBitmap;
try
SaveGraphicToFile(bm, AFileName, AFormat);
finally
bm.Free;
end;
end;
procedure TASPixmap.SaveToFile(ADlgOwner: TComponent;
const ADefFileName: string);
var
bm: TBitmap;
begin
bm := CreateGDIBitmap;
try
SaveGraphicToFile(bm, ADlgOwner, ADefFileName);
finally
bm.Free;
end;
end;
procedure TASPixmap.SetHeight(const Value: Integer);
var
OldHeight: Integer;
i: Integer;
begin
if FHeight = Value then Exit;
OldHeight := FHeight;
Alloc(FWidth, Value);
if FHeight > OldHeight then
for i := OldHeight * FWidth to High(FPixels) do
FPixels[i] := FBackgroundColor;
end;
procedure TASPixmap.SetPixel(X, Y: Integer; const Value: TASPixel);
begin
FPixels[Y * FWidth + X] := Value;
end;
procedure TASPixmap.SetPixelSafe(X, Y: Integer; const Value: TASPixel);
begin
if PixelExists(X, Y) then
FPixels[Y * FWidth + X] := Value
end;
procedure TASPixmap.SetPixelInR2(X, Y: Integer; const Value: TASPixel);
begin
SafePixels[X + Width div 2, Height div 2 - Y] := Value;
end;
function TASPixmap.RGBBlend(const APixel1, APixel2: TRGB; AFunc: TRGBBlendFunc): TRGB;
begin
Result.Red := AFunc(APixel1.Red, APixel2.Red);
Result.Green := AFunc(APixel1.Green, APixel2.Green);
Result.Blue := AFunc(APixel1.Blue, APixel2.Blue);
end;
function _BlendNormal(const APixel1, APixel2: Double): Double; inline;
begin
Result := APixel2;
end;
function _BlendAverage(const APixel1, APixel2: Double): Double; inline;
begin
Result := (APixel1 + APixel2) / 2;
end;
function _BlendGeometricMean(const APixel1, APixel2: Double): Double; inline;
begin
Result := Sqrt(APixel1 * APixel2);
end;
function _BlendHarmonicMean(const APixel1, APixel2: Double): Double; inline;
begin
if (APixel1 = 0) or (APixel2 = 0) then
Result := 0
else
Result := 2/(1/APixel1 + 1/APixel2);
end;
function _BlendAdd(const APixel1, APixel2: Double): Double; inline;
begin
Result := Min(APixel1 + APixel2, 1);
end;
function _BlendAddRed(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange(APixel1 + APixel2 - 1, 0, 1);
end;
function _BlendSubtract(const APixel1, APixel2: Double): Double; inline;
begin
Result := Max(APixel1 - APixel2, 0);
end;
function _BlendIncSubtract(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange(APixel1 - APixel2 + 1, 0, 1);
end;
function _BlendMultiply(const APixel1, APixel2: Double): Double; inline;
begin
Result := APixel1 * APixel2;
end;
function _BlendScreen(const APixel1, APixel2: Double): Double; inline;
begin
Result := 1 - (1 - APixel1) * (1 - APixel2);
end;
function _BlendHardLight(const APixel1, APixel2: Double): Double; forward;
function _BlendOverlay(const APixel1, APixel2: Double): Double; inline;
begin
Result := _BlendHardLight(APixel2, APixel1);
end;
function _BlendDarken(const APixel1, APixel2: Double): Double; inline;
begin
Result := Min(APixel1, APixel2);
end;
function _BlendLighten(const APixel1, APixel2: Double): Double; inline;
begin
Result := Max(APixel1, APixel2);
end;
function _BlendDodge(const APixel1, APixel2: Double): Double; inline;
begin
if APixel1 = 0 then
Result := 0
else if APixel2 = 1 then
Result := 1
else
Result := Min(1, APixel1 / (1 - APixel2));
end;
function _BlendBurn(const APixel1, APixel2: Double): Double; inline;
begin
if APixel1 = 1 then
Result := 1
else if APixel2 = 0 then
Result := 0
else
Result := 1 - Min(1, (1 - APixel1) / APixel2);
end;
function _BlendHardLight(const APixel1, APixel2: Double): Double; inline;
begin
if APixel2 <= 0.5 then
Result := _BlendMultiply(APixel1, 2 * APixel2)
else
Result := _BlendScreen(APixel1, 2 * APixel2 - 1);
end;
function _BlendSoftLight(const APixel1, APixel2: Double): Double; inline;
var
D: Double;
begin
if APixel1 <= 0.25 then
D := ((16 * APixel1 - 12) * APixel1 + 4) * APixel1
else
D := sqrt(APixel1);
if APixel2 <= 0.5 then
Result := APixel1 - (1 - 2*APixel2) * APixel1 * (1 - APixel1)
else
Result := APixel1 + (2*APixel2 - 1) * (D - APixel1);
end;
function _BlendDifference(const APixel1, APixel2: Double): Double; inline;
begin
Result := Abs(APixel1 - APixel2);
end;
function _BlendExclusion(const APixel1, APixel2: Double): Double; inline;
begin
Result := APixel1 + APixel2 - 2*APixel1*APixel2;
end;
function _BlendNegation(const APixel1, APixel2: Double): Double; inline;
begin
Result := 1 - Abs(1 - APixel1 - APixel2);
end;
function _BlendReflect(const APixel1, APixel2: Double): Double; inline;
begin
if APixel2 < 1 then
Result := min(APixel1 * APixel1/(1 - APixel2), 1)
else
Result := 1;
end;
function _BlendFreeze(const APixel1, APixel2: Double): Double; inline;
begin
if APixel2 > 0 then
Result := max(1 - (1 - APixel1) * (1 - APixel1) / APixel2, 0)
else
Result := IfThen(APixel1 = 1, 1, 0);
end;
function _BlendStamp(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange(APixel1 + 2 * APixel2 - 1, 0, 1)
end;
function _BlendCosine(const APixel1, APixel2: Double): Double; inline;
begin
Result := 0.5 - cos(Pi * APixel1) / 4 - cos(Pi * APixel2) / 4;
end;
function _BlendXor(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange((Round(255*APixel1) xor Round(255*APixel2)) / 255, 0, 1)
end;
function _BlendAnd(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange((Round(255*APixel1) and Round(255*APixel2)) / 255, 0, 1)
end;
function _BlendOr(const APixel1, APixel2: Double): Double; inline;
begin
Result := InlinedEnsureRange((Round(255*APixel1) or Round(255*APixel2)) / 255, 0, 1)
end;
function _BlendDissolve(const APixel1, APixel2: Double): Double; inline;
begin
Result := IfThen(Random < 0.5, APixel1, APixel2);
end;
function TASPixmap.PixelBlend(const APixel1, APixel2: TRGB;
const BlendMode: TBlendMode): TRGB;
begin
with result do
case BlendMode of
bmNormal:
Result := RGBBlend(APixel1, APixel2, _BlendNormal);
bmAverage:
Result := RGBBlend(APixel1, APixel2, _BlendAverage);
bmGeometricMean:
Result := RGBBlend(APixel1, APixel2, _BlendGeometricMean);
bmHarmonicMean:
Result := RGBBlend(APixel1, APixel2, _BlendHarmonicMean);
bmLighten:
Result := RGBBlend(APixel1, APixel2, _BlendLighten);
bmDarken:
Result := RGBBlend(APixel1, APixel2, _BlendDarken);
bmAdd:
Result := RGBBlend(APixel1, APixel2, _BlendAdd);
bmAddRed:
Result := RGBBlend(APixel1, APixel2, _BlendAddRed);
bmSubtract:
Result := RGBBlend(APixel1, APixel2, _BlendSubtract);
bmInvSubtract:
Result := RGBBlend(APixel2, APixel1, _BlendSubtract);
bmIncSubtract:
Result := RGBBlend(APixel1, APixel2, _BlendIncSubtract);
bmInvIncSubtract:
Result := RGBBlend(APixel2, APixel1, _BlendIncSubtract);
bmDistance:
Result := RGBBlend(APixel1, APixel2, _BlendDifference);
bmNegation:
Result := RGBBlend(APixel1, APixel2, _BlendNegation);
bmExclusion:
Result := RGBBlend(APixel1, APixel2, _BlendExclusion);
bmMultiply:
Result := RGBBlend(APixel1, APixel2, _BlendMultiply);
bmScreen:
Result := RGBBlend(APixel1, APixel2, _BlendScreen);
bmSoftLight:
Result := RGBBlend(APixel1, APixel2, _BlendSoftLight);
bmHardLight:
Result := RGBBlend(APixel1, APixel2, _BlendHardLight);
bmOverlay:
Result := RGBBLend(APixel1, APixel2, _BlendOverlay);
bmDodge:
Result := RGBBlend(APixel1, APixel2, _BlendDodge);
bmInvDodge:
Result := RGBBlend(APixel2, APixel1, _BlendDodge);
bmBurn:
Result := RGBBlend(APixel1, APixel2, _BlendBurn);
bmInvBurn:
Result := RGBBlend(APixel2, APixel1, _BlendBurn);
bmReflect:
Result := RGBBlend(APixel1, APixel2, _BlendReflect);
bmInvReflect:
Result := RGBBlend(APixel2, APixel1, _BlendReflect);
bmFreeze:
Result := RGBBlend(APixel1, APixel2, _BlendFreeze);
bmInvFreeze:
Result := RGBBlend(APixel2, APixel1, _BlendFreeze);
bmStamp:
Result := RGBBlend(APixel1, APixel2, _BlendStamp);
bmInvStamp:
Result := RGBBlend(APixel2, APixel1, _BlendStamp);
bmCosine:
Result := RGBBlend(APixel1, APixel2, _BlendCosine);
bmXor:
Result := RGBBlend(APixel1, APixel2, _BlendXor);
bmAnd:
Result := RGBBlend(APixel1, APixel2, _BlendAnd);
bmOr:
Result := RGBBlend(APixel1, APixel2, _BlendOr);
bmRed:
begin
Result.Red := APixel2.Red;
Result.Green := APixel1.Green;
Result.Blue := APixel1.Blue;
end;
bmYellow:
begin
Result.Red := APixel2.Red;
Result.Green := APixel2.Green;
Result.Blue := APixel1.Blue;
end;
bmGreen:
begin
Result.Red := APixel1.Red;
Result.Green := APixel2.Green;
Result.Blue := APixel1.Blue;
end;
bmCyan:
begin
Result.Red := APixel1.Red;
Result.Green := APixel2.Green;
Result.Blue := APixel2.Blue;
end;
bmBlue:
begin
Result.Red := APixel1.Red;
Result.Green := APixel1.Green;
Result.Blue := APixel2.Blue;
end;
bmMagenta:
begin
Result.Red := APixel2.Red;
Result.Green := APixel1.Green;
Result.Blue := APixel2.Blue;
end;
bmHue:
with THSV(APixel1) do
Result := TRGB(THSV.Create(THSV(APixel2).Hue, Saturation, Value));
bmSaturation:
with THSV(APixel1) do
Result := TRGB(THSV.Create(Hue, THSV(APixel2).Saturation, Value));
bmValue:
with THSV(APixel1) do
Result := TRGB(THSV.Create(Hue, Saturation, THSV(APixel2).Value));
bmLightness:
with THSL(APixel1) do
Result := TRGB(THSL.Create(Hue, Saturation, THSL(APixel2).Lightness));
bmDissolve:
Result := RGBBlend(APixel1, APixel2, _BlendDissolve);
bmPartialDissolve:
begin
if Random < 0.5 then
Result := APixel1
else
Result := APixel2;
end
else
raise EPixmapException.CreateFmt('PixelBlend: Undefined or unimplemented blend mode: %d', [Ord(BlendMode)]);
end;
end;
function TASPixmap.PixelBlend(const APixel1, APixel2: TASPixel;
const BlendMode: TBlendMode; const AOpacity: Double): TASPixel;
begin
Result := (1 - AOpacity) * APixel1 + AOpacity * TASPixel(PixelBlend(APixel1, APixel2, BlendMode));
end;
procedure TASPixmap.InternalDraw(const APixmap: TASPixmap; X, Y: Integer;
AOpacitySources: TOpacitySources; const AOpacity: Double; ABlendMode: TBlendMode);
var
SelfTopLeft: TPoint;
LayerTopLeft: TPoint;
ActualWidth,
ActualHeight: Integer;
SelfY, SelfX,
LayerY, LayerX: Integer;
S, L: TASPixel;
factor: Double;
begin
SelfTopLeft.X := max(X, 0);
SelfTopLeft.Y := max(Y, 0);
LayerTopLeft.X := max(-X, 0);
LayerTopLeft.Y := max(-Y, 0);
ActualWidth := APixmap.Width - max(X + APixmap.Width - Self.Width, 0) - LayerTopLeft.X;
ActualHeight := APixmap.Height - max(Y + APixmap.Height - Self.Height, 0) - LayerTopLeft.Y;
LayerY := LayerTopLeft.Y;
for SelfY := SelfTopLeft.Y to SelfTopLeft.Y + ActualHeight - 1 do
begin
LayerX := LayerTopLeft.X;
for SelfX := SelfTopLeft.X to SelfTopLeft.X + ActualWidth - 1 do
begin
S := Self.FPixels[SelfY * Self.Width + SelfX];
L := APixmap.FPixels[LayerY * APixmap.Width + LayerX];
factor := 1;
if osChannel in AOpacitySources then
factor := factor * L.Alpha / 255;
if osParameter in AOpacitySources then
factor := factor * AOpacity;
Self.FPixels[SelfY * Self.Width + SelfX] := PixelBlend(S, L, ABlendMode, factor);
Inc(LayerX);
end;
Inc(LayerY);
end;
end;
function TASPixmap.ApplyRGBAdjustments(const APixel: TRGB;
const RGBAdjustment: TRGBAdjustmentParameters): TRGB;
var
i: Integer;
begin
for i := MIN_COLOR_COMPONENT to MAX_COLOR_COMPONENT do
begin
TColorComponents(Result).Components[i] := RGBAdjustment.ComponentParts[i].Constant +
RGBAdjustment.ComponentParts[i].RedFactor * APixel.Red +
RGBAdjustment.ComponentParts[i].GreenFactor * APixel.Green +
RGBAdjustment.ComponentParts[i].BlueFactor * APixel.Blue;
if RGBAdjustment.ComponentParts[i].Overflow then
TColorComponents(Result).Components[i] := rmod(TColorComponents(Result).Components[i], 1)
else
TColorComponents(Result).Components[i] := InlinedEnsureRange(TColorComponents(Result).Components[i], 0, 1);
end;
end;
function TASPixmap.ApplyHSVAdjustments(const APixel: THSV;
const HSVAdjustment: THSVAdjustmentParameters): THSV;
const
ComponentMax: array[0..2] of Double = (360, 1, 1);
var
i: Integer;
begin
for i := MIN_COLOR_COMPONENT to MAX_COLOR_COMPONENT do
begin
TColorComponents(Result).Components[i] := HSVAdjustment.ComponentParts[i].Constant +
HSVAdjustment.ComponentParts[i].HueFactor * APixel.Hue +
HSVAdjustment.ComponentParts[i].SaturationFactor * APixel.Saturation +
HSVAdjustment.ComponentParts[i].ValueFactor * APixel.Value;
if HSVAdjustment.ComponentParts[i].Overflow then
TColorComponents(Result).Components[i] := rmod(TColorComponents(Result).Components[i], ComponentMax[i])
else
TColorComponents(Result).Components[i] := InlinedEnsureRange(TColorComponents(Result).Components[i], 0, ComponentMax[i]);
end;
end;
function TASPixmap.IsEmptyRow(ARow: Integer): Boolean;
var
x: Integer;
begin
for x := 0 to Width - 1 do
if LineData[ARow][x] <> FBackgroundColor then
Exit(False);
Result := True;
end;
function TASPixmap.IsEmptyCol(ACol: Integer): Boolean;
var
y: Integer;
begin
for y := 0 to Height - 1 do
if Pixels[ACol, y] <> FBackgroundColor then
Exit(False);
Result := True;
end;
function TASPixmap.PixelExists(const APoint: TPoint): Boolean;
begin
Result := InRange(APoint.X, 0, Width - 1) and InRange(APoint.Y, 0, Height - 1);
end;
function TASPixmap.PixelExists(X, Y: Integer): Boolean;
begin
Result := InRange(X, 0, Width - 1) and InRange(Y, 0, Height - 1);
end;
procedure TASPixmap.SetSize(AWidth, AHeight: Integer);
var
tmp: TASPixmap;
begin
if (FHeight = AHeight) and (FWidth = AWidth) then
Exit;
if FWidth = AWidth then
begin
SetHeight(AHeight);
Exit;
end;
tmp := Clone;
Alloc(AWidth, AHeight);
Clear;
Draw(tmp);
end;
procedure TASPixmap.SetWidth(const Value: Integer);
var
tmp: TASPixmap;
begin
if FWidth = Value then Exit;
tmp := Clone;
Alloc(Value, FHeight);
Clear;
Draw(tmp);
end;
procedure TASPixmap.Alloc(AWidth: Integer; AHeight: Integer);
begin
if (AWidth < 1) or (AHeight < 1) then
raise EPixmapException.Create('Cannot create empty pixmap.');
FWidth := AWidth;
FHeight := AHeight;
SetLength(FPixels, AWidth * AHeight);
end;
procedure TASPixmap.AlphaDraw(const APixmap: TASPixmap; X, Y: Integer);
begin
InternalDraw(APixmap, X, Y, [osChannel], 1);
end;
procedure TASPixmap.AlphaDraw(const APixmap: TASPixmap; X, Y: Integer;
const AOpacity: Double; ABlendMode: TBlendMode);
begin
InternalDraw(APixmap, X, Y, [osChannel, osParameter], AOpacity, ABlendMode);
end;
procedure TASPixmap.FixHue(const AHue: Double);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSV(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSV.Create(AHue, Saturation, Value))
end;
procedure TASPixmap.ToMonochromatic(const AHue: Double);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSV(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSV.Create(AHue, 1, Value))
end;
procedure TASPixmap.ShiftHue(const AAmount: Double);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSV(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSV.Create(Hue + AAmount, Saturation, Value))
end;
procedure TASPixmap.ToGreyscale;
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSV(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSV.Create(Hue, 0, Value))
end;
procedure TASPixmap.Invert;
var
i: Integer;
begin
for i := 0 to High(FPixels) do
FPixels[i] := TRGB(FPixels[i]).Invert;
end;
procedure TASPixmap.InvertValue;
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSV(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSV.Create(Hue, Saturation, 1 - Value))
end;
procedure TASPixmap.InvertLightness;
var
i: Integer;
begin
for i := 0 to High(FPixels) do
with THSL(TRGB(FPixels[i])) do
FPixels[i] := TRGB(THSL.Create(Hue, Saturation, 1 - Lightness))
end;
procedure TASPixmap.RGBAdjustments(const RGBAdjustments: TRGBAdjustmentParameters);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
FPixels[i] := ApplyRGBAdjustments(FPixels[i], RGBAdjustments)
end;
procedure TASPixmap.HSVAdjustments(const HSVAdjustments: THSVAdjustmentParameters);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
FPixels[i] := TRGB(ApplyHSVAdjustments(THSV(TRGB(FPixels[i])), HSVAdjustments));
end;
procedure TASPixmap.Binarize(const AThreshold: Double);
var
i: Integer;
begin
for i := 0 to High(FPixels) do
if THSL(TRGB(FPixels[i])).Lightness > AThreshold then
FPixels[i] := clWhite
else
FPixels[i] := clBlack;
end;
procedure TASPixmap.FlipHorizontally;
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
tmp[x, y] := Self[Width - 1 - x, y];
FPixels := tmp.FPixels;
end;
procedure TASPixmap.FlipVertically;
var
tmp: TASPixmap;
y: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
Move(FPixels[y * Width], tmp.FPixels[(Height - 1 - y) * Width], Width * sizeof(TASPixel));
FPixels := tmp.FPixels;
end;
procedure TASPixmap.Rot90P;
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Height, Width);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
tmp[y, Width - 1 - x] := Self[x, y];
Self.Alloc(Height, Width);
FPixels := tmp.FPixels;
end;
procedure TASPixmap.Rot90N;
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Height, Width);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
tmp[Height - 1 - y, x] := Self[x, y];
Self.Alloc(Height, Width);
FPixels := tmp.FPixels;
end;
procedure TASPixmap.Rot180;
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
tmp[Width - 1 - x, Height - 1 - y] := Self[x, y];
FPixels := tmp.FPixels;
end;
procedure TASPixmap.HorizontalRotation(AAmount: Integer);
var
tmp: TASPixmap;
y: Integer;
begin
AAmount := imod(AAmount, Width);
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
begin
Move(LineData[y]^, tmp.LineData[y][AAmount], (Width - AAmount) * sizeof(TASPixel));
Move(LineData[y][Width - AAmount], tmp.LineData[y]^, AAmount * sizeof(TASPixel));
end;
FPixels := tmp.FPixels;
end;
procedure TASPixmap.VerticalRotation(AAmount: Integer);
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
tmp[x, imod(y + AAmount, Height)] := Self[x, y];
FPixels := tmp.FPixels;
end;
procedure TASPixmap.CustomHorizontalRotation(AFunction: TFunc<Integer, Integer>);
var
tmp: TASPixmap;
y: Integer;
x: Integer;
Delta: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := 0 to Height - 1 do
begin
Delta := AFunction(y);
for x := 0 to Width - 1 do
tmp[imod(x + Delta, Width), y] := Self[x, y];
end;
FPixels := tmp.FPixels;
end;
procedure TASPixmap.CustomVerticalRotation(AFunction: TFunc<Integer, Integer>);
var
tmp: TASPixmap;
y: Integer;
x: Integer;
Delta: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for x := 0 to Width - 1 do
begin
Delta := AFunction(x);
for y := 0 to Height - 1 do
tmp[x, imod(y + Delta, Height)] := Self[x, y];
end;
FPixels := tmp.FPixels;
end;
procedure TASPixmap.HorizontalSkewRotation(ADelta, ADenominator: Integer);
begin
CustomHorizontalRotation(function(y: Integer): Integer
begin
Result := y * ADelta div ADenominator
end);
end;
procedure TASPixmap.VerticalSkewRotation(ADelta, ADenominator: Integer);
begin
CustomVerticalRotation(function(x: Integer): Integer
begin
Result := x * ADelta div ADenominator
end);
end;
procedure TASPixmap.Scale(const AFactor: Double);
begin
Stretch(AFactor, AFactor);
end;
procedure TASPixmap.Stretch(const AXFactor, AYFactor: Double);
var
tmp: TASPixmap;
y: Integer;
x: Integer;
begin
if SameValue(AXFactor, 1) and SameValue(AYFactor, 1) then
Exit;
if IsZero(AXFactor) or (AXFactor < 0) or IsZero(AYFactor) or (AYFactor < 0) then
raise EPixmapException.Create('Scaling factor must be positive.');
tmp := TASPixmap.CreateUninitialized(Round(AXFactor * Width),
Round(AYFactor * Height));
for y := 0 to tmp.Height - 1 do
for x := 0 to tmp.Width - 1 do
tmp[x, y] := Self[Trunc(x / AXFactor + 1E-12), Trunc(y / AYFactor + 1E-12)];
Alloc(tmp.Width, tmp.Height);
Self.FPixels := tmp.FPixels;
end;
procedure TASPixmap.Rotate(const AAngle: Double);
var
tmp: TASPixmap;
angle: extended;
sintheta, costheta: Double;
tWidth, tHeight: Integer;
y: Integer;
x: Integer;
begin
angle := rmod(AAngle, 2*Pi);
if IsZero(angle) then
Exit
else if SameValue(angle, Pi/2) then
begin
Rot90P;
Exit;
end
else if SameValue(angle, Pi) then
begin
Rot180;
Exit;
end
else if SameValue(angle, 3*Pi/2) then
begin
Rot90N;
Exit;
end;
SinCos(angle, sintheta, costheta);
if sintheta * costheta < 0 then
begin
tWidth := Abs(Round(Height * sintheta - Width * costheta));
tHeight := Abs(Round(Width * sintheta - Height * costheta));
end
else
begin
tWidth := Abs(Round(Width * costheta + Height * sintheta));
tHeight := Abs(Round(Width * sintheta + Height * costheta));
end;
tmp := TASPixmap.CreateUninitialized(tWidth, tHeight);
for y := tmp.Height div 2 - tmp.Height + 1 to tmp.Height div 2 do
for x := -tmp.Width div 2 to tmp.Width - tmp.Width div 2 - 1 do
tmp.PixelsInR2[x, y] := Self.PixelsInR2[Round(costheta * x + sintheta * y),
Round(costheta * y - sintheta * x)];
SetPixelsFrom(tmp);
end;
procedure TASPixmap.Shear(const AAngle: Double);
var
tmp: TASPixmap;
y: Integer;
t: Double;
begin
if not InRange(AAngle, -Pi/2, Pi/2) or SameValue(Abs(AAngle), Pi/2) then
raise EPixmapException.Create('Skew angle must be between −π/2 and π/2.');
if IsZero(AAngle) then
Exit;
t := Abs(tan(AAngle));
tmp := TASPixmap.Create(Width + Ceil(Height * t), Height, FBackgroundColor);
if AAngle > 0 then
for y := 0 to Height - 1 do
Move(LineData[y]^, tmp.LineData[y][Round((Height - y) * t)],
Width * sizeof(TASPixel))
else
for y := 0 to Height - 1 do
Move(LineData[y]^, tmp.LineData[y][Round(y * t)],
Width * sizeof(TASPixel));
SetPixelsFrom(tmp);
end;
procedure TASPixmap.LinearTransform(const AMatrix: TRealMatrix);
var
inverse: TRealMatrix;
tmp: TASPixmap;
y, x: Integer;
begin
if AMatrix.Size <> Mat2x2 then
raise EPixmapException.Create('Transformation matrix must be 2×2.');
if AMatrix.IsIdentity then
Exit;
if not AMatrix.TryInvert(inverse) then
raise EPixmapException.Create('Transformation matrix must be invertible.');
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := tmp.Height div 2 - tmp.Height + 1 to tmp.Height div 2 do
for x := -tmp.Width div 2 to tmp.Width - tmp.Width div 2 - 1 do
with TRealVector((inverse * ASR2(x, y)).Data) do
tmp.PixelsInR2[x, y] := Self.PixelsInR2[Round(Components[0]), Round(Components[1])];
SetPixelsFrom(tmp);
end;
procedure TASPixmap.LinearTransform(const A, B, C, D: TASR);
begin
LinearTransform(TRealMatrix.Create([A, B, C, D], 2));
end;
procedure TASPixmap.CustomTransform(const AFunc: TTransformFunc);
var
tmp: TASPixmap;
y, x: Integer;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
for y := tmp.Height div 2 - tmp.Height + 1 to tmp.Height div 2 do
for x := -tmp.Width div 2 to tmp.Width - tmp.Width div 2 - 1 do
with AFunc(ASR2(x, y)) do
if Dimension = 2 then
tmp.PixelsInR2[x, y] := Self.PixelsInR2[Round(Components[0]), Round(Components[1])]
else
raise EPixmapException.Create('Pixmap transformation function must return a two-dimensional real vector.');
SetPixelsFrom(tmp);
end;
function TASPixmap.GetRect(const ARect: TRect): TASPixmap;
var
w, h: Integer;
R: TRect;
y: Integer;
begin
R.Top := Max(ARect.Top, 0);
R.Left := Max(ARect.Left, 0);
R.Bottom := Min(ARect.Bottom, Height);
R.Right := Min(ARect.Right, Width);
w := R.Right - R.Left;
h := R.Bottom - R.Top;
if (w < 1) or (h < 1) then
raise EPixmapException.Create('TASPixmap.GetRect: Rectangle is empty.');
Result := TASPixmap.CreateUninitialized(w, h);
for y := 0 to h - 1 do
Move(Self.LineData[R.Top + y][R.Left], Result.LineData[y]^, w * sizeof(TASPixel));
end;
function TASPixmap.AverageColor(const ARect: TRect): TRGB;
var
R: TRect;
y: Integer;
x: Integer;
N, sR, sG, sB: UInt64;
const
MaxPixelCount = UInt64.MaxValue div 255;
begin
R.Top := Max(ARect.Top, 0);
R.Left := Max(ARect.Left, 0);
R.Bottom := Min(ARect.Bottom, Height);
R.Right := Min(ARect.Right, Width);
N := (R.Right - R.Left) * (R.Bottom - R.Top);
if N > MaxPixelCount then
raise EPixmapException.CreateFmt('TASPixmap.AverageColor: Possible integer overflow (region consists of more than %d pixels). Use AverageColorF instead.',
[MaxPixelCount]);
sR := 0;
sG := 0;
sB := 0;
for y := R.Top to R.Bottom - 1 do
for x := R.Left to R.Right - 1 do
begin
Inc(sR, Pixels[x, y].Red);
Inc(sG, Pixels[x, y].Green);
Inc(sB, Pixels[x, y].Blue);
end;
N := 255*N;
Result.Red := sR / N;
Result.Green := sG / N;
Result.Blue := sB / N;
end;
function TASPixmap.AverageColor: TRGB;
begin
Result := AverageColor(Rect(0, 0, Width, Height));
end;
function TASPixmap.AverageColorF(const ARect: TRect): TRGB;
var
R: TRect;
y: Integer;
x: Integer;
N: Integer;
sR, sG, sB: Double;
begin
R.Top := Max(ARect.Top, 0);
R.Left := Max(ARect.Left, 0);
R.Bottom := Min(ARect.Bottom, Height);
R.Right := Min(ARect.Right, Width);
N := 255 * (R.Right - R.Left) * (R.Bottom - R.Top);
sR := 0;
sG := 0;
sB := 0;
for y := R.Top to R.Bottom - 1 do
for x := R.Left to R.Right - 1 do
begin
sR := sR + Pixels[x, y].Red / N;
sG := sG + Pixels[x, y].Green / N;
sB := sB + Pixels[x, y].Blue / N;
end;
Result.Red := sR;
Result.Green := sG;
Result.Blue := sB;
end;
function TASPixmap.AverageColorF: TRGB;
begin
Result := AverageColorF(Rect(0, 0, Width, Height));
end;
procedure TASPixmap.CropTo(const ARect: TRect);
var
tmp: TASPixmap;
begin
tmp := GetRect(ARect);
Alloc(tmp.Width, tmp.Height);
Self.FPixels := tmp.FPixels;
end;
class function TASPixmap.Generate(const AWidth, AHeight: Integer;
AFcn: TGetPixelFcn): TASPixmap;
var
y: Integer;
x: Integer;
begin
Result := TASPixmap.CreateUninitialized(AWidth, AHeight);
for y := 0 to AHeight - 1 do
for x := 0 to AWidth - 1 do
Result.Pixels[x, y] := AFcn(x, y);
end;
function TASPixmap.GetAutoCropRect: TRect;
var
y: Integer;
x: Integer;
begin
FillChar(result, sizeof(result), 0);
for y := 0 to Height - 1 do
if not IsEmptyRow(y) then
begin
Result.Top := y;
Break;
end
else if y = Height - 1 then
Exit;
for y := Height - 1 downto 0 do
if not IsEmptyRow(y) then
begin
Result.Bottom := y + 1;
Break;
end;
for x := 0 to Width - 1 do
if not IsEmptyCol(x) then
begin
Result.Left := x;
Break;
end;
for x := Width - 1 downto 0 do
if not IsEmptyCol(x) then
begin
Result.Right := x + 1;
Break;
end;
end;
procedure TASPixmap.AutoCrop;
begin
CropTo(GetAutoCropRect);
end;
procedure TASPixmap.ExpandCanvas(AByX, AByY: Integer);
begin
SetPixelsFrom(CloneWithBorder(AByX, AByY, FBackgroundColor));
end;
procedure TASPixmap.ExpandCanvas(ABy: Integer);
begin
ExpandCanvas(ABy, ABy);
end;
procedure TASPixmap.AddBorder(ABorderWidthX: Integer; ABorderWidthY: Integer; ABorderColor: TColor);
begin
SetPixelsFrom(CloneWithBorder(ABorderWidthX, ABorderWidthY, ABorderColor));
end;
procedure TASPixmap.AddBorder(ABorderWidth: Integer; ABorderColor: TColor);
begin
AddBorder(ABorderWidth, ABorderWidth, ABorderColor);
end;
function TASPixmap.OnlyBackground: Boolean;
var
y: Integer;
begin
for y := 0 to Height - 1 do
if not IsEmptyRow(y) then
Exit(False);
Result := True;
end;
procedure TASPixmap.EdgeDetect(ADirections: TEdgeDetectionDirections);
var
tmp: TASPixmap;
w, h: Integer;
y: Integer;
x: Integer;
begin
w := Width;
if eddHorizontal in ADirections then
Dec(w);
h := Height;
if eddVertical in ADirections then
Dec(h);
tmp := TASPixmap.CreateUninitialized(w, h);
if ADirections = [eddHorizontal] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(Round(255 * (Pixels[x + 1, y] - Pixels[x, y]).Norm / sqrt(3)))
else if ADirections = [eddVertical] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(Round(255 * (Pixels[x, y + 1] - Pixels[x, y]).Norm / sqrt(3)))
else if ADirections = [eddHorizontal, eddVertical] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(Min(255, Round(255 * ( (Pixels[x + 1, y] - Pixels[x, y]).Norm + (Pixels[x, y + 1] - Pixels[x, y]).Norm ) / (sqrt(3)))))
else
tmp.Fill(clBlack);
SetPixelsFrom(tmp);
end;
procedure TASPixmap.Emboss(ADirections: TEdgeDetectionDirections);
var
tmp: TASPixmap;
w, h: Integer;
y: Integer;
x: Integer;
begin
w := Width;
if eddHorizontal in ADirections then
Dec(w);
h := Height;
if eddVertical in ADirections then
Dec(h);
tmp := TASPixmap.CreateUninitialized(w, h);
if ADirections = [eddHorizontal] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(127 + (Pixels[x, y].Sum - Pixels[x + 1, y].Sum) div 6)
else if ADirections = [eddVertical] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(127 + (Pixels[x, y].Sum - Pixels[x, y + 1].Sum) div 6)
else if ADirections = [eddHorizontal, eddVertical] then
for y := 0 to h - 1 do
for x := 0 to w - 1 do
tmp[x, y] := pxli(127 + (2*Pixels[x, y].Sum - Pixels[x, y + 1].Sum - Pixels[x + 1, y].Sum) div 12)
else
tmp.Fill(pxli(127));
SetPixelsFrom(tmp);
end;
procedure TASPixmap.Pixelate(APixelWidth, APixelHeight: Integer);
var
nx, ny: Integer;
tmp: TASPixmap;
y: Integer;
x: Integer;
R: TRect;
begin
tmp := TASPixmap.CreateUninitialized(Width, Height);
nx := Ceil(Width / APixelWidth);
ny := Ceil(Height / APixelHeight);
for y := 0 to ny - 1 do
for x := 0 to nx - 1 do
begin
R := Rect(APixelWidth * x, APixelHeight * y, APixelWidth * (x + 1), APixelHeight * (y + 1));
tmp.FillRect(R, AverageColor(R));
end;
SetPixelsFrom(tmp);
end;
procedure TASPixmap.Pixelate(APixelSize: Integer);
begin
Pixelate(APixelSize, APixelSize);
end;
procedure TASPixmap.Noise(AProbability: Double = 0.5; AColor: TColor = clWhite);
var
i: Integer;
pxl: TASPixel;
begin
if AColor = clRandom then
begin
for i := 0 to PixelCount - 1 do
if Random < AProbability then
FPixels[i] := TASPixel.GetRandomPixel
end
else
begin
pxl := AColor;
for i := 0 to PixelCount - 1 do
if Random < AProbability then
FPixels[i] := pxl;
end;
end;
procedure TASPixmap.DistortMetric(ARadiusX, ARadiusY: Integer);
procedure SwapPixels(x1, y1, x2, y2: Integer);
var
tmp: TASPixel;
begin
if InRange(x2, 0, Width - 1) and InRange(y2, 0, Height - 1) then
begin
tmp := Pixels[x1, y1];
Pixels[x1, y1] := Pixels[x2, y2];
Pixels[x2, y2] := tmp;
end;
end;
var
y: Integer;
x: Integer;
begin
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
SwapPixels(x, y, x + RandomRange(-ARadiusX, ARadiusX + 1), y + RandomRange(-ARadiusY, ARadiusY + 1));
end;
procedure TASPixmap.DistortMetric(ARadius: Integer);
begin
DistortMetric(ARadius, ARadius);
end;
procedure TASPixmap.DistortColor(ARedDistance, AGreenDistance,
ABlueDistance: Integer);
var
i: Integer;
begin
for i := 0 to PixelCount - 1 do
begin
FPixels[i].Red := InlinedEnsureRange(FPixels[i].Red + RandomRange(-ARedDistance, ARedDistance + 1), 0, 255);
FPixels[i].Green := InlinedEnsureRange(FPixels[i].Green + RandomRange(-AGreenDistance, AGreenDistance + 1), 0, 255);
FPixels[i].Blue := InlinedEnsureRange(FPixels[i].Blue + RandomRange(-ABlueDistance, ABlueDistance + 1), 0, 255);
end;
end;
procedure TASPixmap.DistortColor(ADistance: Integer);
begin
DistortColor(ADistance, ADistance, ADistance);
end;
procedure TASPixmap.Tiles(ANumRows: Integer; ANumCols: Integer;
APadding: Integer; AShuffle: Boolean);
var
TileWidth, TileHeight,
CellWidth, CellHeight: Integer;
AvailableIndices: TArray<Integer>;
tmp: TASPixmap;
i: Integer;
function OriginalRect(AIndex: Integer): TRect;
begin
Result.Left := (AIndex mod ANumCols) * TileWidth;
Result.Top := (AIndex div ANumCols) * TileHeight;
Result.Right := result.Left + TileWidth;
Result.Bottom := result.Top + TileHeight;
end;
function NewTopLeft(AIndex: Integer): TPoint;
begin
Result.X := APadding + (AIndex mod ANumCols) * CellWidth;
Result.Y := APadding + (AIndex div ANumCols) * CellHeight;;
end;
begin
TileWidth := Width div ANumCols;
TileHeight := Height div ANumRows;
CellWidth := TileWidth + APadding;
CellHeight := TileHeight + APadding;
tmp := TASPixmap.Create(APadding + CellWidth * ANumCols,
APadding + CellHeight * ANumRows,
FBackgroundColor);
AvailableIndices := TArray<Integer>(CreateIntSequence(0, ANumCols * ANumRows - 1));
if AShuffle then
TShuffler<Integer>.Shuffle(AvailableIndices);
for i := 0 to High(AvailableIndices) do
with NewTopLeft(AvailableIndices[i]) do
tmp.Draw(GetRect(OriginalRect(i)), X, Y);
SetPixelsFrom(tmp);
end;
function RandomColorIdx(Idx: Integer): TColor;
begin
Result := Random(256) or (Random(256) shl 8) or (Random(256) shl 16);
end;
procedure TASPixmap.ComponentHighlight(AIndexColorFcn: TIndexColorFunction);
var
x, y, i: Integer;
begin
if not Assigned(AIndexColorFcn) then
AIndexColorFcn := RandomColorIdx;
i := 0;
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
if Pixels[x, y] = FBackgroundColor then
begin
FloodFill(Point(x, y), AIndexColorFcn(i));
Inc(i);
end;
end;
procedure TASPixmap.FloodFill(const APoint: TPoint; const AColor: TColor);
var
Q: TQueue<TPoint>;
p: TPoint;
TargetColor, ReplacementColor: TASPixel;
procedure CheckPixel(const APoint: TPoint);
begin
with APoint do
if Pixels[X, Y] = TargetColor then
begin
Pixels[X, Y] := ReplacementColor;
Q.Enqueue(APoint);
end;
end;
begin
if not PixelExists(APoint) then
Exit;
TargetColor := Pixels[APoint.X, APoint.Y];
ReplacementColor := AColor;
if TargetColor = ReplacementColor then
Exit;
Q := TQueue<TPoint>.Create;
try
CheckPixel(APoint);
while Q.Count > 0 do
begin
p := Q.Dequeue;
if p.X > 0 then
CheckPixel(Point(p.X - 1, p.Y));
if p.Y > 0 then
CheckPixel(Point(p.X, p.Y - 1));
if p.X < Width - 1 then
CheckPixel(Point(p.X + 1, p.Y));
if p.Y < Height - 1 then
CheckPixel(Point(p.X, p.Y + 1));
end;
finally
Q.Free;
end;
end;
procedure TASPixmap.DrawLine(const AFrom: TPoint; const ATo: TPoint;
const AColor: TColor);
var
x, y,
dx, dy: Double;
n: Integer;
i: Integer;
begin
if not InRange(Abs(AFrom.X), 0, 1000000000) then
Exit;
if not InRange(Abs(AFrom.Y), 0, 1000000000) then
Exit;
if not InRange(Abs(ATo.X), 0, 1000000000) then
Exit;
if not InRange(Abs(ATo.Y), 0, 1000000000) then
Exit;
if (AFrom.X = ATo.X) and (AFrom.Y = ATo.Y) then
begin
SafePixels[AFrom.X, AFrom.Y] := AColor;
FPenPos := ATo;
Exit;
end;
n := Max(Abs(ATo.X - AFrom.X), Abs(ATo.Y - AFrom.Y)) + 1;
dx := ATo.X - AFrom.X; dx := dx + Sign(dx); dx := dx / n;
dy := ATo.Y - AFrom.Y; dy := dy + Sign(dy); dy := dy / n;
x := AFrom.X;
y := AFrom.Y;
for i := 1 to n do
begin
SafePixels[Round(x), Round(y)] := AColor;
x := x + dx;
y := y + dy;
if (x > Width) and (dx > 0) then
Break;
if (x < 0) and (dx < 0) then
Break;
if (y > Height) and (dy > 0) then
Break;
if (y < 0) and (dy < 0) then
Break;
end;
FPenPos := ATo;
end;
procedure TASPixmap.DrawLine(const ATo: TPoint; const AColor: TColor);
begin
DrawLine(FPenPos, ATo, AColor);
end;
procedure TASPixmap.RealtimePenDraw(const APoint: TPoint; const AColor: TColor);
begin
DrawLine(FPenPos, APoint, AColor);
FPenPos := APoint;
end;
procedure TASPixmap.ReversePixels;
begin
TReverser<TASPixel>.Reverse(TArray<TASPixel>(FPixels));
end;
procedure TASPixmap.Convolve(const AKernel: TRealMatrix);
var
Radius: Integer;
x, y, i, j, xp, yp: Integer;
R, G, B: TRealMatrix;
tmp: TASPixmap;
begin
if not AKernel.Size.IsSquare or not Odd(AKernel.Size.Rows) then
raise Exception.Create('Convolution kernel must be square and of odd size.');
Radius := AKernel.Size.Rows div 2;
tmp := CloneWithBorderExtension(Radius);
R := TRealMatrix.CreateUninitialized(AKernel.Size.Rows);
G := TRealMatrix.CreateUninitialized(AKernel.Size.Rows);
B := TRealMatrix.CreateUninitialized(AKernel.Size.Rows);
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
begin
j := 0;
for yp := y - Radius + Radius to y + Radius + Radius do
begin
i := 0;
for xp := x - Radius + Radius to x + Radius + Radius do
begin
R[j, i] := tmp.Pixels[xp, yp].Red / 255;
G[j, i] := tmp.Pixels[xp, yp].Green / 255;
B[j, i] := tmp.Pixels[xp, yp].Blue / 255;
Inc(i);
end;
Inc(j);
end;
Pixels[x, y] := pxlf(
InlinedEnsureRange(TRealVector(AKernel.Data) * TRealVector(R.Data), 0, 1),
InlinedEnsureRange(TRealVector(AKernel.Data) * TRealVector(G.Data), 0, 1),
InlinedEnsureRange(TRealVector(AKernel.Data) * TRealVector(B.Data), 0, 1)
);
end;
end;
class function TASPixmap.GetPredefinedKernel(AKernel: TPredefinedKernel): TRealMatrix;
function M33is(a, b, c, d, e, f, g, h, i, scale: Integer): TRealMatrix; inline;
begin
Result := TRealMatrix.Create([a, b, c, d, e, f, g, h, i], 3) / scale;
end;
function M55is(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, scale: Integer): TRealMatrix; inline;
begin
Result := TRealMatrix.Create([a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y], 5) / scale;
end;
begin
case AKernel of
pkIdentity3:
Result := M33is(0, 0, 0, 0, 1, 0, 0, 0, 0, 1);
pkBoxBlur3:
Result := M33is(1, 1, 1, 1, 1, 1, 1, 1, 1, 9);
pkBoxBlur5:
Result := M55is(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 25);
pkGaussianBlur3:
Result := M33is(1, 2, 1, 2, 4, 2, 1, 2, 1, 16);
pkGaussianBlur5:
Result := M55is(1, 4, 6, 4, 1, 4, 16, 24, 16, 4, 6, 24, 36, 24, 6, 4, 16, 24, 16, 4, 1, 4, 6, 4, 1, 256);
pkUnsharpMasking5:
Result := M55is(1, 4, 6, 4, 1, 4, 16, 24, 16, 4, 6, 24, -476, 24, 6, 4, 16, 24, 16, 4, 1, 4, 6, 4, 1, -256);
pkSharpen3:
Result := M33is(0, -1, 0, -1, 5, -1, 0, -1, 0, 1);
pkEdgeDetect3_1:
Result := M33is(0, 0, 0, -1, 2, -1, 0, 0, 0, 1);
pkEdgeDetect3_2:
Result := M33is(0, -1, 0, 0, 2, 0, 0, -1, 0, 1);
pkEdgeDetect3_3:
Result := M33is(0, -1, 0, -1, 4, -1, 0, -1, 0, 1);
pkEdgeDetect3_4:
Result := M33is(1, 0, -1, 0, 0, 0, -1, 0, 1, 1);
pkEdgeDetect3_5:
Result := M33is(-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);
pkSobel3_1:
Result := M33is(1, 2, 1, 0, 0, 0, -1, -2, -1, 1);
pkSobel3_2:
Result := M33is(1, 0, -1, 2, 0, -2, 1, 0, -1, 1);
pkEmboss3:
Result := M33is(-2, -1, 0, -1, 1, 1, 0, 1, 2, 1);
else
Result := ZeroMatrix(3);
end;
end;
procedure TASPixmap.MotionBlurH(AAmount: Integer);
var
Radius: Integer;
tmp: TASPixmap;
px1, pxL, pxR: PASPixel;
i: Integer;
Raccum,
Gaccum,
Baccum: Integer;
y: Integer;
begin
if AAmount < 0 then
raise Exception.Create('TASPixmap.MotionBlurH: Amount must be non-negative.');
if AAmount = 0 then
Exit;
modd(AAmount);
Radius := AAmount div 2;
tmp := CloneWithBorderExtension(Radius, 0);
for y := 0 to Height - 1 do
begin
px1 := Self.LineData[y];
pxL := tmp.LineData[y];
pxR := pxL;
Raccum := 0;
Gaccum := 0;
Baccum := 0;
for i := -Radius to Radius do
begin
Inc(Raccum, pxR^.Red);
Inc(Gaccum, pxR^.Green);
Inc(Baccum, pxR^.Blue);
Inc(pxR);
end;
px1^ := pxli(Raccum div AAmount, Gaccum div AAmount, Baccum div AAmount);
Inc(px1);
for i := 1 to Width - 1 do
begin
Inc(Raccum, pxR^.Red - pxL^.Red);
Inc(Gaccum, pxR^.Green - pxL^.Green);
Inc(Baccum, pxR^.Blue - pxL^.Blue);
Inc(pxL);
Inc(pxR);
px1^ := pxli(Raccum div AAmount, Gaccum div AAmount, Baccum div AAmount);
Inc(px1);
end;
end;
end;
procedure TASPixmap.MotionBlurV(AAmount: Integer);
begin
Rot90P;
MotionBlurH(AAmount);
Rot90N;
end;
procedure TASPixmap.BoxBlur(AAmount: Integer);
begin
MotionBlurH(AAmount);
MotionBlurV(AAmount);
end;
procedure TASPixmap.GaussianBlur(AAmount: Integer; AIterations: Integer = 6);
var
i: Integer;
begin
for i := 1 to AIterations do
MotionBlurH(AAmount);
Rot90P;
for i := 1 to AIterations do
MotionBlurH(AAmount);
Rot90N;
end;
procedure TASPixmap.QuickFadeToBlack;
var
i: Integer;
begin
for i := 0 to PixelCount - 1 do
with FPixels[i] do
begin
Red := Red div 2;
Green := Green div 2;
Blue := Blue div 2;
end;
end;
procedure TASPixmap.QuickFadeToWhite;
var
i: Integer;
begin
for i := 0 to PixelCount - 1 do
with FPixels[i] do
begin
Red := Red + (255 - Red) div 2;
Green := Green + (255 - Green) div 2;
Blue := Blue + (255 - Blue) div 2;
end;
end;
procedure TASPixmap.FadeToColor(const AColor: TColor; const AFraction: Double = 0.5);
var
i: Integer;
pxl: TASPixel;
begin
pxl := AColor;
for i := 0 to PixelCount - 1 do
FPixels[i] := (1 - AFraction) * FPixels[i] + AFraction * pxl;
end;
procedure TASPixmap.EveryOtherToColor(const AColor: TColor; N: Integer);
var
y, x: Integer;
pxl: TASPixel;
Opposite: Boolean;
begin
if N = 0 then
raise Exception.Create('Denominator cannot be zero.');
Opposite := N < 0;
pxl := AColor;
if Opposite then
begin
N := -N;
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
if (y mod N <> 0) or (x mod N <> 0) then
Pixels[x, y] := pxl;
end
else
begin
for y := 0 to Height - 1 do
if y mod N = 0 then
for x := 0 to Width - 1 do
if x mod N = 0 then
Pixels[x, y] := pxl;
end;
end;
procedure TASPixmap.EveryOtherToColor(AColorFcn: TPixmapColorFcn; N: Integer);
var
y, x: Integer;
Opposite: Boolean;
begin
if N = 0 then
raise Exception.Create('Denominator cannot be zero.');
Opposite := N < 0;
if Opposite then
begin
N := -N;
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
if (y mod N <> 0) or (x mod N <> 0) then
Pixels[x, y] := AColorFcn(x, y);
end
else
begin
for y := 0 to Height - 1 do
if y mod N = 0 then
for x := 0 to Width - 1 do
if x mod N = 0 then
Pixels[x, y] := AColorFcn(x, y);
end;
end;
procedure TASPixmap.RandomToColor(const AColor: TColor; const AProb: TASR);
var
i: Integer;
pxl: TASPixel;
begin
pxl := AColor;
for i := 0 to PixelCount - 1 do
if Random < AProb then
FPixels[i] := pxl;
end;
procedure TASPixmap.RandomToColor(AColorFcn: TPixmapColorFcn; const AProb: TASR);
var
i: Integer;
begin
for i := 0 to PixelCount - 1 do
if Random < AProb then
FPixels[i] := AColorFcn(i mod Width, i div Width);
end;
procedure TASPixmap.ShufflePixels;
begin
TShuffler<TASPixel>.Shuffle(TArray<TASPixel>(FPixels));
end;
procedure TASPixmap.SetPixelsFrom(const tmp: TASPixmap);
begin
Self.Alloc(tmp.Width, tmp.Height);
Self.FPixels := tmp.FPixels;
end;
procedure TASPixmap.Wind(const AProbability: Double; const ADistance: Integer;
const AFading: Double);
var
y, x, i: Integer;
W: Integer;
L: PASPixel;
t: Double;
begin
if not InRange(AProbability, 0, 1) then
raise EPixmapException.Create('Invalid probability.');
if not InRange(AFading, 0, 1) then
raise EPixmapException.Create('Invalid fading.');
if ADistance = 0 then
Exit;
if ADistance < 0 then
raise EPixmapException.Create('Invalid distance.');
for y := 0 to Height - 1 do
begin
L := LineData[y];
x := 1;
while x < Width - 2 do
begin
if Random < AProbability then
begin
W := (ADistance + Round(Random * ADistance)) div 2;
for i := x to Min(x + W, Width) - 1 do
begin
t := AFading * (i - x) / W;
L[i] := (1 - t) * L[x] + t * L[i]
end;
Inc(x, W);
end
else
Inc(x);
end;
end;
end;
procedure TASPixmap.RandomHorizontalRotation(const AAmount: Integer);
begin
CustomHorizontalRotation(function(Index: Integer): Integer
begin
Result := Random(AAmount);
end);
end;
procedure TASPixmap.RandomVerticalRotation(const AAmount: Integer);
begin
CustomVerticalRotation(function(Index: Integer): Integer
begin
Result := Random(AAmount);
end);
end;
procedure TASPixmap.RippleH(const AAmplitude: Integer; const AWavelength: Integer);
begin
if AWavelength <= 0 then
raise EPixmapException.Create('The wavelength must be positive.');
CustomHorizontalRotation(function(Index: Integer): Integer
begin
Result := Round(AAmplitude * Sin(2 * Pi * Index / AWavelength));
end);
end;
procedure TASPixmap.RippleV(const AAmplitude: Integer; const AWavelength: Integer);
begin
if AWavelength <= 0 then
raise EPixmapException.Create('The wavelength must be positive.');
CustomVerticalRotation(function(Index: Integer): Integer
begin
Result := Round(AAmplitude * Sin(2 * Pi * Index / AWavelength));
end);
end;
function TASPixmap.ExtractRGBChannel(const AChannel: TRGBChannelType): TASPixmap;
var
i: Integer;
begin
Result := TASPixmap.CreateUninitialized(Width, Height);
case AChannel of
rgbRed:
for i := 0 to PixelCount - 1 do
Result.FPixels[i] := pxli(FPixels[i].Red);
rgbGreen:
for i := 0 to PixelCount - 1 do
Result.FPixels[i] := pxli(FPixels[i].Green);
rgbBlue:
for i := 0 to PixelCount - 1 do
Result.FPixels[i] := pxli(FPixels[i].Blue);
end
end;
function TASPixmap.ExtractHSVChannel(const AChannel: THSVChannelType): TASPixmap;
var
i: Integer;
clr: THSV;
begin
Result := TASPixmap.CreateUninitialized(Width, Height);
for i := 0 to PixelCount - 1 do
begin
clr := THSV(TRGB(FPixels[i]));
case AChannel of
hsvHue:
Result.FPixels[i] := pxlf(clr.Hue / 360);
hsvSaturation:
Result.FPixels[i] := pxlf(clr.Saturation);
hsvValue:
Result.FPixels[i] := pxlf(clr.Value);
end;
end;
end;
function TASPixmap.ExtractHSLChannel(const AChannel: THSLChannelType): TASPixmap;
var
i: Integer;
clr: THSL;
begin
Result := TASPixmap.CreateUninitialized(Width, Height);
for i := 0 to PixelCount - 1 do
begin
clr := THSL(TRGB(FPixels[i]));
case AChannel of
hslHue:
Result.FPixels[i] := pxlf(clr.Hue / 360);
hslSaturation:
Result.FPixels[i] := pxlf(clr.Saturation);
hslLightness:
Result.FPixels[i] := pxlf(clr.Lightness);
end;
end;
end;
function TASPixmap.IsGreyscale: Boolean;
var
i: Integer;
begin
for i := 0 to PixelCount - 1 do
if not FPixels[i].IsGrey then
Exit(False);
Result := True;
end;
procedure TASPixmap.DrawDisk(const APoint: TPoint; const AColor: TASPixel;
const ARadius: Integer = 2);
var
RadiusSqr: Integer;
x, y, yp: Integer;
xlim, xfrom, xto: Integer;
row: PASPixel;
begin
RadiusSqr := ARadius * ARadius;
y := ARadius;
yp := APoint.Y - y;
if yp < 0 then
begin
Dec(y, -yp);
yp := 0;
end;
while y >= -ARadius do
begin
if yp >= Height then
Exit;
xlim := Trunc(Sqrt(RadiusSqr - y * y));
xfrom := APoint.X - xlim;
xto := APoint.X + xlim;
if (xto >= 0) and (xfrom < Width) then
begin
if xfrom < 0 then
xfrom := 0;
if xto >= Width then
xto := Width - 1;
row := LineData[yp];
for x := xfrom to xto do
row[x] := AColor;
end;
Dec(y);
Inc(yp);
end;
end;
procedure TASPixmap.DrawDisk(const APoint: TPoint);
begin
DrawDisk(APoint, clBlack);
end;
procedure TASPixmap.DrawDisks(const APoints: array of TPoint;
const AColor: TASPixel; const ARadius: Integer = 2);
var
i: Integer;
begin
for i := 0 to High(APoints) do
DrawDisk(APoints[i], AColor, ARadius);
end;
procedure TASPixmap.DrawDisks(const APoints: array of TPoint);
begin
DrawDisks(APoints, clBlack);
end;
procedure TASPixmap.DrawSquare(const APoint: TPoint; const AColor: TASPixel;
const ASide: Integer = 4);
var
HalfSide, HalfSide2: Integer;
begin
HalfSide := ASide div 2;
HalfSide2 := ASide - HalfSide;
FillRect(Rect(APoint.X - HalfSide, APoint.Y - HalfSide,
APoint.X + HalfSide2, APoint.Y + HalfSide2), AColor);
end;
procedure TASPixmap.DrawSquare(const APoint: TPoint);
begin
DrawSquare(APoint, clBlack);
end;
procedure TASPixmap.DrawSquares(const APoints: array of TPoint;
const AColor: TASPixel; const ASide: Integer = 4);
var
i: Integer;
begin
for i := 0 to High(APoints) do
DrawSquare(APoints[i], AColor, ASide);
end;
procedure TASPixmap.DrawSquares(const APoints: array of TPoint);
begin
DrawSquares(APoints, clBlack);
end;
class function TASPixmap.RGBCombine(const ARed, AGreen, ABlue: TASPixmap): TASPixmap;
var
i: Integer;
begin
if not SameSize([ARed, AGreen, ABlue]) then
raise EPixmapException.Create('Pixmaps are not of the same size.');
Result := TASPixmap.CreateUninitialized(ARed.Width, ARed.Height);
for i := 0 to Result.PixelCount - 1 do
Result.FPixels[i] := pxli(ARed.FPixels[i].Red, AGreen.FPixels[i].Green, ABlue.FPixels[i].Blue);
end;
class function TASPixmap.HSVCombine(const AHue, ASaturation, AValue: TASPixmap): TASPixmap;
var
i: Integer;
begin
if not SameSize([AHue, ASaturation, AValue]) then
raise EPixmapException.Create('Pixmaps are not of the same size.');
Result := TASPixmap.CreateUninitialized(AHue.Width, AHue.Height);
for i := 0 to Result.PixelCount - 1 do
Result.FPixels[i] := TRGB(
THSV.Create(
360 * AHue.FPixels[i].Red / 255,
ASaturation.FPixels[i].Red / 255,
AValue.FPixels[i].Red / 255
)
);
end;
procedure TASPixmap.AssignFromBitmap(ABitmap: TBitmap);
var
sl: PScanline;
y: Integer;
i: Integer;
begin
if not Assigned(ABitmap) then
raise EPixmapException.Create('TASPixmap.AssignFromBitmap: Bitmap is nil.');
if ABitmap.PixelFormat <> pf32bit then
raise EPixmapException.Create('TASPixmap.AssignFromBitmap: Bitmap has incorrect pixel format.');
Alloc(ABitmap.Width, ABitmap.Height);
FBackgroundColor := clWhite;
for y := 0 to FHeight - 1 do
begin
sl := ABitmap.ScanLine[y];
Move(sl^[0], FPixels[y * FWidth], FWidth * sizeof(sl^[0]));
end;
for i := 0 to PixelCount - 1 do
Data[i].Alpha := $FF;
end;
procedure TASPixmap.AssignToBitmap(ABitmap: TBitmap);
var
sl: PScanline;
y: Integer;
begin
if not Assigned(ABitmap) then
raise EPixmapException.Create('TASPixmap.AssignToBitmap: Bitmap is nil.');
ABitmap.SetSize(FWidth, FHeight);
ABitmap.PixelFormat := pf32bit;
for y := 0 to FHeight - 1 do
begin
sl := ABitmap.ScanLine[y];
Move(FPixels[y * FWidth], sl^[0], FWidth * sizeof(sl^[0]));
end;
end;
function TASPixmap.CreateGDIBitmap: TBitmap;
begin
Result := TBitmap.Create;
try
AssignToBitmap(Result);
except
Result.Free;
end;
end;
procedure TASPixmap.DrawTo(ACanvas: TCanvas; X, Y: Integer);
var
bm: TBitmap;
begin
bm := CreateGDIBitmap;
try
ACanvas.Draw(X, Y, bm);
finally
bm.Free;
end;
end;
procedure TASPixmap.Draw(const APixmap: TASPixmap; X, Y: Integer);
var
SelfTopLeft: TPoint;
LayerTopLeft: TPoint;
ActualWidth,
ActualHeight: Integer;
SelfY, LayerY: Integer;
begin
SelfTopLeft.X := Max(X, 0);
SelfTopLeft.Y := Max(Y, 0);
LayerTopLeft.X := Max(-X, 0);
LayerTopLeft.Y := Max(-Y, 0);
ActualWidth := APixmap.Width - Max(X + APixmap.Width - Self.Width, 0) - LayerTopLeft.X;
ActualHeight := APixmap.Height - Max(Y + APixmap.Height - Self.Height, 0) - LayerTopLeft.Y;
LayerY := LayerTopLeft.Y;
for SelfY := SelfTopLeft.Y to SelfTopLeft.Y + ActualHeight - 1 do
begin
Move(APixmap.FPixels[LayerY * APixmap.Width + LayerTopLeft.X],
Self.FPixels[SelfY * Self.Width + SelfTopLeft.X],
ActualWidth * sizeof(TASPixel));
Inc(LayerY);
end;
end;
procedure TASPixmap.Draw(const APixmap: TASPixmap; X, Y: Integer;
const AOpacity: Double; ABlendMode: TBlendMode);
begin
InternalDraw(APixmap, X, Y, [osParameter], AOpacity, ABlendMode);
end;
procedure TASPixmap.Fill(const AColor: TASPixel);
var
i: Integer;
Pixel: TASPixel;
begin
Pixel := AColor;
for i := 0 to PixelCount - 1 do
FPixels[i] := Pixel;
end;
procedure TASPixmap.FillRect(const ARect: TRect; const AColor: TASPixel);
var
R: TRect;
y: Integer;
x: Integer;
Pixel: TASPixel;
p: PASPixel;
begin
Pixel := AColor;
R.Top := Max(ARect.Top, 0);
R.Left := Max(ARect.Left, 0);
R.Bottom := Min(ARect.Bottom, Self.Height);
R.Right := Min(ARect.Right, Self.Width);
for y := R.Top to R.Bottom - 1 do
begin
p := LineData[y];
for x := R.Left to R.Right - 1 do
p[x] := Pixel;
end;
end;
procedure TASPixmap.Free;
begin
SetLength(FPixels, 0);
FWidth := 0;
FHeight := 0;
end;
function TASPixmap.GetData: PASPixel;
begin
Result := Pointer(FPixels);
end;
function TASPixmap.GetLineData(Line: Integer): PASPixel;
begin
Result := @FPixels[Line * Width];
end;
function TASPixmap.GetPixel(X, Y: Integer): TASPixel;
begin
Result := FPixels[Y * FWidth + X];
end;
function TASPixmap.GetPixelSafe(X, Y: Integer): TASPixel;
begin
if PixelExists(X, Y) then
Result := FPixels[Y * FWidth + X]
else
Result := FBackgroundColor;
end;
function TASPixmap.GetPixelInR2(X, Y: Integer): TASPixel;
begin
Result := SafePixels[X + Width div 2, Height div 2 - Y]
end;
function TASPixmap.GetPixelCount: Integer;
begin
Result := FWidth * FHeight;
end;
function TASPixmap.CreateColorFreqDict: TDictionary<TColor, Integer>;
var
i, Cnt: Integer;
Clr: TColor;
begin
Result := TDictionary<TColor, Integer>.Create;
try
for i := 0 to High(FPixels) do
begin
Clr := FPixels[i].WithoutAlpha;
if Result.TryGetValue(Clr, Cnt) then
Result[Clr] := Cnt + 1
else
Result.Add(Clr, 1);
end;
except
Result.Free;
raise;
end;
end;
function TASPixmap.GetColorCount: Integer;
var
Colors: TDictionary<TColor, Pointer>;
i: Integer;
begin
Colors := TDictionary<TColor, Pointer>.Create;
try
for i := 0 to High(FPixels) do
Colors.AddOrSetValue(FPixels[i].WithoutAlpha, nil);
Result := Colors.Count;
finally
Colors.Free;
end;
end;
function TASPixmap.GetMemoryUsage: Integer;
begin
Result := sizeof(Self) + PixelCount * sizeof(TASPixel);
end;
procedure TASPixmap.Clear;
begin
Fill(FBackgroundColor);
end;
function TASPixmap.Clone: TASPixmap;
begin
Result := TASPixmap.Create(Self);
end;
function TASPixmap.CloneWithBorder(ABorderWidth: Integer; ABorderColor: TColor): TASPixmap;
begin
Result := CloneWithBorder(ABorderWidth, ABorderWidth, ABorderColor);
end;
function TASPixmap.CloneWithBorder(ABorderWidthX: Integer;
ABorderWidthY: Integer; ABorderColor: TColor): TASPixmap;
begin
if (ABorderWidthX < 0) or (ABorderWidthY < 0) then
raise EPixmapException.Create('TASPixmap.CloneWithBorder: Negative border width.');
Result := TASPixmap.CreateUninitialized(Width + 2 * ABorderWidthX,
Height + 2 * ABorderWidthY);
Result.Draw(Self, ABorderWidthX, ABorderWidthY);
Result.FillRect(Rect(0, 0, Width + 2 * ABorderWidthX, ABorderWidthY),
ABorderColor);
Result.FillRect(Rect(0, Height + ABorderWidthY, Width + 2 * ABorderWidthX,
Height + 2 * ABorderWidthY), ABorderColor);
Result.FillRect(Rect(0, ABorderWidthY, ABorderWidthX, Height + ABorderWidthY),
ABorderColor);
Result.FillRect(Rect(Width + ABorderWidthX, ABorderWidthY,
Width + 2 * ABorderWidthX, Height + ABorderWidthY), ABorderColor);
end;
function TASPixmap.CloneWithBorderExtension(ABorderWidth: Integer): TASPixmap;
begin
Result := CloneWithBorderExtension(ABorderWidth, ABorderWidth);
end;
function TASPixmap.CloneWithBorderExtension(ABorderWidthX, ABorderWidthY: Integer): TASPixmap;
var
x, y: Integer;
begin
if (ABorderWidthX < 0) or (ABorderWidthY < 0) then
raise EPixmapException.Create('TASPixmap.CloneWithBorderExtension: Negative border width.');
Result := TASPixmap.CreateUninitialized(Width + 2 * ABorderWidthX,
Height + 2 * ABorderWidthY);
Result.Draw(Self, ABorderWidthX, ABorderWidthY);
for x := ABorderWidthX to Width + ABorderWidthX - 1 do
begin
for y := 0 to ABorderWidthY - 1 do
Result.Pixels[x, y] := Result.Pixels[x, ABorderWidthY];
for y := Height + ABorderWidthY to Height + 2*ABorderWidthY - 1 do
Result.Pixels[x, y] := Result.Pixels[x, Height + ABorderWidthY - 1];
end;
for y := ABorderWidthY to Height + ABorderWidthY - 1 do
begin
for x := 0 to ABorderWidthX - 1 do
Result.Pixels[x, y] := Result.Pixels[ABorderWidthX, y];
for x := Width + ABorderWidthX to Width + 2*ABorderWidthX - 1 do
Result.Pixels[x, y] := Result.Pixels[Width + ABorderWidthX - 1, y];
end;
Result.FillRect(Rect(0, 0, ABorderWidthX, ABorderWidthY),
Result.Pixels[ABorderWidthX, ABorderWidthY]);
Result.FillRect(Rect(Width + ABorderWidthX, 0, Width + 2 * ABorderWidthX, ABorderWidthY),
Result.Pixels[Width + ABorderWidthX - 1, ABorderWidthY]);
Result.FillRect(Rect(0, Height + ABorderWidthY, ABorderWidthX, Height + 2*ABorderWidthY),
Result.Pixels[ABorderWidthX, Height + ABorderWidthY - 1]);
Result.FillRect(Rect(Width + ABorderWidthX, Height + ABorderWidthY, Width + 2*ABorderWidthX, Height + 2*ABorderWidthY),
Result.Pixels[Width + ABorderWidthX - 1, Height + ABorderWidthY - 1]);
end;
procedure TASPixmap.CopyToClipboard;
var
bm: TBitmap;
begin
bm := CreateGDIBitmap;
try
Clipboard.Assign(bm);
finally
bm.Free;
end;
end;
class function TASPixmap.CreateGradient(const AWidth, AHeight: Integer;
const AFromColor, AToColor: TColor): TASPixmap;
var
y, x: Integer;
p: PASPixel;
pix: TASPixel;
c, delta: TRGB;
begin
Result := TASPixmap.CreateUninitialized(AWidth, AHeight);
c := AFromColor;
delta := (TRGB(AToColor) - TRGB(AFromColor)) / (AHeight - 1);
for y := 0 to AHeight - 1 do
begin
p := Result.LineData[y];
pix := c;
for x := 0 to AWidth - 1 do
p[x] := pix;
c := c + delta;
end;
end;
class function TASPixmap.PerlinNoise(const AWidth, AHeight: Integer): TASPixmap;
function f(X: Double): Double; inline;
begin
Result := X*X*X*(X*(X*6 - 15) + 10);
end;
const
DeltaX = 100;
DeltaY = 100;
var
LenX, LenY: Integer;
sx, cx: Extended;
Gradients: array of array of TRealVector;
lx, ly, ux, uy: Integer;
c0, c1, c2, c3: Double;
tx, ty: Double;
v1, v2, v0: Double;
p: PASPixel;
y, x: Integer;
begin
Result := TASPixmap.CreateUninitialized(AWidth, AHeight);
LenX := AWidth div DeltaX + 2;
LenY := AHeight div DeltaY + 2;
SetLength(Gradients, LenY, LenX);
for y := 0 to LenY - 1 do
for x := 0 to LenX - 1 do
begin
SinCos(2*pi*Random, sx, cx);
Gradients[y, x] := ASR2(cx, sx);
end;
for y := 0 to AHeight - 1 do
begin
p := Result.LineData[y];
for x := 0 to AWidth - 1 do
begin
lx := x div DeltaX;
ux := lx + 1;
ly := y div DeltaY;
uy := ly + 1;
c0 := -(ASR2(lx * DeltaX, ly * DeltaY) - ASR2(x, y)).NormalizedIfNonzero * Gradients[ly, lx];
c1 := (ASR2(ux * DeltaX, ly * DeltaY) - ASR2(x, y)).NormalizedIfNonzero * Gradients[ly, ux];
c2 := -(ASR2(ux * DeltaX, uy * DeltaY) - ASR2(x, y)).NormalizedIfNonzero * Gradients[uy, ux];
c3 := (ASR2(lx * DeltaX, uy * DeltaY) - ASR2(x, y)).NormalizedIfNonzero * Gradients[uy, lx];
tx := (x - lx * DeltaX) / DeltaX;
ty := (y - ly * DeltaY) / DeltaY;
v1 := f(1 - tx) * c0 + f(tx) * c1;
v2 := f(1 - tx) * c3 + f(tx) * c2;
v0 := f(1 - ty) * v1 + f(ty) * v2;
p[x] := pxlf(0.17 + (1+v0)/3, 0.17 + (1+sin(v0))/3, 0.17 + (1+cos(v0))/3);
end;
end;
end;
class function TASPixmap.Voronoi(const AWidth, AHeight: Integer;
const ASites: array of TPoint; const AColors: array of TASPixel;
AMetric: TFunc<TPoint, TPoint, Double>): TASPixmap;
var
minindex: Integer;
mindist, newdist: Double;
y, x, i: Integer;
line: PASPixel;
begin
if Length(ASites) <> Length(AColors) then
raise EPixmapException.Create('Voronoi: The number of sites must equal the number of colors.');
if Length(ASites) = 0 then
Exit(TASPixmap.Create(AWidth, AHeight));
Result := TASPixmap.CreateUninitialized(AWidth, AHeight);
for y := 0 to AHeight - 1 do
begin
line := Result.LineData[y];
for x := 0 to AWidth - 1 do
begin
minindex := 0;
mindist := AMetric(Point(x, y), ASites[0]);
for i := 1 to High(ASites) do
begin
newdist := AMetric(Point(x, y), ASites[i]);
if newdist < mindist then
begin
mindist := newdist;
minindex := i;
end;
end;
line[x] := AColors[minindex];
end;
end;
end;
class function TASPixmap.Voronoi(const AWidth, AHeight: Integer;
const ASites: array of TPoint; const AColors: array of TASPixel): TASPixmap;
begin
Result := Voronoi(AWidth, AHeight, ASites, AColors,
function(A, B: TPoint): Double
var
DX, DY: Integer;
begin
DX := A.X - B.X;
DY := A.Y - B.Y;
Result := DX * DX + DY * DY;
end);
end;
class operator TASPixel.Implicit(const AColor: TColor): TASPixel;
begin
Result.Blue := GetBValue(AColor);
Result.Green := GetGValue(AColor);
Result.Red := GetRValue(AColor);
Result.Alpha := $FF;
end;
class operator TASPixel.Implicit(const APixel: TASPixel): TColor;
begin
Result := RGB(APixel.Red, APixel.Green, APixel.Blue);
end;
class operator TASPixel.Implicit(const AColor: TRGB): TASPixel;
begin
Result.Blue := Round(255*AColor.Blue);
Result.Green := Round(255*AColor.Green);
Result.Red := Round(255*AColor.Red);
Result.Alpha := $FF;
end;
class operator TASPixel.Implicit(const APixel: TASPixel): TRGB;
begin
Result.Red := APixel.Red / 255;
Result.Green := APixel.Green / 255;
Result.Blue := APixel.Blue / 255;
end;
class operator TASPixel.Add(const APixel1, APixel2: TASPixel): TASPixel;
begin
Result.Blue := InlinedEnsureRange(APixel1.Blue + APixel2.Blue, 0, 255);
Result.Green := InlinedEnsureRange(APixel1.Green + APixel2.Green, 0, 255);
Result.Red := InlinedEnsureRange(APixel1.Red + APixel2.Red, 0, 255);
Result.Alpha := $FF;
end;
class operator TASPixel.Subtract(const APixel1, APixel2: TASPixel): TRealVector;
begin
Result := ASR3((APixel1.Red - APixel2.Red) / 255,
(APixel1.Green - APixel2.Green) / 255,
(APixel1.Blue - APixel2.Blue) / 255);
end;
class operator TASPixel.Multiply(const AFactor: Double; const APixel: TASPixel): TASPixel;
begin
Result.Blue := Round(AFactor * APixel.Blue);
Result.Green := Round(AFactor * APixel.Green);
Result.Red := Round(AFactor * APixel.Red);
Result.Alpha := $FF;
end;
class operator TASPixel.Equal(const APixel1, APixel2: TASPixel): Boolean;
begin
Result := CompareMem(@APixel1, @APixel2, sizeof(TASPixel));
end;
class operator TASPixel.NotEqual(const APixel1, APixel2: TASPixel): Boolean;
begin
Result := not (APixel1 = APixel2);
end;
function TASPixel.WithoutAlpha: TASPixel;
begin
PCardinal(@Result)^ := PCardinal(@Self)^ and $00FFFFFF;
end;
function TASPixel.Sum: Integer;
begin
Result := Red + Green + Blue;
end;
function TASPixel.Average: Byte;
begin
Result := Sum div 3;
end;
function TASPixel.IsGrey: Boolean;
begin
Result := (Red = Green) and (Green = Blue);
end;
class function TASPixel.GetRandomPixel: TASPixel;
begin
Result := pxli(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)));
end;
procedure TRGBAdjustmentParameters.Init;
begin
FillChar(Self, sizeof(Self), 0);
RedParams.RedFactor := 1;
GreenParams.GreenFactor := 1;
BlueParams.BlueFactor := 1;
end;
procedure THSVAdjustmentParameters.Init;
begin
FillChar(Self, sizeof(Self), 0);
HueParams.HueFactor := 1;
SaturationParams.SaturationFactor := 1;
ValueParams.ValueFactor := 1;
end;
function TBlendModeHelper.AsString: string;
begin
Result := BlendModeNames[Self];
end;
class function TBlendModeHelper.FromString(const AName: string): TBlendMode;
var
bm: TBlendMode;
begin
for bm := Low(TBlendMode) to High(TBlendMode) do
if SameText(bm.AsString, AName) then
Exit(bm);
raise EPixmapException.CreateFmt('Undefined blend mode "%s".', [AName]);
end;
end.