src/lib/vampimg/ImagingCanvases.pas

   1 {
   2   Vampyre Imaging Library
   3   by Marek Mauder
   4   http://imaginglib.sourceforge.net
   5
   6   The contents of this file are used with permission, subject to the Mozilla
   7   Public License Version 1.1 (the "License"); you may not use this file except
   8   in compliance with the License. You may obtain a copy of the License at
   9   http://www.mozilla.org/MPL/MPL-1.1.html
  10
  11   Software distributed under the License is distributed on an "AS IS" basis,
  12   WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  13   the specific language governing rights and limitations under the License.
  14
  15   Alternatively, the contents of this file may be used under the terms of the
  16   GNU Lesser General Public License (the  "LGPL License"), in which case the
  17   provisions of the LGPL License are applicable instead of those above.
  18   If you wish to allow use of your version of this file only under the terms
  19   of the LGPL License and not to allow others to use your version of this file
  20   under the MPL, indicate your decision by deleting  the provisions above and
  21   replace  them with the notice and other provisions required by the LGPL
  22   License.  If you do not delete the provisions above, a recipient may use
  23   your version of this file under either the MPL or the LGPL License.
  24
  25   For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  26 }
  27
  28 { This unit contains canvas classes for drawing and applying effects.}
  29 unit ImagingCanvases;
  30
  31 {$I ImagingOptions.inc}
  32
  33 interface
  34
  35 uses
  36   SysUtils, Types, Classes, ImagingTypes, Imaging, ImagingClasses,
  37   ImagingFormats, ImagingUtility;
  38
  39 const
  40   { Color constants in ifA8R8G8B8 format.}
  41   pcClear   = $00000000;
  42   pcBlack   = $FF000000;
  43   pcWhite   = $FFFFFFFF;
  44   pcMaroon  = $FF800000;
  45   pcGreen   = $FF008000;
  46   pcOlive   = $FF808000;
  47   pcNavy    = $FF000080;
  48   pcPurple  = $FF800080;
  49   pcTeal    = $FF008080;
  50   pcGray    = $FF808080;
  51   pcSilver  = $FFC0C0C0;
  52   pcRed     = $FFFF0000;
  53   pcLime    = $FF00FF00;
  54   pcYellow  = $FFFFFF00;
  55   pcBlue    = $FF0000FF;
  56   pcFuchsia = $FFFF00FF;
  57   pcAqua    = $FF00FFFF;
  58   pcLtGray  = $FFC0C0C0;
  59   pcDkGray  = $FF808080;
  60
  61   MaxPenWidth = 256;
  62
  63 type
  64   EImagingCanvasError = class(EImagingError);
  65   EImagingCanvasBlendingError = class(EImagingError);
  66
  67   { Fill mode used when drawing filled objects on canvas.}
  68   TFillMode = (
  69     fmSolid,  // Solid fill using current fill color
  70     fmClear   // No filling done
  71   );
  72
  73   { Pen mode used when drawing lines, object outlines, and similar on canvas.}
  74   TPenMode = (
  75     pmSolid,  // Draws solid lines using current pen color.
  76     pmClear   // No drawing done
  77   );
  78
  79   { Source and destination blending factors for drawing functions with blending.
  80     Blending formula: SrcColor * SrcFactor + DestColor * DestFactor }
  81   TBlendingFactor = (
  82     bfIgnore,           // Don't care
  83     bfZero,             // For Src and Dest, Factor = (0, 0, 0, 0)
  84     bfOne,              // For Src and Dest, Factor = (1, 1, 1, 1)
  85     bfSrcAlpha,         // For Src and Dest, Factor = (Src.A, Src.A, Src.A, Src.A)
  86     bfOneMinusSrcAlpha, // For Src and Dest, Factor = (1 - Src.A, 1 - Src.A, 1 - Src.A, 1 - Src.A)
  87     bfDstAlpha,         // For Src and Dest, Factor = (Dest.A, Dest.A, Dest.A, Dest.A)
  88     bfOneMinusDstAlpha, // For Src and Dest, Factor = (1 - Dest.A, 1 - Dest.A, 1 - Dest.A, 1 - Dest.A)
  89     bfSrcColor,         // For Dest,         Factor = (Src.R, Src.R, Src.B, Src.A)
  90     bfOneMinusSrcColor, // For Dest,         Factor = (1 - Src.R, 1 - Src.G, 1 - Src.B, 1 - Src.A)
  91     bfDstColor,         // For Src,          Factor = (Dest.R, Dest.G, Dest.B, Dest.A)
  92     bfOneMinusDstColor  // For Src,          Factor = (1 - Dest.R, 1 - Dest.G, 1 - Dest.B, 1 - Dest.A)
  93   );
  94
  95   { Procedure for custom pixel write modes with blending.}
  96   TPixelWriteProc = procedure(const SrcPix: TColorFPRec; DestPtr: PByte;
  97     DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
  98
  99   { Represents 3x3 convolution filter kernel.}
 100   TConvolutionFilter3x3 = record
 101     Kernel: array[0..2, 0..2] of LongInt;
 102     Divisor: LongInt;
 103     Bias: Single;
 104   end;
 105
 106   { Represents 5x5 convolution filter kernel.}
 107   TConvolutionFilter5x5 = record
 108     Kernel: array[0..4, 0..4] of LongInt;
 109     Divisor: LongInt;
 110     Bias: Single;
 111   end;
 112
 113   TPointTransformFunction = function(const Pixel: TColorFPRec;
 114     Param1, Param2, Param3: Single): TColorFPRec;
 115
 116   TDynFPPixelArray = array of TColorFPRec;
 117
 118   THistogramArray = array[Byte] of Integer;
 119
 120   TSelectPixelFunction = function(var Pixels: TDynFPPixelArray): TColorFPRec;
 121
 122   { Base canvas class for drawing objects, applying effects, and other.
 123     Constructor takes TBaseImage (or pointer to TImageData). Source image
 124     bits are not copied but referenced so all canvas functions affect
 125     source image and vice versa. When you change format or resolution of
 126     source image you must call UpdateCanvasState method (so canvas could
 127     recompute some data size related stuff).
 128
 129     TImagingCanvas works for all image data formats except special ones
 130     (compressed). Because of this its methods are quite slow (they usually work
 131     with colors in ifA32R32G32B32F format). If you want fast drawing you
 132     can use one of fast canvas clases. These descendants of TImagingCanvas
 133     work only for few select formats (or only one) but they are optimized thus
 134     much faster.
 135   }
 136   TImagingCanvas = class(TObject)
 137   private
 138     FDataSizeOnUpdate: LongInt;
 139     FLineRecursion: Boolean;
 140     function GetPixel32(X, Y: LongInt): TColor32; virtual;
 141     function GetPixelFP(X, Y: LongInt): TColorFPRec; virtual;
 142     function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
 143     procedure SetPixel32(X, Y: LongInt; const Value: TColor32); virtual;
 144     procedure SetPixelFP(X, Y: LongInt; const Value: TColorFPRec); virtual;
 145     procedure SetPenColor32(const Value: TColor32); {$IFDEF USE_INLINE}inline;{$ENDIF}
 146     procedure SetPenColorFP(const Value: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF}
 147     procedure SetPenWidth(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
 148     procedure SetFillColor32(const Value: TColor32); {$IFDEF USE_INLINE}inline;{$ENDIF}
 149     procedure SetFillColorFP(const Value: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF}
 150     procedure SetClipRect(const Value: TRect);
 151     procedure CheckBeforeBlending(SrcFactor, DestFactor: TBlendingFactor; DestCanvas: TImagingCanvas);
 152   protected
 153     FPData: PImageData;
 154     FClipRect: TRect;
 155     FPenColorFP: TColorFPRec;
 156     FPenColor32: TColor32;
 157     FPenMode: TPenMode;
 158     FPenWidth: LongInt;
 159     FFillColorFP: TColorFPRec;
 160     FFillColor32: TColor32;
 161     FFillMode: TFillMode;
 162     FNativeColor: TColorFPRec;
 163     FFormatInfo: TImageFormatInfo;
 164
 165     { Returns pointer to pixel at given position.}
 166     function GetPixelPointer(X, Y: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
 167     { Translates given FP color to native format of canvas and stores it
 168       in FNativeColor field (its bit copy) or user pointer (in overloaded method).}
 169     procedure TranslateFPToNative(const Color: TColorFPRec); overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
 170     procedure TranslateFPToNative(const Color: TColorFPRec; Native: Pointer); overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
 171     { Clipping function used by horizontal and vertical line drawing functions.}
 172     function ClipAxisParallelLine(var A1, A2, B: LongInt;
 173       AStart, AStop, BStart, BStop: LongInt): Boolean;
 174     { Internal horizontal line drawer used mainly for filling inside of objects
 175       like ellipses and circles.}
 176     procedure HorzLineInternal(X1, X2, Y: LongInt; Color: Pointer; Bpp: LongInt); virtual;
 177     procedure CopyPixelInternal(X, Y: LongInt; Pixel: Pointer; Bpp: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
 178     procedure DrawInternal(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 179       DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc);
 180     procedure StretchDrawInternal(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 181       const DestRect: TRect; SrcFactor, DestFactor: TBlendingFactor;
 182       Filter: TResizeFilter; PixelWriteProc: TPixelWriteProc);
 183   public
 184     constructor CreateForData(ImageDataPointer: PImageData);
 185     constructor CreateForImage(Image: TBaseImage);
 186     destructor Destroy; override;
 187
 188     { Call this method when you change size or format of image this canvas
 189       operates on (like calling ResizeImage, ConvertImage, or changing Format
 190       property of TBaseImage descendants).}
 191     procedure UpdateCanvasState; virtual;
 192     { Resets clipping rectangle to Rect(0, 0, ImageWidth, ImageHeight).}
 193     procedure ResetClipRect;
 194
 195     { Clears entire canvas with current fill color (ignores clipping rectangle
 196       and always uses fmSolid fill mode).}
 197     procedure Clear;
 198
 199     { Draws horizontal line with current pen settings.}
 200     procedure HorzLine(X1, X2, Y: LongInt); virtual;
 201     { Draws vertical line with current pen settings.}
 202     procedure VertLine(X, Y1, Y2: LongInt); virtual;
 203     { Draws line from [X1, Y1] to [X2, Y2] with current pen settings.}
 204     procedure Line(X1, Y1, X2, Y2: LongInt); virtual;
 205     { Draws a rectangle using current pen settings.}
 206     procedure FrameRect(const Rect: TRect);
 207     { Fills given rectangle with current fill settings.}
 208     procedure FillRect(const Rect: TRect); virtual;
 209     { Fills given rectangle with current fill settings and pixel blending.}
 210     procedure FillRectBlend(const Rect: TRect; SrcFactor, DestFactor: TBlendingFactor);
 211     { Draws rectangle which is outlined by using the current pen settings and
 212       filled by using the current fill settings.}
 213     procedure Rectangle(const Rect: TRect);
 214     { Draws ellipse which is outlined by using the current pen settings and
 215       filled by using the current fill settings. Rect specifies bounding rectangle
 216       of ellipse to be drawn.}
 217     procedure Ellipse(const Rect: TRect);
 218     { Fills area of canvas with current fill color starting at point [X, Y] and
 219       coloring its neighbors. Default flood fill mode changes color of all
 220       neighbors with the same color as pixel [X, Y]. With BoundaryFillMode
 221       set to True neighbors are recolored regardless of their old color,
 222       but area which will be recolored has boundary (specified by current pen color).}
 223     procedure FloodFill(X, Y: Integer; BoundaryFillMode: Boolean = False);
 224
 225     { Draws contents of this canvas onto another canvas with pixel blending.
 226       Blending factors are chosen using TBlendingFactor parameters.
 227       Resulting destination pixel color is:
 228         SrcColor * SrcFactor +  DstColor * DstFactor}
 229     procedure DrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 230       DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor);
 231     { Draws contents of this canvas onto another one with typical alpha
 232       blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
 233     procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); virtual;
 234     { Draws contents of this canvas onto another one using additive blending
 235       (source and dest factors are bfOne).}
 236     procedure DrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer);
 237     { Draws stretched and filtered contents of this canvas onto another canvas
 238       with pixel blending. Blending factors are chosen using TBlendingFactor parameters.
 239       Resulting destination pixel color is:
 240         SrcColor * SrcFactor +  DstColor * DstFactor}
 241     procedure StretchDrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 242       const DestRect: TRect; SrcFactor, DestFactor: TBlendingFactor;
 243       Filter: TResizeFilter = rfBilinear);
 244     { Draws contents of this canvas onto another one with typical alpha
 245       blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
 246     procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 247       const DestRect: TRect; Filter: TResizeFilter = rfBilinear); virtual;
 248     { Draws contents of this canvas onto another one using additive blending
 249       (source and dest factors are bfOne).}
 250     procedure StretchDrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 251       const DestRect: TRect; Filter: TResizeFilter = rfBilinear);
 252
 253     { Convolves canvas' image with given 3x3 filter kernel. You can use
 254       predefined filter kernels or define your own.}
 255     procedure ApplyConvolution3x3(const Filter: TConvolutionFilter3x3);
 256     { Convolves canvas' image with given 5x5 filter kernel. You can use
 257       predefined filter kernels or define your own.}
 258     procedure ApplyConvolution5x5(const Filter: TConvolutionFilter5x5);
 259     { Computes 2D convolution of canvas' image and given filter kernel.
 260       Kernel is in row format and KernelSize must be odd number >= 3. Divisor
 261       is normalizing value based on Kernel (usually sum of all kernel's cells).
 262       The Bias number shifts each color value by a fixed amount (color values
 263       are usually in range [0, 1] during processing). If ClampChannels
 264       is True all output color values are clamped to [0, 1]. You can use
 265       predefined filter kernels or define your own.}
 266     procedure ApplyConvolution(Kernel: PLongInt; KernelSize, Divisor: LongInt;
 267       Bias: Single = 0.0; ClampChannels: Boolean = True); virtual;
 268
 269     { Applies custom non-linear filter. Filter size is diameter of pixel
 270       neighborhood. Typical values are 3, 5, or 7. }
 271     procedure ApplyNonLinearFilter(FilterSize: Integer; SelectFunc: TSelectPixelFunction);
 272     { Applies median non-linear filter with user defined pixel neighborhood.
 273       Selects median pixel from the neighborhood as new pixel
 274       (current implementation is quite slow).}
 275     procedure ApplyMedianFilter(FilterSize: Integer);
 276     { Applies min non-linear filter with user defined pixel neighborhood.
 277       Selects min pixel from the neighborhood as new pixel.}
 278     procedure ApplyMinFilter(FilterSize: Integer);
 279     { Applies max non-linear filter with user defined pixel neighborhood.
 280       Selects max pixel from the neighborhood as new pixel.}
 281     procedure ApplyMaxFilter(FilterSize: Integer);
 282
 283     { Transforms pixels one by one by given function. Pixel neighbors are
 284       not taken into account. Param 1-3 are optional parameters
 285       for transform function.}
 286     procedure PointTransform(Transform: TPointTransformFunction;
 287       Param1, Param2, Param3: Single);
 288     { Modifies image contrast and brightness. Parameters should be
 289       in range <-100; 100>.}
 290     procedure ModifyContrastBrightness(Contrast, Brightness: Single);
 291     { Gamma correction of individual color channels. Range is (0, +inf),
 292       1.0 means no change.}
 293     procedure GammaCorection(Red, Green, Blue: Single);
 294     { Inverts colors of all image pixels, makes negative image. Ignores alpha channel.}
 295     procedure InvertColors; virtual;
 296     { Simple single level thresholding with threshold level (in range [0, 1])
 297       for each color channel.}
 298     procedure Threshold(Red, Green, Blue: Single);
 299     { Adjusts the color levels of the image by scaling the
 300       colors falling between specified white and black points to full [0, 1] range.
 301       The black point specifies the darkest color in the image, white point
 302       specifies the lightest color, and mid point is gamma aplied to image.
 303       Black and white point must be in range [0, 1].}
 304     procedure AdjustColorLevels(BlackPoint, WhitePoint: Single; MidPoint: Single = 1.0);
 305     { Premultiplies color channel values by alpha. Needed for some platforms/APIs
 306       to display images with alpha properly.}
 307     procedure PremultiplyAlpha;
 308     { Reverses PremultiplyAlpha operation.}
 309     procedure UnPremultiplyAlpha;
 310
 311     { Calculates image histogram for each channel and also gray values. Each
 312       channel has 256 values available. Channel values of data formats with higher
 313       precision are scaled and rounded. Example: Red[126] specifies number of pixels
 314       in image with red channel = 126.}
 315     procedure GetHistogram(out Red, Green, Blue, Alpha, Gray: THistogramArray);
 316     { Fills image channel with given value leaving other channels intact.
 317       Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
 318       channel identifier.}
 319     procedure FillChannel(ChannelId: Integer; NewChannelValue: Byte); overload;
 320     { Fills image channel with given value leaving other channels intact.
 321       Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
 322       channel identifier.}
 323     procedure FillChannelFP(ChannelId: Integer; NewChannelValue: Single); overload;
 324
 325     { Color used when drawing lines, frames, and outlines of objects.}
 326     property PenColor32: TColor32 read FPenColor32 write SetPenColor32;
 327     { Color used when drawing lines, frames, and outlines of objects.}
 328     property PenColorFP: TColorFPRec read FPenColorFP write SetPenColorFP;
 329     { Pen mode used when drawing lines, object outlines, and similar on canvas.}
 330     property PenMode: TPenMode read FPenMode write FPenMode;
 331     { Width with which objects like lines, frames, etc. (everything which uses
 332       PenColor) are drawn.}
 333     property PenWidth: LongInt read FPenWidth write SetPenWidth;
 334     { Color used for filling when drawing various objects.}
 335     property FillColor32: TColor32 read FFillColor32 write SetFillColor32;
 336     { Color used for filling when drawing various objects.}
 337     property FillColorFP: TColorFPRec read FFillColorFP write SetFillColorFP;
 338     { Fill mode used when drawing filled objects on canvas.}
 339     property FillMode: TFillMode read FFillMode write FFillMode;
 340     { Specifies the current color of the pixels of canvas. Native pixel is
 341       read from canvas and then translated to 32bit ARGB. Reverse operation
 342       is made when setting pixel color.}
 343     property Pixels32[X, Y: LongInt]: TColor32 read GetPixel32 write SetPixel32;
 344     { Specifies the current color of the pixels of canvas. Native pixel is
 345       read from canvas and then translated to FP ARGB. Reverse operation
 346       is made when setting pixel color.}
 347     property PixelsFP[X, Y: LongInt]: TColorFPRec read GetPixelFP write SetPixelFP;
 348     { Clipping rectangle of this canvas. No pixels outside this rectangle are
 349       altered by canvas methods if Clipping property is True. Clip rect gets
 350       reseted when UpdateCanvasState is called.}
 351     property ClipRect: TRect read FClipRect write SetClipRect;
 352     { Extended format information.}
 353     property FormatInfo: TImageFormatInfo read FFormatInfo;
 354     { Indicates that this canvas is in valid state. If False canvas oprations
 355       may crash.}
 356     property Valid: Boolean read GetValid;
 357
 358     { Returns all formats supported by this canvas class.}
 359     class function GetSupportedFormats: TImageFormats; virtual;
 360   end;
 361
 362   TImagingCanvasClass = class of TImagingCanvas;
 363
 364   TScanlineArray = array[0..MaxInt div SizeOf(Pointer) - 1] of PColor32RecArray;
 365   PScanlineArray = ^TScanlineArray;
 366
 367   { Fast canvas class for ifA8R8G8B8 format images.}
 368   TFastARGB32Canvas = class(TImagingCanvas)
 369   protected
 370     FScanlines: PScanlineArray;
 371     procedure AlphaBlendPixels(SrcPix, DestPix: PColor32Rec); {$IFDEF USE_INLINE}inline;{$ENDIF}
 372     function GetPixel32(X, Y: LongInt): TColor32; override;
 373     procedure SetPixel32(X, Y: LongInt; const Value: TColor32); override;
 374   public
 375     destructor Destroy; override;
 376
 377     procedure UpdateCanvasState; override;
 378
 379     procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); override;
 380     procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
 381       const DestRect: TRect; Filter: TResizeFilter = rfBilinear); override;
 382     procedure InvertColors; override;
 383
 384     property Scanlines: PScanlineArray read FScanlines;
 385
 386     class function GetSupportedFormats: TImageFormats; override;
 387   end;
 388
 389 const
 390   { Kernel for 3x3 average smoothing filter.}
 391   FilterAverage3x3: TConvolutionFilter3x3 = (
 392     Kernel: ((1, 1, 1),
 393              (1, 1, 1),
 394              (1, 1, 1));
 395     Divisor: 9);
 396
 397   { Kernel for 5x5 average smoothing filter.}
 398   FilterAverage5x5: TConvolutionFilter5x5 = (
 399     Kernel: ((1, 1, 1, 1, 1),
 400              (1, 1, 1, 1, 1),
 401              (1, 1, 1, 1, 1),
 402              (1, 1, 1, 1, 1),
 403              (1, 1, 1, 1, 1));
 404     Divisor: 25);
 405
 406   { Kernel for 3x3 Gaussian smoothing filter.}
 407   FilterGaussian3x3: TConvolutionFilter3x3 = (
 408     Kernel: ((1, 2, 1),
 409              (2, 4, 2),
 410              (1, 2, 1));
 411     Divisor: 16);
 412
 413   { Kernel for 5x5 Gaussian smoothing filter.}
 414   FilterGaussian5x5: TConvolutionFilter5x5 = (
 415     Kernel: ((1,  4,  6,  4, 1),
 416              (4, 16, 24, 16, 4),
 417              (6, 24, 36, 24, 6),
 418              (4, 16, 24, 16, 4),
 419              (1,  4,  6,  4, 1));
 420     Divisor: 256);
 421
 422   { Kernel for 3x3 Sobel horizontal edge detection filter (1st derivative approximation).}
 423   FilterSobelHorz3x3: TConvolutionFilter3x3 = (
 424     Kernel: (( 1,  2,  1),
 425              ( 0,  0,  0),
 426              (-1, -2, -1));
 427     Divisor: 1);
 428
 429   { Kernel for 3x3 Sobel vertical edge detection filter (1st derivative approximation).}
 430   FilterSobelVert3x3: TConvolutionFilter3x3 = (
 431     Kernel: ((-1, 0, 1),
 432              (-2, 0, 2),
 433              (-1, 0, 1));
 434     Divisor: 1);
 435
 436   { Kernel for 3x3 Prewitt horizontal edge detection filter.}
 437   FilterPrewittHorz3x3: TConvolutionFilter3x3 = (
 438     Kernel: (( 1,  1,  1),
 439              ( 0,  0,  0),
 440              (-1, -1, -1));
 441     Divisor: 1);
 442
 443   { Kernel for 3x3 Prewitt vertical edge detection filter.}
 444   FilterPrewittVert3x3: TConvolutionFilter3x3 = (
 445     Kernel: ((-1, 0, 1),
 446              (-1, 0, 1),
 447              (-1, 0, 1));
 448     Divisor: 1);
 449
 450   { Kernel for 3x3 Kirsh horizontal edge detection filter.}
 451   FilterKirshHorz3x3: TConvolutionFilter3x3 = (
 452     Kernel: (( 5,  5,  5),
 453              (-3,  0, -3),
 454              (-3, -3, -3));
 455     Divisor: 1);
 456
 457   { Kernel for 3x3 Kirsh vertical edge detection filter.}
 458   FilterKirshVert3x3: TConvolutionFilter3x3 = (
 459     Kernel: ((5, -3, -3),
 460              (5,  0, -3),
 461              (5, -3, -3));
 462     Divisor: 1);
 463
 464   { Kernel for 3x3 Laplace omni-directional edge detection filter
 465     (2nd derivative approximation).}
 466   FilterLaplace3x3: TConvolutionFilter3x3 = (
 467     Kernel: ((-1, -1, -1),
 468              (-1,  8, -1),
 469              (-1, -1, -1));
 470     Divisor: 1);
 471
 472   { Kernel for 5x5 Laplace omni-directional edge detection filter
 473     (2nd derivative approximation).}
 474   FilterLaplace5x5: TConvolutionFilter5x5 = (
 475     Kernel: ((-1, -1, -1, -1, -1),
 476              (-1, -1, -1, -1, -1),
 477              (-1, -1, 24, -1, -1),
 478              (-1, -1, -1, -1, -1),
 479              (-1, -1, -1, -1, -1));
 480     Divisor: 1);
 481
 482   { Kernel for 3x3 spharpening filter (Laplacian + original color).}
 483   FilterSharpen3x3: TConvolutionFilter3x3 = (
 484     Kernel: ((-1, -1, -1),
 485              (-1,  9, -1),
 486              (-1, -1, -1));
 487     Divisor: 1);
 488
 489   { Kernel for 5x5 spharpening filter (Laplacian + original color).}
 490   FilterSharpen5x5: TConvolutionFilter5x5 = (
 491     Kernel: ((-1, -1, -1, -1, -1),
 492              (-1, -1, -1, -1, -1),
 493              (-1, -1, 25, -1, -1),
 494              (-1, -1, -1, -1, -1),
 495              (-1, -1, -1, -1, -1));
 496     Divisor: 1);
 497
 498   { Kernel for 5x5 glow filter.}
 499   FilterGlow5x5: TConvolutionFilter5x5 = (
 500     Kernel: (( 1, 2,   2, 2, 1),
 501              ( 2, 0,   0, 0, 2),
 502              ( 2, 0, -20, 0, 2),
 503              ( 2, 0,   0, 0, 2),
 504              ( 1, 2,   2, 2, 1));
 505     Divisor: 8);
 506
 507   { Kernel for 3x3 edge enhancement filter.}
 508   FilterEdgeEnhance3x3: TConvolutionFilter3x3 = (
 509     Kernel: ((-1, -2, -1),
 510              (-2, 16, -2),
 511              (-1, -2, -1));
 512     Divisor: 4);
 513
 514   { Kernel for 3x3 contour enhancement filter.}
 515   FilterTraceControur3x3: TConvolutionFilter3x3 = (
 516     Kernel: ((-6, -6, -2),
 517              (-1, 32, -1),
 518              (-6, -2, -6));
 519     Divisor: 4;
 520     Bias:    240/255);
 521
 522   { Kernel for filter that negates all images pixels.}
 523   FilterNegative3x3: TConvolutionFilter3x3 = (
 524     Kernel: ((0,  0, 0),
 525              (0, -1, 0),
 526              (0,  0, 0));
 527     Divisor: 1;
 528     Bias:    1);
 529
 530   { Kernel for 3x3 horz/vert embossing filter.}
 531   FilterEmboss3x3: TConvolutionFilter3x3 = (
 532     Kernel: ((2,  0,  0),
 533              (0, -1,  0),
 534              (0,  0, -1));
 535     Divisor: 1;
 536     Bias:    0.5);
 537
 538
 539 { You can register your own canvas class. List of registered canvases is used
 540   by FindBestCanvasForImage functions to find best canvas for given image.
 541   If two different canvases which support the same image data format are
 542   registered then the one that was registered later is returned (so you can
 543   override builtin Imaging canvases).}
 544 procedure RegisterCanvas(CanvasClass: TImagingCanvasClass);
 545 { Returns best canvas for given TImageFormat.}
 546 function FindBestCanvasForImage(ImageFormat: TImageFormat): TImagingCanvasClass; overload;
 547 { Returns best canvas for given TImageData.}
 548 function FindBestCanvasForImage(const ImageData: TImageData): TImagingCanvasClass; overload;
 549 { Returns best canvas for given TBaseImage.}
 550 function FindBestCanvasForImage(Image: TBaseImage): TImagingCanvasClass; overload;
 551
 552 implementation
 553
 554 resourcestring
 555   SConstructorInvalidPointer = 'Invalid pointer (%p) to TImageData passed to TImagingCanvas constructor.';
 556   SConstructorInvalidImage = 'Invalid image data passed to TImagingCanvas constructor (%s).';
 557   SConstructorUnsupportedFormat = 'Image passed to TImagingCanvas constructor is in unsupported format (%s)';
 558
 559 var
 560   // list with all registered TImagingCanvas classes
 561   CanvasClasses: TList = nil;
 562
 563 procedure RegisterCanvas(CanvasClass: TImagingCanvasClass);
 564 begin
 565   Assert(CanvasClass <> nil);
 566   if CanvasClasses = nil then
 567     CanvasClasses := TList.Create;
 568   if CanvasClasses.IndexOf(CanvasClass) < 0 then
 569     CanvasClasses.Add(CanvasClass);
 570 end;
 571
 572 function FindBestCanvasForImage(ImageFormat: TImageFormat): TImagingCanvasClass; overload;
 573 var
 574   I: LongInt;
 575 begin
 576   for I := CanvasClasses.Count - 1 downto 0 do
 577   begin
 578     if ImageFormat in TImagingCanvasClass(CanvasClasses[I]).GetSupportedFormats then
 579     begin
 580       Result := TImagingCanvasClass(CanvasClasses[I]);
 581       Exit;
 582     end;
 583   end;
 584   Result := TImagingCanvas;
 585 end;
 586
 587 function FindBestCanvasForImage(const ImageData: TImageData): TImagingCanvasClass;
 588 begin
 589   Result := FindBestCanvasForImage(ImageData.Format);
 590 end;
 591
 592 function FindBestCanvasForImage(Image: TBaseImage): TImagingCanvasClass;
 593 begin
 594   Result := FindBestCanvasForImage(Image.Format);
 595 end;
 596
 597 { Canvas helper functions }
 598
 599 procedure PixelBlendProc(const SrcPix: TColorFPRec; DestPtr: PByte;
 600   DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
 601 var
 602   DestPix, FSrc, FDst: TColorFPRec;
 603 begin
 604   // Get set pixel color
 605   DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil);
 606   // Determine current blending factors
 607   case SrcFactor of
 608     bfZero:             FSrc := ColorFP(0, 0, 0, 0);
 609     bfOne:              FSrc := ColorFP(1, 1, 1, 1);
 610     bfSrcAlpha:         FSrc := ColorFP(SrcPix.A, SrcPix.A, SrcPix.A, SrcPix.A);
 611     bfOneMinusSrcAlpha: FSrc := ColorFP(1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A);
 612     bfDstAlpha:         FSrc := ColorFP(DestPix.A, DestPix.A, DestPix.A, DestPix.A);
 613     bfOneMinusDstAlpha: FSrc := ColorFP(1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A);
 614     bfDstColor:         FSrc := ColorFP(DestPix.A, DestPix.R, DestPix.G, DestPix.B);
 615     bfOneMinusDstColor: FSrc := ColorFP(1 - DestPix.A, 1 - DestPix.R, 1 - DestPix.G, 1 - DestPix.B);
 616   end;
 617   case DestFactor of
 618     bfZero:             FDst := ColorFP(0, 0, 0, 0);
 619     bfOne:              FDst := ColorFP(1, 1, 1, 1);
 620     bfSrcAlpha:         FDst := ColorFP(SrcPix.A, SrcPix.A, SrcPix.A, SrcPix.A);
 621     bfOneMinusSrcAlpha: FDst := ColorFP(1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A);
 622     bfDstAlpha:         FDst := ColorFP(DestPix.A, DestPix.A, DestPix.A, DestPix.A);
 623     bfOneMinusDstAlpha: FDst := ColorFP(1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A);
 624     bfSrcColor:         FDst := ColorFP(SrcPix.A, SrcPix.R, SrcPix.G, SrcPix.B);
 625     bfOneMinusSrcColor: FDst := ColorFP(1 - SrcPix.A, 1 - SrcPix.R, 1 - SrcPix.G, 1 - SrcPix.B);
 626   end;
 627   // Compute blending formula
 628   DestPix.R := SrcPix.R * FSrc.R + DestPix.R * FDst.R;
 629   DestPix.G := SrcPix.G * FSrc.G + DestPix.G * FDst.G;
 630   DestPix.B := SrcPix.B * FSrc.B + DestPix.B * FDst.B;
 631   DestPix.A := SrcPix.A * FSrc.A + DestPix.A * FDst.A;
 632   // Write blended pixel
 633   DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix);
 634 end;
 635
 636 procedure PixelAlphaProc(const SrcPix: TColorFPRec; DestPtr: PByte;
 637   DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
 638 var
 639   DestPix: TColorFPRec;
 640   SrcAlpha, DestAlpha: Single;
 641 begin
 642   DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil);
 643   // Blend the two pixels (Src 'over' Dest alpha composition operation)
 644   DestPix.A := SrcPix.A + DestPix.A - SrcPix.A * DestPix.A;
 645   if DestPix.A = 0 then
 646     SrcAlpha := 0
 647   else
 648     SrcAlpha := SrcPix.A / DestPix.A;
 649   DestAlpha := 1.0 - SrcAlpha;
 650   DestPix.R := SrcPix.R * SrcAlpha + DestPix.R * DestAlpha;
 651   DestPix.G := SrcPix.G * SrcAlpha + DestPix.G * DestAlpha;
 652   DestPix.B := SrcPix.B * SrcAlpha + DestPix.B * DestAlpha;
 653   // Write blended pixel
 654   DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix);
 655 end;
 656
 657 procedure PixelAddProc(const SrcPix: TColorFPRec; DestPtr: PByte;
 658   DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
 659 var
 660   DestPix: TColorFPRec;
 661 begin
 662   // Just add Src and Dest
 663   DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil);
 664   DestPix.R := SrcPix.R + DestPix.R;
 665   DestPix.G := SrcPix.G + DestPix.G;
 666   DestPix.B := SrcPix.B + DestPix.B;
 667   DestPix.A := SrcPix.A + DestPix.A;
 668   DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix);
 669 end;
 670
 671 function CompareColors(const C1, C2: TColorFPRec): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
 672 begin
 673   Result := (C1.R * GrayConv.R + C1.G * GrayConv.G + C1.B * GrayConv.B) -
 674     (C2.R * GrayConv.R + C2.G * GrayConv.G + C2.B * GrayConv.B);
 675 end;
 676
 677 function MedianSelect(var Pixels: TDynFPPixelArray): TColorFPRec;
 678
 679   procedure QuickSort(L, R: Integer);
 680   var
 681     I, J: Integer;
 682     P, Temp: TColorFPRec;
 683   begin
 684     repeat
 685       I := L;
 686       J := R;
 687       P := Pixels[(L + R) shr 1];
 688       repeat
 689         while CompareColors(Pixels[I], P) < 0 do Inc(I);
 690         while CompareColors(Pixels[J], P) > 0 do Dec(J);
 691         if I <= J then
 692         begin
 693           Temp := Pixels[I];
 694           Pixels[I] := Pixels[J];
 695           Pixels[J] := Temp;
 696           Inc(I);
 697           Dec(J);
 698         end;
 699       until I > J;
 700       if L < J then
 701         QuickSort(L, J);
 702       L := I;
 703     until I >= R;
 704   end;
 705
 706 begin
 707   // First sort pixels
 708   QuickSort(0, High(Pixels));
 709   // Select middle pixel
 710   Result := Pixels[Length(Pixels) div 2];
 711 end;
 712
 713 function MinSelect(var Pixels: TDynFPPixelArray): TColorFPRec;
 714 var
 715   I: Integer;
 716 begin
 717   Result := Pixels[0];
 718   for I := 1 to High(Pixels) do
 719   begin
 720     if CompareColors(Pixels[I], Result) < 0 then
 721       Result := Pixels[I];
 722   end;
 723 end;
 724
 725 function MaxSelect(var Pixels: TDynFPPixelArray): TColorFPRec;
 726 var
 727   I: Integer;
 728 begin
 729   Result := Pixels[0];
 730   for I := 1 to High(Pixels) do
 731   begin
 732     if CompareColors(Pixels[I], Result) > 0 then
 733       Result := Pixels[I];
 734   end;
 735 end;
 736
 737 function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, P3: Single): TColorFPRec;
 738 begin
 739   Result.A := Pixel.A;
 740   Result.R := Pixel.R * C + B;
 741   Result.G := Pixel.G * C + B;
 742   Result.B := Pixel.B * C + B;
 743 end;
 744
 745 function TransformGamma(const Pixel: TColorFPRec; R, G, B: Single): TColorFPRec;
 746 begin
 747   Result.A := Pixel.A;
 748   Result.R := Power(Pixel.R, 1.0 / R);
 749   Result.G := Power(Pixel.G, 1.0 / G);
 750   Result.B := Power(Pixel.B, 1.0 / B);
 751 end;
 752
 753 function TransformInvert(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
 754 begin
 755   Result.A := Pixel.A;
 756   Result.R := 1.0 - Pixel.R;
 757   Result.G := 1.0 - Pixel.G;
 758   Result.B := 1.0 - Pixel.B;
 759 end;
 760
 761 function TransformThreshold(const Pixel: TColorFPRec; R, G, B: Single): TColorFPRec;
 762 begin
 763   Result.A := Pixel.A;
 764   Result.R := IffFloat(Pixel.R >= R, 1.0, 0.0);
 765   Result.G := IffFloat(Pixel.G >= G, 1.0, 0.0);
 766   Result.B := IffFloat(Pixel.B >= B, 1.0, 0.0);
 767 end;
 768
 769 function TransformLevels(const Pixel: TColorFPRec; BlackPoint, WhitePoint, Exp: Single): TColorFPRec;
 770 begin
 771   Result.A := Pixel.A;
 772   if Pixel.R > BlackPoint then
 773     Result.R := Power((Pixel.R - BlackPoint) / (WhitePoint - BlackPoint), Exp)
 774   else
 775     Result.R := 0.0;
 776   if Pixel.G > BlackPoint then
 777     Result.G := Power((Pixel.G - BlackPoint) / (WhitePoint - BlackPoint), Exp)
 778   else
 779     Result.G := 0.0;
 780   if Pixel.B > BlackPoint then
 781     Result.B := Power((Pixel.B - BlackPoint) / (WhitePoint - BlackPoint), Exp)
 782   else
 783     Result.B := 0.0;
 784 end;
 785
 786 function TransformPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
 787 begin
 788   Result.A := Pixel.A;
 789   Result.R := Result.R * Pixel.A;
 790   Result.G := Result.G * Pixel.A;
 791   Result.B := Result.B * Pixel.A;
 792 end;
 793
 794 function TransformUnPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
 795 begin
 796   Result.A := Pixel.A;
 797   if Pixel.A <> 0.0 then
 798   begin
 799     Result.R := Result.R / Pixel.A;
 800     Result.G := Result.G / Pixel.A;
 801     Result.B := Result.B / Pixel.A;
 802   end
 803   else
 804   begin
 805     Result.R := 0;
 806     Result.G := 0;
 807     Result.B := 0;
 808   end;
 809 end;
 810
 811
 812 { TImagingCanvas class implementation }
 813
 814 constructor TImagingCanvas.CreateForData(ImageDataPointer: PImageData);
 815 begin
 816   if ImageDataPointer = nil then
 817     raise EImagingCanvasError.CreateFmt(SConstructorInvalidPointer, [ImageDataPointer]);
 818
 819   if not TestImage(ImageDataPointer^) then
 820     raise EImagingCanvasError.CreateFmt(SConstructorInvalidImage, [Imaging.ImageToStr(ImageDataPointer^)]);
 821
 822   if not (ImageDataPointer.Format in GetSupportedFormats) then
 823     raise EImagingCanvasError.CreateFmt(SConstructorUnsupportedFormat, [Imaging.ImageToStr(ImageDataPointer^)]);
 824
 825   FPData := ImageDataPointer;
 826   FPenWidth := 1;
 827   SetPenColor32(pcWhite);
 828   SetFillColor32(pcBlack);
 829   FFillMode := fmSolid;
 830
 831   UpdateCanvasState;
 832 end;
 833
 834 constructor TImagingCanvas.CreateForImage(Image: TBaseImage);
 835 begin
 836   CreateForData(Image.ImageDataPointer);
 837 end;
 838
 839 destructor TImagingCanvas.Destroy;
 840 begin
 841   inherited Destroy;
 842 end;
 843
 844 function TImagingCanvas.GetPixel32(X, Y: LongInt): TColor32;
 845 begin
 846   Result := Imaging.GetPixel32(FPData^, X, Y).Color;
 847 end;
 848
 849 function TImagingCanvas.GetPixelFP(X, Y: LongInt): TColorFPRec;
 850 begin
 851   Result := Imaging.GetPixelFP(FPData^, X, Y);
 852 end;
 853
 854 function TImagingCanvas.GetValid: Boolean;
 855 begin
 856   Result := (FPData <> nil) and (FDataSizeOnUpdate = FPData.Size);
 857 end;
 858
 859 procedure TImagingCanvas.SetPixel32(X, Y: LongInt; const Value: TColor32);
 860 begin
 861   if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
 862     (X < FClipRect.Right) and (Y < FClipRect.Bottom) then
 863   begin
 864     Imaging.SetPixel32(FPData^, X, Y, TColor32Rec(Value));
 865   end;
 866 end;
 867
 868 procedure TImagingCanvas.SetPixelFP(X, Y: LongInt; const Value: TColorFPRec);
 869 begin
 870   if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
 871     (X < FClipRect.Right) and (Y < FClipRect.Bottom) then
 872   begin
 873     Imaging.SetPixelFP(FPData^, X, Y, TColorFPRec(Value));
 874   end;
 875 end;
 876
 877 procedure TImagingCanvas.SetPenColor32(const Value: TColor32);
 878 begin
 879   FPenColor32 := Value;
 880   TranslatePixel(@FPenColor32, @FPenColorFP, ifA8R8G8B8, ifA32R32G32B32F, nil, nil);
 881 end;
 882
 883 procedure TImagingCanvas.SetPenColorFP(const Value: TColorFPRec);
 884 begin
 885   FPenColorFP := Value;
 886   TranslatePixel(@FPenColorFP, @FPenColor32, ifA32R32G32B32F, ifA8R8G8B8, nil, nil);
 887 end;
 888
 889 procedure TImagingCanvas.SetPenWidth(const Value: LongInt);
 890 begin
 891   FPenWidth := ClampInt(Value, 0, MaxPenWidth);
 892 end;
 893
 894 procedure TImagingCanvas.SetFillColor32(const Value: TColor32);
 895 begin
 896   FFillColor32 := Value;
 897   TranslatePixel(@FFillColor32, @FFillColorFP, ifA8R8G8B8, ifA32R32G32B32F, nil, nil);
 898 end;
 899
 900 procedure TImagingCanvas.SetFillColorFP(const Value: TColorFPRec);
 901 begin
 902   FFillColorFP := Value;
 903   TranslatePixel(@FFillColorFP, @FFillColor32, ifA32R32G32B32F, ifA8R8G8B8, nil, nil);
 904 end;
 905
 906 procedure TImagingCanvas.SetClipRect(const Value: TRect);
 907 begin
 908   FClipRect := Value;
 909   SwapMin(FClipRect.Left, FClipRect.Right);
 910   SwapMin(FClipRect.Top, FClipRect.Bottom);
 911   IntersectRect(FClipRect, FClipRect, Rect(0, 0, FPData.Width, FPData.Height));
 912 end;
 913
 914 procedure TImagingCanvas.CheckBeforeBlending(SrcFactor,
 915   DestFactor: TBlendingFactor; DestCanvas: TImagingCanvas);
 916 begin
 917   if SrcFactor in [bfSrcColor, bfOneMinusSrcColor] then
 918     raise EImagingCanvasBlendingError.Create('Invalid source blending factor. Check the documentation for TBlendingFactor.');
 919   if DestFactor in [bfDstColor, bfOneMinusDstColor] then
 920     raise EImagingCanvasBlendingError.Create('Invalid destination blending factor. Check the documentation for TBlendingFactor.');
 921   if DestCanvas.FormatInfo.IsIndexed then
 922     raise EImagingCanvasBlendingError.Create('Blending destination canvas cannot be in indexed mode.');
 923 end;
 924
 925 function TImagingCanvas.GetPixelPointer(X, Y: LongInt): Pointer;
 926 begin
 927   Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * FFormatInfo.BytesPerPixel]
 928 end;
 929
 930 procedure TImagingCanvas.TranslateFPToNative(const Color: TColorFPRec);
 931 begin
 932   TranslateFPToNative(Color, @FNativeColor);
 933 end;
 934
 935 procedure TImagingCanvas.TranslateFPToNative(const Color: TColorFPRec;
 936   Native: Pointer);
 937 begin
 938   ImagingFormats.TranslatePixel(@Color, Native, ifA32R32G32B32F,
 939     FPData.Format, nil, FPData.Palette);
 940 end;
 941
 942 procedure TImagingCanvas.UpdateCanvasState;
 943 begin
 944   FDataSizeOnUpdate := FPData.Size;
 945   ResetClipRect;
 946   Imaging.GetImageFormatInfo(FPData.Format, FFormatInfo)
 947 end;
 948
 949 procedure TImagingCanvas.ResetClipRect;
 950 begin
 951   FClipRect := Rect(0, 0, FPData.Width, FPData.Height)
 952 end;
 953
 954 procedure TImagingCanvas.Clear;
 955 begin
 956   TranslateFPToNative(FFillColorFP);
 957   Imaging.FillRect(FPData^, 0, 0, FPData.Width, FPData.Height, @FNativeColor);
 958 end;
 959
 960 function TImagingCanvas.ClipAxisParallelLine(var A1, A2, B: LongInt;
 961   AStart, AStop, BStart, BStop: LongInt): Boolean;
 962 begin
 963   if (B >= BStart) and (B < BStop) then
 964   begin
 965     SwapMin(A1, A2);
 966     if A1 < AStart then A1 := AStart;
 967     if A2 >= AStop then A2 := AStop - 1;
 968     Result := True;
 969   end
 970   else
 971     Result := False;
 972 end;
 973
 974 procedure TImagingCanvas.HorzLineInternal(X1, X2, Y: LongInt; Color: Pointer;
 975   Bpp: LongInt);
 976 var
 977   I, WidthBytes: LongInt;
 978   PixelPtr: PByte;
 979 begin
 980   if (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then
 981   begin
 982     SwapMin(X1, X2);
 983     X1 := Max(X1, FClipRect.Left);
 984     X2 := Min(X2, FClipRect.Right);
 985     PixelPtr := GetPixelPointer(X1, Y);
 986     WidthBytes := (X2 - X1) * Bpp;
 987     case Bpp of
 988       1: FillMemoryByte(PixelPtr, WidthBytes, PByte(Color)^);
 989       2: FillMemoryWord(PixelPtr, WidthBytes, PWord(Color)^);
 990       4: FillMemoryLongWord(PixelPtr, WidthBytes, PLongWord(Color)^);
 991     else
 992       for I := X1 to X2 do
 993       begin
 994         ImagingFormats.CopyPixel(Color, PixelPtr, Bpp);
 995         Inc(PixelPtr, Bpp);
 996        end;
 997     end;
 998   end;
 999 end;
1000
1001 procedure TImagingCanvas.CopyPixelInternal(X, Y: LongInt; Pixel: Pointer;
1002   Bpp: LongInt);
1003 begin
1004   if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
1005     (X < FClipRect.Right) and (Y < FClipRect.Bottom) then
1006   begin
1007     ImagingFormats.CopyPixel(Pixel, GetPixelPointer(X, Y), Bpp);
1008   end;
1009 end;
1010
1011 procedure TImagingCanvas.HorzLine(X1, X2, Y: LongInt);
1012 var
1013   DstRect: TRect;
1014 begin
1015   if FPenMode = pmClear then Exit;
1016   SwapMin(X1, X2);
1017   if IntersectRect(DstRect, Rect(X1, Y - FPenWidth div 2, X2,
1018     Y + FPenWidth div 2 + FPenWidth mod 2), FClipRect) then
1019   begin
1020     TranslateFPToNative(FPenColorFP);
1021     Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left,
1022       DstRect.Bottom - DstRect.Top, @FNativeColor);
1023   end;
1024 end;
1025
1026 procedure TImagingCanvas.VertLine(X, Y1, Y2: LongInt);
1027 var
1028   DstRect: TRect;
1029 begin
1030   if FPenMode = pmClear then Exit;
1031   SwapMin(Y1, Y2);
1032   if IntersectRect(DstRect, Rect(X - FPenWidth div 2, Y1,
1033     X + FPenWidth div 2 + FPenWidth mod 2, Y2), FClipRect) then
1034   begin
1035     TranslateFPToNative(FPenColorFP);
1036     Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left,
1037       DstRect.Bottom - DstRect.Top, @FNativeColor);
1038   end;
1039 end;
1040
1041 procedure TImagingCanvas.Line(X1, Y1, X2, Y2: LongInt);
1042 var
1043   Steep: Boolean;
1044   Error, YStep, DeltaX, DeltaY, X, Y, I, Bpp, W1, W2, Code1, Code2: LongInt;
1045 begin
1046   if FPenMode = pmClear then Exit;
1047
1048   // If line is vertical or horizontal just call appropriate method
1049   if X2 = X1 then
1050   begin
1051     VertLine(X1, Y1, Y2);
1052     Exit;
1053   end;
1054   if Y2 = Y1 then
1055   begin
1056     HorzLine(X1, X2, Y1);
1057     Exit;
1058   end;
1059
1060   // Determine if line is steep (angle with X-axis > 45 degrees)
1061   Steep := Abs(Y2 - Y1) > Abs(X2 - X1);
1062
1063   // If we need to draw thick line we just draw more 1 pixel lines around
1064   // the one we already drawn. Setting FLineRecursion assures that we
1065   // won't be doing recursions till the end of the world.
1066   if (FPenWidth > 1) and not FLineRecursion then
1067   begin
1068     FLineRecursion := True;
1069     W1 := FPenWidth div 2;
1070     W2 := W1;
1071     if FPenWidth mod 2 = 0 then
1072       Dec(W1);
1073     if Steep then
1074     begin
1075       // Add lines left/right
1076       for I := 1 to W1 do
1077         Line(X1, Y1 - I, X2, Y2 - I);
1078       for I := 1 to W2 do
1079         Line(X1, Y1 + I, X2, Y2 + I);
1080     end
1081     else
1082     begin
1083       // Add lines above/under
1084       for I := 1 to W1 do
1085         Line(X1 - I, Y1, X2 - I, Y2);
1086       for I := 1 to W2 do
1087         Line(X1 + I, Y1, X2 + I, Y2);
1088     end;
1089     FLineRecursion := False;
1090   end;
1091
1092   with FClipRect do
1093   begin
1094     // Use part of Cohen-Sutherland line clipping to determine if any part of line
1095     // is in ClipRect
1096     Code1 := Ord(X1 < Left) + Ord(X1 > Right) shl 1 + Ord(Y1 < Top) shl 2 + Ord(Y1 > Bottom) shl 3;
1097     Code2 := Ord(X2 < Left) + Ord(X2 > Right) shl 1 + Ord(Y2 < Top) shl 2 + Ord(Y2 > Bottom) shl 3;
1098   end;
1099
1100   if (Code1 and Code2) = 0 then
1101   begin
1102     TranslateFPToNative(FPenColorFP);
1103     Bpp := FFormatInfo.BytesPerPixel;
1104
1105     // If line is steep swap X and Y coordinates so later we just have one loop
1106     // of two (where only one is used according to steepness).
1107     if Steep then
1108     begin
1109       SwapValues(X1, Y1);
1110       SwapValues(X2, Y2);
1111     end;
1112     if X1 > X2 then
1113     begin
1114       SwapValues(X1, X2);
1115       SwapValues(Y1, Y2);
1116     end;
1117
1118     DeltaX := X2 - X1;
1119     DeltaY := Abs(Y2 - Y1);
1120     YStep := Iff(Y2 > Y1, 1, -1);
1121     Error := 0;
1122     Y := Y1;
1123
1124     // Draw line using Bresenham algorithm. No real line clipping here,
1125     // just don't draw pixels outsize clip rect.
1126     for X := X1 to X2 do
1127     begin
1128       if Steep then
1129         CopyPixelInternal(Y, X, @FNativeColor, Bpp)
1130       else
1131         CopyPixelInternal(X, Y, @FNativeColor, Bpp);
1132       Error := Error + DeltaY;
1133       if Error * 2 >= DeltaX then
1134       begin
1135         Inc(Y, YStep);
1136         Dec(Error, DeltaX);
1137       end;
1138     end;
1139   end;
1140 end;
1141
1142 procedure TImagingCanvas.FrameRect(const Rect: TRect);
1143 var
1144   HalfPen, PenMod: LongInt;
1145 begin
1146   if FPenMode = pmClear then Exit;
1147   HalfPen := FPenWidth div 2;
1148   PenMod := FPenWidth mod 2;
1149   HorzLine(Rect.Left - HalfPen, Rect.Right + HalfPen + PenMod - 1, Rect.Top);
1150   HorzLine(Rect.Left - HalfPen, Rect.Right + HalfPen + PenMod - 1, Rect.Bottom - 1);
1151   VertLine(Rect.Left, Rect.Top, Rect.Bottom);
1152   VertLine(Rect.Right - 1, Rect.Top, Rect.Bottom);
1153 end;
1154
1155 procedure TImagingCanvas.FillRect(const Rect: TRect);
1156 var
1157   DstRect: TRect;
1158 begin
1159   if (FFillMode <> fmClear) and IntersectRect(DstRect, Rect, FClipRect) then
1160   begin
1161     TranslateFPToNative(FFillColorFP);
1162     Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left,
1163       DstRect.Bottom - DstRect.Top, @FNativeColor);
1164   end;
1165 end;
1166
1167 procedure TImagingCanvas.FillRectBlend(const Rect: TRect; SrcFactor,
1168   DestFactor: TBlendingFactor);
1169 var
1170   DstRect: TRect;
1171   X, Y: Integer;
1172   Line: PByte;
1173 begin
1174   if (FFillMode <> fmClear) and IntersectRect(DstRect, Rect, FClipRect) then
1175   begin
1176     CheckBeforeBlending(SrcFactor, DestFactor, Self);
1177     for Y := DstRect.Top to DstRect.Bottom - 1 do
1178     begin
1179       Line := @PByteArray(FPData.Bits)[(Y * FPData.Width + DstRect.Left) * FFormatInfo.BytesPerPixel];
1180       for X := DstRect.Left to DstRect.Right - 1 do
1181       begin
1182         PixelBlendProc(FFillColorFP, Line, @FFormatInfo, SrcFactor, DestFactor);
1183         Inc(Line, FFormatInfo.BytesPerPixel);
1184       end;
1185     end;
1186   end;
1187 end;
1188
1189 procedure TImagingCanvas.Rectangle(const Rect: TRect);
1190 begin
1191   FillRect(Rect);
1192   FrameRect(Rect);
1193 end;
1194
1195 procedure TImagingCanvas.Ellipse(const Rect: TRect);
1196 var
1197  RadX, RadY, DeltaX, DeltaY, R, RX, RY: LongInt;
1198  X1, X2, Y1, Y2, Bpp, OldY: LongInt;
1199  Fill, Pen: TColorFPRec;
1200 begin
1201   // TODO: Use PenWidth
1202   X1 := Rect.Left;
1203   X2 := Rect.Right;
1204   Y1 := Rect.Top;
1205   Y2 := Rect.Bottom;
1206
1207   TranslateFPToNative(FPenColorFP, @Pen);
1208   TranslateFPToNative(FFillColorFP, @Fill);
1209   Bpp := FFormatInfo.BytesPerPixel;
1210
1211   SwapMin(X1, X2);
1212   SwapMin(Y1, Y2);
1213
1214   RadX := (X2 - X1) div 2;
1215   RadY := (Y2 - Y1) div 2;
1216
1217   Y1 := Y1 + RadY;
1218   Y2 := Y1;
1219   OldY := Y1;
1220
1221   DeltaX := (RadX * RadX);
1222   DeltaY := (RadY * RadY);
1223   R  := RadX * RadY * RadY;
1224   RX := R;
1225   RY := 0;
1226
1227   if (FFillMode <> fmClear) then
1228     HorzLineInternal(X1, X2, Y1, @Fill, Bpp);
1229   CopyPixelInternal(X1, Y1, @Pen, Bpp);
1230   CopyPixelInternal(X2, Y1, @Pen, Bpp);
1231
1232   while RadX > 0 do
1233   begin
1234     if R > 0 then
1235     begin
1236       Inc(Y1);
1237       Dec(Y2);
1238       Inc(RY, DeltaX);
1239       Dec(R, RY);
1240     end;
1241     if R <= 0 then
1242     begin
1243       Dec(RadX);
1244       Inc(X1);
1245       Dec(X2);
1246       Dec(RX, DeltaY);
1247       Inc(R, RX);
1248     end;
1249
1250     if (OldY <> Y1) and (FFillMode <> fmClear) then
1251     begin
1252       HorzLineInternal(X1, X2, Y1, @Fill, Bpp);
1253       HorzLineInternal(X1, X2, Y2, @Fill, Bpp);
1254     end;
1255     OldY := Y1;
1256
1257     CopyPixelInternal(X1, Y1, @Pen, Bpp);
1258     CopyPixelInternal(X2, Y1, @Pen, Bpp);
1259     CopyPixelInternal(X1, Y2, @Pen, Bpp);
1260     CopyPixelInternal(X2, Y2, @Pen, Bpp);
1261   end;
1262 end;
1263
1264 procedure TImagingCanvas.FloodFill(X, Y: Integer; BoundaryFillMode: Boolean);
1265 var
1266   Stack: array of TPoint;
1267   StackPos, Y1: Integer;
1268   OldColor: TColor32;
1269   SpanLeft, SpanRight: Boolean;
1270
1271   procedure Push(AX, AY: Integer);
1272   begin
1273     if StackPos < High(Stack) then
1274     begin
1275       Inc(StackPos);
1276       Stack[StackPos].X := AX;
1277       Stack[StackPos].Y := AY;
1278     end
1279     else
1280     begin
1281       SetLength(Stack, Length(Stack) + FPData.Width);
1282       Push(AX, AY);
1283     end;
1284   end;
1285
1286   function Pop(out AX, AY: Integer): Boolean;
1287   begin
1288     if StackPos > 0 then
1289     begin
1290       AX := Stack[StackPos].X;
1291       AY := Stack[StackPos].Y;
1292       Dec(StackPos);
1293       Result := True;
1294     end
1295     else
1296       Result := False;
1297   end;
1298
1299   function Compare(AX, AY: Integer): Boolean;
1300   var
1301     Color: TColor32;
1302   begin
1303     Color := GetPixel32(AX, AY);
1304     if BoundaryFillMode then
1305       Result := (Color <> FFillColor32) and (Color <> FPenColor32)
1306     else
1307       Result := Color = OldColor;
1308   end;
1309
1310 begin
1311   // Scanline Floodfill Algorithm With Stack
1312   // http://student.kuleuven.be/~m0216922/CG/floodfill.html
1313
1314   if not PtInRect(FClipRect, Point(X, Y)) then Exit;
1315
1316   SetLength(Stack, FPData.Width * 4);
1317   StackPos := 0;
1318
1319   OldColor := GetPixel32(X, Y);
1320
1321   Push(X, Y);
1322
1323   while Pop(X, Y) do
1324   begin
1325     Y1 := Y;
1326     while (Y1 >= FClipRect.Top) and Compare(X, Y1) do
1327       Dec(Y1);
1328
1329     Inc(Y1);
1330     SpanLeft := False;
1331     SpanRight := False;
1332
1333     while (Y1 < FClipRect.Bottom) and Compare(X, Y1) do
1334     begin
1335       SetPixel32(X, Y1, FFillColor32);
1336       if not SpanLeft and (X > FClipRect.Left) and Compare(X - 1, Y1) then
1337       begin
1338         Push(X - 1, Y1);
1339         SpanLeft := True;
1340       end
1341       else if SpanLeft and (X > FClipRect.Left) and not Compare(X - 1, Y1) then
1342         SpanLeft := False
1343       else if not SpanRight and (X < FClipRect.Right - 1) and Compare(X + 1, Y1)then
1344       begin
1345         Push(X + 1, Y1);
1346         SpanRight := True;
1347       end
1348       else if SpanRight and (X < FClipRect.Right - 1) and not Compare(X + 1, Y1) then
1349         SpanRight := False;
1350
1351       Inc(Y1);
1352     end;
1353   end;
1354 end;
1355
1356 procedure TImagingCanvas.DrawInternal(const SrcRect: TRect;
1357   DestCanvas: TImagingCanvas; DestX, DestY: Integer; SrcFactor,
1358   DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc);
1359 var
1360   X, Y, SrcX, SrcY, Width, Height, SrcBpp, DestBpp: Integer;
1361   PSrc: TColorFPRec;
1362   SrcPointer, DestPointer: PByte;
1363 begin
1364   CheckBeforeBlending(SrcFactor, DestFactor, DestCanvas);
1365   SrcX := SrcRect.Left;
1366   SrcY := SrcRect.Top;
1367   Width := SrcRect.Right - SrcRect.Left;
1368   Height := SrcRect.Bottom - SrcRect.Top;
1369   SrcBpp := FFormatInfo.BytesPerPixel;
1370   DestBpp := DestCanvas.FFormatInfo.BytesPerPixel;
1371   // Clip src and dst rects
1372   ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY,
1373     FPData.Width, FPData.Height, DestCanvas.ClipRect);
1374
1375   for Y := 0 to Height - 1 do
1376   begin
1377     // Get src and dst scanlines
1378     SrcPointer := @PByteArray(FPData.Bits)[((SrcY + Y) * FPData.Width + SrcX) * SrcBpp];
1379     DestPointer := @PByteArray(DestCanvas.FPData.Bits)[((DestY + Y) * DestCanvas.FPData.Width + DestX) * DestBpp];
1380
1381     for X := 0 to Width - 1 do
1382     begin
1383       PSrc := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, FPData.Palette);
1384       // Call pixel writer procedure - combine source and dest pixels
1385       PixelWriteProc(PSrc, DestPointer, @DestCanvas.FFormatInfo, SrcFactor, DestFactor);
1386       // Increment pixel pointers
1387       Inc(SrcPointer, SrcBpp);
1388       Inc(DestPointer, DestBpp);
1389     end;
1390   end;
1391 end;
1392
1393 procedure TImagingCanvas.DrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas;
1394   DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor);
1395 begin
1396   DrawInternal(SrcRect, DestCanvas, DestX, DestY, SrcFactor, DestFactor, PixelBlendProc);
1397 end;
1398
1399 procedure TImagingCanvas.DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
1400   DestX, DestY: Integer);
1401 begin
1402   DrawInternal(SrcRect, DestCanvas, DestX, DestY, bfIgnore, bfIgnore, PixelAlphaProc);
1403 end;
1404
1405 procedure TImagingCanvas.DrawAdd(const SrcRect: TRect;
1406   DestCanvas: TImagingCanvas; DestX, DestY: Integer);
1407 begin
1408   DrawInternal(SrcRect, DestCanvas, DestX, DestY, bfIgnore, bfIgnore, PixelAddProc);
1409 end;
1410
1411 procedure TImagingCanvas.StretchDrawInternal(const SrcRect: TRect;
1412   DestCanvas: TImagingCanvas; const DestRect: TRect;
1413   SrcFactor, DestFactor: TBlendingFactor; Filter: TResizeFilter;
1414   PixelWriteProc: TPixelWriteProc);
1415 const
1416   FilterMapping: array[TResizeFilter] of TSamplingFilter =
1417     (sfNearest, sfLinear, DefaultCubicFilter, sfLanczos);
1418 var
1419   X, Y, I, J, SrcX, SrcY, SrcWidth, SrcHeight: Integer;
1420   DestX, DestY, DestWidth, DestHeight, SrcBpp, DestBpp: Integer;
1421   SrcPix: TColorFPRec;
1422   MapX, MapY: TMappingTable;
1423   XMinimum, XMaximum: Integer;
1424   LineBuffer: array of TColorFPRec;
1425   ClusterX, ClusterY: TCluster;
1426   Weight, AccumA, AccumR, AccumG, AccumB: Single;
1427   DestLine: PByte;
1428   FilterFunction: TFilterFunction;
1429   Radius: Single;
1430 begin
1431   CheckBeforeBlending(SrcFactor, DestFactor, DestCanvas);
1432   SrcX := SrcRect.Left;
1433   SrcY := SrcRect.Top;
1434   SrcWidth := SrcRect.Right - SrcRect.Left;
1435   SrcHeight := SrcRect.Bottom - SrcRect.Top;
1436   DestX := DestRect.Left;
1437   DestY := DestRect.Top;
1438   DestWidth := DestRect.Right - DestRect.Left;
1439   DestHeight := DestRect.Bottom - DestRect.Top;
1440   SrcBpp := FFormatInfo.BytesPerPixel;
1441   DestBpp := DestCanvas.FFormatInfo.BytesPerPixel;
1442   // Get actual resampling filter and radius
1443   FilterFunction := SamplingFilterFunctions[FilterMapping[Filter]];
1444   Radius := SamplingFilterRadii[FilterMapping[Filter]];
1445   // Clip src and dst rects
1446   ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight,
1447       FPData.Width, FPData.Height, DestCanvas.ClipRect);
1448   // Generate mapping tables
1449   MapX := BuildMappingTable(DestX, DestX + DestWidth, SrcX, SrcX + SrcWidth,
1450     FPData.Width, FilterFunction, Radius, False);
1451   MapY := BuildMappingTable(DestY, DestY + DestHeight, SrcY, SrcY + SrcHeight,
1452     FPData.Height, FilterFunction, Radius, False);
1453   FindExtremes(MapX, XMinimum, XMaximum);
1454   SetLength(LineBuffer, XMaximum - XMinimum + 1);
1455
1456   for J := 0 to DestHeight - 1 do
1457   begin
1458     ClusterY := MapY[J];
1459     for X := XMinimum to XMaximum do
1460     begin
1461       AccumA := 0.0;
1462       AccumR := 0.0;
1463       AccumG := 0.0;
1464       AccumB := 0.0;
1465       for Y := 0 to Length(ClusterY) - 1 do
1466       begin
1467         Weight := ClusterY[Y].Weight;
1468         SrcPix := FFormatInfo.GetPixelFP(@PByteArray(FPData.Bits)[(ClusterY[Y].Pos * FPData.Width + X) * SrcBpp],
1469           @FFormatInfo, FPData.Palette);
1470         AccumB := AccumB + SrcPix.B * Weight;
1471         AccumG := AccumG + SrcPix.G * Weight;
1472         AccumR := AccumR + SrcPix.R * Weight;
1473         AccumA := AccumA + SrcPix.A * Weight;
1474       end;
1475       with LineBuffer[X - XMinimum] do
1476       begin
1477         A := AccumA;
1478         R := AccumR;
1479         G := AccumG;
1480         B := AccumB;
1481       end;
1482     end;
1483
1484     DestLine := @PByteArray(DestCanvas.FPData.Bits)[((J + DestY) * DestCanvas.FPData.Width + DestX) * DestBpp];
1485
1486     for I := 0 to DestWidth - 1 do
1487     begin
1488       ClusterX := MapX[I];
1489       AccumA := 0.0;
1490       AccumR := 0.0;
1491       AccumG := 0.0;
1492       AccumB := 0.0;
1493       for X := 0 to Length(ClusterX) - 1 do
1494       begin
1495         Weight := ClusterX[X].Weight;
1496         with LineBuffer[ClusterX[X].Pos - XMinimum] do
1497         begin
1498           AccumB := AccumB + B * Weight;
1499           AccumG := AccumG + G * Weight;
1500           AccumR := AccumR + R * Weight;
1501           AccumA := AccumA + A * Weight;
1502         end;
1503       end;
1504
1505       SrcPix.A := AccumA;
1506       SrcPix.R := AccumR;
1507       SrcPix.G := AccumG;
1508       SrcPix.B := AccumB;
1509
1510       // Write resulting blended pixel
1511       PixelWriteProc(SrcPix, DestLine, @DestCanvas.FFormatInfo, SrcFactor, DestFactor);
1512       Inc(DestLine, DestBpp);
1513     end;
1514   end;
1515 end;
1516
1517 procedure TImagingCanvas.StretchDrawBlend(const SrcRect: TRect;
1518   DestCanvas: TImagingCanvas; const DestRect: TRect;
1519   SrcFactor, DestFactor: TBlendingFactor; Filter: TResizeFilter);
1520 begin
1521   StretchDrawInternal(SrcRect, DestCanvas, DestRect, SrcFactor, DestFactor, Filter, PixelBlendProc);
1522 end;
1523
1524 procedure TImagingCanvas.StretchDrawAlpha(const SrcRect: TRect;
1525   DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter);
1526 begin
1527   StretchDrawInternal(SrcRect, DestCanvas, DestRect, bfIgnore, bfIgnore, Filter, PixelAlphaProc);
1528 end;
1529
1530 procedure TImagingCanvas.StretchDrawAdd(const SrcRect: TRect;
1531   DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter);
1532 begin
1533   StretchDrawInternal(SrcRect, DestCanvas, DestRect, bfIgnore, bfIgnore, Filter, PixelAddProc);
1534 end;
1535
1536 procedure TImagingCanvas.ApplyConvolution(Kernel: PLongInt; KernelSize,
1537   Divisor: LongInt; Bias: Single; ClampChannels: Boolean);
1538 var
1539   X, Y, I, J, PosY, PosX, SizeDiv2, KernelValue, WidthBytes, Bpp: LongInt;
1540   R, G, B, DivFloat: Single;
1541   Pixel: TColorFPRec;
1542   TempImage: TImageData;
1543   DstPointer, SrcPointer: PByte;
1544 begin
1545   SizeDiv2 := KernelSize div 2;
1546   DivFloat := IffFloat(Divisor > 1, 1.0 / Divisor, 1.0);
1547   Bpp := FFormatInfo.BytesPerPixel;
1548   WidthBytes := FPData.Width * Bpp;
1549
1550   InitImage(TempImage);
1551   CloneImage(FPData^, TempImage);
1552
1553   try
1554     // For every pixel in clip rect
1555     for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1556     begin
1557       DstPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp];
1558
1559       for X := FClipRect.Left to FClipRect.Right - 1 do
1560       begin
1561         // Reset accumulators
1562         R := 0.0;
1563         G := 0.0;
1564         B := 0.0;
1565
1566         for J := 0 to KernelSize - 1 do
1567         begin
1568           PosY := ClampInt(Y + J - SizeDiv2, FClipRect.Top, FClipRect.Bottom - 1);
1569
1570           for I := 0 to KernelSize - 1 do
1571           begin
1572             PosX := ClampInt(X + I - SizeDiv2, FClipRect.Left, FClipRect.Right - 1);
1573             SrcPointer := @PByteArray(TempImage.Bits)[PosY * WidthBytes + PosX * Bpp];
1574
1575             // Get pixels from neighbourhood of current pixel and add their
1576             // colors to accumulators weighted by filter kernel values
1577             Pixel := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, TempImage.Palette);
1578             KernelValue := PLongIntArray(Kernel)[J * KernelSize + I];
1579
1580             R := R + Pixel.R * KernelValue;
1581             G := G + Pixel.G * KernelValue;
1582             B := B + Pixel.B * KernelValue;
1583           end;
1584         end;
1585
1586         Pixel := FFormatInfo.GetPixelFP(DstPointer, @FFormatInfo, FPData.Palette);
1587
1588         Pixel.R := R * DivFloat + Bias;
1589         Pixel.G := G * DivFloat + Bias;
1590         Pixel.B := B * DivFloat + Bias;
1591
1592         if ClampChannels then
1593           ClampFloatPixel(Pixel);
1594
1595         // Set resulting pixel color
1596         FFormatInfo.SetPixelFP(DstPointer, @FFormatInfo, FPData.Palette, Pixel);
1597
1598         Inc(DstPointer, Bpp);
1599       end;
1600     end;
1601
1602   finally
1603     FreeImage(TempImage);
1604   end;
1605 end;
1606
1607 procedure TImagingCanvas.ApplyConvolution3x3(const Filter: TConvolutionFilter3x3);
1608 begin
1609   ApplyConvolution(@Filter.Kernel, 3, Filter.Divisor, Filter.Bias, True);
1610 end;
1611
1612 procedure TImagingCanvas.ApplyConvolution5x5(const Filter: TConvolutionFilter5x5);
1613 begin
1614   ApplyConvolution(@Filter.Kernel, 5, Filter.Divisor, Filter.Bias, True);
1615 end;
1616
1617 procedure TImagingCanvas.ApplyNonLinearFilter(FilterSize: Integer; SelectFunc: TSelectPixelFunction);
1618 var
1619   X, Y, I, J, PosY, PosX, SizeDiv2, WidthBytes, Bpp: LongInt;
1620   Pixel: TColorFPRec;
1621   TempImage: TImageData;
1622   DstPointer, SrcPointer: PByte;
1623   NeighPixels: TDynFPPixelArray;
1624 begin
1625   SizeDiv2 := FilterSize div 2;
1626   Bpp := FFormatInfo.BytesPerPixel;
1627   WidthBytes := FPData.Width * Bpp;
1628   SetLength(NeighPixels, FilterSize * FilterSize);
1629
1630   InitImage(TempImage);
1631   CloneImage(FPData^, TempImage);
1632
1633   try
1634     // For every pixel in clip rect
1635     for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1636     begin
1637       DstPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp];
1638
1639       for X := FClipRect.Left to FClipRect.Right - 1 do
1640       begin
1641         for J := 0 to FilterSize - 1 do
1642         begin
1643           PosY := ClampInt(Y + J - SizeDiv2, FClipRect.Top, FClipRect.Bottom - 1);
1644
1645           for I := 0 to FilterSize - 1 do
1646           begin
1647             PosX := ClampInt(X + I - SizeDiv2, FClipRect.Left, FClipRect.Right - 1);
1648             SrcPointer := @PByteArray(TempImage.Bits)[PosY * WidthBytes + PosX * Bpp];
1649
1650             // Get pixels from neighbourhood of current pixel and store them
1651             Pixel := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, TempImage.Palette);
1652             NeighPixels[J * FilterSize + I] := Pixel;
1653           end;
1654         end;
1655
1656         // Choose pixel using custom function
1657         Pixel := SelectFunc(NeighPixels);
1658         // Set resulting pixel color
1659         FFormatInfo.SetPixelFP(DstPointer, @FFormatInfo, FPData.Palette, Pixel);
1660
1661         Inc(DstPointer, Bpp);
1662       end;
1663     end;
1664
1665   finally
1666     FreeImage(TempImage);
1667   end;
1668 end;
1669
1670 procedure TImagingCanvas.ApplyMedianFilter(FilterSize: Integer);
1671 begin
1672   ApplyNonLinearFilter(FilterSize, MedianSelect);
1673 end;
1674
1675 procedure TImagingCanvas.ApplyMinFilter(FilterSize: Integer);
1676 begin
1677   ApplyNonLinearFilter(FilterSize, MinSelect);
1678 end;
1679
1680 procedure TImagingCanvas.ApplyMaxFilter(FilterSize: Integer);
1681 begin
1682   ApplyNonLinearFilter(FilterSize, MaxSelect);
1683 end;
1684
1685 procedure TImagingCanvas.PointTransform(Transform: TPointTransformFunction;
1686   Param1, Param2, Param3: Single);
1687 var
1688   X, Y, Bpp, WidthBytes: Integer;
1689   PixPointer: PByte;
1690   Pixel: TColorFPRec;
1691 begin
1692   Bpp := FFormatInfo.BytesPerPixel;
1693   WidthBytes := FPData.Width * Bpp;
1694
1695   // For every pixel in clip rect
1696   for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1697   begin
1698     PixPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp];
1699     for X := FClipRect.Left to FClipRect.Right - 1 do
1700     begin
1701       Pixel := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette);
1702
1703       FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette,
1704         Transform(Pixel, Param1, Param2, Param3));
1705
1706       Inc(PixPointer, Bpp);
1707     end;
1708   end;
1709 end;
1710
1711 procedure TImagingCanvas.ModifyContrastBrightness(Contrast, Brightness: Single);
1712 begin
1713   PointTransform(TransformContrastBrightness, 1.0 + Contrast / 100,
1714     Brightness / 100, 0);
1715 end;
1716
1717 procedure TImagingCanvas.GammaCorection(Red, Green, Blue: Single);
1718 begin
1719   PointTransform(TransformGamma, Red, Green, Blue);
1720 end;
1721
1722 procedure TImagingCanvas.InvertColors;
1723 begin
1724   PointTransform(TransformInvert, 0, 0, 0);
1725 end;
1726
1727 procedure TImagingCanvas.Threshold(Red, Green, Blue: Single);
1728 begin
1729   PointTransform(TransformThreshold, Red, Green, Blue);
1730 end;
1731
1732 procedure TImagingCanvas.AdjustColorLevels(BlackPoint, WhitePoint, MidPoint: Single);
1733 begin
1734   PointTransform(TransformLevels, BlackPoint, WhitePoint, 1.0 / MidPoint);
1735 end;
1736
1737 procedure TImagingCanvas.PremultiplyAlpha;
1738 begin
1739   PointTransform(TransformPremultiplyAlpha, 0, 0, 0);
1740 end;
1741
1742 procedure TImagingCanvas.UnPremultiplyAlpha;
1743 begin
1744   PointTransform(TransformUnPremultiplyAlpha, 0, 0, 0);
1745 end;
1746
1747 procedure TImagingCanvas.GetHistogram(out Red, Green, Blue, Alpha,
1748   Gray: THistogramArray);
1749 var
1750   X, Y, Bpp: Integer;
1751   PixPointer: PByte;
1752   Color32: TColor32Rec;
1753 begin
1754   FillChar(Red,   SizeOf(Red), 0);
1755   FillChar(Green, SizeOf(Green), 0);
1756   FillChar(Blue,  SizeOf(Blue), 0);
1757   FillChar(Alpha, SizeOf(Alpha), 0);
1758   FillChar(Gray,  SizeOf(Gray), 0);
1759
1760   Bpp := FFormatInfo.BytesPerPixel;
1761
1762   for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1763   begin
1764     PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
1765     for X := FClipRect.Left to FClipRect.Right - 1 do
1766     begin
1767       Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
1768
1769       Inc(Red[Color32.R]);
1770       Inc(Green[Color32.G]);
1771       Inc(Blue[Color32.B]);
1772       Inc(Alpha[Color32.A]);
1773       Inc(Gray[Round(GrayConv.R * Color32.R + GrayConv.G * Color32.G + GrayConv.B * Color32.B)]);
1774
1775       Inc(PixPointer, Bpp);
1776     end;
1777   end;
1778 end;
1779
1780 procedure TImagingCanvas.FillChannel(ChannelId: Integer; NewChannelValue: Byte);
1781 var
1782   X, Y, Bpp: Integer;
1783   PixPointer: PByte;
1784   Color32: TColor32Rec;
1785 begin
1786   Bpp := FFormatInfo.BytesPerPixel;
1787
1788   for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1789   begin
1790     PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
1791     for X := FClipRect.Left to FClipRect.Right - 1 do
1792     begin
1793       Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
1794       Color32.Channels[ChannelId] := NewChannelValue;
1795       FFormatInfo.SetPixel32(PixPointer, @FFormatInfo, FPData.Palette, Color32);
1796
1797       Inc(PixPointer, Bpp);
1798     end;
1799   end;
1800 end;
1801
1802 procedure TImagingCanvas.FillChannelFP(ChannelId: Integer; NewChannelValue: Single);
1803 var
1804   X, Y, Bpp: Integer;
1805   PixPointer: PByte;
1806   ColorFP: TColorFPRec;
1807 begin
1808   Bpp := FFormatInfo.BytesPerPixel;
1809
1810   for Y := FClipRect.Top to FClipRect.Bottom - 1 do
1811   begin
1812     PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
1813     for X := FClipRect.Left to FClipRect.Right - 1 do
1814     begin
1815       ColorFP := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette);
1816       ColorFP.Channels[ChannelId] := NewChannelValue;
1817       FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette, ColorFP);
1818
1819       Inc(PixPointer, Bpp);
1820     end;
1821   end;
1822 end;
1823
1824 class function TImagingCanvas.GetSupportedFormats: TImageFormats;
1825 begin
1826   Result := [ifIndex8..Pred(ifDXT1)];
1827 end;
1828
1829 { TFastARGB32Canvas }
1830
1831 destructor TFastARGB32Canvas.Destroy;
1832 begin
1833   FreeMem(FScanlines);
1834   inherited Destroy;
1835 end;
1836
1837 procedure TFastARGB32Canvas.AlphaBlendPixels(SrcPix, DestPix: PColor32Rec);
1838 var
1839   SrcAlpha, DestAlpha, FinalAlpha: Integer;
1840 begin
1841   FinalAlpha := SrcPix.A + 1 + (DestPix.A * (256 - SrcPix.A)) shr 8;
1842   if FinalAlpha = 0 then
1843     SrcAlpha := 0
1844   else
1845     SrcAlpha := (SrcPix.A shl 8) div FinalAlpha;
1846   DestAlpha := 256 - SrcAlpha;
1847
1848   DestPix.A := ClampToByte(FinalAlpha);
1849   DestPix.R := (SrcPix.R * SrcAlpha + DestPix.R * DestAlpha) shr 8;
1850   DestPix.G := (SrcPix.G * SrcAlpha + DestPix.G * DestAlpha) shr 8;
1851   DestPix.B := (SrcPix.B * SrcAlpha + DestPix.B * DestAlpha) shr 8;
1852 end;
1853
1854 procedure TFastARGB32Canvas.DrawAlpha(const SrcRect: TRect;
1855   DestCanvas: TImagingCanvas; DestX, DestY: Integer);
1856 var
1857   X, Y, SrcX, SrcY, Width, Height: Integer;
1858   SrcPix, DestPix: PColor32Rec;
1859 begin
1860   if DestCanvas.ClassType <> Self.ClassType then
1861   begin
1862     inherited;
1863     Exit;
1864   end;
1865
1866   SrcX := SrcRect.Left;
1867   SrcY := SrcRect.Top;
1868   Width := SrcRect.Right - SrcRect.Left;
1869   Height := SrcRect.Bottom - SrcRect.Top;
1870   ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY,
1871     FPData.Width, FPData.Height, DestCanvas.ClipRect);
1872
1873   for Y := 0 to Height - 1 do
1874   begin
1875     SrcPix := @FScanlines[SrcY + Y, SrcX];
1876     DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + Y, DestX];
1877     for X := 0 to Width - 1 do
1878     begin
1879       AlphaBlendPixels(SrcPix, DestPix);
1880       Inc(SrcPix);
1881       Inc(DestPix);
1882     end;
1883   end;
1884 end;
1885
1886 function TFastARGB32Canvas.GetPixel32(X, Y: LongInt): TColor32;
1887 begin
1888   Result := FScanlines[Y, X].Color;
1889 end;
1890
1891 procedure TFastARGB32Canvas.SetPixel32(X, Y: LongInt; const Value: TColor32);
1892 begin
1893   if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and
1894     (X < FClipRect.Right) and (Y < FClipRect.Bottom) then
1895   begin
1896     FScanlines[Y, X].Color := Value;
1897   end;
1898 end;
1899
1900 procedure TFastARGB32Canvas.StretchDrawAlpha(const SrcRect: TRect;
1901   DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter);
1902 var
1903   X, Y, ScaleX, ScaleY, Yp, Xp, Weight1, Weight2, Weight3, Weight4, InvFracY, T1, T2: Integer;
1904   FracX, FracY: Cardinal;
1905   SrcX, SrcY, SrcWidth, SrcHeight: Integer;
1906   DestX, DestY, DestWidth, DestHeight: Integer;
1907   SrcLine, SrcLine2: PColor32RecArray;
1908   DestPix: PColor32Rec;
1909   Accum: TColor32Rec;
1910 begin
1911   if (Filter = rfBicubic) or (DestCanvas.ClassType <> Self.ClassType) then
1912   begin
1913     inherited;
1914     Exit;
1915   end;
1916
1917   SrcX := SrcRect.Left;
1918   SrcY := SrcRect.Top;
1919   SrcWidth := SrcRect.Right - SrcRect.Left;
1920   SrcHeight := SrcRect.Bottom - SrcRect.Top;
1921   DestX := DestRect.Left;
1922   DestY := DestRect.Top;
1923   DestWidth := DestRect.Right - DestRect.Left;
1924   DestHeight := DestRect.Bottom - DestRect.Top;
1925   // Clip src and dst rects
1926   ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight,
1927       FPData.Width, FPData.Height, DestCanvas.ClipRect);
1928   ScaleX := (SrcWidth shl 16) div DestWidth;
1929   ScaleY := (SrcHeight shl 16) div DestHeight;
1930
1931   // Nearest and linear filtering using fixed point math
1932
1933   if Filter = rfNearest then
1934   begin
1935     Yp := 0;
1936     for Y := DestY to DestY + DestHeight - 1 do
1937     begin
1938       Xp := 0;
1939       SrcLine := @FScanlines[SrcY + Yp shr 16, SrcX];
1940       DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
1941       for X := 0 to DestWidth - 1 do
1942       begin
1943         AlphaBlendPixels(@SrcLine[Xp shr 16], DestPix);
1944         Inc(DestPix);
1945         Inc(Xp, ScaleX);
1946       end;
1947       Inc(Yp, ScaleY);
1948     end;
1949   end
1950   else
1951   begin
1952     Yp := (ScaleY shr 1) - $8000;
1953     for Y := DestY to DestY + DestHeight - 1 do
1954     begin
1955       DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
1956       if Yp < 0 then
1957       begin
1958         T1 := 0;
1959         FracY := 0;
1960         InvFracY := $10000;
1961       end
1962       else
1963       begin
1964         T1 := Yp shr 16;
1965         FracY := Yp and $FFFF;
1966         InvFracY := (not Yp and $FFFF) + 1;
1967       end;
1968
1969       T2 := Iff(T1 < SrcHeight - 1, T1 + 1, T1);
1970       SrcLine :=  @Scanlines[T1 + SrcY, SrcX];
1971       SrcLine2 := @Scanlines[T2 + SrcY, SrcX];
1972       Xp := (ScaleX shr 1) - $8000;
1973
1974       for X := 0 to DestWidth - 1 do
1975       begin
1976         if Xp < 0 then
1977         begin
1978           T1 := 0;
1979           FracX := 0;
1980         end
1981         else
1982         begin
1983           T1 := Xp shr 16;
1984           FracX := Xp and $FFFF;
1985         end;
1986
1987         T2 := Iff(T1 < SrcWidth - 1, T1 + 1, T1);
1988         Weight2:= Integer((Cardinal(InvFracY) * FracX) shr 16); // cast to Card, Int can overflow here
1989         Weight1:= InvFracY - Weight2;
1990         Weight4:= Integer((Cardinal(FracY) * FracX) shr 16);
1991         Weight3:= FracY - Weight4;
1992
1993         Accum.B := (SrcLine[T1].B * Weight1 + SrcLine[T2].B * Weight2 +
1994           SrcLine2[T1].B * Weight3 + SrcLine2[T2].B * Weight4 + $8000) shr 16;
1995         Accum.G := (SrcLine[T1].G * Weight1 + SrcLine[T2].G * Weight2 +
1996           SrcLine2[T1].G * Weight3 + SrcLine2[T2].G * Weight4 + $8000) shr 16;
1997         Accum.R := (SrcLine[T1].R * Weight1 + SrcLine[T2].R * Weight2 +
1998           SrcLine2[T1].R * Weight3 + SrcLine2[T2].R * Weight4 + $8000) shr 16;
1999         Accum.A := (SrcLine[T1].A * Weight1 + SrcLine[T2].A * Weight2 +
2000           SrcLine2[T1].A * Weight3 + SrcLine2[T2].A * Weight4 + $8000) shr 16;
2001
2002         AlphaBlendPixels(@Accum, DestPix);
2003
2004         Inc(Xp, ScaleX);
2005         Inc(DestPix);
2006       end;
2007       Inc(Yp, ScaleY);
2008      end;
2009   end;
2010 end;
2011
2012 procedure TFastARGB32Canvas.UpdateCanvasState;
2013 var
2014   I: LongInt;
2015   ScanPos: PLongWord;
2016 begin
2017   inherited UpdateCanvasState;
2018
2019   // Realloc and update scanline array
2020   ReallocMem(FScanlines, FPData.Height * SizeOf(PColor32RecArray));
2021   ScanPos := FPData.Bits;
2022
2023   for I := 0 to FPData.Height - 1 do
2024   begin
2025     FScanlines[I] := PColor32RecArray(ScanPos);
2026     Inc(ScanPos, FPData.Width);
2027   end;
2028 end;
2029
2030 class function TFastARGB32Canvas.GetSupportedFormats: TImageFormats;
2031 begin
2032   Result := [ifA8R8G8B8];
2033 end;
2034
2035 procedure TFastARGB32Canvas.InvertColors;
2036 var
2037   X, Y: Integer;
2038   PixPtr: PColor32Rec;
2039 begin
2040   for Y := FClipRect.Top to FClipRect.Bottom - 1 do
2041   begin
2042     PixPtr := @FScanlines[Y, FClipRect.Left];
2043     for X := FClipRect.Left to FClipRect.Right - 1 do
2044     begin
2045       PixPtr.R := not PixPtr.R;
2046       PixPtr.G := not PixPtr.G;
2047       PixPtr.B := not PixPtr.B;
2048       Inc(PixPtr);
2049     end;
2050   end;
2051 end;
2052
2053 initialization
2054   RegisterCanvas(TFastARGB32Canvas);
2055
2056 finalization
2057   FreeAndNil(CanvasClasses);
2058
2059 {
2060   File Notes:
2061
2062   -- TODOS ----------------------------------------------------
2063     - more more more ...
2064     - implement pen width everywhere
2065     - more objects (arc, polygon)
2066
2067   -- 0.26.5 Changes/Bug Fixes ---------------------------------
2068     - Fixed bug that could raise floating point error in DrawAlpha
2069       and StretchDrawAlpha.
2070     - Fixed bug in TImagingCanvas.Line that caused not drawing
2071       of horz or vert lines.
2072
2073   -- 0.26.3 Changes/Bug Fixes ---------------------------------
2074     - Added some methods to TFastARGB32Canvas (InvertColors, DrawAlpha/StretchDrawAlpha)
2075     - Fixed DrawAlpha/StretchDrawAlpha destination alpha calculation.
2076     - Added PremultiplyAlpha and UnPremultiplyAlpha methods.
2077
2078   -- 0.26.1 Changes/Bug Fixes ---------------------------------
2079     - Added FillChannel methods.
2080     - Added FloodFill method.
2081     - Added GetHistogram method.
2082     - Fixed "Invalid FP operation" in AdjustColorLevels in FPC compiled exes
2083       (thanks to Carlos González).
2084     - Added TImagingCanvas.AdjustColorLevels method.
2085
2086   -- 0.25.0 Changes/Bug Fixes ---------------------------------
2087     - Fixed error that could cause AV in linear and nonlinear filters.
2088     - Added blended rect filling function FillRectBlend.
2089     - Added drawing function with blending (DrawAlpha, StretchDrawAlpha,
2090         StretchDrawAdd, DrawBlend, StretchDrawBlend, ...)
2091     - Added non-linear filters (min, max, median).
2092     - Added point transforms (invert, contrast, gamma, brightness).
2093
2094   -- 0.21 Changes/Bug Fixes -----------------------------------
2095     - Added some new filter kernels for convolution.
2096     - Added FillMode and PenMode properties.
2097     - Added FrameRect, Rectangle, Ellipse, and Line methods.
2098     - Removed HorzLine and VertLine from TFastARGB32Canvas - new versions
2099       in general canvas is now as fast as those in TFastARGB32Canvas
2100       (only in case of A8R8G8B8 images of course).
2101     - Added PenWidth property, updated HorzLine and VertLine to use it.
2102
2103   -- 0.19 Changes/Bug Fixes -----------------------------------
2104     - added TFastARGB32Canvas
2105     - added convolutions, hline, vline
2106     - unit created, intial stuff added
2107
2108 }
2109
2110 end.