Changeset 317 for GraphicTest

Timestamp:

Feb 1, 2012, 3:02:33 PM (13 years ago)

Author:

chronos

Message:

• Modified: Updated BGRABitmap package to version 5.5.
• Modified: Removed draw method ComboBox and reorganized method list to single listview with using ownerdraw facility.
• Added: New draw method TBitmap.RawImage.Data Move which use fast Move operation. It requires same pixel format.
• Added: New draw method Dummy for comparion of empty method and to determine possibily max frame rate limit.

Location:

GraphicTest

Files:

• BGRABitmap (modified) (1 prop)
• BGRABitmap/bgraanimatedgif.pas (modified) (3 diffs)
• BGRABitmap/bgrabitmap.pas (modified) (4 diffs)
• BGRABitmap/bgrabitmappack.lpk (added)
• BGRABitmap/bgrabitmappack.pas (added)
• BGRABitmap/bgrabitmaptypes.pas (modified) (20 diffs)
• BGRABitmap/bgrablend.pas (modified) (24 diffs)
• BGRABitmap/bgracanvas.pas (added)
• BGRABitmap/bgracanvas2d.pas (added)
• BGRABitmap/bgracompressablebitmap.pas (modified) (12 diffs)
• BGRABitmap/bgradefaultbitmap.pas (modified) (112 diffs)
• BGRABitmap/bgradnetdeserial.pas (modified) (29 diffs)
• BGRABitmap/bgrafillinfo.pas (added)
• BGRABitmap/bgrafilters.pas (modified) (36 diffs)
• BGRABitmap/bgragradients.pas (added)
• BGRABitmap/bgragradientscanner.pas (added)
• BGRABitmap/bgragtkbitmap.pas (modified) (12 diffs)
• BGRABitmap/bgralayers.pas (added)
• BGRABitmap/bgrapaintnet.pas (modified) (19 diffs)
• BGRABitmap/bgrapath.pas (added)
• BGRABitmap/bgrapen.pas (added)
• BGRABitmap/bgraphongtypes.pas (added)
• BGRABitmap/bgrapolygon.pas (modified) (3 diffs)
• BGRABitmap/bgrapolygonaliased.pas (added)
• BGRABitmap/bgraqtbitmap.pas (modified) (1 diff)
• BGRABitmap/bgraresample.pas (modified) (11 diffs)
• BGRABitmap/bgrascene3d.pas (added)
• BGRABitmap/bgratext.pas (added)
• BGRABitmap/bgratextfx.pas (added)
• BGRABitmap/bgratransform.pas (added)
• BGRABitmap/blurfast.inc (added)
• BGRABitmap/blurnormal.inc (added)
• BGRABitmap/filldensity256.inc (added)
• BGRABitmap/filldensitysegment256.inc (added)
• BGRABitmap/lineartexscan.inc (added)
• BGRABitmap/multishapeline.inc (added)
• BGRABitmap/perspectivescan.inc (added)
• BGRABitmap/phongdraw.inc (added)
• BGRABitmap/readme.txt (modified) (1 diff)
• BGRABitmap/renderdensity256.inc (added)
• GraphicTest.lpi (modified) (20 diffs)
• GraphicTest.lpr (modified) (1 diff)
• UDrawMethod.pas (modified) (4 diffs)
• UFastBitmap.pas (modified) (1 diff)
• UMainForm.lfm (modified) (3 diffs)
• UMainForm.pas (modified) (10 diffs)

GraphicTest/BGRABitmap/bgraanimatedgif.pas

@@ -1005 +1005 @@
             begin
               PChangePix^ := PBackground^;
-              DrawPixelInline(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
+              DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
             end
             else if PChangePix^ and AlphaMask <> 0 then
@@ -1045 +1045 @@
               begin
                 PChangePix^ := PBackground^;
-                DrawPixelInline(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
+                DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
               end
               else if PChangePix^ and AlphaMask <> 0 then
@@ -1176 +1176 @@
         begin
           PChangePix^ := MemPixEraseColor;
-          DrawPixelInline(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
+          DrawPixelInlineNoAlphaCheck(PBGRAPixel(PChangePix), PBGRAPixel(@newpix)^);
         end
         else if PChangePix^ and AlphaMask <> 0 then

GraphicTest/BGRABitmap/bgrabitmap.pas

@@ -41 +41 @@
 interface
 
+{ Compiler directives are used to include the best version according
+  to the platform }
+
 uses
   Classes, SysUtils,
@@ -81 +84 @@
 {$ENDIF}
 
-
+// draw a bitmap from pure data
 procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
   VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean);
-procedure BGRAReplace(var Source: TBGRABitmap; Temp: TObject);
+  
+{ Replace the content of the variable Destination with the variable
+  Temp and frees previous object contained in Destination.
+  
+  This function is useful as a shortcut for :
+ 
+  var
+    temp: TBGRABitmap;
+  begin
+    ...
+    temp := someBmp.Filter... as TBGRABitmap;
+    someBmp.Free;
+    someBmp := temp;
+  end;
+  
+  which becomes :
+  
+  begin
+    ...
+    BGRAReplace(temp, someBmp.Filter... );
+  end;
+}
+procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject);
 
 implementation
 
-uses GraphType, BGRAAnimatedGif;
+uses GraphType, BGRABitmapTypes;
 
 var
-  bmp: TBGRABitmap;
+  tempBmp: TBGRABitmap;
 
 procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
@@ -98 +123 @@
   LineOrder: TRawImageLineOrder;
 begin
+  if tempBmp = nil then
+    tempBmp := TBGRABitmap.Create;
   if VerticalFlip then
     LineOrder := riloBottomToTop
@@ -103 +130 @@
     LineOrder := riloTopToBottom;
   if Opaque then
-    bmp.DataDrawOpaque(ACanvas, Rect, AData, LineOrder, AWidth, AHeight)
+    tempBmp.DataDrawOpaque(ACanvas, Rect, AData, LineOrder, AWidth, AHeight)
   else
-    bmp.DataDrawTransparent(ACanvas, Rect, AData, LineOrder, AWidth, AHeight);
+    tempBmp.DataDrawTransparent(ACanvas, Rect, AData, LineOrder, AWidth, AHeight);
 end;
 
-procedure BGRAReplace(var Source: TBGRABitmap; Temp: TObject);
+procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject);
 begin
-  Source.Free;
-  Source := Temp as TBGRABitmap;
+  Destination.Free;
+  Destination := Temp as TBGRABitmap;
 end;
 
 initialization
 
-  bmp := TBGRABitmap.Create(0, 0);
+  //this variable is assigned to access appropriate functions
+  //depending on the platform
+  BGRABitmapFactory := TBGRABitmap;
 
 finalization
 
-  bmp.Free;
+  tempBmp.Free;
 
 end.

GraphicTest/BGRABitmap/bgrabitmaptypes.pas

@@ -30 +30 @@
 
 uses
-  Classes, Graphics;
+  Classes, Types, Graphics, FPImage, FPImgCanv, GraphType;
 
 type
+  //pointer for direct pixel access
   PBGRAPixel = ^TBGRAPixel;
 
+  //pixel structure
   TBGRAPixel = packed record
     blue, green, red, alpha: byte;
   end;
 
+  //gamma expanded values
   TExpandedPixel = packed record
     red, green, blue, alpha: word;
   end;
 
+  //pixel color defined in HSL colorspace
   THSLAPixel = packed record
     hue, saturation, lightness, alpha: word;
   end;
 
-  TDrawMode = (dmSet, dmSetExceptTransparent, dmLinearBlend, dmDrawWithTransparency);
-  TFloodfillMode = (fmSet, fmDrawWithTransparency, fmProgressive);
-  TResampleMode = (rmSimpleStretch, rmFineResample);
+  //general purpose color variable with floating point values
+  TColorF = array[1..4] of single;
+  
+  { These types are used as parameters }
+
+  TDrawMode = (dmSet,                   //replace pixels
+               dmSetExceptTransparent,  //draw pixels with alpha=255
+               dmLinearBlend,           //blend without gamma correction
+               dmDrawWithTransparency,  //normal blending with gamma correction
+               dmXor);                  //bitwise xor for all channels
+  TChannel = (cRed, cGreen, cBlue, cAlpha);
+  TChannels = set of TChannel;
+               
+  //floodfill option
+  TFloodfillMode = (fmSet,                   //set pixels
+                    fmDrawWithTransparency,  //draw fill color with transparency
+                    fmProgressive);          //draw fill color with transparency according to similarity with start color
+
+  TResampleMode = (rmSimpleStretch,   //low quality resample
+                   rmFineResample);   //use resample filters 
+  TResampleFilter = (rfLinear,        //linear interpolation
+                     rfHalfCosine,    //mix of rfLinear and rfCosine
+                     rfCosine,        //cosine-like interpolation
+                     rfBicubic,       //simple bi-cubic filter (blur)
+                     rfMitchell,      //downsizing interpolation
+                     rfSpline,        //upsizing interpolation
+                     rfBestQuality);  //mix of rfMitchell and rfSpline
+
+  TBGRAFontQuality = (fqSystem, fqSystemClearType, fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR);
+
   TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth);
+  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast);
+  TSplineStyle = (ssInside, ssInsideWithEnds, ssCrossing, ssCrossingWithEnds, ssOutside, ssRoundOutside, ssVertexToSide);
+  
+  //Advanced blending modes
+  //see : http://www.brighthub.com/multimedia/photography/articles/18301.aspx
+  //and : http://www.pegtop.net/delphi/articles/blendmodes/  
+  TBlendOperation = (boLinearBlend, boTransparent,                                  //blending
+    boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boNiceGlow,         //lighting
+    boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn, //masking
+    boDifference, boLinearDifference, boNegation, boLinearNegation, boXor);         //negative
+
+const
+  boGlowMask = boGlow;
+  boLinearMultiply = boMultiply;
+
+const
+  BlendOperationStr : array[TBlendOperation] of string =
+   ('LinearBlend', 'Transparent',
+    'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'NiceGlow',
+    'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn',
+    'Difference', 'LinearDifference', 'Negation', 'LinearNegation', 'Xor');
+
+function StrToBlendOperation(str: string): TBlendOperation;
+
+type
   TGradientType = (gtLinear, gtReflected, gtDiamond, gtRadial);
-
 const
   GradientTypeStr : array[TGradientType] of string =
   ('Linear','Reflected','Diamond','Radial');
-
+function StrToGradientType(str: string): TGradientType;
+ 
 type
-  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise);
-  TChannel = (cRed, cGreen, cBlue, cAlpha);
-  TBlendOperation = (boLinearBlend, boTransparent, boMultiply,
-    boLinearMultiply, boAdditive, boLinearAdd, boColorBurn, boColorDodge, boReflect,
-    boGlow, boOverlay, boDifference, boLinearDifference, boNegation,
-    boLinearNegation, boLighten, boDarken, boScreen, boXor);
-
+  { A pen style is defined as a list of floating number. The first number is the length of the first dash,
+    the second number is the length of the first gap, the third number is the length of the second dash... 
+    It must have an even number of values. }
+  TBGRAPenStyle = Array Of Single;
+  TRoundRectangleOption = (rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare,
+                           rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel,rrDefault);
+  TRoundRectangleOptions = set of TRoundRectangleOption;
+  TPolygonOrder = (poNone, poFirstOnTop, poLastOnTop); //see TBGRAMultiShapeFiller in BGRAPolygon
+  
+function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle;  
+  
+{ Point, polygon and curve structures }
+type
+  PPointF = ^TPointF;
   TPointF = record
     x, y: single;
   end;
   ArrayOfTPointF = array of TPointF;
-
+  TArcOption = (aoClosePath, aoPie, aoFillPath);
+  TArcOptions = set of TArcOption;
+
+  TCubicBezierCurve = record
+    p1,c1,c2,p2: TPointF;
+  end;
+  TQuadraticBezierCurve = record
+    p1,c,p2: TPointF;
+  end;
+
+  TPoint3D = record
+    x,y,z: single;
+  end;
+
+function ConcatPointsF(const APolylines: array of ArrayOfTPointF): ArrayOfTPointF;
+
+function Point3D(x,y,z: single): TPoint3D;
+operator = (const v1,v2: TPoint3D): boolean; inline;
+operator * (const v1,v2: TPoint3D): single; inline;
+operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
+operator - (const v1,v2: TPoint3D): TPoint3D; inline;
+operator - (const v: TPoint3D): TPoint3D; inline;
+operator + (const v1,v2: TPoint3D): TPoint3D; inline;
+procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
+procedure Normalize3D(var v: TPoint3D); inline;
+
+function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
+function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
+
+{ Useful constants }
 const
   dmFastBlend = dmLinearBlend;
-
-const
-  EmptySingle: single = -3.402823e38;
-
-const
-  EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38);
-
-const
+  EmptySingle: single = -3.402823e38;                        //used as a separator in floating point lists
+  EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38); //used as a separator in TPointF lists
   BGRAPixelTransparent: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 0);
-
-const
   BGRAWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
-
-const
   BGRABlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
 
-const
+  //Red colors
+  CSSIndianRed: TBGRAPixel = (blue: 92; green: 92; red: 205; alpha: 255);
+  CSSLightCoral: TBGRAPixel = (blue: 128; green: 128; red: 240; alpha: 255);
+  CSSSalmon: TBGRAPixel = (blue: 114; green: 128; red: 250; alpha: 255);
+  CSSDarkSalmon: TBGRAPixel = (blue: 122; green: 150; red: 233; alpha: 255);
+  CSSRed: TBGRAPixel = (blue: 0; green: 0; red: 255; alpha: 255);
+  CSSCrimson: TBGRAPixel = (blue: 60; green: 20; red: 220; alpha: 255);
+  CSSFireBrick: TBGRAPixel = (blue: 34; green: 34; red: 178; alpha: 255);
+  CSSDarkRed: TBGRAPixel = (blue: 0; green: 0; red: 139; alpha: 255);
+
+  //Pink colors
+  CSSPink: TBGRAPixel = (blue: 203; green: 192; red: 255; alpha: 255);
+  CSSLightPink: TBGRAPixel = (blue: 193; green: 182; red: 255; alpha: 255);
+  CSSHotPink: TBGRAPixel = (blue: 180; green: 105; red: 255; alpha: 255);
+  CSSDeepPink: TBGRAPixel = (blue: 147; green: 20; red: 255; alpha: 255);
+  CSSMediumVioletRed: TBGRAPixel = (blue: 133; green: 21; red: 199; alpha: 255);
+  CSSPaleVioletRed: TBGRAPixel = (blue: 147; green: 112; red: 219; alpha: 255);
+
+  //Orange colors
+  CSSLightSalmon: TBGRAPixel = (blue: 122; green: 160; red: 255; alpha: 255);
+  CSSCoral: TBGRAPixel = (blue: 80; green: 127; red: 255; alpha: 255);
+  CSSTomato: TBGRAPixel = (blue: 71; green: 99; red: 255; alpha: 255);
+  CSSOrangeRed: TBGRAPixel = (blue: 0; green: 69; red: 255; alpha: 255);
+  CSSDarkOrange: TBGRAPixel = (blue: 0; green: 140; red: 255; alpha: 255);
+  CSSOrange: TBGRAPixel = (blue: 0; green: 165; red: 255; alpha: 255);
+
+  //Yellow colors
+  CSSGold: TBGRAPixel = (blue: 0; green: 215; red: 255; alpha: 255);
+  CSSYellow: TBGRAPixel = (blue: 0; green: 255; red: 255; alpha: 255);
+  CSSLightYellow: TBGRAPixel = (blue: 224; green: 255; red: 255; alpha: 255);
+  CSSLemonChiffon: TBGRAPixel = (blue: 205; green: 250; red: 255; alpha: 255);
+  CSSLightGoldenrodYellow: TBGRAPixel = (blue: 210; green: 250; red: 250; alpha: 255);
+  CSSPapayaWhip: TBGRAPixel = (blue: 213; green: 239; red: 255; alpha: 255);
+  CSSMoccasin: TBGRAPixel = (blue: 181; green: 228; red: 255; alpha: 255);
+  CSSPeachPuff: TBGRAPixel = (blue: 185; green: 218; red: 255; alpha: 255);
+  CSSPaleGoldenrod: TBGRAPixel = (blue: 170; green: 232; red: 238; alpha: 255);
+  CSSKhaki: TBGRAPixel = (blue: 140; green: 230; red: 240; alpha: 255);
+  CSSDarkKhaki: TBGRAPixel = (blue: 107; green: 183; red: 189; alpha: 255);
+
+  //Purple colors
+  CSSLavender: TBGRAPixel = (blue: 250; green: 230; red: 230; alpha: 255);
+  CSSThistle: TBGRAPixel = (blue: 216; green: 191; red: 216; alpha: 255);
+  CSSPlum: TBGRAPixel = (blue: 221; green: 160; red: 221; alpha: 255);
+  CSSViolet: TBGRAPixel = (blue: 238; green: 130; red: 238; alpha: 255);
+  CSSOrchid: TBGRAPixel = (blue: 214; green: 112; red: 218; alpha: 255);
+  CSSFuchsia: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
+  CSSMagenta: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
+  CSSMediumOrchid: TBGRAPixel = (blue: 211; green: 85; red: 186; alpha: 255);
+  CSSMediumPurple: TBGRAPixel = (blue: 219; green: 112; red: 147; alpha: 255);
+  CSSBlueViolet: TBGRAPixel = (blue: 226; green: 43; red: 138; alpha: 255);
+  CSSDarkViolet: TBGRAPixel = (blue: 211; green: 0; red: 148; alpha: 255);
+  CSSDarkOrchid: TBGRAPixel = (blue: 204; green: 50; red: 153; alpha: 255);
+  CSSDarkMagenta: TBGRAPixel = (blue: 139; green: 0; red: 139; alpha: 255);
+  CSSPurple: TBGRAPixel = (blue: 128; green: 0; red: 128; alpha: 255);
+  CSSIndigo: TBGRAPixel = (blue: 130; green: 0; red: 75; alpha: 255);
+  CSSDarkSlateBlue: TBGRAPixel = (blue: 139; green: 61; red: 72; alpha: 255);
+  CSSSlateBlue: TBGRAPixel = (blue: 205; green: 90; red: 106; alpha: 255);
+  CSSMediumSlateBlue: TBGRAPixel = (blue: 238; green: 104; red: 123; alpha: 255);
+
+  //Green colors
+  CSSGreenYellow: TBGRAPixel = (blue: 47; green: 255; red: 173; alpha: 255);
+  CSSChartreuse: TBGRAPixel = (blue: 0; green: 255; red: 127; alpha: 255);
+  CSSLawnGreen: TBGRAPixel = (blue: 0; green: 252; red: 124; alpha: 255);
+  CSSLime: TBGRAPixel = (blue: 0; green: 255; red: 0; alpha: 255);
+  CSSLimeGreen: TBGRAPixel = (blue: 50; green: 205; red: 50; alpha: 255);
+  CSSPaleGreen: TBGRAPixel = (blue: 152; green: 251; red: 152; alpha: 255);
+  CSSLightGreen: TBGRAPixel = (blue: 144; green: 238; red: 144; alpha: 255);
+  CSSMediumSpringGreen: TBGRAPixel = (blue: 154; green: 250; red: 0; alpha: 255);
+  CSSSpringGreen: TBGRAPixel = (blue: 127; green: 255; red: 0; alpha: 255);
+  CSSMediumSeaGreen: TBGRAPixel = (blue: 113; green: 179; red: 60; alpha: 255);
+  CSSSeaGreen: TBGRAPixel = (blue: 87; green: 139; red: 46; alpha: 255);
+  CSSForestGreen: TBGRAPixel = (blue: 34; green: 139; red: 34; alpha: 255);
+  CSSGreen: TBGRAPixel = (blue: 0; green: 128; red: 0; alpha: 255);
+  CSSDarkGreen: TBGRAPixel = (blue: 0; green: 100; red: 0; alpha: 255);
+  CSSYellowGreen: TBGRAPixel = (blue: 50; green: 205; red: 154; alpha: 255);
+  CSSOliveDrab: TBGRAPixel = (blue: 35; green: 142; red: 107; alpha: 255);
+  CSSOlive: TBGRAPixel = (blue: 0; green: 128; red: 128; alpha: 255);
+  CSSDarkOliveGreen: TBGRAPixel = (blue: 47; green: 107; red: 85; alpha: 255);
+  CSSMediumAquamarine: TBGRAPixel = (blue: 170; green: 205; red: 102; alpha: 255);
+  CSSDarkSeaGreen: TBGRAPixel = (blue: 143; green: 188; red: 143; alpha: 255);
+  CSSLightSeaGreen: TBGRAPixel = (blue: 170; green: 178; red: 32; alpha: 255);
+  CSSDarkCyan: TBGRAPixel = (blue: 139; green: 139; red: 0; alpha: 255);
+  CSSTeal: TBGRAPixel = (blue: 128; green: 128; red: 0; alpha: 255);
+
+  //Blue/Cyan colors
+  CSSAqua: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
+  CSSCyan: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
+  CSSLightCyan: TBGRAPixel = (blue: 255; green: 255; red: 224; alpha: 255);
+  CSSPaleTurquoise: TBGRAPixel = (blue: 238; green: 238; red: 175; alpha: 255);
+  CSSAquamarine: TBGRAPixel = (blue: 212; green: 255; red: 127; alpha: 255);
+  CSSTurquoise: TBGRAPixel = (blue: 208; green: 224; red: 64; alpha: 255);
+  CSSMediumTurquoise: TBGRAPixel = (blue: 204; green: 209; red: 72; alpha: 255);
+  CSSDarkTurquoise: TBGRAPixel = (blue: 209; green: 206; red: 0; alpha: 255);
+  CSSCadetBlue: TBGRAPixel = (blue: 160; green: 158; red: 95; alpha: 255);
+  CSSSteelBlue: TBGRAPixel = (blue: 180; green: 130; red: 70; alpha: 255);
+  CSSLightSteelBlue: TBGRAPixel = (blue: 222; green: 196; red: 176; alpha: 255);
+  CSSPowderBlue: TBGRAPixel = (blue: 230; green: 224; red: 176; alpha: 255);
+  CSSLightBlue: TBGRAPixel = (blue: 230; green: 216; red: 173; alpha: 255);
+  CSSSkyBlue: TBGRAPixel = (blue: 235; green: 206; red: 135; alpha: 255);
+  CSSLightSkyBlue: TBGRAPixel = (blue: 250; green: 206; red: 135; alpha: 255);
+  CSSDeepSkyBlue: TBGRAPixel = (blue: 255; green: 191; red: 0; alpha: 255);
+  CSSDodgerBlue: TBGRAPixel = (blue: 255; green: 144; red: 30; alpha: 255);
+  CSSCornflowerBlue: TBGRAPixel = (blue: 237; green: 149; red: 100; alpha: 255);
+  CSSRoyalBlue: TBGRAPixel = (blue: 255; green: 105; red: 65; alpha: 255);
+  CSSBlue: TBGRAPixel = (blue: 255; green: 0; red: 0; alpha: 255);
+  CSSMediumBlue: TBGRAPixel = (blue: 205; green: 0; red: 0; alpha: 255);
+  CSSDarkBlue: TBGRAPixel = (blue: 139; green: 0; red: 0; alpha: 255);
+  CSSNavy: TBGRAPixel = (blue: 128; green: 0; red: 0; alpha: 255);
+  CSSMidnightBlue: TBGRAPixel = (blue: 112; green: 25; red: 25; alpha: 255);
+
+  //Brown colors
+  CSSCornsilk: TBGRAPixel = (blue: 220; green: 248; red: 255; alpha: 255);
+  CSSBlanchedAlmond: TBGRAPixel = (blue: 205; green: 235; red: 255; alpha: 255);
+  CSSBisque: TBGRAPixel = (blue: 196; green: 228; red: 255; alpha: 255);
+  CSSNavajoWhite: TBGRAPixel = (blue: 173; green: 222; red: 255; alpha: 255);
+  CSSWheat: TBGRAPixel = (blue: 179; green: 222; red: 245; alpha: 255);
+  CSSBurlyWood: TBGRAPixel = (blue: 135; green: 184; red: 222; alpha: 255);
+  CSSTan: TBGRAPixel = (blue: 140; green: 180; red: 210; alpha: 255);
+  CSSRosyBrown: TBGRAPixel = (blue: 143; green: 143; red: 188; alpha: 255);
+  CSSSandyBrown: TBGRAPixel = (blue: 96; green: 164; red: 244; alpha: 255);
+  CSSGoldenrod: TBGRAPixel = (blue: 32; green: 165; red: 218; alpha: 255);
+  CSSDarkGoldenrod: TBGRAPixel = (blue: 11; green: 134; red: 184; alpha: 255);
+  CSSPeru: TBGRAPixel = (blue: 63; green: 133; red: 205; alpha: 255);
+  CSSChocolate: TBGRAPixel = (blue: 30; green: 105; red: 210; alpha: 255);
+  CSSSaddleBrown: TBGRAPixel = (blue: 19; green: 69; red: 139; alpha: 255);
+  CSSSienna: TBGRAPixel = (blue: 45; green: 82; red: 160; alpha: 255);
+  CSSBrown: TBGRAPixel = (blue: 42; green: 42; red: 165; alpha: 255);
+  CSSMaroon: TBGRAPixel = (blue: 0; green: 0; red: 128; alpha: 255);
+
+  //White colors
+  CSSWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
+  CSSSnow: TBGRAPixel = (blue: 250; green: 250; red: 255; alpha: 255);
+  CSSHoneydew: TBGRAPixel = (blue: 240; green: 255; red: 250; alpha: 255);
+  CSSMintCream: TBGRAPixel = (blue: 250; green: 255; red: 245; alpha: 255);
+  CSSAzure: TBGRAPixel = (blue: 255; green: 255; red: 240; alpha: 255);
+  CSSAliceBlue: TBGRAPixel = (blue: 255; green: 248; red: 240; alpha: 255);
+  CSSGhostWhite: TBGRAPixel = (blue: 255; green: 248; red: 248; alpha: 255);
+  CSSWhiteSmoke: TBGRAPixel = (blue: 245; green: 245; red: 245; alpha: 255);
+  CSSSeashell: TBGRAPixel = (blue: 255; green: 245; red: 238; alpha: 255);
+  CSSBeige: TBGRAPixel = (blue: 220; green: 245; red: 245; alpha: 255);
+  CSSOldLace: TBGRAPixel = (blue: 230; green: 245; red: 253; alpha: 255);
+  CSSFloralWhite: TBGRAPixel = (blue: 240; green: 250; red: 255; alpha: 255);
+  CSSIvory: TBGRAPixel = (blue: 240; green: 255; red: 255; alpha: 255);
+  CSSAntiqueWhite: TBGRAPixel = (blue: 215; green: 235; red: 250; alpha: 255);
+  CSSLinen: TBGRAPixel = (blue: 230; green: 240; red: 250; alpha: 255);
+  CSSLavenderBlush: TBGRAPixel = (blue: 245; green: 240; red: 255; alpha: 255);
+  CSSMistyRose: TBGRAPixel = (blue: 255; green: 228; red: 255; alpha: 255);
+
+  //Gray colors
+  CSSGainsboro: TBGRAPixel = (blue: 220; green: 220; red: 220; alpha: 255);
+  CSSLightGray: TBGRAPixel = (blue: 211; green: 211; red: 211; alpha: 255);
+  CSSSilver: TBGRAPixel = (blue: 192; green: 192; red: 192; alpha: 255);
+  CSSDarkGray: TBGRAPixel = (blue: 169; green: 169; red: 169; alpha: 255);
+  CSSGray: TBGRAPixel = (blue: 128; green: 128; red: 128; alpha: 255);
+  CSSDimGray: TBGRAPixel = (blue: 105; green: 105; red: 105; alpha: 255);
+  CSSLightSlateGray: TBGRAPixel = (blue: 153; green: 136; red: 119; alpha: 255);
+  CSSSlateGray: TBGRAPixel = (blue: 144; green: 128; red: 112; alpha: 255);
+  CSSDarkSlateGray: TBGRAPixel = (blue: 79; green: 79; red: 47; alpha: 255);
+  CSSBlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
+
+  { This color is needed for drawing black shapes on the standard TCanvas, because
+    when drawing with pure black, there is no way to know if something has been
+    drawn or if it is transparent }
   clBlackOpaque = TColor($010000);
 
+type
+  TBGRAColorDefinition = record
+    Name: string;
+    Color: TBGRAPixel;
+  end;
+
+  { TBGRAColorList }
+
+  TBGRAColorList = class
+  protected
+    FFinished: boolean;
+    FNbColors: integer;
+    FColors: array of TBGRAColorDefinition;
+    function GetByIndex(Index: integer): TBGRAPixel;
+    function GetByName(Name: string): TBGRAPixel;
+    function GetName(Index: integer): string;
+  public
+    constructor Create;
+    procedure Add(Name: string; Color: TBGRAPixel);
+    procedure Finished;
+    function IndexOf(Name: string): integer;
+
+    property ByName[Name: string]: TBGRAPixel read GetByName;
+    property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default;
+    property Name[Index: integer]: string read GetName;
+    property Count: integer read FNbColors;
+  end;
+
+var
+  CSSColors: TBGRAColorList;
+
 function isEmptyPointF(pt: TPointF): boolean;
 
+type
+  TFontPixelMetric = record
+    Defined: boolean;
+    Baseline, xLine, CapLine, DescentLine, Lineheight: integer;
+  end;
+
+  { A scanner is like an image, but its content has no limit and can be calculated on the fly.
+    It must not implement reference counting. }
+  IBGRAScanner = interface
+    procedure ScanMoveTo(X,Y: Integer);
+    function ScanNextPixel: TBGRAPixel;
+    function ScanAt(X,Y: Single): TBGRAPixel;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode);
+    function IsScanPutPixelsDefined: boolean;
+  end;
+
+  TScanAtFunction = function (X,Y: Single): TBGRAPixel of object;
+  TScanNextPixelFunction = function: TBGRAPixel of object;
+  TBGRACustomGradient = class;
+
+  { TBGRACustomBitmap }
+
+  TBGRACustomBitmap = class(TFPCustomImage,IBGRAScanner) // a bitmap can be used as a scanner
+  private
+    function GetFontAntialias: Boolean;
+    procedure SetFontAntialias(const AValue: Boolean);
+  protected
+     { accessors to properies }
+     function GetHeight: integer; virtual; abstract;
+     function GetWidth: integer; virtual; abstract;
+     function GetDataPtr: PBGRAPixel; virtual; abstract;
+     function GetNbPixels: integer; virtual; abstract;
+     function CheckEmpty: boolean; virtual; abstract;
+     function GetHasTransparentPixels: boolean; virtual; abstract;
+     function GetAverageColor: TColor; virtual; abstract;
+     function GetAveragePixel: TBGRAPixel; virtual; abstract;
+     procedure SetCanvasOpacity(AValue: byte); virtual; abstract;
+     function GetScanLine(y: integer): PBGRAPixel; virtual; abstract;
+     function GetRefCount: integer; virtual; abstract;
+     function GetBitmap: TBitmap; virtual; abstract;
+     function GetLineOrder: TRawImageLineOrder; virtual; abstract;
+     function GetCanvasFP: TFPImageCanvas; virtual; abstract;
+     function GetCanvasDrawModeFP: TDrawMode; virtual; abstract;
+     procedure SetCanvasDrawModeFP(const AValue: TDrawMode); virtual; abstract;
+     function GetCanvas: TCanvas; virtual; abstract;
+     function GetCanvasOpacity: byte; virtual; abstract;
+     function GetCanvasAlphaCorrection: boolean; virtual; abstract;
+     procedure SetCanvasAlphaCorrection(const AValue: boolean); virtual; abstract;
+     function GetFontHeight: integer; virtual; abstract;
+     procedure SetFontHeight(AHeight: integer); virtual; abstract;
+     function GetFontFullHeight: integer; virtual; abstract;
+     procedure SetFontFullHeight(AHeight: integer); virtual; abstract;
+     function GetPenStyle: TPenStyle; virtual; abstract;
+     procedure SetPenStyle(const AValue: TPenStyle); virtual; abstract;
+     function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract;
+     procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); virtual; abstract;
+     function GetClipRect: TRect; virtual; abstract;
+     procedure SetClipRect(const AValue: TRect); virtual; abstract;
+     function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
+     function LoadAsBmp32(Str: TStream): boolean; virtual; abstract;
+
+  public
+     Caption:   string;  //user defined caption
+
+     //font style
+     FontName:  string;
+     FontStyle: TFontStyles;
+     FontQuality : TBGRAFontQuality;
+     FontOrientation: integer;
+
+     //line style
+     LineCap:   TPenEndCap;
+     JoinStyle: TPenJoinStyle;
+     JoinMiterLimit: single;
+
+     FillMode:  TFillMode;  //winding or alternate
+
+     { The resample filter is used when resizing the bitmap, and
+       scan interpolation filter is used when the bitmap is used
+       as a scanner (IBGRAScanner) }
+     ResampleFilter,
+     ScanInterpolationFilter: TResampleFilter;
+     ScanOffset: TPoint;
+
+     constructor Create; virtual; abstract; overload;
+     constructor Create(ABitmap: TBitmap); virtual; abstract; overload;
+     constructor Create(AWidth, AHeight: integer; Color: TColor); virtual; abstract; overload;
+     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); virtual; abstract; overload;
+     constructor Create(AFilename: string); virtual; abstract; overload;
+     constructor Create(AStream: TStream); virtual; abstract; overload;
+
+     function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; virtual; abstract; overload;
+     function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; virtual; abstract; overload;
+     function NewBitmap(Filename: string): TBGRACustomBitmap; virtual; abstract; overload;
+
+     procedure LoadFromFile(const filename: string); virtual;
+     procedure LoadFromStream(Str: TStream); virtual;
+     procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader); virtual;
+     procedure SaveToFile(const filename: string); virtual;
+     procedure SaveToFile(const filename: string; Handler:TFPCustomImageWriter); virtual;
+     procedure SaveToStreamAsPng(Str: TStream); virtual; abstract;
+     procedure Assign(ABitmap: TBitmap); virtual; abstract; overload;
+     procedure Assign(MemBitmap: TBGRACustomBitmap); virtual; abstract; overload;
+     procedure Serialize(AStream: TStream); virtual; abstract;
+     procedure Deserialize(AStream: TStream); virtual; abstract;
+
+     {Pixel functions}
+     procedure SetPixel(x, y: integer; c: TColor); virtual; abstract; overload;
+     procedure XorPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
+     procedure SetPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawPixel(x, y: integer; ec: TExpandedPixel); virtual; abstract; overload;
+     procedure FastBlendPixel(x, y: integer; c: TBGRAPixel); virtual; abstract;
+     procedure ErasePixel(x, y: integer; alpha: byte); virtual; abstract;
+     procedure AlphaPixel(x, y: integer; alpha: byte); virtual; abstract;
+     function GetPixel(x, y: integer): TBGRAPixel; virtual; abstract;
+     function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
+     function GetPixelCycle(x, y: integer): TBGRAPixel; virtual;
+     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
+     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; virtual; abstract; overload;
+
+     {Line primitives}
+     procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure XorHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel); virtual; abstract; overload;
+     procedure DrawHorizLine(x, y, x2: integer; texture: IBGRAScanner); virtual; abstract; overload;
+     procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure AlphaHorizLine(x, y, x2: integer; alpha: byte); virtual; abstract;
+     procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure XorVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure AlphaVertLine(x, y, y2: integer; alpha: byte); virtual; abstract;
+     procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
+     procedure DrawHorizLineDiff(x, y, x2: integer; c, compare: TBGRAPixel;
+       maxDiff: byte); virtual; abstract;
+
+     {Shapes}
+     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract;
+     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); virtual; abstract; overload;
+
+     procedure DrawPolyLineAntialias(const points: array of TPoint; c: TBGRAPixel; DrawLastPixel: boolean); virtual; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPoint; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); virtual; abstract; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); virtual; abstract; overload;
+     procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); virtual; abstract; overload;
+     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); virtual; abstract; overload;
+
+     procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
+     procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
+     procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); virtual; abstract; overload;
+
+     procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
+     procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
+     procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);  virtual; abstract; overload;
+     procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
+     procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
+     procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
+
+     procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel);  virtual; abstract; overload;
+     procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); virtual; abstract; overload;
+     procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); virtual; abstract; overload;
+     procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); virtual; abstract; overload;
+     procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); virtual; abstract; overload;
+
+     procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode); virtual; abstract;
+     procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode); virtual; abstract;
+     procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel); virtual; abstract;
+     procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner); virtual; abstract;
+     procedure ErasePoly(const points: array of TPointF; alpha: byte); virtual; abstract;
+     procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); virtual; abstract;
+
+     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); virtual; abstract;
+     procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); virtual; abstract;
+     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract;
+     procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); virtual; abstract;
+     procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); virtual; abstract;
+     procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); virtual; abstract;
+     procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); virtual; abstract;
+
+     procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
+     procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
+     procedure Rectangle(x, y, x2, y2: integer; c: TColor); virtual; overload;
+     procedure Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
+     procedure Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual;overload;
+     procedure Rectangle(r: TRect; c: TColor); virtual; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single); virtual; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+
+     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel); virtual; abstract;
+     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
+     procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); virtual; abstract;
+
+     procedure FillRect(r: TRect; c: TColor); virtual; overload;
+     procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
+     procedure FillRect(x, y, x2, y2: integer; c: TColor); virtual; overload;
+     procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
+     procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); virtual; abstract;
+     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); virtual; abstract;
+     procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); virtual; abstract;
+     procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); virtual; abstract;
+     procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); virtual; abstract;
+
+     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
+     procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
+     procedure TextOutAngle(x, y, orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
+     procedure TextOutAngle(x, y, orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
+     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel); virtual; overload;
+     procedure TextOut(x, y: integer; s: string; c: TColor); virtual; overload;
+     procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner); virtual; overload;
+     procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract; overload;
+     procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract; overload;
+     procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); virtual; overload;
+     procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); virtual; overload;
+     function TextSize(s: string): TSize; virtual; abstract;
+
+     {Spline}
+     function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
+     function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
+
+     function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; virtual; abstract;
+     function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
+
+     function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; virtual; abstract;
+     function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions): ArrayOfTPointF; virtual; abstract;
+     function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; virtual; abstract;
+     function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; virtual; abstract;
+
+     {Filling}
+     procedure FillTransparent; virtual;
+     procedure NoClip; virtual; abstract;
+     procedure ApplyGlobalOpacity(alpha: byte); virtual; abstract;
+     procedure Fill(c: TColor); virtual; overload;
+     procedure Fill(c: TBGRAPixel); virtual; overload;
+     procedure Fill(texture: IBGRAScanner; mode: TDrawMode); virtual; abstract; overload;
+     procedure Fill(texture: IBGRAScanner); virtual; abstract; overload;
+     procedure Fill(c: TBGRAPixel; start, Count: integer); virtual; abstract; overload;
+     procedure DrawPixels(c: TBGRAPixel; start, Count: integer); virtual; abstract;
+     procedure AlphaFill(alpha: byte); virtual; overload;
+     procedure AlphaFill(alpha: byte; start, Count: integer); virtual; abstract; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; abstract; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); virtual; abstract; overload;
+     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); virtual; abstract; overload;
+     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); virtual; abstract; overload;
+     procedure ReplaceColor(before, after: TColor); virtual; abstract; overload;
+     procedure ReplaceColor(before, after: TBGRAPixel); virtual; abstract; overload;
+     procedure ReplaceTransparent(after: TBGRAPixel); virtual; abstract; overload;
+     procedure FloodFill(X, Y: integer; Color: TBGRAPixel;
+       mode: TFloodfillMode; Tolerance: byte = 0); virtual;
+     procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
+       mode: TFloodfillMode; Tolerance: byte = 0); virtual; abstract;
+     procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
+       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+       gammaColorCorrection: boolean = True; Sinus: Boolean=False); virtual; abstract;
+     procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
+       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+       Sinus: Boolean=False); virtual; abstract;
+     function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
+                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; virtual; abstract;
+
+     {Canvas drawing functions}
+     procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+       AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
+     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
+     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual; abstract;
+     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); virtual; abstract;
+     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); virtual; abstract;
+     procedure DrawPart(ARect: TRect; Canvas: TCanvas; x, y: integer; Opaque: boolean); virtual;
+     function GetPart(ARect: TRect): TBGRACustomBitmap; virtual; abstract;
+     function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; virtual; abstract;
+     procedure InvalidateBitmap; virtual; abstract;         //call if you modify with Scanline
+     procedure LoadFromBitmapIfNeeded; virtual; abstract;   //call to ensure that bitmap data is up to date
+
+     {BGRA bitmap functions}
+     procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
+     procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
+     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); virtual; abstract;
+     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255); virtual; abstract;
+     procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap;
+       operation: TBlendOperation); virtual; abstract;
+     function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; virtual; abstract;
+     function Equals(comp: TBGRACustomBitmap): boolean; virtual; abstract;
+     function Equals(comp: TBGRAPixel): boolean; virtual; abstract;
+     function Resample(newWidth, newHeight: integer;
+       mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract;
+     procedure VerticalFlip; virtual; abstract;
+     procedure HorizontalFlip; virtual; abstract;
+     function RotateCW: TBGRACustomBitmap; virtual; abstract;
+     function RotateCCW: TBGRACustomBitmap; virtual; abstract;
+     procedure Negative; virtual; abstract;
+     procedure LinearNegative; virtual; abstract;
+     procedure SwapRedBlue; virtual; abstract;
+     procedure GrayscaleToAlpha; virtual; abstract;
+     procedure AlphaToGrayscale; virtual; abstract;
+     procedure ApplyMask(mask: TBGRACustomBitmap); virtual; abstract;
+     function GetImageBounds(Channel: TChannel = cAlpha): TRect; virtual; abstract;
+     function GetImageBounds(Channels: TChannels): TRect; virtual; abstract;
+     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract;
+
+     {Filters}
+     function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
+     function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
+     function FilterSmooth: TBGRACustomBitmap; virtual; abstract;
+     function FilterSharpen: TBGRACustomBitmap; virtual; abstract;
+     function FilterContour: TBGRACustomBitmap; virtual; abstract;
+     function FilterBlurRadial(radius: integer;
+       blurType: TRadialBlurType): TBGRACustomBitmap; virtual; abstract;
+     function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract;
+     function FilterBlurMotion(distance: integer; angle: single;
+       oriented: boolean): TBGRACustomBitmap; virtual; abstract;
+     function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
+     function FilterEmboss(angle: single): TBGRACustomBitmap; virtual; abstract;
+     function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; virtual; abstract;
+     function FilterGrayscale: TBGRACustomBitmap; virtual; abstract;
+     function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
+     function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; virtual; abstract;
+     function FilterSphere: TBGRACustomBitmap; virtual; abstract;
+     function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; virtual; abstract;
+     function FilterCylinder: TBGRACustomBitmap; virtual; abstract;
+     function FilterPlane: TBGRACustomBitmap; virtual; abstract;
+
+     property Data: PBGRAPixel Read GetDataPtr;
+     property Width: integer Read GetWidth;
+     property Height: integer Read GetHeight;
+     property NbPixels: integer Read GetNbPixels;
+     property Empty: boolean Read CheckEmpty;
+
+     property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;
+     property RefCount: integer Read GetRefCount;
+     property Bitmap: TBitmap Read GetBitmap; //don't forget to call InvalidateBitmap before if you changed something with Scanline
+     property HasTransparentPixels: boolean Read GetHasTransparentPixels;
+     property AverageColor: TColor Read GetAverageColor;
+     property AveragePixel: TBGRAPixel Read GetAveragePixel;
+     property LineOrder: TRawImageLineOrder Read GetLineOrder;
+     property CanvasFP: TFPImageCanvas read GetCanvasFP;
+     property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP;
+     property Canvas: TCanvas Read GetCanvas;
+     property CanvasOpacity: byte Read GetCanvasOpacity Write SetCanvasOpacity;
+     property CanvasAlphaCorrection: boolean
+       Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
+
+     property FontHeight: integer Read GetFontHeight Write SetFontHeight;
+     property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle;
+     property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle;
+     property ClipRect: TRect read GetClipRect write SetClipRect;
+     property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias; //antialiasing (it's different from TFont antialiasing mode)
+     property FontFullHeight: integer read GetFontFullHeight write SetFontFullHeight;
+     property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;
+
+     //interface
+     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+     function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+     function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+
+     //IBGRAScanner
+     procedure ScanMoveTo(X,Y: Integer); virtual; abstract;
+     function ScanNextPixel: TBGRAPixel; virtual; abstract;
+     function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
+     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
+     function IsScanPutPixelsDefined: boolean; virtual;
+  end;
+
+  { TBGRACustomScanner }
+
+  TBGRACustomScanner = class(IBGRAScanner)
+  private
+    FCurX,FCurY: integer;
+  public
+    procedure ScanMoveTo(X,Y: Integer); virtual;
+    function ScanNextPixel: TBGRAPixel; virtual;
+    function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
+    function IsScanPutPixelsDefined: boolean; virtual;
+    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+    function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+    function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+  end;
+
+  TBGRACustomGradient = class
+  public
+    function GetColorAt(position: integer): TBGRAPixel; virtual; abstract;
+    function GetAverageColor: TBGRAPixel; virtual; abstract;
+    function GetMonochrome: boolean; virtual; abstract;
+    property Monochrome: boolean read GetMonochrome;
+  end;
+
+type
+  TBGRABitmapAny = class of TBGRACustomBitmap;  //used to create instances of the same type (see NewBitmap)
+
+var
+  BGRABitmapFactory : TBGRABitmapAny;
+
+{ Color functions }
 function GetIntensity(c: TExpandedPixel): word; inline;
 function SetIntensity(c: TExpandedPixel; intensity: word): TExpandedPixel;
 function GetLightness(c: TExpandedPixel): word; inline;
 function SetLightness(c: TExpandedPixel; lightness: word): TExpandedPixel;
+function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
 function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
+function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
 function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
+function GtoH(ghue: word): word;
+function HtoG(hue: word): word;
+function HueDiff(h1, h2: word): word;
+function GetHue(ec: TExpandedPixel): word;
+function ColorImportance(ec: TExpandedPixel): word;
+function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
+function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
 function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
 function GammaCompression(ec: TExpandedPixel): TBGRAPixel; inline;
+function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline;
 function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
-function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
+function GrayscaleToBGRA(lightness: word): TBGRAPixel;
+function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload;
+function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload;
+function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload;
 function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline;
 function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline;
 function ColorToBGRA(color: TColor): TBGRAPixel; overload;
 function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload;
+function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
+function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
 function BGRAToColor(c: TBGRAPixel): TColor;
 operator = (const c1, c2: TBGRAPixel): boolean; inline;
-
+function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
+function BGRAWordDiff(c1, c2: TBGRAPixel): word;
 function BGRADiff(c1, c2: TBGRAPixel): byte;
-function PointF(x, y: single): TPointF;
-
-function PtInRect(pt: TPoint; r: TRect): boolean;
-
-function StrToGradientType(str: string): TGradientType;
+operator - (const c1, c2: TColorF): TColorF; inline;
+operator + (const c1, c2: TColorF): TColorF; inline;
+operator * (const c1, c2: TColorF): TColorF; inline;
+operator * (const c1: TColorF; factor: single): TColorF; inline;
+function ColorF(red,green,blue,alpha: single): TColorF;
 function BGRAToStr(c: TBGRAPixel): string;
 function StrToBGRA(str: string): TBGRAPixel;
 
+{ Get height [0..1] stored in a TBGRAPixel }
+function MapHeight(Color: TBGRAPixel): Single;
+
+{ Get TBGRAPixel to store height [0..1] }
+function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
+
+
+{ Gamma conversion arrays. Should be used as readonly }
 var
+  // TBGRAPixel -> TExpandedPixel
   GammaExpansionTab:   packed array[0..255] of word;
+  
+  // TExpandedPixel -> TBGRAPixel
   GammaCompressionTab: packed array[0..65535] of byte;
 
+{ Point functions }
+function PointF(x, y: single): TPointF;
+function PointsF(const pts: array of TPointF): ArrayOfTPointF;
+operator = (const pt1, pt2: TPointF): boolean; inline;
+operator - (const pt1, pt2: TPointF): TPointF; inline;
+operator - (const pt2: TPointF): TPointF; inline;
+operator + (const pt1, pt2: TPointF): TPointF; inline;
+operator * (const pt1, pt2: TPointF): single; inline; //scalar product
+operator * (const pt1: TPointF; factor: single): TPointF; inline;
+operator * (factor: single; const pt1: TPointF): TPointF; inline;
+function PtInRect(pt: TPoint; r: TRect): boolean;
+function VectLen(dx,dy: single): single; overload;
+function VectLen(v: TPointF): single; overload;
+
+{ Line and polygon functions }
+type
+    TLineDef = record
+       origin, dir: TPointF;
+    end;
+
+function IntersectLine(line1, line2: TLineDef): TPointF;
+function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
+function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
+function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+
+{ Cyclic functions }
+function PositiveMod(value, cycle: integer): integer; inline;
+
+{ Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
+  They use a table to store already computed values. The return value is an integer
+  ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is
+  32768 instead of 1. The input has a period of 65536, so you can supply any integer
+  without applying a modulo. }
+procedure PrecalcSin65536; // compute all values now
+function Sin65536(value: word): integer; inline;
+function Cos65536(value: word): integer; inline;
+
 implementation
 
 uses Math, SysUtils;
 
+function StrToBlendOperation(str: string): TBlendOperation;
+var op: TBlendOperation;
+begin
+  result := boTransparent;
+  str := LowerCase(str);
+  for op := low(TBlendOperation) to high(TBlendOperation) do
+    if str = LowerCase(BlendOperationStr[op]) then
+    begin
+      result := op;
+      exit;
+    end;
+end;
+
+function StrToGradientType(str: string): TGradientType;
+var gt: TGradientType;
+begin
+  result := gtLinear;
+  str := LowerCase(str);
+  for gt := low(TGradientType) to high(TGradientType) do
+    if str = LowerCase(GradientTypeStr[gt]) then
+    begin
+      result := gt;
+      exit;
+    end;
+end;
+
+{ Make a pen style. Need an even number of values. See TBGRAPenStyle }
+function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single;
+  dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle;
+var
+  i: Integer;
+begin
+  if dash4 <> 0 then
+  begin
+    setlength(result,8);
+    result[6] := dash4;
+    result[7] := space4;
+    result[4] := dash3;
+    result[5] := space3;
+    result[2] := dash2;
+    result[3] := space2;
+  end else
+  if dash3 <> 0 then
+  begin
+    setlength(result,6);
+    result[4] := dash3;
+    result[5] := space3;
+    result[2] := dash2;
+    result[3] := space2;
+  end else
+  if dash2 <> 0 then
+  begin
+    setlength(result,4);
+    result[2] := dash2;
+    result[3] := space2;
+  end else
+  begin
+    setlength(result,2);
+  end;
+  result[0] := dash1;
+  result[1] := space1;
+  for i := 0 to high(result) do
+    if result[i]=0 then
+      raise exception.Create('Zero is not a valid value');
+end;
+
+{ Bézier curves definitions. See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve }
+
+function ConcatPointsF(const APolylines: array of ArrayOfTPointF
+  ): ArrayOfTPointF;
+var
+  i,pos,count:integer;
+  j: Integer;
+begin
+  count := 0;
+  for i := 0 to high(APolylines) do
+    inc(count,length(APolylines[i]));
+  setlength(result,count);
+  pos := 0;
+  for i := 0 to high(APolylines) do
+    for j := 0 to high(APolylines[i]) do
+    begin
+      result[pos] := APolylines[i][j];
+      inc(pos);
+    end;
+end;
+
+operator-(const v: TPoint3D): TPoint3D;
+begin
+  result.x := -v.x;
+  result.y := -v.y;
+  result.z := -v.z;
+end;
+
+operator + (const v1,v2: TPoint3D): TPoint3D; inline;
+begin
+  result.x := v1.x+v2.x;
+  result.y := v1.y+v2.y;
+  result.z := v1.z+v2.z;
+end;
+
+operator - (const v1,v2: TPoint3D): TPoint3D; inline;
+begin
+  result.x := v1.x-v2.x;
+  result.y := v1.y-v2.y;
+  result.z := v1.z-v2.z;
+end;
+
+operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
+begin
+  result.x := v1.x*factor;
+  result.y := v1.y*factor;
+  result.z := v1.z*factor;
+end;
+
+function Point3D(x, y, z: single): TPoint3D;
+begin
+  result.x := x;
+  result.y := y;
+  result.z := z;
+end;
+
+operator=(const v1, v2: TPoint3D): boolean;
+begin
+  result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z);
+end;
+
+operator * (const v1,v2: TPoint3D): single; inline;
+begin
+  result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
+end;
+
+procedure Normalize3D(var v: TPoint3D); inline;
+var len: double;
+begin
+  len := v*v;
+  if len = 0 then exit;
+  len := sqrt(len);
+  v.x /= len;
+  v.y /= len;
+  v.z /= len;
+end;
+
+procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
+begin
+  w.x := u.y*v.z-u.z*v.y;
+  w.y := u.z*v.x-u.x*v.z;
+  w.z := u.x*v.Y-u.y*v.x;
+end;
+
+// Define a Bézier curve with two control points.
+function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve;
+begin
+  result.p1 := origin;
+  result.c1 := control1;
+  result.c2 := control2;
+  result.p2 := destination;
+end;
+
+// Define a Bézier curve with one control point.
+function BezierCurve(origin, control, destination: TPointF
+  ): TQuadraticBezierCurve;
+begin
+  result.p1 := origin;
+  result.c := control;
+  result.p2 := destination;
+end;
+
+{ Check if a PointF structure is empty or should be treated as a list separator }
 function isEmptyPointF(pt: TPointF): boolean;
 begin
@@ -132 +1062 @@
 end;
 
+{ TBGRAColorList }
+
+function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[Index].Color;
+end;
+
+function TBGRAColorList.GetByName(Name: string): TBGRAPixel;
+var i: integer;
+begin
+  i := IndexOf(Name);
+  if i = -1 then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[i].Color;
+end;
+
+function TBGRAColorList.GetName(Index: integer): string;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := ''
+  else
+    result := FColors[Index].Name;
+end;
+
+constructor TBGRAColorList.Create;
+begin
+  FNbColors:= 0;
+  FColors := nil;
+  FFinished:= false;
+end;
+
+procedure TBGRAColorList.Add(Name: string; Color: TBGRAPixel);
+begin
+  if FFinished then
+    raise Exception.Create('This list is already finished');
+  if length(FColors) = FNbColors then
+    SetLength(FColors, FNbColors*2+1);
+  FColors[FNbColors].Name := Name;
+  FColors[FNbColors].Color := Color;
+  inc(FNbColors);
+end;
+
+procedure TBGRAColorList.Finished;
+begin
+  if FFinished then exit;
+  FFinished := true;
+  SetLength(FColors, FNbColors);
+end;
+
+function TBGRAColorList.IndexOf(Name: string): integer;
+var i: integer;
+begin
+  for i := 0 to FNbColors-1 do
+    if CompareText(Name, FColors[i].Name) = 0 then
+    begin
+      result := i;
+      exit;
+    end;
+  result := -1;
+end;
+
+{ TBGRACustomBitmap }
+
+function TBGRACustomBitmap.GetFontAntialias: Boolean;
+begin
+  result := FontQuality <> fqSystem;
+end;
+
+procedure TBGRACustomBitmap.SetFontAntialias(const AValue: Boolean);
+begin
+  if AValue and not FontAntialias then
+    FontQuality := fqFineAntialiasing
+  else if not AValue and (FontQuality <> fqSystem) then
+    FontQuality := fqSystem;
+end;
+
+{ These declaration make sure that these methods are virtual }
+procedure TBGRACustomBitmap.LoadFromFile(const filename: string);
+begin
+  inherited LoadFromFile(filename);
+end;
+
+procedure TBGRACustomBitmap.SaveToFile(const filename: string);
+begin
+  inherited SaveToFile(filename);
+end;
+
+procedure TBGRACustomBitmap.SaveToFile(const filename: string;
+  Handler: TFPCustomImageWriter);
+begin
+  inherited SaveToFile(filename, Handler);
+end;
+
+{ LoadFromStream uses TFPCustomImage routine, which uses
+  Colors property to access pixels. That's why the
+  FP drawing mode is temporarily changed to load
+  bitmaps properly }
+procedure TBGRACustomBitmap.LoadFromStream(Str: TStream);
+var
+  OldDrawMode: TDrawMode;
+begin
+  OldDrawMode := CanvasDrawModeFP;
+  CanvasDrawModeFP := dmSet;
+  try
+    if not LoadAsBmp32(Str) then
+      inherited LoadFromStream(Str);
+  finally
+    CanvasDrawModeFP := OldDrawMode;
+  end;
+end;
+
+{ See above }
+procedure TBGRACustomBitmap.LoadFromStream(Str: TStream;
+  Handler: TFPCustomImageReader);
+var
+  OldDrawMode: TDrawMode;
+begin
+  OldDrawMode := CanvasDrawModeFP;
+  CanvasDrawModeFP := dmSet;
+  try
+    inherited LoadFromStream(Str, Handler);
+  finally
+    CanvasDrawModeFP := OldDrawMode;
+  end;
+end;
+
+{ Look for a pixel considering the bitmap is repeated in both directions }
+function TBGRACustomBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
+begin
+  if (Width = 0) or (Height = 0) then
+    Result := BGRAPixelTransparent
+  else
+    Result := (Scanline[PositiveMod(y,Height)] + PositiveMod(x,Width))^;
+end;
+
+{ Pixel polylines are constructed by concatenation }
+procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint;
+  c: TBGRAPixel; DrawLastPixel: boolean);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1));
+end;
+
+procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint; c1,
+  c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c1);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c1,c2,dashLen,DrawLastPixel and (i=high(points)-1));
+end;
+
+{ Following functions are defined for convenience }
+procedure TBGRACustomBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
+begin
+  Rectangle(x, y, x2, y2, ColorToBGRA(c), dmSet);
+end;
+
+procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode
+  );
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, c, mode);
+end;
+
+procedure TBGRACustomBitmap.Rectangle(r: TRect; BorderColor,
+  FillColor: TBGRAPixel; mode: TDrawMode);
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, BorderColor, FillColor, mode);
+end;
+
+procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TColor);
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, c);
+end;
+
+procedure TBGRACustomBitmap.RectangleAntialias(x, y, x2, y2: single;
+  c: TBGRAPixel; w: single);
+begin
+  RectangleAntialias(x, y, x2, y2, c, w, BGRAPixelTransparent);
+end;
+
+procedure TBGRACustomBitmap.FillRect(r: TRect; c: TColor);
+begin
+  FillRect(r.Left, r.top, r.right, r.bottom, c);
+end;
+
+procedure TBGRACustomBitmap.FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
+begin
+  FillRect(r.Left, r.top, r.right, r.bottom, c, mode);
+end;
+
+procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
+begin
+  FillRect(x, y, x2, y2, ColorToBGRA(c), dmSet);
+end;
+
+procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string; c: TBGRAPixel);
+begin
+  TextOut(x, y, s, c, taLeftJustify);
+end;
+
+procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string; c: TColor);
+begin
+  TextOut(x, y, s, ColorToBGRA(c));
+end;
+
+procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string;
+  texture: IBGRAScanner);
+begin
+  TextOut(x, y, s, texture, taLeftJustify);
+end;
+
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
+  halign: TAlignment; valign: TTextLayout; c: TBGRAPixel);
+var
+  style: TTextStyle;
+begin
+  {$hints off}
+  FillChar(style,sizeof(style),0);
+  {$hints on}
+  style.Alignment := halign;
+  style.Layout := valign;
+  style.Wordbreak := true;
+  style.ShowPrefix := false;
+  style.Clipping := false;
+  TextRect(ARect,ARect.Left,ARect.Top,s,style,c);
+end;
+
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
+  halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner);
+var
+  style: TTextStyle;
+begin
+  {$hints off}
+  FillChar(style,sizeof(style),0);
+  {$hints on}
+  style.Alignment := halign;
+  style.Layout := valign;
+  style.Wordbreak := true;
+  style.ShowPrefix := false;
+  style.Clipping := false;
+  TextRect(ARect,ARect.Left,ARect.Top,s,style,texture);
+end;
+
+procedure TBGRACustomBitmap.FillTransparent;
+begin
+  Fill(BGRAPixelTransparent);
+end;
+
+procedure TBGRACustomBitmap.Fill(c: TColor);
+begin
+  Fill(ColorToBGRA(c));
+end;
+
+procedure TBGRACustomBitmap.Fill(c: TBGRAPixel);
+begin
+  Fill(c, 0, NbPixels);
+end;
+
+procedure TBGRACustomBitmap.AlphaFill(alpha: byte);
+begin
+  AlphaFill(alpha, 0, NbPixels);
+end;
+
+procedure TBGRACustomBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel;
+  mode: TFloodfillMode; Tolerance: byte);
+begin
+  ParallelFloodFill(X,Y,Self,Color,mode,Tolerance);
+end;
+
+procedure TBGRACustomBitmap.DrawPart(ARect: TRect; Canvas: TCanvas; x,
+  y: integer; Opaque: boolean);
+var
+  partial: TBGRACustomBitmap;
+begin
+  partial := GetPart(ARect);
+  if partial <> nil then
+  begin
+    partial.Draw(Canvas, x, y, Opaque);
+    partial.Free;
+  end;
+end;
+
+procedure TBGRACustomBitmap.PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
+begin
+  PutImageAngle(x,y,source,0);
+end;
+
+{ Interface gateway }
+function TBGRACustomBitmap.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  if GetInterface(iid, obj) then
+    Result := S_OK
+  else
+    Result := longint(E_NOINTERFACE);
+end;
+
+{ There is no automatic reference counting, but it is compulsory to define these functions }
+function TBGRACustomBitmap._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+function TBGRACustomBitmap._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+{$hints off}
+procedure TBGRACustomBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  //do nothing
+end;
+{$hints on}
+
+function TBGRACustomBitmap.IsScanPutPixelsDefined: boolean;
+begin
+  result := False;
+end;
+
+{********************** End of TBGRACustomBitmap **************************}
+
+{ TBGRACustomScanner }
+{ The abstract class record the position so that a derived class
+  need only to redefine ScanAt }
+
+procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer);
+begin
+  FCurX := X;
+  FCurY := Y;
+end;
+
+{ Call ScanAt to determine pixel value }
+function TBGRACustomScanner.ScanNextPixel: TBGRAPixel;
+begin
+  result := ScanAt(FCurX,FCurY);
+  Inc(FCurX);
+end;
+
+{$hints off}
+procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  //do nothing
+end;
+{$hints on}
+
+function TBGRACustomScanner.IsScanPutPixelsDefined: boolean;
+begin
+  result := false;
+end;
+
+{ Interface gateway }
+function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  if GetInterface(iid, obj) then
+    Result := S_OK
+  else
+    Result := longint(E_NOINTERFACE);
+end;
+
+{ There is no automatic reference counting, but it is compulsory to define these functions }
+function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+{********************** End of TBGRACustomScanner **************************}
+
+{ The gamma correction is approximated here by a power function }
 const
-  GammaExpFactor   = 1.7;
-{  redWeight = 0.299;
-  greenWeight = 0.587;
-  blueWeight = 0.114;}
-  redWeightShl10   = 306;
-  greenWeightShl10 = 601;
-  blueWeightShl10  = 117;
+  GammaExpFactor   = 1.7; //exponent
+  redWeightShl10   = 306; // = 0.299
+  greenWeightShl10 = 601; // = 0.587
+  blueWeightShl10  = 117; // = 0.114
 
 var
@@ -146 +1463 @@
 procedure InitGamma;
 var
-  i: integer; {t: textfile; prevval,val: byte; }
-begin
+  i: integer;
+{$IFDEF WINCE}
+  j,prevpos,curpos,midpos: integer;
+{$ENDIF}
+begin
+  //the linear factor is used to normalize expanded values in the range 0..65535
   GammaLinearFactor := 65535 / power(255, GammaExpFactor);
+
+{$IFDEF WINCE}
+  curpos := 0;
+  GammaExpansionTab[0] := 0;
+  GammaCompressionTab[0] := 0;
+  for i := 0 to 255 do
+  begin
+    prevpos := curpos;
+    curpos := round(power(i, GammaExpFactor) * GammaLinearFactor);
+    if i = 1 then curpos := 1; //to avoid information loss
+    GammaExpansionTab[i] := curpos;
+    midpos := (prevpos+1+curpos) div 2;
+    for j := prevpos+1 to midpos-1 do
+      GammaCompressionTab[j] := i-1;
+    for j := midpos to curpos do
+      GammaCompressionTab[j] := i;
+  end;
+{$ELSE}
   for i := 0 to 255 do
     GammaExpansionTab[i] := round(power(i, GammaExpFactor) * GammaLinearFactor);
@@ -155 +1494 @@
     GammaCompressionTab[i] := round(power(i / GammaLinearFactor, 1 / GammaExpFactor));
 
-  GammaExpansionTab[1]   := 1; //to avoid information lost
+  GammaExpansionTab[1]   := 1; //to avoid information loss
   GammaCompressionTab[1] := 1;
-{
-     assignfile(t,'gammaout.txt');
-     rewrite(t);
-     prevval := 255;
-     for i := 0 to 255 do
-     begin
-       val := GammaCompressionTab[i*256+128];
-       if val <> prevval then writeln(t,val);
-       prevval := val;
-     end;
-     closefile(t);}
-end;
-
-{$hints off}
-
+{$ENDIF}
+end;
+
+{************************** Color functions **************************}
+
+{ The intensity is defined here as the maximum value of any color component }
 function GetIntensity(c: TExpandedPixel): word; inline;
 begin
@@ -186 +1516 @@
 begin
   curIntensity := GetIntensity(c);
-  if curIntensity = 0 then
+  if curIntensity = 0 then //suppose it's gray if there is no color information
     Result := c
   else
   begin
+    //linear interpolation to reached wanted intensity
     Result.red   := (c.red * intensity + (curIntensity shr 1)) div curIntensity;
     Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity;
@@ -197 +1528 @@
 end;
 
+{ The lightness here is defined as the subjective sensation of luminosity, where
+  blue is the darkest component and green the lightest }
 function GetLightness(c: TExpandedPixel): word; inline;
 begin
@@ -286 +1619 @@
 end;
 
+function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
+var lightness256: byte;
+begin
+  if lightness <= 32768 then
+  begin
+    if lightness = 32768 then
+      result := color else
+    begin
+      lightness256 := GammaCompressionTab[lightness shl 1];
+      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
+                     color.blue * lightness256 shr 8, color.alpha);
+    end;
+  end else
+  begin
+    if lightness = 65535 then
+      result := BGRAWhite else
+    begin
+      lightness256 := GammaCompressionTab[(lightness-32767) shl 1];
+      result := BGRA(color.red + (255-color.red)*lightness256 shr 8,
+                     color.green + (255-color.green)*lightness256 shr 8,
+                     color.blue + (255-color.blue)*lightness256 shr 8,
+                     color.alpha);
+    end;
+  end;
+end;
+
+{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space }
 function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
 const
@@ -294 +1654 @@
 var
   ec: TExpandedPixel;
-  min, max, minMax: word;
+  min, max, minMax: integer;
   twiceLightness: integer;
+  r,g,b: integer;
 begin
   ec  := GammaExpansion(c);
-  min := ec.red;
-  max := ec.red;
-  if ec.green > max then
-    max := ec.green
-  else
-  if ec.green < min then
-    min := ec.green;
-  if ec.blue > max then
-    max := ec.blue
-  else
-  if ec.blue < min then
-    min  := ec.blue;
+  r := ec.red;
+  g := ec.green;
+  b := ec.blue;
+  min := r;
+  max := r;
+  if g > max then
+    max := g
+  else
+  if g < min then
+    min := g;
+  if b > max then
+    max := b
+  else
+  if b < min then
+    min  := b;
   minMax := max - min;
 
@@ -315 +1679 @@
     Result.hue := 0
   else
-  if max = ec.red then
-    Result.hue := (((ec.green - ec.blue) * deg60 + (minMax shr 1)) div
+  if max = r then
+    Result.hue := (((g - b) * deg60) div
       minMax + deg360) mod deg360
   else
-  if max = ec.green then
-    Result.hue := ((ec.blue - ec.red) * deg60 + (minMax shr 1)) div minMax + deg120
-  else
-    {max = ec.blue} Result.hue :=
-      ((ec.red - ec.green) * deg60 + (minMax shr 1)) div minMax + deg240;
+  if max = g then
+    Result.hue := ((b - r) * deg60) div minMax + deg120
+  else
+    {max = b} Result.hue :=
+      ((r - g) * deg60) div minMax + deg240;
   twiceLightness := max + min;
   if min = max then
     Result.saturation := 0
   else
+  {$hints off}
   if twiceLightness < 65536 then
-    Result.saturation := (minMax shl 16) div (twiceLightness + 1)
-  else
-    Result.saturation := (minMax shl 16) div (131072 - twiceLightness);
+    Result.saturation := (int64(minMax) shl 16) div (twiceLightness + 1)
+  else
+    Result.saturation := (int64(minMax) shl 16) div (131072 - twiceLightness);
+  {$hints on}
   Result.lightness := twiceLightness shr 1;
   Result.alpha := ec.alpha;
-  Result.hue   := Result.hue * 65536 div deg360;
-end;
-
-function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
+  Result.hue   := (Result.hue shl 16) div deg360;
+end;
+
+function HtoG(hue: word): word;
+const
+  segmentDest: array[0..5] of word =
+     (13653, 10923, 8192, 13653, 10923, 8192);
+  segmentSrc: array[0..5] of word =
+     (10923, 10922, 10923, 10923, 10922, 10923);
+begin
+  if hue < segmentSrc[0] then
+    result := hue * segmentDest[0] div segmentSrc[0]
+  else
+  begin
+    result := segmentDest[0];
+    hue -= segmentSrc[0];
+    if hue < segmentSrc[1] then
+      result += hue * segmentDest[1] div segmentSrc[1]
+    else
+    begin
+      result += segmentDest[1];
+      hue -= segmentSrc[1];
+      if hue < segmentSrc[2] then
+        result += hue * segmentDest[2] div segmentSrc[2]
+      else
+      begin
+        result += segmentDest[2];
+        hue -= segmentSrc[2];
+        if hue < segmentSrc[3] then
+          result += hue * segmentDest[3] div segmentSrc[3]
+        else
+        begin
+          result += segmentDest[3];
+          hue -= segmentSrc[3];
+          if hue < segmentSrc[4] then
+            result += hue * segmentDest[4] div segmentSrc[4]
+          else
+          begin
+            result += segmentDest[4];
+            hue -= segmentSrc[4];
+            result += hue * segmentDest[5] div segmentSrc[5];
+          end;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function GtoH(ghue: word): word;
+const
+  segment: array[0..5] of word =
+     (13653, 10923, 8192, 13653, 10923, 8192);
+begin
+  if ghue < segment[0] then
+    result := ghue * 10923 div segment[0]
+  else
+  begin
+    ghue -= segment[0];
+    if ghue < segment[1] then
+      result := ghue * (21845-10923) div segment[1] + 10923
+    else
+    begin
+      ghue -= segment[1];
+      if ghue < segment[2] then
+        result := ghue * (32768-21845) div segment[2] + 21845
+      else
+      begin
+        ghue -= segment[2];
+        if ghue < segment[3] then
+          result := ghue * (43691-32768) div segment[3] + 32768
+        else
+        begin
+          ghue -= segment[3];
+          if ghue < segment[4] then
+            result := ghue * (54613-43691) div segment[4] + 43691
+          else
+          begin
+            ghue -= segment[4];
+            result := ghue * (65536-54613) div segment[5] + 54613;
+          end;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
 const
   deg30  = 4096;
@@ -364 +1813 @@
 var
   q, p: integer;
-  ec:   TExpandedPixel;
 begin
   c.hue := c.hue * deg360 shr 16;
   if c.saturation = 0 then  //gray
   begin
-    ec.red   := c.lightness;
-    ec.green := c.lightness;
-    ec.blue  := c.lightness;
-    ec.alpha := c.alpha;
-    Result   := GammaCompression(ec);
+    result.red   := c.lightness;
+    result.green := c.lightness;
+    result.blue  := c.lightness;
+    result.alpha := c.alpha;
     exit;
   end;
+  {$hints off}
   if c.lightness < 32768 then
     q := (c.lightness shr 1) * ((65535 + c.saturation) shr 1) shr 14
@@ -381 +1829 @@
     q := c.lightness + c.saturation - ((c.lightness shr 1) *
       (c.saturation shr 1) shr 14);
+  {$hints on}
   if q > 65535 then
     q := 65535;
@@ -386 +1835 @@
   if p > 65535 then
     p      := 65535;
-  ec.red   := ComputeColor(p, q, c.hue + deg120);
-  ec.green := ComputeColor(p, q, c.hue);
-  ec.blue  := ComputeColor(p, q, c.hue + deg240);
-  ec.alpha := c.alpha;
-  Result   := GammaCompression(ec);
-end;
-
+  result.red   := ComputeColor(p, q, c.hue + deg120);
+  result.green := ComputeColor(p, q, c.hue);
+  result.blue  := ComputeColor(p, q, c.hue + deg240);
+  result.alpha := c.alpha;
+end;
+
+{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space }
+function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
+var ec: TExpandedPixel;
+begin
+  ec := HSLAToExpanded(c);
+  Result := GammaCompression(ec);
+end;
+
+function HueDiff(h1, h2: word): word;
+begin
+  result := abs(integer(h1)-integer(h2));
+  if result > 32768 then result := 65536-result;
+end;
+
+function GetHue(ec: TExpandedPixel): word;
+const
+  deg60  = 8192;
+  deg120 = deg60 * 2;
+  deg240 = deg60 * 4;
+  deg360 = deg60 * 6;
+var
+  min, max, minMax: integer;
+  r,g,b: integer;
+begin
+  r := ec.red;
+  g := ec.green;
+  b := ec.blue;
+  min := r;
+  max := r;
+  if g > max then
+    max := g
+  else
+  if g < min then
+    min := g;
+  if b > max then
+    max := b
+  else
+  if b < min then
+    min  := b;
+  minMax := max - min;
+
+  if minMax = 0 then
+    Result := 0
+  else
+  if max = r then
+    Result := (((g - b) * deg60) div
+      minMax + deg360) mod deg360
+  else
+  if max = g then
+    Result := ((b - r) * deg60) div minMax + deg120
+  else
+    {max = b} Result :=
+      ((r - g) * deg60) div minMax + deg240;
+
+  Result   := (Result shl 16) div deg360; //normalize
+end;
+
+function ColorImportance(ec: TExpandedPixel): word;
+var min,max: word;
+begin
+  min := ec.red;
+  max := ec.red;
+  if ec.green > max then
+    max := ec.green
+  else
+  if ec.green < min then
+    min := ec.green;
+  if ec.blue > max then
+    max := ec.blue
+  else
+  if ec.blue < min then
+    min  := ec.blue;
+  result := max - min;
+end;
+
+function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
+var ec: TExpandedPixel;
+    lightness: word;
+begin
+  c.hue := GtoH(c.hue);
+  lightness := c.lightness;
+  c.lightness := 32768;
+  ec := HSLAToExpanded(c);
+  result := GammaCompression(SetLightness(ec, lightness));
+end;
+
+function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
+begin
+  result := BGRAToHSLA(GSBAToBGRA(c));
+end;
+
+{ Apply gamma correction using conversion tables }
 function GammaExpansion(c: TBGRAPixel): TExpandedPixel;
 begin
@@ -398 +1938 @@
   Result.green := GammaExpansionTab[c.green];
   Result.blue  := GammaExpansionTab[c.blue];
-  Result.alpha := c.alpha shl 8 + 128;
-end;
-
-{$hints on}
+  Result.alpha := c.alpha shl 8 + c.alpha;
+end;
 
 function GammaCompression(ec: TExpandedPixel): TBGRAPixel;
@@ -411 +1949 @@
 end;
 
+function GammaCompression(red, green, blue, alpha: word): TBGRAPixel;
+begin
+  Result.red   := GammaCompressionTab[red];
+  Result.green := GammaCompressionTab[green];
+  Result.blue  := GammaCompressionTab[blue];
+  Result.alpha := alpha shr 8;
+end;
+
+// Conversion to grayscale by taking into account
+// different color weights
 function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
 var
@@ -430 +1978 @@
 end;
 
+function GrayscaleToBGRA(lightness: word): TBGRAPixel;
+begin
+  result.red := GammaCompressionTab[lightness];
+  result.green := result.red;
+  result.blue := result.red;
+  result.alpha := $ff;
+end;
+
+{ Merge linearly two colors of same importance }
 function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
+var c12: cardinal;
 begin
   if (c1.alpha = 0) then
@@ -439 +1997 @@
   else
   begin
-    Result.red   := round((c1.red * c1.alpha + c2.red * c2.alpha) /
-      (c1.alpha + c2.alpha));
-    Result.green := round((c1.green * c1.alpha + c2.green * c2.alpha) /
-      (c1.alpha + c2.alpha));
-    Result.blue  := round((c1.blue * c1.alpha + c2.blue * c2.alpha) /
-      (c1.alpha + c2.alpha));
-    Result.alpha := (c1.alpha + c2.alpha + 1) div 2;
+    c12 := c1.alpha + c2.alpha;
+    Result.red   := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12;
+    Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12;
+    Result.blue  := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12;
+    Result.alpha := (c12 + 1) shr 1;
+  end;
+end;
+
+function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel;
+  weight2: integer): TBGRAPixel;
+var
+    f1,f2,f12: integer;
+begin
+  f1 := c1.alpha*weight1;
+  f2 := c2.alpha*weight2;
+  if (f1 = 0) then
+  begin
+    if (f2 = 0) then
+      result := BGRAPixelTransparent
+    else
+      Result := c2
+  end
+  else
+  if (f2 = 0) then
+    Result := c1
+  else
+  if (weight1+weight2 = 0) then
+    Result := BGRAPixelTransparent
+  else
+  begin
+    f12 := f1+f2;
+    if f12 = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      Result.red   := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12;
+      Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12;
+      Result.blue  := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12;
+      Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2);
+    end;
+  end;
+end;
+
+{ Merge two colors of same importance }
+function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel;
+var c12: cardinal;
+begin
+  if (ec1.alpha = 0) then
+    Result := ec2
+  else
+  if (ec2.alpha = 0) then
+    Result := ec1
+  else
+  begin
+    c12 := ec1.alpha + ec2.alpha;
+    Result.red   := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12;
+    Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12;
+    Result.blue  := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12;
+    Result.alpha := (c12 + 1) shr 1;
   end;
 end;
@@ -465 +2075 @@
 end;
 
+{ Convert a TColor value to a TBGRAPixel value. Note that
+  you need to call ColorToRGB first if you use a system
+  color identifier like clWindow. }
 {$PUSH}{$R-}
 function ColorToBGRA(color: TColor): TBGRAPixel; overload;
@@ -483 +2096 @@
 {$POP}
 
-{$hints off}
+{ Conversion from TFPColor to TBGRAPixel assuming TFPColor
+  is already gamma compressed }
+function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
+begin
+  with AValue do
+    Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
+end;
+
+function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
+begin
+  result.red := AValue.red shl 8 + AValue.red;
+  result.green := AValue.green shl 8 + AValue.green;
+  result.blue := AValue.blue shl 8 + AValue.blue;
+  result.alpha := AValue.alpha shl 8 + AValue.alpha;
+end;
+
 function BGRAToColor(c: TBGRAPixel): TColor;
 begin
   Result := c.red + (c.green shl 8) + (c.blue shl 16);
 end;
-
-{$hints on}
 
 operator = (const c1, c2: TBGRAPixel): boolean;
@@ -500 +2126 @@
 end;
 
-function BGRADiff(c1, c2: TBGRAPixel): byte;
+function LessStartSlope65535(value: word): word;
+var factor: word;
+begin
+  factor := 4096 - (not value)*3 shr 7;
+  result := value*factor shr 12;
+end;
+
+function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
 var
   CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2,
   CompGreenAlpha2, CompBlueAlpha2: integer;
-  DiffAlpha: byte;
-begin
-    {$hints off}
-  CompRedAlpha1 := c1.red * c1.alpha;
-  CompGreenAlpha1 := c1.green * c1.alpha;
-  CompBlueAlpha1 := c1.blue * c1.alpha;
-  CompRedAlpha2 := c2.red * c2.alpha;
-  CompGreenAlpha2 := c2.green * c2.alpha;
-  CompBlueAlpha2 := c2.blue * c2.alpha;
-    {$hints on}
-  Result    := (Abs(CompRedAlpha2 - CompRedAlpha1) +
-    Abs(CompBlueAlpha2 - CompBlueAlpha1) + Abs(CompGreenAlpha2 - CompGreenAlpha1)) div
-    (3 * 255);
-  DiffAlpha := Abs(c2.Alpha - c1.Alpha) * 3 shr 2;
+  DiffAlpha: word;
+  ColorDiff: word;
+  TempHueDiff: word;
+begin
+  CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535
+  CompGreenAlpha1 := ec1.green * ec1.alpha shr 16;
+  CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16;
+  CompRedAlpha2 := ec2.red * ec2.alpha shr 16;
+  CompGreenAlpha2 := ec2.green * ec2.alpha shr 16;
+  CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16;
+  Result    := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 +
+    Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 +
+    Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10;
+  ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2));
+  if ColorDiff > 0 then
+  begin
+    TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2)));
+    if TempHueDiff < 32768 then
+      TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4
+    else
+      TempHueDiff := TempHueDiff shr 3;
+    Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12;
+  end;
+  DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha));
   if DiffAlpha > Result then
     Result := DiffAlpha;
 end;
 
+function BGRAWordDiff(c1, c2: TBGRAPixel): word;
+begin
+  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2));
+end;
+
+function BGRADiff(c1,c2: TBGRAPixel): byte;
+begin
+  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8;
+end;
+
+operator-(const c1, c2: TColorF): TColorF;
+begin
+  result[1] := c1[1]-c2[1];
+  result[2] := c1[2]-c2[2];
+  result[3] := c1[3]-c2[3];
+  result[4] := c1[4]-c2[4];
+end;
+
+operator+(const c1, c2: TColorF): TColorF;
+begin
+  result[1] := c1[1]+c2[1];
+  result[2] := c1[2]+c2[2];
+  result[3] := c1[3]+c2[3];
+  result[4] := c1[4]+c2[4];
+end;
+
+operator*(const c1, c2: TColorF): TColorF;
+begin
+  result[1] := c1[1]*c2[1];
+  result[2] := c1[2]*c2[2];
+  result[3] := c1[3]*c2[3];
+  result[4] := c1[4]*c2[4];
+end;
+
+operator*(const c1: TColorF; factor: single): TColorF;
+begin
+  result[1] := c1[1]*factor;
+  result[2] := c1[2]*factor;
+  result[3] := c1[3]*factor;
+  result[4] := c1[4]*factor;
+end;
+
+function ColorF(red, green, blue, alpha: single): TColorF;
+begin
+  result[1] := red;
+  result[2] := green;
+  result[3] := blue;
+  result[4] := alpha;
+end;
+
+{ Write a color in hexadecimal format RRGGBBAA }
+function BGRAToStr(c: TBGRAPixel): string;
+begin
+  result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
+end;
+
+type
+    arrayOfString = array of string;
+
+function SimpleParseFuncParam(str: string): arrayOfString;
+var idxOpen,start,cur: integer;
+begin
+    result := nil;
+    idxOpen := pos('(',str);
+    if idxOpen = 0 then exit;
+    start := idxOpen+1;
+    cur := start;
+    while cur <= length(str) do
+    begin
+       if str[cur] in[',',')'] then
+       begin
+         setlength(result,length(result)+1);
+         result[high(result)] := copy(str,start,cur-start);
+         start := cur+1;
+       end;
+       inc(cur);
+    end;
+    if start <= length(str) then
+    begin
+      setlength(result,length(result)+1);
+      result[high(result)] := copy(str,start,length(str)-start+1);
+    end;
+end;
+
+function ParseColorValue(str: string): byte;
+var pourcent,unclipped,errPos: integer;
+begin
+  if str = '' then result := 0 else
+  begin
+    if str[length(str)]='%' then
+    begin
+      val(copy(str,1,length(str)-1),pourcent,errPos);
+      if pourcent < 0 then result := 0 else
+      if pourcent > 100 then result := 255 else
+        result := pourcent*255 div 100;
+    end else
+    begin
+      val(str,unclipped,errPos);
+      if unclipped < 0 then result := 0 else
+      if unclipped > 255 then result := 255 else
+        result := unclipped;
+    end;
+  end;
+end;
+
+{ Read a color in hexadecimal format RRGGBB(AA) or RGB(A) }
+function StrToBGRA(str: string): TBGRAPixel;
+var errPos: integer;
+    values: array of string;
+    alphaF: single;
+    idx: integer;
+begin
+  if str = '' then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
+  str := lowerCase(str);
+
+  //VGA color names
+  if str='black' then result := BGRA(0,0,0) else
+  if str='silver' then result := BGRA(192,192,192) else
+  if str='gray' then result := BGRA(128,128,128) else
+  if str='white' then result := BGRA(255,255,255) else
+  if str='maroon' then result := BGRA(128,0,0) else
+  if str='red' then result := BGRA(255,0,0) else
+  if str='purple' then result := BGRA(128,0,128) else
+  if str='fuchsia' then result := BGRA(255,0,255) else
+  if str='green' then result := BGRA(0,128,0) else
+  if str='lime' then result := BGRA(0,255,0) else
+  if str='olive' then result := BGRA(128,128,0) else
+  if str='yellow' then result := BGRA(255,255,0) else
+  if str='navy' then result := BGRA(0,0,128) else
+  if str='blue' then result := BGRA(0,0,255) else
+  if str='teal' then result := BGRA(0,128,128) else
+  if str='aqua' then result := BGRA(0,255,255) else
+  if str='transparent' then result := BGRAPixelTransparent else
+  begin
+    //check CSS color
+    idx := CSSColors.IndexOf(str);
+    if idx <> -1 then
+    begin
+      result := CSSColors[idx];
+      exit;
+    end;
+
+    //CSS RGB notation
+    if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') then
+    begin
+      values := SimpleParseFuncParam(str);
+      if (length(values)=3) or (length(values)=4) then
+      begin
+        result.red := ParseColorValue(values[0]);
+        result.green := ParseColorValue(values[1]);
+        result.blue := ParseColorValue(values[2]);
+        if length(values)=4 then
+        begin
+          val(values[3],alphaF,errPos);
+          if alphaF < 0 then
+            result.alpha := 0 else
+          if alphaF > 1 then
+            result.alpha := 255
+          else
+            result.alpha := round(alphaF*255);
+        end else
+          result.alpha := 255;
+      end else
+        result := BGRAPixelTransparent;
+      exit;
+    end;
+
+    //remove HTML notation header
+    if str[1]='#' then delete(str,1,1);
+
+    //add alpha if missing
+    if length(str)=6 then str += 'FF';
+    if length(str)=3 then str += 'F';
+
+    //hex notation
+    if length(str)=8 then
+    begin
+      val('$'+copy(str,1,2),result.red,errPos);
+      val('$'+copy(str,3,2),result.green,errPos);
+      val('$'+copy(str,5,2),result.blue,errPos);
+      val('$'+copy(str,7,2),result.alpha,errPos);
+    end else
+    if length(str)=4 then
+    begin
+      val('$'+copy(str,1,1),result.red,errPos);
+      val('$'+copy(str,2,1),result.green,errPos);
+      val('$'+copy(str,3,1),result.blue,errPos);
+      val('$'+copy(str,4,1),result.alpha,errPos);
+      result.red *= $11;
+      result.green *= $11;
+      result.blue *= $11;
+      result.alpha *= $11;
+    end else
+      result := BGRAPixelTransparent;
+  end;
+
+end;
+
+
+function MapHeight(Color: TBGRAPixel): Single;
+var intval: integer;
+begin
+  intval := color.Green shl 16 + color.red shl 8 + color.blue;
+  result := intval/16777215;
+end;
+
+function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
+var intval: integer;
+begin
+  if Height >= 1 then result := BGRA(255,255,255,alpha) else
+  if Height <= 0 then result := BGRA(0,0,0,alpha) else
+  begin
+    intval := round(Height*16777215);
+    result := BGRA(intval shr 8,intval shr 16,intval,alpha);
+  end;
+end;
+
+{********************** Point functions **************************}
+
 function PointF(x, y: single): TPointF;
 begin
   Result.x := x;
   Result.y := y;
+end;
+
+function PointsF(const pts: array of TPointF): ArrayOfTPointF;
+var
+  i: Integer;
+begin
+  setlength(result, length(pts));
+  for i := 0 to high(pts) do result[i] := pts[i];
+end;
+
+operator =(const pt1, pt2: TPointF): boolean;
+begin
+  result := (pt1.x = pt2.x) and (pt1.y = pt2.y);
+end;
+
+operator-(const pt1, pt2: TPointF): TPointF;
+begin
+  result.x := pt1.x-pt2.x;
+  result.y := pt1.y-pt2.y;
+end;
+
+operator-(const pt2: TPointF): TPointF;
+begin
+  result.x := -pt2.x;
+  result.y := -pt2.y;
+end;
+
+operator+(const pt1, pt2: TPointF): TPointF;
+begin
+  result.x := pt1.x+pt2.x;
+  result.y := pt1.y+pt2.y;
+end;
+
+operator*(const pt1, pt2: TPointF): single;
+begin
+  result := pt1.x*pt2.x + pt1.y*pt2.y;
+end;
+
+operator*(const pt1: TPointF; factor: single): TPointF;
+begin
+  result.x := pt1.x*factor;
+  result.y := pt1.y*factor;
+end;
+
+operator*(factor: single; const pt1: TPointF): TPointF;
+begin
+  result.x := pt1.x*factor;
+  result.y := pt1.y*factor;
 end;
 
@@ -548 +2462 @@
 end;
 
-function StrToGradientType(str: string): TGradientType;
-var gt: TGradientType;
-begin
-  result := gtLinear;
-  str := LowerCase(str);
-  for gt := low(TGradientType) to high(TGradientType) do
-    if str = LowerCase(GradientTypeStr[gt]) then
+function VectLen(dx, dy: single): single;
+begin
+  result := sqrt(dx*dx+dy*dy);
+end;
+
+function VectLen(v: TPointF): single;
+begin
+  result := sqrt(v.x*v.x+v.y*v.y);
+end;
+
+function IntersectLine(line1, line2: TLineDef): TPointF;
+var parallel: boolean;
+begin
+  result := IntersectLine(line1,line2,parallel);
+end;
+
+function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
+var divFactor: double;
+begin
+  parallel := false;
+  //if lines are parallel
+  if ((line1.dir.x = line2.dir.x) and (line1.dir.y = line2.dir.y)) or
+     ((abs(line1.dir.y) < 1e-6) and (abs(line2.dir.y) < 1e-6)) then
+  begin
+       parallel := true;
+       //return the center of the segment between line origins
+       result.x := (line1.origin.x+line2.origin.x)/2;
+       result.y := (line1.origin.y+line2.origin.y)/2;
+  end else
+  if abs(line1.dir.y) < 1e-6 then //line1 is horizontal
+  begin
+       result.y := line1.origin.y;
+       result.x := line2.origin.x + (result.y - line2.origin.y)
+               /line2.dir.y*line2.dir.x;
+  end else
+  if abs(line2.dir.y) < 1e-6 then //line2 is horizontal
+  begin
+       result.y := line2.origin.y;
+       result.x := line1.origin.x + (result.y - line1.origin.y)
+               /line1.dir.y*line1.dir.x;
+  end else
+  begin
+       divFactor := line1.dir.x/line1.dir.y - line2.dir.x/line2.dir.y;
+       if abs(divFactor) < 1e-6 then //almost parallel
+       begin
+            parallel := true;
+            //return the center of the segment between line origins
+            result.x := (line1.origin.x+line2.origin.x)/2;
+            result.y := (line1.origin.y+line2.origin.y)/2;
+       end else
+       begin
+         result.y := (line2.origin.x - line1.origin.x +
+                  line1.origin.y*line1.dir.x/line1.dir.y -
+                  line2.origin.y*line2.dir.x/line2.dir.y)
+                  / divFactor;
+         result.x := line1.origin.x + (result.y - line1.origin.y)
+                 /line1.dir.y*line1.dir.x;
+       end;
+  end;
+end;
+
+{ Check if a polygon is convex, i.e. it always turns in the same direction }
+function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
+var
+  positive,negative,zero: boolean;
+  product: single;
+  i: Integer;
+begin
+  positive := false;
+  negative := false;
+  zero := false;
+  for i := 0 to high(pts) do
+  begin
+    product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) -
+               (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x);
+    if product > 0 then
     begin
-      result := gt;
-      exit;
+      if negative then
+      begin
+        result := false;
+        exit;
+      end;
+      positive := true;
+    end else
+    if product < 0 then
+    begin
+      if positive then
+      begin
+        result := false;
+        exit;
+      end;
+      negative := true;
+    end else
+      zero := true;
+  end;
+  if not IgnoreAlign and zero then
+    result := false
+  else
+    result := true;
+end;
+
+{ Check if two segments intersect }
+function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+var
+  seg1: TLineDef;
+  seg1len: single;
+  seg2: TLineDef;
+  seg2len: single;
+  inter: TPointF;
+  pos1,pos2: single;
+  para: boolean;
+
+begin
+  { Determine line definitions }
+  seg1.origin := pt1;
+  seg1.dir := pt2-pt1;
+  seg1len := sqrt(sqr(seg1.dir.X)+sqr(seg1.dir.Y));
+  if seg1len = 0 then
+  begin
+    result := false;
+    exit;
+  end;
+  seg1.dir *= 1/seg1len;
+
+  seg2.origin := pt3;
+  seg2.dir := pt4-pt3;
+  seg2len := sqrt(sqr(seg2.dir.X)+sqr(seg2.dir.Y));
+  if seg2len = 0 then
+  begin
+    result := false;
+    exit;
+  end;
+  seg2.dir *= 1/seg2len;
+
+  //obviously parallel
+  if seg1.dir = seg2.dir then
+    result := false
+  else
+  begin
+    //try to compute intersection
+    inter := IntersectLine(seg1,seg2,para);
+    if para then
+      result := false
+    else
+    begin
+      //check if intersections are inside the segments
+      pos1 := (inter-seg1.origin)*seg1.dir;
+      pos2 := (inter-seg2.origin)*seg2.dir;
+      if (pos1 >= 0) and (pos1 <= seg1len) and
+         (pos2 >= 0) and (pos2 <= seg2len) then
+        result := true
+      else
+        result := false;
     end;
-end;
-
-function BGRAToStr(c: TBGRAPixel): string;
-begin
-  result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
-end;
-
-{$hints off}
-{$notes off}
-function StrToBGRA(str: string): TBGRAPixel;
-var errPos: integer;
-begin
-  if length(str)=6 then str += 'FF';
-  if length(str)=3 then str += 'F';
-  if length(str)=8 then
-  begin
-    val('$'+copy(str,1,2),result.red,errPos);
-    val('$'+copy(str,3,2),result.green,errPos);
-    val('$'+copy(str,5,2),result.blue,errPos);
-    val('$'+copy(str,7,2),result.alpha,errPos);
+  end;
+end;
+
+{ Check if a quaduadrilateral intersects itself }
+function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+begin
+  result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1);
+end;
+
+{************************** Cyclic functions *******************}
+
+// Get the cyclic value in the range [0..cycle-1]
+function PositiveMod(value, cycle: integer): integer; inline;
+begin
+  result := value mod cycle;
+  if result < 0 then //modulo can be negative
+    Inc(result, cycle);
+end;
+
+{ Table of precalc values. Note : the value is stored for
+  the first half of the cycle, and values are stored 'minus 1'
+  in order to stay in the range 0..65535 }
+var
+  sinTab65536: packed array of word;
+
+function Sin65536(value: word): integer;
+var b: integer;
+begin
+  //allocate array
+  if sinTab65536 = nil then
+    setlength(sinTab65536,32768);
+
+  if value >= 32768 then //function is upside down after half-period
+  begin
+    b := value xor 32768;
+    if sinTab65536[b] = 0 then //precalc
+      sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1;
+    result := not sinTab65536[b];
   end else
-  if length(str)=4 then
-  begin
-    val('$'+copy(str,1,1),result.red,errPos);
-    val('$'+copy(str,2,1),result.green,errPos);
-    val('$'+copy(str,3,1),result.blue,errPos);
-    val('$'+copy(str,4,1),result.alpha,errPos);
-    result.red *= $11;
-    result.green *= $11;
-    result.blue *= $11;
-    result.alpha *= $11;
-  end else
-    result := BGRAPixelTransparent;
-end;
-{$notes on}
-{$hints on}
+  begin
+    b := value;
+    if sinTab65536[b] = 0 then //precalc
+      sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1;
+    {$hints off}
+    result := sinTab65536[b]+1;
+    {$hints on}
+  end;
+end;
+
+function Cos65536(value: word): integer;
+begin
+  result := Sin65536(value+16384); //cosine is translated
+end;
+
+procedure PrecalcSin65536;
+var
+  i: Integer;
+begin
+  for i := 0 to 32767 do Sin65536(i);
+end;
 
 initialization
 
   InitGamma;
+  CSSColors := TBGRAColorList.Create;
+  CSSColors.Add('AliceBlue',CSSAliceBlue);
+  CSSColors.Add('AntiqueWhite',CSSAntiqueWhite);
+  CSSColors.Add('Aqua',CSSAqua);
+  CSSColors.Add('Aquamarine',CSSAquamarine);
+  CSSColors.Add('Azure',CSSAzure);
+  CSSColors.Add('Beige',CSSBeige);
+  CSSColors.Add('Bisque',CSSBisque);
+  CSSColors.Add('Black',CSSBlack);
+  CSSColors.Add('BlanchedAlmond',CSSBlanchedAlmond);
+  CSSColors.Add('Blue',CSSBlue);
+  CSSColors.Add('BlueViolet',CSSBlueViolet);
+  CSSColors.Add('Brown',CSSBrown);
+  CSSColors.Add('BurlyWood',CSSBurlyWood);
+  CSSColors.Add('CadetBlue',CSSCadetBlue);
+  CSSColors.Add('Chartreuse',CSSChartreuse);
+  CSSColors.Add('Chocolate',CSSChocolate);
+  CSSColors.Add('Coral',CSSCoral);
+  CSSColors.Add('CornflowerBlue',CSSCornflowerBlue);
+  CSSColors.Add('Cornsilk',CSSCornsilk);
+  CSSColors.Add('Crimson',CSSCrimson);
+  CSSColors.Add('Cyan',CSSCyan);
+  CSSColors.Add('DarkBlue',CSSDarkBlue);
+  CSSColors.Add('DarkCyan',CSSDarkCyan);
+  CSSColors.Add('DarkGoldenrod',CSSDarkGoldenrod);
+  CSSColors.Add('DarkGray',CSSDarkGray);
+  CSSColors.Add('DarkGreen',CSSDarkGreen);
+  CSSColors.Add('DarkKhaki',CSSDarkKhaki);
+  CSSColors.Add('DarkMagenta',CSSDarkMagenta);
+  CSSColors.Add('DarkOliveGreen',CSSDarkOliveGreen);
+  CSSColors.Add('DarkOrange',CSSDarkOrange);
+  CSSColors.Add('DarkOrchid',CSSDarkOrchid);
+  CSSColors.Add('DarkRed',CSSDarkRed);
+  CSSColors.Add('DarkSalmon',CSSDarkSalmon);
+  CSSColors.Add('DarkSeaGreen',CSSDarkSeaGreen);
+  CSSColors.Add('DarkSlateBlue',CSSDarkSlateBlue);
+  CSSColors.Add('DarkSlateGray',CSSDarkSlateGray);
+  CSSColors.Add('DarkTurquoise',CSSDarkTurquoise);
+  CSSColors.Add('DarkViolet',CSSDarkViolet);
+  CSSColors.Add('DeepPink',CSSDeepPink);
+  CSSColors.Add('DeepSkyBlue',CSSDeepSkyBlue);
+  CSSColors.Add('DimGray',CSSDimGray);
+  CSSColors.Add('DodgerBlue',CSSDodgerBlue);
+  CSSColors.Add('FireBrick',CSSFireBrick);
+  CSSColors.Add('FloralWhite',CSSFloralWhite);
+  CSSColors.Add('ForestGreen',CSSForestGreen);
+  CSSColors.Add('Fuchsia',CSSFuchsia);
+  CSSColors.Add('Gainsboro',CSSGainsboro);
+  CSSColors.Add('GhostWhite',CSSGhostWhite);
+  CSSColors.Add('Gold',CSSGold);
+  CSSColors.Add('Goldenrod',CSSGoldenrod);
+  CSSColors.Add('Gray',CSSGray);
+  CSSColors.Add('Green',CSSGreen);
+  CSSColors.Add('GreenYellow',CSSGreenYellow);
+  CSSColors.Add('Honeydew',CSSHoneydew);
+  CSSColors.Add('HotPink',CSSHotPink);
+  CSSColors.Add('IndianRed',CSSIndianRed);
+  CSSColors.Add('Indigo',CSSIndigo);
+  CSSColors.Add('Ivory',CSSIvory);
+  CSSColors.Add('Khaki',CSSKhaki);
+  CSSColors.Add('Lavender',CSSLavender);
+  CSSColors.Add('LavenderBlush',CSSLavenderBlush);
+  CSSColors.Add('LawnGreen',CSSLawnGreen);
+  CSSColors.Add('LemonChiffon',CSSLemonChiffon);
+  CSSColors.Add('LightBlue',CSSLightBlue);
+  CSSColors.Add('LightCoral',CSSLightCoral);
+  CSSColors.Add('LightCyan',CSSLightCyan);
+  CSSColors.Add('LightGoldenrodYellow',CSSLightGoldenrodYellow);
+  CSSColors.Add('LightGray',CSSLightGray);
+  CSSColors.Add('LightGreen',CSSLightGreen);
+  CSSColors.Add('LightPink',CSSLightPink);
+  CSSColors.Add('LightSalmon',CSSLightSalmon);
+  CSSColors.Add('LightSeaGreen',CSSLightSeaGreen);
+  CSSColors.Add('LightSkyBlue',CSSLightSkyBlue);
+  CSSColors.Add('LightSlateGray',CSSLightSlateGray);
+  CSSColors.Add('LightSteelBlue',CSSLightSteelBlue);
+  CSSColors.Add('LightYellow',CSSLightYellow);
+  CSSColors.Add('Lime',CSSLime);
+  CSSColors.Add('LimeGreen',CSSLimeGreen);
+  CSSColors.Add('Linen',CSSLinen);
+  CSSColors.Add('Magenta',CSSMagenta);
+  CSSColors.Add('Maroon',CSSMaroon);
+  CSSColors.Add('MediumAquamarine',CSSMediumAquamarine);
+  CSSColors.Add('MediumBlue',CSSMediumBlue);
+  CSSColors.Add('MediumOrchid',CSSMediumOrchid);
+  CSSColors.Add('MediumPurple',CSSMediumPurple);
+  CSSColors.Add('MediumSeaGreen',CSSMediumSeaGreen);
+  CSSColors.Add('MediumSlateBlue',CSSMediumSlateBlue);
+  CSSColors.Add('MediumSpringGreen',CSSMediumSpringGreen);
+  CSSColors.Add('MediumTurquoise',CSSMediumTurquoise);
+  CSSColors.Add('MediumVioletRed',CSSMediumVioletRed);
+  CSSColors.Add('MidnightBlue',CSSMidnightBlue);
+  CSSColors.Add('MintCream',CSSMintCream);
+  CSSColors.Add('MistyRose',CSSMistyRose);
+  CSSColors.Add('Moccasin',CSSMoccasin);
+  CSSColors.Add('NavajoWhite',CSSNavajoWhite);
+  CSSColors.Add('Navy',CSSNavy);
+  CSSColors.Add('OldLace',CSSOldLace);
+  CSSColors.Add('Olive',CSSOlive);
+  CSSColors.Add('OliveDrab',CSSOliveDrab);
+  CSSColors.Add('Orange',CSSOrange);
+  CSSColors.Add('OrangeRed',CSSOrangeRed);
+  CSSColors.Add('Orchid',CSSOrchid);
+  CSSColors.Add('PaleGoldenrod',CSSPaleGoldenrod);
+  CSSColors.Add('PaleGreen',CSSPaleGreen);
+  CSSColors.Add('PaleTurquoise',CSSPaleTurquoise);
+  CSSColors.Add('PaleVioletRed',CSSPaleVioletRed);
+  CSSColors.Add('PapayaWhip',CSSPapayaWhip);
+  CSSColors.Add('PeachPuff',CSSPeachPuff);
+  CSSColors.Add('Peru',CSSPeru);
+  CSSColors.Add('Pink',CSSPink);
+  CSSColors.Add('Plum',CSSPlum);
+  CSSColors.Add('PowderBlue',CSSPowderBlue);
+  CSSColors.Add('Purple',CSSPurple);
+  CSSColors.Add('Red',CSSRed);
+  CSSColors.Add('RosyBrown',CSSRosyBrown);
+  CSSColors.Add('RoyalBlue',CSSRoyalBlue);
+  CSSColors.Add('SaddleBrown',CSSSaddleBrown);
+  CSSColors.Add('Salmon',CSSSalmon);
+  CSSColors.Add('SandyBrown',CSSSandyBrown);
+  CSSColors.Add('SeaGreen',CSSSeaGreen);
+  CSSColors.Add('Seashell',CSSSeashell);
+  CSSColors.Add('Sienna',CSSSienna);
+  CSSColors.Add('Silver',CSSSilver);
+  CSSColors.Add('SkyBlue',CSSSkyBlue);
+  CSSColors.Add('SlateBlue',CSSSlateBlue);
+  CSSColors.Add('SlateGray',CSSSlateGray);
+  CSSColors.Add('Snow',CSSSnow);
+  CSSColors.Add('SpringGreen',CSSSpringGreen);
+  CSSColors.Add('SteelBlue',CSSSteelBlue);
+  CSSColors.Add('Tan',CSSTan);
+  CSSColors.Add('Teal',CSSTeal);
+  CSSColors.Add('Thistle',CSSThistle);
+  CSSColors.Add('Tomato',CSSTomato);
+  CSSColors.Add('Turquoise',CSSTurquoise);
+  CSSColors.Add('Violet',CSSViolet);
+  CSSColors.Add('Wheat',CSSWheat);
+  CSSColors.Add('White',CSSWhite);
+  CSSColors.Add('WhiteSmoke',CSSWhiteSmoke);
+  CSSColors.Add('Yellow',CSSYellow);
+  CSSColors.Add('YellowGreen',CSSYellowGreen);
+  CSSColors.Finished;
+
+finalization
+
+  CSSColors.Free;
 
 end.
-

GraphicTest/BGRABitmap/bgrablend.pas

@@ -1 +1 @@
 unit BGRABlend;
+
+{ This unit contains pixel blending functions. They take a destination adress as parameter,
+  and draw pixels at this address with different blending modes. These functions are used
+  by many functions in BGRABitmap library to do the low level drawing. }
 
 {$mode objfpc}{$H+}
@@ -8 +12 @@
   Classes, SysUtils, BGRABitmapTypes;
 
+{ Draw one pixel with alpha blending }
+procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload;
+procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload;
+procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); inline; overload;
+procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); inline; overload;  //alpha in 'c' parameter
+procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload;
+procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; calpha: byte); inline; overload;
+
+procedure CopyPixelsWithOpacity(dest,src: PBGRAPixel; opacity: byte; Count: integer); inline;
+function ApplyOpacity(opacity1,opacity2: byte): byte; inline;
+function FastRoundDiv255(value: cardinal): cardinal; inline;
+
+{ Draw a series of pixels with alpha blending }
+procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; overload;
+procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; Count: integer); inline; overload;
+procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); inline; overload;  //alpha in 'c' parameter
+
+{ Draw one pixel with linear alpha blending }
+procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload;
+procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload;
+
+{ Draw a series of pixels with linear alpha blending }
+procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
+
+{ Replace a series of pixels }
+procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
+
+{ Xor a series of pixels }
+procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
+procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer);
+
+{ Set alpha value for a series of pixels }
+procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline;
+
+{ Erase a series of pixels, i.e. decrease alpha value }
+procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline;
+
+{ Draw a pixel to the extent the current pixel is close enough to compare value.
+  It should not be called on pixels that have not been checked to be close enough }
+procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel;
+  maxDiff: byte); inline;
+{ Draw a series of pixel to the extent the current pixel is close enough to compare value }
+procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel;
+  Count: integer; compare: TBGRAPixel; maxDiff: byte); inline;
+
+{ Blend pixels with scanner content }
+procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode);
+
+{ Perform advanced blending operation }
 procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel;
   blendOp: TBlendOperation; Count: integer);
 
-procedure DrawPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
-procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
-
-procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
-procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline;
-procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline;
-
-procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
-procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;
-
-procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel;
-  maxDiff: byte); inline;
-procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel;
-  Count: integer; compare: TBGRAPixel; maxDiff: byte); inline;
-
 //layer blend modes ( http://www.pegtop.net/delphi/articles/blendmodes/ )
-procedure MultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
@@ -34 +71 @@
 procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
@@ -47 +87 @@
 implementation
 
+procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode);
+var c : TBGRAPixel;
+  i: Integer;
+  scanNextFunc: function(): TBGRAPixel of object;
+begin
+  if scan.IsScanPutPixelsDefined then
+    scan.ScanPutPixels(pdest,count,mode) else
+  begin
+    scanNextFunc := @scan.ScanNextPixel;
+    case mode of
+      dmLinearBlend:
+        for i := 0 to count-1 do
+        begin
+          FastBlendPixelInline(pdest, scanNextFunc());
+          inc(pdest);
+        end;
+      dmDrawWithTransparency:
+        for i := 0 to count-1 do
+        begin
+          DrawPixelInlineWithAlphaCheck(pdest, scanNextFunc());
+          inc(pdest);
+        end;
+      dmSet:
+        for i := 0 to count-1 do
+        begin
+          pdest^ := scanNextFunc();
+          inc(pdest);
+        end;
+      dmXor:
+        for i := 0 to count-1 do
+        begin
+          PDWord(pdest)^ := PDWord(pdest)^ xor DWord(scanNextFunc());
+          inc(pdest);
+        end;
+      dmSetExceptTransparent:
+        for i := 0 to count-1 do
+        begin
+          c := scanNextFunc();
+          if c.alpha = 255 then pdest^ := c;
+          inc(pdest);
+        end;
+    end;
+  end;
+end;
+
 procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel;
   blendOp: TBlendOperation; Count: integer);
@@ -61 +146 @@
     boTransparent: while Count > 0 do
       begin
-        DrawPixelInline(pdest, psrc^);
+        DrawPixelInlineWithAlphaCheck(pdest, psrc^);
         Inc(pdest);
         Inc(psrc);
@@ -69 +154 @@
     boMultiply: while Count > 0 do
       begin
-        MultiplyPixelInline(pdest, psrc^);
-        Inc(pdest);
-        Inc(psrc);
-        Dec(Count);
-      end;
-
-    boLinearMultiply: while Count > 0 do
-      begin
-        LinearMultiplyPixelInline(pdest, psrc^);
+        LinearMultiplyPixelInline(pdest, psrc^);  //same look with non linear
         Inc(pdest);
         Inc(psrc);
@@ -131 +208 @@
       end;
 
+    boNiceGlow: while Count > 0 do
+      begin
+        NiceGlowPixelInline(pdest, psrc^);
+        Inc(pdest);
+        Inc(psrc);
+        Dec(Count);
+      end;
+
     boOverlay: while Count > 0 do
       begin
+        LinearOverlayPixelInline(pdest, psrc^);
+        Inc(pdest);
+        Inc(psrc);
+        Dec(Count);
+      end;
+
+    boDarkOverlay: while Count > 0 do
+      begin
         OverlayPixelInline(pdest, psrc^);
         Inc(pdest);
@@ -202 +295 @@
         Dec(Count);
       end;
+  end;
+end;
+
+procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer);
+begin
+  while Count > 0 do
+  begin
+    PDWord(dest)^ := PDWord(dest)^ xor DWord(c);
+    Inc(dest);
+    Dec(Count);
+  end;
+end;
+
+procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer);
+begin
+  while Count > 0 do
+  begin
+    PDWord(pdest)^ := PDWord(psrc)^ xor PDWord(pdest)^;
+    Inc(pdest);
+    Inc(psrc);
+    Dec(Count);
   end;
 end;
@@ -224 +338 @@
   n: integer;
 begin
+  if c.alpha = 0 then exit;
   for n := Count - 1 downto 0 do
   begin
@@ -234 +349 @@
 var
   n: integer;
-begin
+  ec: TExpandedPixel;
+begin
+  if c.alpha = 0 then exit;
+  if c.alpha = 255 then
+  begin
+    filldword(dest^,count,longword(c));
+    exit;
+  end;
+  ec := GammaExpansion(c);
   for n := Count - 1 downto 0 do
   begin
-    DrawPixelInline(dest, c);
+    DrawExpandedPixelInlineNoAlphaCheck(dest, ec,c.alpha);
+    Inc(dest);
+  end;
+end;
+
+procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel;
+  Count: integer);
+var
+  n: integer;
+  c: TBGRAPixel;
+begin
+  if ec.alpha < $0100 then exit;
+  if ec.alpha >= $FF00 then
+  begin
+    c := GammaCompression(ec);
+    filldword(dest^,count,longword(c));
+    exit;
+  end;
+  for n := Count - 1 downto 0 do
+  begin
+    DrawExpandedPixelInlineNoAlphaCheck(dest, ec, ec.alpha shr 8);
+    Inc(dest);
+  end;
+end;
+
+procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer
+  );
+var
+  n: integer;
+begin
+  if c.alpha = 0 then exit;
+  if c.alpha = 255 then
+  begin
+    filldword(dest^,count,longword(c));
+    exit;
+  end;
+  for n := Count - 1 downto 0 do
+  begin
+    DrawExpandedPixelInlineNoAlphaCheck(dest, ec, c.alpha);
     Inc(dest);
   end;
@@ -255 +416 @@
 
 {$hints off}
-procedure DrawPixelInline(dest: PBGRAPixel; c: TBGRAPixel);
+procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel);
+begin
+  if c.alpha = 0 then
+    exit;
+  if c.alpha = 255 then
+  begin
+    dest^ := c;
+    exit;
+  end;
+  DrawPixelInlineNoAlphaCheck(dest,c);
+end;
+
+procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte);
+begin
+  c.alpha := ApplyOpacity(c.alpha,appliedOpacity);
+  if c.alpha = 0 then
+    exit;
+  if c.alpha = 255 then
+  begin
+    dest^ := c;
+    exit;
+  end;
+  DrawPixelInlineNoAlphaCheck(dest,c);
+end;
+
+procedure CopyPixelsWithOpacity(dest, src: PBGRAPixel; opacity: byte;
+  Count: integer);
+var c: TBGRAPixel;
+begin
+  while count > 0 do
+  begin
+    c := src^;
+    c.alpha := ApplyOpacity(c.alpha,opacity);
+    dest^ := c;
+    inc(src);
+    inc(dest);
+    dec(count);
+  end;
+end;
+
+function ApplyOpacity(opacity1, opacity2: byte): byte;
+begin
+  result := opacity1*(opacity2+1) shr 8;
+end;
+
+function FastRoundDiv255(value: cardinal): cardinal; inline;
+begin
+  result := (value + (value shr 7)) shr 8;
+end;
+
+procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel);
+var
+  calpha: byte;
+begin
+  calpha := ec.alpha shr 8;
+  if calpha = 0 then
+    exit;
+  if calpha = 255 then
+  begin
+    dest^ := GammaCompression(ec);
+    exit;
+  end;
+  DrawExpandedPixelInlineNoAlphaCheck(dest,ec,calpha);
+end;
+
+procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel);
+begin
+  if c.alpha = 0 then
+    exit;
+  if c.alpha = 255 then
+  begin
+    dest^ := c;
+    exit;
+  end;
+  DrawExpandedPixelInlineNoAlphaCheck(dest,ec,c.alpha);
+end;
+
+procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel);
 var
   p: PByte;
   a1f, a2f, a12, a12m: cardinal;
 begin
-  if c.alpha = 0 then
-    exit;
-  if c.alpha = 255 then
-  begin
-    dest^ := c;
-    exit;
-  end;
-
   a12  := 65025 - (not dest^.alpha) * (not c.alpha);
   a12m := a12 shr 1;
@@ -289 +519 @@
 end;
 
-procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel);
+procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel;
+  const ec: TExpandedPixel; calpha: byte);
+var
+  p: PByte;
+  a1f, a2f, a12, a12m: cardinal;
+begin
+  a12  := 65025 - (not dest^.alpha) * (not calpha);
+  a12m := a12 shr 1;
+
+  a1f := dest^.alpha * (not calpha);
+  a2f := (calpha shl 8) - calpha;
+
+  p := PByte(dest);
+
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f +
+    ec.blue * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f +
+    ec.green * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f +
+    ec.red * a2f + a12m) div a12];
+  Inc(p);
+
+  p^ := (a12 + a12 shr 7) shr 8;
+end;
+
+procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel);
 var
   p: PByte;
@@ -320 +577 @@
 end;
 
+procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel;
+  appliedOpacity: byte);
+begin
+  c.alpha := ApplyOpacity(c.alpha,appliedOpacity);
+  FastBlendPixelInline(dest,c);
+end;
+
 procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel;
   maxDiff: byte); inline;
 begin
-  DrawPixelInline(dest, BGRA(c.red, c.green, c.blue,
+  DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue,
     (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div
     (maxDiff + 1)));
@@ -332 +596 @@
   newAlpha: byte;
 begin
-  newAlpha := dest^.alpha * (255 - alpha) div 255;
+  newAlpha := ApplyOpacity(dest^.alpha, not alpha);
   if newAlpha = 0 then
     dest^ := BGRAPixelTransparent
@@ -343 +607 @@
 {--------------------------------------- Layer blending -----------------------------------------}
 
-function ByteMultiplyInline(a, b: byte): byte;
-begin
-  Result := GammaCompressionTab[GammaExpansionTab[a] * GammaExpansionTab[b] shr 16];
-end;
-
 function ByteLinearMultiplyInline(a, b: byte): byte;
 begin
   Result := (a * b) shr 8;
-end;
-
-procedure MultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
-var
-  destalpha: byte;
-begin
-  destalpha   := dest^.alpha;
-  dest^.red   := (ByteMultiplyInline(dest^.red, c.red) * destalpha +
-    c.red * (not destalpha)) shr 8;
-  dest^.green := (ByteMultiplyInline(dest^.green, c.green) * destalpha +
-    c.green * (not destalpha)) shr 8;
-  dest^.blue  := (ByteMultiplyInline(dest^.blue, c.blue) * destalpha +
-    c.blue * (not destalpha)) shr 8;
-  dest^.alpha := c.alpha;
 end;
 
@@ -456 +701 @@
 end;
 
+{$hints off}
 function ByteDodgeInline(a, b: byte): byte; inline;
 var
@@ -464 +710 @@
   else
   begin
-    temp := (a shl 8) div (255 - b);
+    temp := (a shl 8) div (not b);
     if temp > 255 then
       Result := 255
@@ -471 +717 @@
   end;
 end;
+{$hints on}
 
 procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
@@ -486 +733 @@
 end;
 
-function ByteReflectInline(a, b: byte): byte; inline;
-var
-  temp: integer;
+{$hints off}
+function ByteNonLinearReflectInline(a, b: byte): byte; inline;
+var
+  temp: longword;
+  wa,wb: word;
 begin
   if b = 255 then
@@ -494 +743 @@
   else
   begin
-    temp := a * a div (255 - b);
+    wa := GammaExpansionTab[a];
+    wb := GammaExpansionTab[b];
+    temp := wa * wa div (not wb);
+    if temp >= 65535 then
+      Result := 255
+    else
+      Result := GammaCompressionTab[ temp ];
+  end;
+end;
+
+function ByteReflectInline(a, b: byte): byte; inline;
+var
+  temp: integer;
+begin
+  if b = 255 then
+    Result := 255
+  else
+  begin
+    temp := a * a div (not b);
     if temp > 255 then
       Result := 255
@@ -501 +768 @@
   end;
 end;
+{$hints on}
+
 
 procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
@@ -526 +795 @@
     c.green * (not destalpha)) shr 8;
   dest^.blue  := (ByteReflectInline(c.blue, dest^.blue) * destalpha +
+    c.blue * (not destalpha)) shr 8;
+  dest^.alpha := c.alpha;
+end;
+
+procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+var
+  destalpha: byte;
+begin
+  destalpha   := dest^.alpha;
+  dest^.red   := (ByteReflectInline(c.red, dest^.red) * destalpha +
+    c.red * (not destalpha)) shr 8;
+  dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha +
+    c.green * (not destalpha)) shr 8;
+  dest^.blue  := (ByteReflectInline(c.blue, dest^.blue) * destalpha +
+    c.blue * (not destalpha)) shr 8;
+
+  if (c.red > c.green) and (c.red > c.blue) then
+    dest^.alpha := c.red else
+  if (c.green > c.blue) then
+    dest^.alpha := c.green else
+    dest^.alpha := c.blue;
+  dest^.alpha := ApplyOpacity(GammaExpansionTab[dest^.alpha] shr 8,c.alpha);
+end;
+
+procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+var
+  destalpha: byte;
+begin
+  destalpha   := dest^.alpha;
+  dest^.red   := (ByteNonLinearReflectInline(dest^.red, c.red) * destalpha +
+    c.red * (not destalpha)) shr 8;
+  dest^.green := (ByteNonLinearReflectInline(dest^.green, c.green) * destalpha +
+    c.green * (not destalpha)) shr 8;
+  dest^.blue  := (ByteNonLinearReflectInline(dest^.blue, c.blue) * destalpha +
     c.blue * (not destalpha)) shr 8;
   dest^.alpha := c.alpha;
@@ -532 +835 @@
 {$hints off}
 function ByteOverlayInline(a, b: byte): byte; inline;
+var wa,wb: word;
+begin
+  wa := GammaExpansionTab[a];
+  wb := GammaExpansionTab[b];
+  if wa < 32768 then
+    Result := GammaCompressionTab[ (wa * wb) shr 15 ]
+  else
+    Result := GammaCompressionTab[ 65535 - ((not wa) * (not wb) shr 15) ];
+end;
+
+function ByteLinearOverlayInline(a, b: byte): byte; inline;
 begin
   if a < 128 then
     Result := (a * b) shr 7
   else
-    Result := 255 - ((255 - a) * (255 - b) shr 7);
+    Result := 255 - ((not a) * (not b) shr 7);
 end;
 
@@ -551 +865 @@
     c.green * (not destalpha)) shr 8;
   dest^.blue  := (ByteOverlayInline(dest^.blue, c.blue) * destalpha +
+    c.blue * (not destalpha)) shr 8;
+  dest^.alpha := c.alpha;
+end;
+
+procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+var
+  destalpha: byte;
+begin
+  destalpha   := dest^.alpha;
+  dest^.red   := (ByteLinearOverlayInline(dest^.red, c.red) * destalpha +
+    c.red * (not destalpha)) shr 8;
+  dest^.green := (ByteLinearOverlayInline(dest^.green, c.green) * destalpha +
+    c.green * (not destalpha)) shr 8;
+  dest^.blue  := (ByteLinearOverlayInline(dest^.blue, c.blue) * destalpha +
     c.blue * (not destalpha)) shr 8;
   dest^.alpha := c.alpha;

GraphicTest/BGRABitmap/bgracompressablebitmap.pas

@@ -1 @@
-unit bgracompressablebitmap;
+unit BGRACompressableBitmap;
 
 {$mode objfpc}{$H+}
 
 interface
+
+{ This unit contains the TBGRACompressableBitmap class, which
+  can be used to temporarily compress bitmaps in memory.
+  To use it, create an instance with the bitmap you want
+  to compress. You can then free the original bitmap because
+  TBGRACompressableBitmap contains all information necessary
+  to build it again. To construct again your bitmap, call
+  the GetBitmap function.
+
+  When you have your bitmap in TBGRACompressableBitmap,
+  you can call Compress function as many times as necessary
+  until all data is compressed. It does only a part of the
+  work at each call, so you can put it in a loop or in
+  a timer. When it's done, Compress returns false to
+  notify that it did nothing, which means you can
+  stop calling Compress.
+
+  In this implementation, the memory usage grows during
+  the compression process and is lower only after it is
+  finished. So it is recommended to compress one bitmap
+  at a time. }
 
 uses
@@ -16 +37 @@
      FWidth,FHeight: integer;
      FCaption: String;
+     FBounds: TRect;
      FCompressedDataArray: array of TMemoryStream;
      FUncompressedData: TMemoryStream;
@@ -25 +47 @@
      constructor Create(Source: TBGRABitmap);
      function GetBitmap: TBGRABitmap;
-     function Compress: boolean;
+     
+     //call Compress as many times as necessary
+     //when it returns false, it means that
+     //the image compression is finished
+     function Compress: boolean; 
+     
      function UsedMemory: Int64;
      procedure Assign(Source: TBGRABitmap);
@@ -38 +65 @@
 uses zstream, BGRABitmapTypes;
 
-const maxPartSize = 1048576;
+// size of each chunk treated by Compress function
+const maxPartSize = 524288;
 
 { TBGRACompressedBitmap }
@@ -63 +91 @@
 end;
 
+{ Constructs the bitmap again, decompressing if necessary.
+  After this, the image is not compressed anymore so the
+  memoy usage grows again and the access becomes fast
+  because there is no need to decompress anymore. }
 function TBGRACompressableBitmap.GetBitmap: TBGRABitmap;
+var UsedPart: TBGRABitmap;
+    UsedNbPixels: Integer;
 begin
   Decompress;
@@ -74 +108 @@
   result.Caption := FCaption;
   FUncompressedData.Position := 0;
-  FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel));
-end;
-
+  if (FBounds.Left <> 0) or (FBounds.Top <> 0)
+    or (FBounds.Right <> FWidth) or (FBounds.Bottom <> FHeight) then
+  begin
+    UsedNbPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top);
+    if UsedNbPixels > 0 then
+    begin
+      UsedPart := TBGRABitmap.Create(FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top);
+      FUncompressedData.Read(UsedPart.Data^,UsedPart.NbPixels*Sizeof(TBGRAPixel));
+      result.PutImage(FBounds.Left,FBounds.Top,UsedPart,dmSet);
+      UsedPart.Free;
+    end;
+  end else
+    FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel));
+end;
+
+{ Returns the total memory used by this object for storing bitmap data }
 function TBGRACompressableBitmap.UsedMemory: Int64;
 var i: integer;
@@ -86 +133 @@
 end;
 
+{ Do one compress step or return false }
 function TBGRACompressableBitmap.Compress: boolean;
 var comp: Tcompressionstream;
@@ -91 +139 @@
 begin
   if FCompressedDataArray = nil then FCompressionProgress := 0;
-  if FUncompressedData = nil then
+  if (FUncompressedData = nil) or (FUncompressedData.Size = 0) then
   begin
     result := false;
@@ -104 +152 @@
       partSize := maxPartSize else
         partSize := integer(FUncompressedData.Size - FCompressionProgress);
+
+    //use fast compression to avoid slowing down the application
     comp := Tcompressionstream.Create(clfastest,FCompressedDataArray[high(FCompressedDataArray)]);
     comp.write(partSize,sizeof(partSize));
@@ -136 +186 @@
 end;
 
+{ Free all data }
 procedure TBGRACompressableBitmap.FreeData;
 var i: integer;
@@ -148 +199 @@
 end;
 
+{ Copy a bitmap into this object. As it is copied, you need not
+  keep a copy of the source }
 procedure TBGRACompressableBitmap.Assign(Source: TBGRABitmap);
+var
+  UsedPart: TBGRABitmap;
+  NbUsedPixels: integer;
 begin
   FreeData;
@@ -161 +217 @@
   FHeight := Source.Height;
   FCaption := Source.Caption;
+  FBounds := Source.GetImageBounds([cRed,cGreen,cBlue,cAlpha]);
+  NbUsedPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top);
   FUncompressedData := TMemoryStream.Create;
-  FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel));
+  if NbUsedPixels = 0 then exit;
+
+  if (FBounds.Left <> 0) or (FBounds.Top <> 0)
+    or (FBounds.Right <> Source.Width) or (FBounds.Bottom <> Source.Height) then
+  begin
+    UsedPart := Source.GetPart(FBounds) as TBGRABitmap;
+    FUncompressedData.Write(UsedPart.Data^,NbUsedPixels*Sizeof(TBGRAPixel));
+    UsedPart.Free;
+  end else
+    FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel));
 end;
 

GraphicTest/BGRABitmap/bgradefaultbitmap.pas

@@ -29 +29 @@
 interface
 
+{ This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines,
+  and call functions from other units to perform advanced drawing functions. }
+
 uses
-  Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType;
+  Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType, FPImgCanv, BGRACanvas, BGRACanvas2D, FPWritePng;
 
 type
-  TBGRADefaultBitmap = class;
-  TBGRABitmapAny     = class of TBGRADefaultBitmap;
-
   { TBGRADefaultBitmap }
 
-  TBGRADefaultBitmap = class(TFPCustomImage)
+  TBGRADefaultBitmap = class(TBGRACustomBitmap)
   private
-    FEraseMode: boolean;
-    FBitmapModified: boolean; //if TBitmap has changed
-    FFontHeightSign: integer;
-    FFont: TFont;
+    { Bounds checking which are shared by drawing functions. These functions check
+      if the coordinates are visible and return true if it is the case, swap
+      coordinates if necessary and make them fit into the clipping rectangle }
+    function CheckHorizLineBounds(var x, y, x2: integer): boolean; inline;
+    function CheckVertLineBounds(var x, y, y2: integer; out delta: integer): boolean; inline;
+    function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline;
+    function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean; inline;
+    function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer): boolean; inline;
+    function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean;
+    function GetCanvasBGRA: TBGRACanvas;
+    function GetCanvas2D: TBGRACanvas2D;
+  protected
+    FRefCount: integer; //reference counter (not related to interface reference counter)
+
+    //Pixel data
+    FData:      PBGRAPixel;              //pointer to pixels
+    FWidth, FHeight, FNbPixels: integer; //dimensions
+    FDataModified: boolean;              //if data image has changed so TBitmap should be updated
+    FLineOrder: TRawImageLineOrder;
+    FClipRect:  TRect;                   //clipping (can be the whole image if there is no clipping)
+
+    //Scan
+    FScanPtr : PBGRAPixel;          //current scan address
+    FScanCurX,FScanCurY: integer;   //current scan coordinates
+
+    //LCL bitmap object
+    FBitmap:   TBitmap;
+    FBitmapModified: boolean;         //if TBitmap has changed so pixel data should be updated
+    FCanvasOpacity: byte;             //opacity used with standard canvas functions
+    FAlphaCorrectionNeeded: boolean;  //the alpha channel is not correct because standard functions do not
+                                      //take it into account
+
+    //FreePascal drawing routines
+    FCanvasFP: TFPImageCanvas;
+    FCanvasDrawModeFP: TDrawMode;
+    FCanvasPixelProcFP: procedure(x, y: integer; col: TBGRAPixel) of object;
+
+    //canvas-like with antialiasing and texturing
+    FCanvasBGRA: TBGRACanvas;
+    FCanvas2D: TBGRACanvas2D;
+
+    //drawing options
+    FEraseMode: boolean;      //when polygons are erased instead of drawn
+    FFont: TFont;             //font parameters
     FFontHeight: integer;
-    function GetCanvasAlphaCorrection: boolean;
-    procedure SetCanvasAlphaCorrection(const AValue: boolean);
-    procedure UpdateFont;
-    procedure SetFontHeight(AHeight: integer);
+    FFontHeightSign: integer; //sign correction
+
+    { Pen style can be defined by PenStyle property of by CustomPenStyle property.
+      When PenStyle property is assigned, CustomPenStyle property is assigned the actual
+      pen pattern. }
+    FCustomPenStyle:  TBGRAPenStyle;
+    FPenStyle: TPenStyle;
+
+    //Pixel data
+    function GetRefCount: integer; override;
+    function GetScanLine(y: integer): PBGRAPixel; override; //don't forget to call InvalidateBitmap after modifications
+    function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
+      AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean;
+    function GetDataPtr: PBGRAPixel; override;
+    procedure ClearTransparentPixels;
     function GetScanlineFast(y: integer): PBGRAPixel; inline;
-  protected
-    FBitmap:   TBitmap; //LCL bitmap object
-    FRefCount: integer; //reference counter
-
-    {Pixel data}
-    FData:      PBGRAPixel;
-    FWidth, FHeight, FNbPixels: integer;
-    FDataModified: boolean; //if data image has changed
-    FLineOrder: TRawImageLineOrder;
-    FCanvasOpacity: byte;
-    FAlphaCorrectionNeeded: boolean;
-
-    function GetScanLine(y: integer): PBGRAPixel;
-    //don't forget to call InvalidateBitmap after modifications
-    function GetBitmap: TBitmap;
-    function GetCanvas: TCanvas;
+    function GetLineOrder: TRawImageLineOrder; override;
+    function GetNbPixels: integer; override;
+    function GetWidth: integer; override;
+    function GetHeight: integer; override;
+
+    //LCL bitmap object
+    function GetBitmap: TBitmap; override;
+    function GetCanvas: TCanvas; override;
     procedure DiscardBitmapChange; inline;
-    procedure LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
-      AlwaysReplaceAlpha: boolean = False);
+    procedure DoAlphaCorrection;
+    procedure SetCanvasOpacity(AValue: byte); override;
+    function GetCanvasOpacity: byte; override;
+    function GetCanvasAlphaCorrection: boolean; override;
+    procedure SetCanvasAlphaCorrection(const AValue: boolean); override;
+
+    //FreePascal drawing routines
+    function GetCanvasFP: TFPImageCanvas; override;
+    procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override;
+    function GetCanvasDrawModeFP: TDrawMode; override;
 
     {Allocation routines}
@@ -78 +129 @@
 
     procedure Init; virtual;
+
     {TFPCustomImage}
     procedure SetInternalColor(x, y: integer; const Value: TFPColor); override;
@@ -84 +136 @@
     function GetInternalPixel(x, y: integer): integer; override;
 
-    {resample}
-    function FineResample(NewWidth, NewHeight: integer): TBGRADefaultBitmap;
-    function SimpleStretch(NewWidth, NewHeight: integer): TBGRADefaultBitmap;
-
-    function CheckEmpty: boolean;
-    function GetHasTransparentPixels: boolean;
-    function GetAverageColor: TColor;
-    function GetAveragePixel: TBGRAPixel;
-    procedure SetCanvasOpacity(AValue: byte);
-    function GetDataPtr: PBGRAPixel;
-    procedure DoAlphaCorrection;
-    procedure ClearTransparentPixels;
-
-    {Spline}
-    function Spline(y0, y1, y2, y3: single; t: single): single;
+    {Image functions}
+    function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap;
+    function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap;
+    function CheckEmpty: boolean; override;
+    function GetHasTransparentPixels: boolean; override;
+    function GetAverageColor: TColor; override;
+    function GetAveragePixel: TBGRAPixel; override;
+    function CreateAdaptedPngWriter: TFPWriterPNG;
+    function LoadAsBmp32(Str: TStream): boolean; override;
+
+    //drawing
+    function GetCustomPenStyle: TBGRAPenStyle; override;
+    procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override;
+    procedure SetPenStyle(const AValue: TPenStyle); override;
+    function GetPenStyle: TPenStyle; override;
+
+    procedure UpdateFont;
+    function GetFontHeight: integer; override;
+    procedure SetFontHeight(AHeight: integer); override;
+    function GetFontFullHeight: integer; override;
+    procedure SetFontFullHeight(AHeight: integer); override;
+    function GetFontPixelMetric: TFontPixelMetric; override;
+
+    function GetClipRect: TRect; override;
+    procedure SetClipRect(const AValue: TRect); override;
 
   public
-    Caption:   string;
-    FontName:  string;
-    FontStyle: TFontStyles;
-
     {Reference counter functions}
-    function NewReference: TBGRADefaultBitmap;
+    function NewReference: TBGRACustomBitmap;
     procedure FreeReference;
-    function GetUnique: TBGRADefaultBitmap;
-    function NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap;
-    function NewBitmap(Filename: string): TBGRADefaultBitmap;
+    function GetUnique: TBGRACustomBitmap;
 
     {TFPCustomImage override}
@@ -117 +173 @@
 
     {Constructors}
-    constructor Create;
-    constructor Create(ABitmap: TBitmap);
-    constructor Create(AWidth, AHeight: integer; Color: TColor);
-    constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel);
+    constructor Create; override;
+    constructor Create(ABitmap: TBitmap); override;
+    constructor Create(AWidth, AHeight: integer; Color: TColor); override;
+    constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); override;
+    constructor Create(AFilename: string); override;
+    constructor Create(AStream: TStream); override;
     destructor Destroy; override;
 
     {Loading functions}
-    procedure LoadFromFile(const filename: string);
-    procedure SaveToFile(const filename: string);
-    constructor Create(AFilename: string);
-    constructor Create(AStream: TStream);
-    procedure Assign(Bitmap: TBitmap); overload;
-    procedure Assign(MemBitmap: TBGRADefaultBitmap); overload;
+    function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; override;
+    function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; override;
+    function NewBitmap(Filename: string): TBGRACustomBitmap; override;
+
+    procedure LoadFromFile(const filename: string); override;
+    procedure SaveToFile(const filename: string); override;
+    procedure SaveToStreamAsPng(Str: TStream); override;
+    procedure Assign(ABitmap: TBitmap); override; overload;
+    procedure Assign(MemBitmap: TBGRACustomBitmap);override; overload;
+    procedure Serialize(AStream: TStream); override;
+    procedure Deserialize(AStream: TStream); override;
+    class procedure SerializeEmpty(AStream: TStream);
 
     {Pixel functions}
-    procedure SetPixel(x, y: integer; c: TColor); overload;
-    procedure SetPixel(x, y: integer; c: TBGRAPixel); overload;
-    procedure DrawPixel(x, y: integer; c: TBGRAPixel);
-    procedure FastBlendPixel(x, y: integer; c: TBGRAPixel);
-    procedure ErasePixel(x, y: integer; alpha: byte);
-    procedure AlphaPixel(x, y: integer; alpha: byte);
-    function GetPixel(x, y: integer): TBGRAPixel; overload;
-    function GetPixel(x, y: single): TBGRAPixel; overload;
-    function GetPixelCycle(x, y: integer): TBGRAPixel;
+    function PtInClipRect(x, y: integer): boolean; inline;
+    procedure SetPixel(x, y: integer; c: TColor); override;
+    procedure SetPixel(x, y: integer; c: TBGRAPixel); override;
+    procedure XorPixel(x, y: integer; c: TBGRAPixel); override;
+    procedure DrawPixel(x, y: integer; c: TBGRAPixel); override;
+    procedure DrawPixel(x, y: integer; ec: TExpandedPixel); override;
+    procedure FastBlendPixel(x, y: integer; c: TBGRAPixel); override;
+    procedure ErasePixel(x, y: integer; alpha: byte); override;
+    procedure AlphaPixel(x, y: integer; alpha: byte); override;
+    function GetPixel(x, y: integer): TBGRAPixel; override;
+    function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
+    function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
+    function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter;
+      repeatX: boolean; repeatY: boolean): TBGRAPixel; override; overload;
 
     {Line primitives}
-    procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
-    procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel);
-    procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel);
-    procedure AlphaHorizLine(x, y, x2: integer; alpha: byte);
-    procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel);
-    procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
-    procedure AlphaVertLine(x, y, y2: integer; alpha: byte);
-    procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
+    procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
+    procedure XorHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
+    procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
+    procedure DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel); override;
+    procedure DrawHorizLine(x, y, x2: integer; texture: IBGRAScanner); override;
+    procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
+    procedure AlphaHorizLine(x, y, x2: integer; alpha: byte); override;
+    procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel); override;
+    procedure XorVertLine(x, y, y2: integer; c: TBGRAPixel); override;
+    procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel); override;
+    procedure AlphaVertLine(x, y, y2: integer; alpha: byte); override;
+    procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel); override;
     procedure DrawHorizLineDiff(x, y, x2: integer; c, compare: TBGRAPixel;
-      maxDiff: byte);
+      maxDiff: byte); override;
 
     {Shapes}
-    procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean);
-    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel;
-      DrawLastPixel: boolean); overload;
-    procedure DrawPolyLineAntialias(points: array of TPoint; c: TBGRAPixel;
-      DrawLastPixel: boolean); overload;
-    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel;
-      dashLen: integer; DrawLastPixel: boolean); overload;
-    procedure DrawPolyLineAntialias(points: array of TPoint; c1, c2: TBGRAPixel;
-      dashLen: integer; DrawLastPixel: boolean); overload;
-    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel;
-      w: single; Closed: boolean); overload;
-    procedure DrawPolyLineAntialias(points: array of TPointF; c: TBGRAPixel;
-      w: single; Closed: boolean); overload;
-    procedure DrawPolygonAntialias(points: array of TPointF; c: TBGRAPixel;
-      w: single); overload;
-    procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte;
-      w: single; Closed: boolean); overload;
-    procedure FillPolyAntialias(points: array of TPointF; c: TBGRAPixel);
-    procedure ErasePolyAntialias(points: array of TPointF; alpha: byte);
-    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single);
-    procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
-    procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
-    procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode);
-    procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel;
-      mode: TDrawMode);
-    procedure Rectangle(x, y, x2, y2: integer; c: TColor);
-    procedure Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode);
-    procedure Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel;
-      mode: TDrawMode);
-    procedure Rectangle(r: TRect; c: TColor);
-    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel;
-      w: single); overload;
-    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel;
-      w: single; back: TBGRAPixel); overload;
-    procedure FillRect(r: TRect; c: TColor);
-    procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
-    procedure FillRect(x, y, x2, y2: integer; c: TColor);
-    procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode);
-    procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
-    procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte);
-    procedure RoundRect(X1, Y1, X2, Y2: integer; RX, RY: integer;
-      BorderColor, FillColor: TBGRAPixel);
-    procedure TextOut(x, y: integer; s: string; c: TBGRAPixel;
-      align: TAlignment); overload;
-    procedure TextOut(x, y: integer; s: string; c: TBGRAPixel); overload;
-    procedure TextOut(x, y: integer; s: string; c: TColor); overload;
-    procedure TextRect(ARect: TRect; x, y: integer; s: string;
-      style: TTextStyle; c: TBGRAPixel); overload;
-    function TextSize(s: string): TSize;
+    procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); override;
+
+    procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
+    procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
+    procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); override;
+    procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
+    procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
+
+    procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); override;
+    procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); override;
+    procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); override;
+
+    procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
+    procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
+    procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
+
+    procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True); override;
+    procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
+    procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
+    procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
+    procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
+
+    procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
+    procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
+    procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
+    procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
+    procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
+    procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode); override;
+    procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode); override;
+    procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel); override;
+    procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner); override;
+    procedure ErasePoly(const points: array of TPointF; alpha: byte); override;
+    procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); override;
+
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); override;
+    procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); override;
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); override;
+    procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); override;
+    procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); override;
+    procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); override;
+
+    procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
+    procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); override;
+    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); override;
+
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
+
+    procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
+    procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); override;
+    procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); override;
+    procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); override;
+    procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); override;
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); override;
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
+    procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); override;
+    procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); override;
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer;
+      BorderColor, FillColor: TBGRAPixel); override;
+
+    procedure TextOutAngle(x, y, orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextOutAngle(x, y, orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(x, y: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
+    function TextSize(s: string): TSize; override;
 
     {Spline}
-    function ComputeClosedSpline(points: array of TPointF): ArrayOfTPointF;
-    function ComputeOpenedSpline(points: array of TPointF): ArrayOfTPointF;
+    function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
+    function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
+
+    function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; override;
+    function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; override;
+    function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; override;
+    function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; override;
+
+    function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; override;
+    function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; override;
+    function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; override;
+
+    function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; override;
+    function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; override;
+    function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; override;
+    function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; override;
+    function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single): ArrayOfTPointF; override;
+    function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions): ArrayOfTPointF; override;
+    function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; override;
+    function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; override;
 
     {Filling}
-    procedure FillTransparent;
-    procedure ApplyGlobalOpacity(alpha: byte);
-    procedure Fill(c: TColor); overload;
-    procedure Fill(c: TBGRAPixel); overload;
-    procedure Fill(c: TBGRAPixel; start, Count: integer); overload;
-    procedure DrawPixels(c: TBGRAPixel; start, Count: integer);
-    procedure AlphaFill(alpha: byte); overload;
-    procedure AlphaFill(alpha: byte; start, Count: integer); overload;
-    procedure ReplaceColor(before, after: TColor); overload;
-    procedure ReplaceColor(before, after: TBGRAPixel); overload;
-    procedure ReplaceTransparent(after: TBGRAPixel); overload;
-    procedure FloodFill(X, Y: integer; Color: TBGRAPixel;
-      mode: TFloodfillMode; Tolerance: byte = 0);
-    procedure ParallelFloodFill(X, Y: integer; Dest: TBGRADefaultBitmap; Color: TBGRAPixel;
-      mode: TFloodfillMode; Tolerance: byte = 0);
+    procedure NoClip; override;
+    procedure Fill(texture: IBGRAScanner; mode: TDrawMode); override;
+    procedure Fill(texture: IBGRAScanner); override;
+    procedure Fill(c: TBGRAPixel; start, Count: integer); override;
+    procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override;
+    procedure AlphaFill(alpha: byte; start, Count: integer); override;
+    procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); override;
+    procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); override;
+    procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override;
+    procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override;
+    procedure ReplaceColor(before, after: TColor); override;
+    procedure ReplaceColor(before, after: TBGRAPixel); override;
+    procedure ReplaceTransparent(after: TBGRAPixel); override;
+    procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
+      mode: TFloodfillMode; Tolerance: byte = 0); override;
     procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
-      gammaColorCorrection: boolean = True; Sinus: Boolean=False);
+      gammaColorCorrection: boolean = True; Sinus: Boolean=False); override;
+    procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
+      gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+      Sinus: Boolean=False); override;
+    function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
+                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override;
+    procedure ScanMoveTo(X,Y: Integer); override;
+    function ScanNextPixel: TBGRAPixel; override;
+    function ScanAt(X,Y: Single): TBGRAPixel; override;
+    function IsScanPutPixelsDefined: boolean; override;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
 
     {Canvas drawing functions}
     procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
-      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual;
+      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
-      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual;
-    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual;
-    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); virtual;
-    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); virtual;
-    procedure DrawPart(ARect: TRect; Canvas: TCanvas; x, y: integer; Opaque: boolean);
-    function GetPart(ARect: TRect): TBGRADefaultBitmap;
-    procedure InvalidateBitmap; inline; //call if you modify with Scanline
-    procedure LoadFromBitmapIfNeeded;   //call to ensure that bitmap data is up to date
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
+    procedure InvalidateBitmap; override;         //call if you modify with Scanline
+    procedure LoadFromBitmapIfNeeded; override;   //call to ensure that bitmap data is up to date
 
     {BGRA bitmap functions}
-    procedure PutImage(x, y: integer; Source: TBGRADefaultBitmap; mode: TDrawMode);
-    procedure BlendImage(x, y: integer; Source: TBGRADefaultBitmap;
-      operation: TBlendOperation);
-    function Duplicate: TBGRADefaultBitmap; virtual;
-    function Equals(comp: TBGRADefaultBitmap): boolean;
-    function Equals(comp: TBGRAPixel): boolean;
+    procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
+    procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255); override;
+    procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); override;
+    procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); override;
+
+    function GetPart(ARect: TRect): TBGRACustomBitmap; override;
+    function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override;
+    function Duplicate(DuplicateProperties: Boolean = False) : TBGRACustomBitmap; override;
+    procedure CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
+    function Equals(comp: TBGRACustomBitmap): boolean; override;
+    function Equals(comp: TBGRAPixel): boolean; override;
+    function GetImageBounds(Channel: TChannel = cAlpha): TRect; override;
+    function GetImageBounds(Channels: TChannels): TRect; override;
+    function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override;
+
     function Resample(newWidth, newHeight: integer;
-      mode: TResampleMode = rmFineResample): TBGRADefaultBitmap;
-    procedure VerticalFlip;
-    procedure HorizontalFlip;
-    function RotateCW: TBGRADefaultBitmap;
-    function RotateCCW: TBGRADefaultBitmap;
-    procedure Negative;
-    procedure LinearNegative;
-    procedure SwapRedBlue;
-    procedure GrayscaleToAlpha;
-    procedure AlphaToGrayscale;
-    procedure ApplyMask(mask: TBGRADefaultBitmap);
-    function GetImageBounds(Channel: TChannel = cAlpha): TRect;
-    function MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
+      mode: TResampleMode = rmFineResample): TBGRACustomBitmap; override;
+    procedure VerticalFlip; override;
+    procedure HorizontalFlip; override;
+    function RotateCW: TBGRACustomBitmap; override;
+    function RotateCCW: TBGRACustomBitmap; override;
+    procedure Negative; override;
+    procedure LinearNegative; override;
+    procedure SwapRedBlue; override;
+    procedure GrayscaleToAlpha; override;
+    procedure AlphaToGrayscale; override;
+    procedure ApplyMask(mask: TBGRACustomBitmap); override;
+    procedure ApplyGlobalOpacity(alpha: byte); override;
 
     {Filters}
-    function FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap;
-    function FilterMedian(Option: TMedianOption): TBGRADefaultBitmap;
-    function FilterSmooth: TBGRADefaultBitmap;
-    function FilterSharpen: TBGRADefaultBitmap;
-    function FilterContour: TBGRADefaultBitmap;
+    function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; override;
+    function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; override;
+    function FilterSmooth: TBGRACustomBitmap; override;
+    function FilterSharpen: TBGRACustomBitmap; override;
+    function FilterContour: TBGRACustomBitmap; override;
     function FilterBlurRadial(radius: integer;
-      blurType: TRadialBlurType): TBGRADefaultBitmap;
+      blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; override;
     function FilterBlurMotion(distance: integer; angle: single;
-      oriented: boolean): TBGRADefaultBitmap;
-    function FilterCustomBlur(mask: TBGRADefaultBitmap): TBGRADefaultBitmap;
-    function FilterEmboss(angle: single): TBGRADefaultBitmap;
-    function FilterEmbossHighlight(FillSelection: boolean): TBGRADefaultBitmap;
-    function FilterGrayscale: TBGRADefaultBitmap;
-    function FilterNormalize(eachChannel: boolean = True): TBGRADefaultBitmap;
-    function FilterRotate(origin: TPointF; angle: single): TBGRADefaultBitmap;
-    function FilterSphere: TBGRADefaultBitmap;
-    function FilterCylinder: TBGRADefaultBitmap;
-    function FilterPlane: TBGRADefaultBitmap;
-
-    property Data: PBGRAPixel Read GetDataPtr;
-    property Width: integer Read FWidth;
-    property Height: integer Read FHeight;
-    property NbPixels: integer Read FNbPixels;
-    property Empty: boolean Read CheckEmpty;
-
-    property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;
-    property RefCount: integer Read FRefCount;
-    property Bitmap: TBitmap Read GetBitmap;
-    //don't forget to call InvalidateBitmap before if you changed something with Scanline
-    property HasTransparentPixels: boolean Read GetHasTransparentPixels;
-    property AverageColor: TColor Read GetAverageColor;
-    property AveragePixel: TBGRAPixel Read GetAveragePixel;
-    property LineOrder: TRawImageLineOrder Read FLineOrder;
-    property Canvas: TCanvas Read GetCanvas;
-    property CanvasOpacity: byte Read FCanvasOpacity Write SetCanvasOpacity;
-    property CanvasAlphaCorrection: boolean
-      Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
-
-    property FontHeight: integer Read FFontHeight Write SetFontHeight;
-  end;
-
-type
+      oriented: boolean): TBGRACustomBitmap; override;
+    function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; override;
+    function FilterEmboss(angle: single): TBGRACustomBitmap; override;
+    function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; override;
+    function FilterGrayscale: TBGRACustomBitmap; override;
+    function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; override;
+    function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; override;
+    function FilterSphere: TBGRACustomBitmap; override;
+    function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; override;
+    function FilterCylinder: TBGRACustomBitmap; override;
+    function FilterPlane: TBGRACustomBitmap; override;
+
+    property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
+    property Canvas2D: TBGRACanvas2D read GetCanvas2D;
+  end;
+
   { TBGRAPtrBitmap }
 
@@ -315 +437 @@
   public
     constructor Create(AWidth, AHeight: integer; AData: Pointer); overload;
-    function Duplicate: TBGRADefaultBitmap; override;
+    function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; override;
     procedure SetDataPtr(AData: Pointer);
     property LineOrder: TRawImageLineOrder Read FLineOrder Write FLineOrder;
@@ -323 +445 @@
   DefaultTextStyle: TTextStyle;
 
+procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
+  c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
+
 implementation
 
-uses FPWritePng, Math, LCLIntf, LCLType, BGRAPolygon, BGRAResample,
-  BGRAFilters, BGRABlend, BGRAPaintNet,
-  FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
+uses Math, LCLIntf, LCLType,
+  BGRABlend, BGRAFilters, BGRAPen, BGRAText, BGRATextFX, BGRAGradientScanner,
+  BGRAResample, BGRATransform, BGRAPolygon, BGRAPolygonAliased,
+  BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
 
 type
@@ -375 +502 @@
 end;
 
+function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle;
+begin
+  result := DuplicatePenStyle(FCustomPenStyle);
+end;
+
 procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean);
 begin
@@ -386 +518 @@
 end;
 
+procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode);
+begin
+  FCanvasDrawModeFP := AValue;
+  Case AValue of
+  dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel;
+  dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel;
+  dmXor: FCanvasPixelProcFP:= @XorPixel;
+  else FCanvasPixelProcFP := @SetPixel;
+  end;
+end;
+
+function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode;
+begin
+  Result:= FCanvasDrawModeFP;
+end;
+
+procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle);
+begin
+  FCustomPenStyle := DuplicatePenStyle(AValue);
+end;
+
+procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle);
+begin
+  Case AValue of
+  psSolid: CustomPenStyle := SolidPenStyle;
+  psDash: CustomPenStyle := DashPenStyle;
+  psDot: CustomPenStyle := DotPenStyle;
+  psDashDot: CustomPenStyle := DashDotPenStyle;
+  psDashDotDot: CustomPenStyle := DashDotDotPenStyle;
+  else CustomPenStyle := ClearPenStyle;
+  end;
+  FPenStyle := AValue;
+end;
+
+function TBGRADefaultBitmap.GetPenStyle: TPenStyle;
+begin
+  Result:= FPenStyle;
+end;
+
+{ Update font properties to internal TFont object }
 procedure TBGRADefaultBitmap.UpdateFont;
 begin
@@ -394 +566 @@
   if FFont.Height <> FFontHeight * FFontHeightSign then
     FFont.Height := FFontHeight * FFontHeightSign;
+  if FFont.Orientation <> FontOrientation then
+    FFont.Orientation := FontOrientation;
+  if FontQuality = fqSystemClearType then
+    FFont.Quality := fqCleartype
+  else
+    FFont.Quality := FontDefaultQuality;
 end;
 
 procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer);
 begin
-  if AHeight < 0 then
-    raise ERangeError.Create('Font height must be positive');
   FFontHeight := AHeight;
 end;
 
+function TBGRADefaultBitmap.GetFontFullHeight: integer;
+begin
+  if FontHeight < 0 then
+    result := -FontHeight
+  else
+    result := TextSize('Hg').cy;
+end;
+
+procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer);
+begin
+  if AHeight > 0 then
+    FontHeight := -AHeight
+  else
+    FontHeight := 1;
+end;
+
+function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric;
+var fxFont: TFont;
+begin
+  UpdateFont;
+  if FontQuality = fqSystem then
+    result := BGRAText.GetFontPixelMetric(FFont)
+  else
+  begin
+    FxFont := TFont.Create;
+    FxFont.Assign(FFont);
+    FxFont.Height := fxFont.Height*FontAntialiasingLevel;
+    Result:= BGRAText.GetFontPixelMetric(FxFont);
+    if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel);
+    if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel);
+    if Result.DescentLine <> -1 then Result.DescentLine:= round((Result.DescentLine-1)/FontAntialiasingLevel);
+    if Result.Lineheight <> -1 then Result.Lineheight:= round(Result.Lineheight/FontAntialiasingLevel);
+    if Result.xLine <> -1 then Result.xLine:= round(Result.xLine/FontAntialiasingLevel);
+  end;
+end;
+
+{ Get scanline without checking bounds nor updated from TBitmap }
 function TBGRADefaultBitmap.GetScanlineFast(y: integer): PBGRAPixel; inline;
 begin
@@ -423 +636 @@
 
 {------------------------- Reference counter functions ------------------------}
-
-function TBGRADefaultBitmap.NewReference: TBGRADefaultBitmap;
+{ These functions are not related to reference counting for interfaces :
+  a reference must be explicitely freed with FreeReference }
+
+{ Add a new reference and gives a pointer to it }
+function TBGRADefaultBitmap.NewReference: TBGRACustomBitmap;
 begin
   Inc(FRefCount);
@@ -430 +646 @@
 end;
 
+{ Free the current reference, and free the bitmap if necessary }
 procedure TBGRADefaultBitmap.FreeReference;
 begin
@@ -445 +662 @@
 end;
 
-function TBGRADefaultBitmap.GetUnique: TBGRADefaultBitmap;
+{ Make sure there is only one copy of the bitmap and return
+  the new pointer for it. If the bitmap is already unique,
+  then it does nothing }
+function TBGRADefaultBitmap.GetUnique: TBGRACustomBitmap;
 begin
   if FRefCount > 1 then
@@ -456 +676 @@
 end;
 
-function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap;
+{ Creates a new bitmap. Internally, it uses the same type so that if you
+  use an optimized version, you get a new bitmap with the same optimizations }
+function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap;
 var
   BGRAClass: TBGRABitmapAny;
@@ -466 +688 @@
 end;
 
-function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRADefaultBitmap;
+function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer;
+  Color: TBGRAPixel): TBGRACustomBitmap;
+var
+  BGRAClass: TBGRABitmapAny;
+begin
+  BGRAClass := TBGRABitmapAny(self.ClassType);
+  if BGRAClass = TBGRAPtrBitmap then
+    BGRAClass := TBGRADefaultBitmap;
+  Result      := BGRAClass.Create(AWidth, AHeight, Color);
+end;
+
+{ Creates a new bitmap and loads it contents from a file }
+function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRACustomBitmap;
 var
   BGRAClass: TBGRABitmapAny;
@@ -476 +710 @@
 {----------------------- TFPCustomImage override ------------------------------}
 
+{ Creates a new bitmap, initialize properties and bitmap data }
 constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer);
 begin
@@ -484 +719 @@
 end;
 
-
+{ Set the size of the current bitmap. All data is lost during the process }
 procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer);
 begin
@@ -497 +732 @@
   FHeight   := AHeight;
   FNbPixels := AWidth * AHeight;
-  if FNbPixels < 0 then
+  if FNbPixels < 0 then // 2 Go limit
     raise EOutOfMemory.Create('Image too big');
   FreeBitmap;
   ReallocData;
+  NoClip;
 end;
 
@@ -515 +751 @@
   Init;
   inherited Create(ABitmap.Width, ABitmap.Height);
-  LoadFromRawImage(ABitmap.RawImage,0);
+  Assign(ABitmap);
 end;
 
@@ -535 +771 @@
 begin
   FreeData;
+  FFont.Free;
   FBitmap.Free;
+  FCanvasFP.Free;
+  FCanvasBGRA.Free;
+  FCanvas2D.Free;
   inherited Destroy;
 end;
@@ -553 +793 @@
 end;
 
-procedure TBGRADefaultBitmap.Assign(Bitmap: TBitmap);
+procedure TBGRADefaultBitmap.Assign(ABitmap: TBitmap);
+var TempBmp: TBitmap;
+    ConvertOk: boolean;
 begin
   DiscardBitmapChange;
-  SetSize(Bitmap.Width, bitmap.Height);
-  GetImageFromCanvas(Bitmap.Canvas, 0, 0);
-end;
-
-procedure TBGRADefaultBitmap.Assign(MemBitmap: TBGRADefaultBitmap);
+  SetSize(ABitmap.Width, ABitmap.Height);
+  if not LoadFromRawImage(ABitmap.RawImage,0,False,False) then
+  begin //try to convert
+    TempBmp := TBitmap.Create;
+    TempBmp.Width := ABitmap.Width;
+    TempBmp.Height := ABitmap.Height;
+    TempBmp.Canvas.Draw(0,0,ABitmap);
+    ConvertOk := LoadFromRawImage(TempBmp.RawImage,0,False,False);
+    TempBmp.Free;
+    if not ConvertOk then
+      raise Exception.Create('Unable to convert image to 24 bit');
+  end;
+  If Empty then AlphaFill(255); // if bitmap seems to be empty, assume
+                                // it is an opaque bitmap without alpha channel
+end;
+
+procedure TBGRADefaultBitmap.Assign(MemBitmap: TBGRACustomBitmap);
 begin
   DiscardBitmapChange;
@@ -567 +821 @@
 end;
 
+procedure TBGRADefaultBitmap.Serialize(AStream: TStream);
+var lWidth,lHeight: integer;
+begin
+  lWidth := NtoLE(Width);
+  lHeight := NtoLE(Height);
+  AStream.Write(lWidth,sizeof(lWidth));
+  AStream.Write(lHeight,sizeof(lHeight));
+  AStream.Write(Data^, NbPixels*sizeof(TBGRAPixel));
+end;
+
+{$hints off}
+procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
+var lWidth,lHeight: integer;
+begin
+  AStream.Read(lWidth,sizeof(lWidth));
+  AStream.Read(lHeight,sizeof(lHeight));
+  lWidth := LEtoN(lWidth);
+  lHeight := LEtoN(lHeight);
+  SetSize(lWidth,lHeight);
+  AStream.Read(Data^, NbPixels*sizeof(TBGRAPixel));
+end;
+{$hints on}
+
+class procedure TBGRADefaultBitmap.SerializeEmpty(AStream: TStream);
+var zero: integer;
+begin
+  zero := 0;
+  AStream.Write(zero,sizeof(zero));
+  AStream.Write(zero,sizeof(zero));
+end;
+
 procedure TBGRADefaultBitmap.LoadFromFile(const filename: string);
 var
-  tempBitmap: TBGRADefaultBitmap;
-begin
-  if IsPaintDotNetFile(filename) then
-  begin
-    tempBitmap := LoadPaintDotNetFile(filename);
-    Assign(tempBitmap);
-    tempBitmap.Free;
-  end
-  else
-  begin
+  OldDrawMode: TDrawMode;
+begin
+  OldDrawMode := CanvasDrawModeFP;
+  CanvasDrawModeFP := dmSet;
+  ClipRect := rect(0,0,Width,Height);
+  try
     inherited LoadFromfile(filename);
+  finally
+    CanvasDrawModeFP := OldDrawMode;
     ClearTransparentPixels;
   end;
@@ -588 +871 @@
   ext:    string;
   writer: TFPCustomImageWriter;
-  pngWriter: TFPWriterPNG;
 begin
   ext := AnsiLowerCase(ExtractFileExt(filename));
 
+  { When saving to PNG, define some parameters so that the
+    image be readable by most programs }
   if ext = '.png' then
-  begin
-    pngWriter := TFPWriterPNG.Create;
-    pngWriter.Indexed := False;
-    pngWriter.UseAlpha := HasTransparentPixels;
-    pngWriter.WordSized := false;
-    writer    := pngWriter;
-  end else
-  if (ext='.xpm') and (Width*Height > 32768) then
+    writer := CreateAdaptedPngWriter
+  else
+  if (ext='.xpm') and (Width*Height > 32768) then //xpm is slow so avoid big images
     raise exception.Create('Image is too big to be saved as XPM') else
       writer := nil;
 
-  if writer <> nil then
+  if writer <> nil then //use custom writer if defined
   begin
     inherited SaveToFile(Filename, writer);
@@ -613 +892 @@
 end;
 
+procedure TBGRADefaultBitmap.SaveToStreamAsPng(Str: TStream);
+var writer: TFPWriterPNG;
+begin
+  writer := CreateAdaptedPngWriter;
+  SaveToStream(Str,writer);
+  writer.Free;
+end;
+
+{------------------------- Clipping -------------------------------}
+
+{ Check if a point is in the clipping rectangle }
+function TBGRADefaultBitmap.PtInClipRect(x, y: integer): boolean;
+begin
+  result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom);
+end;
+
+procedure TBGRADefaultBitmap.NoClip;
+begin
+  FClipRect := rect(0,0,FWidth,FHeight);
+end;
+
+procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner; mode: TDrawMode);
+begin
+  FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,mode);
+end;
+
+function TBGRADefaultBitmap.GetClipRect: TRect;
+begin
+  Result:= FClipRect;
+end;
+
+procedure TBGRADefaultBitmap.SetClipRect(const AValue: TRect);
+begin
+  IntersectRect(FClipRect,AValue,Rect(0,0,FWidth,FHeight));
+end;
+
 {-------------------------- Pixel functions -----------------------------------}
 
 procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TBGRAPixel);
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
-  (Scanline[y] +x)^ := c;
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  (GetScanlineFast(y) +x)^ := c;
   InvalidateBitmap;
 end;
 
+procedure TBGRADefaultBitmap.XorPixel(x, y: integer; c: TBGRAPixel);
+var
+  p : PDWord;
+begin
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  p := PDWord(GetScanlineFast(y) +x);
+  p^ := p^ xor DWord(c);
+  InvalidateBitmap;
+end;
+
 procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TColor);
 var
   p: PByte;
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
-  p  := PByte(Scanline[y] + x);
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  p  := PByte(GetScanlineFast(y) + x);
   p^ := c shr 16;
   Inc(p);
@@ -642 +968 @@
 procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; c: TBGRAPixel);
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
-  DrawPixelInline(Scanline[y] + x, c);
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c);
   InvalidateBitmap;
 end;
 
+procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; ec: TExpandedPixel);
+begin
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  DrawExpandedPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, ec);
+  InvalidateBitmap;
+end;
+
 procedure TBGRADefaultBitmap.FastBlendPixel(x, y: integer; c: TBGRAPixel);
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
-  FastBlendPixelInline(Scanline[y] + x, c);
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  FastBlendPixelInline(GetScanlineFast(y) + x, c);
   InvalidateBitmap;
 end;
@@ -658 +992 @@
 procedure TBGRADefaultBitmap.ErasePixel(x, y: integer; alpha: byte);
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
-  ErasePixelInline(Scanline[y] + x, alpha);
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
+  ErasePixelInline(GetScanlineFast(y) + x, alpha);
   InvalidateBitmap;
 end;
@@ -666 +1000 @@
 procedure TBGRADefaultBitmap.AlphaPixel(x, y: integer; alpha: byte);
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
-    exit;
+  if not PtInClipRect(x,y) then exit;
+  LoadFromBitmapIfNeeded;
   if alpha = 0 then
-    (Scanline[y] +x)^ := BGRAPixelTransparent
+    (GetScanlineFast(y) +x)^ := BGRAPixelTransparent
   else
-    (Scanline[y] +x)^.alpha := alpha;
+    (GetScanlineFast(y) +x)^.alpha := alpha;
   InvalidateBitmap;
 end;
@@ -677 +1011 @@
 function TBGRADefaultBitmap.GetPixel(x, y: integer): TBGRAPixel;
 begin
-  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
+  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then //it is possible to read pixels outside of the cliprect
     Result := BGRAPixelTransparent
   else
-    Result := (Scanline[y] + x)^;
+  begin
+    LoadFromBitmapIfNeeded;
+    Result := (GetScanlineFast(y) + x)^;
+  end;
 end;
 
 {$hints off}
-function TBGRADefaultBitmap.GetPixel(x, y: single): TBGRAPixel;
-var
-  ix, iy, w: integer;
-  rSum, gSum, bSum, rgbDiv: cardinal;
-  aSum, aDiv: cardinal;
+{ This function compute an interpolated pixel at floating point coordinates }
+function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
+var
+  ix, iy: integer;
+  w1,w2,w3,w4,alphaW: cardinal;
+  rSum, gSum, bSum: cardinal; //rgbDiv = aSum
+  aSum: cardinal;
   c:    TBGRAPixel;
   scan: PBGRAPixel;
-begin
-  if (frac(x) = 0) and (frac(y) = 0) then
-  begin
-    Result := GetPixel(round(x), round(y));
+  factX,factY: single;
+  iFactX,iFactY: integer;
+begin
+  ix := floor(x);
+  iy := floor(y);
+  factX := x-ix; //distance from integer coordinate
+  factY := y-iy;
+
+  //if the coordinate is integer, then call standard GetPixel function
+  if (factX = 0) and (factY = 0) then
+  begin
+    Result := GetPixel(ix, iy);
     exit;
   end;
   LoadFromBitmapIfNeeded;
+
+  rSum   := 0;
+  gSum   := 0;
+  bSum   := 0;
+  aSum   := 0;
+
+  //apply interpolation filter
+  factX := FineInterpolation( factX, AResampleFilter );
+  factY := FineInterpolation( factY, AResampleFilter );
+
+  iFactX := round(factX*256); //integer values for fractionnal part
+  iFactY := round(factY*256);
+
+  w4 := (iFactX*iFactY+127) shr 8;
+  w3 := iFactY-w4;
+  w1 := (256-iFactX)-w3;
+  w2 := iFactX-w4;
+
+  { For each pixel around the coordinate, compute
+    the weight for it and multiply values by it before
+    adding to the sum }
+  if (iy >= 0) and (iy < Height) then
+  begin
+    scan := GetScanlineFast(iy);
+
+    if (ix >= 0) and (ix < Width) then
+    begin
+      c      := (scan + ix)^;
+      alphaW := c.alpha * w1;
+      aSum   += alphaW;
+      rSum   += c.red * alphaW;
+      gSum   += c.green * alphaW;
+      bSum   += c.blue * alphaW;
+    end;
+
+    Inc(ix);
+    if (ix >= 0) and (ix < Width) then
+    begin
+      c      := (scan + ix)^;
+      alphaW := c.alpha * w2;
+      aSum   += alphaW;
+      rSum   += c.red * alphaW;
+      gSum   += c.green * alphaW;
+      bSum   += c.blue * alphaW;
+    end;
+  end
+  else
+  begin
+    Inc(ix);
+  end;
+
+  Inc(iy);
+  if (iy >= 0) and (iy < Height) then
+  begin
+    scan := GetScanlineFast(iy);
+
+    if (ix >= 0) and (ix < Width) then
+    begin
+      c      := (scan + ix)^;
+      alphaW := c.alpha * w4;
+      aSum   += alphaW;
+      rSum   += c.red * alphaW;
+      gSum   += c.green * alphaW;
+      bSum   += c.blue * alphaW;
+    end;
+
+    Dec(ix);
+    if (ix >= 0) and (ix < Width) then
+    begin
+      c      := (scan + ix)^;
+      alphaW := c.alpha * w3;
+      aSum   += alphaW;
+      rSum   += c.red * alphaW;
+      gSum   += c.green * alphaW;
+      bSum   += c.blue * alphaW;
+    end;
+  end;
+
+  if aSum = 0 then //if there is no alpha
+    Result := BGRAPixelTransparent
+  else
+  begin
+    Result.red   := (rSum + aSum shr 1) div aSum;
+    Result.green := (gSum + aSum shr 1) div aSum;
+    Result.blue  := (bSum + aSum shr 1) div aSum;
+    Result.alpha := (aSum + 128) shr 8;
+  end;
+end;
+
+{ Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions }
+function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
+var
+  ix, iy, ixMod1,ixMod2: integer;
+  w1,w2,w3,w4,alphaW: cardinal;
+  bSum, gSum, rSum, rgbDiv: cardinal;
+  aSum: cardinal;
+
+  c:    TBGRAPixel;
+  scan: PBGRAPixel;
+  factX,factY: single;
+  iFactX,iFactY: integer;
+begin
+  ix := floor(x);
+  iy := floor(y);
+  factX := x-ix;
+  factY := y-iy;
+
+  if (factX = 0) and (factY = 0) then
+  begin
+    Result := GetPixelCycle(ix, iy);
+    exit;
+  end;
+  LoadFromBitmapIfNeeded;
+
+  factX := FineInterpolation( factX, AResampleFilter );
+  factY := FineInterpolation( factY, AResampleFilter );
+
+  iFactX := round(factX*256);
+  iFactY := round(factY*256);
+
+
+  w4 := (iFactX*iFactY+127) shr 8;
+  w3 := iFactY-w4;
+  w1 := (256-iFactX)-w3;
+  w2 := iFactX-w4;
 
   rSum   := 0;
@@ -703 +1175 @@
   bSum   := 0;
   rgbDiv := 0;
+
   aSum   := 0;
-  aDiv   := 0;
-
-  ix := floor(x);
-  iy := floor(y);
-
-  if (iy >= 0) and (iy < Height) then
-  begin
-    scan := GetScanlineFast(iy);
-
-    if (ix >= 0) and (ix < Width) then
-    begin
-      c      := (scan + ix)^;
-      w      := round((1 - (x - ix)) * (1 - (y - iy)) * 255);
-      aDiv   += w;
-      aSum   += c.alpha * w;
-      c.alpha := c.alpha * w div 255;
-      rSum   += c.red * c.alpha;
-      gSum   += c.green * c.alpha;
-      bSum   += c.blue * c.alpha;
-      rgbDiv += c.alpha;
-    end;
-
-    Inc(ix);
-    if (ix >= 0) and (ix < Width) then
-    begin
-      c      := (scan + ix)^;
-      w      := round((1 - (ix - x)) * (1 - (y - iy)) * 255);
-      aDiv   += w;
-      aSum   += c.alpha * w;
-      c.alpha := c.alpha * w div 255;
-      rSum   += c.red * c.alpha;
-      gSum   += c.green * c.alpha;
-      bSum   += c.blue * c.alpha;
-      rgbDiv += c.alpha;
-    end;
-  end
-  else
-    Inc(ix);
+
+  scan := GetScanlineFast(PositiveMod(iy,Height));
+
+  ixMod1 := PositiveMod(ix,Width); //apply cycle
+  c      := (scan + ixMod1)^;
+  alphaW := c.alpha * w1;
+  aSum   += alphaW;
+
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  rgbDiv += alphaW;
+
+  Inc(ix);
+  ixMod2 := PositiveMod(ix,Width); //apply cycle
+  c      := (scan + ixMod2)^;
+  alphaW := c.alpha * w2;
+  aSum   += alphaW;
+
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  rgbDiv += alphaW;
 
   Inc(iy);
-  if (iy >= 0) and (iy < Height) then
-  begin
-    scan := GetScanlineFast(iy);
-
-    if (ix >= 0) and (ix < Width) then
-    begin
-      c      := (scan + ix)^;
-      w      := round((1 - (ix - x)) * (1 - (iy - y)) * 255);
-      aDiv   += w;
-      aSum   += c.alpha * w;
-      c.alpha := c.alpha * w div 255;
-      rSum   += c.red * c.alpha;
-      gSum   += c.green * c.alpha;
-      bSum   += c.blue * c.alpha;
-      rgbDiv += c.alpha;
-    end;
-
-    Dec(ix);
-    if (ix >= 0) and (ix < Width) then
-    begin
-      c      := (scan + ix)^;
-      w      := round((1 - (x - ix)) * (1 - (iy - y)) * 255);
-      aDiv   += w;
-      aSum   += c.alpha * w;
-      c.alpha := c.alpha * w div 255;
-      rSum   += c.red * c.alpha;
-      gSum   += c.green * c.alpha;
-      bSum   += c.blue * c.alpha;
-      rgbDiv += c.alpha;
-    end;
-  end;
-
-  if (rgbDiv = 0) or (aDiv = 0) then
+  scan := GetScanlineFast(PositiveMod(iy,Height));
+
+  c      := (scan + ixMod2)^;
+  alphaW := c.alpha * w4;
+  aSum   += alphaW;
+
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  rgbDiv += alphaW;
+
+  c      := (scan + ixMod1)^;
+  alphaW := c.alpha * w3;
+  aSum   += alphaW;
+
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  rgbDiv += alphaW;
+
+  if (rgbDiv = 0) then
     Result := BGRAPixelTransparent
   else
@@ -783 +1229 @@
     Result.green := (gSum + rgbDiv shr 1) div rgbDiv;
     Result.blue  := (bSum + rgbDiv shr 1) div rgbDiv;
-    Result.alpha := (aSum + aDiv shr 1) div aDiv;
-  end;
+    Result.alpha := (aSum + 128) shr 8;
+  end;
+end;
+
+function TBGRADefaultBitmap.GetPixelCycle(x, y: single;
+  AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean
+  ): TBGRAPixel;
+var
+  alpha: byte;
+begin
+  alpha := 255;
+  if not repeatX then
+  begin
+    if (x < -0.5) or (x > Width-0.5) then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    if x < 0 then
+      alpha := round((0.5+x)*510)
+    else
+    if x > Width-1 then
+      alpha := round((Width-0.5-x)*510);
+  end;
+  if not repeatY then
+  begin
+    if (y < -0.5) or (y > Height-0.5) then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    if y < 0 then
+      alpha := round((0.5+y)*2*alpha)
+    else
+    if y > Height-1 then
+      alpha := round((Height-0.5-y)*2*alpha);
+  end;
+  result := GetPixelCycle(x,y,AResampleFilter);
+  if alpha<>255 then
+    result.alpha := ApplyOpacity(result.alpha,alpha);
 end;
 
 {$hints on}
-
-function TBGRADefaultBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
-begin
-  if (Width = 0) or (Height = 0) then
-    Result := BGRAPixelTransparent
-  else
-  begin
-    x := x mod Width;
-    if x < 0 then
-      Inc(x, Width);
-    y := y mod Height;
-    if y < 0 then
-      Inc(y, Height);
-    Result := (Scanline[y] + x)^;
-  end;
-end;
 
 procedure TBGRADefaultBitmap.InvalidateBitmap;
@@ -827 +1295 @@
 end;
 
-procedure TBGRADefaultBitmap.LoadFromRawImage(ARawImage: TRawImage;
-  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean);
-var
-  psource_byte, pdest_byte: PByte;
-  n, x, y, delta: integer;
-  psource_pix, pdest_pix: PBGRAPixel;
-  sourceval:      longword;
-  OpacityOrMask:  longword;
+function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas;
+begin
+  {$warnings off}
+  if FCanvasFP = nil then
+    FCanvasFP := TFPImageCanvas.Create(self);
+  {$warnings on}
+  result := FCanvasFP;
+end;
+
+{ Load raw image data. It must be 32bit or 24 bits per pixel}
+function TBGRADefaultBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+var
+  psource_byte, pdest_byte,
+  psource_first, pdest_first: PByte;
+  psource_delta, pdest_delta: integer;
+
+  n: integer;
+  mustSwapRedBlue, mustReverse32: boolean;
+
+  procedure CopyAndSwapIfNecessary(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
+  begin
+    if mustReverse32 then
+    begin
+      while count > 0 do
+      begin
+        pdest^.blue := psrc^.alpha;
+        pdest^.green := psrc^.red;
+        pdest^.red := psrc^.green;
+        pdest^.alpha := psrc^.blue;
+        dec(count);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+    if mustSwapRedBlue then
+    begin
+      while count > 0 do
+      begin
+        pdest^.red := psrc^.blue;
+        pdest^.green := psrc^.green;
+        pdest^.blue := psrc^.red;
+        pdest^.alpha := psrc^.alpha;
+        dec(count);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+      move(psrc^,pdest^,count*sizeof(TBGRAPixel));
+  end;
+
+  procedure CopyRGBAndSwapIfNecessary(psrc: PByte; pdest: PBGRAPixel; count: integer);
+  begin
+    if mustSwapRedBlue then
+    begin
+      while count > 0 do
+      begin
+        pdest^.blue := (psource_byte+2)^;
+        pdest^.green := (psource_byte+1)^;
+        pdest^.red := psource_byte^;
+        pdest^.alpha := DefaultOpacity;
+        inc(psrc,3);
+        inc(pdest);
+        dec(count);
+      end;
+    end else
+    begin
+      while count > 0 do
+      begin
+        PWord(pdest)^ := PWord(psource_byte)^;
+        pdest^.red := (psource_byte+2)^;
+        pdest^.alpha := DefaultOpacity;
+        inc(psrc,3);
+        inc(pdest);
+        dec(count);
+      end;
+    end;
+  end;
+
+  procedure CopyAndSwapIfNecessaryAndSetAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
+  begin
+    if mustReverse32 then
+    begin
+      while count > 0 do
+      begin
+        pdest^.blue := psrc^.alpha;
+        pdest^.green := psrc^.red;
+        pdest^.red := psrc^.green;
+        pdest^.alpha := DefaultOpacity; //use default opacity
+        inc(psrc);
+        inc(pdest);
+        dec(count);
+      end;
+    end else
+    if mustSwapRedBlue then
+    begin
+      while count > 0 do
+      begin
+        pdest^.red := psrc^.blue;
+        pdest^.green := psrc^.green;
+        pdest^.blue := psrc^.red;
+        pdest^.alpha := DefaultOpacity; //use default opacity
+        inc(psrc);
+        inc(pdest);
+        dec(count);
+      end;
+    end else
+    begin
+      while count > 0 do
+      begin
+        PWord(pdest)^ := PWord(psource_byte)^;
+        pdest^.red := psrc^.red;
+        pdest^.alpha := DefaultOpacity; //use default opacity
+        inc(psrc);
+        inc(pdest);
+        dec(count);
+      end;
+    end;
+  end;
+
+  procedure CopyAndSwapIfNecessaryAndReplaceAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
+  var OpacityOrMask, OpacityAndMask, sourceval: Longword;
+  begin
+    OpacityOrMask := NtoLE(longword(DefaultOpacity) shl 24);
+    OpacityAndMask := NtoLE($FFFFFF);
+    if mustReverse32 then
+    begin
+      OpacityAndMask := NtoBE($FFFFFF);
+      while count > 0 do
+      begin
+        sourceval := plongword(psrc)^ and OpacityAndMask;
+        if (sourceval <> 0) and (psrc^.blue{=alpha} = 0) then //if not black but transparent
+        begin
+          pdest^.blue := psrc^.alpha;
+          pdest^.green := psrc^.red;
+          pdest^.red := psrc^.green;
+          pdest^.alpha := DefaultOpacity; //use default opacity
+        end
+        else
+        begin
+          pdest^.blue := psrc^.alpha;
+          pdest^.green := psrc^.red;
+          pdest^.red := psrc^.green;
+          pdest^.alpha := psrc^.blue;
+        end;
+        dec(count);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+    if mustSwapRedBlue then
+    begin
+      while count > 0 do
+      begin
+        sourceval := plongword(psrc)^ and OpacityAndMask;
+        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
+        begin
+          pdest^.red := psrc^.blue;
+          pdest^.green := psrc^.green;
+          pdest^.blue := psrc^.red;
+          pdest^.alpha := DefaultOpacity; //use default opacity
+        end
+        else
+        begin
+          pdest^.red := psrc^.blue;
+          pdest^.green := psrc^.green;
+          pdest^.blue := psrc^.red;
+          pdest^.alpha := psrc^.alpha;
+        end;
+        dec(count);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+    begin
+      while count > 0 do
+      begin
+        sourceval := plongword(psrc)^ and OpacityAndMask;
+        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
+          plongword(pdest)^ := sourceval or OpacityOrMask //use default opacity
+        else
+          pdest^ := psrc^;
+        dec(count);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end;
+  end;
+
 begin
   if (ARawImage.Description.Width <> cardinal(Width)) or
     (ARawImage.Description.Height <> cardinal(Height)) then
-  begin
     raise Exception.Create('Bitmap size is inconsistant');
-  end
+
+  DiscardBitmapChange;
+  if (Height=0) or (Width=0) then
+  begin
+    result := true;
+    exit;
+  end;
+
+  if ARawImage.Description.LineOrder = riloTopToBottom then
+  begin
+    psource_first := ARawImage.Data;
+    psource_delta := ARawImage.Description.BytesPerLine;
+  end else
+  begin
+    psource_first := ARawImage.Data + (ARawImage.Description.Height-1) * ARawImage.Description.BytesPerLine;
+    psource_delta := -ARawImage.Description.BytesPerLine;
+  end;
+
+  if ((ARawImage.Description.RedShift = 0) and
+    (ARawImage.Description.BlueShift = 16) and
+    (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+    ((ARawImage.Description.RedShift = 24) and
+    (ARawImage.Description.BlueShift = 8) and
+    (ARawImage.Description.ByteOrder = riboMSBFirst)) then
+    mustSwapRedBlue:= true
   else
+  begin
+    mustSwapRedBlue:= false;
+    if ((ARawImage.Description.RedShift = 8) and
+      (ARawImage.Description.GreenShift = 16) and
+      (ARawImage.Description.BlueShift = 24) and
+      (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+      ((ARawImage.Description.RedShift = 16) and
+      (ARawImage.Description.GreenShift = 8) and
+      (ARawImage.Description.BlueShift = 0) and
+      (ARawImage.Description.ByteOrder = riboMSBFirst)) then
+        mustReverse32 := true
+      else
+        mustReverse32 := false;
+  end;
+
+  if self.LineOrder = riloTopToBottom then
+  begin
+    pdest_first := PByte(self.Data);
+    pdest_delta := self.Width*sizeof(TBGRAPixel);
+  end else
+  begin
+    pdest_first := PByte(self.Data) + (self.Height-1)*self.Width*sizeof(TBGRAPixel);
+    pdest_delta := -self.Width*sizeof(TBGRAPixel);
+  end;
+
+  { 32 bits per pixel }
   if (ARawImage.Description.BitsPerPixel = 32) and
-    (ARawImage.DataSize = longword(NbPixels) * sizeof(TBGRAPixel)) then
-  begin
+    (ARawImage.DataSize >= longword(NbPixels) * 4) then
+  begin
+    { If there is an alpha channel }
     if (ARawImage.Description.AlphaPrec = 8) and not AlwaysReplaceAlpha then
     begin
-      psource_pix := PBGRAPixel(ARawImage.Data);
-      pdest_pix   := FData;
       if DefaultOpacity = 0 then
-        move(psource_pix^, pdest_pix^, NbPixels * sizeof(TBGRAPixel))
+      begin
+        if ARawImage.Description.LineOrder = FLineOrder then
+          CopyAndSwapIfNecessary(PBGRAPixel(ARawImage.Data), FData, NbPixels) else
+        begin
+          psource_byte := psource_first;
+          pdest_byte := pdest_first;
+          for n := FHeight-1 downto 0 do
+          begin
+            CopyAndSwapIfNecessary(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
+            inc(psource_byte, psource_delta);
+            inc(pdest_byte, pdest_delta);
+          end;
+        end;
+      end
       else
       begin
-        OpacityOrMask := longword(DefaultOpacity) shl 24;
-        for n := NbPixels - 1 downto 0 do
+        psource_byte := psource_first;
+        pdest_byte := pdest_first;
+        for n := FHeight-1 downto 0 do
         begin
-          sourceval := plongword(psource_pix)^ and $FFFFFF;
-          if (sourceval <> 0) and (psource_pix^.alpha = 0) then
-          begin
-            plongword(pdest_pix)^ := sourceval or OpacityOrMask;
-            InvalidateBitmap;
-          end
-          else
-            pdest_pix^ := psource_pix^;
-          Inc(pdest_pix);
-          Inc(psource_pix);
+          CopyAndSwapIfNecessaryAndReplaceAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
+          inc(psource_byte, psource_delta);
+          inc(pdest_byte, pdest_delta);
         end;
       end;
     end
     else
-    begin
-      psource_byte := ARawImage.Data;
-      pdest_byte   := PByte(FData);
-      for n := NbPixels - 1 downto 0 do
+    begin { If there isn't any alpha channel }
+      psource_byte := psource_first;
+      pdest_byte := pdest_first;
+      for n := FHeight-1 downto 0 do
       begin
-        PWord(pdest_byte)^ := PWord(psource_byte)^;
-        Inc(pdest_byte, 2);
-        Inc(psource_byte, 2);
-        pdest_byte^ := psource_byte^;
-        Inc(pdest_byte);
-        Inc(psource_byte, 2);
-        pdest_byte^ := DefaultOpacity;
-        Inc(pdest_byte);
+        CopyAndSwapIfNecessaryAndSetAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
+        inc(psource_byte, psource_delta);
+        inc(pdest_byte, pdest_delta);
       end;
     end;
   end
   else
+  { 24 bit per pixel }
   if (ARawImage.Description.BitsPerPixel = 24) then
   begin
-    psource_byte := ARawImage.Data;
-    pdest_byte := PByte(FData);
-    delta := integer(ARawImage.Description.BytesPerLine) - FWidth * 3;
-    for y := 0 to FHeight - 1 do
-    begin
-      for x := 0 to FWidth - 1 do
-      begin
-        PWord(pdest_byte)^ := PWord(psource_byte)^;
-        Inc(pdest_byte, 2);
-        Inc(psource_byte, 2);
-        pdest_byte^ := psource_byte^;
-        Inc(pdest_byte);
-        Inc(psource_byte);
-        pdest_byte^ := DefaultOpacity;
-        Inc(pdest_byte);
-      end;
-      Inc(psource_byte, delta);
+    psource_byte := psource_first;
+    pdest_byte := pdest_first;
+    for n := FHeight-1 downto 0 do
+    begin
+      CopyRGBAndSwapIfNecessary(psource_byte, PBGRAPixel(pdest_byte), FWidth);
+      inc(psource_byte, psource_delta);
+      inc(pdest_byte, pdest_delta);
     end;
   end
   else
-    raise Exception.Create('Invalid raw image format (' + IntToStr(
-      ARawImage.Description.Depth) + ' found)');
-  DiscardBitmapChange;
-  if (ARawImage.Description.RedShift = 0) and
-    (ARawImage.Description.BlueShift = 16) then
-    SwapRedBlue;
-  if ARawImage.Description.LineOrder <> FLineOrder then
-    VerticalFlip;
+  begin
+    if RaiseErrorOnInvalidPixelFormat then
+      raise Exception.Create('Invalid raw image format (' + IntToStr(
+        ARawImage.Description.Depth) + ' found)') else
+    begin
+      result := false;
+      exit;
+    end;
+  end;
+
+  InvalidateBitmap;
+  result := true;
 end;
 
@@ -938 +1632 @@
 end;
 
+{ Initialize properties }
 procedure TBGRADefaultBitmap.Init;
-var
-  HeightP1, HeightM1: integer;
 begin
   FRefCount  := 1;
   FBitmap    := nil;
+  FCanvasFP  := nil;
+  FCanvasBGRA := nil;
+  CanvasDrawModeFP := dmDrawWithTransparency;
   FData      := nil;
   FWidth     := 0;
@@ -951 +1647 @@
   FAlphaCorrectionNeeded := False;
   FEraseMode := False;
+  FillMode := fmWinding;
 
   FFont     := TFont.Create;
   FontName  := 'Arial';
   FontStyle := [];
+  FontAntialias := False;
   FFontHeight := 20;
-  FFontHeightSign := 1;
-  HeightP1  := TextSize('Hg').cy;
-  FFontHeightSign := -1;
-  HeightM1  := TextSize('Hg').cy;
-
-  if HeightP1 > HeightM1 then
-    FFontHeightSign := 1
-  else
-    FFontHeightSign := -1;
+  FFontHeightSign := GetFontHeightSign(FFont);
+
+  PenStyle := psSolid;
+  LineCap := pecRound;
+  JoinStyle := pjsBevel;
+  JoinMiterLimit := 2;
+  ResampleFilter := rfHalfCosine;
+  ScanInterpolationFilter := rfLinear;
+  ScanOffset := Point(0,0);
 end;
 
 procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor);
-var
-  p: PByte;
-begin
-  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
-    exit;
-  p  := PByte(Scanline[y] + x);
-  p^ := Value.blue shr 8;
-  Inc(p);
-  p^ := Value.green shr 8;
-  Inc(p);
-  p^ := Value.red shr 8;
-  Inc(p);
-  p^ := Value.alpha shr 8;
+begin
+  FCanvasPixelProcFP(x,y, FPColorToBGRA(Value));
+end;
+
+function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
+begin
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
+  result := BGRAToFPColor((Scanline[y] + x)^);
+end;
+
+procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
+var
+  c: TFPColor;
+begin
+  if not PtInClipRect(x,y) then exit;
+  c  := Palette.Color[Value];
+  (Scanline[y] + x)^ := FPColorToBGRA(c);
   InvalidateBitmap;
 end;
 
-{$hints off}
-function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
-var
-  p: PByte;
-  v: byte;
-begin
-  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
-    exit;
-  p := PByte(Scanline[y] + x);
-  v := p^;
-  Result.blue := v shl 8 + v;
-  Inc(p);
-  v := p^;
-  Result.green := v shl 8 + v;
-  Inc(p);
-  v := p^;
-  Result.red := v shl 8 + v;
-  Inc(p);
-  v := p^;
-  Result.alpha := v shl 8 + v;
-end;
-
-{$hints on}
-
-procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
-var
-  p: PByte;
+function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
+var
   c: TFPColor;
 begin
-  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
-    exit;
-  c  := Palette.Color[Value];
-  p  := PByte(Scanline[y] + x);
-  p^ := c.blue shr 8;
-  Inc(p);
-  p^ := c.green shr 8;
-  Inc(p);
-  p^ := c.red shr 8;
-  Inc(p);
-  p^ := c.alpha shr 8;
-  InvalidateBitmap;
-end;
-
-{$hints off}
-function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
-var
-  p: PByte;
-  v: byte;
-  c: TFPColor;
-begin
-  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
-    exit;
-  p      := PByte(Scanline[y] + x);
-  v      := p^;
-  c.blue := v shl 8 + v;
-  Inc(p);
-  v := p^;
-  c.green := v shl 8 + v;
-  Inc(p);
-  v     := p^;
-  c.red := v shl 8 + v;
-  Inc(p);
-  v      := p^;
-  c.alpha := v shl 8 + v;
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
+  c := BGRAToFPColor((Scanline[y] + x)^);
   Result := palette.IndexOf(c);
 end;
-
-{$hints on}
 
 procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
@@ -1086 +1728 @@
 {---------------------------- Line primitives ---------------------------------}
 
-procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
+function TBGRADefaultBitmap.CheckHorizLineBounds(var x,y,x2: integer): boolean; inline;
 var
   temp: integer;
@@ -1096 +1738 @@
     x2   := temp;
   end;
-  if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
+  if (x >= FClipRect.Right) or (x2 < FClipRect.Left) or (y < FClipRect.Top) or (y >= FClipRect.Bottom) then
+  begin
+    result := false;
     exit;
-  if x < 0 then
-    x := 0;
-  if x2 >= Width then
-    x2 := Width - 1;
+  end;
+  if x < FClipRect.Left then
+    x := FClipRect.Left;
+  if x2 >= FClipRect.Right then
+    x2 := FClipRect.Right - 1;
+  result := true;
+end;
+
+procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
   FillInline(scanline[y] + x, c, x2 - x + 1);
   InvalidateBitmap;
 end;
 
+procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: integer; c: TBGRAPixel);
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
+  XorInline(scanline[y] + x, c, x2 - x + 1);
+  InvalidateBitmap;
+end;
+
 procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; c: TBGRAPixel);
-var
-  temp: integer;
-begin
-  if (x2 < x) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 >= Width then
-    x2 := Width - 1;
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
   DrawPixelsInline(scanline[y] + x, c, x2 - x + 1);
   InvalidateBitmap;
 end;
 
+procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel
+  );
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
+  DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1);
+  InvalidateBitmap;
+end;
+
+procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer;
+  texture: IBGRAScanner);
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
+  texture.ScanMoveTo(x,y);
+  ScannerPutPixels(texture,scanline[y] + x, x2 - x + 1,dmDrawWithTransparency);
+  InvalidateBitmap;
+end;
+
 procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel);
-var
-  temp: integer;
-begin
-  if (x2 < x) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 >= Width then
-    x2 := Width - 1;
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
   FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1);
   InvalidateBitmap;
@@ -1147 +1796 @@
 
 procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: integer; alpha: byte);
-var
-  temp: integer;
 begin
   if alpha = 0 then
@@ -1155 +1802 @@
     exit;
   end;
-  if (x2 < x) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 >= Width then
-    x2 := Width - 1;
+  if not CheckHorizLineBounds(x,y,x2) then exit;
   AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1);
   InvalidateBitmap;
 end;
 
-procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: integer; c: TBGRAPixel);
-var
-  temp, n, delta: integer;
-  p: PBGRAPixel;
-begin
-  if (y2 < y) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
-    exit;
-  if y < 0 then
-    y := 0;
-  if y2 >= Height then
-    y2 := Height - 1;
-  p    := scanline[y] + x;
+function TBGRADefaultBitmap.CheckVertLineBounds(var x,y,y2: integer; out delta: integer): boolean; inline;
+var
+  temp: integer;
+begin
   if FLineOrder = riloBottomToTop then
     delta := -Width
   else
     delta := Width;
-  for n := y2 - y downto 0 do
-  begin
-    p^ := c;
-    Inc(p, delta);
-  end;
-  InvalidateBitmap;
-end;
-
-procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
-var
-  temp, n, delta: integer;
-  p: PBGRAPixel;
-begin
+
   if (y2 < y) then
   begin
@@ -1212 +1822 @@
     y2   := temp;
   end;
-  if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
+
+  if y < FClipRect.Top then
+    y := FClipRect.Top;
+  if y2 >= FClipRect.Bottom then
+    y2 := FClipRect.Bottom - 1;
+
+  if (y >= FClipRect.Bottom) or (y2 < FClipRect.Top) or (x < FClipRect.Left) or (x >= FClipRect.Right) then
+  begin
+    result := false;
     exit;
-  if y < 0 then
-    y := 0;
-  if y2 >= Height then
-    y2 := Height - 1;
+  end;
+
+  result := true;
+end;
+
+procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: integer; c: TBGRAPixel);
+var
+  n, delta: integer;
+  p: PBGRAPixel;
+begin
+  if not CheckVertLineBounds(x,y,y2,delta) then exit;
   p    := scanline[y] + x;
-  if FLineOrder = riloBottomToTop then
-    delta := -Width
-  else
-    delta := Width;
   for n := y2 - y downto 0 do
   begin
-    DrawPixelInline(p, c);
+    p^ := c;
     Inc(p, delta);
   end;
@@ -1231 +1852 @@
 end;
 
+procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: integer; c: TBGRAPixel);
+var
+  n, delta: integer;
+  p: PBGRAPixel;
+begin
+  if not CheckVertLineBounds(x,y,y2,delta) then exit;
+  p    := scanline[y] + x;
+  for n := y2 - y downto 0 do
+  begin
+    PDword(p)^ := PDword(p)^ xor DWord(c);
+    Inc(p, delta);
+  end;
+  InvalidateBitmap;
+end;
+
+procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
+var
+  n, delta: integer;
+  p: PBGRAPixel;
+begin
+  if c.alpha = 255 then
+  begin
+    SetVertLine(x,y,y2,c);
+    exit;
+  end;
+  if not CheckVertLineBounds(x,y,y2,delta) or (c.alpha=0) then exit;
+  p    := scanline[y] + x;
+  for n := y2 - y downto 0 do
+  begin
+    DrawPixelInlineNoAlphaCheck(p, c);
+    Inc(p, delta);
+  end;
+  InvalidateBitmap;
+end;
+
 procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: integer; alpha: byte);
 var
-  temp, n, delta: integer;
+  n, delta: integer;
   p: PBGRAPixel;
 begin
@@ -1241 +1897 @@
     exit;
   end;
-  if (y2 < y) then
+  if not CheckVertLineBounds(x,y,y2,delta) then exit;
+  p    := scanline[y] + x;
+  for n := y2 - y downto 0 do
+  begin
+    p^.alpha := alpha;
+    Inc(p, delta);
+  end;
+  InvalidateBitmap;
+end;
+
+procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
+var
+  n, delta: integer;
+  p: PBGRAPixel;
+begin
+  if not CheckVertLineBounds(x,y,y2,delta) then exit;
+  p    := scanline[y] + x;
+  for n := y2 - y downto 0 do
+  begin
+    FastBlendPixelInline(p, c);
+    Inc(p, delta);
+  end;
+  InvalidateBitmap;
+end;
+
+procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: integer;
+  c, compare: TBGRAPixel; maxDiff: byte);
+begin
+  if not CheckHorizLineBounds(x,y,x2) then exit;
+  DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
+  InvalidateBitmap;
+end;
+
+{---------------------------- Lines ---------------------------------}
+{ Call appropriate functions }
+
+procedure TBGRADefaultBitmap.DrawLine(x1, y1, x2, y2: integer;
+  c: TBGRAPixel; DrawLastPixel: boolean);
+begin
+  BGRADrawLineAliased(self,x1,y1,x2,y2,c,DrawLastPixel);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
+  c: TBGRAPixel; DrawLastPixel: boolean);
+begin
+  BGRADrawLineAntialias(self,x1,y1,x2,y2,c,DrawLastPixel);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
+  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
+begin
+  BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  c: TBGRAPixel; w: single);
+begin
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  texture: IBGRAScanner; w: single);
+begin
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  c: TBGRAPixel; w: single; closed: boolean);
+var
+  options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,nil,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  texture: IBGRAScanner; w: single; Closed: boolean);
+var
+  options: TBGRAPolyLineOptions;
+  c: TBGRAPixel;
+begin
+  if not closed then
+  begin
+    options := [plRoundCapOpen];
+    c := BGRAWhite; //needed for alpha junction
+  end else
+  begin
+    options := [];
+    c := BGRAPixelTransparent;
+  end;
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,texture,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
+  c: TBGRAPixel; w: single);
+begin
+  BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
+  const points: array of TPointF; texture: IBGRAScanner; w: single);
+begin
+  BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
+  c: TBGRAPixel; w: single; Closed: boolean);
+var
+  options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  BGRAPolyLine(self,points,w,c,pecRound,JoinStyle,FCustomPenStyle,options,nil,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawPolygonAntialias(const points: array of TPointF;
+  c: TBGRAPixel; w: single);
+begin
+   BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[plCycle],nil,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.DrawPolygonAntialias(
+  const points: array of TPointF; texture: IBGRAScanner; w: single);
+begin
+  BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[plCycle],texture,JoinMiterLimit);
+end;
+
+procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
+  alpha: byte; w: single; Closed: boolean);
+begin
+  FEraseMode := True;
+  DrawLineAntialias(x1, y1, x2, y2, BGRA(0, 0, 0, alpha), w, Closed);
+  FEraseMode := False;
+end;
+
+procedure TBGRADefaultBitmap.ErasePolyLineAntialias(const points: array of TPointF;
+  alpha: byte; w: single);
+begin
+  FEraseMode := True;
+  DrawPolyLineAntialias(points, BGRA(0,0,0,alpha),w);
+  FEraseMode := False;
+end;
+
+{------------------------ Shapes ----------------------------------------------}
+{ Call appropriate functions }
+
+procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF;
+  c1, c2, c3: TBGRAPixel);
+begin
+  FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]);
+end;
+
+procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2,
+  pt3: TPointF; c1, c2, c3: TBGRAPixel);
+var
+  grad: TBGRAGradientTriangleScanner;
+begin
+  grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
+  FillPolyAntialias([pt1,pt2,pt3],grad);
+  grad.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF;
+  texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True);
+begin
+  FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation);
+end;
+
+procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2,
+  pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,
+  light2, light3: word; TextureInterpolation: Boolean);
+begin
+  FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation);
+end;
+
+procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2,
+  pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
+var
+  mapping: TBGRATriangleLinearMapping;
+begin
+  mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
+  FillPolyAntialias([pt1,pt2,pt3],mapping);
+  mapping.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
+  c1, c2, c3, c4: TBGRAPixel);
+var
+  center: TPointF;
+  centerColor: TBGRAPixel;
+  multi: TBGRAMultishapeFiller;
+begin
+  if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4);
+    multi.Antialiasing:= false;
+    multi.Draw(self);
+    multi.Free;
+    exit;
+  end;
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
+                    MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
+  FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
+  FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
+  FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
+  FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
+end;
+
+procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3,
+  pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
+var multi : TBGRAMultishapeFiller;
+begin
+  multi := TBGRAMultishapeFiller.Create;
+  multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4);
+  multi.Draw(self);
+  multi.free;
+end;
+
+procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF;
+  texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);
+var
+  center: TPointF;
+  centerTex: TPointF;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
+  FillTriangleLinearMapping(pt1,pt2,center, texture,tex1,tex2,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt2,pt3,center, texture,tex2,tex3,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt3,pt4,center, texture,tex3,tex4,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt4,pt1,center, texture,tex4,tex1,centerTex, TextureInterpolation);
+end;
+
+procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,
+  light2, light3, light4: word; TextureInterpolation: Boolean);
+var
+  center: TPointF;
+  centerTex: TPointF;
+  centerLight: word;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
+  centerLight := (light1+light2+light3+light4) div 4;
+  FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation);
+  FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation);
+  FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation);
+  FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation);
+end;
+
+procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var multi : TBGRAMultishapeFiller;
+begin
+  multi := TBGRAMultishapeFiller.Create;
+  multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4);
+  multi.Draw(self);
+  multi.free;
+end;
+
+procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var
+  persp: TBGRAPerspectiveScannerTransform;
+begin
+  persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
+  FillPoly([pt1,pt2,pt3,pt4],persp,dmDrawWithTransparency);
+  persp.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var
+  persp: TBGRAPerspectiveScannerTransform;
+begin
+  persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
+  FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
+  persp.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF;
+  texture: IBGRAScanner; texCoords: array of TPointF;
+  TextureInterpolation: Boolean);
+begin
+  PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness(
+  const points: array of TPointF; texture: IBGRAScanner;
+  texCoords: array of TPointF; lightnesses: array of word;
+  TextureInterpolation: Boolean);
+begin
+  PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPolyLinearColor(
+  const points: array of TPointF; AColors: array of TBGRAPixel);
+begin
+  PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping(
+  const points: array of TPointF; const pointsZ: array of single;
+  texture: IBGRAScanner; texCoords: array of TPointF;
+  TextureInterpolation: Boolean);
+begin
+  PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness(
+  const points: array of TPointF; const pointsZ: array of single;
+  texture: IBGRAScanner; texCoords: array of TPointF;
+  lightnesses: array of word; TextureInterpolation: Boolean);
+begin
+  PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
+  c: TBGRAPixel; drawmode: TDrawMode);
+begin
+  BGRAPolygon.FillPolyAliased(self, points, c, FEraseMode, FillMode = fmWinding, drawmode);
+end;
+
+procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
+  texture: IBGRAScanner; drawmode: TDrawMode);
+begin
+  BGRAPolygon.FillPolyAliasedWithTexture(self, points, texture, FillMode = fmWinding, drawmode);
+end;
+
+procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
+  alpha: byte; w: single);
+begin
+  FEraseMode := True;
+  DrawLineAntialias(x1,y1,x2,y2, BGRA(0,0,0,alpha),w);
+  FEraseMode := False;
+end;
+
+procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel);
+begin
+  BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF;
+  texture: IBGRAScanner);
+begin
+  BGRAPolygon.FillPolyAntialiasWithTexture(self, points, texture, FillMode = fmWinding);
+end;
+
+procedure TBGRADefaultBitmap.ErasePoly(const points: array of TPointF;
+  alpha: byte);
+begin
+  BGRAPolygon.FillPolyAliased(self, points, BGRA(0, 0, 0, alpha), True, FillMode = fmWinding, dmDrawWithTransparency);
+end;
+
+procedure TBGRADefaultBitmap.ErasePolyAntialias(const points: array of TPointF; alpha: byte);
+begin
+  FEraseMode := True;
+  FillPolyAntialias(points, BGRA(0, 0, 0, alpha));
+  FEraseMode := False;
+end;
+
+procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
+  c: TBGRAPixel; w: single);
+begin
+  if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode)
+  else
+    DrawPolygonAntialias(ComputeEllipse(x,y,rx,ry),c,w);
+end;
+
+procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
+  texture: IBGRAScanner; w: single);
+begin
+  if IsClearPenStyle(FCustomPenStyle) then exit;
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture)
+  else
+    DrawPolygonAntialias(ComputeEllipse(x,y,rx,ry),texture,w);
+end;
+
+procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
+  c: TBGRAPixel; w: single; back: TBGRAPixel);
+var multi: TBGRAMultishapeFiller;
+    hw: single;
+begin
+  if w=0 then exit;
+  rx := abs(rx);
+  ry := abs(ry);
+  hw := w/2;
+  if (rx <= hw) or (ry <= hw) then
+  begin
+    FillEllipseAntialias(x,y,rx+hw,ry+hw,c);
+    exit;
+  end;
+  { use multishape filler for fine junction between polygons }
+  multi := TBGRAMultishapeFiller.Create;
+  if not IsClearPenStyle(FCustomPenStyle) and (c.alpha <> 0) then
+  begin
+    if IsSolidPenStyle(FCustomPenStyle) then
+    begin
+      multi.AddEllipse(x,y,rx-hw,ry-hw,back);
+      multi.AddEllipseBorder(x,y,rx,ry,w,c)
+    end
+    else
+    begin
+      multi.AddEllipse(x,y,rx,ry,back);
+      multi.AddPolygon(ComputeWidePolygon(ComputeEllipse(x,y,rx,ry),w),c);
+      multi.PolygonOrder := poLastOnTop;
+    end;
+  end;
+  multi.Draw(self);
+  multi.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
+begin
+  BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode);
+end;
+
+procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single;
+  texture: IBGRAScanner);
+begin
+  BGRAPolygon.FillEllipseAntialiasWithTexture(self, x, y, rx, ry, texture);
+end;
+
+procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx,
+  ry: single; outercolor, innercolor: TBGRAPixel);
+var
+    grad: TBGRAGradientScanner;
+    affine: TBGRAAffineScannerTransform;
+begin
+  if (rx=0) or (ry=0) then exit;
+  if rx=ry then
+  begin
+    grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True);
+    FillEllipseAntialias(x,y,rx,ry,grad);
+    grad.Free;
+  end else
+  begin
+    grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
+    affine := TBGRAAffineScannerTransform.Create(grad);
+    affine.Scale(rx,ry);
+    affine.Translate(x,y);
+    FillEllipseAntialias(x,y,rx,ry,affine);
+    affine.Free;
+    grad.Free;
+  end;
+end;
+
+procedure TBGRADefaultBitmap.EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
+begin
+  FEraseMode := True;
+  FillEllipseAntialias(x, y, rx, ry, BGRA(0, 0, 0, alpha));
+  FEraseMode := False;
+end;
+
+procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
+  c: TBGRAPixel; w: single; back: TBGRAPixel);
+var
+  bevel: single;
+  multi: TBGRAMultishapeFiller;
+  hw: single;
+begin
+  if IsClearPenStyle(FCustomPenStyle) or (c.alpha=0) or (w=0) then
+  begin
+    if back <> BGRAPixelTransparent then
+      FillRectAntialias(x,y,x2,y2,back);
+    exit;
+  end;
+
+  hw := w/2;
+  if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
+  begin
+    if JoinStyle = pjsBevel then
+    begin
+      bevel := (2-sqrt(2))*hw;
+      FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
+    end else
+    if JoinStyle = pjsRound then
+     FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c)
+    else
+     FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c);
+    exit;
+  end;
+
+  { use multishape filler for fine junction between polygons }
+  multi := TBGRAMultishapeFiller.Create;
+  multi.FillMode := FillMode;
+  if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
+    multi.AddRectangleBorder(x,y,x2,y2,w,c)
+  else
+    multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c);
+
+  if (frac(x + hw) = 0.5) and (frac(y + hw)=0.5) and (frac(x2 - hw)=0.5) and (frac(y2 - hw)=0.5) then
+    FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency)
+  else
+    multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back);
+  multi.Draw(self);
+  multi.Free;
+end;
+
+procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
+  texture: IBGRAScanner; w: single);
+var
+  bevel,hw: single;
+  multi: TBGRAMultishapeFiller;
+begin
+  if IsClearPenStyle(FCustomPenStyle) or (w=0) then exit;
+
+  hw := w/2;
+  if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
+  begin
+    if JoinStyle = pjsBevel then
+    begin
+      bevel := (2-sqrt(2))*hw;
+      FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, texture, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
+    end else
+    if JoinStyle = pjsRound then
+     FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, texture)
+    else
+     FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, texture);
+    exit;
+  end;
+
+  { use multishape filler for fine junction between polygons }
+  multi := TBGRAMultishapeFiller.Create;
+  multi.FillMode := FillMode;
+  if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
+    multi.AddRectangleBorder(x,y,x2,y2,w, texture)
+  else
+    multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w), texture);
+  multi.Draw(self);
+  multi.Free;
+end;
+
+procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
+   c: TBGRAPixel; w: single; options: TRoundRectangleOptions);
+begin
+  if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False)
+  else
+    DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w);
+end;
+
+procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
+  pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel;
+  options: TRoundRectangleOptions);
+var
+  multi: TBGRAMultishapeFiller;
+begin
+  if IsClearPenStyle(FCustomPenStyle) or (pencolor.alpha = 0) then
+  begin
+    FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options);
+    exit;
+  end;
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False)
+  else
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.PolygonOrder := poLastOnTop;
+    multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options);
+    multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor);
+    multi.Draw(self);
+    multi.Free;
+  end;
+end;
+
+procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
+  penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner;
+  options: TRoundRectangleOptions);
+var
+  multi: TBGRAMultishapeFiller;
+begin
+  if IsClearPenStyle(FCustomPenStyle) then
+  begin
+    FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options);
+    exit;
+  end else
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False)
+  else
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.PolygonOrder := poLastOnTop;
+    multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options);
+    multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture);
+    multi.Draw(self);
+    multi.Free;
+  end;
+end;
+
+procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
+  texture: IBGRAScanner; w: single; options: TRoundRectangleOptions);
+begin
+  if IsClearPenStyle(FCustomPenStyle) then exit;
+  if IsSolidPenStyle(FCustomPenStyle) then
+    BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture)
+  else
+    DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w);
+end;
+
+function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline;
+var
+  temp: integer;
+begin
+  //swap coordinates if needed
+  if (x > x2) then
+  begin
+    temp := x;
+    x    := x2;
+    x2   := temp;
+  end;
+  if (y > y2) then
   begin
     temp := y;
@@ -1247 +2518 @@
     y2   := temp;
   end;
-  if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
+  if (x2 - x <= minsize) or (y2 - y <= minsize) then
+  begin
+    result := false;
     exit;
-  if y < 0 then
-    y := 0;
-  if y2 >= Height then
-    y2 := Height - 1;
-  p    := scanline[y] + x;
-  if FLineOrder = riloBottomToTop then
-    delta := -Width
-  else
-    delta := Width;
-  for n := y2 - y downto 0 do
-  begin
-    p^.alpha := alpha;
-    Inc(p, delta);
-  end;
-  InvalidateBitmap;
-end;
-
-procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
-var
-  temp, n, delta: integer;
-  p: PBGRAPixel;
-begin
-  if (y2 < y) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
-    exit;
-  if y < 0 then
-    y := 0;
-  if y2 >= Height then
-    y2 := Height - 1;
-  p    := scanline[y] + x;
-  if FLineOrder = riloBottomToTop then
-    delta := -Width
-  else
-    delta := Width;
-  for n := y2 - y downto 0 do
-  begin
-    FastBlendPixelInline(p, c);
-    Inc(p, delta);
-  end;
-  InvalidateBitmap;
-end;
-
-procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: integer;
-  c, compare: TBGRAPixel; maxDiff: byte);
-var
-  temp: integer;
-begin
-  if (x2 < x) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 >= Width then
-    x2 := Width - 1;
-  DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
-  InvalidateBitmap;
-end;
-
-{---------------------------- Shapes ---------------------------------}
-
-procedure TBGRADefaultBitmap.DrawLine(x1, y1, x2, y2: integer;
-  c: TBGRAPixel; DrawLastPixel: boolean);
-var
-  Y, X: integer;
-  DX, DY, SX, SY, E: integer;
-begin
-
-  if (Y1 = Y2) and (X1 = X2) then
-  begin
-    if DrawLastPixel then
-      DrawPixel(X1, Y1, c);
-    Exit;
-  end;
-
-  DX := X2 - X1;
-  DY := Y2 - Y1;
-
-  if DX < 0 then
-  begin
-    SX := -1;
-    DX := -DX;
-  end
-  else
-    SX := 1;
-
-  if DY < 0 then
-  begin
-    SY := -1;
-    DY := -DY;
-  end
-  else
-    SY := 1;
-
-  DX := DX shl 1;
-  DY := DY shl 1;
-
-  X := X1;
-  Y := Y1;
-  if DX > DY then
-  begin
-    E := DY - DX shr 1;
-
-    while X <> X2 do
-    begin
-      DrawPixel(X, Y, c);
-      if E >= 0 then
-      begin
-        Inc(Y, SY);
-        Dec(E, DX);
-      end;
-      Inc(X, SX);
-      Inc(E, DY);
-    end;
-  end
-  else
-  begin
-    E := DX - DY shr 1;
-
-    while Y <> Y2 do
-    begin
-      DrawPixel(X, Y, c);
-      if E >= 0 then
-      begin
-        Inc(X, SX);
-        Dec(E, DY);
-      end;
-      Inc(Y, SY);
-      Inc(E, DX);
-    end;
-  end;
-
-  if DrawLastPixel then
-    DrawPixel(X2, Y2, c);
-end;
-
-procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
-  c: TBGRAPixel; DrawLastPixel: boolean);
-var
-  Y, X:  integer;
-  DX, DY, SX, SY, E: integer;
-  alpha: single;
-begin
-
-  if (Y1 = Y2) and (X1 = X2) then
-  begin
-    if DrawLastPixel then
-      DrawPixel(X1, Y1, c);
-    Exit;
-  end;
-
-  DX := X2 - X1;
-  DY := Y2 - Y1;
-
-  if DX < 0 then
-  begin
-    SX := -1;
-    DX := -DX;
-  end
-  else
-    SX := 1;
-
-  if DY < 0 then
-  begin
-    SY := -1;
-    DY := -DY;
-  end
-  else
-    SY := 1;
-
-  DX := DX shl 1;
-  DY := DY shl 1;
-
-  X := X1;
-  Y := Y1;
-
-  if DX > DY then
-  begin
-    E := 0;
-
-    while X <> X2 do
-    begin
-      alpha := 1 - E / DX;
-      DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
-      DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
-        round(c.alpha * sqrt(1 - alpha))));
-      Inc(E, DY);
-      if E >= DX then
-      begin
-        Inc(Y, SY);
-        Dec(E, DX);
-      end;
-      Inc(X, SX);
-    end;
-  end
-  else
-  begin
-    E := 0;
-
-    while Y <> Y2 do
-    begin
-      alpha := 1 - E / DY;
-      DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
-      DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
-        round(c.alpha * sqrt(1 - alpha))));
-      Inc(E, DX);
-      if E >= DY then
-      begin
-        Inc(X, SX);
-        Dec(E, DY);
-      end;
-      Inc(Y, SY);
-    end;
-  end;
-  if DrawLastPixel then
-    DrawPixel(X2, Y2, c);
-end;
-
-procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPoint;
-  c: TBGRAPixel; DrawLastPixel: boolean);
-var i: integer;
-begin
-   if length(points) = 1 then
-   begin
-     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
-   end
-   else
-     for i := 0 to high(points)-1 do
-       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1));
-end;
-
-procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
-  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
-var
-  Y, X:  integer;
-  DX, DY, SX, SY, E: integer;
-  alpha: single;
-  c:     TBGRAPixel;
-  DashPos: integer;
-begin
-
-  c := c1;
-  DashPos := 0;
-
-  if (Y1 = Y2) and (X1 = X2) then
-  begin
-    if DrawLastPixel then
-      DrawPixel(X1, Y1, c);
-    Exit;
-  end;
-
-  DX := X2 - X1;
-  DY := Y2 - Y1;
-
-  if DX < 0 then
-  begin
-    SX := -1;
-    DX := -DX;
-  end
-  else
-    SX := 1;
-
-  if DY < 0 then
-  begin
-    SY := -1;
-    DY := -DY;
-  end
-  else
-    SY := 1;
-
-  DX := DX shl 1;
-  DY := DY shl 1;
-
-  X := X1;
-  Y := Y1;
-
-  if DX > DY then
-  begin
-    E := 0;
-
-    while X <> X2 do
-    begin
-      alpha := 1 - E / DX;
-      DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
-      DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
-        round(c.alpha * sqrt(1 - alpha))));
-      Inc(E, DY);
-      if E >= DX then
-      begin
-        Inc(Y, SY);
-        Dec(E, DX);
-      end;
-      Inc(X, SX);
-
-      Inc(DashPos);
-      if DashPos = DashLen then
-        c := c2
-      else
-      if DashPos = DashLen + DashLen then
-      begin
-        c := c1;
-        DashPos := 0;
-      end;
-    end;
-  end
-  else
-  begin
-    E := 0;
-
-    while Y <> Y2 do
-    begin
-      alpha := 1 - E / DY;
-      DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
-      DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
-        round(c.alpha * sqrt(1 - alpha))));
-      Inc(E, DX);
-      if E >= DY then
-      begin
-        Inc(X, SX);
-        Dec(E, DY);
-      end;
-      Inc(Y, SY);
-
-      Inc(DashPos);
-      if DashPos = DashLen then
-        c := c2
-      else
-      if DashPos = DashLen + DashLen then
-      begin
-        c := c1;
-        DashPos := 0;
-      end;
-    end;
-  end;
-  if DrawLastPixel then
-    DrawPixel(X2, Y2, c);
-end;
-
-procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPoint; c1,
-  c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
-var i: integer;
-begin
-   if length(points) = 1 then
-   begin
-     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c1);
-   end
-   else
-     for i := 0 to high(points)-1 do
-       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c1,c2,dashLen,DrawLastPixel and (i=high(points)-1));
-end;
-
-procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
-  c: TBGRAPixel; w: single; closed: boolean);
-var
-  dx, dy, d, hx, hy, wx, wy, t, t2, t3: single;
-  nbInter, i: integer;
-
-  poly: array of tpointf;
-  alphaFactor: single;
-begin
-  if (w <= 0) then
-    exit;
-  if (w = 1) and (frac(x1) = 0) and (frac(y1) = 0) and (frac(x2) = 0) and
-    (frac(y2) = 0) then
-  begin
-    DrawLineAntialias(round(x1), round(y1), round(x2), round(y2), c, closed);
-    exit;
-  end;
-
-  dx := x2 - x1;
-  dy := y2 - y1;
-  if (dx = 0) and (dy = 0) then
-  begin
-    if closed then
-      FillEllipseAntialias(x1, y1, w / 2, w / 2, c);
-    exit;
-  end;
-
-  d  := sqrt(sqr(dx) + sqr(dy));
-  dx /= d;
-  dy /= d;
-  hx := dy * w / 2;
-  hy := -dx * w / 2;
-  wx := dx * w / 2;
-  wy := dy * w / 2;
-
-  nbInter := (ceil(w) + 1) * 2;
-  setlength(poly, 4 + nbInter * 2);
-  poly[0] := pointf(x1 + hx, y1 + hy);
-  poly[1] := pointf(x2 + hx, y2 + hy);
-
-  if closed then
-  begin
-    for i := 0 to nbInter - 1 do
-    begin
-      t  := 1 - (i + 1) / (nbInter + 1) * 2;
-      t2 := sqrt(1 - sqr(t));
-      poly[2 + i] := pointf(x2 + t * hx + t2 * wx, y2 + t * hy + t2 * wy);
-    end;
-  end
-  else
-  begin
-    if c.alpha=255 then alphaFactor := 1 else
-    begin
-      alphaFactor := sqr(c.alpha / 255) / 2.5;
-      if (c.alpha > 220) then
-      begin
-        t := sqr(sqr((c.alpha-220)/(255-220)));
-        alphaFactor := alphaFactor*(1-t)+0.8*t;
-      end;
-    end;
-    for i := 0 to nbInter - 1 do
-    begin
-      t  := 1 - (i + 1) / (nbInter + 1) * 2;
-      t2 := sqrt(1 - sqr(t));
-      t3 := (1 - t2) * 0.7;
-      poly[2 + i] := pointf(x2 + t * hx - t2 * wx + dx * (alphaFactor + t3),
-        y2 + t * hy - t2 * wy + dy * (alphaFactor + t3));
-    end;
-  end;
-
-  poly[2 + nbinter] := pointf(x2 - hx, y2 - hy);
-  poly[3 + nbinter] := pointf(x1 - hx, y1 - hy);
-
-  for i := 0 to nbInter - 1 do
-  begin
-    t  := (i + 1) / (nbInter + 1) * 2 - 1;
-    t2 := sqrt(1 - sqr(t));
-    poly[4 + nbinter + i] := pointf(x1 + t * hx - t2 * wx, y1 + t * hy - t2 * wy);
-  end;
-
-  FillPolyAntialias(poly, c);
-end;
-
-procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPointF;
-  c: TBGRAPixel; w: single; Closed: boolean);
-var i: integer;
-begin
-   if length(points) = 1 then
-   begin
-     if Closed then DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,w,true);
-   end
-   else
-     for i := 0 to high(points)-1 do
-       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,w,Closed and (i=high(points)-1));
-end;
-
-procedure TBGRADefaultBitmap.DrawPolygonAntialias(points: array of TPointF;
-  c: TBGRAPixel; w: single);
-var i: integer;
-begin
-   if length(points) = 1 then
-   begin
-     DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,w,true);
-   end
-   else
-   if length(points) > 1 then
-   begin
-     for i := 0 to high(points)-1 do
-       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,w,False);
-     DrawLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,w,False);
-   end;
-end;
-
-procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
-  alpha: byte; w: single; Closed: boolean);
-begin
-  FEraseMode := True;
-  DrawLineAntialias(x1, y1, x2, y2, BGRA(0, 0, 0, alpha), w, Closed);
-  FEraseMode := False;
-end;
-
-procedure TBGRADefaultBitmap.FillPolyAntialias(points: array of TPointF; c: TBGRAPixel);
-begin
-  BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode);
-end;
-
-procedure TBGRADefaultBitmap.ErasePolyAntialias(points: array of TPointF; alpha: byte);
-begin
-  FEraseMode := True;
-  FillPolyAntialias(points, BGRA(0, 0, 0, alpha));
-  FEraseMode := False;
-end;
-
-procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
-  c: TBGRAPixel; w: single);
-begin
-  BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode);
-end;
-
-procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
-begin
-  BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode);
-end;
-
-procedure TBGRADefaultBitmap.EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
-begin
-  FEraseMode := True;
-  FillEllipseAntialias(x, y, rx, ry, BGRA(0, 0, 0, alpha));
-  FEraseMode := False;
-end;
-
-{------------------------ Shapes ----------------------------------------------}
-
-procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
-begin
-  Rectangle(x, y, x2, y2, ColorToBGRA(c), dmSet);
-end;
-
-procedure TBGRADefaultBitmap.Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode);
-begin
-  Rectangle(r.left, r.top, r.right, r.bottom, c, mode);
-end;
-
-procedure TBGRADefaultBitmap.Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel;
-  mode: TDrawMode);
-begin
-  Rectangle(r.left, r.top, r.right, r.bottom, BorderColor, FillColor, mode);
-end;
-
-procedure TBGRADefaultBitmap.Rectangle(r: TRect; c: TColor);
-begin
-  Rectangle(r.left, r.top, r.right, r.bottom, c);
-end;
-
-procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
-  c: TBGRAPixel; w: single);
-begin
-  RectangleAntialias(x, y, x2, y2, c, w, BGRAPixelTransparent);
-end;
-
-procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
-  c: TBGRAPixel; w: single; back: TBGRAPixel);
-var
-  poly: array of TPointF;
-  temp: single;
-begin
-  if (x > x2) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (y > y2) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-
-  if (x2 - x <= w) or (y2 - y <= w) then
-  begin
-    FillRectAntialias(x - w / 2, y - w / 2, x2 + w / 2, y2 + w / 2, c);
-    exit;
-  end;
-  w /= 2;
-
-  setlength(poly, 9);
-  poly[0] := pointf(x - w, y - w);
-  poly[1] := pointf(x2 + w, y - w);
-  poly[2] := pointf(x2 + w, y2 + w);
-  poly[3] := pointf(x - w, y2 + w);
-  poly[4] := EmptyPointF;
-  poly[5] := pointf(x + w, y + w);
-  poly[6] := pointf(x2 - w, y + w);
-  poly[7] := pointf(x2 - w, y2 - w);
-  poly[8] := pointf(x + w, y2 - w);
-  FillPolyAntialias(poly, c);
-
-  if back.alpha <> 0 then
-    FillRectAntialias(x + w, y + w, x2 - w, y2 - w, back);
-end;
-
-procedure TBGRADefaultBitmap.FillRect(r: TRect; c: TColor);
-begin
-  FillRect(r.Left, r.top, r.right, r.bottom, c);
-end;
-
-procedure TBGRADefaultBitmap.FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
-begin
-  FillRect(r.Left, r.top, r.right, r.bottom, c, mode);
+  end else
+    result := true;
 end;
 
 procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
   c: TBGRAPixel; mode: TDrawMode);
-var
-  temp: integer;
-begin
-  if (x > x2) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (y > y2) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if (x2 - x <= 1) or (y2 - y <= 1) then
-    exit;
+begin
+  if not CheckRectBounds(x,y,x2,y2,1) then exit;
   case mode of
     dmFastBlend:
@@ -1891 +2561 @@
       end;
     end;
+    dmXor:
+    begin
+      XorHorizLine(x, y, x2 - 1, c);
+      XorHorizLine(x, y2 - 1, x2 - 1, c);
+      if y2 - y > 2 then
+      begin
+        XorVertLine(x, y + 1, y2 - 2, c);
+        XorVertLine(x2 - 1, y + 1, y2 - 2, c);
+      end;
+    end;
     dmSetExceptTransparent: if (c.alpha = 255) then
         Rectangle(x, y, x2, y2, c, dmSet);
@@ -1898 +2578 @@
 procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
   BorderColor, FillColor: TBGRAPixel; mode: TDrawMode);
+begin
+  if not CheckRectBounds(x,y,x2,y2,1) then exit;
+  Rectangle(x, y, x2, y2, BorderColor, mode);
+  FillRect(x + 1, y + 1, x2 - 1, y2 - 1, FillColor, mode);
+end;
+
+function TBGRADefaultBitmap.CheckClippedRectBounds(var x, y, x2, y2: integer): boolean; inline;
 var
   temp: integer;
@@ -1913 +2600 @@
     y2   := temp;
   end;
-  if (x2 - x <= 1) or (y2 - y <= 1) then
+  if (x >= FClipRect.Right) or (x2 <= FClipRect.Left) or (y >= FClipRect.Bottom) or (y2 <= FClipRect.Top) then
+  begin
+    result := false;
     exit;
-
-  Rectangle(x, y, x2, y2, BorderColor, mode);
-  FillRect(x + 1, y + 1, x2 - 1, y2 - 1, FillColor, mode);
-end;
-
-procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
-begin
-  FillRect(x, y, x2, y2, ColorToBGRA(c), dmSet);
+  end;
+  if x < FClipRect.Left then
+    x := FClipRect.Left;
+  if x2 > FClipRect.Right then
+    x2 := FClipRect.Right;
+  if y < FClipRect.Top then
+    y := FClipRect.Top;
+  if y2 > FClipRect.Bottom then
+    y2 := FClipRect.Bottom;
+  if (x2 - x <= 0) or (y2 - y <= 0) then
+  begin
+    result := false;
+    exit;
+  end else
+    result := true;
 end;
 
@@ -1928 +2624 @@
   mode: TDrawMode);
 var
-  temp, yb, tx, delta: integer;
+  yb, tx, delta: integer;
   p: PBGRAPixel;
 begin
-  if (x > x2) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (y > y2) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if (x >= Width) or (x2 <= 0) or (y >= Height) or (y2 <= 0) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 > Width then
-    x2 := Width;
-  if y < 0 then
-    y := 0;
-  if y2 > Height then
-    y2 := Height;
-  if (x2 - x <= 0) or (y2 - y <= 0) then
-    exit;
+  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
   tx := x2 - x;
   Dec(x2);
   Dec(y2);
 
-  case mode of
-    dmFastBlend:
-    begin
-      p := Scanline[y] + x;
-      if FLineOrder = riloBottomToTop then
-        delta := -Width
-      else
-        delta := Width;
-      for yb := y2 - y downto 0 do
-      begin
-        FastBlendPixelsInline(p, c, tx);
-        Inc(p, delta);
-      end;
-      InvalidateBitmap;
+  if mode = dmSetExceptTransparent then
+  begin
+    if (c.alpha = 255) then
+      FillRect(x, y, x2, y2, c, dmSet);
+  end else
+  begin
+    if (mode <> dmSet) and (c.alpha = 0) then exit;
+
+    p := Scanline[y] + x;
+    if FLineOrder = riloBottomToTop then
+      delta := -Width
+    else
+      delta := Width;
+
+    case mode of
+      dmFastBlend:
+        for yb := y2 - y downto 0 do
+        begin
+          FastBlendPixelsInline(p, c, tx);
+          Inc(p, delta);
+        end;
+      dmDrawWithTransparency:
+        for yb := y2 - y downto 0 do
+        begin
+          DrawPixelsInline(p, c, tx);
+          Inc(p, delta);
+        end;
+      dmSet:
+        for yb := y2 - y downto 0 do
+        begin
+          FillInline(p, c, tx);
+          Inc(p, delta);
+        end;
+      dmXor:
+        for yb := y2 - y downto 0 do
+        begin
+          XorInline(p, c, tx);
+          Inc(p, delta);
+        end;
     end;
-    dmDrawWithTransparency:
-    begin
-      p := Scanline[y] + x;
-      if FLineOrder = riloBottomToTop then
-        delta := -Width
-      else
-        delta := Width;
-      for yb := y2 - y downto 0 do
-      begin
-        DrawPixelsInline(p, c, tx);
-        Inc(p, delta);
-      end;
-      InvalidateBitmap;
-    end;
-    dmSet:
-    begin
-      p := Scanline[y] + x;
-      if FLineOrder = riloBottomToTop then
-        delta := -Width
-      else
-        delta := Width;
-      for yb := y2 - y downto 0 do
-      begin
-        FillInline(p, c, tx);
-        Inc(p, delta);
-      end;
-      InvalidateBitmap;
-    end;
-    dmSetExceptTransparent: if (c.alpha = 255) then
-        FillRect(x, y, x2, y2, c, dmSet);
-  end;
-end;
-
-procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
-var
-  poly: array of TPointF;
-begin
-  setlength(poly, 4);
-  poly[0] := pointf(x, y);
-  poly[1] := pointf(x2, y);
-  poly[2] := pointf(x2, y2);
-  poly[3] := pointf(x, y2);
-  FillPolyAntialias(poly, c);
+
+    InvalidateBitmap;
+  end;
+end;
+
+procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
+  texture: IBGRAScanner; mode: TDrawMode);
+var
+  yb, tx, delta: integer;
+  p: PBGRAPixel;
+begin
+  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
+  tx := x2 - x;
+  Dec(x2);
+  Dec(y2);
+
+  p := Scanline[y] + x;
+  if FLineOrder = riloBottomToTop then
+    delta := -Width
+  else
+    delta := Width;
+
+  for yb := y to y2 do
+  begin
+    texture.ScanMoveTo(x,yb);
+    ScannerPutPixels(texture, p, tx, mode);
+    Inc(p, delta);
+  end;
+
+  InvalidateBitmap;
 end;
 
 procedure TBGRADefaultBitmap.AlphaFillRect(x, y, x2, y2: integer; alpha: byte);
 var
-  temp, yb, tx, delta: integer;
+  yb, tx, delta: integer;
   p: PBGRAPixel;
 begin
@@ -2030 +2715 @@
   end;
 
-  if (x > x2) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (y > y2) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if (x >= Width) or (x2 <= 0) or (y >= Height) or (y2 <= 0) then
-    exit;
-  if x < 0 then
-    x := 0;
-  if x2 > Width then
-    x2 := Width;
-  if y < 0 then
-    y := 0;
-  if y2 > Height then
-    y2 := Height;
-  if (x2 - x <= 0) or (y2 - y <= 0) then
-    exit;
+  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
   tx := x2 - x;
   Dec(x2);
@@ -2071 +2733 @@
 end;
 
+procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
+var tx,ty: single;
+begin
+  tx := x2-x;
+  ty := y2-y;
+  if (tx=0) or (ty=0) then exit;
+  if (abs(tx) > 2) and (abs(ty) > 2) then
+  begin
+    if (tx < 0) then
+    begin
+      tx := -tx;
+      x := x2;
+      x2 := x+tx;
+    end;
+    if (ty < 0) then
+    begin
+      ty := -ty;
+      y := y2;
+      y2 := y+ty;
+    end;
+    FillRectAntialias(x,y,x2,ceil(y)+0.5,c);
+    FillRectAntialias(x,ceil(y)+0.5,ceil(x)+0.5,floor(y2)-0.5,c);
+    FillRectAntialias(floor(x2)-0.5,ceil(y)+0.5,x2,floor(y2)-0.5,c);
+    FillRectAntialias(x,floor(y2)-0.5,x2,y2,c);
+    FillRect(ceil(x)+1,ceil(y)+1,floor(x2),floor(y2),c,dmDrawWithTransparency);
+  end else
+    FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], c);
+end;
+
+procedure TBGRADefaultBitmap.EraseRectAntialias(x, y, x2, y2: single;
+  alpha: byte);
+begin
+  ErasePolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], alpha);
+end;
+
+procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single;
+  texture: IBGRAScanner);
+begin
+  FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], texture);
+end;
+
+procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,ry: single;
+  c: TBGRAPixel; options: TRoundRectangleOptions);
+begin
+  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False);
+end;
+
+procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,
+  ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions);
+begin
+  BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture);
+end;
+
+procedure TBGRADefaultBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx,
+  ry: single; alpha: byte; options: TRoundRectangleOptions);
+begin
+  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True);
+end;
+
 procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer;
-  RX, RY: integer; BorderColor, FillColor: TBGRAPixel);
-var
-  CX, CY, CX1, CY1, A, B, NX, NY: single;
-  X, Y, EX, EY: integer;
-  LX1, LY1: integer;
-  LX2, LY2: integer;
-  DivSqrA, DivSqrB: single;
-  I, J, S: integer;
-  EdgeList: array of TPoint;
-  temp:   integer;
-  LX, LY: integer;
-
-  procedure AddEdge(X, Y: integer);
-  begin
-    if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then
-      EdgeList[Y].X := X;
-    if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then
-      EdgeList[Y].Y := X;
-  end;
-
-begin
-  if (x1 > x2) then
-  begin
-    temp := x1;
-    x1   := x2;
-    x2   := temp;
-  end;
-  if (y1 > y2) then
-  begin
-    temp := y1;
-    y1   := y2;
-    y2   := temp;
-  end;
-  if (x2 - x1 <= 0) or (y2 - y1 <= 0) then
-    exit;
-  LX := x2 - x1 - RX;
-  LY := y2 - y1 - RY;
-  Dec(x2);
-  Dec(y2);
-
-  if (X1 = X2) and (Y1 = Y2) then
-  begin
-    DrawPixel(X1, Y1, BorderColor);
-    Exit;
-  end;
-
-  if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
-  begin
-    FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
-    Exit;
-  end;
-
-  if (LX > X2 - X1) or (LY > Y2 - Y1) then
-  begin
-    Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
-    FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, dmDrawWithTransparency);
-    Exit;
-  end;
-
-  SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2));
-  for I := 0 to Pred(High(EdgeList)) do
-    EdgeList[I] := Point(-1, -1);
-  EdgeList[High(EdgeList)] := Point(0, 0);
-
-  A  := (X2 - X1 + 1 - LX) / 2;
-  B  := (Y2 - Y1 + 1 - LY) / 2;
-  CX := (X2 + X1 + 1) / 2;
-  CY := (Y2 + Y1 + 1) / 2;
-
-  CX1 := X2 + 1 - A - Floor(CX);
-  CY1 := Y2 + 1 - B - Floor(CY);
-
-  EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A));
-  EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B));
-
-  DivSqrA := 1 / Sqr(A);
-  DivSqrB := 1 / Sqr(B);
-
-  NY := B;
-  AddEdge(Floor(CX1), Round(CY1 + B) - 1);
-  for X := 1 to Pred(EX) do
-  begin
-    NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA);
-
-    AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1);
-  end;
-
-  LX1 := Floor(CX1) + Pred(EX);
-  LY1 := Round(CY1 + NY) - 1;
-
-  NX := A;
-  AddEdge(Round(CX1 + A) - 1, Floor(CY1));
-  for Y := 1 to Pred(EY) do
-  begin
-    NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB);
-
-    AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y);
-  end;
-
-  LX2 := Round(CX1 + NX) - 1;
-  LY2 := Floor(CY1) + Pred(EY);
-
-  if Abs(LX1 - LX2) > 1 then
-  begin
-    if Abs(LY1 - LY2) > 1 then
-      AddEdge(LX1 + 1, LY1 - 1)
-    else
-      AddEdge(LX1 + 1, LY1);
-  end
-  else
-  if Abs(LY1 - LY2) > 1 then
-    AddEdge(LX2, LY1 - 1);
-
-  for I := 0 to High(EdgeList) do
-  begin
-    if EdgeList[I].X = -1 then
-      EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1)
-    else
-      Break;
-  end;
-
-  for J := 0 to High(EdgeList) do
-  begin
-    if (J = 0) and (Frac(CY) > 0) then
-    begin
-      for I := EdgeList[J].X to EdgeList[J].Y do
-      begin
-        DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
-        DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
-      end;
-
-      DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
-        Pred(EdgeList[J].X), FillColor);
-    end
-    else
-    if (J = High(EdgeList)) then
-    begin
-      if Frac(CX) > 0 then
-        S := -EdgeList[J].Y
-      else
-        S := -Succ(EdgeList[J].Y);
-
-      for I := S to EdgeList[J].Y do
-      begin
-        DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
-        DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
-      end;
-    end
-    else
-    begin
-      for I := EdgeList[J].X to EdgeList[J].Y do
-      begin
-        DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
-        DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
-        if Floor(CX) + I <> Ceil(CX) - Succ(I) then
-        begin
-          DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
-          DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor);
-        end;
-      end;
-
-      DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J,
-        Floor(CX) + Pred(EdgeList[J].X), FillColor);
-      DrawHorizLine(Ceil(CX) - EdgeList[J].X, Ceil(CY) - Succ(J),
-        Floor(CX) + Pred(EdgeList[J].X), FillColor);
-    end;
-  end;
-end;
-
-procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string; c: TBGRAPixel);
-begin
-  TextOut(x, y, s, c, taLeftJustify);
-end;
-
-
-{$HINTS OFF}
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel);
+begin
+  BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,FillColor);
+end;
+
+{------------------------- Text functions ---------------------------------------}
+
+procedure TBGRADefaultBitmap.TextOutAngle(x, y, orientation: integer;
+  s: string; c: TBGRAPixel; align: TAlignment);
+begin
+  UpdateFont;
+  BGRAText.BGRATextOutAngle(self,FFont,FontQuality,x,y,orientation,s,c,nil,align);
+end;
+
+procedure TBGRADefaultBitmap.TextOutAngle(x, y, orientation: integer;
+  s: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  UpdateFont;
+  BGRAText.BGRATextOutAngle(self,FFont,FontQuality,x,y,orientation,s,BGRAPixelTransparent,texture,align);
+end;
+
+procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string;
+  texture: IBGRAScanner; align: TAlignment);
+begin
+  UpdateFont;
+
+  if (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
+    BGRATextFX.BGRATextOutImproveReadability(self,FFont,x,y,s,BGRAPixelTransparent,texture,align,
+     FontQuality in[fqFineClearTypeRGB,fqFineClearTypeBGR], FontQuality = fqFineClearTypeRGB) else
+
+    BGRAText.BGRATextOut(self,FFont,FontQuality,x,y,s,BGRAPixelTransparent,texture,align);
+end;
+
 procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string;
   c: TBGRAPixel; align: TAlignment);
-var
-  size:  TSize;
-  temp:  TBGRADefaultBitmap;
-  P:     PBGRAPixel;
-  n:     integer;
-  alpha: integer;
 begin
   UpdateFont;
 
-  size := TextSize(s);
-  if (size.cx = 0) or (size.cy = 0) then
-    exit;
-
-  case align of
-    taLeftJustify: ;
-    taCenter: Dec(x, size.cx div 2);
-    taRightJustify: Dec(x, size.cx);
-  end;
-
-  temp := NewBitmap(size.cx, size.cy);
-  temp.Fill(clBlack);
-  temp.Canvas.Font := FFont;
-  temp.Canvas.Font.Color := clWhite;
-  temp.Canvas.Brush.Style := bsClear;
-  temp.Canvas.TextOut(0, 0, s);
-  p := temp.Data;
-  for n := temp.NbPixels - 1 downto 0 do
-  begin
-    alpha    := P^.green;
-    p^.red   := c.red;
-    p^.green := c.green;
-    p^.blue  := c.blue;
-    p^.alpha := (c.alpha * alpha) div 255;
-    Inc(p);
-  end;
-  PutImage(x, y, temp, dmDrawWithTransparency);
-  temp.Free;
-end;
-
-{$HINTS ON}
-
-procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string; c: TColor);
-begin
-  TextOut(x, y, s, ColorToBGRA(c));
+  if (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
+    BGRATextFX.BGRATextOutImproveReadability(self,FFont,x,y,s,c,nil,align,
+    FontQuality in[fqFineClearTypeRGB,fqFineClearTypeBGR], FontQuality = fqFineClearTypeRGB) else
+
+    BGRAText.BGRATextOut(self,FFont,FontQuality,x,y,s,c,nil,align);
 end;
 
 procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer;
   s: string; style: TTextStyle; c: TBGRAPixel);
-var
-  tx, ty: integer;
-  temp:   TBGRADefaultBitmap;
-  P:      PBGRAPixel;
-  n:      integer;
-  alpha:  integer;
 begin
   UpdateFont;
-
-  if ARect.Left < 0 then
-    ARect.Left := 0;
-  if ARect.Top < 0 then
-    ARect.Top := 0;
-  if ARect.Right > Width then
-    ARect.Right := Width;
-  if ARect.Bottom > Height then
-    ARect.Bottom := Height;
-
-  tx := ARect.Right - ARect.Left;
-  ty := ARect.Bottom - ARect.Top;
-  if (tx <= 0) or (ty <= 0) then
-    exit;
-  temp := NewBitmap(tx, ty);
-  temp.Fill(clBlack);
-  temp.Canvas.Font := FFont;
-  temp.Canvas.Font.Color := clWhite;
-  temp.Canvas.Brush.Style := bsClear;
-  temp.Canvas.TextRect(rect(0, 0, tx, ty), x - ARect.Left, y - ARect.Top, s, style);
-  p := temp.Data;
-  for n := tx * ty - 1 downto 0 do
-  begin
-    alpha    := P^.green;
-    p^.red   := c.red;
-    p^.green := c.green;
-    p^.blue  := c.blue;
-    p^.alpha := (c.alpha * alpha) div 255;
-    Inc(p);
-  end;
-  PutImage(ARect.Left, ARect.Top, temp, dmDrawWithTransparency);
-  temp.Free;
-end;
-
-{$hints off}
+  BGRAText.BGRATextRect(self,FFont,FontQuality,ARect,x,y,s,style,c,nil);
+end;
+
+procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; s: string;
+  style: TTextStyle; texture: IBGRAScanner);
+begin
+  UpdateFont;
+  BGRAText.BGRATextRect(self,FFont,FontQuality,ARect,x,y,s,style,BGRAPixelTransparent,texture);
+end;
+
 function TBGRADefaultBitmap.TextSize(s: string): TSize;
-var
-  temp: TBitmap;
 begin
   UpdateFont;
-
-  temp := TBitmap.Create;
-  temp.Canvas.Font := FFont;
-  temp.Canvas.Font.GetTextSize(s, Result.cx, Result.cy);
-  temp.Free;
-end;
-
-{$hints on}
-
-{----------------------- Spline ------------------}
-
-function TBGRADefaultBitmap.Spline(y0, y1, y2, y3: single; t: single): single;
-var
-  a0, a1, a2, a3: single;
-  t2: single;
-begin
-  t2     := t * t;
-  a0     := y3 - y2 - y0 + y1;
-  a1     := y0 - y1 - a0;
-  a2     := y2 - y0;
-  a3     := y1;
-  Result := a0 * t * t2 + a1 * t2 + a2 * t + a3;
-end;
-
-function TBGRADefaultBitmap.ComputeClosedSpline(points: array of TPointF):
-ArrayOfTPointF;
-
-  function computePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
-  var
-    len: single;
-  begin
-    len    := sqrt(sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y));
-    len    := max(len, sqrt(sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)));
-    len    := max(len, sqrt(sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)));
-    Result := round(sqrt(len) * 2);
-  end;
-
-var
-  i, j, nb, idx, pre: integer;
-  ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
-
-begin
-  if length(points) = 2 then
-  begin
-    setlength(Result, 2);
-    Result[0] := points[0];
-    Result[1] := points[1];
-    exit;
-  end;
-
-  nb := 1;
-  for i := 0 to high(points) do
-  begin
-    ptPrev2 := points[(i + length(points) - 1) mod length(points)];
-    ptPrev  := points[i];
-    ptNext  := points[(i + 1) mod length(points)];
-    ptNext2 := points[(i + 2) mod length(points)];
-    nb      += computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
-  end;
-
-  setlength(Result, nb);
-  Result[0] := points[0];
-  idx := 1;
-  for i := 0 to high(points) do
-  begin
-    ptPrev2 := points[(i + length(points) - 1) mod length(points)];
-    ptPrev  := points[i];
-    ptNext  := points[(i + 1) mod length(points)];
-    ptNext2 := points[(i + 2) mod length(points)];
-    pre     := computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
-    for j := 1 to pre - 1 do
-    begin
-      Result[idx] := pointF(spline(ptPrev2.x, ptPrev.X, ptNext.X, ptNext2.X, j / pre),
-        spline(ptPrev2.y, ptPrev.y, ptNext.y, ptNext2.y, j / pre));
-      Inc(idx);
-    end;
-    if pre <> 0 then
-    begin
-      Result[idx] := ptNext;
-      Inc(idx);
-    end;
-  end;
-end;
-
-function TBGRADefaultBitmap.ComputeOpenedSpline(points: array of TPointF):
-ArrayOfTPointF;
-
-  function computePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
-  var
-    len: single;
-  begin
-    len    := sqrt(sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y));
-    len    := max(len, sqrt(sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)));
-    len    := max(len, sqrt(sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)));
-    Result := round(sqrt(len) * 2);
-  end;
-
-var
-  i, j, nb, idx, pre: integer;
-  ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
-
-begin
-  if length(points) = 2 then
-  begin
-    setlength(Result, 2);
-    Result[0] := points[0];
-    Result[1] := points[1];
-    exit;
-  end;
-
-  nb := 1;
-  for i := 0 to high(points) - 1 do
-  begin
-    ptPrev2 := points[max(0, i - 1)];
-    ptPrev  := points[i];
-    ptNext  := points[i + 1];
-    ptNext2 := points[min(high(points), i + 2)];
-    nb      += computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
-  end;
-
-  setlength(Result, nb);
-  Result[0] := points[0];
-  idx := 1;
-  for i := 0 to high(points) - 1 do
-  begin
-    ptPrev2 := points[max(0, i - 1)];
-    ptPrev  := points[i];
-    ptNext  := points[i + 1];
-    ptNext2 := points[min(high(points), i + 2)];
-    pre     := computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
-    for j := 1 to pre - 1 do
-    begin
-      Result[idx] := pointF(spline(ptPrev2.x, ptPrev.X, ptNext.X, ptNext2.X, j / pre),
-        spline(ptPrev2.y, ptPrev.y, ptNext.y, ptNext2.y, j / pre));
-      Inc(idx);
-    end;
-    if pre <> 0 then
-    begin
-      Result[idx] := ptNext;
-      Inc(idx);
-    end;
-  end;
+  result := BGRAText.BGRATextSize(FFont,FontQuality,s,FontAntialiasingLevel);
+  if (result.cy >= 24) and FontAntialias then
+    result := BGRAText.BGRATextSize(FFont,FontQuality,s,4);
+end;
+
+{---------------------------- Curves ----------------------------------------}
+
+function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeClosedSpline(APoints, AStyle);
+end;
+
+function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeOpenedSpline(APoints, AStyle);
+end;
+
+function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve
+  ): ArrayOfTPointF;
+begin
+  Result:= BGRAPath.ComputeBezierCurve(ACurve);
+end;
+
+function TBGRADefaultBitmap.ComputeBezierCurve(
+  const ACurve: TQuadraticBezierCurve): ArrayOfTPointF;
+begin
+  Result:= BGRAPath.ComputeBezierCurve(ACurve);
+end;
+
+function TBGRADefaultBitmap.ComputeBezierSpline(
+  const ASpline: array of TCubicBezierCurve): ArrayOfTPointF;
+begin
+  Result:= BGRAPath.ComputeBezierSpline(ASpline);
+end;
+
+function TBGRADefaultBitmap.ComputeBezierSpline(
+  const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF;
+begin
+  Result:= BGRAPath.ComputeBezierSpline(ASpline);
+end;
+
+function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
+  w: single): ArrayOfTPointF;
+begin
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[],JoinMiterLimit);
+end;
+
+function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
+  w: single; Closed: boolean): ArrayOfTPointF;
+var
+  options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,pecRound,pjsRound,FCustomPenStyle,options,JoinMiterLimit);
+end;
+
+function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF;
+  w: single): ArrayOfTPointF;
+begin
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[plCycle],JoinMiterLimit);
+end;
+
+function TBGRADefaultBitmap.ComputeEllipse(x, y, rx, ry: single
+  ): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeEllipse(x,y,rx,ry);
+end;
+
+function TBGRADefaultBitmap.ComputeEllipse(x, y, rx, ry, w: single
+  ): ArrayOfTPointF;
+begin
+  result := ComputeWidePolygon(ComputeEllipse(x,y,rx,ry),w);
+end;
+
+function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536,
+  end65536: word): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536);
+end;
+
+function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad,
+  endRad: single): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeArc65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi));
+end;
+
+function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single
+  ): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry);
+end;
+
+function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single;
+  options: TRoundRectangleOptions): ArrayOfTPointF;
+begin
+  Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options);
+end;
+
+function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536,
+  end65536: word): ArrayOfTPointF;
+begin
+  result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536);
+  if (start65536 <> end65536) then
+  begin
+    setlength(result,length(result)+1);
+    result[high(result)] := PointF(x,y);
+  end;
+end;
+
+function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad,
+  endRad: single): ArrayOfTPointF;
+begin
+  result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi));
 end;
 
 {---------------------------------- Fill ---------------------------------}
 
-procedure TBGRADefaultBitmap.FillTransparent;
-begin
-  Fill(BGRAPixelTransparent);
-end;
-
-procedure TBGRADefaultBitmap.ApplyGlobalOpacity(alpha: byte);
-var
-  p: PBGRAPixel;
-  i: integer;
-begin
-  if alpha = 0 then
-    FillTransparent
-  else
-  if alpha <> 255 then
-  begin
-    p := Data;
-    for i := NbPixels - 1 downto 0 do
-    begin
-      p^.alpha := (p^.alpha * alpha + 128) shr 8;
-      Inc(p);
-    end;
-  end;
-end;
-
-procedure TBGRADefaultBitmap.Fill(c: TColor);
-begin
-  Fill(ColorToBGRA(c));
-end;
-
-procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel);
-begin
-  Fill(c, 0, Width * Height);
+procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner);
+begin
+  FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,dmSet);
 end;
 
@@ -2542 +2993 @@
 end;
 
-procedure TBGRADefaultBitmap.AlphaFill(alpha: byte);
-begin
-  AlphaFill(alpha, 0, NbPixels);
-end;
-
 procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer);
 begin
@@ -2565 +3011 @@
 end;
 
+procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
+  color: TBGRAPixel);
+var
+  scan: TBGRACustomScanner;
+begin
+  if (AMask = nil) or (color.alpha = 0) then exit;
+  scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),color);
+  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
+  scan.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
+  texture: IBGRAScanner);
+var
+  scan: TBGRACustomScanner;
+begin
+  if AMask = nil then exit;
+  scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),texture);
+  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
+  scan.Free;
+end;
+
+procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
+  AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean);
+begin
+  BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder);
+end;
+
+procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
+  AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean);
+begin
+  BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder);
+end;
+
+{ Replace color without taking alpha channel into account }
 procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor);
 const
@@ -2573 +3054 @@
   beforeBGR, afterBGR: longword;
 begin
-  beforeBGR := (before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF);
-  afterBGR  := (after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF);
+  beforeBGR := NtoLE((before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF));
+  afterBGR  := NtoLE((after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF));
 
   p := PLongWord(Data);
@@ -2606 +3087 @@
 end;
 
+{ Replace transparent pixels by the specified color }
 procedure TBGRADefaultBitmap.ReplaceTransparent(after: TBGRAPixel);
 var
@@ -2621 +3103 @@
 end;
 
-procedure TBGRADefaultBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel;
-  mode: TFloodfillMode; Tolerance: byte = 0);
-begin
-  ParallelFloodFill(X,Y,Self,Color,mode,Tolerance);
-end;
-
+{ General purpose FloodFill. It can be used to fill inplace or to
+  fill a destination bitmap according to the content of the current bitmap.
+
+  The first pixel encountered is taken as a reference, further pixels
+  are compared to this pixel. If the distance between next colors and
+  the first color is lower than the tolerance, then the floodfill continues.
+
+  It uses an array of bits to store visited places to avoid filling twice
+  the same area. It also uses a stack of positions to remember where
+  to continue after a place is completely filled.
+
+  The first direction to be checked is horizontal, then
+  it checks pixels on the line above and on the line below. }
 procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer;
-  Dest: TBGRADefaultBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
+  Dest: TBGRACustomBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
   Tolerance: byte);
 var
@@ -2699 +3188 @@
 
 begin
-  if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
+  if PtInClipRect(X,Y) then
   begin
     S := GetPixel(X, Y);
@@ -2717 +3206 @@
 
       SX := X;
-      while (SX > 0) and CheckPixel(Pred(SX), Y) do
+      while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do
         Dec(SX);
       EX := X;
-      while (EX < Pred(Width)) and CheckPixel(Succ(EX), Y) do
+      while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do
         Inc(EX);
 
@@ -2733 +3222 @@
 
       Added := False;
-      if Y > 0 then
+      if Y > FClipRect.Top then
         for I := SX to EX do
           if CheckPixel(I, Pred(Y)) then
           begin
-            if Added then
+            if Added then //do not add twice the same segment
               Continue;
             Push(I, Pred(Y));
@@ -2746 +3235 @@
 
       Added := False;
-      if Y < Pred(Height) then
+      if Y < Pred(FClipRect.Bottom) then
         for I := SX to EX do
           if CheckPixel(I, Succ(Y)) then
           begin
-            if Added then
+            if Added then //do not add twice the same segment
               Continue;
             Push(I, Succ(Y));
@@ -2764 +3253 @@
   c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
   gammaColorCorrection: boolean = True; Sinus: Boolean=False);
-var
-  u, p:   TPointF;
-  len, a: single;
-  xb, yb, temp: integer;
-  b:      integer;
-  c:      TBGRAPixel;
-  ec, ec1, ec2: TExpandedPixel;
-  pixelProc: procedure(x, y: integer; col: TBGRAPixel) of object;
-begin
-  if (x > x2) then
-  begin
-    temp := x;
-    x    := x2;
-    x2   := temp;
-  end;
-  if (y > y2) then
-  begin
-    temp := y;
-    y    := y2;
-    y2   := temp;
-  end;
-  if x < 0 then x := 0;
-  if x2 > width then x2 := width;
-  if y < 0 then y := 0;
-  if y2 > height then y2 := height;
-  if (x2 <= x) or (y2 <= y) then exit;
-
+begin
+  BGRAGradientFill(self, x, y, x2, y2, c1, c2, gtype, o1, o2, mode, gammaColorCorrection, Sinus);
+end;
+
+procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
+  gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
+  mode: TDrawMode; Sinus: Boolean);
+var
+  scanner: TBGRAGradientScanner;
+begin
+  scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
+  FillRect(x,y,x2,y2,scanner,mode);
+  scanner.Free;
+end;
+
+function TBGRADefaultBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
+                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap;
+begin
+  result := BGRAPen.CreateBrushTexture(self,ABrushStyle,APatternColor,ABackgroundColor,AWidth,AHeight,APenWidth);
+end;
+
+{ Scanning procedures for IBGRAScanner interface }
+procedure TBGRADefaultBitmap.ScanMoveTo(X, Y: Integer);
+begin
+  LoadFromBitmapIfNeeded;
+  FScanCurX := PositiveMod(X+ScanOffset.X, FWidth);
+  FScanCurY := PositiveMod(Y+ScanOffset.Y, FHeight);
+  FScanPtr := ScanLine[FScanCurY];
+end;
+
+function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel;
+begin
+  result := (FScanPtr+FScanCurX)^;
+  inc(FScanCurX);
+  if FScanCurX = FWidth then //cycle
+    FScanCurX := 0;
+end;
+
+function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel;
+begin
+  Result:= GetPixelCycle(x+ScanOffset.X,y+ScanOffset.Y,ScanInterpolationFilter);
+end;
+
+function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean;
+begin
+  Result:= true;
+end;
+
+procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+var
+  i,nbCopy: Integer;
+  c: TBGRAPixel;
+begin
   case mode of
-    dmSet, dmSetExceptTransparent: pixelProc := @SetPixel;
-    dmDrawWithTransparency: pixelProc := @DrawPixel;
-    dmFastBlend: pixelProc := @FastBlendPixel;
-  end;
-  //handles transparency
-  if (c1.alpha = 0) and (c2.alpha = 0) then
-  begin
-    FillRect(x, y, x2, y2, BGRAPixelTransparent, mode);
-    exit;
-  end;
-  if c1.alpha = 0 then
-  begin
-    c1.red   := c2.red;
-    c1.green := c2.green;
-    c1.blue  := c2.blue;
-  end
-  else
-  if c2.alpha = 0 then
-  begin
-    c2.red   := c1.red;
-    c2.green := c1.green;
-    c2.blue  := c1.blue;
-  end;
-
-  //compute vector
-  u.x := o2.x - o1.x;
-  u.y := o2.y - o1.y;
-  len := sqrt(sqr(u.x) + sqr(u.y));
-  if len = 0 then
-  begin
-    FillRect(x, y, x2, y2, MergeBGRA(c1, c2), mode);
-    exit;
-  end;
-  u.x /= len;
-  u.y /= len;
-
-  ec1 := GammaExpansion(c1);
-  ec2 := GammaExpansion(c2);
-  if gammaColorCorrection then
-  begin
-    //render with gamma correction
-    case gtype of
-      gtLinear:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := p.x * u.x + p.y * u.y;
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
-              ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
-              ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
-              ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
-              c      := GammaCompression(ec);
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtReflected:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := abs(p.x * u.x + p.y * u.y);
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
-              ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
-              ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
-              ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
-              c      := GammaCompression(ec);
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtDiamond:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := max(abs(p.x * u.x + p.y * u.y), abs(p.x * u.y - p.y * u.x));
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
-              ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
-              ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
-              ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
-              c      := GammaCompression(ec);
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtRadial:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
-              ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
-              ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
-              ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
-              c      := GammaCompression(ec);
-            end;
-            pixelProc(xb, yb, c);
-          end;
-    end;
-  end
-  else
-  begin
-    //render without gamma correction
-    case gtype of
-      gtLinear:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := p.x * u.x + p.y * u.y;
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
-              c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
-              c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
-              c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtReflected:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := abs(p.x * u.x + p.y * u.y);
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
-              c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
-              c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
-              c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtDiamond:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := max(abs(p.x * u.x + p.y * u.y), abs(p.x * u.y - p.y * u.x));
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
-              c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
-              c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
-              c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
-            end;
-            pixelProc(xb, yb, c);
-          end;
-
-      gtRadial:
-        for yb := y to y2 - 1 do
-          for xb := x to x2 - 1 do
-          begin
-            p.x := xb - o1.x;
-            p.y := yb - o1.y;
-            a   := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
-            if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
-            if a < 0 then
-              c := c1
-            else
-            if a > len then
-              c := c2
-            else
-            begin
-              b      := round(a / len * 256);
-              c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
-              c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
-              c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
-              c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
-            end;
-            pixelProc(xb, yb, c);
-          end;
-    end;
-  end;
-end;
-
+    dmLinearBlend:
+      for i := 0 to count-1 do
+      begin
+        FastBlendPixelInline(pdest, ScanNextPixel);
+        inc(pdest);
+      end;
+    dmDrawWithTransparency:
+      for i := 0 to count-1 do
+      begin
+        DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel);
+        inc(pdest);
+      end;
+    dmSet:
+      while count > 0 do
+      begin
+        nbCopy := FWidth-FScanCurX;
+        if count < nbCopy then nbCopy := count;
+        move((FScanPtr+FScanCurX)^,pdest^,nbCopy*sizeof(TBGRAPixel));
+        inc(pdest,nbCopy);
+        inc(FScanCurX,nbCopy);
+        if FScanCurX = FWidth then FScanCurX := 0;
+        dec(count,nbCopy);
+      end;
+    dmSetExceptTransparent:
+      for i := 0 to count-1 do
+      begin
+        c := ScanNextPixel;
+        if c.alpha = 255 then pdest^ := c;
+        inc(pdest);
+      end;
+    dmXor:
+      for i := 0 to count-1 do
+      begin
+        PDWord(pdest)^ := PDWord(pdest)^ xor DWord(ScanNextPixel);
+        inc(pdest);
+      end;
+  end;
+end;
+
+{ General purpose pixel drawing function }
 procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer);
 var
@@ -3044 +3354 @@
   if c.alpha = 0 then
     exit;
+  if c.alpha = 255 then
+  begin
+    Fill(c,start,Count);
+    exit;
+  end;
 
   if start < 0 then
@@ -3056 +3371 @@
 
   p := Data + start;
-  while Count > 0 do
-  begin
-    DrawPixelInline(p, c);
-    Inc(p);
-    Dec(Count);
-  end;
+  DrawPixelsInline(p,c,Count);
   InvalidateBitmap;
 end;
@@ -3086 +3396 @@
 end;
 
+{ Ensure that transparent pixels have all channels to zero }
 procedure TBGRADefaultBitmap.ClearTransparentPixels;
 var
@@ -3101 +3412 @@
 end;
 
-procedure TBGRADefaultBitmap.PutImage(x, y: integer; Source: TBGRADefaultBitmap;
-  mode: TDrawMode);
-var
-  x2, y2, yb, minxb, minyb, maxxb, ignoreleft, copycount, sourcewidth,
+function TBGRADefaultBitmap.CheckPutImageBounds(x,y,tx,ty: integer; out minxb,minyb,maxxb,maxyb,ignoreleft: integer): boolean inline;
+var x2,y2: integer;
+begin
+  if (x >= FClipRect.Right) or (y >= FClipRect.Bottom) or (x <= FClipRect.Left-tx) or
+    (y <= FClipRect.Top-ty) or (Height = 0) or (ty = 0) or (tx = 0) then
+  begin
+    result := false;
+    exit;
+  end;
+
+  x2 := x + tx - 1;
+  y2 := y + ty - 1;
+
+  if y < FClipRect.Top then
+    minyb := FClipRect.Top
+  else
+    minyb := y;
+  if y2 >= FClipRect.Bottom then
+    maxyb := FClipRect.Bottom - 1
+  else
+    maxyb := y2;
+
+  if x < FClipRect.Left then
+  begin
+    ignoreleft := FClipRect.Left-x;
+    minxb      := FClipRect.Left;
+  end
+  else
+  begin
+    ignoreleft := 0;
+    minxb      := x;
+  end;
+  if x2 >= FClipRect.Right then
+    maxxb := FClipRect.Right - 1
+  else
+    maxxb := x2;
+
+  result := true;
+end;
+
+function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single;
+  w: single): boolean;
+var
+  temp: Single;
+begin
+  if (x > x2) then
+  begin
+    temp := x;
+    x    := x2;
+    x2   := temp;
+  end;
+  if (y > y2) then
+  begin
+    temp := y;
+    y    := y2;
+    y2   := temp;
+  end;
+
+  result := (x2 - x > w) and (y2 - y > w);
+end;
+
+function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas;
+begin
+  if FCanvasBGRA = nil then
+    FCanvasBGRA := TBGRACanvas.Create(self);
+  result := FCanvasBGRA;
+end;
+
+function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D;
+begin
+  if FCanvas2D = nil then
+    FCanvas2D := TBGRACanvas2D.Create(self);
+  result := FCanvas2D;
+end;
+
+procedure TBGRADefaultBitmap.PutImage(x, y: integer; Source: TBGRACustomBitmap;
+  mode: TDrawMode; AOpacity: byte);
+var
+  yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
   i, delta_source, delta_dest: integer;
   psource, pdest: PBGRAPixel;
-begin
+  tempPixel: TBGRAPixel;
+
+begin
+  if (source = nil) or (AOpacity = 0) then exit;
   sourcewidth := Source.Width;
 
-  if (x >= Width) or (y >= Height) or (x <= -sourcewidth) or
-    (y <= -Source.Height) or (Height = 0) or (Source.Height = 0) then
-    exit;
-
-  x2 := x + sourcewidth - 1;
-  y2 := y + Source.Height - 1;
-
-  if y < 0 then
-    minyb := 0
-  else
-    minyb := y;
-  if y2 >= Height then
-    y2 := Height - 1;
-
-  if x < 0 then
-  begin
-    ignoreleft := -x;
-    minxb      := 0;
-  end
-  else
-  begin
-    ignoreleft := 0;
-    minxb      := x;
-  end;
-  if x2 >= Width then
-    maxxb := Width - 1
-  else
-    maxxb := x2;
+  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
 
   copycount := maxxb - minxb + 1;
 
   psource := Source.ScanLine[minyb - y] + ignoreleft;
-  if Source.FLineOrder = riloBottomToTop then
+  if Source.LineOrder = riloBottomToTop then
     delta_source := -sourcewidth
   else
@@ -3156 +3518 @@
     dmSet:
     begin
-      copycount *= sizeof(TBGRAPixel);
-      for yb := minyb to y2 do
+      if AOpacity <> 255 then
       begin
-        move(psource^, pdest^, copycount);
-        Inc(psource, delta_source);
-        Inc(pdest, delta_dest);
+        for yb := minyb to maxyb do
+        begin
+          CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount);
+          Inc(psource, delta_source);
+          Inc(pdest, delta_dest);
+        end;
+      end
+      else
+      begin
+        copycount *= sizeof(TBGRAPixel);
+        for yb := minyb to maxyb do
+        begin
+          move(psource^, pdest^, copycount);
+          Inc(psource, delta_source);
+          Inc(pdest, delta_dest);
+        end;
       end;
       InvalidateBitmap;
@@ -3169 +3543 @@
       Dec(delta_source, copycount);
       Dec(delta_dest, copycount);
-      for yb := minyb to y2 do
+      for yb := minyb to maxyb do
       begin
-        for i := copycount - 1 downto 0 do
+        if AOpacity <> 255 then
         begin
-          if psource^.alpha = 255 then
-            pdest^ := psource^;
-          Inc(pdest);
-          Inc(psource);
-        end;
+          for i := copycount - 1 downto 0 do
+          begin
+            if psource^.alpha = 255 then
+            begin
+              tempPixel := psource^;
+              tempPixel.alpha := ApplyOpacity(tempPixel.alpha,AOpacity);
+              FastBlendPixelInline(pdest,tempPixel);
+            end;
+            Inc(pdest);
+            Inc(psource);
+          end;
+        end else
+          for i := copycount - 1 downto 0 do
+          begin
+            if psource^.alpha = 255 then
+              pdest^ := psource^;
+            Inc(pdest);
+            Inc(psource);
+          end;
         Inc(psource, delta_source);
         Inc(pdest, delta_dest);
@@ -3187 +3575 @@
       Dec(delta_source, copycount);
       Dec(delta_dest, copycount);
-      for yb := minyb to y2 do
+      for yb := minyb to maxyb do
       begin
-        for i := copycount - 1 downto 0 do
+        if AOpacity <> 255 then
         begin
-          DrawPixelInline(pdest, psource^);
-          Inc(pdest);
-          Inc(psource);
-        end;
+          for i := copycount - 1 downto 0 do
+          begin
+            DrawPixelInlineWithAlphaCheck(pdest, psource^, AOpacity);
+            Inc(pdest);
+            Inc(psource);
+          end;
+        end
+        else
+          for i := copycount - 1 downto 0 do
+          begin
+            DrawPixelInlineWithAlphaCheck(pdest, psource^);
+            Inc(pdest);
+            Inc(psource);
+          end;
         Inc(psource, delta_source);
         Inc(pdest, delta_dest);
@@ -3204 +3602 @@
       Dec(delta_source, copycount);
       Dec(delta_dest, copycount);
-      for yb := minyb to y2 do
+      for yb := minyb to maxyb do
       begin
-        for i := copycount - 1 downto 0 do
+        if AOpacity <> 255 then
         begin
-          FastBlendPixelInline(pdest, psource^);
-          Inc(pdest);
-          Inc(psource);
-        end;
+          for i := copycount - 1 downto 0 do
+          begin
+            FastBlendPixelInline(pdest, psource^, AOpacity);
+            Inc(pdest);
+            Inc(psource);
+          end;
+        end else
+          for i := copycount - 1 downto 0 do
+          begin
+            FastBlendPixelInline(pdest, psource^);
+            Inc(pdest);
+            Inc(psource);
+          end;
         Inc(psource, delta_source);
         Inc(pdest, delta_dest);
@@ -3217 +3624 @@
       InvalidateBitmap;
     end;
-  end;
-end;
-
-procedure TBGRADefaultBitmap.BlendImage(x, y: integer; Source: TBGRADefaultBitmap;
+    dmXor:
+    begin
+      if AOpacity <> 255 then
+      begin
+        Dec(delta_source, copycount);
+        Dec(delta_dest, copycount);
+        for yb := minyb to maxyb do
+        begin
+          for i := copycount - 1 downto 0 do
+          begin
+            FastBlendPixelInline(pdest, TBGRAPixel(PDWord(pdest)^ xor PDword(psource)^), AOpacity);
+            Inc(pdest);
+            Inc(psource);
+          end;
+          Inc(psource, delta_source);
+          Inc(pdest, delta_dest);
+        end;
+      end else
+      begin
+        for yb := minyb to maxyb do
+        begin
+          XorPixels(pdest, psource, copycount);
+          Inc(psource, delta_source);
+          Inc(pdest, delta_dest);
+        end;
+      end;
+      InvalidateBitmap;
+    end;
+  end;
+end;
+
+procedure TBGRADefaultBitmap.BlendImage(x, y: integer; Source: TBGRACustomBitmap;
   operation: TBlendOperation);
 var
-  x2, y2, yb, minxb, minyb, maxxb, ignoreleft, copycount, sourcewidth,
+  yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
   delta_source, delta_dest: integer;
   psource, pdest: PBGRAPixel;
@@ -3229 +3664 @@
   sourcewidth := Source.Width;
 
-  if (x >= Width) or (y >= Height) or (x <= -sourcewidth) or
-    (y <= -Source.Height) or (Height = 0) or (Source.Height = 0) then
-    exit;
-
-  x2 := x + sourcewidth - 1;
-  y2 := y + Source.Height - 1;
-
-  if y < 0 then
-    minyb := 0
-  else
-    minyb := y;
-  if y2 >= Height then
-    y2 := Height - 1;
-
-  if x < 0 then
-  begin
-    ignoreleft := -x;
-    minxb      := 0;
-  end
-  else
-  begin
-    ignoreleft := 0;
-    minxb      := x;
-  end;
-  if x2 >= Width then
-    maxxb := Width - 1
-  else
-    maxxb := x2;
+  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
 
   copycount := maxxb - minxb + 1;
 
   psource := Source.ScanLine[minyb - y] + ignoreleft;
-  if Source.FLineOrder = riloBottomToTop then
+  if Source.LineOrder = riloBottomToTop then
     delta_source := -sourcewidth
   else
@@ -3272 +3680 @@
     delta_dest := Width;
 
-  for yb := minyb to y2 do
+  for yb := minyb to maxyb do
   begin
     BlendPixels(pdest, psource, operation, copycount);
@@ -3281 +3689 @@
 end;
 
-function TBGRADefaultBitmap.Duplicate: TBGRADefaultBitmap;
+{ Draw an image wih an angle. Use an affine transformation to do this. }
+procedure TBGRADefaultBitmap.PutImageAngle(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
+  imageCenterY: single; AOpacity: Byte);
+var
+  cosa,sina: single;
+
+  { Compute rotated coordinates }
+  function Coord(relX,relY: single): TPointF;
+  begin
+    relX -= imageCenterX;
+    relY -= imageCenterY;
+    result.x := relX*cosa-relY*sina+x;
+    result.y := relY*cosa+relX*sina+y;
+  end;
+
+begin
+  cosa := cos(-angle*Pi/180);
+  sina := -sin(-angle*Pi/180);
+  PutImageAffine(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source,AOpacity);
+end;
+
+{ Draw an image with an affine transformation (rotation, scale, translate).
+  Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis. }
+procedure TBGRADefaultBitmap.PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte);
+var affine: TBGRAAffineBitmapTransform;
+    minx,miny,maxx,maxy: integer;
+    pt4: TPointF;
+
+  //include specified point in the bounds
+  procedure Include(pt: TPointF);
+  begin
+    if floor(pt.X) < minx then minx := floor(pt.X);
+    if floor(pt.Y) < miny then miny := floor(pt.Y);
+    if ceil(pt.X) > maxx then maxx := ceil(pt.X);
+    if ceil(pt.Y) > maxy then maxy := ceil(pt.Y);
+  end;
+
+begin
+  if (abs(Origin.x-round(Origin.x))<1e-6) and (abs(Origin.y-round(Origin.Y))<1e-6) and
+     (abs(HAxis.x-(Origin.x+Source.Width))<1e-6) and (abs(HAxis.y-origin.y)<1e-6) and
+     (abs(VAxis.x-Origin.x)<1e-6) and (abs(VAxis.y-(Origin.y+Source.Height))<1e-6) then
+  begin
+    PutImage(round(origin.x),round(origin.y),Source,dmDrawWithTransparency,AOpacity);
+    exit;
+  end;
+
+  { Create affine transformation }
+  affine := TBGRAAffineBitmapTransform.Create(Source);
+  affine.GlobalOpacity := AOpacity;
+  affine.Fit(Origin,HAxis,VAxis);
+
+  { Compute bounds }
+  pt4.x := VAxis.x+HAxis.x-Origin.x;
+  pt4.y := VAxis.y+HAxis.y-Origin.y;
+  minx := floor(Origin.X);
+  miny := floor(Origin.Y);
+  maxx := ceil(Origin.X);
+  maxy := ceil(Origin.Y);
+  Include(HAxis);
+  Include(VAxis);
+  Include(pt4);
+
+  { Use the affine transformation as a scanner }
+  FillRect(minx,miny,maxx+1,maxy+1,affine,dmDrawWithTransparency);
+  affine.Free;
+end;
+
+{ Duplicate bitmap content. Optionally, bitmap properties can be also duplicated }
+function TBGRADefaultBitmap.Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap;
+var Temp: TBGRADefaultBitmap;
 begin
   LoadFromBitmapIfNeeded;
-  Result := NewBitmap(Width, Height);
-  Result.PutImage(0, 0, self, dmSet);
-  Result.Caption := self.Caption;
-end;
-
-function TBGRADefaultBitmap.Equals(comp: TBGRADefaultBitmap): boolean;
+  Temp := NewBitmap(Width, Height) as TBGRADefaultBitmap;
+  Temp.PutImage(0, 0, self, dmSet);
+  Temp.Caption := self.Caption;
+  if DuplicateProperties then
+    CopyPropertiesTo(Temp);
+  Result := Temp;
+end;
+
+{ Copy properties only }
+procedure TBGRADefaultBitmap.CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
+begin
+  ABitmap.CanvasOpacity := CanvasOpacity;
+  ABitmap.CanvasDrawModeFP := CanvasDrawModeFP;
+  ABitmap.PenStyle := PenStyle;
+  ABitmap.CustomPenStyle := CustomPenStyle;
+  ABitmap.FontHeight := FontHeight;
+  ABitmap.FontName := FontName;
+  ABitmap.FontStyle := FontStyle;
+  ABitmap.FontAntialias := FontAntialias;
+  ABitmap.FontOrientation := FontOrientation;
+  ABitmap.LineCap := LineCap;
+  ABitmap.JoinStyle := JoinStyle;
+  ABitmap.FillMode := FillMode;
+  ABitmap.ClipRect := ClipRect;
+end;
+
+{ Check if two bitmaps have the same content }
+function TBGRADefaultBitmap.Equals(comp: TBGRACustomBitmap): boolean;
 var
   yb, xb: integer;
@@ -3320 +3820 @@
 end;
 
+{ Check if a bitmap is filled wih the specified color }
 function TBGRADefaultBitmap.Equals(comp: TBGRAPixel): boolean;
 var
@@ -3338 +3839 @@
 end;
 
-function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap;
+{----------------------------- Filters -----------------------------------------}
+{ Call the appropriate function }
+
+function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterSmartZoom3(self, Option);
 end;
 
-function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterMedian(self, option);
 end;
 
-function TBGRADefaultBitmap.FilterSmooth: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterSmooth: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterBlurRadialPrecise(self, 0.3);
 end;
 
-function TBGRADefaultBitmap.FilterSphere: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterSphere: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterSphere(self);
 end;
 
-function TBGRADefaultBitmap.FilterCylinder: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent);
+end;
+
+function TBGRADefaultBitmap.FilterCylinder: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterCylinder(self);
 end;
 
-function TBGRADefaultBitmap.FilterPlane: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterPlane: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterPlane(self);
 end;
 
-function TBGRADefaultBitmap.FilterSharpen: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterSharpen: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterSharpen(self);
 end;
 
-function TBGRADefaultBitmap.FilterContour: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterContour: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterContour(self);
@@ -3379 +3888 @@
 
 function TBGRADefaultBitmap.FilterBlurRadial(radius: integer;
-  blurType: TRadialBlurType): TBGRADefaultBitmap;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterBlurRadial(self, radius, blurType);
 end;
 
+function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
+  useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
+begin
+  Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter);
+end;
+
 function TBGRADefaultBitmap.FilterBlurMotion(distance: integer;
-  angle: single; oriented: boolean): TBGRADefaultBitmap;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterBlurMotion(self, distance, angle, oriented);
 end;
 
-function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRADefaultBitmap):
-TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRACustomBitmap):
+TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterBlur(self, mask);
 end;
 
-function TBGRADefaultBitmap.FilterEmboss(angle: single): TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterEmboss(angle: single): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterEmboss(self, angle);
@@ -3402 +3917 @@
 
 function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean):
-TBGRADefaultBitmap;
+TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection);
 end;
 
-function TBGRADefaultBitmap.FilterGrayscale: TBGRADefaultBitmap;
+function TBGRADefaultBitmap.FilterGrayscale: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterGrayscale(self);
@@ -3413 +3928 @@
 
 function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True):
-TBGRADefaultBitmap;
+TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterNormalize(self, eachChannel);
@@ -3419 +3934 @@
 
 function TBGRADefaultBitmap.FilterRotate(origin: TPointF;
-  angle: single): TBGRADefaultBitmap;
+  angle: single): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterRotate(self, origin, angle);
@@ -3481 +3996 @@
 end;
 
+function TBGRADefaultBitmap.CreateAdaptedPngWriter: TFPWriterPNG;
+begin
+  result := TFPWriterPNG.Create;
+  result.Indexed := False;
+  result.UseAlpha := HasTransparentPixels;
+  result.WordSized := false;
+end;
+
+{$hints off}
+function TBGRADefaultBitmap.LoadAsBmp32(Str: TStream): boolean;
+var OldPos: int64;
+    fileHeader: TBitmapFileHeader;
+    infoHeader: TBitmapInfoHeader;
+    dataSize: integer;
+begin
+  OldPos := Str.Position;
+  result := false;
+  try
+    if Str.Read(fileHeader,sizeof(fileHeader)) <> sizeof(fileHeader) then
+      raise exception.Create('Inuable to read file header');
+    if fileHeader.bfType = $4D42 then
+    begin
+      if Str.Read(infoHeader,sizeof(infoHeader)) <> sizeof(infoHeader) then
+        raise exception.Create('Inuable to read info header');
+
+      if (infoHeader.biPlanes = 1) and (infoHeader.biBitCount = 32) and (infoHeader.biCompression = 0) then
+      begin
+        SetSize(infoHeader.biWidth,infoHeader.biHeight);
+        Str.Position := OldPos+fileHeader.bfOffBits;
+        dataSize := NbPixels*sizeof(TBGRAPixel);
+        if Str.Read(Data^, dataSize) <> dataSize then
+        Begin
+          SetSize(0,0);
+          raise exception.Create('Unable to read data');
+        end;
+        result := true;
+      end;
+    end;
+
+  except
+    on ex:exception do
+    begin
+
+    end;
+  end;
+  Str.Position := OldPos;
+
+end;
+{$hints on}
+
 procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte);
 begin
@@ -3496 +4061 @@
 
 function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer):
-TBGRADefaultBitmap;
-begin
-  Result := BGRAResample.FineResample(self, NewWidth, NewHeight);
+TBGRACustomBitmap;
+begin
+  Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter);
 end;
 
 function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer):
-TBGRADefaultBitmap;
+TBGRACustomBitmap;
 begin
   Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight);
@@ -3508 +4073 @@
 
 function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer;
-  mode: TResampleMode): TBGRADefaultBitmap;
+  mode: TResampleMode): TBGRACustomBitmap;
 begin
   case mode of
@@ -3520 +4085 @@
 {-------------------------------- Data functions ------------------------}
 
+{ Flip vertically the bitmap. Use a temporary line to store top line,
+  assign bottom line to top line, then assign temporary line to bottom line.
+
+  It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.VerticalFlip;
 var
@@ -3531 +4100 @@
     exit;
 
+  LoadFromBitmapIfNeeded;
   linesize := Width * sizeof(TBGRAPixel);
   line     := nil;
@@ -3548 +4118 @@
 end;
 
+{ Flip horizontally. Swap left pixels with right pixels on each line.
+
+  It is an involution, i.e it does nothing when applied twice}
 procedure TBGRADefaultBitmap.HorizontalFlip;
 var
@@ -3558 +4131 @@
     exit;
 
+  LoadFromBitmapIfNeeded;
   for yb := 0 to Height - 1 do
   begin
@@ -3574 +4148 @@
 end;
 
-function TBGRADefaultBitmap.RotateCW: TBGRADefaultBitmap;
+{ Return a new bitmap rotated in a clock wise direction. }
+function TBGRADefaultBitmap.RotateCW: TBGRACustomBitmap;
 var
   psrc, pdest: PBGRAPixel;
@@ -3580 +4155 @@
   delta: integer;
 begin
+  LoadFromBitmapIfNeeded;
   Result := NewBitmap(Height, Width);
   if Result.LineOrder = riloTopToBottom then
@@ -3598 +4174 @@
 end;
 
-function TBGRADefaultBitmap.RotateCCW: TBGRADefaultBitmap;
+{ Return a new bitmap rotated in a counter clock wise direction. }
+function TBGRADefaultBitmap.RotateCCW: TBGRACustomBitmap;
 var
   psrc, pdest: PBGRAPixel;
@@ -3604 +4181 @@
   delta: integer;
 begin
+  LoadFromBitmapIfNeeded;
   Result := NewBitmap(Height, Width);
   if Result.LineOrder = riloTopToBottom then
@@ -3622 +4200 @@
 end;
 
+{ Compute negative with gamma correction. A negative contains
+  complentary colors (black becomes white etc.).
+
+  It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.Negative;
 var
@@ -3627 +4209 @@
   n: integer;
 begin
+  LoadFromBitmapIfNeeded;
   p := Data;
   for n := NbPixels - 1 downto 0 do
@@ -3641 +4224 @@
 end;
 
+{ Compute negative without gamma correction.
+
+  It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.LinearNegative;
 var
@@ -3646 +4232 @@
   n: integer;
 begin
+  LoadFromBitmapIfNeeded;
   p := Data;
   for n := NbPixels - 1 downto 0 do
@@ -3660 +4247 @@
 end;
 
+{ Swap red and blue channels. Useful when RGB order is swapped.
+
+  It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.SwapRedBlue;
 var
@@ -3666 +4256 @@
   p:    PLongword;
 begin
+  LoadFromBitmapIfNeeded;
   p := PLongword(Data);
   n := NbPixels;
@@ -3671 +4262 @@
     exit;
   repeat
-    temp := p^;
-    p^   := ((temp and $FF) shl 16) or ((temp and $FF0000) shr 16) or
-      temp and $FF00FF00;
+    temp := LEtoN(p^);
+    p^   := NtoLE(((temp and $FF) shl 16) or ((temp and $FF0000) shr 16) or
+      temp and $FF00FF00);
     Inc(p);
     Dec(n);
@@ -3680 +4271 @@
 end;
 
+{ Convert a grayscale image into a black image with alpha value }
 procedure TBGRADefaultBitmap.GrayscaleToAlpha;
 var
@@ -3686 +4278 @@
   p:    PLongword;
 begin
+  LoadFromBitmapIfNeeded;
   p := PLongword(Data);
   n := NbPixels;
@@ -3691 +4284 @@
     exit;
   repeat
-    temp := p^;
-    p^   := (temp and $FF) shl 24;
+    temp := LEtoN(p^);
+    p^   := NtoLE((temp and $FF) shl 24);
     Inc(p);
     Dec(n);
@@ -3705 +4298 @@
   p:    PLongword;
 begin
+  LoadFromBitmapIfNeeded;
   p := PLongword(Data);
   n := NbPixels;
@@ -3710 +4304 @@
     exit;
   repeat
-    temp := p^ shr 24;
-    p^   := temp or (temp shl 8) or (temp shl 16) or $FF000000;
+    temp := LEtoN(p^ shr 24);
+    p^   := NtoLE(temp or (temp shl 8) or (temp shl 16) or $FF000000);
     Inc(p);
     Dec(n);
@@ -3718 +4312 @@
 end;
 
-procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRADefaultBitmap);
+{ Apply a mask to the bitmap. It means that alpha channel is
+  changed according to grayscale values of the mask.
+
+  See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 }
+procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRACustomBitmap);
 var
   p, pmask: PBGRAPixel;
@@ -3726 +4324 @@
     exit;
 
+  LoadFromBitmapIfNeeded;
   for yb := 0 to Height - 1 do
   begin
@@ -3732 +4331 @@
     for xb := Width - 1 downto 0 do
     begin
-      p^.alpha := (p^.alpha * pmask^.red + 128) div 255;
+      p^.alpha := ApplyOpacity(p^.alpha, pmask^.red);
       Inc(p);
       Inc(pmask);
@@ -3740 +4339 @@
 end;
 
+procedure TBGRADefaultBitmap.ApplyGlobalOpacity(alpha: byte);
+var
+  p: PBGRAPixel;
+  i: integer;
+begin
+  if alpha = 0 then
+    FillTransparent
+  else
+  if alpha <> 255 then
+  begin
+    p := Data;
+    for i := NbPixels - 1 downto 0 do
+    begin
+      p^.alpha := ApplyOpacity(p^.alpha, alpha);
+      Inc(p);
+    end;
+  end;
+end;
+
+{ Get bounds of non zero values of specified channel }
 function TBGRADefaultBitmap.GetImageBounds(Channel: TChannel = cAlpha): TRect;
 var
@@ -3793 +4412 @@
 end;
 
+function TBGRADefaultBitmap.GetImageBounds(Channels: TChannels): TRect;
+var c: TChannel;
+begin
+  result := rect(0,0,0,0);
+  for c := low(TChannel) to high(TChannel) do
+    if c in Channels then
+      UnionRect(result,result,GetImageBounds(c));
+end;
+
+{ Make a copy of the transparent bitmap to a TBitmap with a background color
+  instead of transparency }
 function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
 var
-  opaqueCopy: TBGRADefaultBitmap;
+  opaqueCopy: TBGRACustomBitmap;
 begin
   Result     := TBitmap.Create;
@@ -3807 +4437 @@
 end;
 
-procedure TBGRADefaultBitmap.DrawPart(Arect: TRect; Canvas: TCanvas;
-  x, y: integer; Opaque: boolean);
-var
-  partial: TBGRADefaultBitmap;
-begin
-  partial := GetPart(ARect);
-  if partial <> nil then
-  begin
-    partial.Draw(Canvas, x, y, Opaque);
-    partial.Free;
-  end;
-end;
-
-function TBGRADefaultBitmap.GetPart(ARect: TRect): TBGRADefaultBitmap;
+{ Get a part of the image with repetition in both directions. It means
+  that if the bounds are within the image, the result is just that part
+  of the image, but if the bounds are bigger than the image, the image
+  is tiled. }
+function TBGRADefaultBitmap.GetPart(ARect: TRect): TBGRACustomBitmap;
 var
   copywidth, copyheight, widthleft, heightleft, curxin, curyin, xdest,
@@ -3890 +4511 @@
 end;
 
+function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer
+  ): TBGRACustomBitmap;
+var temp: integer;
+    ptrbmp: TBGRAPtrBitmap;
+begin
+  if Top > Bottom then
+  begin
+    temp := Top;
+    Top := Bottom;
+    Bottom := Temp;
+  end;
+  if Top < 0 then Top := 0;
+  if Bottom > Height then Bottom := Height;
+  if Top >= Bottom then
+    result := nil
+  else
+  begin
+    if LineOrder = riloTopToBottom then
+      ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Top]) else
+      ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Bottom-1]);
+    ptrbmp.LineOrder := LineOrder;
+    result := ptrbmp;
+  end;
+end;
+
+{ Draw BGRA data to a canvas with transparency }
 procedure TBGRADefaultBitmap.DataDrawTransparent(ACanvas: TCanvas;
   Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
@@ -3911 +4558 @@
 end;
 
+{ Draw BGRA data to a canvas without transparency }
 procedure TBGRADefaultBitmap.DataDrawOpaque(ACanvas: TCanvas;
   Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
@@ -3924 +4572 @@
   ALineEndMargin: integer;
   CreateResult: boolean;
-{$IFDEF DARWIN}
-  TempShift: byte;
-{$ENDIF}
+  {$IFDEF DARWIN}
+  TempShift: Byte;
+  {$ENDIF}
 begin
   if (AHeight = 0) or (AWidth = 0) then
@@ -3939 +4587 @@
   PTempData := TempData;
   PSource   := AData;
-     {$IFDEF DARWIN}
-  SwapRedBlue; //swap red and blue values
-     {$ENDIF}
+
+{$IFDEF DARWIN} //swap red and blue values
   for y := 0 to AHeight - 1 do
   begin
     for x := 0 to AWidth - 1 do
     begin
-      PWord(PTempData)^ := PWord(PSource)^;
-      Inc(PTempData, 2);
-      Inc(PSource, 2);
-      PTempData^ := PSource^;
-      Inc(PTempData);
-      Inc(PSource, 2);
+      PTempData^ := (PSource+2)^;
+      (PTempData+1)^ := (PSource+1)^;
+      (PTempData+2)^ := PSource^;
+      inc(PTempData,3);
+      inc(PSource,4);
     end;
     Inc(PTempData, ALineEndMargin);
   end;
-     {$IFDEF DARWIN}
-  SwapRedBlue; //swap red and blue values
-     {$ENDIF}
+{$ELSE}
+  for y := 0 to AHeight - 1 do
+  begin
+    for x := 0 to AWidth - 1 do
+    begin
+      PWord(PTempData)^ := PWord(PSource)^;
+      (PTempData+2)^ := (PSource+2)^;
+      Inc(PTempData,3);
+      Inc(PSource, 4);
+    end;
+    Inc(PTempData, ALineEndMargin);
+  end;
+{$ENDIF}
 
   RawImage.Init;
   RawImage.Description.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight);
-     {$IFDEF DARWIN}
-  //swap red and blue positions
+{$IFDEF DARWIN}
   TempShift := RawImage.Description.RedShift;
   RawImage.Description.RedShift := RawImage.Description.BlueShift;
   RawImage.Description.BlueShift := TempShift;
-     {$ENDIF}
+{$ENDIF}
+
   RawImage.Description.LineOrder := ALineOrder;
   RawImage.Description.LineEnd := rileDWordBoundary;
+
   if integer(RawImage.Description.BytesPerLine) <> AWidth * 3 + ALineEndMargin then
   begin
@@ -3999 +4656 @@
     raise EOutOfMemory.Create('TBGRADefaultBitmap: Not enough memory');
   InvalidateBitmap;
+  FScanPtr := nil;
 end;
 
@@ -4042 +4700 @@
 var
   bmp: TBitmap;
-  subBmp: TBGRADefaultBitmap;
+  subBmp: TBGRACustomBitmap;
   subRect: TRect;
   cw,ch: integer;
@@ -4081 +4739 @@
 end;
 
+function TBGRADefaultBitmap.GetNbPixels: integer;
+begin
+  result := FNbPixels;
+end;
+
+function TBGRADefaultBitmap.GetWidth: integer;
+begin
+  Result := FWidth;
+end;
+
+function TBGRADefaultBitmap.GetHeight: integer;
+begin
+  Result:= FHeight;
+end;
+
+function TBGRADefaultBitmap.GetRefCount: integer;
+begin
+  result := FRefCount;
+end;
+
+function TBGRADefaultBitmap.GetLineOrder: TRawImageLineOrder;
+begin
+  result := FLineOrder;
+end;
+
+function TBGRADefaultBitmap.GetCanvasOpacity: byte;
+begin
+  result:= FCanvasOpacity;
+end;
+
+function TBGRADefaultBitmap.GetFontHeight: integer;
+begin
+  result := FFontHeight;
+end;
+
 { TBGRAPtrBitmap }
 
@@ -4099 +4792 @@
 end;
 
-function TBGRAPtrBitmap.Duplicate: TBGRADefaultBitmap;
+function TBGRAPtrBitmap.Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap;
 begin
   Result := NewBitmap(Width, Height);
-  TBGRAPtrBitmap(Result).SetDataPtr(FData);
+  if DuplicateProperties then CopyPropertiesTo(TBGRADefaultBitmap(Result));
 end;
 
@@ -4108 +4801 @@
 begin
   FData := AData;
+end;
+
+procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
+  c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
+var
+  gradScan : TBGRAGradientScanner;
+begin
+  //handles transparency
+  if (c1.alpha = 0) and (c2.alpha = 0) then
+  begin
+    bmp.FillRect(x, y, x2, y2, BGRAPixelTransparent, mode);
+    exit;
+  end;
+
+  gradScan := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
+  bmp.FillRect(x,y,x2,y2,gradScan,mode);
+  gradScan.Free;
 end;
 

GraphicTest/BGRABitmap/bgradnetdeserial.pas

@@ -4 +4 @@
 
 interface
+
+{ This unit allow to read .Net serialized classes with BinaryFormatter of
+  namespace System.Runtime.Serialization.Formatters.Binary.
+
+  Serialization is a process by which objects in memory are saved according
+  to their structure.
+
+  This unit is used by BGRAPaintNet to read Paint.NET images. }
 
 uses
@@ -9 +17 @@
 
 type
+  arrayOfLongword = array of longword;
+
   TTypeCategory = (ftPrimitiveType = 0, ftString = 1, ftObjectType =
     2, ftRuntimeType = 3,
@@ -17 +27 @@
     ptDouble = 6, ptInt16 = 7, ptInt32 = 8, ptInt64 = 9, ptSByte = 10, ptSingle = 11,
     ptDateTime = 13, ptUInt16 = 14, ptUInt32 = 15, ptUInt64 = 16, ptString = 18);
+
+  TGenericArrayType = (gatSingleDimension, gatJagged, gatMultidimensional);
+
+  TDotNetDeserialization = class;
 
   ArrayOfNameValue = array of record
@@ -43 +57 @@
   end;
 
-  PSerializedObject = ^TSerializedObject;
-
-  TSerializedObject = record
+  { TCustomSerializedObject }
+
+  TCustomSerializedObject = class
+  protected
+    FContainer: TDotNetDeserialization;
+    function GetTypeAsString: string; virtual; abstract;
+    function GetFieldAsString(Index: longword): string; virtual; abstract;
+    function GetFieldAsString(Name: string): string;
+    function GetFieldCount: longword; virtual; abstract;
+    function GetFieldName(Index: longword): string; virtual; abstract;
+    function GetFieldTypeAsString(Index: longword): string; virtual; abstract;
+    function IsReferenceType(index: longword): boolean; virtual; abstract;
+  public
     idObject:   longword;
-    numType:    integer;
-    fields:     ArrayOfNameValue;
     refCount:   integer;
     inToString: boolean;
+    constructor Create(container: TDotNetDeserialization); virtual;
+    property FieldCount: longword read GetFieldCount;
+    property FieldName[Index: longword]:string read GetFieldName;
+    property FieldAsString[Index: longword]: string read GetFieldAsString;
+    property FieldByNameAsString[Name: string]: string read GetFieldAsString;
+    property FieldTypeAsString[Index: longword]: string read GetFieldTypeAsString;
+    property TypeAsString: string read GetTypeAsString;
+    function GetFieldIndex(Name: string): integer;
+  end;
+
+  { TSerializedClass }
+
+  TSerializedClass = class(TCustomSerializedObject)
+  protected
+    function GetFieldAsString(Index: longword): string; override;
+    function GetFieldCount: longword; override;
+    function GetFieldName(Index: longword): string; override;
+    function GetFieldTypeAsString(Index: longword): string; override;
+    function IsReferenceType(index: longword): boolean; override;
+    function GetTypeAsString: string; override;
+  public
+    numType: integer;
+    fields:  ArrayOfNameValue;
+  end;
+
+  { TSerializedArray }
+
+  TSerializedArray = class(TCustomSerializedObject)
+  private
+    data:       pointer;
+    FItemSize:   longword;
+    function GetItemPtr(Index: longword): pointer;
+    procedure InitData;
+  protected
+    FArrayType: TGenericArrayType;
+    function GetFieldAsString(Index: longword): string; override;
+    function GetFieldCount: longword; override;
+    function GetFieldName(Index: longword): string; override;
+    function GetFieldTypeAsString(Index: longword): string; override;
+    function IsReferenceType(index: longword): boolean; override;
+    function GetTypeAsString: string; override;
+  public
+    dimensions: array of longword;
+    itemType:   TFieldType;
+    nbItems:    longword;
+    constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: longword); overload;
+    constructor Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType; ADimensions: arrayOfLongword); overload;
+    destructor Destroy; override;
+    property ItemPtr[Index:longword]: pointer read GetItemPtr;
+    property ItemSize: longword read FItemSize;
+  end;
+
+  { TSerializedValue }
+
+  TSerializedValue = class(TSerializedArray)
+  protected
+    function GetIsReferenceType: boolean;
+    function GetValueAsString: string;
+    function GetTypeAsString: string; override;
+  public
+    constructor Create(AContainer: TDotNetDeserialization; AItemType: TFieldType); overload;
+    property ValueAsString: string read GetValueAsString;
+    property IsReferenceType: boolean read GetIsReferenceType;
   end;
 
@@ -57 +142 @@
     objectTypes: array of TSerializedType;
     assemblies:  array of TAssemblyReference;
-    objects:     array of TSerializedObject;
-
-    function FindObject(typeName: string): PSerializedObject;
-    function GetSimpleField(obj: TSerializedObject; Name: string): string;
-    function FieldIndex(obj: TSerializedObject; Name: string): integer;
-    function GetObjectField(obj: TSerializedObject; Name: string): PSerializedObject;
-    function GetObject(id: string): PSerializedObject;
-    function GetObject(id: longword): PSerializedObject;
-    function GetObjectType(obj: PSerializedObject): string;
-    function PrimitiveTypeName(pt: TPrimitiveType): string;
-    function IsBoxedValue(obj: TSerializedObject; index: integer): boolean;
-    function GetBoxedValue(obj: TSerializedObject; index: integer): string;
-    function IsReferenceType(numType: integer; index: integer): boolean;
+    objects:     array of TCustomSerializedObject;
+
+    function FindClass(typeName: string): TSerializedClass;
+    function FindObject(typeName: string): TCustomSerializedObject;
+    function GetSimpleField(obj: TCustomSerializedObject; Name: string): string;
+    function GetObjectField(obj: TCustomSerializedObject; Name: string): TCustomSerializedObject;
+    function GetObjectField(obj: TCustomSerializedObject; index: integer): TCustomSerializedObject;
+    function GetObject(id: string): TCustomSerializedObject;
+    function GetObject(id: longword): TCustomSerializedObject;
+    function IsBoxedValue(obj: TCustomSerializedObject; index: integer): boolean;
+    function GetBoxedValue(obj: TCustomSerializedObject; index: integer): string;
     procedure LoadFromStream(Stream: TStream);
     procedure LoadFromFile(filename: string);
     function ToString: string;
     constructor Create;
+    destructor Destroy; override;
+    function GetTypeOfClassObject(idObject: longword): integer;
   private
     EndOfStream:      boolean;
-    ArrayFillerCount: integer;
+    ArrayFillerCount: Longword;
     currentAutoObjectValue: longword;
     function nextAutoObjectId: longword;
     function LoadNextFromStream(Stream: TStream): longword;
     function LoadStringFromStream(Stream: TStream): string;
+    function LoadDotNetCharFromStream(Stream: TStream): string;
     function LoadTypeFromStream(Stream: TStream; IsRuntimeType: boolean): integer;
     function LoadValuesFromStream(Stream: TStream; numType: integer): ArrayOfNameValue;
-    function LoadValueFromStream(Stream: TStream; fieldType: TFieldType): string;
-    function GetTypeOfObject(idObject: longword): integer;
-  end;
-
+    function LoadValueFromStream(Stream: TStream; const fieldType: TFieldType): string;
+    function LoadFieldType(Stream: TStream; category: TTypeCategory): TFieldType;
+  end;
+
+function WinReadByte(stream: TStream): byte;
 function WinReadWord(Stream: TStream): word;
 function WinReadSmallInt(Stream: TStream): smallint;
@@ -119 +206 @@
 
 {$hints off}
+
+function WinReadByte(stream: TStream): byte;
+begin
+  stream.Read(Result, sizeof(Result));
+end;
+
 function WinReadWord(Stream: TStream): word;
 begin
@@ -155 +248 @@
 end;
 
-{$hints on}
-
-{ TDotNetDeserialization }
-
-function TDotNetDeserialization.FindObject(typeName: string): PSerializedObject;
-var
-  i, numType:   integer;
-  comparedType: string;
-begin
-  for i := 0 to high(objects) do
+function GetFieldTypeSize(const fieldType: TFieldType): longword;
+begin
+  case fieldType.category of
+    ftPrimitiveType:
+      case fieldType.primitiveType of
+        ptBoolean, ptByte,ptSByte: result := 1;
+        ptChar,ptString, ptDecimal: Result := sizeof(string);
+        ptSingle: result := sizeof(single);
+        ptDouble: result := sizeof(double);
+        ptInt16,ptUInt16: result := 2;
+        ptInt32,ptUInt32: result := 4;
+        ptInt64,ptUInt64,ptDateTime: result := 8;
+      else
+        raise Exception.Create('Unknown primitive type (' + IntToStr(
+          byte(fieldType.primitiveType)) + ')');
+      end;
+    ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject,
+    ftArrayOfString, ftArrayOfPrimitiveType: result := 4;
+  else
+    raise Exception.Create('Unknown field type (' + IntToStr(
+      byte(fieldType.category)) + ')');
+  end;
+end;
+
+function IsDotNetTypeStoredAsString(const fieldType: TFieldType): boolean;
+begin
+  result := (fieldType.category = ftPrimitiveType) and
+    (fieldType.primitiveType in [ptChar,ptString,ptDecimal]);
+end;
+
+function DotNetValueToString(var value; const fieldType: TFieldType): string;
+var
+  tempByte:     byte;
+  value2bytes: record
+    case byte of
+    2: (tempWord: word);
+    3: (tempInt16: smallint);
+  end;
+  value4bytes: record
+    case byte of
+    1: (tempSingle:   single);
+    2: (tempLongWord: longword);
+    3: (tempLongInt: longint);
+  end;
+  value8bytes: record
+    case byte of
+    1: (tempDouble:   double);
+    2: (tempInt64:    Int64);
+    2: (tempUInt64:   QWord);
+  end;
+  tempIdObject: longword;
+
+begin
+  if IsDotNetTypeStoredAsString(fieldType) then
   begin
-    numType := objects[i].numType;
-    if numType >= 0 then
-    begin
-      comparedType := objectTypes[numType].ClassName;
-      if (comparedType = typeName) or (length(typeName) <
-        length(comparedType)) and
-        (copy(comparedType, length(comparedType) - length(typeName),
-        length(typeName) + 1) = '.' + typeName) then
-      begin
-        Result := @objects[i];
-        exit;
-      end;
-    end;
-  end;
-  Result := nil;
-end;
-
-function TDotNetDeserialization.GetSimpleField(obj: TSerializedObject;
-  Name: string): string;
-var
-  i: integer;
-begin
-  i := FieldIndex(obj, Name);
-  if i = -1 then
-    Result := ''
-  else
-  begin
-    if IsBoxedValue(obj, i) then
-      Result := GetBoxedValue(obj, i)
+    Result := pstring(@value)^;
+    exit;
+  end;
+  case fieldType.category of
+    ftPrimitiveType: case fieldType.primitiveType of
+        ptBoolean:
+        begin
+          {$hints off}
+          move(value,tempByte,sizeof(tempByte));
+          {$hints on}
+          if tempByte = 0 then
+            Result := 'False'
+          else
+          if tempByte = 1 then
+            Result := 'True'
+          else
+            raise Exception.Create('Invalid boolean value (' +
+              IntToStr(tempByte) + ')');
+        end;
+        ptByte: Result := inttostr(pbyte(@value)^);
+        ptSByte: Result := inttostr(pshortint(@value)^);
+        ptInt16,ptUInt16:
+        begin
+          {$hints off}
+          move(value, value2bytes.tempWord,sizeof(word));
+          {$hints on}
+          value2bytes.tempWord := LEtoN(value2bytes.tempWord);
+          if fieldType.primitiveType = ptInt16 then
+            Result := IntToStr(value2bytes.tempInt16)
+          else
+            Result := IntToStr(value2bytes.tempWord);
+        end;
+        ptInt32,ptUInt32,ptSingle:
+        begin
+          {$hints off}
+          move(value, value4bytes.tempLongWord,sizeof(longword));
+          {$hints on}
+          value4bytes.tempLongWord := LEtoN(value4bytes.tempLongWord);
+          if fieldType.primitiveType = ptInt32 then
+            Result := IntToStr(value4bytes.tempLongInt)
+          else if fieldType.primitiveType = ptUInt32 then
+            Result := IntToStr(value4bytes.tempLongWord)
+          else
+            result := FloatToStr(value4bytes.tempSingle);
+        end;
+
+        ptInt64,ptUInt64,ptDouble,ptDateTime:
+        begin
+          {$hints off}
+          move(value, value8bytes.tempUInt64,8);
+          {$hints on}
+          value8bytes.tempUInt64 := LEtoN(value8bytes.tempUInt64);
+          if fieldType.primitiveType = ptInt64 then
+            Result := IntToStr(value8bytes.tempInt64)
+          else if fieldType.primitiveType = ptUInt64 then
+            Result := IntToStr(value8bytes.tempUInt64)
+          else if fieldType.primitiveType = ptDouble then
+            result := FloatToStr(value8bytes.tempDouble)
+          else
+            Result := DateTimeToStr(
+            (value8bytes.tempUInt64 and $7FFFFFFFFFFFFFFF - 599264352000000000) / 864000000000);
+        end;
+        else
+          raise Exception.Create('Unknown primitive type (' + IntToStr(
+            byte(fieldType.primitiveType)) + ')');
+      end;
+    ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject,
+    ftArrayOfString, ftArrayOfPrimitiveType:
+    begin
+      {$hints off}
+      move(value,tempIdObject,sizeof(tempIdObject));
+      {$hints on}
+      result := '#' + IntToStr(tempIdObject);
+    end;
     else
-      Result := obj.fields[i].Value;
-  end;
-end;
-
-function TDotNetDeserialization.FieldIndex(obj: TSerializedObject;
-  Name: string): integer;
-var
-  i: integer;
-begin
-  //case sensitive
-  for i := 0 to high(obj.fields) do
-    if obj.fields[i].Name = Name then
-    begin
-      Result := i;
-      exit;
-    end;
-  //case insensitive
-  for i := 0 to high(obj.fields) do
-    if compareText(obj.fields[i].Name, Name) = 0 then
-    begin
-      Result := i;
-      exit;
-    end;
-  //case sensitive inner member
-  for i := 0 to high(obj.fields) do
-    if (length(Name) < length(obj.fields[i].Name)) and
-      (copy(obj.fields[i].Name, length(obj.fields[i].Name) - length(Name),
-      length(Name) + 1) = '+' + Name) then
-    begin
-      Result := i;
-      exit;
-    end;
-  //case insensitive inner member
-  for i := 0 to high(obj.fields) do
-    if (length(Name) < length(obj.fields[i].Name)) and
-      (compareText(copy(obj.fields[i].Name, length(obj.fields[i].Name) -
-      length(Name), length(Name) + 1), '+' + Name) = 0) then
-    begin
-      Result := i;
-      exit;
-    end;
-  Result := -1;
-end;
-
-function TDotNetDeserialization.GetObjectField(obj: TSerializedObject;
-  Name: string): PSerializedObject;
-var
-  i: integer;
-begin
-  i := FieldIndex(obj, Name);
-  if i = -1 then
-    Result := nil
-  else
-  begin
-    if not IsReferenceType(obj.numType, i) then
-      raise Exception.Create('GetObjectMember: Not a reference type');
-    Result := GetObject(obj.fields[i].Value);
-  end;
-end;
-
-function TDotNetDeserialization.GetObject(id: string): PSerializedObject;
-var
-  idObj: longword;
-begin
-  if copy(id, 1, 1) = '#' then
-    Delete(id, 1, 1);
-  idObj  := StrToInt(id);
-  Result := GetObject(idObj);
-end;
-
-function TDotNetDeserialization.GetObject(id: longword): PSerializedObject;
-var
-  i: integer;
-begin
-  for i := 0 to high(objects) do
-    if objects[i].idObject = id then
-    begin
-      Result := @objects[i];
-      exit;
-    end;
-  Result := nil;
-end;
-
-function TDotNetDeserialization.GetObjectType(obj: PSerializedObject): string;
-begin
-  if (obj^.numType = -btString) then
-    Result := 'String'
-  else
-  if (obj^.numType = -btArrayOfObject) then
-    Result := 'Object[]'
-  else
-  if (obj^.numType = -btArrayOfString) then
-    Result := 'String[]'
-  else
-  if (obj^.numType < 0) or (obj^.numType > high(objectTypes)) then
-    Result := ''
-  else
-  begin
-    Result := objectTypes[obj^.numType].ClassName;
-  end;
-end;
-
-function TDotNetDeserialization.PrimitiveTypeName(pt: TPrimitiveType): string;
+      raise Exception.Create('Unknown field type (' + IntToStr(
+        byte(fieldType.category)) + ')');
+  end;
+end;
+
+function PrimitiveTypeName(pt: TPrimitiveType): string;
 begin
   case pt of
@@ -317 +402 @@
     ptString: Result   := 'String';
     else
-      raise Exception.Create('Unknown primitive type (' + IntToStr(byte(pt)) + ')');
-  end;
-end;
-
-function TDotNetDeserialization.IsBoxedValue(obj: TSerializedObject;
+      raise Exception.Create('Unknown primitive type (' + IntToStr(integer(pt)) + ')');
+  end;
+end;
+
+Function DotNetTypeToString(ft: TFieldType): string;
+begin
+  if ft.category = ftPrimitiveType then
+    result := PrimitiveTypeName(ft.primitiveType)
+  else
+    case ft.category of
+      ftString: result := 'String';
+      ftObjectType: result := 'Object';
+      ftRuntimeType: result := 'RuntimeType';
+      ftGenericType: result := 'GenericType';
+      ftArrayOfObject: result := 'Object[]';
+      ftArrayOfString: result := 'String[]';
+      ftArrayOfPrimitiveType: result := 'PrimitiveType[]';
+    else
+      raise Exception.Create('Unknown field type (' + IntToStr(
+        byte(ft.category)) + ')');
+    end;
+end;
+
+{ TCustomSerializedObject }
+
+function TCustomSerializedObject.GetFieldAsString(Name: string): string;
+begin
+  result := GetFieldAsString(GetFieldIndex(Name));
+end;
+
+constructor TCustomSerializedObject.Create(container: TDotNetDeserialization);
+begin
+  FContainer := container;
+  refCount := 0;
+end;
+
+function TCustomSerializedObject.GetFieldIndex(Name: string): integer;
+var
+  i: integer;
+  fn: string;
+begin
+  if FieldCount = 0 then
+  begin
+    result := -1;
+    exit;
+  end;
+  //case sensitive
+  for i := 0 to FieldCount-1 do
+    if FieldName[i] = Name then
+    begin
+      Result := i;
+      exit;
+    end;
+  //case insensitive
+  for i := 0 to FieldCount-1 do
+    if compareText(FieldName[i], Name) = 0 then
+    begin
+      Result := i;
+      exit;
+    end;
+  //case sensitive inner member
+  for i := 0 to FieldCount-1 do
+  begin
+    fn := FieldName[i];
+    if (length(Name) < length(fn)) and
+      (copy(fn, length(fn) - length(Name),
+      length(Name) + 1) = '+' + Name) then
+    begin
+      Result := i;
+      exit;
+    end;
+  end;
+  //case insensitive inner member
+  for i := 0 to FieldCount-1 do
+  begin
+    fn := FieldName[i];
+    if (length(Name) < length(fn)) and
+      (compareText(copy(fn, length(fn) -
+      length(Name), length(Name) + 1), '+' + Name) = 0) then
+    begin
+      Result := i;
+      exit;
+    end;
+  end;
+  Result := -1;
+end;
+
+{ TSerializedClass }
+
+function TSerializedClass.GetFieldAsString(Index: longword): string;
+begin
+  result := fields[Index].Value;
+end;
+
+function TSerializedClass.GetFieldCount: longword;
+begin
+  Result:= length(fields);
+end;
+
+function TSerializedClass.GetFieldName(Index: longword): string;
+begin
+  result := fields[Index].Name;
+end;
+
+function TSerializedClass.GetFieldTypeAsString(Index: longword): string;
+begin
+  result := fields[Index].valueType;
+end;
+
+function TSerializedClass.IsReferenceType(index: longword): boolean;
+begin
+  Result:= FContainer.objectTypes[numType].fieldTypes[index].category <> ftPrimitiveType;
+end;
+
+function TSerializedClass.GetTypeAsString: string;
+begin
+  Result:= FContainer.objectTypes[numType].ClassName;
+end;
+
+{ TSerializedArray }
+
+procedure TSerializedArray.InitData;
+begin
+  FItemSize := GetFieldTypeSize(itemType);
+  getmem(data, itemSize*nbItems);
+  fillchar(data^, itemSize*nbItems, 0);
+end;
+
+function TSerializedArray.GetItemPtr(Index: longword): pointer;
+begin
+  if index >= nbItems then
+    raise exception.Create('Index out of bounds');
+  result := pointer(pbyte(data)+Index*itemsize);
+end;
+
+function TSerializedArray.GetFieldAsString(Index: longword): string;
+begin
+  if data = nil then
+    result := ''
+  else
+    result := DotNetValueToString(ItemPtr[index]^, itemType);
+end;
+
+function TSerializedArray.GetFieldCount: longword;
+begin
+  Result:= nbItems;
+end;
+
+function TSerializedArray.GetFieldName(Index: longword): string;
+var
+  r: longword;
+begin
+  result := '[';
+  for r := 1 to length(dimensions) do
+  begin
+    if r <> 1 then result+=',';
+    result += inttostr(index mod dimensions[r-1]);
+    index := index div dimensions[r-1];
+  end;
+  result += ']';
+end;
+
+{$hints off}
+function TSerializedArray.GetFieldTypeAsString(Index: longword): string;
+begin
+  Result:= DotNetTypeToString(itemType);
+end;
+{$hints on}
+
+{$hints off}
+function TSerializedArray.IsReferenceType(index: longword): boolean;
+begin
+  Result:= itemType.category <> ftPrimitiveType;
+end;
+{$hints on}
+
+function TSerializedArray.GetTypeAsString: string;
+var
+  i: Integer;
+begin
+  Result:= DotNetTypeToString(itemType)+'[';
+  for i := 2 to length(dimensions) do
+    result += ',';
+  result += ']';
+end;
+
+constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AItemType: TFieldType; ALength: longword);
+begin
+  inherited Create(AContainer);
+  setlength(dimensions,1);
+  dimensions[0] := ALength;
+  nbItems := ALength;
+  FArrayType := gatSingleDimension;
+  itemType := AItemType;
+  InitData;
+end;
+
+constructor TSerializedArray.Create(AContainer: TDotNetDeserialization; AArrayType: TGenericArrayType; AItemType: TFieldType;
+  ADimensions: arrayOfLongword);
+var n: longword;
+begin
+  inherited Create(AContainer);
+  setlength(dimensions, length(ADimensions));
+  nbItems := 1;
+  if length(ADimensions) <> 0 then
+    for n := 0 to length(ADimensions)-1 do
+    begin
+      dimensions[n] := ADimensions[n];
+      nbItems *= ADimensions[n];
+    end;
+  FArrayType := AArrayType;
+  itemType := AItemType;
+  InitData;
+end;
+
+destructor TSerializedArray.Destroy;
+var ps: PString;
+  n: longword;
+begin
+  if IsDotNetTypeStoredAsString(itemType) and (nbItems <> 0) then
+  begin
+    ps := PString(data);
+    for n := 1 to nbItems do
+    begin
+      ps^ := '';
+      inc(ps);
+    end;
+  end;
+  freemem(data);
+  inherited Destroy;
+end;
+
+{ TSerializedValue }
+
+function TSerializedValue.GetIsReferenceType: boolean;
+begin
+  result := inherited IsReferenceType(0);
+end;
+
+function TSerializedValue.GetValueAsString: string;
+begin
+  result := GetFieldAsString(0);
+end;
+
+function TSerializedValue.GetTypeAsString: string;
+begin
+  Result:= GetFieldTypeAsString(0);
+end;
+
+constructor TSerializedValue.Create(AContainer: TDotNetDeserialization;
+  AItemType: TFieldType);
+begin
+  inherited Create(AContainer,AItemType,1);
+end;
+
+{$hints on}
+
+{ TDotNetDeserialization }
+
+function TDotNetDeserialization.FindClass(typeName: string): TSerializedClass;
+var obj: TCustomSerializedObject;
+begin
+  obj := FindObject(typeName);
+  if obj is TSerializedClass then
+    result := obj as TSerializedClass
+  else
+    raise exception.Create('FindClass: found object is not a class');
+end;
+
+function TDotNetDeserialization.FindObject(typeName: string): TCustomSerializedObject;
+var
+  i:   integer;
+  comparedType: string;
+begin
+  for i := 0 to high(objects) do
+  begin
+    comparedType := objects[i].TypeAsString;
+    if (comparedType = typeName) or
+      ( (length(typeName) < length(comparedType) ) and
+        (copy(comparedType, length(comparedType) - length(typeName),
+        length(typeName) + 1) = '.' + typeName) ) then
+    begin
+      Result := objects[i];
+      exit;
+    end;
+  end;
+  Result := nil;
+end;
+
+function TDotNetDeserialization.GetSimpleField(obj: TCustomSerializedObject;
+  Name: string): string;
+var
+  i,idxSlash: integer;
+  tempSub: TCustomSerializedObject;
+begin
+  i := obj.GetFieldIndex(Name);
+  if i = -1 then
+  begin
+    idxSlash := pos('\',name);
+    if idxSlash <> 0 then
+    begin
+      tempSub := GetObjectField(obj,copy(name,1,idxSlash-1));
+      if tempSub <> nil then
+      begin
+        result := GetSimpleField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash));
+        exit;
+      end;
+    end;
+    Result := ''
+  end
+  else
+  begin
+    if IsBoxedValue(obj, i) then
+      Result := GetBoxedValue(obj, i)
+    else
+      Result := obj.FieldAsString[i];
+  end;
+end;
+
+function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject;
+  Name: string): TCustomSerializedObject;
+var
+  i: integer;
+  idxSlash: LongInt;
+  tempSub: TCustomSerializedObject;
+begin
+  i := obj.GetFieldIndex(Name);
+  if i = -1 then
+  begin
+    idxSlash := pos('\',name);
+    if idxSlash <> 0 then
+    begin
+      tempSub := GetObjectField(obj,copy(name,1,idxSlash-1));
+      if tempSub <> nil then
+      begin
+        result := GetObjectField(tempSub,copy(name,idxSlash+1,length(name)-idxSlash));
+        exit;
+      end;
+    end;
+    Result := nil
+  end
+  else
+  begin
+    if not obj.IsReferenceType(i) then
+      raise Exception.Create('GetObjectField: Not a reference type');
+    Result := GetObject(obj.FieldAsString[i]);
+  end;
+end;
+
+function TDotNetDeserialization.GetObjectField(obj: TCustomSerializedObject;
+  index: integer): TCustomSerializedObject;
+begin
+  if not obj.IsReferenceType(index) then
+    raise Exception.Create('GetObjectField: Not a reference type');
+  Result := GetObject(obj.FieldAsString[index]);
+end;
+
+function TDotNetDeserialization.GetObject(id: string): TCustomSerializedObject;
+var
+  idObj: longword;
+begin
+  if copy(id, 1, 1) = '#' then
+    Delete(id, 1, 1);
+  idObj  := StrToInt64(id);
+  Result := GetObject(idObj);
+end;
+
+function TDotNetDeserialization.GetObject(id: longword): TCustomSerializedObject;
+var
+  i: integer;
+begin
+  for i := 0 to high(objects) do
+    if objects[i].idObject = id then
+    begin
+      Result := objects[i];
+      exit;
+    end;
+  Result := nil;
+end;
+
+function TDotNetDeserialization.IsBoxedValue(obj: TCustomSerializedObject;
   index: integer): boolean;
 var
-  subObj: PSerializedObject;
-begin
-  if not IsReferenceType(obj.numType, index) then
+  subObj: TCustomSerializedObject;
+begin
+  if not obj.IsReferenceType(index) then
   begin
     Result := False;
     exit;
   end;
-  subObj := GetObject(obj.fields[index].Value);
-  if subObj = nil then
+  subObj := GetObject(obj.FieldAsString[index]);
+  if subObj = nil then //suppose Nothing is a boxed value
   begin
     Result := True;
     exit;
   end;
-  Result := (length(subObj^.fields) = 1) and (subObj^.fields[0].Name = '');
-end;
-
-function TDotNetDeserialization.GetBoxedValue(obj: TSerializedObject;
+  Result := subObj is TSerializedValue;
+end;
+
+function TDotNetDeserialization.GetBoxedValue(obj: TCustomSerializedObject;
   index: integer): string;
 var
-  subObj: PSerializedObject;
-begin
-  if not IsReferenceType(obj.numType, index) then
+  subObj: TCustomSerializedObject;
+begin
+  if not obj.IsReferenceType(index) then
     raise Exception.Create('GetBoxedValue: Not a reference type');
-  subObj := GetObject(obj.fields[index].Value);
+  subObj := GetObject(obj.FieldAsString[index]);
   if subObj = nil then
   begin
@@ -353 +814 @@
     exit;
   end;
-  if (length(subObj^.fields) = 1) and (subObj^.fields[0].Name = '') then
-    Result := subObj^.fields[0].Value
+  if (subObj is TSerializedValue) and not (subObj as TSerializedValue).IsReferenceType then
+    Result := (subObj as TSerializedValue).ValueAsString
   else
     raise Exception.Create('GetBoxedValue: Not a primitive type');
-end;
-
-function TDotNetDeserialization.IsReferenceType(numType: integer;
-  index: integer): boolean;
-begin
-  if numType >= length(objectTypes) then
-    raise Exception.Create('IsReferenceType: Type number out of bounds');
-
-  if (numType < 0) then
-  begin
-    Result := (numType = -btArrayOfObject) or (numtype = -btArrayOfString);
-  end
-  else
-  begin
-    if (index < 0) or (index >= objecttypes[numType].nbFields) then
-      raise Exception.Create('IsReferenceType: Index out of bounds');
-
-    Result := (objecttypes[numType].fieldTypes[index].category <> ftPrimitiveType);
-  end;
 end;
 
@@ -433 +875 @@
     subNum: integer;
     objType, subExpectedType: string;
+    fieldTypeStr: string;
   begin
     Result := '';
@@ -448 +891 @@
       end;
       inToString := True;
+      objType := TypeAsString;
       if main then
       begin
-        if numType < 0 then
-          objType := ''
-        else
-          objType := objectTypes[numType].ClassName;
         Result += tab + 'Object';
-        if refCount > 0 then
-          Result += ' #' + IntToStr(idObject);
+        Result += ' #' + IntToStr(idObject);
         if (objType = '') or (objType = expectedType) then
           Result += ' = '
@@ -464 +903 @@
       else
       begin
-        objType := GetObjectType(@objects[num]);
         if (objType = '') or (objType = expectedType) then
           Result := ''
@@ -477 +915 @@
         subExpectedType := '';
 
-      if not main and (length(fields) = 1) and (fields[0].Name = '') then
+      if not main and (objects[num] is TSerializedValue) then
       begin
-        Result += fields[0].Value + LineEnding;
+        Result += (objects[num] as TSerializedValue).ValueAsString + LineEnding;
       end
       else
-      if (length(fields) = 0) then
+      if (FieldCount = 0) then
       begin
         Result += '{}' + LineEnding;
@@ -489 +927 @@
       begin
         Result += '{' + LineEnding;
-        for j := 0 to High(fields) do
+        for j := 0 to FieldCount-1 do
         begin
-          Result += tab + '  ' + fields[j].Name;
-          if (fields[j].valueType <> '') and (fields[j].valueType <> subExpectedType) and
-            not ((subExpectedType = '') and ((fields[j].valueType = 'Int32') or
-            (fields[j].valueType = 'Boolean'))) then
-            Result += ' As ' + fields[j].valueType;
+          Result += tab + '  ' + FieldName[j];
+          fieldTypeStr := FieldTypeAsString[j];
+          if (fieldTypeStr <> '') and (fieldTypeStr <> subExpectedType) and
+            not ((subExpectedType = '') and ((fieldTypeStr = 'Int32') or
+            (fieldTypeStr = 'Boolean') or (fieldTypeStr = 'Double'))) then
+            Result += ' As ' + fieldTypeStr;
           Result   += ' = ';
-          if not IsReferenceType(numType, j) or (copy(fields[j].Value, 1, 1) <> '#') or
-            (fields[j].Value = '#0') then
-            Result += fields[j].Value + lineending
+          if not IsReferenceType(j) then
+            Result += FieldAsString[j] + lineending
           else
           begin
-            subId  := StrToInt(copy(fields[j].Value, 2, length(fields[j].Value) - 1));
-            subNum := -1;
-            for k := 0 to high(objects) do
-              if (objects[k].idObject = subId) then
+            try
+              subId  := StrToInt64(copy(fieldAsString[j], 2, length(fieldAsString[j]) - 1));
+              if subId = 0 then result += 'null'+LineEnding else
               begin
-                subNum := k;
-                break;
+                begin
+                  subNum := -1;
+                  for k := 0 to high(objects) do
+                  if (objects[k].idObject = subId) then
+                  begin
+                    subNum := k;
+                    break;
+                  end;
+                end;
+                if subNum = -1 then
+                  Result += '(Not found) #' + IntToStr(subId)+LineEnding
+                else
+                  Result += objectToString(subNum, fieldTypeStr, tab + '  ', False);
               end;
-            if subNum = -1 then
-              Result += '#' + IntToStr(subId) + '!' + LineEnding
-            else
-              Result += objectToString(subNum, fields[j].valueType, tab + '  ', False);
+            except
+              result += '!' + fieldAsString[j]+'!' +LineEnding
+            end;
           end;
         end;
@@ -541 +988 @@
 end;
 
+destructor TDotNetDeserialization.Destroy;
+var
+  i: Integer;
+begin
+  for i := 0 to high(objects) do
+    objects[i].Free;
+  inherited Destroy;
+end;
+
+function TDotNetDeserialization.GetTypeOfClassObject(idObject: longword
+  ): integer;
+var
+  i: Integer;
+begin
+  for i := 0 to high(objects) do
+    if objects[i].idObject = idObject then
+    begin
+      if objects[i] is TSerializedClass then
+      begin
+        result := (objects[i] as TSerializedClass).numType;
+        exit;
+      end
+      else
+        raise exception.Create('GetTypeOfClassObject: Specified object is not of class type');
+    end;
+  raise exception.Create('GetTypeOfClassObject: Object not found');
+end;
+
 function TDotNetDeserialization.nextAutoObjectId: longword;
 begin
@@ -552 +1027 @@
   idRefObject, tempIdObject: longword;
   tempType:     TFieldType;
-  arrayCount, i, idx, FillZeroCount: integer;
-  tempObj:      TSerializedObject;
-  tempTypeName: string;
-  tempPObj:     PSerializedObject;
+  arrayCount, arrayIndex,FillZeroCount : longword;
+  tempAnyObj: TCustomSerializedObject;
+  newClassObj: TSerializedClass;
+  newValueObj: TSerializedValue;
+  newArrayObj: TSerializedArray;
+  genericArrayType: TGenericArrayType;
+  genericArrayRank: longword;
+  genericArrayDims: array of longword;
+  genericArrayItemType: TFieldType;
+
+  function GetArrayCellNumber(index: longword): string;
+  var r: longword;
+  begin
+    result := '';
+    for r := 1 to genericArrayRank do
+    begin
+      if r <> 1 then result+=',';
+      result += inttostr(index mod genericArrayDims[r-1]);
+      index := index div genericArrayDims[r-1];
+    end;
+  end;
+
 begin
   Result := 0; //idObject or zero
-   {$hints off}
-  Stream.Read(blockType, sizeof(blockType));
-   {$hints on}
+  blockType := WinReadByte(Stream);
   case blockType of
 
@@ -568 +1059 @@
       with assemblies[high(assemblies)] do
       begin
-        Stream.Read(idAssembly, 4);
+        idAssembly := WinReadLongword(Stream);
         Name := LoadStringFromStream(Stream);
       end;
@@ -575 +1066 @@
     btRuntimeObject, btExternalObject:
     begin
+      newClassObj := TSerializedClass.Create(self);
       setlength(objects, length(objects) + 1);
-      idx := high(objects);
-      with tempObj do  //use temp because array address may change
+      objects[high(objects)] := newClassObj;
+      with newClassObj do
       begin
-        refCount := 0;
-        Stream.Read(idObject, 4);
-        Result  := idObject;
-        numType := LoadTypeFromStream(Stream, blockType = btRuntimeObject);
-      end;
-      objects[idx]   := tempObj;
-      tempObj.fields := LoadValuesFromStream(Stream, objects[idx].numType);
-      objects[idx].fields := tempObj.fields;
+        idObject := WinReadLongword(Stream);
+        Result   := idObject;
+        numType  := LoadTypeFromStream(Stream, blockType = btRuntimeObject);
+        fields   := LoadValuesFromStream(Stream, numType);
+      end;
     end;
 
     btRefTypeObject:
     begin
+      newClassObj := TSerializedClass.Create(self);
       setlength(objects, length(objects) + 1);
-      idx := high(objects);
-      with tempObj do  //use temp because array address may change
+      objects[high(objects)] := newClassObj;
+      with newClassObj do
       begin
-        refCount    := 0;
         idObject    := WinReadLongword(Stream);
         Result      := idObject;
         idRefObject := WinReadLongword(Stream);
-        numType     := GetTypeOfObject(idRefObject);
-      end;
-      objects[idx]   := tempObj;
-      tempObj.fields := LoadValuesFromStream(Stream, objects[idx].numType);
-      objects[idx].fields := tempObj.fields;
+        numType     := GetTypeOfClassObject(idRefObject);
+        fields      := LoadValuesFromStream(Stream, numType);
+      end;
     end;
 
     btString:
     begin
+      tempType.primitiveType := ptString;
+      tempType.category := ftPrimitiveType;
+      tempType.Name := PrimitiveTypeName(ptString);
+      tempType.refAssembly := 0;
+
+      newValueObj := TSerializedValue.Create(self,tempType);
       setlength(objects, length(objects) + 1);
-      idx := high(objects);
-      with tempObj do  //use temp because array address may change
+      objects[high(objects)] := newValueObj;
+      with newValueObj do
       begin
-        refCount := 0;
-        Stream.Read(idObject, 4);
+        idObject := WinReadLongword(Stream);
         Result  := idObject;
-        numType := -blockType;
-        setlength(fields, 1);
-        fields[0].Name      := '';
-        fields[0].valueType := 'String';
-        fields[0].Value     := LoadStringFromStream(Stream);
-      end;
-      objects[idx] := tempObj;
+        pstring(data)^ := LoadStringFromStream(Stream);
+      end;
     end;
 
@@ -627 +1114 @@
     begin
       try
+        tempType.category    := ftPrimitiveType;
+        tempType.refAssembly := 0;
+        tempType.primitiveType := TPrimitiveType(WinReadByte(stream));
+        tempType.Name := PrimitiveTypeName(tempType.primitiveType);
+
+        newValueObj := TSerializedValue.Create(self,tempType);
         setlength(objects, length(objects) + 1);
-        idx := high(objects);
-        with tempObj do  //use temp because array address may change
+        objects[high(objects)] := newValueObj;
+
+        with newValueObj do
         begin
-          refCount := 0;
           idObject := nextAutoObjectId;
           Result   := idObject;
-          numType  := -blockType;
-
-          tempType.category    := ftPrimitiveType;
-          tempType.refAssembly := 0;
-          Stream.Read(tempType.primitiveType, 1);
-          tempType.Name := PrimitiveTypeName(tempType.primitiveType);
-
-          setlength(fields, 1);
-          fields[0].Name      := '';
-          fields[0].Value     := LoadValueFromStream(Stream, tempType);
-          fields[0].valueType := tempType.Name;
+
+          if IsDotNetTypeStoredAsString(tempType) then
+            pstring(data)^ := LoadValueFromStream(Stream, tempType)
+          else
+            Stream.Read(data^, itemSize);
         end;
-        objects[idx] := tempObj;
       except
         on ex: Exception do
@@ -656 +1142 @@
     btObjectReference:
     begin
-      Stream.Read(Result, 4);
-      tempPObj := GetObject(Result);
-      if tempPObj <> nil then
-        Inc(tempPObj^.refCount);
+      result := WinReadLongword(Stream);
+      tempAnyObj := GetObject(Result);
+      if tempAnyObj <> nil then
+        Inc(tempAnyObj.refCount);
     end;
 
@@ -667 +1153 @@
     begin
       try
+        result := WinReadLongword(Stream);
+        arrayCount := WinReadLongword(Stream);
+
+        tempType.category    := ftPrimitiveType;
+        tempType.refAssembly := 0;
+        tempType.primitiveType := TPrimitiveType(WinReadByte(stream));
+        tempType.Name := PrimitiveTypeName(tempType.primitiveType);
+
+        newArrayObj := TSerializedArray.Create(self,tempType,arrayCount);
         setlength(objects, length(objects) + 1);
-        idx := high(objects);
-        with tempObj do  //use temp because array address may change
+        objects[high(objects)] := newArrayObj;
+        with newArrayObj do
         begin
-          refCount := 0;
-          Stream.Read(idObject, 4);
-          Result     := idObject;
-          arrayCount := WinReadLongint(Stream);
-
-          tempType.category    := ftPrimitiveType;
-          tempType.refAssembly := 0;
-          Stream.Read(tempType.primitiveType, 1);
-          tempType.Name := PrimitiveTypeName(tempType.primitiveType);
-
-          setlength(fields, arrayCount);
-          for i := 0 to arrayCount - 1 do
+          idObject := result;
+
+          if arrayCount <> 0 then
           begin
-            fields[i].Name      := '[' + IntToStr(i) + ']';
-            fields[i].Value     := LoadValueFromStream(Stream, tempType);
-            fields[i].valueType := tempType.Name;
-          end;
-
-          setlength(objectTypes, length(objecttypes) + 1);
-          numType := high(objectTypes);
-          with objectTypes[numType] do
-          begin
-            ClassName := tempType.Name + '[]';
-            nbFields  := arrayCount;
-            setlength(fieldNames, nbFields);
-            setlength(fieldTypes, nbFields);
-            for i := 0 to arrayCount - 1 do
+            if IsDotNetTypeStoredAsString(tempType) then
             begin
-              fieldNames[i] := fields[i].Name;
-              fieldTypes[i] := tempType;
+              for arrayIndex := 0 to arrayCount - 1 do
+                pstring(ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream, tempType);
+            end else
+            begin
+              for arrayIndex := 0 to arrayCount - 1 do
+                stream.Read(ItemPtr[arrayIndex]^, itemSize);
             end;
-            refAssembly := 0;
           end;
         end;
-        objects[idx] := tempObj;
       except
         on ex: Exception do
@@ -713 +1188 @@
     end;
 
-    btArrayOfObject, btArrayOfString:
+    btArrayOfObject,btArrayOfString:
     begin
       try
+        result := WinReadLongword(Stream);
+        arrayCount := WinReadLongword(Stream);
+
+        if blockType = btArrayOfObject then
+          tempType.category := ftObjectType
+        else
+          tempType.category := ftString;
+
+        tempType.refAssembly := 0;
+        tempType.primitiveType := ptNone;
+        tempType.Name := DotNetTypeToString(tempType);
+
+        newArrayObj := TSerializedArray.Create(self,tempType,arrayCount);
         setlength(objects, length(objects) + 1);
-        idx := high(objects);
-        with tempObj do  //use temp because array address may change
+        objects[high(objects)] := newArrayObj;
+
+        with newArrayObj do
         begin
-          refCount := 0;
-          Stream.Read(idObject, 4);
-          Result  := idObject;
-          numType := -blockType;
-          Stream.Read(arrayCount, 4);
-        end;
-        objects[idx] := tempObj;
-        with tempObj do
-        begin
-          setlength(fields, arrayCount);
+          idObject:= result;
           FillZeroCount := 0;
-          if blockType = btArrayOfObject then
-            tempTypeName := 'Object'
-          else
-            tempTypeName := 'String';
-          for i := 0 to arrayCount - 1 do
-          begin
-            fields[i].Name      := '[' + IntToStr(i) + ']';
-            fields[i].valueType := tempTypeName;
-            if FillZeroCount > 0 then
+          if arrayCount <> 0 then
+            for arrayIndex := 0 to arrayCount - 1 do
             begin
-              fields[i].Value := '#0';
-              Dec(FillZeroCount);
-            end
-            else
-            begin
-              tempIdObject := LoadNextFromStream(Stream);
-              if tempIdObject = idArrayFiller then
-              begin
-                tempIdObject     := 0;
-                FillZeroCount    := ArrayFillerCount;
-                ArrayFillerCount := 0;
-              end;
               if FillZeroCount > 0 then
-              begin
-                fields[i].Value := '#0';
-                Dec(FillZeroCount);
-              end
+                Dec(FillZeroCount)
               else
               begin
-                fields[i].Value := '#' + IntToStr(tempIdObject);
+                tempIdObject := LoadNextFromStream(Stream);
+                if tempIdObject = idArrayFiller then
+                begin
+                  tempIdObject     := 0;
+                  FillZeroCount    := ArrayFillerCount;
+                  ArrayFillerCount := 0;
+                end;
+                if FillZeroCount > 0 then
+                  Dec(FillZeroCount)
+                else
+                  plongword(ItemPtr[arrayIndex])^ := tempIdObject;
               end;
             end;
-          end;
         end;
-        objects[idx].fields := tempObj.fields;
       except
         on ex: Exception do
@@ -777 +1243 @@
       arrayCount := 0;
       if blockType = btArrayFiller8b then
-      begin
-        Stream.Read(arrayCount, 1);
-      end
+        arrayCount := WinReadByte(Stream)
       else
-        Stream.Read(arrayCount, 3);
-      arrayCount := LEtoN(arrayCount);
+        arrayCount := WinReadLongWord(Stream);
       ArrayFillerCount := arraycount;
     end;
 
     btGenericArray:
-      raise Exception.Create('Generic array not supported');
+    begin
+        try
+          result := WinReadLongword(Stream);
+          genericArrayType := TGenericArrayType( WinReadByte(Stream) );
+          genericArrayRank := WinReadLongword(Stream);
+          setlength(genericArrayDims,genericArrayRank);
+          arrayCount := 0;
+          if genericArrayRank <> 0 then
+            for arrayIndex := 0 to genericArrayRank-1 do
+            begin
+              genericArrayDims[arrayIndex] := WinReadLongword(Stream);
+              if arrayIndex=0 then
+                arrayCount := genericArrayDims[arrayIndex]
+              else
+                arrayCount *= genericArrayDims[arrayIndex];
+            end;
+          genericArrayItemType.category := TTypeCategory(WinReadByte(Stream));
+          genericArrayItemType := LoadFieldType(stream,genericArrayItemType.category);
+
+          newArrayObj := TSerializedArray.Create(self,genericArrayType,genericArrayItemType,genericArrayDims);
+          setlength(objects, length(objects) + 1);
+          objects[high(objects)] := newArrayObj;
+          newArrayObj.idObject := result;
+
+          FillZeroCount := 0;
+          if arrayCount <> 0 then
+            for arrayIndex := 0 to arrayCount - 1 do
+            begin
+              if IsDotNetTypeStoredAsString(genericArrayItemType) then
+                PString(newArrayObj.ItemPtr[arrayIndex])^ := LoadValueFromStream(Stream,genericArrayItemType)
+              else
+              if genericArrayItemType.category = ftPrimitiveType then
+                Stream.Read(newArrayObj.ItemPtr[arrayIndex]^, newArrayObj.ItemSize)
+              else
+              begin
+                if FillZeroCount > 0 then
+                  Dec(FillZeroCount)
+                else
+                begin
+                  tempIdObject := LoadNextFromStream(Stream);
+                  if tempIdObject = idArrayFiller then
+                  begin
+                    tempIdObject     := 0;
+                    FillZeroCount    := ArrayFillerCount;
+                    ArrayFillerCount := 0;
+                  end;
+                  if FillZeroCount > 0 then
+                    Dec(FillZeroCount)
+                  else
+                    plongword(newArrayObj.ItemPtr[arrayIndex])^ := tempIdObject;
+                end;
+              end;
+            end;
+        except
+          on ex: Exception do
+            raise Exception.Create('Error while reading array of object. ' + ex.Message);
+        end;
+      end;
 
     btMethodCall, btMethodResponse:
-      raise Exception.Create('Method or not supported');
+      raise Exception.Create('Method or method response not supported');
 
     btEndOfStream: EndOfStream := True;
@@ -802 +1322 @@
 var
   byteLength, shift: byte;
-  fullLength: longword;
+  fullLength: integer;
   utf8value:  string;
 begin
@@ -817 +1337 @@
   if Stream.Read(utf8value[1], fullLength) <> fullLength then
     raise Exception.Create('String length error');
-  Result := Utf8ToAnsi(utf8value);
+  Result := utf8value;
+end;
+
+function TDotNetDeserialization.LoadDotNetCharFromStream(Stream: TStream
+  ): string;
+var
+  tempByte: byte;
+  dataLen: Byte;
+  utf8value: string;
+begin
+  tempByte:= WinReadByte(Stream);
+
+  if tempByte and $80 = 0 then
+    dataLen := 1
+  else
+  if tempByte and $E0 = $C0 then
+    dataLen := 2
+  else
+  if tempByte and $F0 = $E0 then
+    dataLen := 3
+  else
+  if tempByte and $F8 = $F0 then
+    dataLen := 4
+  else
+    raise Exception.Create('Invalid UTF8 char');
+
+  setlength(utf8value, dataLen);
+  utf8value[1] := char(tempByte);
+  Stream.Read(utf8value[2], dataLen - 1);
+  Result := utf8value;
 end;
 
@@ -831 +1380 @@
     begin
       ClassName := LoadStringFromStream(Stream);
-      Stream.Read(nbFields, 4);
+      nbFields := WinReadLongword(Stream);
       setlength(fieldNames, nbFields);
       setlength(fieldTypes, nbFields);
@@ -837 +1386 @@
         fieldNames[i] := LoadStringFromStream(Stream);
       for i := 0 to nbFields - 1 do
-        Stream.Read(fieldTypes[i].category, 1);
+        fieldTypes[i].category := TTypeCategory(WinReadByte(Stream));
       for i := 0 to nbFields - 1 do
-      begin
-        fieldTypes[i].Name := '';
-        fieldTypes[i].refAssembly := 0;
-        fieldTypes[i].primitiveType := ptNone;
-        case fieldTypes[i].category of
-          ftPrimitiveType, ftArrayOfPrimitiveType:
-          begin
-            Stream.Read(fieldTypes[i].primitiveType, 1);
-            fieldTypes[i].Name := PrimitiveTypeName(fieldTypes[i].primitiveType);
-            if fieldTypes[i].category = ftArrayOfPrimitiveType then
-              fieldTypes[i].Name += '[]';
-          end;
-          ftString: fieldTypes[i].Name      := 'String';
-          ftObjectType: fieldTypes[i].Name  := 'Object';
-          ftRuntimeType: fieldTypes[i].Name := LoadStringFromStream(Stream);
-          ftGenericType:
-          begin
-            fieldTypes[i].Name := LoadStringFromStream(Stream);
-            Stream.Read(fieldTypes[i].refAssembly, 4);
-          end;
-          ftArrayOfObject: fieldTypes[i].Name := 'Object[]';
-          ftArrayOfString: fieldTypes[i].Name := 'String[]';
-          else
-            raise Exception.Create('Unknown field type tag (' + IntToStr(
-              byte(fieldTypes[i].category)) + ')');
-        end;
-      end;
+        fieldTypes[i] := LoadFieldType(Stream,fieldTypes[i].category);
       if isRuntimeType then
         refAssembly := 0
       else
-        Stream.Read(refAssembly, 4);
+        refAssembly := WinReadLongword(Stream);
     end;
   except
@@ -906 +1429 @@
 
 function TDotNetDeserialization.LoadValueFromStream(Stream: TStream;
-  fieldType: TFieldType): string;
-var
-  utf8value:    string;
-  utf8len:      byte;
-  tempByte:     byte;
-  tempDouble:   double;
-  tempSingle:   single;
-  tempSByte:    shortint;
-  tempUInt64:   QWord;
+  const fieldType: TFieldType): string;
+var
+  data : record
+    case byte of
+    1: (ptr: pointer);
+    2: (bytes: array[0..7] of byte);
+    end;
+  dataLen: longword;
   tempIdObject: longword;
 begin
   try
-    case fieldType.category of
-      ftPrimitiveType: case fieldType.primitiveType of
-          ptBoolean:
-          begin
-                 {$hints off}
-            Stream.Read(tempByte, 1);
-                 {$hints on}
-            if tempByte = 0 then
-              Result := 'False'
-            else
-            if tempByte = 1 then
-              Result := 'True'
-            else
-              raise Exception.Create('Invalid boolean value (' +
-                IntToStr(tempByte) + ')');
-          end;
-          ptByte:
-          begin
-                 {$hints off}
-            Stream.Read(tempByte, 1);
-                 {$hints on}
-            Result := IntToStr(tempByte);
-          end;
-          ptChar:
-          begin
-                 {$hints off}
-            Stream.Read(tempByte, 1);
-                 {$hints on}
-            if tempByte and $80 = 0 then
-              utf8len := 1
-            else
-            if tempByte and $E0 = $C0 then
-              utf8len := 2
-            else
-            if tempByte and $F0 = $E0 then
-              utf8len := 3
-            else
-            if tempByte and $F8 = $F0 then
-              utf8len := 4
-            else
-              raise Exception.Create('Invalid UTF8 char');
-            setlength(utf8value, utf8len);
-            utf8value[1] := char(tempByte);
-            Stream.Read(utf8value[2], utf8len - 1);
-            Result := Utf8ToAnsi(utf8value);
-          end;
-          ptString, ptDecimal: Result := LoadStringFromStream(Stream);
-          ptDouble:
-          begin
-              {$hints off}
-            stream.Read(tempDouble, sizeof(tempDouble));
-              {$hints on}
-            Result := FloatToStr(tempDouble);
-          end;
-          ptInt16:
-          begin
-            Result := IntToStr(WinReadSmallInt(stream));
-          end;
-          ptInt32:
-          begin
-            Result := IntToStr(WinReadLongInt(stream));
-          end;
-          ptInt64:
-          begin
-            Result := IntToStr(WinReadInt64(stream));
-          end;
-          ptSByte:
-          begin
-              {$hints off}
-            stream.Read(tempSByte, sizeof(tempSByte));
-              {$hints on}
-            Result := IntToStr(tempSByte);
-          end;
-          ptSingle:
-          begin
-              {$hints off}
-            stream.Read(tempSingle, sizeof(tempSingle));
-              {$hints on}
-            Result := FloatToStr(tempSingle);
-          end;
-          ptUInt16:
-          begin
-            Result := IntToStr(WinReadWord(stream));
-          end;
-          ptUInt32:
-          begin
-            Result := IntToStr(WinReadLongword(stream));
-          end;
-          ptUInt64:
-          begin
-            Result := IntToStr(WinReadQWord(stream));
-          end;
-          ptDateTime:
-          begin
-            tempUInt64 := WinReadQWord(stream);
-            Result     := DateTimeToStr(
-              (tempUInt64 and $7FFFFFFFFFFFFFFF - 599264352000000000) / 864000000000);
-          end;
-          else
-            raise Exception.Create('Unknown primitive type (' + IntToStr(
-              byte(fieldType.primitiveType)) + ')');
+    if fieldType.Category = ftPrimitiveType then
+    begin
+      case fieldType.primitiveType of
+        ptChar: Result := LoadDotNetCharFromStream(Stream);
+        ptString, ptDecimal: Result := LoadStringFromStream(Stream);
+      else
+        begin
+          dataLen := GetFieldTypeSize(fieldType);
+          {$hints off}
+          stream.read(data,dataLen);
+          {$hints on}
+          result := DotNetValueToString(data,fieldType);
         end;
-      ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject,
-      ftArrayOfString, ftArrayOfPrimitiveType:
-      begin
-        tempIdObject := LoadNextFromStream(stream);
-        Result := '#' + IntToStr(tempIdObject);
-
-      end;
-      else
-        raise Exception.Create('Unknown field type (' + IntToStr(
-          byte(fieldType.category)) + ')');
-    end;
+      end;
+    end else
+    if fieldType.Category in [ftString, ftObjectType, ftRuntimeType, ftGenericType, ftArrayOfObject,
+        ftArrayOfString, ftArrayOfPrimitiveType] then
+    begin
+      tempIdObject := LoadNextFromStream(stream);
+      Result := '#' + IntToStr(tempIdObject);
+    end else
+      raise Exception.Create('Unknown field type (' + IntToStr(
+        byte(fieldType.category)) + ')');
   except
     on ex: Exception do
@@ -1037 +1469 @@
 end;
 
-function TDotNetDeserialization.GetTypeOfObject(idObject: longword): integer;
-var
-  i: integer;
-begin
-  for i := 0 to high(objects) do
-    if objects[i].idObject = idObject then
-    begin
-      Result := objects[i].numType;
-      exit;
-    end;
-  raise Exception.Create('Object not found (' + IntToStr(idObject) + ')');
+function TDotNetDeserialization.LoadFieldType(Stream: TStream; category: TTypeCategory
+  ): TFieldType;
+begin
+  result.category := category;
+  result.Name := '';
+  result.refAssembly := 0;
+  result.primitiveType := ptNone;
+  case category of
+    ftPrimitiveType, ftArrayOfPrimitiveType:
+    begin
+      result.primitiveType := TPrimitiveType(WinReadByte(stream));
+      result.Name := PrimitiveTypeName(result.primitiveType);
+      if result.category = ftArrayOfPrimitiveType then
+        result.Name += '[]';
+    end;
+    ftString: result.Name      := 'String';
+    ftObjectType: result.Name  := 'Object';
+    ftRuntimeType: result.Name := LoadStringFromStream(Stream);
+    ftGenericType:
+    begin
+      result.Name := LoadStringFromStream(Stream);
+      result.refAssembly := WinReadLongword(Stream);
+    end;
+    ftArrayOfObject: result.Name := 'Object[]';
+    ftArrayOfString: result.Name := 'String[]';
+    else
+      raise Exception.Create('Unknown field type tag (' + IntToStr(
+        byte(result.category)) + ')');
+  end;
 end;
 

GraphicTest/BGRABitmap/bgrafilters.pas

@@ -5 +5 @@
 interface
 
+{ Here are some filters that can be applied to a bitmap. The filters
+  take a source image as a parameter and gives a filtered image as
+  a result. }
+
 uses
-  Classes, SysUtils, BGRADefaultBitmap, BGRABitmapTypes;
-
-function FilterMedian(bmp: TBGRADefaultBitmap;
-  Option: TMedianOption): TBGRADefaultBitmap;
-function FilterSmartZoom3(bmp: TBGRADefaultBitmap;
-  Option: TMedianOption): TBGRADefaultBitmap;
-function FilterSharpen(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterBlurRadialPrecise(bmp: TBGRADefaultBitmap;
-  radius: single): TBGRADefaultBitmap;
-function FilterBlurRadial(bmp: TBGRADefaultBitmap; radius: integer;
-  blurType: TRadialBlurType): TBGRADefaultBitmap;
-function FilterBlurMotion(bmp: TBGRADefaultBitmap; distance: single;
-  angle: single; oriented: boolean): TBGRADefaultBitmap;
-function FilterBlur(bmp: TBGRADefaultBitmap;
-  blurMask: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterEmboss(bmp: TBGRADefaultBitmap; angle: single): TBGRADefaultBitmap;
-function FilterEmbossHighlight(bmp: TBGRADefaultBitmap;
-  FillSelection: boolean): TBGRADefaultBitmap;
-function FilterNormalize(bmp: TBGRADefaultBitmap;
-  eachChannel: boolean = True): TBGRADefaultBitmap;
-function FilterRotate(bmp: TBGRADefaultBitmap; origin: TPointF;
-  angle: single): TBGRADefaultBitmap;
-function FilterGrayscale(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterContour(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterSphere(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterCylinder(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
-function FilterPlane(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+  Classes, SysUtils, BGRABitmapTypes;
+
+{ The median filter consist in calculating the median value of pixels. Here
+  a square of 9x9 pixel is considered. The median allow to select the most
+  representative colors. The option parameter allow to choose to smooth the
+  result or not. }
+function FilterMedian(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+
+{ SmartZoom x3 is a filter that upsizes 3 times the picture and add
+  pixels that could be logically expected (horizontal, vertical, diagonal lines) }
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+
+{ Sharpen filter add more contrast between pixels }
+function FilterSharpen(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ A radial blur applies a blur with a circular influence, i.e, each pixel
+  is merged with pixels within the specified radius. There is an exception
+  with rbFast blur, the optimization entails an hyperbolic shape. }
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
+
+{ The precise blur allow to specify the blur radius with subpixel accuracy }
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
+  radius: single): TBGRACustomBitmap;
+
+{ Motion blur merge pixels in a direction. The oriented parameter specifies
+  if the weights of the pixels are the same along the line or not. }
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
+
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
+
+{ General purpose blur filter, with a blur mask as parameter to describe
+  how pixels influence each other }
+function FilterBlur(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Emboss filter compute a color difference in the angle direction }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap;
+
+{ Emboss highlight computes a sort of emboss with 45 degrees angle and
+  with standard selection color (white/black and filled with blue) }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean): TBGRACustomBitmap;
+
+{ Normalize use the whole available range of values, making dark colors darkest possible
+  and light colors lightest possible }
+function FilterNormalize(bmp: TBGRACustomBitmap;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+
+{ Rotate filter rotate the image and clip it in the bounding rectangle }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single): TBGRACustomBitmap;
+
+{ Grayscale converts colored pixel into grayscale with same luminosity }
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil }
+function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Distort the image as if it were on a sphere }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Twirl distortion, i.e. a progressive rotation }
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+
+{ Distort the image as if it were on a vertical cylinder }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Compute a plane projection towards infinity (SLOW) }
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 
 implementation
 
-uses Math;
-
-function FilterSmartZoom3(bmp: TBGRADefaultBitmap;
-  Option: TMedianOption): TBGRADefaultBitmap;
+uses Math, GraphType, Dialogs, BGRATransform;
+
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
 type
   TSmartDiff = record
@@ -48 +98 @@
   xb, yb: integer;
   diag1, diag2, h1, h2, v1, v2: TSmartDiff;
-  c:      TBGRAPixel;
-  temp, median: TBGRADefaultBitmap;
+  c,c1,c2:      TBGRAPixel;
+  temp, median: TBGRACustomBitmap;
 
   function ColorDiff(c1, c2: TBGRAPixel): single;
@@ -156 +206 @@
         if diag1.cd < 0.3 then
         begin
-          c := MergeBGRA(bmp.GetPixel(xb, yb), bmp.GetPixel(xb + 1, yb + 1));
+          c1 := bmp.GetPixel(xb, yb);
+          c2 := bmp.GetPixel(integer(xb + 1), integer(yb + 1));
+          c := MergeBGRA(c1, c2);
           //restore
           Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb));
-          Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1));
+          Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(integer(xb + 1), integer(yb + 1)));
 
           if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then
@@ -173 +225 @@
         if diag2.cd < 0.3 then
         begin
-          c := MergeBGRA(bmp.GetPixel(xb, yb + 1), bmp.GetPixel(xb + 1, yb));
+          c1 := bmp.GetPixel(xb, yb + 1);
+          c2 := bmp.GetPixel(xb + 1, yb);
+          c := MergeBGRA(c1, c2);
           //restore
           Result.SetPixel(xb * 3 + 3, yb * 3 + 2, bmp.GetPixel(xb + 1, yb));
@@ -190 +244 @@
 end;
 
-function FilterSharpen(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+{ This filter compute for each pixel the mean of the eight surrounding pixels,
+  then the difference between this average pixel and the pixel at the center
+  of the square. Finally the difference is added to the new pixel, exagerating
+  its difference with its neighbours. }
+function FilterSharpen(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 const
   nbpix = 8;
@@ -204 +262 @@
   Result := bmp.NewBitmap(bmp.Width, bmp.Height);
 
+  //determine where pixels are in the bitmap
   bounds := bmp.GetImageBounds;
   if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
@@ -212 +271 @@
   bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
 
+  //loop through the destination bitmap
   for yb := bounds.Top to bounds.Bottom - 1 do
   begin
@@ -217 +277 @@
     for xb := bounds.Left to bounds.Right - 1 do
     begin
+      //for each pixel, read eight surrounding pixels in the source bitmap
       n := 0;
       for dy := -1 to 1 do
@@ -222 +283 @@
           if (dx <> 0) or (dy <> 0) then
           begin
-            a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
+            a_pixels[n] := bmp.GetPixel(integer(xb + dx), integer(yb + dy));
             Inc(n);
           end;
 
+      //compute sum
       sumR   := 0;
       sumG   := 0;
@@ -246 +308 @@
        {$hints on}
 
+      //we finally have an average pixel
       if (RGBdiv = 0) then
         refPixel := BGRAPixelTransparent
@@ -256 +319 @@
       end;
 
+      //read the pixel at the center of the square
       tempPixel := bmp.GetPixel(xb, yb);
       if refPixel <> BGRAPixelTransparent then
       begin
+        //compute sharpened pixel by adding the difference
         tempPixel.red   := max(0, min(255, tempPixel.red +
           integer(tempPixel.red - refPixel.red)));
@@ -275 +340 @@
 end;
 
-function FilterBlurRadialPrecise(bmp: TBGRADefaultBitmap;
-  radius: single): TBGRADefaultBitmap;
-var
-  blurShape: TBGRADefaultBitmap;
+{ Precise blur builds a blur mask with a gradient fill and use
+  general purpose blur }
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
+  radius: single): TBGRACustomBitmap;
+var
+  blurShape: TBGRACustomBitmap;
   intRadius: integer;
 begin
+  if radius = 0 then
+  begin
+    result := bmp.Duplicate;
+    exit;
+  end;
   intRadius := ceil(radius);
-  blurShape := TBGRADefaultBitmap.Create(2 * intRadius + 1, 2 * intRadius + 1);
+  blurShape := bmp.NewBitmap(2 * intRadius + 1, 2 * intRadius + 1);
   blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite,
     BGRABlack, gtRadial, pointF(intRadius, intRadius), pointF(
@@ -290 +362 @@
 end;
 
-function FilterBlurRadialNormal(bmp: TBGRADefaultBitmap;
-  radius: integer): TBGRADefaultBitmap;
-var
-  blurShape: TBGRADefaultBitmap;
-begin
-  blurShape := TBGRADefaultBitmap.Create(2 * radius + 1, 2 * radius + 1);
+{ This is a clever solution for fast computing of the blur
+  effect : it stores an array of vertical sums forming a square
+  around the pixel which moves with it. For each new pixel,
+  the vertical sums are kept except for the last column of
+  the square }
+function FilterBlurFast(bmp: TBGRACustomBitmap;
+  radius: integer): TBGRACustomBitmap;
+
+  type
+    TRowSum = record
+      sumR,sumG,sumB,rgbDiv,sumA,aDiv: cardinal;
+    end;
+
+  function ComputeAverage(sum: TRowSum): TBGRAPixel;
+  begin
+    result.alpha:= (sum.sumA+sum.aDiv shr 1) div sum.aDiv;
+    result.red := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv;
+    result.green := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv;
+    result.blue := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv;
+  end;
+
+  {$I blurfast.inc}
+
+{ Normal radial blur compute a blur mask with a GradientFill and
+  then posterize to optimize general purpose blur }
+function FilterBlurRadialNormal(bmp: TBGRACustomBitmap;
+  radius: integer): TBGRACustomBitmap;
+var
+  blurShape: TBGRACustomBitmap;
+  n: Integer;
+  p: PBGRAPixel;
+begin
+  blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite,
     BGRABlack, gtRadial, pointF(radius, radius), pointF(-0.5, radius), dmSet);
+  p := blurShape.Data;
+  for n := 0 to blurShape.NbPixels-1 do
+  begin
+    p^.red := p^.red and $F0;
+    p^.green := p^.red;
+    p^.blue := p^.red;
+    inc(p);
+  end;
   Result := FilterBlur(bmp, blurShape);
   blurShape.Free;
 end;
 
-function FilterBlurDisk(bmp: TBGRADefaultBitmap; radius: integer): TBGRADefaultBitmap;
-var
-  blurShape: TBGRADefaultBitmap;
-begin
-  blurShape := TBGRADefaultBitmap.Create(2 * radius + 1, 2 * radius + 1);
+{ Blur disk creates a disk mask with a FillEllipse }
+function FilterBlurDisk(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;
+var
+  blurShape: TBGRACustomBitmap;
+begin
+  blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.Fill(BGRABlack);
   blurShape.FillEllipseAntialias(radius, radius, radius + 0.5, radius + 0.5, BGRAWhite);
@@ -313 +421 @@
 end;
 
-function FilterBlurCorona(bmp: TBGRADefaultBitmap; radius: integer): TBGRADefaultBitmap;
-var
-  blurShape: TBGRADefaultBitmap;
-begin
-  blurShape := TBGRADefaultBitmap.Create(2 * radius + 1, 2 * radius + 1);
+{ Corona blur use a circle as mask }
+function FilterBlurCorona(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;
+var
+  blurShape: TBGRACustomBitmap;
+begin
+  blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.Fill(BGRABlack);
   blurShape.EllipseAntialias(radius, radius, radius, radius, BGRAWhite, 1);
@@ -324 +433 @@
 end;
 
-function FilterBlurRadial(bmp: TBGRADefaultBitmap; radius: integer;
-  blurType: TRadialBlurType): TBGRADefaultBitmap;
-begin
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
+begin
+  if radius = 0 then
+  begin
+    result := bmp.Duplicate;
+    exit;
+  end;
   case blurType of
     rbCorona: Result  := FilterBlurCorona(bmp, radius);
     rbDisk: Result    := FilterBlurDisk(bmp, radius);
     rbNormal: Result  := FilterBlurRadialNormal(bmp, radius);
+    rbFast: Result  := FilterBlurFast(bmp, radius);
     rbPrecise: Result := FilterBlurRadialPrecise(bmp, radius / 10);
     else
@@ -337 +452 @@
 end;
 
-function FilterBlurMotion(bmp: TBGRADefaultBitmap; distance: single;
-  angle: single; oriented: boolean): TBGRADefaultBitmap;
-var
-  blurShape: TBGRADefaultBitmap;
+{ This filter draws an antialiased line to make the mask, and
+  if the motion blur is oriented, does a GradientFill to orient it }
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
+var
+  blurShape: TBGRACustomBitmap;
   intRadius: integer;
   dx, dy, d: single;
 begin
+  if distance = 0 then
+  begin
+    result := bmp.Duplicate;
+    exit;
+  end;
   intRadius := ceil(distance / 2);
-  blurShape := TBGRADefaultBitmap.Create(2 * intRadius + 1, 2 * intRadius + 1);
+  blurShape := bmp.NewBitmap(2 * intRadius + 1, 2 * intRadius + 1);
   d  := distance / 2;
   dx := cos(angle * Pi / 180);
@@ -362 +484 @@
 end;
 
-function FilterBlur(bmp: TBGRADefaultBitmap;
-  blurMask: TBGRADefaultBitmap): TBGRADefaultBitmap;
-var
-  yb, xb:      integer;
-  dx, dy, mindx, maxdx, mindy, maxdy, n, j: integer;
-  a_pixels:    array of TBGRAPixel;
-  weights:     array of integer;
-  sumR, sumG, sumB, sumA, Adiv, RGBdiv: cardinal;
-  RGBweight:   byte;
-  tempPixel, refPixel: TBGRAPixel;
-  shapeMatrix: array of array of byte;
-  pdest, psrc: PBGRAPixel;
-  blurOfs:     TPoint;
-  bounds:      TRect;
-begin
-  blurOfs := point(blurMask.Width shr 1, blurMask.Height shr 1);
-
-  setlength(shapeMatrix, blurMask.Width, blurMask.Height);
-  n := 0;
-  for yb := 0 to blurMask.Height - 1 do
-    for xb := 0 to blurMask.Width - 1 do
-    begin
-      shapeMatrix[yb, xb] := blurMask.GetPixel(xb, yb).red;
-      if shapeMatrix[yb, xb] <> 0 then
-        Inc(n);
-    end;
-
-  setlength(a_pixels, n);
-  setlength(weights, n);
-
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
-  bounds := bmp.GetImageBounds;
-  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+{ General purpose blur : compute pixel sum according to the mask and then
+  compute only difference while scanning from the left to the right }
+function FilterBlurSmallMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap; forward;
+function FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; maskShift: integer): TBGRACustomBitmap; forward;
+function FilterBlurBigMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap; forward;
+
+//make sure value is in the range 0..255
+function clampByte(value: integer): byte; inline;
+begin
+  if value < 0 then result := 0 else
+  if value > 255 then result := 255 else
+    result := value;
+end;
+
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer;
+  useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
+var yb,xb, xs,ys, tx,ty: integer;
+    psrc,pdest: PBGRAPixel;
+    temp,stretched: TBGRACustomBitmap;
+    oldfilter: TResampleFilter;
+begin
+  if pixelSize < 1 then
+  begin
+    result := bmp.Duplicate;
     exit;
-  bounds.Left   := max(0, bounds.Left - blurOfs.X);
-  bounds.Top    := max(0, bounds.Top - blurOfs.Y);
-  bounds.Right  := min(bmp.Width, bounds.Right + blurMask.Width - 1 - blurOfs.X);
-  bounds.Bottom := min(bmp.Height, bounds.Bottom + blurMask.Height - 1 - blurOfs.Y);
-
-  for yb := bounds.Top to bounds.Bottom - 1 do
-  begin
-    pdest := Result.ScanLine[yb] + bounds.Left;
-    for xb := bounds.Left to Bounds.Right - 1 do
-    begin
-      n     := 0;
-      mindx := max(-blurOfs.X, -xb);
-      mindy := max(-blurOfs.Y, -yb);
-      maxdx := min(blurMask.Width - 1 - blurOfs.X, bmp.Width - 1 - xb);
-      maxdy := min(blurMask.Height - 1 - blurOfs.Y, bmp.Height - 1 - yb);
-      for dy := mindy to maxdy do
-      begin
-        psrc := bmp.scanline[yb + dy] + (xb + mindx);
-        for dx := mindx to maxdx do
-        begin
-          j := shapeMatrix[dy + blurOfs.Y, dx + blurOfs.X];
-          if j <> 0 then
-          begin
-            a_pixels[n] := psrc^;
-            weights[n]  := (a_pixels[n].alpha * j + 127) shr 8;
-            Inc(n);
-          end;
-          Inc(psrc);
-        end;
+  end;
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+
+  tx := (bmp.Width+pixelSize-1) div pixelSize;
+  ty := (bmp.Height+pixelSize-1) div pixelSize;
+  if not useResample then
+  begin
+    temp := bmp.NewBitmap(tx,ty);
+
+    xs := (bmp.Width mod pixelSize) div 2;
+    ys := (bmp.Height mod pixelSize) div 2;
+
+    for yb := 0 to temp.height-1 do
+    begin
+      pdest := temp.ScanLine[yb];
+      psrc := bmp.scanline[ys]+xs;
+      inc(ys,pixelSize);
+      for xb := 0 to temp.width-1 do
+      begin
+        pdest^ := psrc^;
+        inc(pdest);
+        inc(psrc,pixelSize);
       end;
-      sumR   := 0;
-      sumG   := 0;
-      sumB   := 0;
-      sumA   := 0;
-      Adiv   := 0;
-      RGBdiv := 0;
-
-       {$hints off}
-      for j := 0 to n - 1 do
-      begin
-        tempPixel := a_pixels[j];
-        RGBweight := (weights[j] * tempPixel.alpha + 128) div 255;
-        sumR      += tempPixel.red * RGBweight;
-        sumG      += tempPixel.green * RGBweight;
-        sumB      += tempPixel.blue * RGBweight;
-        RGBdiv    += RGBweight;
-        sumA      += tempPixel.alpha;
-        Adiv      += 1;
-      end;
-       {$hints on}
-
-      if (Adiv = 0) or (RGBdiv = 0) then
-        refPixel := BGRAPixelTransparent
-      else
-      begin
-        refPixel.alpha := (sumA + Adiv shr 1) div Adiv;
-        if refPixel.alpha = 0 then
-          refPixel := BGRAPixelTransparent
-        else
-        begin
-          refPixel.red   := (sumR + RGBdiv shr 1) div RGBdiv;
-          refPixel.green := (sumG + RGBdiv shr 1) div RGBdiv;
-          refPixel.blue  := (sumB + RGBdiv shr 1) div RGBdiv;
-        end;
-      end;
-
-      pdest^ := refPixel;
-      Inc(pdest);
-    end;
-  end;
-  Result.InvalidateBitmap;
-end;
-
-function FilterEmboss(bmp: TBGRADefaultBitmap; angle: single): TBGRADefaultBitmap;
+    end;
+    temp.InvalidateBitmap;
+  end else
+  begin
+    oldfilter := bmp.ResampleFilter;
+    bmp.ResampleFilter := filter;
+    temp := bmp.Resample(tx,ty,rmFineResample);
+    bmp.ResampleFilter := oldfilter;
+  end;
+  stretched := temp.Resample(temp.Width*pixelSize,temp.Height*pixelSize,rmSimpleStretch);
+  temp.free;
+  if bmp.Width mod pixelSize = 0 then
+    xs := 0
+  else
+    xs := (-pixelSize+(bmp.Width mod pixelSize)) div 2;
+  if bmp.Height mod pixelSize = 0 then
+    ys := 0
+  else
+    ys := (-pixelSize+(bmp.Height mod pixelSize)) div 2;
+  result.PutImage(xs,ys,stretched,dmSet);
+  stretched.Free;
+end;
+
+function FilterBlur(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  maskSum: int64;
+  i: Integer;
+  p: PBGRAPixel;
+  maskShift: integer;
+begin
+  maskSum := 0;
+  p := blurMask.data;
+  for i := 0 to blurMask.NbPixels-1 do
+  begin
+    inc(maskSum,p^.red);
+    inc(p);
+  end;
+  maskShift := 0;
+  while maskSum > 32768 do
+  begin
+    inc(maskShift);
+    maskSum := maskSum shr 1;
+  end;
+  //check if sum can be stored in a 32-bit signed integer
+  if maskShift = 0 then
+    result := FilterBlurSmallMask(bmp,blurMask) else
+  if maskShift < 8 then
+    result := FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift) else
+    result := FilterBlurBigMask(bmp,blurMask);
+end;
+
+//32-bit blur with shift
+function FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; maskShift: integer): TBGRACustomBitmap;
+
+  var
+    sumR, sumG, sumB, sumA, Adiv, RGBdiv : integer;
+
+  function ComputeAverage: TBGRAPixel; inline;
+  begin
+    result.alpha := (sumA + Adiv shr 1) div Adiv;
+    if result.alpha = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      result.red   := clampByte((sumR + RGBdiv shr 1) div RGBdiv);
+      result.green := clampByte((sumG + RGBdiv shr 1) div RGBdiv);
+      result.blue  := clampByte((sumB + RGBdiv shr 1) div RGBdiv);
+    end;
+  end;
+
+  {$define PARAM_MASKSHIFT}
+  {$I blurnormal.inc}
+
+//32-bit blur
+function FilterBlurSmallMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+
+  var
+    sumR, sumG, sumB, sumA, Adiv : integer;
+
+  function ComputeAverage: TBGRAPixel; inline;
+  begin
+    result.alpha := (sumA + Adiv shr 1) div Adiv;
+    if result.alpha = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      result.red   := clampByte((sumR + sumA shr 1) div sumA);
+      result.green := clampByte((sumG + sumA shr 1) div sumA);
+      result.blue  := clampByte((sumB + sumA shr 1) div sumA);
+    end;
+  end;
+
+  {$I blurnormal.inc}
+
+//floating point blur
+function FilterBlurBigMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+
+  var
+    sumR, sumG, sumB, sumA, Adiv : single;
+
+  function ComputeAverage: TBGRAPixel; inline;
+  begin
+    result.alpha := round(sumA/Adiv);
+    if result.alpha = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      result.red   := clampByte(round(sumR/sumA));
+      result.green := clampByte(round(sumG/sumA));
+      result.blue  := clampByte(round(sumB/sumA));
+    end;
+  end;
+
+  {$I blurnormal.inc}
+
+{ Emboss filter computes the difference between each pixel and the surrounding pixels
+  in the specified direction. }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap;
 var
   yb, xb: integer;
@@ -475 +662 @@
   idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: integer;
   w:      array[1..4] of single;
-  iw:     integer;
+  iw:     cardinal;
   c:      array[0..4] of TBGRAPixel;
 
@@ -485 +672 @@
   bounds: TRect;
 begin
+  //compute pixel position and weight
   dx   := cos(angle * Pi / 180);
   dy   := sin(angle * Pi / 180);
@@ -501 +689 @@
   w[4] := (1 - abs(idx4 - dx)) * (1 - abs(idy4 - dy));
 
+  //fill with gray
   Result := bmp.NewBitmap(bmp.Width, bmp.Height);
   Result.Fill(BGRA(128, 128, 128, 255));
@@ -512 +701 @@
   bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
 
+  //loop through destination
   for yb := bounds.Top to bounds.bottom - 1 do
   begin
@@ -518 +708 @@
     begin
       c[0] := bmp.getPixel(xb, yb);
-      c[1] := bmp.getPixel(xb + idx1, yb + idy1);
-      c[2] := bmp.getPixel(xb + idx2, yb + idy2);
-      c[3] := bmp.getPixel(xb + idx3, yb + idy3);
-      c[4] := bmp.getPixel(xb + idx4, yb + idy4);
+      c[1] := bmp.getPixel(integer(xb + idx1), integer(yb + idy1));
+      c[2] := bmp.getPixel(integer(xb + idx2), integer(yb + idy2));
+      c[3] := bmp.getPixel(integer(xb + idx3), integer(yb + idy3));
+      c[4] := bmp.getPixel(integer(xb + idx4), integer(yb + idy4));
 
       sumR   := 0;
@@ -530 +720 @@
       RGBdiv := 0;
 
+      //compute sum
        {$hints off}
       for i := 1 to 4 do
@@ -546 +737 @@
        {$hints on}
 
+      //average
       if (Adiv = 0) or (RGBdiv = 0) then
         refPixel := c[0]
@@ -555 +747 @@
         refPixel.alpha := (sumA * 255 + Adiv shr 1) div Adiv;
       end;
+
+      //difference with center pixel
        {$hints off}
       tempPixel.red := max(0, min(512 * 255, 65536 + refPixel.red *
@@ -571 +765 @@
 end;
 
-function FilterEmbossHighlight(bmp: TBGRADefaultBitmap;
-  FillSelection: boolean): TBGRADefaultBitmap;
+{ Like general emboss, but with fixed direction and automatic color with transparency }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean): TBGRACustomBitmap;
 var
   yb, xb: integer;
@@ -710 +905 @@
 end;
 
-function FilterNormalize(bmp: TBGRADefaultBitmap;
-  eachChannel: boolean = True): TBGRADefaultBitmap;
+{ Normalize compute min-max of specified channel and apply an affine transformation
+  to make it use the full range of values }
+function FilterNormalize(bmp: TBGRACustomBitmap;
+  eachChannel: boolean = True): TBGRACustomBitmap;
 var
   psrc, pdest: PBGRAPixel;
@@ -831 +1028 @@
 end;
 
-function FilterRotate(bmp: TBGRADefaultBitmap; origin: TPointF;
-  angle: single): TBGRADefaultBitmap;
+{ Rotates the image. To do this, loop through the destination and
+  calculates the position in the source bitmap with an affine transformation }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single): TBGRACustomBitmap;
 var
   bounds:     TRect;
@@ -926 +1125 @@
 end;
 
-function FilterGrayscale(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+{ Filter grayscale applies BGRAToGrayscale function to all pixels }
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 var
   bounds:      TRect;
@@ -952 +1152 @@
 end;
 
-function FilterContour(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+{ Filter contour compute a grayscale image, then for each pixel
+  calculates the difference with surrounding pixels (in intensity and alpha)
+  and draw black pixels when there is a difference }
+function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 var
   yb, xb: integer;
@@ -964 +1167 @@
 
   bounds: TRect;
-  gray:   TBGRADefaultBitmap;
+  gray:   TBGRACustomBitmap;
 begin
   bmpWidth  := bmp.Width;
@@ -1066 +1269 @@
 end;
 
-function FilterSphere(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+{ Compute the distance for each pixel to the center of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the center in the source bitmap }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 var
   cx, cy, x, y, len, fact: single;
   xb, yb: integer;
-  mask:   TBGRADefaultBitmap;
+  mask:   TBGRACustomBitmap;
 begin
   Result := bmp.NewBitmap(bmp.Width, bmp.Height);
@@ -1099 +1305 @@
 end;
 
-function FilterCylinder(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+{ Applies twirl scanner. See TBGRATwirlScanner }
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+var twirl: TBGRATwirlScanner;
+begin
+  twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent);
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  result.Fill(twirl);
+  twirl.free;
+end;
+
+{ Compute the distance for each pixel to the vertical axis of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the vertical axis in the source bitmap }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 var
   cx, cy, x, y, len, fact: single;
@@ -1125 +1344 @@
 end;
 
-function FilterPlane(bmp: TBGRADefaultBitmap): TBGRADefaultBitmap;
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 const resampleGap=0.6;
 var
   cy, x1, x2, y1, y2, z1, z2, h: single;
   yb: integer;
-  resampledBmp: TBGRADefaultBitmap;
+  resampledBmp: TBGRACustomBitmap;
   resampledBmpWidth: integer;
   resampledFactor,newResampleFactor: single;
-  sub,resampledSub: TBGRADefaultBitmap;
+  sub,resampledSub: TBGRACustomBitmap;
   partRect: TRect;
   resampleSizeY : integer;
@@ -1191 +1410 @@
 end;
 
-function FilterMedian(bmp: TBGRADefaultBitmap;
-  Option: TMedianOption): TBGRADefaultBitmap;
+{ For each component, sort values to get the median }
+function FilterMedian(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
 
   function ComparePixLt(p1, p2: TBGRAPixel): boolean;
@@ -1236 +1456 @@
         for dx := -1 to 1 do
         begin
-          a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
+          a_pixels[n] := bmp.GetPixel(integer(xb + dx), integer(yb + dy));
           if a_pixels[n].alpha = 0 then
             a_pixels[n] := BGRAPixelTransparent;

GraphicTest/BGRABitmap/bgragtkbitmap.pas

@@ -37 +37 @@
   private
     FPixBuf: Pointer;
-    procedure SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
-      ACanvas: TCanvas; ARect: TRect);
+{    procedure SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
+      ACanvas: TCanvas; ARect: TRect);}
+    procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect);
+    procedure DrawOpaque(ACanvas: TCanvas; Rect: TRect);
   protected
     procedure ReallocData; override;
     procedure FreeData; override;
-    procedure DrawOpaque(ACanvas: TCanvas; Rect: TRect);
   public
     procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
@@ -50 +51 @@
     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
-      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-      override;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
   end;
@@ -71 +71 @@
 {$ENDIF}
 
-procedure TBGRAGtkBitmap.SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
+{procedure TBGRAGtkBitmap.SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
   ACanvas: TCanvas; ARect: TRect);
 var
-  background, temp: TBGRADefaultBitmap;
+  background, temp: TBGRACustomBitmap;
   w, h: integer;
 
@@ -92 +92 @@
   background.Draw(ACanvas, ARect.Left, ARect.Top, True);
   background.Free;
-end;
+end;}
 
 procedure TBGRAGtkBitmap.ReallocData;
 begin
+  {$IFDEF LCLgtk2}
+  If FPixBuf <> nil then g_object_unref(FPixBuf);
+  {$ELSE}
+  If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf);
+  {$ENDIF}
+  FPixBuf := nil;  
   inherited ReallocData;
-  FPixbuf := gdk_pixbuf_new_from_data(pguchar(FData),
-    GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil);
-  if FPixbuf = nil then
-    raise Exception.Create('Error initializing Pixbuf');
+  if (FWidth <> 0) and (FHeight <> 0) then
+  begin  
+    FPixbuf := gdk_pixbuf_new_from_data(pguchar(FData),
+      GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil);
+    if FPixbuf = nil then
+      raise Exception.Create('Error initializing Pixbuf');
+  end;
 end;
 
@@ -114 +123 @@
 end;
 
-procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; Rect: TRect);
+procedure TBGRAGtkBitmap.DrawTransparent(ACanvas: TCanvas; Rect: TRect);
 var DrawWidth,DrawHeight: integer;
     stretched: TBGRAGtkBitmap;
@@ -126 +135 @@
   begin
     stretched := Resample(DrawWidth,DrawHeight,rmSimpleStretch) as TBGRAGtkBitmap;
-    stretched.DrawOpaque(ACanvas,Rect);
+    stretched.DrawTransparent(ACanvas,Rect);
     stretched.Free;
     exit;
   end;
 
-  //SwapRedBlue;
+  SwapRedBlue;
   gdk_pixbuf_render_to_drawable(FPixBuf,
     TGtkDeviceContext(ACanvas.Handle).Drawable,
@@ -140 +149 @@
     Width,Height,
     GDK_RGB_DITHER_NORMAL,0,0);
-  //SwapRedBlue;
+  SwapRedBlue;
+end;
+
+procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; Rect: TRect);
+begin
+  DataDrawOpaque(ACanvas,Rect,Data,LineOrder,Width,Height);
 end;
 
@@ -146 +160 @@
   AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
 var
-  Temp: TBGRAPtrBitmap;
-begin
-  Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData);
-  Temp.LineOrder := ALineOrder;
-  SlowDrawTransparent(Temp, ACanvas, Rect);
-  Temp.Free;
+  TempGtk: TBGRAGtkBitmap;
+  temp: integer;
+begin
+  if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or
+    (Rect.Top = Rect.Bottom) then
+    exit;
+
+  if Rect.Right < Rect.Left then
+  begin
+    temp := Rect.Left;
+    Rect.Left := Rect.Right;
+    Rect.Right := temp;
+  end;
+
+  if Rect.Bottom < Rect.Top then
+  begin
+    temp := Rect.Top;
+    Rect.Top := Rect.Bottom;
+    Rect.Bottom := temp;
+  end;
+
+  TempGtk := TBGRAGtkBitmap.Create(AWidth, AHeight);
+  Move(AData^,TempGtk.Data^,TempGtk.NbPixels*sizeof(TBGRAPixel));
+  if ALineOrder <> TempGtk.LineOrder then TempGtk.VerticalFlip;
+  TempGtk.DrawTransparent(ACanvas,Rect);
+  TempGtk.Free;
 end;
 
@@ -161 +195 @@
     DrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height))
   else
-    SlowDrawTransparent(Self, ACanvas, Rect(X, Y, X + Width, Y + Height));
+    DrawTransparent(ACanvas, Rect(X, Y, X + Width, Y + Height));
 end;
 
@@ -171 +205 @@
     DrawOpaque(ACanvas, Rect)
   else
-    SlowDrawTransparent(Self, ACanvas, Rect);
+    DrawTransparent(ACanvas, Rect);
 end;
 
 procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
   AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-var stretched: TBGRADefaultBitmap;
-begin
-  if (AHeight = 0) or (AWidth = 0) then
-    exit;
-
-  if (AWidth <> Width) or (AHeight <> Height) then
-  begin
-    stretched := Resample(AWidth,AHeight,rmSimpleStretch);
-    stretched.DataDrawOpaque(ACanvas,Rect,AData,stretched.LineOrder,AWidth,AHeight)
-  end;
-
+var ptr: TBGRAPtrBitmap;
+    stretched: TBGRACustomBitmap;
+    temp: integer;
+    pos: TPoint;
+    dest: HDC;
+begin
+  if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or
+    (Rect.Top = Rect.Bottom) then
+    exit;
+
+  if Rect.Right < Rect.Left then
+  begin
+    temp := Rect.Left;
+    Rect.Left := Rect.Right;
+    Rect.Right := temp;
+  end;
+
+  if Rect.Bottom < Rect.Top then
+  begin
+    temp := Rect.Top;
+    Rect.Top := Rect.Bottom;
+    Rect.Bottom := temp;
+  end;
+
+  if (AWidth <> Rect.Right-Rect.Left) or (AHeight <> Rect.Bottom-Rect.Top) then
+  begin
+    ptr := TBGRAPtrBitmap.Create(AWidth,AHeight,AData);
+    ptr.LineOrder := ALineOrder;
+    stretched := ptr.Resample(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top);
+    ptr.free;
+    DataDrawOpaque(ACanvas,Rect,AData,stretched.LineOrder,stretched.Width,stretched.Height);
+    stretched.Free;
+    exit;
+  end;
+
+  dest := ACanvas.Handle;
+  pos := TGtkDeviceContext(dest).Offset;
+  pos.X += rect.Left;
+  pos.Y += rect.Top;
   If ALineOrder = riloBottomToTop then VerticalFlip;
   SwapRedBlue;
-  gdk_pixbuf_render_to_drawable(FPixBuf,
-    TGtkDeviceContext(ACanvas.Handle).Drawable,
-    TGtkDeviceContext(ACanvas.Handle).GC,
-    0,0,Rect.Left,Rect.Top,AWidth,AHeight,
-    GDK_RGB_DITHER_NORMAL,0,0);
+  gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable,
+    TGtkDeviceContext(Dest).GC, pos.X,pos.Y,
+    AWidth,AHeight, GDK_RGB_DITHER_NORMAL,
+    AData, AWidth*sizeof(TBGRAPixel));
   SwapRedBlue;
   If ALineOrder = riloBottomToTop then VerticalFlip;
@@ -200 +261 @@
 procedure TBGRAGtkBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
 var
-  subBmp: TBGRADefaultBitmap;
+  subBmp: TBGRACustomBitmap;
   subRect: TRect;
   cw,ch: integer;
@@ -240 +301 @@
 end.
 
+

GraphicTest/BGRABitmap/bgrapaintnet.pas

@@ -5 +5 @@
 interface
 
+{ This unit reads Paint.NET files. It needs BGRADNetDeserial to deserialize binary .Net objects.
+
+  A Paint.NET image consists in three parts :
+  - Xml header
+  - Binary serialized information (contains layer information)
+  - Compressed data (pixel data)
+
+  The class TPaintDotNetFile do not read the Xml header. ComputeFlatImage builds the resulting image
+  by using blending operations to merge layers.
+
+  The unit registers a TFPCustomImageReader so that it can be read by any image reading function of FreePascal }
+
 uses
-  Classes, SysUtils, BGRADNetDeserial, BGRABitmap, BGRABitmapTypes;
+  Classes, SysUtils, BGRADNetDeserial, BGRALayers, BGRABitmap, BGRABitmapTypes, FPImage;
 
 type
@@ -12 +24 @@
   { TPaintDotNetFile }
 
-  TPaintDotNetFile = class
+  TPaintDotNetFile = class(TBGRACustomLayeredBitmap)
   public
-    procedure LoadFromFile(filename: string);
-    procedure LoadFromStream(stream: TStream);
-    procedure Clear;
-    function ToString: string;
-    destructor Destroy; override;
+    procedure LoadFromFile(filename: string); override;
+    procedure LoadFromStream(stream: TStream); override;
+    procedure Clear; override;
+    function ToString: ansistring; override;
+    function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
     constructor Create;
-    function Width: integer;
-    function Height: integer;
-    function NbLayers: integer;
-    function BlendOperation(Layer: integer): TBlendOperation;
-    function LayerVisible(layer: integer): boolean;
-    function LayerOpacity(layer: integer): byte;
-    function LayerName(layer: integer): string;
-    function MakeBitmapLayer(layer: integer): TBGRABitmap;
-    function ComputeFlatImage: TBGRABitmap;
+  protected
+    function GetWidth: integer; override;
+    function GetHeight: integer; override;
+    function GetNbLayers: integer; override;
+    function GetBlendOperation(Layer: integer): TBlendOperation; override;
+    function GetLayerVisible(layer: integer): boolean; override;
+    function GetLayerOpacity(layer: integer): byte; override;
+    function GetLayerName(layer: integer): string; override;
   private
     XmlHeader: string;
     ThumbNail: TBGRABitmap;
     Content:   TDotNetDeserialization;
-    Document:  PSerializedObject;
-    Layers:    PSerializedObject;
+    Document:  TSerializedClass;
+    Layers:    TSerializedClass;
     LayerData: array of TMemoryStream;
-    function GetLayer(num: integer): PSerializedObject;
-    function GetBlendOperation(layer: PSerializedObject): TBlendOperation;
-    function GetLayerName(layer: PSerializedObject): string;
-    function GetLayerVisible(layer: PSerializedObject): boolean;
-    function GetLayerOpacity(layer: PSerializedObject): byte;
+    function InternalGetLayer(num: integer): TSerializedClass;
+    function InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation;
+    function InternalGetLayerName(layer: TSerializedClass): string;
+    function InternalGetLayerVisible(layer: TSerializedClass): boolean;
+    function InternalGetLayerOpacity(layer: TSerializedClass): byte;
     function LayerDataSize(numLayer: integer): int64;
     procedure LoadLayer(dest: TMemoryStream; src: TStream; uncompressedSize: int64);
+  end;
+
+  { TFPReaderPaintDotNet }
+
+  TFPReaderPaintDotNet = class(TFPCustomImageReader)
+    protected
+      function InternalCheck(Stream: TStream): boolean; override;
+      procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
   end;
 
@@ -146 +165 @@
 {$hints on}
 
+{ TFPReaderPaintDotNet }
+
+function TFPReaderPaintDotNet.InternalCheck(Stream: TStream): boolean;
+begin
+  result := IsPaintDotNetStream(stream);
+end;
+
+procedure TFPReaderPaintDotNet.InternalRead(Stream: TStream; Img: TFPCustomImage
+  );
+var
+  pdn: TPaintDotNetFile;
+  flat: TBGRABitmap;
+  x,y: integer;
+begin
+  pdn    := TPaintDotNetFile.Create;
+  try
+    pdn.LoadFromStream(Stream);
+    flat := pdn.ComputeFlatImage;
+    try
+      Img.SetSize(pdn.Width,pdn.Height);
+      for y := 0 to pdn.Height-1 do
+        for x := 0 to pdn.Width-1 do
+          Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y));
+    finally
+      flat.free;
+    end;
+    pdn.Free;
+  except
+    on ex: Exception do
+    begin
+      pdn.Free;
+      raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message);
+    end;
+  end;
+end;
+
 { TPaintDotNetFile }
 
@@ -163 +218 @@
 var
   header: packed array[0..3] of char;
-  XmlHeaderSize: longword;
+  XmlHeaderSize: integer;
   CompressionFormat: word;
   i:      integer;
@@ -192 +247 @@
         IntToStr(Compressionformat) + ')');
   end;
-  Document := Content.FindObject('Document');
+  Document := Content.FindClass('Document');
   if Document <> nil then
-    Layers := Content.GetObjectField(Document^, 'layers');
+    Layers := Content.GetObjectField(Document, 'layers') as TSerializedClass;
   SetLength(LayerData, NbLayers);
   for i := 0 to NbLayers - 1 do
@@ -203 +258 @@
 end;
 
-function TPaintDotNetFile.ToString: string;
+function TPaintDotNetFile.ToString: ansistring;
 var
   i, j, nbbytes: integer;
@@ -216 +271 @@
   for i := 0 to NbLayers - 1 do
   begin
-    Result += LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName(i) + LineEnding;
+    Result += LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding;
     Result += '[ ';
     LayerData[i].Position := 0;
@@ -234 +289 @@
     Result   += ']' + lineending;
   end;
-end;
-
-destructor TPaintDotNetFile.Destroy;
-begin
-  content.Free;
-  Thumbnail.Free;
-  inherited Destroy;
 end;
 
@@ -265 +313 @@
 end;
 
-function TPaintDotNetFile.Width: integer;
+function TPaintDotNetFile.GetWidth: integer;
 begin
   if Document = nil then
     Result := 0
   else
-    Result := StrToInt(Content.GetSimpleField(Document^, 'width'));
-end;
-
-function TPaintDotNetFile.Height: integer;
+    Result := StrToInt(Content.GetSimpleField(Document, 'width'));
+end;
+
+function TPaintDotNetFile.GetHeight: integer;
 begin
   if Document = nil then
     Result := 0
   else
-    Result := StrToInt(Content.GetSimpleField(Document^, 'height'));
-end;
-
-function TPaintDotNetFile.NbLayers: integer;
+    Result := StrToInt(Content.GetSimpleField(Document, 'height'));
+end;
+
+function TPaintDotNetFile.GetNbLayers: integer;
 begin
   if Layers = nil then
     Result := 0
   else
-    Result := StrToInt(Content.GetSimpleField(Layers^, '_size'));
-end;
-
-function TPaintDotNetFile.BlendOperation(Layer: integer): TBlendOperation;
-begin
-  Result := GetBlendOperation(GetLayer(layer));
-end;
-
-function TPaintDotNetFile.LayerVisible(layer: integer): boolean;
-begin
-  Result := GetLayerVisible(GetLayer(layer));
-end;
-
-function TPaintDotNetFile.LayerOpacity(layer: integer): byte;
-begin
-  Result := GetLayerOpacity(GetLayer(layer));
-end;
-
-function TPaintDotNetFile.LayerName(layer: integer): string;
-begin
-  Result := GetLayerName(GetLayer(layer));
-end;
-
-function TPaintDotNetFile.MakeBitmapLayer(layer: integer): TBGRABitmap;
+    Result := StrToInt(Content.GetSimpleField(Layers, '_size'));
+end;
+
+function TPaintDotNetFile.GetBlendOperation(Layer: integer): TBlendOperation;
+begin
+  Result := InternalGetBlendOperation(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerVisible(layer: integer): boolean;
+begin
+  Result := InternalGetLayerVisible(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerOpacity(layer: integer): byte;
+begin
+  Result := InternalGetLayerOpacity(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerName(layer: integer): string;
+begin
+  Result := InternalGetLayerName(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerBitmapCopy(layer: integer): TBGRABitmap;
 begin
   if (layer < 0) or (layer >= NbLayers) then
@@ -315 +363 @@
 
   Result := TBGRABitmap.Create(Width, Height);
-  if Result.NbPixels * 4 <> LayerData[layer].Size then
+  if int64(Result.NbPixels) * 4 <> LayerData[layer].Size then
   begin
     Result.Free;
@@ -331 +379 @@
 end;
 
-function TPaintDotNetFile.ComputeFlatImage: TBGRABitmap;
-var
-  tempLayer, tempMerge: TBGRABitmap;
-  i: integer;
-begin
-  Result := TBGRABitmap.Create(Width, Height);
-  for i := 0 to NbLayers - 1 do
-  begin
-    tempLayer := MakeBitmapLayer(i);
-    if tempLayer <> nil then
-    begin
-      //first layer is simply the background
-      if i = 0 then
-        Result.PutImage(0, 0, tempLayer, dmSet)
-      else
-      //simple blend operations
-      if BlendOperation(i) in [boTransparent, boLinearBlend] then
-      begin
-        tempLayer.ApplyGlobalOpacity(LayerOpacity(i));
-        Result.BlendImage(0, 0, tempLayer, BlendOperation(i));
-      end
-      else
-        //complex blend operations are done in a third bitmap
-      begin
-        tempMerge := Result.Duplicate as TBGRABitmap;
-        tempMerge.BlendImage(0, 0, tempLayer, BlendOperation(i));
-        tempMerge.ApplyGlobalOpacity(LayerOpacity(i));
-        Result.PutImage(0, 0, tempMerge, dmFastBlend);
-        tempMerge.Free;
-      end;
-      tempLayer.Free;
-    end;
-  end;
-end;
-
-function TPaintDotNetFile.GetLayerName(layer: PSerializedObject): string;
-var
-  prop: PSerializedObject;
+function TPaintDotNetFile.InternalGetLayerName(layer: TSerializedClass): string;
+var
+  prop: TCustomSerializedObject;
 begin
   if layer = nil then
@@ -374 +387 @@
   else
   begin
-    prop := Content.GetObjectField(layer^, 'Layer+properties');
+    prop := Content.GetObjectField(layer, 'Layer+properties');
     if prop = nil then
       Result := ''
     else
     begin
-      Result := Content.GetSimpleField(prop^, 'name');
+      Result := Content.GetSimpleField(prop, 'name');
     end;
   end;
@@ -386 +399 @@
 function TPaintDotNetFile.LayerDataSize(numLayer: integer): int64;
 var
-  layer, surface, scan0: PSerializedObject;
-begin
-  layer := GetLayer(numLayer);
+  layer, surface, scan0: TCustomSerializedObject;
+begin
+  layer := InternalGetLayer(numLayer);
   if layer = nil then
     Result := 0
   else
   begin
-    surface := Content.GetObjectField(layer^, 'surface');
+    surface := Content.GetObjectField(layer, 'surface');
     if surface = nil then
       Result := 0
     else
     begin
-      scan0  := Content.GetObjectField(surface^, 'scan0');
-      Result := StrToInt64(Content.GetSimpleField(scan0^, 'length64'));
+      scan0  := Content.GetObjectField(surface, 'scan0');
+      Result := StrToInt64(Content.GetSimpleField(scan0, 'length64'));
     end;
   end;
@@ -457 +470 @@
 end;
 
-function TPaintDotNetFile.GetLayer(num: integer): PSerializedObject;
-var
-  layerList: PSerializedObject;
+function TPaintDotNetFile.InternalGetLayer(num: integer): TSerializedClass;
+var
+  layerList: TCustomSerializedObject;
 begin
   if Layers = nil then
@@ -468 +481 @@
   else
   begin
-    layerList := Content.GetObjectField(Layers^, '_items');
-    Result    := Content.GetObject(layerList^.fields[num].Value);
-  end;
-end;
-
-function TPaintDotNetFile.GetBlendOperation(layer: PSerializedObject): TBlendOperation;
-var
-  prop, blendOp: PSerializedObject;
+    layerList := Content.GetObjectField(Layers, '_items');
+    Result    := Content.GetObject(layerList.FieldAsString[num]) as TSerializedClass;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation;
+var
+  prop, blendOp: TCustomSerializedObject;
   blendName:     string;
 begin
@@ -482 +495 @@
   else
   begin
-    prop := Content.GetObjectField(layer^, 'properties');
+    prop := Content.GetObjectField(layer, 'properties');
     if prop = nil then
       Result := boTransparent
     else
     begin
-      blendOp := Content.GetObjectField(prop^, 'blendOp');
+      blendOp := Content.GetObjectField(prop, 'blendOp');
       if blendOp = nil then
         Result := boTransparent
       else
       begin
-        blendName := Content.GetObjectType(blendOp);
+        blendName := blendOp.TypeAsString;
         if (pos('+', blendName) <> 0) then
           Delete(blendName, 1, pos('+', blendName));
@@ -548 +561 @@
 end;
 
-function TPaintDotNetFile.GetLayerVisible(layer: PSerializedObject): boolean;
-var
-  prop: PSerializedObject;
+function TPaintDotNetFile.InternalGetLayerVisible(layer: TSerializedClass): boolean;
+var
+  prop: TCustomSerializedObject;
 begin
   if layer = nil then
@@ -556 +569 @@
   else
   begin
-    prop := Content.GetObjectField(layer^, 'Layer+properties');
+    prop := Content.GetObjectField(layer, 'Layer+properties');
     if prop = nil then
       Result := False
     else
     begin
-      Result := (Content.GetSimpleField(prop^, 'visible') = 'True');
-    end;
-  end;
-end;
-
-function TPaintDotNetFile.GetLayerOpacity(layer: PSerializedObject): byte;
-var
-  prop: PSerializedObject;
+      Result := (Content.GetSimpleField(prop, 'visible') = 'True');
+    end;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetLayerOpacity(layer: TSerializedClass): byte;
+var
+  prop: TCustomSerializedObject;
 begin
   if layer = nil then
@@ -574 +587 @@
   else
   begin
-    prop := Content.GetObjectField(layer^, 'Layer+properties');
+    prop := Content.GetObjectField(layer, 'Layer+properties');
     if prop = nil then
       Result := 0
     else
     begin
-      Result := StrToInt(Content.GetSimpleField(prop^, 'opacity'));
-    end;
-  end;
-end;
-
-{var fout: TFileStream;
-    comp: Tcompressionstream;
-
-    gzipHeader: packed record
-       magicWord: word;
-       compMethod,flags: byte;
-       fileModif: Longword;
-       extraflag,os: byte;
-    end;                   }
+      Result := StrToInt(Content.GetSimpleField(prop, 'opacity'));
+    end;
+  end;
+end;
 
 initialization
 
-{  gzipHeader.magicWord := $8b1F;
-  gzipHeader.compMethod := 8;
-  gzipHeader.flags := 0;
-  gzipHeader.fileModif := 0;
-  gzipHeader.extraflag := 0;
-  gzipHeader.os := $ff;
-
-  fout := TFileStream.Create('testcomp.gz', fmCreate);
-  fout.Write(gzipHeader,sizeof(gzipHeader));
-  comp := Tcompressionstream.Create(cldefault,fout,true);
-  comp.WriteAnsiString('Hello world');
-  comp.free;
-  fout.Free;  }
+  ImageHandlers.RegisterImageReader ('Paint.NET image', 'pdn', TFPReaderPaintDotNet);
 
 end.
 
+

GraphicTest/BGRABitmap/bgrapolygon.pas

@@ -3 +3 @@
 {$mode objfpc}{$H+}
 
+{ This unit contains polygon drawing functions and spline functions.
+
+  Shapes are drawn using a TFillShapeInfo object, which calculates the
+  intersection of an horizontal line and the polygon.
+
+  Various shapes are handled :
+  - TFillPolyInfo : polygon
+  - TFillEllipseInfo : ellipse
+  - TFillBorderEllipseInfo : ellipse border
+  - TFillRoundRectangleInfo : round rectangle (or other corners)
+  - TFillBorderRoundRectInfo : round rectangle border
+
+  Various fill modes :
+  - Alternate : each time there is an intersection, it enters or go out of the polygon
+  - Winding : filled when the sum of ascending and descending intersection is non zero
+  - Color : fill with a color defined as a TBGRAPixel argument
+  - Erase : erase with an alpha in the TBGRAPixel argument
+  - Texture : draws a texture with the IBGRAScanner argument
+
+  Various border handling :
+  - aliased : one horizontal line intersection is calculated per pixel in the vertical loop
+  - antialiased : more lines are calculated and a density is computed by adding them together
+  - multi-polygon antialiasing and superposition (TBGRAMultiShapeFiller) : same as above but
+    by combining multiple polygons at the same time, and optionally subtracting top polygons
+  }
+
 interface
 
 uses
-  Classes, SysUtils, BGRADefaultBitmap, BGRABitmapTypes;
+  Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, Graphics;
+
+procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean);
+procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+  scan: IBGRAScanner; NonZeroWinding: boolean);
+procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
 
 type
-  ArrayOfSingle = array of single;
-
-  { TFillShapeInfo }
-
-  TFillShapeInfo = class
-    function GetBounds: TRect; virtual;
-    function NbMaxIntersection: integer; virtual;
-    procedure ComputeIntersection(cury: single; var inter: ArrayOfSingle;
-      var nbInter: integer); virtual;
-  end;
-
-procedure FillShapeAntialias(bmp: TBGRADefaultBitmap; shapeInfo: TFillShapeInfo;
+
+  { TBGRAMultishapeFiller }
+
+  TBGRAMultishapeFiller = class
+  protected
+    nbShapes: integer;
+    shapes: array of record
+        info: TFillShapeInfo;
+        internalInfo: boolean;
+        texture: IBGRAScanner;
+        internalTexture: TObject;
+        color: TExpandedPixel;
+        bounds: TRect;
+      end;
+    procedure AddShape(AInfo: TFillShapeInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
+    function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean;
+  public
+    FillMode : TFillMode;
+    PolygonOrder: TPolygonOrder;
+    Antialiasing: Boolean;
+    AliasingIncludeBottomRight: Boolean;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddShape(AShape: TFillShapeInfo; AColor: TBGRAPixel);
+    procedure AddShape(AShape: TFillShapeInfo; ATexture: IBGRAScanner);
+    procedure AddPolygon(const points: array of TPointF; AColor: TBGRAPixel);
+    procedure AddPolygon(const points: array of TPointF; ATexture: IBGRAScanner);
+    procedure AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2, c3: TBGRAPixel);
+    procedure AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
+    procedure AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
+    procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+    procedure AddQuadPerspectiveMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+    procedure AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel);
+    procedure AddEllipse(x, y, rx, ry: single; ATexture: IBGRAScanner);
+    procedure AddEllipseBorder(x, y, rx, ry, w: single; AColor: TBGRAPixel);
+    procedure AddEllipseBorder(x, y, rx, ry, w: single; ATexture: IBGRAScanner);
+    procedure AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []);
+    procedure AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []);
+    procedure AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []);
+    procedure AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []);
+    procedure AddRectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel);
+    procedure AddRectangle(x1, y1, x2, y2: single; ATexture: IBGRAScanner);
+    procedure AddRectangleBorder(x1, y1, x2, y2, w: single; AColor: TBGRAPixel);
+    procedure AddRectangleBorder(x1, y1, x2, y2, w: single; ATexture: IBGRAScanner);
+    procedure Draw(dest: TBGRACustomBitmap);
+  end;
+
+procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF;
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode);
+procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; points: array of TPointF;
+  scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode);
+procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean);
+procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; points: array of TPointF;
+  scan: IBGRAScanner; NonZeroWinding: boolean);
+
+procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
   c: TBGRAPixel; EraseMode: boolean);
-
-type
-  { TFillPolyInfo }
-
-  TFillPolyInfo = class(TFillShapeInfo)
-  private
-    FPoints:      array of TPointF;
-    FSlopes:      array of single;
-    FEmptyPt, FChangedir: array of boolean;
-    FNext, FPrev: array of integer;
-  public
-    constructor Create(points: array of TPointF);
-    function GetBounds: TRect; override;
-    function NbMaxIntersection: integer; override;
-    procedure ComputeIntersection(cury: single; var inter: ArrayOfSingle;
-      var nbInter: integer); override;
-  end;
-
-procedure FillPolyAntialias(bmp: TBGRADefaultBitmap; points: array of TPointF;
+procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
+  scan: IBGRAScanner);
+
+procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
   c: TBGRAPixel; EraseMode: boolean);
-
-type
-  { TFillEllipseInfo }
-
-  TFillEllipseInfo = class(TFillShapeInfo)
-  private
-    FX, FY, FRX, FRY: single;
-  public
-    constructor Create(x, y, rx, ry: single);
-    function GetBounds: TRect; override;
-    function NbMaxIntersection: integer; override;
-    procedure ComputeIntersection(cury: single; var inter: ArrayOfSingle;
-      var nbInter: integer); override;
-  end;
-
-procedure FillEllipseAntialias(bmp: TBGRADefaultBitmap; x, y, rx, ry: single;
-  c: TBGRAPixel; EraseMode: boolean);
-
-type
-  { TFillBorderEllipseInfo }
-
-  TFillBorderEllipseInfo = class(TFillShapeInfo)
-  private
-    innerBorder, outerBorder: TFillEllipseInfo;
-  public
-    constructor Create(x, y, rx, ry, w: single);
-    function GetBounds: TRect; override;
-    function NbMaxIntersection: integer; override;
-    procedure ComputeIntersection(cury: single; var inter: ArrayOfSingle;
-      var nbInter: integer); override;
-    destructor Destroy; override;
-  end;
-
-procedure BorderEllipseAntialias(bmp: TBGRADefaultBitmap; x, y, rx, ry, w: single;
-  c: TBGRAPixel; EraseMode: boolean);
+procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
+  scan: IBGRAScanner);
+
+procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
+  options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
+  options: TRoundRectangleOptions; scan: IBGRAScanner);
+
+procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
+  options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
+  options: TRoundRectangleOptions; scan: IBGRAScanner);
+
+procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
+  options: TRoundRectangleOptions; bordercolor,fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean);
 
 implementation
 
-uses Math, bgrablend;
-
-procedure FillShapeAntialias(bmp: TBGRADefaultBitmap; shapeInfo: TFillShapeInfo;
-  c: TBGRAPixel; EraseMode: boolean);
-const
-  precision = 11;
-var
-  bounds: TRect;
-  miny, maxy, minx, maxx: integer;
-
-  inter:   array of single;
+uses Math, BGRABlend, BGRAGradientScanner, BGRATransform;
+
+procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean);
+var
+  inter:   array of TIntersectionInfo;
   nbInter: integer;
-  density: packed array of single;
+
+  firstScan, lastScan: record
+    inter:   array of TIntersectionInfo;
+    nbInter: integer;
+  end;
+
+  miny, maxy, minx, maxx,
+  densMinX, densMaxX: integer;
+
+  density: PDensity;
 
   xb, yb, yc, i, j: integer;
 
-  temp, cury, x1, x2: single;
+  x1, x2, x1b,x2b: single;
   ix1, ix2: integer;
   pdest:    PBGRAPixel;
-  pdens:    PSingle;
-
-begin
-  bounds := shapeInfo.GetBounds;
-  if (bounds.Right <= bounds.left) or (bounds.bottom <= bounds.top) then
-    exit;
-
-  miny := bounds.top;
-  maxy := bounds.bottom - 1;
-  minx := bounds.left;
-  maxx := bounds.right - 1;
-
-  if minx < 0 then
-    minx := 0;
-  if maxx < 0 then
-    exit;
-  if maxx > bmp.Width - 1 then
-    maxx := bmp.Width - 1;
-  if minx > bmp.Width - 1 then
-    exit;
-  if miny < 0 then
-    miny := 0;
-  if miny > bmp.Height - 1 then
-    exit;
-  if maxy > bmp.Height - 1 then
-    maxy := bmp.Height - 1;
-  if maxy < 0 then
-    exit;
-
-  setlength(inter, shapeInfo.NbMaxIntersection);
-  setlength(density, maxx - minx + 2); //one more for safety
+  pdens:    PDensity;
+
+  curvedSeg,optimised: boolean;
+  ec: TExpandedPixel;
+  c2:TBGRAPixel;
+  MemScanCopy,pscan: pbgrapixel;
+  ScanNextPixelProc: TScanNextPixelFunction;
+  temp: Single;
+
+  function GetYScan(num: integer): single; inline;
+  begin
+    result := yb + (num * 2 + 1) / (AntialiasPrecision * 2);
+  end;
+
+  procedure SubTriangleDensity(x1,density1, x2, density2: single);
+  var ix1,ix2,n: integer;
+      slope: single;
+    function densityAt(x: single): single; inline;
+    begin
+      result := (x-x1)*slope+density1;
+    end;
+  var
+      curdens: single;
+      pdens: pdensity;
+  begin
+    if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then
+    begin
+      slope := (density2-density1)/(x2-x1);
+      if x1 < minx then
+      begin
+        density1 := densityAt(minx);
+        x1 := minx;
+      end;
+      if x2 >= maxx + 1 then
+      begin
+        density2 := densityAt(maxx+1);
+        x2 := maxx + 1;
+      end;
+      ix1  := floor(x1);
+      ix2  := floor(x2);
+
+      if ix1 = ix2 then
+        (density + (ix1 - minx))^ -= round((x2 - x1)*(density1+density2)/2)
+      else
+      begin
+        (density + (ix1 - minx))^ := max(0, (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) );
+        if (ix2 <= maxx) then
+          (density + (ix2 - minx))^ := max(0, (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2) );
+      end;
+      if ix2 > ix1 + 1 then
+      begin
+        curdens := densityAt(ix1+1.5);
+        pdens := density + (ix1+1 - minx);
+        for n := ix2-1-(ix1+1) downto 0 do
+        begin
+          pdens^ -= round(curdens);
+          curdens += slope;
+          inc(pdens);
+        end;
+      end;
+    end;
+  end;
+
+begin
+  if (scan=nil) and (c.alpha=0) then exit;
+  If not shapeInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+
+  inter := shapeInfo.CreateIntersectionArray;
+  getmem(density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety
+  ec := GammaExpansion(c);
+  c2 := c;
+
+  MemScanCopy := nil;
+  ScanNextPixelProc := nil;
+  if scan <> nil then
+  begin
+    if scan.IsScanPutPixelsDefined then
+      GetMem(MemScanCopy,(maxx-minx+1)*sizeof(TBGRAPixel));
+    ScanNextPixelProc := @scan.ScanNextPixel;
+  end;
+
+  curvedSeg := shapeInfo.SegmentsCurved;
+  if not curvedSeg then
+  begin
+    firstScan.inter := shapeInfo.CreateIntersectionArray;
+    lastScan.inter := shapeInfo.CreateIntersectionArray;
+  end;
 
   //vertical scan
@@ -135 +238 @@
   begin
     //mean density
-    for i := 0 to high(density) do
-      density[i] := 0;
-
-    //precision scan
-    for yc := 0 to precision - 1 do
-    begin
-      cury := yb + (yc * 2 + 1) / (precision * 2);
-
-      //find intersections
-      nbinter := 0;
-      shapeInfo.ComputeIntersection(cury, inter, nbInter);
-      if nbinter = 0 then
-        continue;
-
-      //sort intersections
-      for i := 1 to nbinter - 1 do
-      begin
-        j := i;
-        while (j > 0) and (inter[j - 1] > inter[j]) do
+    fillchar(density^,(maxx-minx+1)*sizeof(TDensity),0);
+
+    densMinX := maxx+1;
+    densMaxX := minx-1;
+
+    if not curvedSeg then
+    begin
+      with firstScan do
+        shapeInfo.ComputeAndSort(yb+1/256,inter,nbInter,NonZeroWinding);
+      with lastScan do
+        shapeInfo.ComputeAndSort(yb+255/256,inter,nbInter,NonZeroWinding);
+      if (firstScan.nbInter = lastScan.nbInter) and (firstScan.nbInter >= 2) then
+      begin
+        optimised := true;
+        for i := 0 to firstScan.nbInter-1 do
+          if firstScan.inter[i].numSegment <> lastScan.inter[i].numSegment then
+          begin
+            optimised := false;
+            break;
+          end;
+      end else
+        optimised := false;
+
+      if optimised then
+      begin
+        for i := 0 to firstScan.nbinter div 2 - 1 do
         begin
-          temp     := inter[j - 1];
-          inter[j - 1] := inter[j];
-          inter[j] := temp;
-          Dec(j);
+          x1 := firstScan.inter[i+i].interX;
+          x1b := lastScan.inter[i+i].interX;
+          if (x1 > x1b) then
+          begin
+            temp := x1;
+            x1 := x1b;
+            x1b := temp;
+          end;
+          x2 := firstScan.inter[i+i+1].interX;
+          x2b := lastScan.inter[i+i+1].interX;
+          if (x2 < x2b) then
+          begin
+            temp := x2;
+            x2 := x2b;
+            x2b := temp;
+          end;
+          {$i filldensitysegment256.inc}
+          SubTriangleDensity(x1,256,x1b,0);
+          SubTriangleDensity(x2b,0,x2,256);
         end;
-      end;
-
-      //fill density
-      for i := 0 to nbinter div 2 - 1 do
-      begin
-        x1 := inter[i + i];
-        x2 := inter[i + i + 1];
-        if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then
+      end else
+      begin
+        for yc := 0 to AntialiasPrecision - 1 do
         begin
-          if x1 < minx then
-            x1 := minx;
-          if x2 >= maxx + 1 then
-            x2 := maxx + 1;
-          ix1  := floor(x1);
-          ix2  := floor(x2);
-          if ix1 = ix2 then
-            density[ix1 - minx] += x2 - x1
+          //find intersections
+          shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
+
+          {$i filldensity256.inc}
+        end;
+      end;
+    end else
+    begin
+      optimised := false;
+      //precision scan
+      for yc := 0 to AntialiasPrecision - 1 do
+      begin
+        //find intersections
+        shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
+
+        {$i filldensity256.inc}
+      end;
+    end;
+
+    if optimised then
+      {$i renderdensity256.inc}
+    else
+      {$define PARAM_ANTIALIASINGFACTOR}
+      {$i renderdensity256.inc}
+  end;
+
+  freemem(MemScanCopy);
+  shapeInfo.FreeIntersectionArray(inter);
+
+  if not curvedSeg then
+  begin
+    with firstScan do
+    begin
+      for i := 0 to high(inter) do
+        inter[i].free;
+    end;
+    with lastScan do
+    begin
+      for i := 0 to high(inter) do
+        inter[i].free;
+    end;
+  end;
+  freemem(density);
+
+  bmp.InvalidateBitmap;
+end;
+
+procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
+var
+  inter:    array of TIntersectionInfo;
+  nbInter:  integer;
+
+  miny, maxy, minx, maxx: integer;
+  xb,yb, i: integer;
+  x1, x2: single;
+  ix1, ix2: integer;
+  pdest: PBGRAPixel;
+  AliasingOfs: TPointF;
+  ec: TExpandedPixel;
+
+begin
+  if (scan=nil) and (c.alpha=0) then exit;
+  If not shapeInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  inter := shapeInfo.CreateIntersectionArray;
+
+  if AliasingIncludeBottomRight then
+    AliasingOfs := PointF(0,0) else
+    AliasingOfs := PointF(-0.0001,-0.0001);
+
+  ec := GammaExpansion(c);
+  if (scan = nil) and (c.alpha = 255) then drawmode := dmSet;
+
+  //vertical scan
+  for yb := miny to maxy do
+  begin
+    //find intersections
+    shapeInfo.ComputeAndSort( yb+0.5-AliasingOfs.Y, inter, nbInter, NonZeroWinding);
+
+    for i := 0 to nbinter div 2 - 1 do
+    begin
+      x1 := inter[i + i].interX-AliasingOfs.X;
+      x2 := inter[i + i+ 1].interX-AliasingOfs.X;
+
+      if x1 <> x2 then
+      begin
+        ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
+        if ix1 <= ix2 then
+        begin
+          //render scanline
+          if scan <> nil then //with texture scan
+          begin
+            pdest := bmp.ScanLine[yb] + ix1;
+            scan.ScanMoveTo(ix1,yb);
+            ScannerPutPixels(scan,pdest,ix2-ix1+1,drawmode);
+          end else
+          if EraseMode then //erase with alpha
+          begin
+            pdest := bmp.ScanLine[yb] + ix1;
+            for xb := ix1 to ix2 do
+            begin
+              ErasePixelInline(pdest, c.alpha);
+              Inc(pdest);
+            end;
+          end
           else
           begin
-            density[ix1 - minx] += 1 - (x1 - ix1);
-            if (ix2 <= maxx) then
-              density[ix2 - minx] += x2 - ix2;
-          end;
-          if ix2 > ix1 + 1 then
-          begin
-            for j := ix1 + 1 to ix2 - 1 do
-              density[j - minx] += 1;
+            case drawmode of
+              dmFastBlend: bmp.FastBlendHorizLine(ix1,yb,ix2, c);
+              dmDrawWithTransparency: bmp.DrawHorizLine(ix1,yb,ix2, ec);
+              dmSet: bmp.SetHorizLine(ix1,yb,ix2, c);
+              dmXor: bmp.XorHorizLine(ix1,yb,ix2, c);
+            end;
           end;
         end;
       end;
-
     end;
-
-    pdest := bmp.ScanLine[yb] + minx;
-    pdens := @density[0];
-    //render scanline
-    if EraseMode then
-    begin
-      for xb := minx to maxx do
-      begin
-        temp := pdens^;
-        Inc(pdens);
-        if temp <> 0 then
-          ErasePixelInline(pdest, round(c.alpha * temp / precision));
-        Inc(pdest);
-      end;
-    end
-    else
-    begin
-      for xb := minx to maxx do
-      begin
-        temp := pdens^;
-        Inc(pdens);
-        if temp <> 0 then
-          DrawPixelInline(pdest, BGRA(c.red, c.green, c.blue, round(
-            c.alpha * temp / precision)));
-        Inc(pdest);
-      end;
-    end;
-  end;
-
+  end;
+
+  shapeInfo.FreeIntersectionArray(inter);
   bmp.InvalidateBitmap;
 end;
 
-procedure FillPolyAntialias(bmp: TBGRADefaultBitmap; points: array of TPointF;
-  c: TBGRAPixel; EraseMode: boolean);
+procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap;
+  shapeInfo: TFillShapeInfo; scan: IBGRAScanner; NonZeroWinding: boolean);
+begin
+  FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding);
+end;
+
+procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF;
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode);
 var
   info: TFillPolyInfo;
@@ -233 +427 @@
 
   info := TFillPolyInfo.Create(points);
-  FillShapeAntialias(bmp, info, c, EraseMode);
-  info.Free;
-end;
-
-procedure FillEllipseAntialias(bmp: TBGRADefaultBitmap; x, y, rx, ry: single;
+  FillShapeAliased(bmp, info, c, EraseMode, nil, NonZeroWinding, drawmode);
+  info.Free;
+end;
+
+procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap;
+  points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode);
+var
+  info: TFillPolyInfo;
+begin
+  if length(points) < 3 then
+    exit;
+
+  info := TFillPolyInfo.Create(points);
+  FillShapeAliased(bmp, info, BGRAPixelTransparent,False,scan, NonZeroWinding, drawmode);
+  info.Free;
+end;
+
+procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean);
+var
+  info: TFillPolyInfo;
+begin
+  if length(points) < 3 then
+    exit;
+
+  info := TFillPolyInfo.Create(points);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, NonZeroWinding);
+  info.Free;
+end;
+
+procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap;
+  points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean
+  );
+var
+  info: TFillPolyInfo;
+begin
+  if length(points) < 3 then
+    exit;
+
+  info := TFillPolyInfo.Create(points);
+  FillShapeAntialiasWithTexture(bmp, info, scan, NonZeroWinding);
+  info.Free;
+end;
+
+procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
   c: TBGRAPixel; EraseMode: boolean);
 var
   info: TFillEllipseInfo;
 begin
-  if (rx = 0) or (ry = 0) then
+  if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then
     exit;
 
   info := TFillEllipseInfo.Create(x, y, rx, ry);
-  FillShapeAntialias(bmp, info, c, EraseMode);
-  info.Free;
-end;
-
-procedure BorderEllipseAntialias(bmp: TBGRADefaultBitmap; x, y, rx, ry, w: single;
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False);
+  info.Free;
+end;
+
+procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
+  ry: single; scan: IBGRAScanner);
+var
+  info: TFillEllipseInfo;
+begin
+  if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then
+    exit;
+
+  info := TFillEllipseInfo.Create(x, y, rx, ry);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  info.Free;
+end;
+
+procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
   c: TBGRAPixel; EraseMode: boolean);
 var
   info: TFillBorderEllipseInfo;
 begin
-  if (rx = 0) or (ry = 0) then
+  if (rx = 0) or (ry = 0) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
     exit;
   info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
-  FillShapeAntialias(bmp, info, c, EraseMode);
-  info.Free;
-end;
-
-{ TFillShapeInfo }
-
-function TFillShapeInfo.GetBounds: TRect;
-begin
-  Result := rect(0, 0, 0, 0);
-end;
-
-function TFillShapeInfo.NbMaxIntersection: integer;
-begin
-  Result := 0;
-end;
-
-{$hints off}
-procedure TFillShapeInfo.ComputeIntersection(cury: single;
-  var inter: ArrayOfSingle; var nbInter: integer);
-begin
-
-end;
-
-{$hints on}
-
-{ TFillPolyInfo }
-
-constructor TFillPolyInfo.Create(points: array of TPointF);
-var
-  i, j: integer;
-  First, cur, nbP: integer;
-begin
-  setlength(FPoints, length(points));
-  nbP := 0;
-  for i := 0 to high(points) do
-  if (i=0) or (points[i].x<>points[i-1].X) or (points[i].y<>points[i-1].y) then
-  begin
-    FPoints[nbP] := points[i];
-    inc(nbP);
-  end;
-  if (nbP>0) and (FPoints[nbP-1].X = FPoints[0].X) and (FPoints[nbP-1].Y = FPoints[0].Y) then dec(NbP);
-  setlength(FPoints, nbP);
-
-  //look for empty points, correct coordinate and successors
-  setlength(FEmptyPt, length(FPoints));
-  setlength(FNext, length(FPoints));
-
-  cur   := -1;
-  First := -1;
-  for i := 0 to high(FPoints) do
-    if not isEmptyPointF(FPoints[i]) then
-    begin
-      FEmptyPt[i]  := False;
-      FPoints[i].x += 0.5;
-      FPoints[i].y += 0.5;
-      if cur <> -1 then
-        FNext[cur] := i;
-      if First = -1 then
-        First := i;
-      cur     := i;
-    end
-    else
-    begin
-      if (First <> -1) and (cur <> First) then
-        FNext[cur] := First;
-
-      FEmptyPt[i] := True;
-      FNext[i] := -1;
-      cur   := -1;
-      First := -1;
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False);
+  info.Free;
+end;
+
+procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
+  ry, w: single; scan: IBGRAScanner);
+var
+  info: TFillBorderEllipseInfo;
+begin
+  if (rx = 0) or (ry = 0) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
+    exit;
+  info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  info.Free;
+end;
+
+{ TBGRAMultishapeFiller }
+
+procedure TBGRAMultishapeFiller.AddShape(AInfo: TFillShapeInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
+begin
+  if length(shapes) = nbShapes then
+    setlength(shapes, (length(shapes)+1)*2);
+  with shapes[nbShapes] do
+  begin
+    info := AInfo;
+    internalInfo:= AInternalInfo;
+    texture := ATexture;
+    internalTexture:= AInternalTexture;
+    color := GammaExpansion(AColor);
+  end;
+  inc(nbShapes);
+end;
+
+function TBGRAMultishapeFiller.CheckRectangleBorderBounds(var x1, y1, x2,
+  y2: single; w: single): boolean;
+var temp: single;
+begin
+  if x1 > x2 then
+  begin
+    temp := x1;
+    x1 := x2;
+    x2 := temp;
+  end;
+  if y1 > y2 then
+  begin
+    temp := y1;
+    y1 := y2;
+    y2 := temp;
+  end;
+  result := (x2-x1 > w) and (y2-y1 > w);
+end;
+
+constructor TBGRAMultishapeFiller.Create;
+begin
+  nbShapes := 0;
+  shapes := nil;
+  PolygonOrder := poNone;
+  Antialiasing := True;
+  AliasingIncludeBottomRight := False;
+end;
+
+destructor TBGRAMultishapeFiller.Destroy;
+var
+  i: Integer;
+begin
+  for i := 0 to nbShapes-1 do
+  begin
+    if shapes[i].internalInfo then shapes[i].info.free;
+    shapes[i].texture := nil;
+    if shapes[i].internalTexture <> nil then shapes[i].internalTexture.Free;
+  end;
+  shapes := nil;
+  inherited Destroy;
+end;
+
+procedure TBGRAMultishapeFiller.AddShape(AShape: TFillShapeInfo; AColor: TBGRAPixel);
+begin
+  AddShape(AShape,False,nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddShape(AShape: TFillShapeInfo;
+  ATexture: IBGRAScanner);
+begin
+  AddShape(AShape,False,ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF;
+  AColor: TBGRAPixel);
+begin
+  if length(points) <= 2 then exit;
+  AddShape(TFillPolyInfo.Create(points),True,nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF;
+  ATexture: IBGRAScanner);
+begin
+  if length(points) <= 2 then exit;
+  AddShape(TFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2,
+  c3: TBGRAPixel);
+var
+  grad: TBGRAGradientTriangleScanner;
+begin
+  grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
+  AddShape(TFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddTriangleLinearMapping(pt1, pt2,
+  pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
+var
+  mapping: TBGRATriangleLinearMapping;
+begin
+  mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
+  AddShape(TFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
+  c1, c2, c3, c4: TBGRAPixel);
+var
+  center: TPointF;
+  centerColor: TBGRAPixel;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
+                    MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
+  AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
+  AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
+  AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
+  AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddQuadLinearMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var
+  center: TPointF;
+  centerTex: TPointF;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
+  AddTriangleLinearMapping(pt1,pt2,center, texture,tex1,tex2,centerTex);
+  AddTriangleLinearMapping(pt2,pt3,center, texture,tex2,tex3,centerTex);
+  AddTriangleLinearMapping(pt3,pt4,center, texture,tex3,tex4,centerTex);
+  AddTriangleLinearMapping(pt4,pt1,center, texture,tex4,tex1,centerTex);
+end;
+
+procedure TBGRAMultishapeFiller.AddQuadPerspectiveMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var persp: TBGRAPerspectiveScannerTransform;
+begin
+  persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
+  AddShape(TFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel
+  );
+begin
+  AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single;
+  ATexture: IBGRAScanner);
+begin
+  AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single;
+  AColor: TBGRAPixel);
+begin
+  AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single;
+  ATexture: IBGRAScanner);
+begin
+  AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, ry: single;
+  AColor: TBGRAPixel; options: TRoundRectangleOptions);
+begin
+  AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx, ry: single;
+  ATexture: IBGRAScanner; options: TRoundRectangleOptions);
+begin
+  AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,
+     ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx,
+  ry, w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions);
+begin
+  AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True,
+    nil,nil,AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry,
+  w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions);
+begin
+  AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True,
+    ATexture,nil,BGRAPixelTransparent);
+end;
+
+procedure TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single;
+  AColor: TBGRAPixel);
+begin
+  AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single;
+  ATexture: IBGRAScanner);
+begin
+  AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],ATexture);
+end;
+
+procedure TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2,
+  w: single; AColor: TBGRAPixel);
+var hw : single;
+begin
+  hw := w/2;
+  if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then
+    AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,AColor) else
+    AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF,
+                PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],AColor);
+end;
+
+procedure TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2,
+  w: single; ATexture: IBGRAScanner);
+var hw : single;
+begin
+  hw := w/2;
+  if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then
+    AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,ATexture) else
+    AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF,
+                PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],ATexture);
+end;
+
+procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap);
+var
+  shapeRow: array of record
+    density: PDensity;
+    densMinx,densMaxx: integer;
+    nbInter: integer;
+    inter: array of TIntersectionInfo;
+  end;
+  shapeRowsList: array of integer;
+  NbShapeRows: integer;
+  miny, maxy, minx, maxx,
+  rowminx, rowmaxx: integer;
+
+  procedure SubstractScanlines(src,dest: integer);
+  var i: integer;
+
+    procedure SubstractSegment(srcseg: integer);
+    var x1,x2, x3,x4: single;
+      j: integer;
+
+      procedure AddSegment(xa,xb: single);
+      var nb: PInteger;
+          prevNb,k: integer;
+      begin
+        nb := @shapeRow[dest].nbinter;
+        if length(shapeRow[dest].inter) < nb^+2 then
+        begin
+          prevNb := length(shapeRow[dest].inter);
+          setlength(shapeRow[dest].inter, nb^*2+2);
+          for k := prevNb to high(shapeRow[dest].inter) do
+            shapeRow[dest].inter[k] := shapes[dest].info.CreateIntersectionInfo;
+        end;
+        shapeRow[dest].inter[nb^].interX := xa;
+        shapeRow[dest].inter[nb^+1].interX := xb;
+        inc(nb^,2);
+      end;
+
+    begin
+      x1 := shapeRow[src].inter[(srcseg-1)*2].interX;
+      x2 := shapeRow[src].inter[srcseg*2-1].interX;
+      for j := shapeRow[dest].nbInter div 2 downto 1 do
+      begin
+        x3 := shapeRow[dest].inter[(j-1)*2].interX;
+        x4 := shapeRow[dest].inter[j*2-1].interX;
+        if (x2 <= x3) or (x1 >= x4) then continue; //not overlapping
+        if (x1 <= x3) and (x2 >= x4) then
+          shapeRow[dest].inter[j*2-1].interX := x3 //empty
+        else
+        if (x1 <= x3) and (x2 < x4) then
+          shapeRow[dest].inter[(j-1)*2].interX := x2 //remove left part
+        else
+        if (x1 > x3) and (x2 >= x4) then
+          shapeRow[dest].inter[j*2-1].interX := x1 else //remove right part
+        begin
+          //[x1,x2] is inside [x3,x4]
+          shapeRow[dest].inter[j*2-1].interX := x1; //left part
+          AddSegment(x2,x4);
+        end;
+      end;
     end;
-  if (First <> -1) and (cur <> First) then
-    FNext[cur] := First;
-
-  setlength(FPrev, length(FPoints));
-  for i := 0 to high(FPrev) do
-    FPrev[i] := -1;
-  for i := 0 to high(FNext) do
-    if FNext[i] <> -1 then
-      FPrev[FNext[i]] := i;
-
-  setlength(FSlopes, length(FPoints));
-  setlength(FChangedir, length(FPoints));
-
-  //compute slopes
-  for i := 0 to high(FPoints) do
-    if not FEmptyPt[i] then
-    begin
-      j := FNext[i];
-
-      if FPoints[i].y <> FPoints[j].y then
-        FSlopes[i] := (FPoints[j].x - FPoints[i].x) / (FPoints[j].y - FPoints[i].y)
+
+  begin
+    for i := 1 to shapeRow[src].nbInter div 2 do
+      SubstractSegment(i);
+  end;
+
+var
+    AliasingOfs: TPointF;
+
+  procedure AddOneLineDensity(cury: single);
+  var
+    i,k: integer;
+    ix1,ix2: integer;
+    x1,x2: single;
+  begin
+    for k := 0 to NbShapeRows-1 do
+      with shapeRow[shapeRowsList[k]], shapes[shapeRowsList[k]] do
+      begin
+        //find intersections
+        info.ComputeAndSort(cury, inter, nbInter, FillMode=fmWinding);
+        nbInter := nbInter and not 1; //even
+      end;
+
+      case PolygonOrder of
+        poLastOnTop: begin
+          for k := 1 to NbShapeRows-1 do
+            if shapeRow[shapeRowsList[k]].nbInter > 0 then
+              for i := 0 to k-1 do
+                SubstractScanlines(shapeRowsList[k],shapeRowsList[i]);
+        end;
+        poFirstOnTop: begin
+          for k := 0 to NbShapeRows-2 do
+            if shapeRow[shapeRowsList[k]].nbInter > 0 then
+              for i := k+1 to NbShapeRows-1 do
+                SubstractScanlines(shapeRowsList[k],shapeRowsList[i]);
+        end;
+      end;
+
+      for k := 0 to NbShapeRows-1 do
+      with shapeRow[shapeRowsList[k]] do
+      begin
+        //fill density
+        if not Antialiasing then
+        begin
+          for i := 0 to nbinter div 2 - 1 do
+          begin
+            x1 := inter[i + i].interX;
+            x2 := inter[i + i + 1].interX;
+            ComputeAliasedRowBounds(x1+AliasingOfs.X,x2+AliasingOfs.X,minx,maxx,ix1,ix2);
+
+            if ix1 < densMinx then densMinx := ix1;
+            if ix2 > densMaxx then densMaxx := ix2;
+
+            FillWord(density[ix1-minx],ix2-ix1+1,256);
+          end;
+        end else
+          {$I filldensity256.inc}
+      end;
+
+      for k := 0 to NbShapeRows-1 do
+      with shapeRow[shapeRowsList[k]] do
+      begin
+        if densMinX < rowminx then rowminx := densMinX;
+        if densMaxX > rowmaxx then rowmaxx := densMaxX;
+      end;
+  end;
+
+type
+    TCardinalSum = record
+          sumR,sumG,sumB,sumA: cardinal;
+        end;
+
+var
+  MultiEmpty: boolean;
+  bounds: TRect;
+
+  xb, yb, yc, j,k: integer;
+  pdest:    PBGRAPixel;
+
+  curSum,nextSum: ^TCardinalSum;
+  sums: array of TCardinalSum;
+
+  pdens: PDensity;
+  w: cardinal;
+  ec: TExpandedPixel;
+  count: integer;
+  ScanNextFunc: function: TBGRAPixel of object;
+
+begin
+  if nbShapes = 0 then exit;
+  if nbShapes = 1 then
+  begin
+    if Antialiasing then
+      FillShapeAntialias(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,FillMode = fmWinding) else
+      FillShapeAliased(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,FillMode = fmWinding, dmDrawWithTransparency,
+        AliasingIncludeBottomRight);
+    exit;
+  end;
+  bounds := Rect(0,0,0,0);
+  MultiEmpty := True;
+  for k := 0 to nbShapes-1 do
+  begin
+    If shapes[k].info.ComputeMinMax(minx,miny,maxx,maxy,dest) then
+    begin
+      shapes[k].bounds := rect(minx,miny,maxx+1,maxy+1);
+      if MultiEmpty then
+      begin
+        MultiEmpty := False;
+        bounds := shapes[k].bounds;
+      end else
+      begin
+        if minx < bounds.left then bounds.left := minx;
+        if miny < bounds.top then bounds.top := miny;
+        if maxx >= bounds.right then bounds.right := maxx+1;
+        if maxy >= bounds.bottom then bounds.bottom := maxy+1;
+      end;
+    end else
+      shapes[k].bounds := rect(0,0,0,0);
+  end;
+  if MultiEmpty then exit;
+  minx := bounds.left;
+  miny := bounds.top;
+  maxx := bounds.right-1;
+  maxy := bounds.bottom-1;
+
+  setlength(shapeRow, nbShapes);
+  for k := 0 to nbShapes-1 do
+  begin
+    shapeRow[k].inter := shapes[k].info.CreateIntersectionArray;
+    getmem(shapeRow[k].density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety
+  end;
+
+  if AliasingIncludeBottomRight then
+    AliasingOfs := PointF(0,0) else
+    AliasingOfs := PointF(-0.0001,-0.0001);
+
+  setlength(sums,maxx-minx+2); //more for safety
+  setlength(shapeRowsList, nbShapes);
+
+  //vertical scan
+  for yb := miny to maxy do
+  begin
+    rowminx := maxx+1;
+    rowmaxx := minx-1;
+
+    //init shape rows
+    NbShapeRows := 0;
+    for k := 0 to nbShapes-1 do
+    if (yb >= shapes[k].bounds.top) and (yb < shapes[k].bounds.Bottom) then
+    begin
+      shapeRowsList[NbShapeRows] := k;
+      inc(NbShapeRows);
+
+      fillchar(shapeRow[k].density^,(maxx-minx+1)*sizeof(TDensity),0);
+      shapeRow[k].densMinx := maxx+1;
+      shapeRow[k].densMaxx := minx-1;
+    end;
+
+    If Antialiasing then
+    begin
+      //precision scan
+      for yc := 0 to AntialiasPrecision - 1 do
+        AddOneLineDensity( yb + (yc * 2 + 1) / (AntialiasPrecision * 2) );
+    end else
+    begin
+      AddOneLineDensity( yb + 0.5 - AliasingOfs.Y );
+    end;
+
+    rowminx := minx;
+    rowmaxx := maxx;
+    if rowminx <= rowmaxx then
+    begin
+      if rowminx < minx then rowminx := minx;
+      if rowmaxx > maxx then rowmaxx := maxx;
+
+      FillChar(sums[rowminx-minx],(rowmaxx-rowminx+1)*sizeof(sums[0]),0);
+
+      if Antialiasing then
+        {$define PARAM_ANTIALIASINGFACTOR}
+        {$i multishapeline.inc}
       else
-        FSlopes[i] := EmptySingle;
-
-      FChangedir[i] := ((FPoints[i].y - FPoints[j].y > 0) and
-        (FPoints[FPrev[i]].y - FPoints[i].y < 0)) or
-        ((FPoints[i].y - FPoints[j].y < 0) and (FPoints[FPrev[i]].y - FPoints[i].y > 0));
-    end
-    else
-    begin
-      FSlopes[i]    := EmptySingle;
-      FChangedir[i] := False;
+        {$i multishapeline.inc};
+
+      pdest := dest.ScanLine[yb] + rowminx;
+      xb := rowminx;
+      nextSum := @sums[xb-minx];
+      while xb <= rowmaxx do
+      begin
+        curSum := nextSum;
+        inc(nextSum);
+        with curSum^ do
+        begin
+          if sumA <> 0 then
+          begin
+            ec.red := (sumR+sumA shr 1) div sumA;
+            ec.green := (sumG+sumA shr 1) div sumA;
+            ec.blue := (sumB+sumA shr 1) div sumA;
+            if sumA > 255 then sumA := 255;
+            ec.alpha := sumA shl 8 + sumA;
+            count := 1;
+            while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
+              and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
+            begin
+              inc(xb);
+              inc(nextSum);
+              inc(count);
+            end;
+            if count = 1 then
+              DrawExpandedPixelInlineWithAlphaCheck(pdest,ec) else
+               DrawExpandedPixelsInline(pdest, ec, count );
+            inc(pdest,count-1);
+          end;
+        end;
+        inc(xb);
+        inc(pdest);
+      end;
     end;
 
-end;
-
-function TFillPolyInfo.GetBounds: TRect;
-var
-  minx, miny, maxx, maxy, i: integer;
-begin
-  miny := floor(FPoints[0].y);
-  maxy := ceil(FPoints[0].y);
-  minx := floor(FPoints[0].x);
-  maxx := ceil(FPoints[0].x);
-  for i := 1 to high(FPoints) do
-    if not FEmptyPt[i] then
-    begin
-      if floor(FPoints[i].y) < miny then
-        miny := floor(FPoints[i].y)
-      else
-      if ceil(FPoints[i].y) > maxy then
-        maxy := ceil(FPoints[i].y);
-
-      if floor(FPoints[i].x) < minx then
-        minx := floor(FPoints[i].x)
-      else
-      if ceil(FPoints[i].x) > maxx then
-        maxx := ceil(FPoints[i].x);
+  end;
+
+  for k := 0 to nbShapes-1 do
+  begin
+    freemem(shapeRow[k].density);
+    shapes[k].info.FreeIntersectionArray(shapeRow[k].inter);
+  end;
+
+  dest.InvalidateBitmap;
+end;
+
+procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2,
+  rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+var
+  info: TFillRoundRectangleInfo;
+begin
+  if (x1 = x2) or (y1 = y2) then exit;
+  info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options);
+  FillShapeAntialias(bmp, info, c, EraseMode,nil, False);
+  info.Free;
+end;
+
+procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
+  y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions;
+  scan: IBGRAScanner);
+var
+  info: TFillRoundRectangleInfo;
+begin
+  if (x1 = x2) or (y1 = y2) then exit;
+  info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  info.Free;
+end;
+
+procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2,
+  y2, rx, ry, w: single; options: TRoundRectangleOptions; c: TBGRAPixel;
+  EraseMode: boolean);
+var
+  info: TFillBorderRoundRectInfo;
+begin
+  if (rx = 0) or (ry = 0) or (w=0) then exit;
+  info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False);
+  info.Free;
+end;
+
+procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
+  y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions;
+  scan: IBGRAScanner);
+var
+  info: TFillBorderRoundRectInfo;
+begin
+  if (rx = 0) or (ry = 0) or (w=0) then exit;
+  info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  info.Free;
+end;
+
+procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1,
+  x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; bordercolor,
+  fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean);
+var
+  info: TFillBorderRoundRectInfo;
+  multi: TBGRAMultishapeFiller;
+begin
+  if (rx = 0) or (ry = 0) then exit;
+  info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options);
+  if not EraseMode then
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    if filltexture <> nil then
+      multi.AddShape(info.innerBorder, filltexture) else
+      multi.AddShape(info.innerBorder, fillcolor);
+    if w<>0 then
+    begin
+      if bordertexture <> nil then
+        multi.AddShape(info, bordertexture) else
+        multi.AddShape(info, bordercolor);
     end;
-  Result := rect(minx, miny, maxx + 1, maxy + 1);
-end;
-
-function TFillPolyInfo.NbMaxIntersection: integer;
-begin
-  Result := length(FPoints);
-end;
-
-procedure TFillPolyInfo.ComputeIntersection(cury: single;
-  var inter: ArrayOfSingle; var nbInter: integer);
-var
-  i, j: integer;
-begin
-  for i := 0 to high(FPoints) do
-    if not FEmptyPt[i] then
-    begin
-      if cury = FPoints[i].y then
-      begin
-        if not FChangedir[i] then
-        begin
-          inter[nbinter] := FPoints[i].x;
-          Inc(nbinter);
-        end;
-      end
-      else
-      if (FSlopes[i] <> EmptySingle) then
-      begin
-        j := FNext[i];
-        if (((cury >= FPoints[i].y) and (cury < FPoints[j].y)) or
-          ((cury > FPoints[j].y) and (cury <= FPoints[i].y))) then
-        begin
-          inter[nbinter] := (cury - FPoints[i].y) * FSlopes[i] + FPoints[i].x;
-          Inc(nbinter);
-        end;
-      end;
-    end;
-end;
-
-{ TFillEllipseInfo }
-
-constructor TFillEllipseInfo.Create(x, y, rx, ry: single);
-begin
-  FX  := x + 0.5;
-  FY  := y + 0.5;
-  FRX := abs(rx);
-  FRY := abs(ry);
-end;
-
-function TFillEllipseInfo.GetBounds: TRect;
-begin
-  Result := rect(floor(fx - frx), floor(fy - fry), ceil(fx + frx), ceil(fy + fry));
-end;
-
-function TFillEllipseInfo.NbMaxIntersection: integer;
-begin
-  Result := 2;
-end;
-
-procedure TFillEllipseInfo.ComputeIntersection(cury: single;
-  var inter: ArrayOfSingle; var nbInter: integer);
-var
-  d: single;
-begin
-  d := sqr((cury - FY) / FRY);
-  if d < 1 then
-  begin
-    d := sqrt(1 - d) * FRX;
-    inter[nbinter] := FX - d;
-    Inc(nbinter);
-    inter[nbinter] := FX + d;
-    Inc(nbinter);
-  end;
-end;
-
-{ TFillBorderEllipseInfo }
-
-constructor TFillBorderEllipseInfo.Create(x, y, rx, ry, w: single);
-begin
-  if rx < 0 then
-    rx := -rx;
-  if ry < 0 then
-    ry := -ry;
-  outerBorder := TFillEllipseInfo.Create(x, y, rx + w / 2, ry + w / 2);
-  if (rx > w / 2) and (ry > w / 2) then
-    innerBorder := TFillEllipseInfo.Create(x, y, rx - w / 2, ry - w / 2)
-  else
-    innerBorder := nil;
-end;
-
-function TFillBorderEllipseInfo.GetBounds: TRect;
-begin
-  Result := outerBorder.GetBounds;
-end;
-
-function TFillBorderEllipseInfo.NbMaxIntersection: integer;
-begin
-  Result := 4;
-end;
-
-procedure TFillBorderEllipseInfo.ComputeIntersection(cury: single;
-  var inter: ArrayOfSingle; var nbInter: integer);
-begin
-  outerBorder.ComputeIntersection(cury, inter, nbInter);
-  if innerBorder <> nil then
-    innerBorder.ComputeIntersection(cury, inter, nbInter);
-end;
-
-destructor TFillBorderEllipseInfo.Destroy;
-begin
-  outerBorder.Free;
-  if innerBorder <> nil then
-    innerBorder.Free;
-  inherited Destroy;
-end;
+    multi.Draw(bmp);
+    multi.Free;
+  end else
+  begin
+    FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False);
+    FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False);
+  end;
+  info.Free;
+end;
+
+initialization
+
+  Randomize;
 
 end.
-

GraphicTest/BGRABitmap/bgraqtbitmap.pas

@@ -59 +59 @@
 procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
   ACanvas: TCanvas; ARect: TRect);
-var
-  background, temp: TBGRADefaultBitmap;
-  w, h: integer;
-
 begin
-  w := ARect.Right - ARect.Left;
-  h := ARect.Bottom - ARect.Top;
-  background := NewBitmap(w, h);
-  background.GetImageFromCanvas(ACanvas, ARect.Left, ARect.Top);
-  if (ABitmap.Width = w) and (ABitmap.Height = h) then
-    background.PutImage(0, 0, ABitmap, dmDrawWithTransparency)
-  else
-  begin
-    temp := ABitmap.Resample(w, h, rmSimpleStretch);
-    background.PutImage(0, 0, temp, dmDrawWithTransparency);
-    temp.Free;
-  end;
-  background.Draw(ACanvas, ARect.Left, ARect.Top, True);
-  background.Free;
+  ACanvas.Draw(0,0, ABitmap.Bitmap);
 end;
 

GraphicTest/BGRABitmap/bgraresample.pas

@@ -1 @@
-unit bgraresample;
+unit BGRAResample;
 
 {$mode objfpc}{$H+}
 
-{ 6/2/2011 : fixed SimpleStretchSmaller }
-
 interface
 
+{ This unit provides resampling functions, i.e. resizing of bitmaps with or
+  without interpolation filters.
+
+  SimpleStretch does a fast stretch by splitting the image into zones defined
+  by integers. This can be quite ugly.
+
+  FineResample uses floating point coordinates to get an antialiased resample.
+  It can use minimal interpolation (4 pixels when upsizing) for simple interpolation
+  filters (linear and cosine-like) or wide kernel resample for complex interpolation.
+  In this cas, it calls WideKernelResample.
+
+  WideKernelResample can be called by custom filter kernel, derived
+  from TWideKernelFilter. It is slower of course than simple interpolation. }
+
 uses
-  Classes, SysUtils, BGRADefaultBitmap;
-
-function FineResample(bmp: TBGRADefaultBitmap;
-  NewWidth, NewHeight: integer): TBGRADefaultBitmap;
-function SimpleStretch(bmp: TBGRADefaultBitmap;
-  NewWidth, NewHeight: integer): TBGRADefaultBitmap;
+  Classes, SysUtils, BGRABitmapTypes;
+
+{------------------------------- Simple stretch ------------------------------------}
+
+function SimpleStretch(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer): TBGRACustomBitmap;
+
+{---------------------------- Interpolation filters --------------------------------}
+
+function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single;
+
+type
+  TWideKernelFilter = class
+    function Interpolation(t: single): single; virtual; abstract;
+    function ShouldCheckRange: boolean; virtual; abstract;
+    function KernelWidth: single; virtual; abstract;
+  end;
+
+  TMitchellKernel = class(TWideKernelFilter)
+    function Interpolation(t: single): single; override;
+    function ShouldCheckRange: boolean; override;
+    function KernelWidth: single; override;
+  end;
+
+  { TSplineKernel }
+
+  TSplineKernel = class(TWideKernelFilter)
+  public
+    Coeff: single;
+    constructor Create;
+    constructor Create(ACoeff: single);
+    function Interpolation(t: single): single; override;
+    function ShouldCheckRange: boolean; override;
+    function KernelWidth: single; override;
+  end;
+
+  { TCubicKernel }
+
+  TCubicKernel = class(TWideKernelFilter)
+    function pow3(x: single): single; inline;
+    function Interpolation(t: single): single; override;
+    function ShouldCheckRange: boolean; override;
+    function KernelWidth: single; override;
+  end;
+
+function CreateInterpolator(style: TSplineStyle): TWideKernelFilter;
+
+{-------------------------------- Fine resample ------------------------------------}
+
+function FineResample(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
+
+function WideKernelResample(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap;
 
 implementation
 
-uses GraphType, BGRABitmapTypes, Math;
-
-function FineResampleLarger(bmp: TBGRADefaultBitmap;
-  newWidth, newHeight: integer): TBGRADefaultBitmap;
+uses GraphType, Math;
+
+{-------------------------------- Simple stretch ------------------------------------}
+
+function FastSimpleStretchLarger(bmp: TBGRACustomBitmap;
+  xFactor, yFactor: integer): TBGRACustomBitmap;
 var
-  yb, xb: integer;
-  pdest:  PBGRAPixel;
-  xsrc, ysrc, xfactor, yfactor: double;
-  ixsrc1, ixsrc2, iysrc1, iysrc2: integer;
-  cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel;
-  factHoriz, factVert, factCorrX, factCorrY, Sum, fUpLeft, fUpRight,
-  fLowLeft, fLowRight, faUpLeft, faUpRight, faLowLeft, faLowRight: single;
-  rSum, gSum, bSum, aSum: single;
-  temp:   TBGRADefaultBitmap;
+  y_src, yb, y_dest: integer;
+
+  x_src, xb: integer;
+  srcColor:  TBGRAPixel;
+
+  PSrc:  PBGRAPixel;
+  PDest: array of PBGRAPixel;
+  temp:  PBGRAPixel;
+
+begin
+  if (xFactor < 1) or (yFactor < 1) then
+    raise ERangeError.Create('FastSimpleStretchLarger: New dimensions must be greater or equal (*'+IntToStr(xFactor)+'x*'+IntToStr(yFactor)+')');
+
+  Result := bmp.NewBitmap(bmp.Width * xFactor, bmp.Height * yFactor);
+  if (Result.Width = 0) or (Result.Height = 0) then
+    exit;
+
+  bmp.LoadFromBitmapIfNeeded;
+
+  SetLength(PDest, yFactor);
+  y_dest := 0;
+  for y_src := 0 to bmp.Height - 1 do
+  begin
+    PSrc := bmp.Scanline[y_src];
+    for yb := 0 to yFactor - 1 do
+      PDest[yb] := Result.scanLine[y_dest + yb];
+
+    for x_src := 0 to bmp.Width - 1 do
+    begin
+      srcColor := PSrc^;
+      Inc(PSrc);
+
+      for yb := 0 to yFactor - 1 do
+      begin
+        temp := PDest[yb];
+        for xb := 0 to xFactor - 1 do
+        begin
+          temp^ := srcColor;
+          Inc(temp);
+        end;
+        PDest[yb] := temp;
+      end;
+    end;
+    Inc(y_dest, yFactor);
+  end;
+
+  Result.InvalidateBitmap;
+end;
+
+function SimpleStretchLarger(bmp: TBGRACustomBitmap;
+  newWidth, newHeight: integer): TBGRACustomBitmap;
+var
+  x_src, y_src: integer;
+  inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest: integer;
+  x_dest, y_dest, prev_x_dest, prev_y_dest: integer;
+
+  xb, yb:      integer;
+  srcColor:    TBGRAPixel;
+  PDest, PSrc: PBGRAPixel;
+  delta, lineDelta: integer;
+
 begin
   if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
-    raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
+    raise ERangeError.Create('SimpleStretchLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
+
+  if ((newWidth div bmp.Width) * bmp.Width = newWidth) and
+    ((newHeight div bmp.Height) * bmp.Height = newHeight) then
+  begin
+    Result := FastSimpleStretchLarger(bmp, newWidth div bmp.Width,
+      newHeight div bmp.Height);
+    exit;
+  end;
 
   Result := bmp.NewBitmap(NewWidth, NewHeight);
@@ -41 +163 @@
   bmp.LoadFromBitmapIfNeeded;
 
+  inc_x_dest := newwidth div bmp.Width;
+  mod_x_dest := newwidth mod bmp.Width;
+  inc_y_dest := newheight div bmp.Height;
+  mod_y_dest := newheight mod bmp.Height;
+
+  y_dest     := 0;
+  acc_y_dest := bmp.Height div 2;
+  if Result.LineOrder = riloTopToBottom then
+    lineDelta := newWidth
+  else
+    lineDelta := -newWidth;
+  for y_src := 0 to bmp.Height - 1 do
+  begin
+    prev_y_dest := y_dest;
+    Inc(y_dest, inc_y_dest);
+    Inc(acc_y_dest, mod_y_dest);
+    if acc_y_dest >= bmp.Height then
+    begin
+      Dec(acc_y_dest, bmp.Height);
+      Inc(y_dest);
+    end;
+
+    PSrc := bmp.Scanline[y_src];
+
+    x_dest     := 0;
+    acc_x_dest := bmp.Width div 2;
+    for x_src := 0 to bmp.Width - 1 do
+    begin
+      prev_x_dest := x_dest;
+      Inc(x_dest, inc_x_dest);
+      Inc(acc_x_dest, mod_x_dest);
+      if acc_x_dest >= bmp.Width then
+      begin
+        Dec(acc_x_dest, bmp.Width);
+        Inc(x_dest);
+      end;
+
+      srcColor := PSrc^;
+      Inc(PSrc);
+
+      PDest := Result.scanline[prev_y_dest] + prev_x_dest;
+      delta := lineDelta - (x_dest - prev_x_dest);
+      for yb := prev_y_dest to y_dest - 1 do
+      begin
+        for xb := prev_x_dest to x_dest - 1 do
+        begin
+          PDest^ := srcColor;
+          Inc(PDest);
+        end;
+        Inc(PDest, delta);
+      end;
+    end;
+  end;
+  Result.InvalidateBitmap;
+end;
+
+function SimpleStretchSmallerFactor2(source: TBGRACustomBitmap): TBGRACustomBitmap;
+var xb,yb: integer;
+    pdest: PBGRAPixel;
+    psrc1,psrc2: PBGRAPixel;
+    asum: integer;
+    a1,a2,a3,a4: integer;
+    newWidth,newHeight: integer;
+begin
+  newWidth := source.Width div 2;
+  newHeight := source.Height div 2;
+  result := source.NewBitmap(newWidth,newHeight);
+  for yb := 0 to newHeight-1 do
+  begin
+    pdest := result.ScanLine[yb];
+    psrc1 := source.Scanline[yb shl 1];
+    psrc2 := source.Scanline[yb shl 1+1];
+    for xb := newWidth-1 downto 0 do
+    begin
+      asum := psrc1^.alpha + (psrc1+1)^.alpha + psrc2^.alpha + (psrc2+1)^.alpha;
+      if asum = 0 then
+        pdest^ := BGRAPixelTransparent
+      else if asum = 1020 then
+      begin
+        pdest^.alpha := 255;
+        pdest^.red := (psrc1^.red + (psrc1+1)^.red + psrc2^.red + (psrc2+1)^.red + 2) shr 2;
+        pdest^.green := (psrc1^.green + (psrc1+1)^.green + psrc2^.green + (psrc2+1)^.green+ 2) shr 2;
+        pdest^.blue := (psrc1^.blue + (psrc1+1)^.blue + psrc2^.blue + (psrc2+1)^.blue+ 2) shr 2;
+      end else
+      begin
+        pdest^.alpha := asum shr 2;
+        a1 := psrc1^.alpha;
+        a2 := (psrc1+1)^.alpha;
+        a3 := psrc2^.alpha;
+        a4 := (psrc2+1)^.alpha;
+        pdest^.red := (psrc1^.red*a1 + (psrc1+1)^.red*a2 + psrc2^.red*a3 + (psrc2+1)^.red*a4 + (asum shr 1)) div asum;
+        pdest^.green := (psrc1^.green*a1 + (psrc1+1)^.green*a2 + psrc2^.green*a3 + (psrc2+1)^.green*a4+ (asum shr 1)) div asum;
+        pdest^.blue := (psrc1^.blue*a1 + (psrc1+1)^.blue*a2 + psrc2^.blue*a3 + (psrc2+1)^.blue*a4+ (asum shr 1)) div asum;
+      end;
+      inc(psrc1,2);
+      inc(psrc2,2);
+      inc(pdest);
+    end;
+  end;
+end;
+
+function SimpleStretchSmallerFactor4(source: TBGRACustomBitmap): TBGRACustomBitmap;
+var xb,yb: integer;
+    pdest: PBGRAPixel;
+    psrc1,psrc2,psrc3,psrc4: PBGRAPixel;
+    asum: integer;
+    a1,a2,a3,a4,
+    a5,a6,a7,a8,
+    a9,a10,a11,a12,
+    a13,a14,a15,a16: integer;
+    newWidth,newHeight: integer;
+begin
+  newWidth := source.Width div 4;
+  newHeight := source.Height div 4;
+  result := source.NewBitmap(newWidth,newHeight);
+  for yb := 0 to newHeight-1 do
+  begin
+    pdest := result.ScanLine[yb];
+    psrc1 := source.Scanline[yb shl 2];
+    psrc2 := source.Scanline[yb shl 2+1];
+    psrc3 := source.Scanline[yb shl 2+2];
+    psrc4 := source.Scanline[yb shl 2+3];
+    for xb := newWidth-1 downto 0 do
+    begin
+      asum := psrc1^.alpha + (psrc1+1)^.alpha + (psrc1+2)^.alpha + (psrc1+3)^.alpha +
+              psrc2^.alpha + (psrc2+1)^.alpha + (psrc2+2)^.alpha + (psrc2+3)^.alpha +
+              psrc3^.alpha + (psrc3+1)^.alpha + (psrc3+2)^.alpha + (psrc3+3)^.alpha +
+              psrc4^.alpha + (psrc4+1)^.alpha + (psrc4+2)^.alpha + (psrc4+3)^.alpha;
+      if asum = 0 then
+        pdest^ := BGRAPixelTransparent
+      else if asum = 4080 then
+      begin
+        pdest^.alpha := 255;
+        pdest^.red := (psrc1^.red + (psrc1+1)^.red + (psrc1+2)^.red + (psrc1+3)^.red +
+              psrc2^.red + (psrc2+1)^.red + (psrc2+2)^.red + (psrc2+3)^.red +
+              psrc3^.red + (psrc3+1)^.red + (psrc3+2)^.red + (psrc3+3)^.red +
+              psrc4^.red + (psrc4+1)^.red + (psrc4+2)^.red + (psrc4+3)^.red + 8) shr 4;
+        pdest^.green := (psrc1^.green + (psrc1+1)^.green + (psrc1+2)^.green + (psrc1+3)^.green +
+              psrc2^.green + (psrc2+1)^.green + (psrc2+2)^.green + (psrc2+3)^.green +
+              psrc3^.green + (psrc3+1)^.green + (psrc3+2)^.green + (psrc3+3)^.green +
+              psrc4^.green + (psrc4+1)^.green + (psrc4+2)^.green + (psrc4+3)^.green + 8) shr 4;
+        pdest^.blue := (psrc1^.blue + (psrc1+1)^.blue + (psrc1+2)^.blue + (psrc1+3)^.blue +
+              psrc2^.blue + (psrc2+1)^.blue + (psrc2+2)^.blue + (psrc2+3)^.blue +
+              psrc3^.blue + (psrc3+1)^.blue + (psrc3+2)^.blue + (psrc3+3)^.blue +
+              psrc4^.blue + (psrc4+1)^.blue + (psrc4+2)^.blue + (psrc4+3)^.blue + 8) shr 4;
+      end else
+      begin
+        pdest^.alpha := asum shr 4;
+        a1 := psrc1^.alpha;
+        a2 := (psrc1+1)^.alpha;
+        a3 := (psrc1+2)^.alpha;
+        a4 := (psrc1+3)^.alpha;
+        a5 := psrc2^.alpha;
+        a6 := (psrc2+1)^.alpha;
+        a7 := (psrc2+2)^.alpha;
+        a8 := (psrc2+3)^.alpha;
+        a9 := psrc3^.alpha;
+        a10 := (psrc3+1)^.alpha;
+        a11 := (psrc3+2)^.alpha;
+        a12 := (psrc3+3)^.alpha;
+        a13 := psrc4^.alpha;
+        a14 := (psrc4+1)^.alpha;
+        a15 := (psrc4+2)^.alpha;
+        a16 := (psrc4+3)^.alpha;
+        pdest^.red := (psrc1^.red*a1 + (psrc1+1)^.red*a2 + (psrc1+2)^.red*a3 + (psrc1+3)^.red*a4 +
+              psrc2^.red*a5 + (psrc2+1)^.red*a6 + (psrc2+2)^.red*a7 + (psrc2+3)^.red*a8 +
+              psrc3^.red*a9 + (psrc3+1)^.red*a10 + (psrc3+2)^.red*a11 + (psrc3+3)^.red*a12 +
+              psrc4^.red*a13 + (psrc4+1)^.red*a14 + (psrc4+2)^.red*a15 + (psrc4+3)^.red*a16 + (asum shr 1)) div asum;
+        pdest^.green := (psrc1^.green*a1 + (psrc1+1)^.green*a2 + (psrc1+2)^.green*a3 + (psrc1+3)^.green*a4 +
+              psrc2^.green*a5 + (psrc2+1)^.green*a6 + (psrc2+2)^.green*a7 + (psrc2+3)^.green*a8 +
+              psrc3^.green*a9 + (psrc3+1)^.green*a10 + (psrc3+2)^.green*a11 + (psrc3+3)^.green*a12 +
+              psrc4^.green*a13 + (psrc4+1)^.green*a14 + (psrc4+2)^.green*a15 + (psrc4+3)^.green*a16 + (asum shr 1)) div asum;
+        pdest^.blue := (psrc1^.blue*a1 + (psrc1+1)^.blue*a2 + (psrc1+2)^.blue*a3 + (psrc1+3)^.blue*a4 +
+              psrc2^.blue*a5 + (psrc2+1)^.blue*a6 + (psrc2+2)^.blue*a7 + (psrc2+3)^.blue*a8 +
+              psrc3^.blue*a9 + (psrc3+1)^.blue*a10 + (psrc3+2)^.blue*a11 + (psrc3+3)^.blue*a12 +
+              psrc4^.blue*a13 + (psrc4+1)^.blue*a14 + (psrc4+2)^.blue*a15 + (psrc4+3)^.blue*a16 + (asum shr 1)) div asum;
+      end;
+      inc(psrc1,4);
+      inc(psrc2,4);
+      inc(psrc3,4);
+      inc(psrc4,4);
+      inc(pdest);
+    end;
+  end;
+end;
+
+function SimpleStretchSmallerFactor(source: TBGRACustomBitmap; fx,fy: integer): TBGRACustomBitmap;
+var xb,yb,ys,iy,ix: integer;
+    pdest: PBGRAPixel;
+    psrc: array of PBGRAPixel;
+    psrci: PBGRAPixel;
+    asum,maxsum: integer;
+    newWidth,newHeight: integer;
+    r,g,b,nbi: integer;
+begin
+  newWidth := source.Width div fx;
+  newHeight := source.Height div fy;
+  result := source.NewBitmap(newWidth,newHeight);
+  ys := 0;
+  maxsum := 255*fx*fy;
+  nbi := fx*fy;
+  setlength(psrc, fy);
+  for yb := 0 to newHeight-1 do
+  begin
+    pdest := result.ScanLine[yb];
+    for iy := fy-1 downto 0 do
+    begin
+      psrc[iy] := source.Scanline[ys];
+      inc(ys);
+    end;
+    for xb := newWidth-1 downto 0 do
+    begin
+      asum := 0;
+      for iy := fy-1 downto 0 do
+      begin
+        psrci := psrc[iy];
+        for ix := fx-1 downto 0 do
+          asum += (psrci+ix)^.alpha;
+      end;
+      if asum = 0 then
+        pdest^ := BGRAPixelTransparent
+      else if asum = maxsum then
+      begin
+        pdest^.alpha := 255;
+        r := 0;
+        g := 0;
+        b := 0;
+        for iy := fy-1 downto 0 do
+        begin
+          psrci := psrc[iy];
+          for ix := fx-1 downto 0 do
+          begin
+            with (psrci+ix)^ do
+            begin
+              r += red;
+              g += green;
+              b += blue;
+            end;
+          end;
+        end;
+        pdest^.red := (r + (nbi shr 1)) div nbi;
+        pdest^.green := (g + (nbi shr 1)) div nbi;
+        pdest^.blue := (b + (nbi shr 1)) div nbi;
+      end else
+      begin
+        pdest^.alpha := (asum + (nbi shr 1)) div nbi;
+        r := 0;
+        g := 0;
+        b := 0;
+        for iy := fy-1 downto 0 do
+        begin
+          psrci := psrc[iy];
+          for ix := fx-1 downto 0 do
+          begin
+            with (psrci+ix)^ do
+            begin
+              r += integer(red)*integer(alpha);
+              g += integer(green)*integer(alpha);
+              b += integer(blue)*integer(alpha);
+            end;
+          end;
+        end;
+        pdest^.red := (r + (asum shr 1)) div asum;
+        pdest^.green := (g + (asum shr 1)) div asum;
+        pdest^.blue := (b + (asum shr 1)) div asum;
+      end;
+      for iy := fy-1 downto 0 do
+        inc(psrc[iy],fx);
+      inc(pdest);
+    end;
+  end;
+end;
+
+function SimpleStretchSmaller(bmp: TBGRACustomBitmap;
+  newWidth, newHeight: integer): TBGRACustomBitmap;
+var
+  x_dest, y_dest: integer;
+  inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src: integer;
+  x_src, y_src, prev_x_src, prev_y_src: integer;
+  x_src2, y_src2: integer;
+
+  xb, yb: integer;
+  v1, v2, v3, v4, v4shr1: int64;
+  nb,a:     integer;
+  pdest, psrc, psrcscan: PBGRAPixel;
+  lineDelta, delta: integer;
+
+begin
+  if (newWidth > bmp.Width) or (newHeight > bmp.Height) then
+    raise ERangeError.Create('SimpleStretchSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
+
+  if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then
+  begin
+    Result := bmp.NewBitmap(NewWidth, NewHeight);
+    exit;
+  end;
+
+  if (newWidth*2 = bmp.Width) and (newHeight*2 = bmp.Height) then
+  begin
+    result := SimpleStretchSmallerFactor2(bmp);
+    exit
+  end
+  else
+  if (newWidth*4 = bmp.Width) and (newHeight*4 = bmp.Height) then
+  begin
+    result := SimpleStretchSmallerFactor4(bmp);
+    exit;
+  end
+  else
+  if (newWidth < bmp.Width) and (newHeight < bmp.Height) and
+     (bmp.Width mod newWidth = 0) and (bmp.Height mod newHeight = 0) then
+  begin
+    result := SimpleStretchSmallerFactor(bmp, bmp.Width div newWidth, bmp.Height div newHeight);
+    exit;
+  end;
+
+  Result := bmp.NewBitmap(NewWidth, NewHeight);
+
+  bmp.LoadFromBitmapIfNeeded;
+
+  inc_x_src := bmp.Width div newWidth;
+  mod_x_src := bmp.Width mod newWidth;
+  inc_y_src := bmp.Height div newHeight;
+  mod_y_src := bmp.Height mod newHeight;
+
+  if bmp.lineOrder = riloTopToBottom then
+    lineDelta := bmp.Width
+  else
+    lineDelta := -bmp.Width;
+
+  y_src     := 0;
+  acc_y_src := 0;
+  for y_dest := 0 to newHeight - 1 do
+  begin
+    PDest := Result.ScanLine[y_dest];
+
+    prev_y_src := y_src;
+    Inc(y_src, inc_y_src);
+    Inc(acc_y_src, mod_y_src);
+    if acc_y_src >= newHeight then
+    begin
+      Dec(acc_y_src, newHeight);
+      Inc(y_src);
+    end;
+    if y_src > prev_y_src then
+      y_src2 := y_src - 1
+    else
+      y_src2 := y_src;
+    psrcscan := bmp.Scanline[prev_y_src];
+
+    x_src     := 0;
+    acc_x_src := 0;
+    for x_dest := 0 to newWidth - 1 do
+    begin
+      prev_x_src := x_src;
+      Inc(x_src, inc_x_src);
+      Inc(acc_x_src, mod_x_src);
+      if acc_x_src >= newWidth then
+      begin
+        Dec(acc_x_src, newWidth);
+        Inc(x_src);
+      end;
+      if x_src > prev_x_src then
+        x_src2 := x_src - 1
+      else
+        x_src2 := x_src;
+
+      v1    := 0;
+      v2    := 0;
+      v3    := 0;
+      v4    := 0;
+      nb    := 0;
+      delta := lineDelta - (x_src2 - prev_x_src + 1);
+
+      PSrc  := psrcscan + prev_x_src;
+      for yb := prev_y_src to y_src2 do
+      begin
+        for xb := prev_x_src to x_src2 do
+        begin
+          with PSrc^ do
+          begin
+            a := alpha;
+                    {$HINTS OFF}
+            v1 += integer(red) * a;
+            v2 += integer(green) * a;
+            v3 += integer(blue) * a;
+                    {$HINTS ON}
+          end;
+          v4 += a;
+          Inc(PSrc);
+          Inc(nb);
+        end;
+        Inc(PSrc, delta);
+      end;
+
+      if (v4 <> 0) and (nb <> 0) then
+      begin
+        v4shr1  := v4 shr 1;
+        with PDest^ do
+        begin
+          red   := (v1 + v4shr1) div v4;
+          green := (v2 + v4shr1) div v4;
+          blue  := (v3 + v4shr1) div v4;
+          alpha := (v4 + (nb shr 1)) div nb;
+        end;
+      end
+      else
+       PDest^ := BGRAPixelTransparent;
+
+      Inc(PDest);
+    end;
+  end;
+  Result.InvalidateBitmap;
+end;
+
+function SimpleStretch(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer): TBGRACustomBitmap;
+var
+  temp, newtemp: TBGRACustomBitmap;
+begin
+  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
+    Result := bmp.Duplicate
+  else
+  if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
+    Result := SimpleStretchLarger(bmp, NewWidth, NewHeight)
+  else
+  if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
+    Result := SimpleStretchSmaller(bmp, NewWidth, NewHeight)
+  else
+  begin
+    temp := bmp;
+
+    if NewWidth < bmp.Width then
+    begin
+      newtemp := SimpleStretchSmaller(temp, NewWidth, temp.Height);
+      if (temp <> bmp) then
+        temp.Free;
+      temp := newtemp;
+    end;
+
+    if NewHeight < bmp.Height then
+    begin
+      newtemp := SimpleStretchSmaller(temp, temp.Width, NewHeight);
+      if (temp <> bmp) then
+        temp.Free;
+      temp := newtemp;
+    end;
+
+    if NewWidth > bmp.Width then
+    begin
+      newtemp := SimpleStretchLarger(temp, NewWidth, temp.Height);
+      if (temp <> bmp) then
+        temp.Free;
+      temp := newtemp;
+    end;
+
+    if NewHeight > bmp.Height then
+    begin
+      newtemp := SimpleStretchLarger(temp, temp.Width, NewHeight);
+      if (temp <> bmp) then
+        temp.Free;
+      temp := newtemp;
+    end;
+
+    if temp <> bmp then
+      Result := temp
+    else
+      Result := bmp.Duplicate;
+  end;
+end;
+
+{---------------------------- Interpolation filters ----------------------------------------}
+
+function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single;
+begin
+  if ResampleFilter = rfLinear then
+    result := t else
+  begin
+    if t <= 0.5 then
+      result := t*t*2 else
+      result := 1-(1-t)*(1-t)*2;
+    if ResampleFilter <> rfCosine then result := (result+t)*0.5;
+  end;
+end;
+
+{ TCubicKernel }
+
+function TCubicKernel.pow3(x: single): single;
+begin
+  if x <= 0.0 then
+   result:=0.0
+  else
+   result:=x * x * x;
+end;
+
+function TCubicKernel.Interpolation(t: single): single;
+const globalfactor = 1/6;
+begin
+   if t > 2 then
+     result := 0
+   else
+     result:= globalfactor *
+       (pow3(t + 2 ) - 4 * pow3(t + 1 ) + 6 * pow3(t ) - 4 * pow3(t - 1 ) );
+end;
+
+function TCubicKernel.ShouldCheckRange: boolean;
+begin
+  Result:= false;
+end;
+
+function TCubicKernel.KernelWidth: single;
+begin
+  Result:= 2;
+end;
+
+{ TMitchellKernel }
+
+function TMitchellKernel.Interpolation(t: single): single;
+var
+  tt, ttt: single;
+const OneEighteenth = 1 / 18;
+begin
+  t := Abs(t);
+  tt := Sqr(t);
+  ttt := tt * t;
+  if t < 1 then Result := (21 * ttt - 36 * tt + 16 ) * OneEighteenth
+  else if t < 2 then Result := (- 7 * ttt + 36 * tt - 60 * t + 32) * OneEighteenth
+  else Result := 0;
+end;
+
+function TMitchellKernel.ShouldCheckRange: Boolean;
+begin
+  Result := True;
+end;
+
+function TMitchellKernel.KernelWidth: single;
+begin
+  Result := 2;
+end;
+
+{ TSplineKernel }
+
+constructor TSplineKernel.Create;
+begin
+  coeff := 0.5;
+end;
+
+constructor TSplineKernel.Create(ACoeff: single);
+begin
+  Coeff := ACoeff;
+end;
+
+function TSplineKernel.Interpolation(t: single): single;
+var
+  tt, ttt: single;
+begin
+  t := Abs(t);
+  tt := Sqr(t);
+  ttt := tt * t;
+  if t < 1 then
+    Result := (2 - Coeff) * ttt - (3 - Coeff) * tt + 1
+  else if t < 2 then
+    Result := -Coeff * (ttt - 5 * tt + 8 * t - 4)
+  else
+    Result := 0;
+end;
+
+function TSplineKernel.ShouldCheckRange: Boolean;
+begin
+  Result := True;
+end;
+
+function TSplineKernel.KernelWidth: single;
+begin
+  Result := 2;
+end;
+
+{--------------------------------------------- Fine resample ------------------------------------------------}
+
+function FineResampleLarger(bmp: TBGRACustomBitmap;
+  newWidth, newHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
+type
+  TInterpolationEntry = record
+    isrc1,isrc2,factCorr: integer;
+  end;
+var
+  yb, xb: integer;
+  pdest,psrc1,psrc2:  PBGRAPixel;
+  xsrc, ysrc, xfactor, yfactor: double;
+  xTab,yTab: array of TInterpolationEntry;
+  xInfo,yInfo: TInterpolationEntry;
+  cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel;
+  factHoriz, factVert: single;
+  fUpLeft, fUpRight, fLowLeft, fLowRight: integer;
+  faUpLeft, faUpRight, faLowLeft, faLowRight: integer;
+  rSum, gSum, bSum, aSum: integer;
+  temp:   TBGRACustomBitmap;
+begin
+  if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
+    raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
+
+  if (newWidth = 0) or (newHeight = 0) then
+  begin
+    Result := bmp.NewBitmap(NewWidth, NewHeight);
+    exit;
+  end;
+
+  bmp.LoadFromBitmapIfNeeded;
+
   if (bmp.Width = 1) and (bmp.Height = 1) then
   begin
+    Result := bmp.NewBitmap(NewWidth, NewHeight);
     Result.Fill(bmp.GetPixel(0, 0));
     exit;
@@ -52 +784 @@
     temp.PutImage(0, 0, bmp, dmSet);
     temp.PutImage(1, 0, bmp, dmSet);
-    Result := FineResampleLarger(temp, 2, newHeight);
+    Result := FineResampleLarger(temp, 2, newHeight, ResampleFilter);
     temp.Free;
     temp := Result;
-    Result := SimpleStretch(temp, 1,temp.Height);
+    Result := SimpleStretch(temp, newWidth,temp.Height);
     temp.Free;
     exit;
@@ -65 +797 @@
     temp.PutImage(0, 0, bmp, dmSet);
     temp.PutImage(0, 1, bmp, dmSet);
-    Result := FineResampleLarger(temp, newWidth, 2);
+    Result := FineResampleLarger(temp, newWidth, 2, ResampleFilter);
     temp.Free;
     temp := Result;
-    Result := SimpleStretch(temp, temp.Width,1);
+    Result := SimpleStretch(temp, temp.Width,newHeight);
     temp.Free;
     exit;
   end;
 
+  Result := bmp.NewBitmap(NewWidth, NewHeight);
   yfactor := (bmp.Height - 1) / (newHeight - 1);
   xfactor := (bmp.Width - 1) / (newWidth - 1);
+
+  setlength(yTab, newHeight);
   for yb := 0 to newHeight - 1 do
   begin
+    ysrc     := yb * yfactor;
+    factVert := frac(ysrc);
+    yTab[yb].isrc1   := floor(ysrc);
+    yTab[yb].isrc2 := min(bmp.Height-1, ceil(ysrc));
+    yTab[yb].factCorr := round(FineInterpolation(factVert,ResampleFilter)*256);
+  end;
+  setlength(xTab, newWidth);
+  for xb := 0 to newWidth - 1 do
+  begin
+    xsrc     := xb * xfactor;
+    factHoriz := frac(xsrc);
+    xTab[xb].isrc1   := floor(xsrc);
+    xTab[xb].isrc2 := min(bmp.Width-1,ceil(xsrc));
+    xTab[xb].factCorr := round(FineInterpolation(factHoriz,ResampleFilter)*256);
+  end;
+
+  for yb := 0 to newHeight - 1 do
+  begin
     pdest    := Result.Scanline[yb];
-    ysrc     := yb * yfactor;
-    iysrc1   := floor(ysrc);
-    factVert := frac(ysrc);
-    if (factVert = 0) then
-      iysrc2 := iysrc1
-    else
-      iysrc2 := ceil(ysrc);
-    factCorrY := 0.5 - cos(factVert * Pi) / 2;
+    yInfo    := yTab[yb];
+    psrc1    := bmp.scanline[yInfo.isrc1];
+    psrc2    := bmp.scanline[yInfo.isrc2];
     for xb := 0 to newWidth - 1 do
     begin
-      xsrc      := xb * xfactor;
-      ixsrc1    := floor(xsrc);
-      factHoriz := frac(xsrc);
-      if (factHoriz = 0) then
-        ixsrc2 := ixsrc1
-      else
-        ixsrc2 := ceil(xsrc);
-      factCorrX := 0.5 - cos(factHoriz * Pi) / 2;
-
-      cUpLeft   := bmp.GetPixel(ixsrc1, iysrc1);
-      cUpRight  := bmp.GetPixel(ixsrc2, iysrc1);
-      cLowLeft  := bmp.GetPixel(ixsrc1, iysrc2);
-      cLowRight := bmp.GetPixel(ixsrc2, iysrc2);
-
-      fUpLeft   := (1 - factCorrX) * (1 - factCorrY);
-      fUpRight  := factCorrX * (1 - factCorrY);
-      fLowLeft  := (1 - factCorrX) * factCorrY;
-      fLowRight := factCorrX * factCorrY;
+      xInfo  := xTab[xb];
+
+      cUpLeft   := (psrc1 + xInfo.isrc1)^;
+      cUpRight  := (psrc1 + xInfo.isrc2)^;
+      cLowLeft  := (psrc2 + xInfo.isrc1)^;
+      cLowRight := (psrc2 + xInfo.isrc2)^;
+
+      fLowRight := (xInfo.factCorr * yInfo.factCorr + 128) shr 8;
+      fLowLeft := yInfo.factCorr - fLowRight;
+      fUpRight := xInfo.factCorr - fLowRight;
+      fUpLeft := (256 - xInfo.factCorr) - fLowLeft;
 
       faUpLeft   := fUpLeft * cUpLeft.alpha;
@@ -112 +853 @@
       faLowRight := fLowRight * cLowRight.alpha;
 
-      Sum  := fUpLeft + fUpRight + fLowLeft + fLowRight;
       rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight +
         cLowLeft.red * faLowLeft + cLowRight.red * faLowRight;
@@ -125 +865 @@
         pdest^ := BGRAPixelTransparent
       else
-        pdest^ := BGRA(round(rSum / aSum), round(gSum / aSum),
-          round(bSum / aSum), round(aSum / Sum));
+        pdest^ := BGRA((rSum + aSum shr 1) div aSum, (gSum + aSum shr 1) div aSum,
+          (bSum + aSum shr 1) div aSum, (aSum + 128) shr 8);
       Inc(pdest);
 
@@ -133 +873 @@
 end;
 
-function FastSimpleStretchLarger(bmp: TBGRADefaultBitmap;
-  xFactor, yFactor: integer): TBGRADefaultBitmap;
-var
-  y_src, yb, y_dest: integer;
-
-  x_src, xb: integer;
-  srcColor:  TBGRAPixel;
-
-  PSrc:  PBGRAPixel;
-  PDest: array of PBGRAPixel;
-  temp:  PBGRAPixel;
-
-begin
-  if (xFactor < 1) or (yFactor < 1) then
-    raise ERangeError.Create('FastSimpleStretchLarger: New dimensions must be greater or equal (*'+IntToStr(xFactor)+'x*'+IntToStr(yFactor)+')');
-
-  Result := bmp.NewBitmap(bmp.Width * xFactor, bmp.Height * yFactor);
-  if (Result.Width = 0) or (Result.Height = 0) then
-    exit;
-
-  bmp.LoadFromBitmapIfNeeded;
-
-  SetLength(PDest, yFactor);
-  y_dest := 0;
-  for y_src := 0 to bmp.Height - 1 do
-  begin
-    PSrc := bmp.Scanline[y_src];
-    for yb := 0 to yFactor - 1 do
-      PDest[yb] := Result.scanLine[y_dest + yb];
-
-    for x_src := 0 to bmp.Width - 1 do
-    begin
-      srcColor := PSrc^;
-      Inc(PSrc);
-
-      for yb := 0 to yFactor - 1 do
-      begin
-        temp := PDest[yb];
-        for xb := 0 to xFactor - 1 do
-        begin
-          temp^ := srcColor;
-          Inc(temp);
-        end;
-        PDest[yb] := temp;
-      end;
-    end;
-    Inc(y_dest, yFactor);
-  end;
-
-  Result.InvalidateBitmap;
-end;
-
-function SimpleStretchLarger(bmp: TBGRADefaultBitmap;
-  newWidth, newHeight: integer): TBGRADefaultBitmap;
-var
-  x_src, y_src: integer;
-  inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest: integer;
-  x_dest, y_dest, prev_x_dest, prev_y_dest: integer;
-
-  xb, yb:      integer;
-  srcColor:    TBGRAPixel;
-  PDest, PSrc: PBGRAPixel;
-  delta, lineDelta: integer;
-
-begin
-  if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
-    raise ERangeError.Create('SimpleStretchLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
-
-  if ((newWidth div bmp.Width) * bmp.Width = newWidth) and
-    ((newHeight div bmp.Height) * bmp.Height = newHeight) then
-  begin
-    Result := FastSimpleStretchLarger(bmp, newWidth div bmp.Width,
-      newHeight div bmp.Height);
-    exit;
-  end;
-
-  Result := bmp.NewBitmap(NewWidth, NewHeight);
-  if (newWidth = 0) or (newHeight = 0) then
-    exit;
-
-  bmp.LoadFromBitmapIfNeeded;
-
-  inc_x_dest := newwidth div bmp.Width;
-  mod_x_dest := newwidth mod bmp.Width;
-  inc_y_dest := newheight div bmp.Height;
-  mod_y_dest := newheight mod bmp.Height;
-
-  y_dest     := 0;
-  acc_y_dest := bmp.Height div 2;
-  if Result.LineOrder = riloTopToBottom then
-    lineDelta := newWidth
-  else
-    lineDelta := -newWidth;
-  for y_src := 0 to bmp.Height - 1 do
-  begin
-    prev_y_dest := y_dest;
-    Inc(y_dest, inc_y_dest);
-    Inc(acc_y_dest, mod_y_dest);
-    if acc_y_dest >= bmp.Height then
-    begin
-      Dec(acc_y_dest, bmp.Height);
-      Inc(y_dest);
-    end;
-
-    PSrc := bmp.Scanline[y_src];
-
-    x_dest     := 0;
-    acc_x_dest := bmp.Width div 2;
-    for x_src := 0 to bmp.Width - 1 do
-    begin
-      prev_x_dest := x_dest;
-      Inc(x_dest, inc_x_dest);
-      Inc(acc_x_dest, mod_x_dest);
-      if acc_x_dest >= bmp.Width then
-      begin
-        Dec(acc_x_dest, bmp.Width);
-        Inc(x_dest);
-      end;
-
-      srcColor := PSrc^;
-      Inc(PSrc);
-
-      PDest := Result.scanline[prev_y_dest] + prev_x_dest;
-      delta := lineDelta - (x_dest - prev_x_dest);
-      for yb := prev_y_dest to y_dest - 1 do
-      begin
-        for xb := prev_x_dest to x_dest - 1 do
-        begin
-          PDest^ := srcColor;
-          Inc(PDest);
-        end;
-        Inc(PDest, delta);
-      end;
-    end;
-  end;
-  Result.InvalidateBitmap;
-end;
-
-function SimpleStretchSmaller(bmp: TBGRADefaultBitmap;
-  newWidth, newHeight: integer): TBGRADefaultBitmap;
-var
-  x_dest, y_dest: integer;
-  inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src: integer;
-  x_src, y_src, prev_x_src, prev_y_src: integer;
-  x_src2, y_src2: integer;
-
-  xb, yb: integer;
-  v1, v2, v3, v4, v4shr1: int64;
-  nb:     integer;
-  c:      TBGRAPixel;
-  pdest, psrc: PBGRAPixel;
-  lineDelta, delta: integer;
-begin
-  if (newWidth > bmp.Width) or (newHeight > bmp.Height) then
-    raise ERangeError.Create('SimpleStretchSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
-  Result := bmp.NewBitmap(NewWidth, NewHeight);
-  if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then
-    exit;
-
-  bmp.LoadFromBitmapIfNeeded;
-
-  inc_x_src := bmp.Width div newWidth;
-  mod_x_src := bmp.Width mod newWidth;
-  inc_y_src := bmp.Height div newHeight;
-  mod_y_src := bmp.Height mod newHeight;
-
-  if bmp.lineOrder = riloTopToBottom then
-    lineDelta := bmp.Width
-  else
-    lineDelta := -bmp.Width;
-
-  y_src     := 0;
-  acc_y_src := 0;
-  for y_dest := 0 to newHeight - 1 do
-  begin
-    PDest := Result.ScanLine[y_dest];
-
-    prev_y_src := y_src;
-    Inc(y_src, inc_y_src);
-    Inc(acc_y_src, mod_y_src);
-    if acc_y_src >= newHeight then
-    begin
-      Dec(acc_y_src, newHeight);
-      Inc(y_src);
-    end;
-    if y_src > prev_y_src then
-      y_src2 := y_src - 1
-    else
-      y_src2 := y_src;
-
-    x_src     := 0;
-    acc_x_src := 0;
-    for x_dest := 0 to newWidth - 1 do
-    begin
-      prev_x_src := x_src;
-      Inc(x_src, inc_x_src);
-      Inc(acc_x_src, mod_x_src);
-      if acc_x_src >= newWidth then
-      begin
-        Dec(acc_x_src, newWidth);
-        Inc(x_src);
-      end;
-      if x_src > prev_x_src then
-        x_src2 := x_src - 1
-      else
-        x_src2 := x_src;
-
-      v1    := 0;
-      v2    := 0;
-      v3    := 0;
-      v4    := 0;
-      nb    := 0;
-      delta := lineDelta - (x_src2 - prev_x_src + 1);
-      PSrc  := bmp.Scanline[prev_y_src] + prev_x_src;
-      for yb := prev_y_src to y_src2 do
-      begin
-        for xb := prev_x_src to x_src2 do
-        begin
-          c := PSrc^;
-          Inc(PSrc);
-                  {$HINTS OFF}
-          v1 += integer(c.red) * integer(c.alpha);
-          v2 += integer(c.green) * integer(c.alpha);
-          v3 += integer(c.blue) * integer(c.alpha);
-                  {$HINTS ON}
-          v4 += c.alpha;
-          Inc(nb);
-        end;
-        Inc(PSrc, delta);
-      end;
-
-      if (v4 <> 0) and (nb <> 0) then
-      begin
-        v4shr1  := v4 shr 1;
-        c.red   := (v1 + v4shr1) div v4;
-        c.green := (v2 + v4shr1) div v4;
-        c.blue  := (v3 + v4shr1) div v4;
-        c.alpha := (v4 + (nb shr 1)) div nb;
-      end
-      else
-      begin
-        c.alpha := 0;
-        c.red   := 0;
-        c.green := 0;
-        c.blue  := 0;
-      end;
-      PDest^ := c;
-      Inc(PDest);
-    end;
-  end;
-  Result.InvalidateBitmap;
-end;
-
-function FineResampleSmaller(bmp: TBGRADefaultBitmap;
-  newWidth, newHeight: integer): TBGRADefaultBitmap;
+function FineResampleSmaller(bmp: TBGRACustomBitmap;
+  newWidth, newHeight: integer): TBGRACustomBitmap;
 var
   yb, xb, yb2, xb2: integer;
@@ -571 +1058 @@
 end;
 
-function FineResample(bmp: TBGRADefaultBitmap;
-  NewWidth, NewHeight: integer): TBGRADefaultBitmap;
+function CreateInterpolator(style: TSplineStyle): TWideKernelFilter;
+begin
+  case Style of
+    ssInside, ssInsideWithEnds: result := TCubicKernel.Create;
+    ssCrossing, ssCrossingWithEnds: result := TMitchellKernel.Create;
+    ssOutside: result := TSplineKernel.Create(0.5);
+    ssRoundOutside: result := TSplineKernel.Create(0.75);
+    ssVertexToSide: result := TSplineKernel.Create(1);
+  else
+    raise Exception.Create('Unknown spline style');
+  end;
+end;
+
+function FineResample(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
 var
-  temp, newtemp: TBGRADefaultBitmap;
-begin
+  temp, newtemp: TBGRACustomBitmap;
+  tempFilter1,tempFilter2: TWideKernelFilter;
+begin
+  case ResampleFilter of
+    rfBicubic: //blur
+    begin
+      tempFilter1 := TCubicKernel.Create;
+      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
+      tempFilter1.Free;
+      exit;
+    end;
+    rfMitchell:
+    begin
+      tempFilter1 := TMitchellKernel.Create;
+      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
+      tempFilter1.Free;
+      exit;
+    end;
+    rfSpline:
+    begin
+      tempFilter1 := TSplineKernel.Create;
+      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
+      tempFilter1.Free;
+      exit;
+    end;
+    rfBestQuality:
+    begin
+      tempFilter1 := TSplineKernel.Create;
+      tempFilter2 := TMitchellKernel.Create;
+      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter2,tempFilter1);
+      tempFilter1.Free;
+      tempFilter2.Free;
+      exit;
+    end;
+  end;
+
   if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
     Result := bmp.Duplicate
   else
   if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
-    Result := FineResampleLarger(bmp, NewWidth, NewHeight)
+    Result := FineResampleLarger(bmp, NewWidth, NewHeight, ResampleFilter)
   else
   if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
@@ -606 +1140 @@
     if NewWidth > bmp.Width then
     begin
-      newtemp := FineResampleLarger(temp, NewWidth, temp.Height);
+      newtemp := FineResampleLarger(temp, NewWidth, temp.Height, ResampleFilter);
       if (temp <> bmp) then
         temp.Free;
@@ -614 +1148 @@
     if NewHeight > bmp.Height then
     begin
-      newtemp := FineResampleLarger(temp, temp.Width, NewHeight);
+      newtemp := FineResampleLarger(temp, temp.Width, NewHeight, ResampleFilter);
       if (temp <> bmp) then
         temp.Free;
@@ -627 +1161 @@
 end;
 
-function SimpleStretch(bmp: TBGRADefaultBitmap;
-  NewWidth, NewHeight: integer): TBGRADefaultBitmap;
+{------------------------ Wide kernel filtering adapted from Graphics32 ---------------------------}
+
+function Constrain(const Value, Lo, Hi: Integer): Integer;
+begin
+  if Value < Lo then
+        Result := Lo
+  else if Value > Hi then
+        Result := Hi
+  else
+        Result := Value;
+end;
+
+type
+  TPointRec = record
+    Pos: Integer;
+    Weight: Single;
+  end;
+
+  TCluster = array of TPointRec;
+  TMappingTable = array of TCluster;
+
+{$warnings off}
+function BuildMappingTable(
+  DstLo, DstHi: Integer;
+  ClipLo, ClipHi: Integer;
+  SrcLo, SrcHi: Integer;
+  KernelSmaller,KernelLarger: TWideKernelFilter): TMappingTable;
+Const FullEdge = false;
 var
-  temp, newtemp: TBGRADefaultBitmap;
-begin
-  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
-    Result := bmp.Duplicate
-  else
-  if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
-    Result := SimpleStretchLarger(bmp, NewWidth, NewHeight)
-  else
-  if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
-    Result := SimpleStretchSmaller(bmp, NewWidth, NewHeight)
-  else
-  begin
-    temp := bmp;
-
-    if NewWidth < bmp.Width then
-    begin
-      newtemp := SimpleStretchSmaller(temp, NewWidth, temp.Height);
-      if (temp <> bmp) then
-        temp.Free;
-      temp := newtemp;
-    end;
-
-    if NewHeight < bmp.Height then
-    begin
-      newtemp := SimpleStretchSmaller(temp, temp.Width, NewHeight);
-      if (temp <> bmp) then
-        temp.Free;
-      temp := newtemp;
-    end;
-
-    if NewWidth > bmp.Width then
-    begin
-      newtemp := SimpleStretchLarger(temp, NewWidth, temp.Height);
-      if (temp <> bmp) then
-        temp.Free;
-      temp := newtemp;
-    end;
-
-    if NewHeight > bmp.Height then
-    begin
-      newtemp := SimpleStretchLarger(temp, temp.Width, NewHeight);
-      if (temp <> bmp) then
-        temp.Free;
-      temp := newtemp;
-    end;
-
-    if temp <> bmp then
-      Result := temp
-    else
-      Result := bmp.Duplicate;
-  end;
+  SrcW, DstW, ClipW: Integer;
+  FilterWidth: Single;
+  Scale, OldScale: Single;
+  Center: Single;
+  Left, Right: Integer;
+  I, J, K: Integer;
+  Weight: Single;
+begin
+  SrcW := SrcHi - SrcLo;
+  DstW := DstHi - DstLo;
+  ClipW := ClipHi - ClipLo;
+  if SrcW = 0 then
+  begin
+    Result := nil;
+    Exit;
+  end
+  else if SrcW = 1 then
+  begin
+    SetLength(Result, ClipW);
+    for I := 0 to ClipW - 1 do
+    begin
+      SetLength(Result[I], 1);
+      Result[I][0].Pos := 0;
+      Result[I][0].Weight := 1;
+    end;
+    Exit;
+  end;
+  SetLength(Result, ClipW);
+  if ClipW = 0 then Exit;
+
+  if FullEdge then Scale := DstW / SrcW
+  else Scale := (DstW - 1) / (SrcW - 1);
+
+  K := 0;
+
+  if Scale = 0 then
+  begin
+    SetLength(Result[0], 1);
+    Result[0][0].Pos := (SrcLo + SrcHi) div 2;
+    Result[0][0].Weight := 1;
+  end
+  else if Scale < 1 then
+  begin
+    FilterWidth := KernelSmaller.KernelWidth;
+    OldScale := Scale;
+    Scale := 1 / Scale;
+    FilterWidth := FilterWidth * Scale;
+    for I := 0 to ClipW - 1 do
+    begin
+      if FullEdge then
+        Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
+      else
+        Center := SrcLo + (I - DstLo + ClipLo) * Scale;
+      Left := Floor(Center - FilterWidth);
+      Right := Ceil(Center + FilterWidth);
+      for J := Left to Right do
+      begin
+        Weight := KernelSmaller.Interpolation((Center - J) * OldScale) * OldScale;
+        if Weight <> 0 then
+        begin
+          K := Length(Result[I]);
+          SetLength(Result[I], K + 1);
+          Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1);
+          Result[I][K].Weight := Weight;
+        end;
+      end;
+      if Length(Result[I]) = 0 then
+      begin
+        SetLength(Result[I], 1);
+        Result[I][0].Pos := Floor(Center);
+        Result[I][0].Weight := 1;
+      end;
+    end;
+  end
+  else // scale > 1
+  begin
+    FilterWidth := KernelLarger.KernelWidth;
+    Scale := 1 / Scale;
+    for I := 0 to ClipW - 1 do
+    begin
+      if FullEdge then
+        Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
+      else
+        Center := SrcLo + (I - DstLo + ClipLo) * Scale;
+      Left := Floor(Center - FilterWidth);
+      Right := Ceil(Center + FilterWidth);
+      for J := Left to Right do
+      begin
+        Weight := KernelLarger.Interpolation(Center - j);
+        if Weight <> 0 then
+        begin
+          K := Length(Result[I]);
+          SetLength(Result[I], k + 1);
+          Result[I][K].Pos := Constrain(j, SrcLo, SrcHi - 1);
+          Result[I][K].Weight := Weight;
+        end;
+      end;
+    end;
+  end;
+end;
+{$warnings on}
+
+function WideKernelResample(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap;
+type
+  TSum = record
+    sumR,sumG,sumB,sumA: single;
+  end;
+
+var
+  mapX,mapY: TMappingTable;
+  xb,yb,xc,yc,MapXLoPos,MapXHiPos: integer;
+  clusterX,clusterY: TCluster;
+  verticalSum: array of TSum;
+  scanlinesSrc: array of PBGRAPixel;
+  sum: TSum;
+  c: TBGRAPixel;
+  w,wa: single;
+  pdest: PBGRAPixel;
+begin
+  result := bmp.NewBitmap(NewWidth,NewHeight);
+  if (NewWidth=0) or (NewHeight=0) then exit;
+  mapX := BuildMappingTable(0,NewWidth,0,NewWidth,0,bmp.Width,ResampleFilterSmaller,ResampleFilterLarger);
+  mapY := BuildMappingTable(0,NewHeight,0,NewHeight,0,bmp.Height,ResampleFilterSmaller,ResampleFilterLarger);
+
+  MapXLoPos := MapX[0][0].Pos;
+  MapXHiPos := MapX[NewWidth - 1][High(MapX[NewWidth - 1])].Pos;
+
+  setlength(verticalSum, MapXHiPos-MapXLoPos+1);
+
+  setlength(scanlinesSrc, bmp.Height);
+  for yb := 0 to bmp.Height-1 do
+    scanlinesSrc[yb] := bmp.ScanLine[yb];
+
+  for yb := 0 to NewHeight-1 do
+  begin
+    clusterY := mapY[yb];
+
+    for xb := MapXLoPos to MapXHiPos do
+    begin
+      fillchar(verticalSum[xb - MapXLoPos],sizeof(verticalSum[xb - MapXLoPos]),0);
+      for yc := 0 to high(clusterY) do
+      with verticalSum[xb - MapXLoPos] do
+      begin
+        c := (scanlinesSrc[clusterY[yc].Pos]+xb)^;
+        w := clusterY[yc].Weight;
+        wa := w * c.alpha;
+        sumA += wa;
+        sumR += c.red * wa;
+        sumG += c.green * wa;
+        sumB += c.blue * wa;
+      end;
+    end;
+
+    pdest := result.Scanline[yb];
+
+    for xb := 0 to NewWidth-1 do
+    begin
+      clusterX := mapX[xb];
+      {$hints off}
+      fillchar(sum,sizeof(sum),0);
+      {$hints on}
+      for xc := 0 to high(clusterX) do
+      begin
+        w := clusterX[xc].Weight;
+        with verticalSum[ClusterX[xc].Pos - MapXLoPos] do
+        begin
+          sum.sumA += sumA*w;
+          sum.sumR += sumR*w;
+          sum.sumG += sumG*w;
+          sum.sumB += sumB*w;
+        end;
+      end;
+
+      if sum.sumA < 0.5 then
+        pdest^ := BGRAPixelTransparent else
+      begin
+        c.red := constrain(round(sum.sumR/sum.sumA),0,255);
+        c.green := constrain(round(sum.sumG/sum.sumA),0,255);
+        c.blue := constrain(round(sum.sumB/sum.sumA),0,255);
+        if sum.sumA > 255 then
+          c.alpha := 255 else
+          c.alpha := round(sum.sumA);
+        pdest^ := c;
+      end;
+      inc(pdest);
+    end;
+  end;
+
 end;
 

GraphicTest/BGRABitmap/readme.txt

@@ -1 @@
-BGRABitmap v2.2 - Drawing routines with alpha blending and antialiasing with Lazarus.
+BGRABitmap v5.5 - Drawing routines with alpha blending and antialiasing with Lazarus.
 
 These routines allow to manipulate 32bit images in BGRA format.

GraphicTest/GraphicTest.lpi

@@ -2 +2 @@
 <CONFIG>
   <ProjectOptions>
-    <Version Value="7"/>
+    <Version Value="9"/>
     <General>
       <MainUnit Value="0"/>
-      <TargetFileExt Value=".exe"/>
+      <UseXPManifest Value="True"/>
       <Icon Value="0"/>
-      <UseXPManifest Value="True"/>
-      <ActiveEditorIndexAtStart Value="2"/>
+      <ActiveWindowIndexAtStart Value="0"/>
     </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -21 +23 @@
       </local>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="3">
       <Item1>
-        <PackageName Value="lazopenglcontext"/>
+        <PackageName Value="bgrabitmappack"/>
       </Item1>
       <Item2>
+        <PackageName Value="lazopenglcontext"/>
+      </Item2>
+      <Item3>
         <PackageName Value="LCL"/>
-      </Item2>
+      </Item3>
     </RequiredPackages>
-    <Units Count="50">
+    <Units Count="61">
       <Unit0>
         <Filename Value="GraphicTest.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="GraphicTest"/>
+        <TopLine Value="1"/>
         <CursorPos X="51" Y="15"/>
-        <TopLine Value="1"/>
-        <UsageCount Value="56"/>
+        <UsageCount Value="58"/>
       </Unit0>
       <Unit1>
@@ -44 +49 @@
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UMainForm"/>
-        <CursorPos X="3" Y="188"/>
-        <TopLine Value="186"/>
+        <IsVisibleTab Value="True"/>
         <EditorIndex Value="0"/>
-        <UsageCount Value="56"/>
-        <Loaded Value="True"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="118"/>
+        <CursorPos X="32" Y="135"/>
+        <UsageCount Value="58"/>
+        <Loaded Value="True"/>
+        <LoadedDesigner Value="True"/>
       </Unit1>
       <Unit2>
         <Filename Value="StopWatch.pas"/>
         <UnitName Value="StopWatch"/>
+        <TopLine Value="1"/>
         <CursorPos X="42" Y="22"/>
-        <TopLine Value="1"/>
         <UsageCount Value="15"/>
       </Unit2>
@@ -61 +69 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="UPlatform"/>
+        <TopLine Value="1"/>
         <CursorPos X="1" Y="1"/>
-        <TopLine Value="1"/>
-        <UsageCount Value="56"/>
+        <UsageCount Value="58"/>
       </Unit3>
       <Unit4>
         <Filename Value="../../lazarus/lcl/intfgraphics.pas"/>
         <UnitName Value="IntfGraphics"/>
+        <TopLine Value="244"/>
         <CursorPos X="49" Y="262"/>
-        <TopLine Value="244"/>
         <UsageCount Value="9"/>
       </Unit4>
@@ -75 +83 @@
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/fcl-image/src/fpimage.pp"/>
         <UnitName Value="FPimage"/>
+        <TopLine Value="121"/>
         <CursorPos X="57" Y="142"/>
-        <TopLine Value="121"/>
         <UsageCount Value="9"/>
       </Unit5>
       <Unit6>
         <Filename Value="../../lazarus/lcl/include/lclintfh.inc"/>
+        <TopLine Value="85"/>
         <CursorPos X="10" Y="102"/>
-        <TopLine Value="85"/>
         <UsageCount Value="9"/>
       </Unit6>
       <Unit7>
         <Filename Value="../../lazarus/lcl/include/lclintf.inc"/>
+        <TopLine Value="153"/>
         <CursorPos X="1" Y="160"/>
-        <TopLine Value="153"/>
         <UsageCount Value="9"/>
       </Unit7>
@@ -94 +102 @@
         <Filename Value="../../lazarus/lcl/graphics.pp"/>
         <UnitName Value="Graphics"/>
+        <TopLine Value="1282"/>
         <CursorPos X="15" Y="1299"/>
-        <TopLine Value="1282"/>
         <UsageCount Value="9"/>
       </Unit8>
       <Unit9>
         <Filename Value="../../lazarus/lcl/include/rasterimage.inc"/>
+        <TopLine Value="546"/>
         <CursorPos X="11" Y="553"/>
-        <TopLine Value="546"/>
         <UsageCount Value="9"/>
       </Unit9>
       <Unit10>
         <Filename Value="../../lazarus/lcl/include/picture.inc"/>
+        <TopLine Value="389"/>
         <CursorPos X="1" Y="411"/>
-        <TopLine Value="389"/>
         <UsageCount Value="6"/>
       </Unit10>
       <Unit11>
         <Filename Value="../../lazarus/lcl/interfaces/gtk2/gtk2lclintf.inc"/>
+        <TopLine Value="444"/>
         <CursorPos X="1" Y="461"/>
-        <TopLine Value="444"/>
         <UsageCount Value="9"/>
       </Unit11>
       <Unit12>
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/gtk2/src/gtk+/gdk/gdkimage.inc"/>
+        <TopLine Value="14"/>
         <CursorPos X="24" Y="21"/>
-        <TopLine Value="14"/>
         <UsageCount Value="9"/>
       </Unit12>
       <Unit13>
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/fcl-image/src/fpimage.inc"/>
+        <TopLine Value="313"/>
         <CursorPos X="24" Y="316"/>
-        <TopLine Value="313"/>
         <UsageCount Value="9"/>
       </Unit13>
       <Unit14>
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/fcl-image/src/fppalette.inc"/>
+        <TopLine Value="149"/>
         <CursorPos X="3" Y="151"/>
-        <TopLine Value="149"/>
         <UsageCount Value="9"/>
       </Unit14>
@@ -137 +145 @@
         <Filename Value="../../lazarus/lcl/graphtype.pp"/>
         <UnitName Value="GraphType"/>
+        <TopLine Value="171"/>
         <CursorPos X="3" Y="188"/>
-        <TopLine Value="171"/>
         <UsageCount Value="8"/>
       </Unit15>
       <Unit16>
         <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/systemh.inc"/>
+        <TopLine Value="496"/>
         <CursorPos X="11" Y="519"/>
-        <TopLine Value="496"/>
         <UsageCount Value="13"/>
       </Unit16>
@@ -151 +159 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="UDrawMethod"/>
-        <CursorPos X="29" Y="244"/>
-        <TopLine Value="237"/>
         <EditorIndex Value="2"/>
-        <UsageCount Value="50"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="690"/>
+        <CursorPos X="3" Y="709"/>
+        <UsageCount Value="52"/>
         <Loaded Value="True"/>
       </Unit17>
@@ -161 +170 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="UFastBitmap"/>
-        <CursorPos X="19" Y="110"/>
-        <TopLine Value="101"/>
         <EditorIndex Value="1"/>
-        <UsageCount Value="50"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="185"/>
+        <CursorPos X="39" Y="198"/>
+        <UsageCount Value="52"/>
         <Loaded Value="True"/>
       </Unit18>
       <Unit19>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/rasterimage.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/rasterimage.inc"/>
+        <TopLine Value="292"/>
         <CursorPos X="1" Y="308"/>
-        <TopLine Value="292"/>
         <UsageCount Value="12"/>
       </Unit19>
       <Unit20>
-        <Filename Value="bgrabitmap/bgradefaultbitmap.pas"/>
+        <Filename Value="BGRABitmap/bgradefaultbitmap.pas"/>
         <UnitName Value="BGRADefaultBitmap"/>
-        <CursorPos X="57" Y="292"/>
-        <TopLine Value="279"/>
-        <UsageCount Value="10"/>
+        <EditorIndex Value="13"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="655"/>
+        <CursorPos X="25" Y="666"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
       </Unit20>
       <Unit21>
         <Filename Value="bgrabitmap/bgrawinbitmap.pas"/>
         <UnitName Value="BGRAWinBitmap"/>
+        <TopLine Value="133"/>
         <CursorPos X="1" Y="146"/>
-        <TopLine Value="133"/>
         <UsageCount Value="10"/>
       </Unit21>
       <Unit22>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/extctrls.pp"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/extctrls.pp"/>
         <UnitName Value="ExtCtrls"/>
+        <TopLine Value="584"/>
         <CursorPos X="3" Y="597"/>
-        <TopLine Value="584"/>
         <UsageCount Value="9"/>
       </Unit22>
       <Unit23>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/winapih.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/winapih.inc"/>
+        <TopLine Value="32"/>
         <CursorPos X="10" Y="45"/>
-        <TopLine Value="32"/>
         <UsageCount Value="11"/>
       </Unit23>
       <Unit24>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/winapi.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/winapi.inc"/>
+        <TopLine Value="51"/>
         <CursorPos X="3" Y="53"/>
-        <TopLine Value="51"/>
         <UsageCount Value="11"/>
       </Unit24>
       <Unit25>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/graphics.pp"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/graphics.pp"/>
         <UnitName Value="Graphics"/>
+        <TopLine Value="1314"/>
         <CursorPos X="31" Y="1327"/>
-        <TopLine Value="1314"/>
         <UsageCount Value="11"/>
       </Unit25>
       <Unit26>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/objpas/classes/classesh.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/FPC/rtl/objpas/classes/classesh.inc"/>
+        <TopLine Value="1883"/>
         <CursorPos X="10" Y="1896"/>
-        <TopLine Value="1883"/>
         <UsageCount Value="11"/>
       </Unit26>
       <Unit27>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/inc/heaph.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/FPC/rtl/inc/heaph.inc"/>
+        <TopLine Value="75"/>
         <CursorPos X="31" Y="88"/>
-        <TopLine Value="75"/>
         <UsageCount Value="9"/>
       </Unit27>
       <Unit28>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/inc/heap.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/FPC/rtl/inc/heap.inc"/>
+        <TopLine Value="309"/>
         <CursorPos X="3" Y="311"/>
-        <TopLine Value="309"/>
         <UsageCount Value="8"/>
       </Unit28>
@@ -234 +247 @@
         <Filename Value="bgrabitmap/bgrabitmaptypes.pas"/>
         <UnitName Value="BGRABitmapTypes"/>
+        <TopLine Value="24"/>
         <CursorPos X="3" Y="37"/>
-        <TopLine Value="24"/>
         <UsageCount Value="10"/>
       </Unit29>
       <Unit30>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/graphtype.pp"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/graphtype.pp"/>
         <UnitName Value="GraphType"/>
+        <TopLine Value="271"/>
         <CursorPos X="23" Y="292"/>
-        <TopLine Value="271"/>
         <UsageCount Value="9"/>
       </Unit30>
@@ -248 +261 @@
         <Filename Value="UBitmaps.pas"/>
         <UnitName Value="UBitmaps"/>
+        <TopLine Value="1"/>
         <CursorPos X="41" Y="62"/>
-        <TopLine Value="1"/>
         <UsageCount Value="18"/>
       </Unit31>
       <Unit32>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/packages/fcl-image/src/fpimage.pp"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/FPC/packages/fcl-image/src/fpimage.pp"/>
         <UnitName Value="FPimage"/>
+        <TopLine Value="23"/>
         <CursorPos X="4" Y="35"/>
-        <TopLine Value="23"/>
         <UsageCount Value="8"/>
       </Unit32>
       <Unit33>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/canvas.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/Lazarus/lcl/include/canvas.inc"/>
+        <TopLine Value="1456"/>
         <CursorPos X="1" Y="1471"/>
-        <TopLine Value="1456"/>
         <UsageCount Value="8"/>
       </Unit33>
       <Unit34>
-        <Filename Value="../../../Projekty2/FreePascalManager/trunk/Instance/1/FPC/rtl/win/wininc/func.inc"/>
+        <Filename Value="../../FreePascalManager/trunk/Instance/1/FPC/rtl/win/wininc/func.inc"/>
+        <TopLine Value="780"/>
         <CursorPos X="10" Y="793"/>
-        <TopLine Value="780"/>
         <UsageCount Value="8"/>
       </Unit34>
@@ -274 +287 @@
         <Filename Value="bgrabitmap/bgrablend.pas"/>
         <UnitName Value="BGRABlend"/>
+        <TopLine Value="217"/>
         <CursorPos X="3" Y="219"/>
-        <TopLine Value="217"/>
         <UsageCount Value="8"/>
       </Unit35>
@@ -281 +294 @@
         <Filename Value="BGRABitmap/bgrabitmap.pas"/>
         <UnitName Value="BGRABitmap"/>
+        <TopLine Value="52"/>
         <CursorPos X="23" Y="72"/>
-        <TopLine Value="52"/>
         <UsageCount Value="18"/>
       </Unit36>
@@ -288 +301 @@
         <Filename Value="BGRABitmap/bgragtkbitmap.pas"/>
         <UnitName Value="BGRAGtkBitmap"/>
+        <TopLine Value="29"/>
         <CursorPos X="36" Y="36"/>
-        <TopLine Value="29"/>
         <UsageCount Value="18"/>
       </Unit37>
@@ -295 +308 @@
         <Filename Value="BGRABitmap/bgraresample.pas"/>
         <UnitName Value="bgraresample"/>
+        <TopLine Value="629"/>
         <CursorPos X="30" Y="638"/>
-        <TopLine Value="629"/>
         <UsageCount Value="18"/>
       </Unit38>
@@ -302 +315 @@
         <Filename Value="../../../lazarus/components/opengl/glqtcontext.pas"/>
         <UnitName Value="GLQTContext"/>
+        <TopLine Value="1"/>
         <CursorPos X="1" Y="1"/>
-        <TopLine Value="1"/>
         <UsageCount Value="18"/>
       </Unit39>
@@ -309 +322 @@
         <Filename Value="../../../lazarus/components/opengl/openglcontext.pas"/>
         <UnitName Value="OpenGLContext"/>
+        <TopLine Value="135"/>
         <CursorPos X="34" Y="152"/>
-        <TopLine Value="135"/>
         <UsageCount Value="18"/>
       </Unit40>
@@ -316 +329 @@
         <Filename Value="../../../lazarus/components/opengl/glgtkglxcontext.pas"/>
         <UnitName Value="GLGtkGlxContext"/>
+        <TopLine Value="699"/>
         <CursorPos X="3" Y="704"/>
-        <TopLine Value="699"/>
         <UsageCount Value="18"/>
       </Unit41>
@@ -323 +336 @@
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/opengl/src/gl.pp"/>
         <UnitName Value="GL"/>
+        <TopLine Value="1502"/>
         <CursorPos X="3" Y="1499"/>
-        <TopLine Value="1502"/>
         <UsageCount Value="18"/>
       </Unit42>
       <Unit43>
         <Filename Value="../../../lazarus/lcl/include/customform.inc"/>
+        <TopLine Value="898"/>
         <CursorPos X="38" Y="928"/>
-        <TopLine Value="898"/>
         <UsageCount Value="17"/>
       </Unit43>
       <Unit44>
         <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/heaph.inc"/>
+        <TopLine Value="63"/>
         <CursorPos X="43" Y="80"/>
-        <TopLine Value="63"/>
         <UsageCount Value="9"/>
       </Unit44>
       <Unit45>
         <Filename Value="../../../lazarus/lcl/include/custombitmap.inc"/>
+        <TopLine Value="21"/>
         <CursorPos X="1" Y="38"/>
-        <TopLine Value="21"/>
         <UsageCount Value="9"/>
       </Unit45>
@@ -348 +361 @@
         <Filename Value="/usr/share/fpcsrc/2.4.0/packages/opengl/src/glext.pp"/>
         <UnitName Value="GLext"/>
+        <TopLine Value="2783"/>
         <CursorPos X="15" Y="2800"/>
-        <TopLine Value="2783"/>
         <UsageCount Value="15"/>
       </Unit46>
       <Unit47>
         <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/i386/i386.inc"/>
+        <TopLine Value="185"/>
         <CursorPos X="11" Y="202"/>
-        <TopLine Value="185"/>
         <UsageCount Value="13"/>
       </Unit47>
       <Unit48>
         <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/generic.inc"/>
+        <TopLine Value="245"/>
         <CursorPos X="3" Y="250"/>
-        <TopLine Value="245"/>
         <UsageCount Value="13"/>
       </Unit48>
       <Unit49>
         <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/inc/system.inc"/>
+        <TopLine Value="188"/>
         <CursorPos X="3" Y="190"/>
-        <TopLine Value="188"/>
         <UsageCount Value="13"/>
       </Unit49>
+      <Unit50>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/fpc/2.6.0/source/rtl/inc/mathh.inc"/>
+        <EditorIndex Value="14"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="65"/>
+        <CursorPos X="14" Y="78"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit50>
+      <Unit51>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/components/opengl/openglcontext.pas"/>
+        <UnitName Value="OpenGLContext"/>
+        <EditorIndex Value="9"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="387"/>
+        <CursorPos X="3" Y="389"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit51>
+      <Unit52>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/components/opengl/glwin32wglcontext.pas"/>
+        <UnitName Value="GLWin32WGLContext"/>
+        <EditorIndex Value="10"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="236"/>
+        <CursorPos X="3" Y="240"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit52>
+      <Unit53>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/fpc/2.6.0/source/rtl/win/wininc/func.inc"/>
+        <EditorIndex Value="12"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="988"/>
+        <CursorPos X="10" Y="1001"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit53>
+      <Unit54>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/fpc/2.6.0/source/rtl/win/wininc/ascdef.inc"/>
+        <EditorIndex Value="11"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="236"/>
+        <CursorPos X="10" Y="249"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit54>
+      <Unit55>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/fpc/2.6.0/source/rtl/objpas/objpas.pp"/>
+        <UnitName Value="objpas"/>
+        <EditorIndex Value="8"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="15"/>
+        <CursorPos X="8" Y="28"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit55>
+      <Unit56>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/lcl/graphics.pp"/>
+        <UnitName Value="Graphics"/>
+        <EditorIndex Value="4"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1292"/>
+        <CursorPos X="15" Y="1305"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit56>
+      <Unit57>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/lcl/include/rasterimage.inc"/>
+        <EditorIndex Value="5"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="247"/>
+        <CursorPos X="1" Y="260"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit57>
+      <Unit58>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/fpc/2.6.0/source/rtl/inc/systemh.inc"/>
+        <EditorIndex Value="3"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="501"/>
+        <CursorPos X="11" Y="514"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit58>
+      <Unit59>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/lcl/include/custombitmap.inc"/>
+        <EditorIndex Value="7"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="403"/>
+        <CursorPos X="1" Y="416"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit59>
+      <Unit60>
+        <Filename Value="../../../Lazarus/0.9.31_2.6.0/lcl/include/bitmapcanvas.inc"/>
+        <EditorIndex Value="6"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="90"/>
+        <CursorPos X="1" Y="103"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit60>
     </Units>
     <JumpHistory Count="30" HistoryIndex="29">
       <Position1>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="248" Column="1" TopLine="224"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="233" Column="30" TopLine="210"/>
       </Position1>
       <Position2>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="250" Column="1" TopLine="224"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="117" Column="1" TopLine="112"/>
       </Position2>
       <Position3>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="251" Column="1" TopLine="224"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="190" Column="12" TopLine="178"/>
       </Position3>
       <Position4>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="254" Column="1" TopLine="226"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="145" Column="21" TopLine="138"/>
       </Position4>
       <Position5>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="256" Column="1" TopLine="228"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="142" Column="1" TopLine="137"/>
       </Position5>
       <Position6>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="257" Column="1" TopLine="229"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="192" Column="14" TopLine="187"/>
       </Position6>
       <Position7>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="105" Column="30" TopLine="98"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="199" Column="1" TopLine="184"/>
       </Position7>
       <Position8>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="260" Column="97" TopLine="233"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="156" Column="1" TopLine="143"/>
       </Position8>
       <Position9>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="237" Column="1" TopLine="218"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="189" Column="82" TopLine="177"/>
       </Position9>
       <Position10>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="224" Column="54" TopLine="207"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="144" Column="43" TopLine="136"/>
       </Position10>
       <Position11>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="237" Column="1" TopLine="220"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="185" Column="20" TopLine="183"/>
       </Position11>
       <Position12>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="240" Column="26" TopLine="223"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="191" Column="3" TopLine="189"/>
       </Position12>
       <Position13>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="237" Column="117" TopLine="220"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="236" Column="58" TopLine="215"/>
       </Position13>
       <Position14>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="240" Column="1" TopLine="224"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="124" Column="14" TopLine="107"/>
       </Position14>
       <Position15>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="281" Column="45" TopLine="263"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="206" Column="19" TopLine="203"/>
       </Position15>
       <Position16>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="145" Column="49" TopLine="130"/>
+        <Caret Line="117" Column="3" TopLine="115"/>
       </Position16>
       <Position17>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="182" Column="3" TopLine="173"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="118" Column="1" TopLine="113"/>
       </Position17>
       <Position18>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="257" Column="42" TopLine="243"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="119" Column="1" TopLine="113"/>
       </Position18>
       <Position19>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="336" Column="18" TopLine="311"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="242" Column="1" TopLine="223"/>
       </Position19>
       <Position20>
-        <Filename Value="UDrawMethod.pas"/>
-        <Caret Line="234" Column="38" TopLine="220"/>
+        <Filename Value="UMainForm.pas"/>
+        <Caret Line="243" Column="1" TopLine="223"/>
       </Position20>
       <Position21>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="117" Column="26" TopLine="106"/>
+        <Caret Line="244" Column="1" TopLine="223"/>
       </Position21>
       <Position22>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="180" Column="3" TopLine="178"/>
+        <Caret Line="245" Column="1" TopLine="223"/>
       </Position22>
       <Position23>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="182" Column="9" TopLine="179"/>
+        <Caret Line="120" Column="1" TopLine="107"/>
       </Position23>
       <Position24>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="186" Column="92" TopLine="177"/>
+        <Caret Line="121" Column="1" TopLine="107"/>
       </Position24>
       <Position25>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="183" Column="1" TopLine="177"/>
+        <Caret Line="122" Column="1" TopLine="107"/>
       </Position25>
       <Position26>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="184" Column="1" TopLine="177"/>
+        <Caret Line="123" Column="1" TopLine="107"/>
       </Position26>
       <Position27>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="140" Column="29" TopLine="133"/>
+        <Caret Line="129" Column="37" TopLine="115"/>
       </Position27>
       <Position28>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="142" Column="29" TopLine="135"/>
+        <Caret Line="148" Column="3" TopLine="139"/>
       </Position28>
       <Position29>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="141" Column="29" TopLine="134"/>
+        <Caret Line="133" Column="32" TopLine="116"/>
       </Position29>
       <Position30>
         <Filename Value="UMainForm.pas"/>
-        <Caret Line="146" Column="20" TopLine="135"/>
+        <Caret Line="134" Column="32" TopLine="117"/>
       </Position30>
     </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="11"/>
     <Target>
       <Filename Value="GraphicTest"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)/"/>
-      <OtherUnitFiles Value="BGRABitmap/"/>
+      <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
     <Linking>
       <Options>

GraphicTest/GraphicTest.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, lazopenglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap;
+  Forms, lazopenglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
+  bgrabitmappack;
 
 {$R *.res}

GraphicTest/UDrawMethod.pas

@@ -41 +41 @@
   TDrawMethodClass = class of TDrawMethod;
 
+  { TDummyMethod }
+
+  TDummyMethod = class(TDrawMethod)
+    constructor Create; override;
+    procedure DrawFrame(FastBitmap: TFastBitmap); override;
+  end;
+
   { TCanvasPixels }
 
@@ -84 +91 @@
 
   TBitmapRawImageDataPaintBox = class(TDrawMethod)
+    constructor Create; override;
+    procedure DrawFrame(FastBitmap: TFastBitmap); override;
+  end;
+
+  { TBitmapRawImageDataMove }
+
+  TBitmapRawImageDataMove = class(TDrawMethod)
     constructor Create; override;
     procedure DrawFrame(FastBitmap: TFastBitmap); override;
@@ -121 +135 @@
 
 const
-  DrawMethodClasses: array[0..8] of TDrawMethodClass = (
+  DrawMethodClasses: array[0..10] of TDrawMethodClass = (
     TCanvasPixels, TCanvasPixelsUpdateLock, TLazIntfImageColorsCopy,
     TLazIntfImageColorsNoCopy, TBitmapRawImageData, TBitmapRawImageDataPaintBox,
-    TBGRABitmapPaintBox, TOpenGLMethod, TOpenGLPBOMethod);
+    TBitmapRawImageDataMove, TBGRABitmapPaintBox, TOpenGLMethod, TOpenGLPBOMethod,
+    TDummyMethod);
 
 implementation
+
+{ TDummyMethod }
+
+constructor TDummyMethod.Create;
+begin
+  inherited Create;
+  Caption := 'Dummy';
+end;
+
+procedure TDummyMethod.DrawFrame(FastBitmap: TFastBitmap);
+var
+  Y, X: Integer;
+  PixelPtr: PInteger;
+  RowPtr: PInteger;
+  P: TPixelFormat;
+  RawImage: TRawImage;
+  BytePerPixel: Integer;
+  BytePerRow: Integer;
+begin
+  P := Bitmap.PixelFormat;
+    with FastBitmap do
+    try
+      //Bitmap.BeginUpdate(False);
+      RawImage := Bitmap.RawImage;
+      RowPtr := PInteger(RawImage.Data);
+      BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+      BytePerRow := RawImage.Description.BytesPerLine;
+    finally
+      //Bitmap.EndUpdate(False);
+    end;
+end;
+
+{ TBitmapRawImageDataMove }
+
+constructor TBitmapRawImageDataMove.Create;
+begin
+  inherited;
+  Caption := 'TBitmap.RawImage.Data Move';
+end;
+
+procedure TBitmapRawImageDataMove.DrawFrame(FastBitmap: TFastBitmap);
+var
+  Y, X: Integer;
+  PixelPtr: PInteger;
+  RowPtr: PInteger;
+  P: TPixelFormat;
+  RawImage: TRawImage;
+  BytePerPixel: Integer;
+  BytePerRow: Integer;
+begin
+  P := Bitmap.PixelFormat;
+    with FastBitmap do
+    try
+      Bitmap.BeginUpdate(False);
+      RawImage := Bitmap.RawImage;
+      RowPtr := PInteger(RawImage.Data);
+      BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+      BytePerRow := RawImage.Description.BytesPerLine;
+      Move(FastBitmap.PixelsData^, RowPtr^, Size.Y * BytePerRow);
+    finally
+      Bitmap.EndUpdate(False);
+    end;
+end;
 
 { TOpenGLPBOMethod }
@@ -455 +533 @@
 
 procedure TBitmapRawImageData.DrawFrame(FastBitmap: TFastBitmap);
-type
-  TFastBitmapPixelComponents = packed record
-  end;
 var
   Y, X: Integer;

GraphicTest/UFastBitmap.pas

@@ -31 +31 @@
     property Size: TPoint read FSize write SetSize;
     property Pixels[X, Y: Integer]: TFastBitmapPixel read GetPixel write SetPixel;
+    property PixelsData: PByte read FPixelsData;
   end;
 

GraphicTest/UMainForm.lfm

@@ -1 +1 @@
 object MainForm: TMainForm
-  Left = 214
-  Height = 393
-  Top = 106
-  Width = 680
+  Left = 187
+  Height = 421
+  Top = 68
+  Width = 735
   Caption = 'Graphic test'
-  ClientHeight = 393
-  ClientWidth = 680
+  ClientHeight = 421
+  ClientWidth = 735
   OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnShow = FormShow
   LCLVersion = '0.9.31'
   object PageControl1: TPageControl
-    Left = 312
-    Height = 373
+    Left = 360
+    Height = 401
     Top = 16
-    Width = 365
-    ActivePage = TabSheet3
+    Width = 372
+    ActivePage = TabSheet1
     Anchors = [akTop, akLeft, akRight, akBottom]
-    TabIndex = 2
+    TabIndex = 0
     TabOrder = 0
     object TabSheet1: TTabSheet
       Caption = 'TImage'
-      ClientHeight = 346
-      ClientWidth = 361
+      ClientHeight = 375
+      ClientWidth = 364
       object Image1: TImage
         Left = 6
-        Height = 278
+        Height = 307
         Top = 7
-        Width = 351
+        Width = 354
         Anchors = [akTop, akLeft, akRight, akBottom]
       end
@@ -48 +49 @@
     end
   end
-  object ButtonStart: TButton
-    Left = 7
-    Height = 25
-    Top = 9
-    Width = 75
-    Caption = 'Start'
-    OnClick = ButtonStartClick
-    TabOrder = 1
-  end
-  object Label1: TLabel
-    Left = 9
-    Height = 14
-    Top = 95
-    Width = 24
-    Caption = 'FPS:'
-    ParentColor = False
-  end
-  object Label2: TLabel
-    Left = 128
-    Height = 14
-    Top = 95
-    Width = 10
-    Caption = '   '
-    ParentColor = False
-  end
-  object ButtonStop: TButton
-    Left = 95
-    Height = 25
-    Top = 9
-    Width = 75
-    Caption = 'Stop'
-    Enabled = False
-    OnClick = ButtonStopClick
-    TabOrder = 2
-  end
-  object Label3: TLabel
-    Left = 9
-    Height = 14
-    Top = 112
-    Width = 83
-    Caption = 'Frame duration'
-    ParentColor = False
-  end
-  object Label4: TLabel
-    Left = 128
-    Height = 14
-    Top = 112
-    Width = 10
-    Caption = '   '
-    ParentColor = False
-  end
-  object ListView1: TListView
+  object ListViewMethods: TListView
     Left = 8
-    Height = 253
-    Top = 136
-    Width = 296
+    Height = 345
+    Top = 8
+    Width = 344
     Anchors = [akTop, akLeft, akBottom]
     Columns = <    
       item
         Caption = 'Method'
-        Width = 140
+        Width = 200
       end    
       item
@@ -118 +68 @@
         Width = 75
       end>
-    TabOrder = 3
+    OwnerData = True
+    ReadOnly = True
+    RowSelect = True
+    TabOrder = 1
     ViewStyle = vsReport
+    OnData = ListViewMethodsData
+    OnSelectItem = ListViewMethodsSelectItem
+  end
+  object ButtonSingleTest: TButton
+    Left = 8
+    Height = 25
+    Top = 360
+    Width = 115
+    Anchors = [akLeft, akBottom]
+    Caption = 'Test one method'
+    OnClick = ButtonSingleTestClick
+    TabOrder = 2
   end
   object ButtonBenchmark: TButton
-    Left = 229
+    Left = 136
     Height = 25
-    Top = 101
-    Width = 75
-    Caption = 'Benchmark'
+    Top = 360
+    Width = 112
+    Anchors = [akLeft, akBottom]
+    Caption = 'Test all methods'
     OnClick = ButtonBenchmarkClick
-    TabOrder = 4
-  end
-  object ComboBox1: TComboBox
-    Left = 7
-    Height = 25
-    Top = 64
-    Width = 297
-    ItemHeight = 0
-    Style = csDropDownList
-    TabOrder = 5
-  end
-  object Label5: TLabel
-    Left = 9
-    Height = 14
-    Top = 47
-    Width = 46
-    Caption = 'Method:'
-    ParentColor = False
+    TabOrder = 3
   end
   object FloatSpinEdit1: TFloatSpinEdit
-    Left = 175
+    Left = 160
     Height = 21
-    Top = 103
-    Width = 50
+    Top = 392
+    Width = 58
+    Anchors = [akLeft, akBottom]
     Increment = 1
     MaxValue = 100
     MinValue = 0
-    TabOrder = 6
+    TabOrder = 4
     Value = 1
+  end
+  object ButtonStop: TButton
+    Left = 256
+    Height = 25
+    Top = 360
+    Width = 75
+    Anchors = [akLeft, akBottom]
+    Caption = 'Stop'
+    OnClick = ButtonStopClick
+    TabOrder = 5
+  end
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 395
+    Width = 137
+    Anchors = [akLeft, akBottom]
+    Caption = 'Single method test duration:'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 224
+    Height = 14
+    Top = 395
+    Width = 6
+    Anchors = [akLeft, akBottom]
+    Caption = 's'
+    ParentColor = False
   end
   object Timer1: TTimer
     Interval = 500
     OnTimer = Timer1Timer
-    left = 209
-    top = 16
+    left = 238
+    top = 136
   end
 end

GraphicTest/UMainForm.pas

@@ -20 +20 @@
 
   TMainForm = class(TForm)
+    ButtonStop: TButton;
     ButtonBenchmark: TButton;
-    ButtonStart: TButton;
-    ButtonStop: TButton;
-    ComboBox1: TComboBox;
+    ButtonSingleTest: TButton;
     FloatSpinEdit1: TFloatSpinEdit;
     Image1: TImage;
     Label1: TLabel;
     Label2: TLabel;
-    Label3: TLabel;
-    Label4: TLabel;
-    Label5: TLabel;
-    ListView1: TListView;
+    ListViewMethods: TListView;
     PageControl1: TPageControl;
     PaintBox1: TPaintBox;
@@ -39 +35 @@
     Timer1: TTimer;
     procedure ButtonBenchmarkClick(Sender: TObject);
-    procedure ButtonStartClick(Sender: TObject);
+    procedure ButtonSingleTestClick(Sender: TObject);
     procedure ButtonStopClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure ListViewMethodsData(Sender: TObject; Item: TListItem);
+    procedure ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
+      Selected: Boolean);
     procedure Timer1Timer(Sender: TObject);
   private
@@ -50 +50 @@
     TextureData: Pointer;
     MethodIndex: Integer;
+    SingleTestActive: Boolean;
+    AllTestActive: Boolean;
     procedure OpenGLControl1Resize(Sender: TObject);
     procedure InitGL;
+    procedure UpdateMethodList;
+    procedure UpdateInterface;
   public
     DrawMethods: TObjectList; // TObjectList<TDrawMethod>
@@ -86 +90 @@
   Bitmap.PixelFormat := pf24bit;
   Image1.Picture.Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
+  Image1.Picture.Bitmap.PixelFormat := pf32bit;
   Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
 
@@ -100 +105 @@
 
   DrawMethods := TObjectList.Create;
-  ComboBox1.Clear;
   for I := 0 to High(DrawMethodClasses) do begin
     NewDrawMethod := DrawMethodClasses[I].Create;
@@ -109 +113 @@
     NewDrawMethod.Init;
     DrawMethods.Add(NewDrawMethod);
-    ComboBox1.Items.Add(NewDrawMethod.Caption);
-  end;
-  ComboBox1.ItemIndex := DrawMethods.Count - 1;
-end;
-
-procedure TMainForm.ButtonStartClick(Sender: TObject);
-begin
-  MethodIndex := ComboBox1.ItemIndex;
-  ButtonStop.Enabled := True;
-  ButtonStart.Enabled := False;
-  Timer1.Enabled := True;
-  if MethodIndex >= 0 then
-  with TDrawMethod(DrawMethods[MethodIndex]) do begin
-    PageControl1.TabIndex := Integer(PaintObject);
-    Application.ProcessMessages;
-    repeat
-      DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
-      SceneIndex := (SceneIndex + 1) mod Scenes.Count;
+  end;
+end;
+
+procedure TMainForm.ButtonSingleTestClick(Sender: TObject);
+begin
+  try
+    SingleTestActive := True;
+    UpdateInterface;
+    Timer1.Enabled := True;
+    MethodIndex := ListViewMethods.Selected.Index;
+    Timer1.Enabled := True;
+    if MethodIndex >= 0 then
+    with TDrawMethod(DrawMethods[MethodIndex]) do begin
+      PageControl1.TabIndex := Integer(PaintObject);
       Application.ProcessMessages;
-    until not ButtonStop.Enabled;
-  end;
-  ButtonStopClick(Self);
+      repeat
+        DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
+        SceneIndex := (SceneIndex + 1) mod Scenes.Count;
+        Application.ProcessMessages;
+      until not SingleTestActive;
+    end;
+  finally
+    Timer1.Enabled := False;
+    SingleTestActive := False;
+    UpdateInterface;
+  end;
 end;
 
 procedure TMainForm.ButtonBenchmarkClick(Sender: TObject);
 var
-  NewItem: TListItem;
   I: Integer;
   C: Integer;
   StartTime: TDateTime;
 begin
-  Timer1.Enabled := True;
-  with ListView1, Items do
   try
-    //BeginUpdate;
-    Clear;
+    AllTestActive := True;
+    UpdateInterface;
+    Timer1.Enabled := True;
+    with ListViewMethods, Items do
     for I := 0 to DrawMethods.Count - 1 do
     with TDrawMethod(DrawMethods[I]) do begin
@@ -154 +161 @@
         SceneIndex := (SceneIndex + 1) mod Scenes.Count;
         Application.ProcessMessages;
-      until (NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value;
-      NewItem := Add;
-      NewItem.Caption := Caption;
-      NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
-      NewItem.SubItems.Add(FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3)));
+      until ((NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value) or not AllTestActive;
     end;
   finally
-    //EndUpdate;
+    Timer1.Enabled := False;
+    AllTestActive := False;
+    UpdateInterface;
   end;
 end;
@@ -167 +172 @@
 procedure TMainForm.ButtonStopClick(Sender: TObject);
 begin
-  ButtonStart.Enabled := True;
-  ButtonStop.Enabled := False;
+  SingleTestActive := False;
+  AllTestActive := False;
 end;
 
@@ -184 +189 @@
 end;
 
+procedure TMainForm.FormShow(Sender: TObject);
+begin
+  UpdateMethodList;
+  UpdateInterface;
+end;
+
+procedure TMainForm.ListViewMethodsData(Sender: TObject; Item: TListItem);
+begin
+  if (Item.Index >= 0) and (Item.Index < DrawMethods.Count) then
+  with TDrawMethod(DrawMethods[Item.Index]) do begin
+    Item.Caption := Caption;
+    if FrameDuration > 0 then
+      Item.SubItems.Add(FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3)))
+      else Item.SubItems.Add('0');
+    Item.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)) + ' ms');
+  end;
+end;
+
+procedure TMainForm.ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
+  Selected: Boolean);
+begin
+  UpdateInterface;
+end;
+
 procedure TMainForm.Timer1Timer(Sender: TObject);
 begin
-  if (MethodIndex >= 0) then
-  with TDrawMethod(DrawMethods[MethodIndex]) do begin
-    if (FrameDuration > 0) then
-      Label2.Caption := FloatToStr(RoundTo(1 / (FrameDuration / OneSecond), -3))
-      else Label2.Caption := '0';
-    Label4.Caption := FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)) + ' ms';
-  end;
+  UpdateMethodList;
 end;
 
@@ -220 +243 @@
 end;
 
+procedure TMainForm.UpdateMethodList;
+begin
+  ListViewMethods.Items.Count := DrawMethods.Count;
+  ListViewMethods.Refresh;
+end;
+
+procedure TMainForm.UpdateInterface;
+begin
+  ButtonSingleTest.Enabled := not SingleTestActive and not AllTestActive and Assigned(ListViewMethods.Selected);
+  ButtonBenchmark.Enabled := not AllTestActive and not SingleTestActive;
+  ButtonStop.Enabled := SingleTestActive or AllTestActive;
+end;
+
 end.