Changeset 472 for GraphicTest

GraphicTest/GraphicTest.lpi

-              r470
+              r472
         <Filename Value="Methods/ULazIntfImageColorsCopy.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="ULazIntfImageColorsCopy"/>
       </Unit8>
       <Unit9>
 …
         <Filename Value="Methods/UOpenGLPBOMethod.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="UOpenGLPBOMethod"/>
       </Unit16>
       <Unit17>
 …
     </CodeGeneration>
     <Linking>
-      <Debugging>
-        <UseExternalDbgSyms Value="True"/>
-      </Debugging>
       <Options>
         <Win32>

GraphicTest/Packages/bgrabitmap/bgraanimatedgif.pas

-              r452
+              r472
     FTimeAccumulator: double;
     FCurrentImage, FWantedImage: integer;
+    FFullAnimationTime: double;
     FPreviousDisposeMode: TDisposeMode;
 …
     function GetCount: integer;
+    function GetTimeUntilNextImage: integer;
     procedure Render(StretchWidth, StretchHeight: integer);
     procedure UpdateSimple(Canvas: TCanvas; ARect: TRect;
 …
     BackgroundMode: TGifBackgroundMode;
     constructor Create(filename: string);
+    constructor Create(filenameUTF8: string);
     constructor Create(stream: TStream);
     constructor Create; override;
 …
     procedure LoadFromStream(Stream: TStream); override;
     procedure SaveToStream(Stream: TStream); override;
+    procedure LoadFromFile(const AFilenameUTF8: string); override;
+    procedure SaveToFile(const AFilenameUTF8: string); override;
     class function GetFileExtensions: string; override;
 …
     property MemBitmap: TBGRABitmap Read GetMemBitmap;
     property CurrentImage: integer Read FCurrentImage Write SetCurrentImage;
+    property TimeUntilNextImageMs: integer read GetTimeUntilNextImage;
   end;
 …
 implementation
 uses BGRABlend;
+uses BGRABlend, lazutf8classes;
 const
+  {$IFDEF ENDIAN_LITTLE}
   AlphaMask = $FF000000;
+  {$ELSE}
+  AlphaMask = $000000FF;
+  {$ENDIF}
 type
 …
     if not FPaused then
       FTimeAccumulator += (curDate - FPrevDate) * 24 * 60 * 60 * 1000;
+    if FFullAnimationTime > 0 then FTimeAccumulator:= frac(FTimeAccumulator/FFullAnimationTime)*FFullAnimationTime;
     nextImage := FCurrentImage;
     while FTimeAccumulator > FImages[nextImage].Delay do
 …
 end;
 constructor TBGRAAnimatedGif.Create(filename: string);
+function TBGRAAnimatedGif.GetTimeUntilNextImage: integer;
 var
+  Stream: TFileStream;
+  acc: double;
+begin
+  if Count <= 1 then result := 60*1000 else
+  if (FWantedImage <> -1) or (FCurrentImage = -1) then
+    result := 0
+  else
+  begin
+    acc := FTimeAccumulator;
+    if not FPaused then acc += (Now- FPrevDate) * 24 * 60 * 60 * 1000;
+    if acc >= FImages[FCurrentImage].Delay then
+      result := 0
+    else
+      result := round(FImages[FCurrentImage].Delay-FTimeAccumulator);
+  end;
+end;
+constructor TBGRAAnimatedGif.Create(filenameUTF8: string);
+var
+  Stream: TFileStreamUTF8;
 begin
   inherited Create;
   Init;
   Stream := TFileStream.Create(filename, fmOpenRead);
+  Stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead or fmShareDenyWrite);
   LoadFromStream(Stream);
   Stream.Free;
 …
 end;
+procedure TBGRAAnimatedGif.LoadFromFile(const AFilenameUTF8: string);
+var stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+procedure TBGRAAnimatedGif.SaveToFile(const AFilenameUTF8: string);
+var
+  Stream: TFileStreamUTF8;
+begin
+  Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate);
+  try
+    SaveToStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
 {$HINTS OFF}
 procedure TBGRAAnimatedGif.LoadImages(stream: TStream);
 …
     stridx:   longint;
     bitbuf, bitsinbuf: longint;
     bytbuf:   array[0..255] of byte;
+    bytbuf:   packed array[0..255] of byte;
     bytinbuf, bytbufidx: byte;
     endofsrc: boolean;
 …
   begin
     stream.Read(GIFImageDescriptor, sizeof(GIFImageDescriptor));
+    GIFImageDescriptor.Width := LEtoN(GIFImageDescriptor.Width);
+    GIFImageDescriptor.Height := LEtoN(GIFImageDescriptor.Height);
+    GIFImageDescriptor.x := LEtoN(GIFImageDescriptor.x);
+    GIFImageDescriptor.y := LEtoN(GIFImageDescriptor.y);
     if (GIFImageDescriptor.flags and GIFImageDescriptor_LocalColorTableFlag =
       GIFImageDescriptor_LocalColorTableFlag) then
 …
     Clear;
     SetLength(FImages, NbImages);
+    FFullAnimationTime:= 0;
     for i := 0 to Count - 1 do
+    begin
       FImages[i] := NewImages[i];
+      FFullAnimationTime += NewImages[i].Delay;
+    end;
   end;
 …
           mincount := sizeof(GIFGraphicControlExtension);
           stream.Read(GIFGraphicControlExtension, mincount);
+          GIFGraphicControlExtension.delaytime := LEtoN(GIFGraphicControlExtension.delaytime);
           if GIFGraphicControlExtension.flags and
 …
   begin
     stream.Read(GIFScreenDescriptor, sizeof(GIFScreenDescriptor));
+    GIFScreenDescriptor.Width := LEtoN(GIFScreenDescriptor.Width);
+    GIFScreenDescriptor.Height := LEtoN(GIFScreenDescriptor.Height);
     FWidth  := GIFScreenDescriptor.Width;
     FHeight := GIFScreenDescriptor.Height;

GraphicTest/Packages/bgrabitmap/bgrabitmap.pas

-              r452
+              r472
 implementation
+uses GraphType, BGRABitmapTypes;
+uses GraphType, BGRABitmapTypes, BGRAReadBMP, BGRAReadGif,
+  BGRAReadIco, bgrareadjpeg, BGRAReadLzp, BGRAReadPCX,
+  BGRAReadPng, BGRAReadPSD, BGRAReadTGA, BGRAReadXPM,
+  BGRAWriteLzp;
 var

GraphicTest/Packages/bgrabitmap/bgrabitmappack.lpk

-              r452
+              r472
         </SyntaxOptions>
       </Parsing>
+      <CodeGeneration>
+        <Optimizations>
+          <VariablesInRegisters Value="True"/>
+          <OptimizationLevel Value="3"/>
+        </Optimizations>
+      </CodeGeneration>
       <Linking>
         <Debugging>
           <DebugInfoType Value="dsStabs"/>
+          <GenerateDebugInfo Value="False"/>
         </Debugging>
       </Linking>
 …
     <Description Value="Drawing routines with alpha blending and antialiasing"/>
     <License Value="modified LGPL"/>
     <Version Major="6" Minor="2"/>
     <Files Count="56">
+    <Version Major="8" Minor="1"/>
+    <Files Count="91">
       <Item1>
         <Filename Value="bgraanimatedgif.pas"/>
 …
       </Item4>
       <Item5>
+        <Filename Value="bgracanvas.pas"/>
+        <UnitName Value="BGRACanvas"/>
+      </Item5>
+      <Item6>
+        <Filename Value="bgracanvas2d.pas"/>
+        <UnitName Value="BGRACanvas2D"/>
+      </Item6>
+      <Item7>
+        <Filename Value="bgracolorint.pas"/>
+        <UnitName Value="BGRAColorInt"/>
+      </Item7>
+      <Item8>
         <Filename Value="bgracompressablebitmap.pas"/>
         <UnitName Value="BGRACompressableBitmap"/>
+      </Item5>
+      <Item6>
+      </Item8>
+      <Item9>
+        <Filename Value="bgracoordpool3d.pas"/>
+        <UnitName Value="BGRACoordPool3D"/>
+      </Item9>
+      <Item10>
         <Filename Value="bgradefaultbitmap.pas"/>
         <UnitName Value="BGRADefaultBitmap"/>
       </Item6>
       <Item7>
+      </Item10>
+      <Item11>
         <Filename Value="bgradnetdeserial.pas"/>
         <UnitName Value="BGRADNetDeserial"/>
+      </Item7>
+      <Item8>
+      </Item11>
+      <Item12>
+        <Filename Value="bgrafillinfo.pas"/>
+        <UnitName Value="BGRAFillInfo"/>
+      </Item12>
+      <Item13>
         <Filename Value="bgrafilters.pas"/>
         <UnitName Value="BGRAFilters"/>
+      </Item8>
+      <Item9>
+      </Item13>
+      <Item14>
+        <Filename Value="bgrafreetype.pas"/>
+        <UnitName Value="BGRAFreeType"/>
+      </Item14>
+      <Item15>
+        <Filename Value="bgragradients.pas"/>
+        <UnitName Value="BGRAGradients"/>
+      </Item15>
+      <Item16>
+        <Filename Value="bgragradientscanner.pas"/>
+        <UnitName Value="BGRAGradientScanner"/>
+      </Item16>
+      <Item17>
+        <Filename Value="bgralayers.pas"/>
+        <UnitName Value="BGRALayers"/>
+      </Item17>
+      <Item18>
+        <Filename Value="bgramatrix3d.pas"/>
+        <UnitName Value="BGRAMatrix3D"/>
+      </Item18>
+      <Item19>
+        <Filename Value="bgraopenraster.pas"/>
+        <UnitName Value="BGRAOpenRaster"/>
+      </Item19>
+      <Item20>
         <Filename Value="bgrapaintnet.pas"/>
         <UnitName Value="BGRAPaintNet"/>
+      </Item9>
+      <Item10>
+      </Item20>
+      <Item21>
+        <Filename Value="bgrapath.pas"/>
+        <UnitName Value="BGRAPath"/>
+      </Item21>
+      <Item22>
+        <Filename Value="bgrapen.pas"/>
+        <UnitName Value="BGRAPen"/>
+      </Item22>
+      <Item23>
+        <Filename Value="bgraphongtypes.pas"/>
+        <UnitName Value="BGRAPhongTypes"/>
+      </Item23>
+      <Item24>
         <Filename Value="bgrapolygon.pas"/>
         <UnitName Value="BGRAPolygon"/>
+      </Item10>
+      <Item11>
+      </Item24>
+      <Item25>
+        <Filename Value="bgrapolygonaliased.pas"/>
+        <UnitName Value="BGRAPolygonAliased"/>
+      </Item25>
+      <Item26>
         <Filename Value="bgraresample.pas"/>
         <UnitName Value="BGRAResample"/>
+      </Item11>
+      <Item12>
+        <Filename Value="bgrapen.pas"/>
+        <UnitName Value="BGRAPen"/>
+      </Item12>
+      <Item13>
+      </Item26>
+      <Item27>
+        <Filename Value="bgrascene3d.pas"/>
+        <UnitName Value="BGRAScene3D"/>
+      </Item27>
+      <Item28>
+        <Filename Value="bgrascene3dinterface.inc"/>
+        <Type Value="Binary"/>
+      </Item28>
+      <Item29>
+        <Filename Value="bgraslicescaling.pas"/>
+        <UnitName Value="BGRASliceScaling"/>
+      </Item29>
+      <Item30>
+        <Filename Value="bgrasse.pas"/>
+        <UnitName Value="BGRASSE"/>
+      </Item30>
+      <Item31>
+        <Filename Value="bgrastreamlayers.pas"/>
+        <UnitName Value="BGRAStreamLayers"/>
+      </Item31>
+      <Item32>
+        <Filename Value="bgratext.pas"/>
+        <UnitName Value="BGRAText"/>
+      </Item32>
+      <Item33>
+        <Filename Value="bgratextfx.pas"/>
+        <UnitName Value="BGRATextFX"/>
+      </Item33>
+      <Item34>
         <Filename Value="bgratransform.pas"/>
         <UnitName Value="BGRATransform"/>
-      </Item13>
-      <Item14>
-        <Filename Value="bgragradientscanner.pas"/>
-        <UnitName Value="BGRAGradientScanner"/>
-      </Item14>
-      <Item15>
-        <Filename Value="bgratext.pas"/>
-        <UnitName Value="BGRAText"/>
-      </Item15>
-      <Item16>
-        <Filename Value="bgrapolygonaliased.pas"/>
-        <UnitName Value="BGRAPolygonAliased"/>
-      </Item16>
-      <Item17>
-        <Filename Value="blurfast.inc"/>
-        <Type Value="Binary"/>
-      </Item17>
-      <Item18>
-        <Filename Value="blurnormal.inc"/>
-        <Type Value="Binary"/>
-      </Item18>
-      <Item19>
-        <Filename Value="phongdraw.inc"/>
-        <Type Value="Binary"/>
-      </Item19>
-      <Item20>
-        <Filename Value="bgracanvas.pas"/>
-        <UnitName Value="BGRACanvas"/>
-      </Item20>
-      <Item21>
-        <Filename Value="filldensity256.inc"/>
-        <Type Value="Binary"/>
-      </Item21>
-      <Item22>
-        <Filename Value="perspectivescan.inc"/>
-        <Type Value="Binary"/>
-      </Item22>
-      <Item23>
-        <Filename Value="lineartexscan.inc"/>
-        <Type Value="Binary"/>
-      </Item23>
-      <Item24>
-        <Filename Value="bgrafillinfo.pas"/>
-        <UnitName Value="BGRAFillInfo"/>
-      </Item24>
-      <Item25>
-        <Filename Value="filldensitysegment256.inc"/>
-        <Type Value="Binary"/>
-      </Item25>
-      <Item26>
-        <Filename Value="renderdensity256.inc"/>
-        <Type Value="Binary"/>
-      </Item26>
-      <Item27>
-        <Filename Value="multishapeline.inc"/>
-        <Type Value="Binary"/>
-      </Item27>
-      <Item28>
-        <Filename Value="bgrapath.pas"/>
-        <UnitName Value="BGRAPath"/>
-      </Item28>
-      <Item29>
-        <Filename Value="bgracanvas2d.pas"/>
-        <UnitName Value="BGRACanvas2D"/>
-      </Item29>
-      <Item30>
-        <Filename Value="bgrascene3d.pas"/>
-        <UnitName Value="BGRAScene3D"/>
-      </Item30>
-      <Item31>
-        <Filename Value="bgratextfx.pas"/>
-        <UnitName Value="BGRATextFX"/>
-      </Item31>
-      <Item32>
-        <Filename Value="bgraphongtypes.pas"/>
-        <UnitName Value="BGRAPhongTypes"/>
-      </Item32>
-      <Item33>
-        <Filename Value="bgralayers.pas"/>
-        <UnitName Value="BGRALayers"/>
-      </Item33>
-      <Item34>
-        <Filename Value="bgrasse.pas"/>
-        <UnitName Value="BGRASSE"/>
       </Item34>
       <Item35>
         <Filename Value="perspectivescan2.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgratypewriter.pas"/>
+        <UnitName Value="BGRATypewriter"/>
       </Item35>
       <Item36>
         <Filename Value="shape3D.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgravectorize.pas"/>
+        <UnitName Value="BGRAVectorize"/>
       </Item36>
       <Item37>
         <Filename Value="bgrascene3dinterface.inc"/>
+        <Filename Value="blendpixelinline.inc"/>
         <Type Value="Binary"/>
       </Item37>
       <Item38>
         <Filename Value="bgramatrix3d.pas"/>
         <UnitName Value="BGRAMatrix3D"/>
+        <Filename Value="blendpixels.inc"/>
+        <Type Value="Binary"/>
       </Item38>
       <Item39>
         <Filename Value="csscolorconst.inc"/>
+        <Filename Value="blendpixelsover.inc"/>
         <Type Value="Binary"/>
       </Item39>
       <Item40>
         <Filename Value="lightingclasses3d.inc"/>
+        <Filename Value="blurfast.inc"/>
         <Type Value="Binary"/>
       </Item40>
       <Item41>
         <Filename Value="phonglight.inc"/>
+        <Filename Value="blurnormal.inc"/>
         <Type Value="Binary"/>
       </Item41>
       <Item42>
         <Filename Value="polyaliaspersp.inc"/>
+        <Filename Value="csscolorconst.inc"/>
         <Type Value="Binary"/>
       </Item42>
       <Item43>
         <Filename Value="lineartexscan2.inc"/>
+        <Filename Value="filldensity256.inc"/>
         <Type Value="Binary"/>
       </Item43>
       <Item44>
         <Filename Value="perspectivecolorscan.inc"/>
+        <Filename Value="filldensitysegment256.inc"/>
         <Type Value="Binary"/>
       </Item44>
       <Item45>
         <Filename Value="phongdrawsse.inc"/>
+        <Filename Value="lightingclasses3d.inc"/>
         <Type Value="Binary"/>
       </Item45>
       <Item46>
         <Filename Value="phonglightsse.inc"/>
+        <Filename Value="lineartexscan.inc"/>
         <Type Value="Binary"/>
       </Item46>
       <Item47>
         <Filename Value="bgracoordpool3d.pas"/>
         <UnitName Value="BGRACoordPool3D"/>
+        <Filename Value="lineartexscan2.inc"/>
+        <Type Value="Binary"/>
       </Item47>
       <Item48>
         <Filename Value="bgraopenraster.pas"/>
         <UnitName Value="BGRAOpenRaster"/>
+        <Filename Value="multishapeline.inc"/>
+        <Type Value="Binary"/>
       </Item48>
       <Item49>
         <Filename Value="blendpixels.inc"/>
+        <Filename Value="perspectivecolorscan.inc"/>
         <Type Value="Binary"/>
       </Item49>
       <Item50>
         <Filename Value="blendpixelinline.inc"/>
+        <Filename Value="perspectivescan.inc"/>
         <Type Value="Binary"/>
       </Item50>
       <Item51>
         <Filename Value="blendpixelsover.inc"/>
+        <Filename Value="perspectivescan2.inc"/>
         <Type Value="Binary"/>
       </Item51>
       <Item52>
         <Filename Value="bgrafreetype.pas"/>
         <UnitName Value="BGRAFreeType"/>
+        <Filename Value="phongdraw.inc"/>
+        <Type Value="Binary"/>
       </Item52>
       <Item53>
         <Filename Value="bgragradients.pas"/>
         <UnitName Value="BGRAGradients"/>
+        <Filename Value="phongdrawsse.inc"/>
+        <Type Value="Binary"/>
       </Item53>
       <Item54>
         <Filename Value="bgraslicescaling.pas"/>
         <UnitName Value="BGRASliceScaling"/>
+        <Filename Value="phonglight.inc"/>
+        <Type Value="Binary"/>
       </Item54>
       <Item55>
         <Filename Value="bgravectorize.pas"/>
         <UnitName Value="BGRAVectorize"/>
+        <Filename Value="phonglightsse.inc"/>
+        <Type Value="Binary"/>
       </Item55>
       <Item56>
         <Filename Value="bgratypewriter.pas"/>
         <UnitName Value="BGRATypewriter"/>
+        <Filename Value="polyaliaspersp.inc"/>
+        <Type Value="Binary"/>
       </Item56>
+      <Item57>
+        <Filename Value="renderdensity256.inc"/>
+        <Type Value="Binary"/>
+      </Item57>
+      <Item58>
+        <Filename Value="shapes3d.inc"/>
+        <Type Value="Binary"/>
+      </Item58>
+      <Item59>
+        <Filename Value="winstream.inc"/>
+        <Type Value="Binary"/>
+      </Item59>
+      <Item60>
+        <Filename Value="bgrasse.inc"/>
+        <UnitName Value="bgrasse"/>
+      </Item60>
+      <Item61>
+        <Filename Value="sseloadv.inc"/>
+        <UnitName Value="sseloadv"/>
+      </Item61>
+      <Item62>
+        <Filename Value="ssesavev.inc"/>
+        <UnitName Value="ssesavev"/>
+      </Item62>
+      <Item63>
+        <Filename Value="bgragrayscalemask.pas"/>
+        <UnitName Value="BGRAGrayscaleMask"/>
+      </Item63>
+      <Item64>
+        <Filename Value="bgrareadbmp.pas"/>
+        <UnitName Value="BGRAReadBMP"/>
+      </Item64>
+      <Item65>
+        <Filename Value="bgrareadgif.pas"/>
+        <UnitName Value="BGRAReadGif"/>
+      </Item65>
+      <Item66>
+        <Filename Value="bgrareadpcx.pas"/>
+        <UnitName Value="BGRAReadPCX"/>
+      </Item66>
+      <Item67>
+        <Filename Value="bgrareadpng.pas"/>
+        <UnitName Value="BGRAReadPng"/>
+      </Item67>
+      <Item68>
+        <Filename Value="bgrareadpsd.pas"/>
+        <UnitName Value="BGRAReadPSD"/>
+      </Item68>
+      <Item69>
+        <Filename Value="bgrathumbnail.pas"/>
+        <UnitName Value="BGRAThumbnail"/>
+      </Item69>
+      <Item70>
+        <Filename Value="bgrareadtga.pas"/>
+        <UnitName Value="BGRAReadTGA"/>
+      </Item70>
+      <Item71>
+        <Filename Value="bgrareadico.pas"/>
+        <UnitName Value="BGRAReadIco"/>
+      </Item71>
+      <Item72>
+        <Filename Value="bgrareadjpeg.pas"/>
+        <UnitName Value="bgrareadjpeg"/>
+      </Item72>
+      <Item73>
+        <Filename Value="bgrareadlzp.pas"/>
+        <UnitName Value="BGRAReadLzp"/>
+      </Item73>
+      <Item74>
+        <Filename Value="unzipperext.pas"/>
+        <UnitName Value="UnzipperExt"/>
+      </Item74>
+      <Item75>
+        <Filename Value="bgralzpcommon.pas"/>
+        <UnitName Value="BGRALzpCommon"/>
+      </Item75>
+      <Item76>
+        <Filename Value="bgrawritelzp.pas"/>
+        <UnitName Value="BGRAWriteLzp"/>
+      </Item76>
+      <Item77>
+        <Filename Value="bgrareadxpm.pas"/>
+        <UnitName Value="BGRAReadXPM"/>
+      </Item77>
+      <Item78>
+        <Filename Value="bgrasvg.pas"/>
+        <UnitName Value="BGRASVG"/>
+      </Item78>
+      <Item79>
+        <Filename Value="bgraunits.pas"/>
+        <UnitName Value="BGRAUnits"/>
+      </Item79>
+      <Item80>
+        <Filename Value="bgrasvgshapes.pas"/>
+        <UnitName Value="BGRASVGShapes"/>
+      </Item80>
+      <Item81>
+        <Filename Value="bgrasvgtype.pas"/>
+        <UnitName Value="BGRASVGType"/>
+      </Item81>
+      <Item82>
+        <Filename Value="bgrareadbmpmiomap.pas"/>
+        <UnitName Value="BGRAReadBmpMioMap"/>
+      </Item82>
+      <Item83>
+        <Filename Value="bgraarrow.pas"/>
+        <UnitName Value="BGRAArrow"/>
+      </Item83>
+      <Item84>
+        <Filename Value="vertex3d.inc"/>
+        <Type Value="Binary"/>
+      </Item84>
+      <Item85>
+        <Filename Value="face3d.inc"/>
+        <Type Value="Binary"/>
+      </Item85>
+      <Item86>
+        <Filename Value="part3d.inc"/>
+        <Type Value="Binary"/>
+      </Item86>
+      <Item87>
+        <Filename Value="object3d.inc"/>
+        <Type Value="Binary"/>
+      </Item87>
+      <Item88>
+        <Filename Value="bgrapalette.pas"/>
+        <UnitName Value="BGRAPalette"/>
+      </Item88>
+      <Item89>
+        <Filename Value="bgracolorquantization.pas"/>
+        <UnitName Value="BGRAColorQuantization"/>
+      </Item89>
+      <Item90>
+        <Filename Value="bgradithering.pas"/>
+        <UnitName Value="BGRADithering"/>
+      </Item90>
+      <Item91>
+        <Filename Value="paletteformats.inc"/>
+        <Type Value="Binary"/>
+      </Item91>
     </Files>
-    <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="2">
       <Item1>

GraphicTest/Packages/bgrabitmap/bgrabitmappack.pas

-              r452
+              r472
 uses
+  BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend,
+  BGRACompressableBitmap, BGRADefaultBitmap, BGRADNetDeserial, BGRAFilters,
+  BGRAPaintNet, BGRAPolygon, BGRAResample, BGRAPen, BGRATransform,
+  BGRAGradientScanner, BGRAText, BGRAPolygonAliased, BGRACanvas, BGRAFillInfo,
+  BGRAPath, BGRACanvas2D, BGRAScene3D, BGRATextFX, BGRAPhongTypes, BGRALayers,
+  BGRASSE, BGRAMatrix3D, BGRACoordPool3D, BGRAOpenRaster, BGRAFreeType,
+  BGRAGradients, BGRASliceScaling, BGRAVectorize, BGRATypewriter,
+  LazarusPackageIntf;
+  BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas,
+  BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D,
+  BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters,
+  BGRAFreeType, BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D,
+  BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes,
+  BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D,
+  BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRAText, BGRATextFX,
+  BGRATransform, BGRATypewriter, BGRAVectorize, BGRAGrayscaleMask,
+  BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, BGRAReadPSD,
+  BGRAThumbnail, BGRAReadTGA, BGRAReadIco, bgrareadjpeg, BGRAReadLzp,
+  UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRASVG, BGRAUnits,
+  BGRASVGShapes, BGRASVGType, BGRAReadBmpMioMap, BGRAArrow, BGRAPalette,
+  BGRAColorQuantization, BGRADithering;
 implementation
-procedure Register;
-begin
-end;
-initialization
-  RegisterPackage('BGRABitmapPack', @Register);
 end.

GraphicTest/Packages/bgrabitmap/bgrabitmaptypes.pas

-              r452
+              r472
   PBGRAPixel = ^TBGRAPixel;
+  //pixel structure
+  Int32or64 = {$IFDEF CPU64}Int64{$ELSE}LongInt{$ENDIF};
+  UInt32or64 = {$IFDEF CPU64}UInt64{$ELSE}LongWord{$ENDIF};
+  //Each pixel is a sequence of 4 bytes containing blue, green, red and alpha channel.
   TBGRAPixel = packed record
     blue, green, red, alpha: byte;
   end;
+  ArrayOfTBGRAPixel = array of TBGRAPixel;
   //gamma expanded values
 …
     hue, saturation, lightness, alpha: word;
   end;
+  TGSBAPixel = THSLAPixel;
   //general purpose color variable with floating point values
 …
   TResampleMode = (rmSimpleStretch,   //low quality resample
+                   rmFineResample);   //use resample filters
+  TResampleFilter = (rfLinear,        //linear interpolation
+                   rmFineResample);   //use resample filters and pixel-centered coordinates
+  TResampleFilter = (rfBox,           //equivalent of stretch with high quality
+                     rfLinear,        //linear interpolation
                      rfHalfCosine,    //mix of rfLinear and rfCosine
                      rfCosine,        //cosine-like interpolation
 …
                      rfMitchell,      //downsizing interpolation
                      rfSpline,        //upsizing interpolation
+                     rfLanczos2,      //Lanczos with radius 2
+                     rfLanczos3,      //Lanczos with radius 3
+                     rfLanczos4,      //Lanczos with radius 4
                      rfBestQuality);  //mix of rfMitchell and rfSpline
+  TDitheringAlgorithm = (daNearestNeighbor, daFloydSteinberg);
+  TAlphaChannelPaletteOption = (acIgnore, acTransparentEntry, acFullChannelInPalette);
+const
+  ResampleFilterStr : array[TResampleFilter] of string =
+   ('Box','Linear','HalfCosine','Cosine','Bicubic','Mitchell','Spline',
+    'Lanczos2','Lanczos3','Lanczos4','BestQuality');
+function StrToResampleFilter(str: string): TResampleFilter;
+type
+  TBGRAImageFormat = (ifUnknown, ifJpeg, ifPng, ifGif, ifBmp, ifIco, ifPcx, ifPaintDotNet, ifLazPaint, ifOpenRaster,
+    ifPsd, ifTarga, ifTiff, ifXwd, ifXPixMap, ifBmpMioMap);
+var
+  DefaultBGRAImageReader: array[TBGRAImageFormat] of TFPCustomImageReaderClass;
+  DefaultBGRAImageWriter: array[TBGRAImageFormat] of TFPCustomImageWriterClass;
+type
   TBGRAFontQuality = (fqSystem, fqSystemClearType, fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR);
+        // fqSystem: use system rendering. It is fast however it may be not be smoothed.
+        // fqSystemClearType: use system rendering with ClearType. This quality is of course better than fqSystem however it may not be much smoother.
+        // fqFineAntialiasing: garanties a high quality antialiasing. This is slower.
+        // fqFineClearTypeRGB: garanties a high quality antialiasing with ClearType. The order of the color in the LCD screen is supposed to be un red/green/blue order.
+        // fqFineClearTypeBGR: same as above, except the color of the LCD screen is supposed to be in blue/green/red order.
   TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth);
+  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast);
+  TSplineStyle = (ssInside, ssInsideWithEnds, ssCrossing, ssCrossingWithEnds, ssOutside, ssRoundOutside, ssVertexToSide);
+  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast, rbBox);
+  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/
+  { 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, boDivide, boNiceGlow, boSoftLight, boHardLight, //lighting
 …
   end;
+  TArcDef = record
+    center: TPointF;
+    radius: TPointF;
+    xAngleRadCW, startAngleRadCW, endAngleRadCW: single; //see convention in BGRAPath
+    anticlockwise: boolean
+  end;
+  PArcDef = ^TArcDef;
   TPoint3D = record
     x,y,z: single;
   end;
+  TBGRAArrowStyle = (asNone, asNormal, asCut, asTriangle, asHollowTriangle, asFlipped, asFlippedCut, asTail, asTailRepeat);
   TBGRATypeWriterAlignment = (twaTopLeft, twaTop, twaTopRight,
 …
 function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
 function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
+function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload;
+function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef;
 { Useful constants }
 …
   clBlackOpaque = TColor($010000);
+{$DEFINE INCLUDE_COLOR_CONST}
 {$i csscolorconst.inc}
 …
   public
     constructor Create;
     procedure Add(Name: string; Color: TBGRAPixel);
+    procedure Add(Name: string; const Color: TBGRAPixel);
     procedure Finished;
     function IndexOf(Name: string): integer;
+    function IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer;
     property ByName[Name: string]: TBGRAPixel read GetByName;
 …
 var
   CSSColors: TBGRAColorList;
+  VGAColors, CSSColors: TBGRAColorList;
 function isEmptyPointF(pt: TPointF): boolean;
 …
   end;
+  { A path is the ability to define a contour with moveTo, lineTo...
+    It must not implement reference counting. }
+  IBGRAPath = interface
+    procedure closePath;
+    procedure moveTo(const pt: TPointF);
+    procedure lineTo(const pt: TPointF);
+    procedure polylineTo(const pts: array of TPointF);
+    procedure quadraticCurveTo(const cp,pt: TPointF);
+    procedure bezierCurveTo(const cp1,cp2,pt: TPointF);
+    procedure arc(const arcDef: TArcDef);
+    procedure copyTo(dest: IBGRAPath);
+  end;
   TScanAtFunction = function (X,Y: Single): TBGRAPixel of object;
   TScanAtIntegerFunction = function (X,Y: Integer): TBGRAPixel of object;
   TScanNextPixelFunction = function: TBGRAPixel of object;
   TBGRACustomGradient = class;
+  TBGRACustomFillInfo = class;
+  TBGRACustomFontRenderer = class;
   { TBGRACustomBitmap }
 …
   protected
      { accessors to properies }
+     function GetArrowEndRepeat: integer; virtual; abstract;
+     function GetArrowStartRepeat: integer; virtual; abstract;
+     procedure SetArrowEndRepeat(AValue: integer); virtual; abstract;
+     procedure SetArrowStartRepeat(AValue: integer); virtual; abstract;
+     function GetArrowEndOffset: single; virtual; abstract;
+     function GetArrowStartOffset: single; virtual; abstract;
+     procedure SetArrowEndOffset(AValue: single); virtual; abstract;
+     procedure SetArrowStartOffset(AValue: single); virtual; abstract;
+     function GetArrowEndSize: TPointF; virtual; abstract;
+     function GetArrowStartSize: TPointF; virtual; abstract;
+     procedure SetArrowEndSize(AValue: TPointF); virtual; abstract;
+     procedure SetArrowStartSize(AValue: TPointF); virtual; abstract;
+     function GetLineCap: TPenEndCap; virtual; abstract;
+     procedure SetLineCap(AValue: TPenEndCap); virtual; abstract;
+     function GetFontRenderer: TBGRACustomFontRenderer; virtual; abstract;
+     procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); virtual; abstract;
      function GetHeight: integer; virtual; abstract;
      function GetWidth: integer; virtual; abstract;
 …
      procedure SetClipRect(const AValue: TRect); virtual; abstract;
      function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
+     function LoadAsBmp32(Str: TStream): boolean; virtual; abstract;
+     procedure ClearTransparentPixels; virtual; abstract;
+     procedure SetArrowStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); virtual; abstract;
+     procedure SetArrowEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); virtual; abstract;
   public
      Caption:   string;  //user defined caption
+     //font style
+     FontName:  string;
+     FontStyle: TFontStyles;
+     FontQuality : TBGRAFontQuality;
+     FontOrientation: integer;
+     {-------------------font style------------------------}
+     FontName: string;              //Specifies the font to use. Unless the font renderer accept otherwise,
+                                    //the name is in human readable form, like 'Arial', 'Times New Roman', ...
+     FontStyle: TFontStyles;        //Specifies the set of styles to be applied to the font.
+                                    //These can be fsBold, fsItalic, fsStrikeOut, fsUnderline.
+                                    //So the value [fsBold,fsItalic] means that the font must be bold and italic.
+     FontQuality : TBGRAFontQuality;//Specifies the quality of rendering. Default value is fqSystem.
+     FontOrientation: integer;      //Specifies the rotation of the text, for functions that support text rotation.
+                                    //It is expressed in tenth of degrees, positive values going counter-clockwise.
      //line style
-     LineCap:   TPenEndCap;
      JoinStyle: TPenJoinStyle;
      JoinMiterLimit: single;
      FillMode:  TFillMode;  //winding or alternate
+     LinearAntialiasing: boolean;
      { The resample filter is used when resizing the bitmap, and
 …
      constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); virtual; abstract; overload;
      constructor Create(AFilename: string); virtual; abstract; overload;
+     constructor Create(AFilename: string; AIsUtf8Filename: boolean); virtual; abstract; overload;
      constructor Create(AStream: TStream); virtual; abstract; overload;
 …
      function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; virtual; abstract; overload;
      function NewBitmap(Filename: string): TBGRACustomBitmap; virtual; abstract; overload;
+     function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; virtual; abstract; overload;
+     //there are UTF8 functions that are different from standard function as those
+     //depend on TFPCustomImage that does not clearly handle UTF8
      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 LoadFromFileUTF8(const filenameUTF8: string); virtual;
+     procedure LoadFromFileUTF8(const filenameUTF8: string; AHandler: TFPCustomImageReader); virtual;
+     procedure LoadFromStream(Str: TStream); virtual; overload;
+     procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader); virtual; overload;
+     procedure SaveToFile(const filename: string); virtual; overload;
+     procedure SaveToFile(const filename: string; Handler:TFPCustomImageWriter); virtual; overload;
+     procedure SaveToFileUTF8(const filenameUTF8: string); virtual; overload;
+     procedure SaveToFileUTF8(const filenameUTF8: string; Handler:TFPCustomImageWriter); virtual; overload;
      procedure SaveToStreamAsPng(Str: TStream); virtual; abstract;
+     procedure Assign(ABitmap: TBitmap); virtual; abstract; overload;
+     procedure SaveToStreamAs(Str: TStream; AFormat: TBGRAImageFormat); virtual;
+     procedure Assign(ARaster: TRasterImage); virtual; abstract; overload;
      procedure Assign(MemBitmap: TBGRACustomBitmap); virtual; abstract; overload;
      procedure Serialize(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;
+     procedure SetPixel(x, y: int32or64; c: TColor); virtual; abstract; overload;
+     procedure XorPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
+     procedure SetPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawPixel(x, y: int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
+     procedure DrawPixel(x, y: int32or64; ec: TExpandedPixel); virtual; abstract; overload;
+     procedure FastBlendPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure ErasePixel(x, y: int32or64; alpha: byte); virtual; abstract;
+     procedure AlphaPixel(x, y: int32or64; alpha: byte); virtual; abstract;
+     function GetPixel(x, y: int32or64): TBGRAPixel; virtual; abstract; overload;
+     function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract;
+     function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract; overload;
+     function GetPixelCycle(x, y: int32or64): TBGRAPixel; virtual; overload;
      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;
+     function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
+     function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; 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;
+     procedure SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); virtual; abstract; overload;
+     procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload;
+     procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); virtual; abstract;
+     procedure SetVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); virtual; abstract;
+     procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
+     procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; maxDiff: byte); virtual; abstract;
+     procedure HorizLine(x,y,x2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
+     procedure VertLine(x,y,y2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode);
+     procedure HorizLine(x,y,x2: Int32or64; texture: IBGRAScanner; ADrawMode: TDrawMode); virtual; abstract; overload;
      {Shapes}
+     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract;
+     procedure DrawPath(APath: IBGRAPath; c: TBGRAPixel; w: single); virtual; abstract;
+     procedure DrawPath(APath: IBGRAPath; texture: IBGRAScanner; w: single); virtual; abstract;
+     procedure ArrowStartAsNone;
+     procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1);
+     procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5);
+     procedure ArrowStartAsTail;
+     procedure ArrowEndAsNone;
+     procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1);
+     procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5);
+     procedure ArrowEndAsTail;
+     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode= dmDrawWithTransparency); 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; texture: IBGRAScanner; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure DrawPolyLine(const points: array of TPoint; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode=dmDrawWithTransparency);
      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; texture: IBGRAScanner; w: single); virtual; abstract; overload;
      procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); virtual; abstract; overload;
+     procedure DrawPolygon(const points: array of TPoint; c: TBGRAPixel; ADrawMode: TDrawMode=dmDrawWithTransparency);
+     procedure DrawPolygonAntialias(const points: array of TPoint; c: TBGRAPixel); 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 DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); virtual; abstract; overload;
      procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; abstract;
 …
      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 ErasePolyLine(const points: array of TPoint; alpha: byte; DrawLastPixel: boolean);
+     procedure ErasePolyLineAntialias(const points: array of TPoint; alpha: byte; DrawLastPixel: boolean); overload;
      procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); virtual; abstract; overload;
+     procedure ErasePolygonOutline(const points: array of TPoint; alpha: byte);
+     procedure ErasePolygonOutlineAntialias(const points: array of TPoint; alpha: byte);
+     procedure FillPath(APath: IBGRAPath; c: TBGRAPixel); virtual; abstract;
+     procedure FillPath(APath: IBGRAPath; texture: IBGRAScanner); virtual; abstract;
      procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); 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 FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); virtual; abstract; overload;
      procedure FillQuadPerspectiveMappingAntialias(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; ACleanBorders: TRect); virtual; abstract; overload;
      procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel);  virtual; abstract; overload;
 …
      procedure ErasePoly(const points: array of TPointF; alpha: byte); virtual; abstract;
      procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); virtual; abstract;
+     procedure FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel; drawmode: TDrawMode); virtual; abstract;
+     procedure FillShape(shape: TBGRACustomFillInfo; texture: IBGRAScanner; drawmode: TDrawMode); virtual; abstract;
+     procedure FillShapeAntialias(shape: TBGRACustomFillInfo; c: TBGRAPixel); virtual; abstract;
+     procedure FillShapeAntialias(shape: TBGRACustomFillInfo; texture: IBGRAScanner); virtual; abstract;
+     procedure EraseShape(shape: TBGRACustomFillInfo; alpha: byte); virtual; abstract;
+     procedure EraseShapeAntialias(shape: TBGRACustomFillInfo; alpha: byte); virtual; abstract;
      procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); virtual; abstract;
 …
      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 RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; abstract; overload;
+     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; abstract; overload;
      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 FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual;
      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 EllipseInRect(r: TRect; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; overload;
+     procedure EllipseInRect(r: TRect; BorderColor,FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; overload;
+     procedure FillEllipseInRect(r: TRect; FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual;
      procedure FillRect(r: TRect; c: TColor); virtual; overload;
      procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
+     procedure FillRect(r: TRect; texture: IBGRAScanner; 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 FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); virtual; abstract; overload;
      procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); virtual; abstract;
      procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); virtual; abstract;
 …
      procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); virtual; abstract;
+     procedure TextOut(x, y: single; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
+     procedure TextOut(x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
+     procedure TextOutAngle(x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
+     procedure TextOutAngle(x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
+     procedure TextOut(x, y: single; s: string; c: TBGRAPixel); virtual; overload;
+     procedure TextOut(x, y: single; s: string; c: TColor); virtual; overload;
+     procedure TextOut(x, y: single; 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;
+     procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
+     procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
+     procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
+     procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
+     procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract; overload;
+     procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract; overload;
+     function TextSize(sUTF8: string): TSize; virtual; abstract;
+     { Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c or texture is used to fill the text.
+       The value of FontOrientation is taken into account, so that the text may be rotated. }
+     procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel); virtual; overload;
+     procedure TextOut(x, y: single; sUTF8: string; c: TColor); virtual; overload;
+     procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner); virtual; overload;
+     { Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
+       The position depends on the specified horizontal alignment halign and vertical alignement valign.
+       The color c or texture is used to fill the text. No rotation is applied. }
+     procedure TextRect(ARect: TRect; sUTF8: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); virtual; overload;
+     procedure TextRect(ARect: TRect; sUTF8: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); virtual; overload;
      {Spline}
 …
      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 FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); virtual; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ADrawMode: TDrawMode); virtual; abstract; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ADrawMode: TDrawMode); 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;
 …
      {BGRA bitmap functions}
+     procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); virtual; abstract;
+     procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); virtual; abstract;
      procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
+     procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
      procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
      procedure PutImagePart(x,y: integer; Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte = 255);
+     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; ARestoreOffsetAfterRotation: boolean = false); virtual; abstract;
+     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload;
+     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255); overload;
+     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); virtual; abstract; overload;
+     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload;
+     function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap): TRect;
+     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload;
+     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload;
+     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload;
+     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload;
+     procedure ComputeImageAngleAxes(x,y,w,h,angle: single; imageCenterX,imageCenterY: single; ARestoreOffsetAfterRotation: boolean;
+       out Origin,HAxis,VAxis: TPointF);
+     function GetImageAngleBounds(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; ARestoreOffsetAfterRotation: boolean = false): TRect;
      procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); virtual; abstract;
      procedure BlendImageOver(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte = 255;
 …
      function Resample(newWidth, newHeight: integer;
        mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract;
+     procedure VerticalFlip; virtual; abstract;
+     procedure HorizontalFlip; virtual; abstract;
+     procedure VerticalFlip; virtual; overload;
+     procedure VerticalFlip(ARect: TRect); virtual; abstract; overload;
+     procedure HorizontalFlip; virtual; overload;
+     procedure HorizontalFlip(ARect: TRect); virtual; abstract; overload;
      function RotateCW: TBGRACustomBitmap; virtual; abstract;
      function RotateCCW: TBGRACustomBitmap; virtual; abstract;
      procedure Negative; virtual; abstract;
+     procedure NegativeRect(ABounds: TRect); virtual; abstract;
      procedure LinearNegative; virtual; abstract;
+     procedure LinearNegativeRect(ABounds: TRect); virtual; abstract;
+     procedure InplaceGrayscale; virtual; abstract;
+     procedure InplaceGrayscale(ABounds: TRect); virtual; abstract;
      procedure ConvertToLinearRGB; virtual; abstract;
      procedure ConvertFromLinearRGB; virtual; abstract;
 …
      procedure GrayscaleToAlpha; virtual; abstract;
      procedure AlphaToGrayscale; virtual; abstract;
+     procedure ApplyMask(mask: TBGRACustomBitmap); virtual; abstract;
+     procedure ApplyMask(mask: TBGRACustomBitmap); overload;
+     procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect); overload;
+     procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); virtual; abstract; overload;
      function GetImageBounds(Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; virtual; abstract;
      function GetImageBounds(Channels: TChannels): TRect; virtual; abstract;
+     function GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect; virtual; abstract;
      function GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect; virtual; abstract;
      function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract;
 …
      function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
      function FilterSmooth: TBGRACustomBitmap; virtual; abstract;
+     function FilterSharpen: TBGRACustomBitmap; virtual; abstract;
+     function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; virtual; abstract;
+     function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; virtual; abstract;
      function FilterContour: TBGRACustomBitmap; virtual; abstract;
+     function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): 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 FilterBlurRadial(ABounds: TRect; radius: integer;
+       blurType: TRadialBlurType): TBGRACustomBitmap; virtual; abstract;
      function FilterBlurMotion(distance: integer; angle: single;
        oriented: boolean): TBGRACustomBitmap; virtual; abstract;
+     function FilterBlurMotion(ABounds: TRect; distance: integer; angle: single;
+       oriented: boolean): TBGRACustomBitmap; virtual; abstract;
      function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
+     function FilterCustomBlur(ABounds: TRect; mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
      function FilterEmboss(angle: single): TBGRACustomBitmap; virtual; abstract;
+     function FilterEmboss(angle: single; ABounds: TRect): TBGRACustomBitmap; virtual; abstract;
      function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; virtual; abstract;
      function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; virtual; abstract;
      function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; virtual; abstract;
      function FilterGrayscale: TBGRACustomBitmap; virtual; abstract;
+     function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; virtual; abstract;
      function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
+     function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; virtual; abstract;
+     function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
+     function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract;
      function FilterSphere: TBGRACustomBitmap; virtual; abstract;
      function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; virtual; abstract;
+     function FilterTwirl(ABounds: TRect; 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 Width: integer Read GetWidth;        //width of the image in pixels
+     property Height: integer Read GetHeight;      //height of the image in pixels
+     property NbPixels: integer Read GetNbPixels;  //total number of pixels. It is always true that NbPixels = Width * Height
+     property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;   //Returns the address of the left-most pixel of any line.
+                                                                   //The parameter y ranges from 0 to Height-1.
+     property LineOrder: TRawImageLineOrder Read GetLineOrder;     //Indicates the order in which lines are stored in memory.
+                                                                   //If it is equal to riloTopToBottom, the first line is the top line.
+                                                                   //If it is equal to riloBottomToTop, the first line is the bottom line.
+     property Data: PBGRAPixel Read GetDataPtr;  //Provides a pointer to the first pixel in memory.
+                                                 //Depending on the LineOrder property, this can be the top-left pixel or the bottom-left pixel.
+                                                 //There is no padding between scanlines, so the start of the next line is at the address Data + Width.
+     property Empty: boolean Read CheckEmpty;    //Returns True if the bitmap only contains transparent pixels or has a size of zero.
+     property HasTransparentPixels: boolean Read GetHasTransparentPixels; //Returns True if there are transparent or semitransparent pixels,
+                                                                          //and so if the image would be stored with an alpha channel.
      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;
 …
        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)
+     { Specifies the height of the font without taking into account additional line spacing.
+       A negative value means that it is the full height instead (see below). }
+     property FontHeight: integer Read GetFontHeight Write SetFontHeight;
+     { Specifies the height of the font, taking into account the additional line spacing defined for the font. }
      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};
+     property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias;    //Simplified property to specify the quality.
+     property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;   //Returns measurement for the current font in pixels.
+     { Specifies the font renderer. By default it is an instance of TLCLFontRenderer of unit BGRAText.
+       Other renderers are provided in BGRATextFX unit and BGRAVectorize unit.
+       Once you assign a renderer, it will automatically be freed.
+       The renderers may provide additional styling for the font. }
+     property FontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer;
+     property LineCap: TPenEndCap read GetLineCap write SetLineCap;
+     property ArrowStartSize: TPointF read GetArrowStartSize write SetArrowStartSize;
+     property ArrowEndSize: TPointF read GetArrowEndSize write SetArrowEndSize;
+     property ArrowStartOffset: single read GetArrowStartOffset write SetArrowStartOffset;
+     property ArrowEndOffset: single read GetArrowEndOffset write SetArrowEndOffset;
+     property ArrowStartRepeat: integer read GetArrowStartRepeat write SetArrowStartRepeat;
+     property ArrowEndRepeat: integer read GetArrowEndRepeat write SetArrowEndRepeat;
      //IBGRAScanner
 …
      procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
      function IsScanPutPixelsDefined: boolean; virtual;
+  protected
+     //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};
   end;
 …
     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
     function IsScanPutPixelsDefined: boolean; virtual;
+  protected
     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};
 …
   end;
+  { TIntersectionInfo }
+  TIntersectionInfo = class
+    interX: single;
+    winding: integer;
+    numSegment: integer;
+    procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer);
+  end;
+  ArrayOfTIntersectionInfo = array of TIntersectionInfo;
+  TBGRACustomFillInfo = class
+    public
+      //returns true if the same segment number can be curved
+      function SegmentsCurved: boolean; virtual; abstract;
+      //returns integer bounds
+      function GetBounds: TRect; virtual; abstract;
+      //compute min-max to be drawn on destination bitmap according to cliprect. Returns false if
+      //there is nothing to draw
+      function ComputeMinMax(out minx,miny,maxx,maxy: integer; bmpDest: TBGRACustomBitmap): boolean; virtual; abstract;
+      //check if the point is inside the filling zone
+      function IsPointInside(x,y: single; windingMode: boolean): boolean; virtual; abstract;
+      //create an array that will contain computed intersections.
+      //you may augment, in this case, use CreateIntersectionInfo for new items
+      function CreateIntersectionArray: ArrayOfTIntersectionInfo; virtual; abstract;
+      function CreateIntersectionInfo: TIntersectionInfo; virtual; abstract; //creates a single info
+      procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); virtual; abstract;
+      //fill a previously created array of intersections with actual intersections at the current y coordinate.
+      //nbInter gets the number of computed intersections
+      procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); virtual; abstract;
+  end;
+  { TBGRACustomFontRenderer }
+  TBGRACustomFontRenderer = class
+    FontName: string;              //Specifies the font to use. Unless the font renderer accept otherwise,
+                                   //the name is in human readable form, like 'Arial', 'Times New Roman', ...
+    FontStyle: TFontStyles;        //Specifies the set of styles to be applied to the font.
+                                   //These can be fsBold, fsItalic, fsStrikeOut, fsUnderline.
+                                   //So the value [fsBold,fsItalic] means that the font must be bold and italic.
+    FontQuality : TBGRAFontQuality;//Specifies the quality of rendering. Default value is fqSystem.
+    FontOrientation: integer;      //Specifies the rotation of the text, for functions that support text rotation.
+                                   //It is expressed in tenth of degrees, positive values going counter-clockwise.
+    FontEmHeight: integer;         // Specifies the height of the font without taking into account additional line spacing.
+                                   // A negative value means that it is the full height instead.
+    { Returns measurement for the current font in pixels. }
+    function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
+    { Returns the total size of the string provided using the current font.
+      Orientation is not taken into account, so that the width is along the text.  }
+    function TextSize(sUTF8: string): TSize; virtual; abstract;
+    { Draws the UTF8 encoded string, with color c.
+      If align is taLeftJustify, (x,y) is the top-left corner.
+      If align is taCenter, (x,y) is at the top and middle of the text.
+      If align is taRightJustify, (x,y) is the top-right corner.
+      The value of FontOrientation is taken into account, so that the text may be rotated. }
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
+    { Same as above functions, except that the text is filled using texture.
+      The value of FontOrientation is taken into account, so that the text may be rotated. }
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
+    { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. }
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
+    { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect.
+      Additional style information is provided by the style parameter.
+      The color c or texture is used to fill the text. No rotation is applied. }
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract;
+    { Copy the path for the UTF8 encoded string into ADest.
+      If align is taLeftJustify, (x,y) is the top-left corner.
+      If align is taCenter, (x,y) is at the top and middle of the text.
+      If align is taRightJustify, (x,y) is the top-right corner. }
+    procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment); virtual; //optional
+  end;
 type
   TBGRABitmapAny = class of TBGRACustomBitmap;  //used to create instances of the same type (see NewBitmap)
+  TBGRATextOutImproveReadabilityMode = (irMask, irNormal, irClearTypeRGB, irClearTypeBGR);
 var
   BGRABitmapFactory : TBGRABitmapAny;
+  BGRATextOutImproveReadabilityProc : procedure (bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
+function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer; const cliprect: TRect): boolean; inline;
 { 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 GetIntensity(const c: TExpandedPixel): word; inline;
+function GetIntensity(c: TBGRAPixel): word; inline;
+function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
+function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel;
+function GetLightness(c: TBGRAPixel): word;
+function GetLightness(const c: TExpandedPixel): word; inline;
+function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
+function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
+function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; //if you already know the current lightness of the color
 function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
 function ApplyIntensityFast(color: TBGRAPixel; lightness: longword): TBGRAPixel;
 function CombineLightness(lightness1,lightness2: integer): integer;
+function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
 function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
+function ExpandedToHSLA(ec: TExpandedPixel): THSLAPixel; inline;
+function BGRAToGSBA(c: TBGRAPixel): THSLAPixel;
+function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
+function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
+function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
+function ExpandedToGSBA(ec: TExpandedPixel): TGSBAPixel;
+function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
+function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
+function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
 function GtoH(ghue: word): word;
 function HtoG(hue: word): word;
 …
 function GetHue(ec: TExpandedPixel): word;
 function ColorImportance(ec: TExpandedPixel): word;
+function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
+function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
+function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
+function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
+function GSBAToHSLA(c: TGSBAPixel): THSLAPixel;
 function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
 function GammaCompression(ec: TExpandedPixel): TBGRAPixel; inline;
+function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline;
 function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline;
 function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
 …
 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;
+function StrToBGRA(str: string; DefaultColor: TBGRAPixel): TBGRAPixel;
+function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; AMaxDiff: Word= 0): string;
+function StrToBGRA(str: string): TBGRAPixel; //full parse
+function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; //full parse with default when error or missing values
+function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out error: boolean): TBGRAPixel; //partial parse allowed
+procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean);
 { Get height [0..1] stored in a TBGRAPixel }
 …
 operator * (const pt1: TPointF; factor: single): TPointF; inline;
 operator * (factor: single; const pt1: TPointF): TPointF; inline;
+function PtInRect(pt: TPoint; r: TRect): boolean;
+function PtInRect(const pt: TPoint; r: TRect): boolean; overload;
+function RectWithSize(left,top,width,height: integer): TRect;
 function VectLen(dx,dy: single): single; overload;
 function VectLen(v: TPointF): single; overload;
 …
 { Cyclic functions }
 function PositiveMod(value, cycle: integer): integer; inline;
+function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload;
 { Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
 …
   without applying a modulo. }
 procedure PrecalcSin65536; // compute all values now
 function Sin65536(value: word): integer; inline;
 function Cos65536(value: word): integer; inline;
+function Sin65536(value: word): Int32or64; inline;
+function Cos65536(value: word): Int32or64; inline;
 function ByteSqrt(value: byte): byte; inline;
+function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat;
+function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string = ''): TBGRAImageFormat;
+function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
+function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader;
+function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter;
 implementation
+uses Math, SysUtils;
+uses Math, SysUtils, FileUtil, lazutf8classes, LCLProc,
+  FPReadTiff, FPReadXwd, FPReadXPM,
+  FPWriteTiff, FPWriteJPEG, FPWritePNG, FPWriteBMP, FPWritePCX,
+  FPWriteTGA, FPWriteXPM;
+function StrToResampleFilter(str: string): TResampleFilter;
+var f: TResampleFilter;
+begin
+  result := rfLinear;
+  str := LowerCase(str);
+  for f := low(TResampleFilter) to high(TResampleFilter) do
+    if CompareText(str,ResampleFilterStr[f])=0 then
+    begin
+      result := f;
+      exit;
+    end;
+end;
 function StrToBlendOperation(str: string): TBlendOperation;
 …
 end;
+//straight line
+function BezierCurve(origin, destination: TPointF): TQuadraticBezierCurve;
+begin
+  result.p1 := origin;
+  result.c := (origin+destination)*0.5;
+  result.p2 := destination;
+end;
+function ArcDef(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
+  anticlockwise: boolean): TArcDef;
+begin
+  result.center := PointF(cx,cy);
+  result.radius := PointF(rx,ry);
+  result.xAngleRadCW:= xAngleRadCW;
+  result.startAngleRadCW := startAngleRadCW;
+  result.endAngleRadCW:= endAngleRadCW;
+  result.anticlockwise:= anticlockwise;
+end;
 { Check if a PointF structure is empty or should be treated as a list separator }
 function isEmptyPointF(pt: TPointF): boolean;
 begin
   Result := (pt.x = EmptySingle) and (pt.y = EmptySingle);
+end;
+{ TBGRACustomFontRenderer }
+procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment);
+begin
+end;
+{ TIntersectionInfo }
+procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding,
+  ANumSegment: integer);
+begin
+  interX := AInterX;
+  winding := AWinding;
+  numSegment := ANumSegment;
 end;
 …
 end;
 procedure TBGRAColorList.Add(Name: string; Color: TBGRAPixel);
+procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel);
 begin
   if FFinished then
 …
 end;
+function TBGRAColorList.IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer;
+var i: integer;
+  MinDiff,CurDiff: Word;
+begin
+  if AMaxDiff = 0 then
+  begin
+    for i := 0 to FNbColors-1 do
+      if AColor = FColors[i].Color then
+      begin
+        result := i;
+        exit;
+      end;
+    result := -1;
+  end else
+  begin
+    MinDiff := AMaxDiff;
+    result := -1;
+    for i := 0 to FNbColors-1 do
+    begin
+      CurDiff := BGRAWordDiff(AColor,FColors[i].Color);
+      if CurDiff <= MinDiff then
+      begin
+        result := i;
+        MinDiff := CurDiff;
+        if MinDiff = 0 then exit;
+      end;
+    end;
+  end;
+end;
 { TBGRACustomBitmap }
 …
 procedure TBGRACustomBitmap.LoadFromFile(const filename: string);
 begin
+  inherited LoadFromFile(filename);
+  LoadFromFileUTF8(SysToUtf8(filename));
+end;
+procedure TBGRACustomBitmap.LoadFromFileUTF8(const filenameUTF8: string);
+var
+  Stream: TStream;
+  format: TBGRAImageFormat;
+  reader: TFPCustomImageReader;
+begin
+  stream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  try
+    format := DetectFileFormat(Stream, ExtractFileExt(filenameUTF8));
+    reader := CreateBGRAImageReader(format);
+    try
+      LoadFromStream(stream, reader);
+    finally
+      reader.Free;
+    end;
+  finally
+    ClearTransparentPixels;
+    stream.Free;
+  end;
+end;
+procedure TBGRACustomBitmap.LoadFromFileUTF8(const filenameUTF8: string;
+  AHandler: TFPCustomImageReader);
+var
+  Stream: TStream;
+begin
+  stream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(stream, AHandler);
+  finally
+    ClearTransparentPixels;
+    stream.Free;
+  end;
 end;
 procedure TBGRACustomBitmap.SaveToFile(const filename: string);
 begin
+  inherited SaveToFile(filename);
+  SaveToFileUTF8(SysToUtf8(filename));
+end;
+procedure TBGRACustomBitmap.SaveToFileUTF8(const filenameUTF8: string);
+var
+  writer: TFPCustomImageWriter;
+  format: TBGRAImageFormat;
+begin
+  format := SuggestImageFormat(filenameUTF8);
+  writer := CreateBGRAImageWriter(Format, HasTransparentPixels);
+  try
+    SaveToFileUTF8(filenameUTF8, writer);
+  finally
+    writer.free;
+  end;
 end;
 …
   Handler: TFPCustomImageWriter);
 begin
+  inherited SaveToFile(filename, Handler);
+  SaveToFileUTF8(SysToUtf8(filename),Handler);
+end;
+procedure TBGRACustomBitmap.SaveToFileUTF8(const filenameUTF8: string;
+  Handler: TFPCustomImageWriter);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(filenameUTF8,fmCreate);
+   try
+     SaveToStream(stream, Handler);
+   finally
+     stream.Free;
+   end;
+end;
+procedure TBGRACustomBitmap.SaveToStreamAs(Str: TStream;
+  AFormat: TBGRAImageFormat);
+var handler: TFPCustomImageWriter;
+begin
+  handler := CreateBGRAImageWriter(AFormat, HasTransparentPixels);
+  try
+    SaveToStream(Str, handler)
+  finally
+    handler.Free;
+  end;
+end;
+procedure TBGRACustomBitmap.DrawPixel(x, y: int32or64; c: TBGRAPixel;
+  ADrawMode: TDrawMode);
+begin
+  case ADrawMode of
+  dmSet: SetPixel(x,y,c);
+  dmSetExceptTransparent: if c.alpha = 255 then SetPixel(x,y,c);
+  dmLinearBlend: FastBlendPixel(x,y,c);
+  dmDrawWithTransparency: DrawPixel(x,y,c);
+  dmXor: XorPixel(x,y,c);
+  end;
+end;
+procedure TBGRACustomBitmap.LoadFromStream(Str: TStream);
+var
+  format: TBGRAImageFormat;
+  reader: TFPCustomImageReader;
+begin
+  format := DetectFileFormat(Str);
+  reader := CreateBGRAImageReader(format);
+  try
+    LoadFromStream(Str,reader);
+  finally
+    reader.Free;
+  end;
 end;
 …
   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);
 …
 { Look for a pixel considering the bitmap is repeated in both directions }
 function TBGRACustomBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
+function TBGRACustomBitmap.GetPixelCycle(x, y: int32or64): TBGRAPixel;
 begin
   if (Width = 0) or (Height = 0) then
 …
   else
     Result := (Scanline[PositiveMod(y,Height)] + PositiveMod(x,Width))^;
+end;
+procedure TBGRACustomBitmap.DrawHorizLine(x, y, x2: int32or64;
+  texture: IBGRAScanner);
+begin
+  HorizLine(x,y,x2,texture,dmDrawWithTransparency);
+end;
+procedure TBGRACustomBitmap.HorizLine(x, y, x2: Int32or64; c: TBGRAPixel;
+  ADrawMode: TDrawMode);
+begin
+  case ADrawMode of
+    dmSet: SetHorizLine(x,y,x2,c);
+    dmSetExceptTransparent: if c.alpha = 255 then SetHorizLine(x,y,x2,c);
+    dmXor: XorHorizLine(x,y,x2,c);
+    dmLinearBlend: FastBlendHorizLine(x,y,x2,c);
+    dmDrawWithTransparency: DrawHorizLine(x,y,x2,c);
+  end;
+end;
+procedure TBGRACustomBitmap.VertLine(x, y, y2: Int32or64; c: TBGRAPixel;
+  ADrawMode: TDrawMode);
+begin
+  case ADrawMode of
+    dmSet: SetVertLine(x,y,y2,c);
+    dmSetExceptTransparent: if c.alpha = 255 then SetVertLine(x,y,y2,c);
+    dmXor: XorVertLine(x,y,y2,c);
+    dmLinearBlend: FastBlendVertLine(x,y,y2,c);
+    dmDrawWithTransparency: DrawVertLine(x,y,y2,c);
+  end;
+end;
+procedure TBGRACustomBitmap.ArrowStartAsNone;
+begin
+  SetArrowStart(asNone);
+end;
+procedure TBGRACustomBitmap.ArrowStartAsClassic(AFlipped: boolean; ACut: boolean; ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetArrowStart(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetArrowStart(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetArrowStart(asFlipped,join,ARelativePenWidth)
+    else
+      SetArrowStart(asNormal,join,ARelativePenWidth)
+  end;
+end;
+procedure TBGRACustomBitmap.ArrowStartAsTriangle(ABackOffset: single; ARounded: boolean; AHollow: boolean;
+  AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetArrowStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetArrowStart(asTriangle, join,1,ABackOffset);
+end;
+procedure TBGRACustomBitmap.ArrowStartAsTail;
+begin
+  SetArrowStart(asTail);
+end;
+procedure TBGRACustomBitmap.ArrowEndAsNone;
+begin
+  SetArrowEnd(asNone);
+end;
+procedure TBGRACustomBitmap.ArrowEndAsClassic(AFlipped: boolean; ACut: boolean; ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetArrowEnd(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetArrowEnd(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetArrowEnd(asFlipped,join,ARelativePenWidth)
+    else
+      SetArrowEnd(asNormal,join,ARelativePenWidth)
+  end;
+end;
+procedure TBGRACustomBitmap.ArrowEndAsTriangle(ABackOffset: single; ARounded: boolean; AHollow: boolean;
+  AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetArrowEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetArrowEnd(asTriangle, join,1, ABackOffset);
+end;
+procedure TBGRACustomBitmap.ArrowEndAsTail;
+begin
+  SetArrowEnd(asTail);
+end;
+procedure TBGRACustomBitmap.DrawPolyLine(const points: array of TPoint;
+  c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c,ADrawMode);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       DrawLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1),ADrawMode);
 end;
 …
    if length(points) = 1 then
    begin
      if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
+     if DrawLastPixel then DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,true);
    end
    else
 …
 end;
+procedure TBGRACustomBitmap.DrawPolygon(const points: array of TPoint;
+  c: TBGRAPixel; ADrawMode: TDrawMode);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     DrawPixel(points[0].x,points[0].y,c,ADrawMode);
+   end
+   else
+   begin
+     for i := 0 to high(points)-1 do
+       DrawLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,false,ADrawMode);
+     DrawLine(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,false,ADrawMode);
+   end;
+end;
+procedure TBGRACustomBitmap.DrawPolygonAntialias(const points: array of TPoint;
+  c: TBGRAPixel);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,true);
+   end
+   else
+   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,false);
+     DrawLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,false);
+   end;
+end;
+procedure TBGRACustomBitmap.ErasePolyLine(const points: array of TPoint; alpha: byte;
+  DrawLastPixel: boolean);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then ErasePixel(points[0].x,points[0].y,alpha);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       EraseLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,DrawLastPixel and (i=high(points)-1));
+end;
+procedure TBGRACustomBitmap.ErasePolyLineAntialias(
+  const points: array of TPoint; alpha: byte; DrawLastPixel: boolean);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then ErasePixel(points[0].x,points[0].y,alpha);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       EraseLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,DrawLastPixel and (i=high(points)-1));
+end;
+procedure TBGRACustomBitmap.ErasePolygonOutline(const points: array of TPoint;
+  alpha: byte);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     ErasePixel(points[0].x,points[0].y,alpha);
+   end
+   else
+   begin
+     for i := 0 to high(points)-1 do
+       EraseLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,false);
+     EraseLine(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,alpha,false);
+   end;
+end;
+procedure TBGRACustomBitmap.ErasePolygonOutlineAntialias(
+  const points: array of TPoint; alpha: byte);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     ErasePixel(points[0].x,points[0].y,alpha);
+   end
+   else
+   begin
+     for i := 0 to high(points)-1 do
+       EraseLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,false);
+     EraseLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,alpha,false);
+   end;
+end;
 { Following functions are defined for convenience }
 procedure TBGRACustomBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
 …
 end;
+procedure TBGRACustomBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX,
+  DY: integer; FillColor: TBGRAPixel; ADrawMode: TDrawMode);
+begin
+  RoundRect(X1,Y1,X2,Y2,DX,DY,FillColor,FillColor,ADrawMode);
+end;
+procedure TBGRACustomBitmap.EllipseInRect(r: TRect; BorderColor: TBGRAPixel;
+  ADrawMode: TDrawMode);
+begin
+  RoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),BorderColor,ADrawMode);
+end;
+procedure TBGRACustomBitmap.EllipseInRect(r: TRect; BorderColor,
+  FillColor: TBGRAPixel; ADrawMode: TDrawMode);
+begin
+  RoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),BorderColor,FillColor,ADrawMode);
+end;
+procedure TBGRACustomBitmap.FillEllipseInRect(r: TRect; FillColor: TBGRAPixel;
+  ADrawMode: TDrawMode);
+begin
+  FillRoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),FillColor,ADrawMode);
+end;
 procedure TBGRACustomBitmap.FillRect(r: TRect; c: TColor);
 begin
 …
 end;
+procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner;
+  mode: TDrawMode);
+begin
+  FillRect(r.Left, r.top, r.right, r.bottom, texture, mode);
+end;
 procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
 begin
 …
 end;
+procedure TBGRACustomBitmap.TextOut(x, y: single; s: string; c: TBGRAPixel);
+begin
+  TextOut(x, y, s, c, taLeftJustify);
+end;
+procedure TBGRACustomBitmap.TextOut(x, y: single; s: string; c: TColor);
+begin
+  TextOut(x, y, s, ColorToBGRA(c));
+end;
+procedure TBGRACustomBitmap.TextOut(x, y: single; s: string;
+{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text.
+  The value of FontOrientation is taken into account, so that the text may be rotated. }
+procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string; c: TBGRAPixel);
+begin
+  TextOut(x, y, sUTF8, c, taLeftJustify);
+end;
+{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text.
+  The value of FontOrientation is taken into account, so that the text may be rotated. }
+procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string; c: TColor);
+begin
+  TextOut(x, y, sUTF8, ColorToBGRA(c));
+end;
+{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The texture is used to fill the text.
+  The value of FontOrientation is taken into account, so that the text may be rotated. }
+procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string;
   texture: IBGRAScanner);
 begin
+  TextOut(x, y, s, texture, taLeftJustify);
+end;
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
+  TextOut(x, y, sUTF8, texture, taLeftJustify);
+end;
+{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
+  The position depends on the specified horizontal alignment halign and vertical alignement valign.
+  The color c is used to fill the text. No rotation is applied. }
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; sUTF8: string;
   halign: TAlignment; valign: TTextLayout; c: TBGRAPixel);
 var
 …
   style.ShowPrefix := false;
   style.Clipping := false;
+  TextRect(ARect,ARect.Left,ARect.Top,s,style,c);
+end;
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
+  TextRect(ARect,ARect.Left,ARect.Top,sUTF8,style,c);
+end;
+{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
+  The position depends on the specified horizontal alignment halign and vertical alignement valign.
+  The texture is used to fill the text. No rotation is applied. }
+procedure TBGRACustomBitmap.TextRect(ARect: TRect; sUTF8: string;
   halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner);
 var
 …
   style.ShowPrefix := false;
   style.Clipping := false;
   TextRect(ARect,ARect.Left,ARect.Top,s,style,texture);
+  TextRect(ARect,ARect.Left,ARect.Top,sUTF8,style,texture);
 end;
 …
 begin
   AlphaFill(alpha, 0, NbPixels);
+end;
+procedure TBGRACustomBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
+  color: TBGRAPixel);
+begin
+  FillMask(x,y, AMask, color, dmDrawWithTransparency);
+end;
+procedure TBGRACustomBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
+  texture: IBGRAScanner);
+begin
+  FillMask(x,y, AMask, texture, dmDrawWithTransparency);
 end;
 …
     oldClip,newClip: TRect;
 begin
   if Source = nil then exit;
+  if (Source = nil) or (AOpacity = 0) then exit;
   w := SourceRect.Right-SourceRect.Left;
   h := SourceRect.Bottom-SourceRect.Top;
 …
   ClipRect := oldClip;
+end;
+procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
+  Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean);
+begin
+  if ACorrectBlur then
+    PutImageAffine(Origin,HAxis,VAxis,Source,rfCosine,AOpacity)
+  else
+    PutImageAffine(Origin,HAxis,VAxis,Source,rfLinear,AOpacity);
+end;
+procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
+  Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte);
+var outputBounds: TRect;
+begin
+  if (Source = nil) or (AOpacity = 0) then exit;
+  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;
+  outputBounds := GetImageAffineBounds(Origin,HAxis,VAxis,Source);
+  PutImageAffine(Origin,HAxis,VAxis,Source,outputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity);
+end;
+procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
+  Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte;
+  ACorrectBlur: Boolean);
+begin
+  if ACorrectBlur then
+    PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfCosine,dmDrawWithTransparency, AOpacity)
+  else
+    PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity);
+end;
+{ Returns the area that contains the affine transformed image }
+function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF;
+  Source: TBGRACustomBitmap): TRect;
+var minx,miny,maxx,maxy: integer;
+    vx,vy,pt1: TPointF;
+    sourceBounds: TRect;
+  //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
+  result := EmptyRect;
+  if (Source = nil) then exit;
+  sourceBounds := source.GetImageBounds;
+  if IsRectEmpty(sourceBounds) then exit;
+  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
+    result := sourceBounds;
+    OffsetRect(result,round(origin.x),round(origin.y));
+    IntersectRect(result,result,ClipRect);
+    exit;
+  end;
+  { Compute bounds }
+  vx := (HAxis-Origin)*(1/source.Width);
+  vy := (VAxis-Origin)*(1/source.Height);
+  pt1 := Origin+vx*sourceBounds.Left+vy*sourceBounds.Top;
+  minx := floor(pt1.X);
+  miny := floor(pt1.Y);
+  maxx := ceil(pt1.X);
+  maxy := ceil(pt1.Y);
+  Include(Origin+vx*sourceBounds.Right+vy*sourceBounds.Top);
+  Include(Origin+vx*sourceBounds.Right+vy*sourceBounds.Bottom);
+  Include(Origin+vx*sourceBounds.Left+vy*sourceBounds.Bottom);
+  result := rect(minx,miny,maxx+1,maxy+1);
+  IntersectRect(result,result,ClipRect);
+end;
+procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect;
+  imageCenterX: single; imageCenterY: single; AOpacity: Byte;
+  ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean);
+begin
+  if ACorrectBlur then
+    PutImageAngle(x,y,Source,angle,AOutputBounds,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation)
+  else
+    PutImageAngle(x,y,Source,angle,AOutputBounds,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation);
+end;
+procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
+  imageCenterY: single; AOpacity: Byte; ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean);
+begin
+  if ACorrectBlur then
+    PutImageAngle(x,y,Source,angle,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation)
+  else
+    PutImageAngle(x,y,Source,angle,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation);
+end;
+procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect;
+  AResampleFilter: TResampleFilter; imageCenterX: single; imageCenterY: single; AOpacity: Byte;
+  ARestoreOffsetAfterRotation: boolean);
+var
+  Origin,HAxis,VAxis: TPointF;
+begin
+  if (source = nil) or (AOpacity=0) then exit;
+  ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation,
+     Origin,HAxis,VAxis);
+  PutImageAffine(Origin,HAxis,VAxis,source,AOutputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity);
+end;
+procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter;
+  imageCenterX: single; imageCenterY: single; AOpacity: Byte;
+  ARestoreOffsetAfterRotation: boolean);
+var
+  Origin,HAxis,VAxis: TPointF;
+begin
+  if (source = nil) or (AOpacity=0) then exit;
+  ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation,
+     Origin,HAxis,VAxis);
+  PutImageAffine(Origin,HAxis,VAxis,source,AResampleFilter,AOpacity);
+end;
+procedure TBGRACustomBitmap.ComputeImageAngleAxes(x, y, w, h,
+  angle: single; imageCenterX, imageCenterY: single;
+  ARestoreOffsetAfterRotation: boolean; out Origin, HAxis, VAxis: TPointF);
+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;
+    if ARestoreOffsetAfterRotation then
+    begin
+      result.x += imageCenterX;
+      result.y += imageCenterY;
+    end;
+  end;
+begin
+  cosa := cos(-angle*Pi/180);
+  sina := -sin(-angle*Pi/180);
+  Origin := Coord(0,0);
+  HAxis := Coord(w,0);
+  VAxis := Coord(0,h);
+end;
+function TBGRACustomBitmap.GetImageAngleBounds(x, y: single;
+  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
+  imageCenterY: single; ARestoreOffsetAfterRotation: boolean): TRect;
+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;
+    if ARestoreOffsetAfterRotation then
+    begin
+      result.x += imageCenterX;
+      result.y += imageCenterY;
+    end;
+  end;
+begin
+  if (source = nil) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  cosa := cos(-angle*Pi/180);
+  sina := -sin(-angle*Pi/180);
+  result := GetImageAffineBounds(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source);
+end;
+procedure TBGRACustomBitmap.VerticalFlip;
+begin
+  VerticalFlip(rect(0,0,Width,Height));
+end;
+procedure TBGRACustomBitmap.HorizontalFlip;
+begin
+  HorizontalFlip(rect(0,0,Width,Height));
+end;
+procedure TBGRACustomBitmap.ApplyMask(mask: TBGRACustomBitmap);
+begin
+  ApplyMask(mask, Rect(0,0,Width,Height), Point(0,0));
+end;
+procedure TBGRACustomBitmap.ApplyMask(mask: TBGRACustomBitmap; ARect: TRect);
+begin
+  ApplyMask(mask, ARect, ARect.TopLeft);
 end;
 …
 {************************** Color functions **************************}
+function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb,
+  maxyb, ignoreleft: integer; const cliprect: TRect): boolean;
+var x2,y2: integer;
+begin
+  if (x >= cliprect.Right) or (y >= cliprect.Bottom) or (x <= cliprect.Left-tx) or
+    (y <= cliprect.Top-ty) or (ty <= 0) or (tx <= 0) then
+  begin
+    result := false;
+    exit;
+  end;
+  x2 := x + tx - 1;
+  y2 := y + ty - 1;
+  if y < cliprect.Top then
+    minyb := cliprect.Top
+  else
+    minyb := y;
+  if y2 >= cliprect.Bottom then
+    maxyb := cliprect.Bottom - 1
+  else
+    maxyb := y2;
+  if x < cliprect.Left then
+  begin
+    ignoreleft := cliprect.Left-x;
+    minxb      := cliprect.Left;
+  end
+  else
+  begin
+    ignoreleft := 0;
+    minxb      := x;
+  end;
+  if x2 >= cliprect.Right then
+    maxxb := cliprect.Right - 1
+  else
+    maxxb := x2;
+  result := true;
+end;
 { The intensity is defined here as the maximum value of any color component }
 function GetIntensity(c: TExpandedPixel): word; inline;
+function GetIntensity(const c: TExpandedPixel): word; inline;
 begin
   Result := c.red;
 …
 end;
+function SetIntensity(c: TExpandedPixel; intensity: word): TExpandedPixel;
+function GetIntensity(c: TBGRAPixel): word;
+begin
+  Result := c.red;
+  if c.green > Result then
+    Result := c.green;
+  if c.blue > Result then
+    Result := c.blue;
+  result := GammaExpansionTab[Result];
+end;
+function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
 var
   curIntensity: word;
 …
   curIntensity := GetIntensity(c);
   if curIntensity = 0 then //suppose it's gray if there is no color information
+    Result := c
+  begin
+    Result.red := intensity;
+    Result.green := intensity;
+    Result.blue := intensity;
+    result.alpha := c.alpha;
+  end
   else
   begin
 …
 end;
+function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel;
+begin
+  result := GammaCompression(SetIntensity(GammaExpansion(c),intensity));
+end;
+function GetLightness(c: TBGRAPixel): word;
+begin
+  result := GetLightness(GammaExpansion(c));
+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;
+function GetLightness(const c: TExpandedPixel): word; inline;
 begin
   Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 +
 …
 end;
 function SetLightness(c: TExpandedPixel; lightness: word): TExpandedPixel;
+function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
 var
   curLightness: word;
-  AddedWhiteness, maxBeforeWhite: word;
-  clip: boolean;
 begin
   curLightness := GetLightness(c);
 …
     exit;
   end;
+  result := SetLightness(c, lightness, curLightness);
+end;
+function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
+begin
+  result := GammaCompression(SetLightness(GammaExpansion(c),lightness));
+end;
+function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel;
+var
+  AddedWhiteness, maxBeforeWhite: word;
+  clip: boolean;
+begin
+  if lightness = curLightness then
+  begin //no change
+    Result := c;
+    exit;
+  end;
   if lightness = 65535 then //set to white
   begin
 …
   if lightness < curLightness then //darker is easy
   begin
+    Result := SetIntensity(c, (GetIntensity(c) * lightness + (curLightness shr 1)) div
+      curLightness);
+    result.alpha:= c.alpha;
+    result.red := (c.red * lightness + (curLightness shr 1)) div curLightness;
+    result.green := (c.green * lightness + (curLightness shr 1)) div curLightness;
+    result.blue := (c.blue * lightness + (curLightness shr 1)) div curLightness;
     exit;
   end;
 …
 end;
 function CombineLightness(lightness1,lightness2: integer): integer;
+function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
 {$ifdef CPUI386} {$asmmode intel} assembler;
   asm
 …
 end;
 function ExpandedToHSLA(ec: TExpandedPixel): THSLAPixel;
+procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline;
 const
+  deg60  = 8192;
+  deg120 = deg60 * 2;
+  deg240 = deg60 * 4;
+  deg360 = deg60 * 6;
+  deg60  = 10922;
+  deg120 = 21845;
+  deg240 = 43690;
 var
+  min, max, minMax: integer;
+  twiceLightness: 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, max, minMax: Int32or64;
+  UMinMax,UTwiceLightness: UInt32or64;
+begin
+  if g > r then
+  begin
+    max := g;
+    min := r;
+  end
+  else
+  begin
+    max := r;
     min := g;
+  end;
   if b > max then
     max := b
 …
   if minMax = 0 then
     Result.hue := 0
+    dest.hue := 0
   else
   if max = r then
+    Result.hue := (((g - b) * deg60) div
+      minMax + deg360) mod deg360
+    {$PUSH}{$RANGECHECKS OFF}
+    dest.hue := ((g - b) * deg60) div minMax
+    {$POP}
   else
   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;
+    dest.hue := ((b - r) * deg60) div minMax + deg120
+  else
+    {max = b} dest.hue := ((r - g) * deg60) div minMax + deg240;
+  UTwiceLightness := max + min;
   if min = max then
+    Result.saturation := 0
+  else
+  {$hints off}
+  if twiceLightness < 65536 then
+    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 shl 16) div deg360;
+    dest.saturation := 0
+  else
+  begin
+    UMinMax:= minMax;
+    if UTwiceLightness < 65536 then
+      dest.saturation := (UMinMax shl 16) div (UTwiceLightness + 1)
+    else
+      dest.saturation := (UMinMax shl 16) div (131072 - UTwiceLightness);
+  end;
+  dest.lightness := UTwiceLightness shr 1;
+end;
+function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
+begin
+  result.alpha := ec.alpha;
+  ExpandedToHSLAInline(ec.red,ec.green,ec.blue,result);
 end;
 function HtoG(hue: word): word;
 const
   segmentDest: array[0..5] of word =
+  segmentDest: array[0..5] of NativeUInt =
      (13653, 10923, 8192, 13653, 10923, 8192);
   segmentSrc: array[0..5] of word =
+  segmentSrc: array[0..5] of NativeUInt =
      (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]
+var
+  h,g: NativeUInt;
+begin
+  h := hue;
+  if h < segmentSrc[0] then
+    g := h * segmentDest[0] div segmentSrc[0]
+  else
+  begin
+    g := segmentDest[0];
+    h -= segmentSrc[0];
+    if h < segmentSrc[1] then
+      g += h * 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]
+      g += segmentDest[1];
+      h -= segmentSrc[1];
+      if h < segmentSrc[2] then
+        g += h * 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]
+        g += segmentDest[2];
+        h -= segmentSrc[2];
+        if h < segmentSrc[3] then
+          g += h * 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]
+          g += segmentDest[3];
+          h -= segmentSrc[3];
+          if h < segmentSrc[4] then
+            g += h * segmentDest[4] div segmentSrc[4]
           else
           begin
             result += segmentDest[4];
             hue -= segmentSrc[4];
             result += hue * segmentDest[5] div segmentSrc[5];
+            g += segmentDest[4];
+            h -= segmentSrc[4];
+            g += h * segmentDest[5] div segmentSrc[5];
           end;
         end;
 …
     end;
   end;
+  result := g;
 end;
 function GtoH(ghue: word): word;
 const
   segment: array[0..5] of word =
+  segment: array[0..5] of NativeUInt =
      (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
+var g: NativeUint;
+begin
+  g := ghue;
+  if g < segment[0] then
+    result := g * 10923 div segment[0]
+  else
+  begin
+    g -= segment[0];
+    if g < segment[1] then
+      result := g * (21845-10923) div segment[1] + 10923
     else
     begin
       ghue -= segment[1];
       if ghue < segment[2] then
         result := ghue * (32768-21845) div segment[2] + 21845
+      g -= segment[1];
+      if g < segment[2] then
+        result := g * (32768-21845) div segment[2] + 21845
       else
       begin
         ghue -= segment[2];
         if ghue < segment[3] then
           result := ghue * (43691-32768) div segment[3] + 32768
+        g -= segment[2];
+        if g < segment[3] then
+          result := g * (43691-32768) div segment[3] + 32768
         else
         begin
           ghue -= segment[3];
           if ghue < segment[4] then
             result := ghue * (54613-43691) div segment[4] + 43691
+          g -= segment[3];
+          if g < segment[4] then
+            result := g * (54613-43691) div segment[4] + 43691
           else
           begin
             ghue -= segment[4];
             result := ghue * (65536-54613) div segment[5] + 54613;
+            g -= segment[4];
+            result := g * (65536-54613) div segment[5] + 54613;
           end;
         end;
 …
 end;
+function BGRAToGSBA(c: TBGRAPixel): THSLAPixel;
+var ec: TExpandedPixel;
+    lightness: word;
+begin
+  ec := GammaExpansion(c);
+  lightness := GetLightness(ec);
+  result := ExpandedToHSLA(ec);
+function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
+var lightness: UInt32Or64;
+    red,green,blue: Int32or64;
+begin
+  red   := GammaExpansionTab[c.red];
+  green := GammaExpansionTab[c.green];
+  blue  := GammaExpansionTab[c.blue];
+  result.alpha := c.alpha shl 8 + c.alpha;
+  lightness := (red * redWeightShl10 + green * greenWeightShl10 +
+    blue * blueWeightShl10 + 512) shr 10;
+  ExpandedToHSLAInline(red,green,blue,result);
   if result.lightness > 32768 then
     result.saturation := result.saturation* word(65535-result.lightness) div 32767;
+    result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767;
   result.lightness := lightness;
   result.hue := HtoG(result.hue);
 end;
+function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
+function ExpandedToGSBA(ec: TExpandedPixel): TGSBAPixel;
+var lightness: UInt32Or64;
+    red,green,blue: Int32or64;
+begin
+  red   := ec.red;
+  green := ec.green;
+  blue  := ec.blue;
+  result.alpha := ec.alpha;
+  lightness := (red * redWeightShl10 + green * greenWeightShl10 +
+    blue * blueWeightShl10 + 512) shr 10;
+  ExpandedToHSLAInline(red,green,blue,result);
+  if result.lightness > 32768 then
+    result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767;
+  result.lightness := lightness;
+  result.hue := HtoG(result.hue);
+end;
+function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
 const
   deg30  = 4096;
 …
   deg360 = deg60 * 6;
+  function ComputeColor(p, q: integer; h: integer): word; inline;
+  begin
+    if h > deg360 then
+      Dec(h, deg360);
+    if h < deg60 then
+      Result := p + ((q - p) * h + deg30) div deg60
+    else
+  function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline;
+  begin
     if h < deg180 then
+      Result := q
+    else
+    if h < deg240 then
+      Result := p + ((q - p) * (deg240 - h) + deg30) div deg60
+    else
+      Result := p;
+    begin
+      if h < deg60 then
+        Result := p + ((q - p) * h + deg30) div deg60
+      else
+        Result := q
+    end else
+    begin
+      if h < deg240 then
+        Result := p + ((q - p) * (deg240 - h) + deg30) div deg60
+      else
+        Result := p;
+    end;
   end;
 var
+  q, p: integer;
+begin
+  c.hue := c.hue * deg360 shr 16;
+  if c.saturation = 0 then  //gray
+  begin
+    result.red   := c.lightness;
+    result.green := c.lightness;
+    result.blue  := c.lightness;
+  q, p, L, S, H: Int32or64;
+begin
+  L := c.lightness;
+  S := c.saturation;
+  if S = 0 then  //gray
+  begin
+    result.red   := L;
+    result.green := L;
+    result.blue  := L;
     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
   else
     q := c.lightness + c.saturation - ((c.lightness shr 1) *
       (c.saturation shr 1) shr 14);
+  if L < 32768 then
+    q := (L shr 1) * ((65535 + S) shr 1) shr 14
+  else
+    q := L + S - ((L shr 1) *
+      (S shr 1) shr 14);
   {$hints on}
+  if q > 65535 then
+    q := 65535;
+  p   := c.lightness * 2 - q;
+  if p > 65535 then
+    p      := 65535;
+  result.red   := ComputeColor(p, q, c.hue + deg120);
+  result.green := ComputeColor(p, q, c.hue);
+  result.blue  := ComputeColor(p, q, c.hue + deg240);
+  if q > 65535 then q := 65535;
+  p   := (L shl 1) - q;
+  if p > 65535 then p := 65535;
+  H := c.hue * deg360 shr 16;
+  result.green := ComputeColor(p, q, H);
+  inc(H, deg120);
+  if H > deg360 then Dec(H, deg360);
+  result.red   := ComputeColor(p, q, H);
+  inc(H, deg120);
+  if H > deg360 then Dec(H, deg360);
+  result.blue  := ComputeColor(p, q, H);
   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;
+function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
 var ec: TExpandedPixel;
 begin
 …
 end;
 function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
+function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
 var ec: TExpandedPixel;
     lightness: word;
 …
 end;
+function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
+function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
+var lightness: word;
+begin
+  c.hue := GtoH(c.hue);
+  lightness := c.lightness;
+  c.lightness := 32768;
+  result := SetLightness(HSLAToExpanded(c),lightness);
+end;
+function GSBAToHSLA(c: TGSBAPixel): THSLAPixel;
 begin
   result := BGRAToHSLA(GSBAToBGRA(c));
 …
 end;
 function GammaCompression(ec: TExpandedPixel): TBGRAPixel;
+function GammaCompression(const ec: TExpandedPixel): TBGRAPixel;
 begin
   Result.red   := GammaCompressionTab[ec.red];
 …
   cgray: byte;
 begin
+  if c.alpha = 0 then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
   //gamma expansion
   ec    := GammaExpansion(c);
 …
 function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel;
 var
   sumR,sumG,sumB,sumA: longword;
+  sumR,sumG,sumB,sumA: NativeUInt;
   i: integer;
 begin
 …
   weight2: byte): TBGRAPixel;
 var
+    f1,f2: word;
+    f12: longword;
+begin
+  if (weight1 = 0) then
+  begin
+    if (weight2 = 0) then
+    w1,w2,f1,f2,f12,a: UInt32or64;
+begin
+  w1 := weight1;
+  w2 := weight2;
+  if (w1 = 0) then
+  begin
+    if (w2 = 0) then
       result := BGRAPixelTransparent
     else
 …
   end
   else
   if (weight2 = 0) then
+  if (w2 = 0) then
     Result := c1
   else
   begin
+    f1 := c1.alpha*weight1 shr 1;
+    f2 := c2.alpha*weight2 shr 1;
+    f1 := c1.alpha*w1;
+    f2 := c2.alpha*w2;
+    a := (f1+f2 + ((w1+w2) shr 1)) div (w1+w2);
+    if a = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end else
+      Result.alpha := a;
+    {$IFNDEF CPU64}
+    if (f1 >= 32768) or (f2 >= 32768) then
+    begin
+      f1 := f1 shr 1;
+      f2 := f2 shr 1;
+    end;
+    {$ENDIF}
     f12 := f1+f2;
+    if f12 = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      Result.red   := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12];
+      Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12];
+      Result.blue  := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12];
+      Result.alpha := (c1.alpha*weight1+c2.alpha*weight2 + ((weight1+weight2) shr 1)) div (weight1+weight2);
+    end;
+    Result.red   := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12];
+    Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12];
+    Result.blue  := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12];
   end;
 end;
 …
 end;
+{ Write a color in hexadecimal format RRGGBBAA }
+function BGRAToStr(c: TBGRAPixel): string;
+begin
+{ Write a color in hexadecimal format RRGGBBAA or using the name in a color list }
+function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; AMaxDiff: Word= 0): string;
+var idx: integer;
+begin
+  if Assigned(AColorList) then
+  begin
+    idx := AColorList.IndexOfColor(c, AMaxDiff);
+    if idx<> -1 then
+    begin
+      result := AColorList.Name[idx];
+      exit;
+    end;
+  end;
   result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
 end;
 …
     arrayOfString = array of string;
 function SimpleParseFuncParam(str: string): arrayOfString;
+function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString;
 var idxOpen,start,cur: integer;
 begin
     result := nil;
     idxOpen := pos('(',str);
+    if idxOpen = 0 then exit;
+    start := idxOpen+1;
+    if idxOpen = 0 then
+    begin
+      start := 1;
+      //find first space
+      while (start <= length(str)) and (str[start]<>' ') do inc(start);
+    end else
+      start := idxOpen+1;
     cur := start;
     while cur <= length(str) do
 …
        begin
          setlength(result,length(result)+1);
          result[high(result)] := copy(str,start,cur-start);
+         result[high(result)] := trim(copy(str,start,cur-start));
          start := cur+1;
+         if str[cur] = ')' then exit;
        end;
        inc(cur);
     end;
+    if idxOpen <> 0 then flagError := true; //should exit on ')'
     if start <= length(str) then
     begin
 …
 end;
 function ParseColorValue(str: string): byte;
+function ParseColorValue(str: string; var flagError: boolean): byte;
 var pourcent,unclipped,{%H-}errPos: integer;
 begin
 …
     begin
       val(copy(str,1,length(str)-1),pourcent,errPos);
+      if errPos <> 0 then flagError := true;
       if pourcent < 0 then result := 0 else
       if pourcent > 100 then result := 255 else
 …
     begin
       val(str,unclipped,errPos);
+      if errPos <> 0 then flagError := true;
       if unclipped < 0 then result := 0 else
       if unclipped > 255 then result := 255 else
 …
 end;
+//this function returns the parsed value only if it contains no error nor missing values, otherwise
+//it returns BGRAPixelTransparent
 function StrToBGRA(str: string): TBGRAPixel;
+begin
+  result := StrToBGRA(str, BGRAPixelTransparent);
+end;
+{ Read a color in hexadecimal format RRGGBB(AA) or RGB(A) }
+function StrToBGRA(str: string; DefaultColor: TBGRAPixel): TBGRAPixel;
+var missingValues, error: boolean;
+begin
+  result := BGRABlack;
+  TryStrToBGRA(str, result, missingValues, error);
+  if missingValues or error then result := BGRAPixelTransparent;
+end;
+//this function changes the content of parsedValue depending on available and parsable information.
+//set parsedValue to the fallback values before calling this function.
+//missing values are expressed by empty string or by '?', for example 'rgb(255,?,?,?)' will change only the red value.
+//note that if alpha is not expressed by the string format, it will be opaque. So 'rgb(255,?,?)' will change the red value and the alpha value.
+//the last parameter of rgba() is a floating point number where 1 is opaque and 0 is transparent.
+procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean);
 var errPos: integer;
     values: array of string;
 …
     idx: integer;
 begin
+  if str = '' then
+  begin
+    result := DefaultColor;
+  str := Trim(str);
+  error := false;
+  if (str = '') or (str = '?') then
+  begin
+    missingValues := true;
     exit;
+  end;
+  str := lowerCase(str);
+  end else
+    missingValues := false;
+  str := StringReplace(lowerCase(str),'grey','gray',[]);
   //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='grey' 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 := DefaultColor else
+  idx := VGAColors.IndexOf(str);
+  if idx <> -1 then
+  begin
+    parsedValue := VGAColors[idx];
+    exit;
+  end;
+  if str='transparent' then parsedValue := BGRAPixelTransparent else
   begin
     //check CSS color
 …
     if idx <> -1 then
     begin
       result := CSSColors[idx];
+      parsedValue := CSSColors[idx];
       exit;
     end;
     //CSS RGB notation
+    if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') then
+    if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') or
+      (copy(str,1,4)='rgb ') or (copy(str,1,5)='rgba ') then
     begin
       values := SimpleParseFuncParam(str);
+      values := SimpleParseFuncParam(str,error);
       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 (values[0] <> '') and (values[0] <> '?') then
+           parsedValue.red := ParseColorValue(values[0], error)
+        else
+           missingValues := true;
+        if (values[1] <> '') and (values[1] <> '?') then
+           parsedValue.green := ParseColorValue(values[1], error)
+        else
+           missingValues := true;
+        if (values[2] <> '') and (values[2] <> '?') then
+           parsedValue.blue := ParseColorValue(values[2], error)
+        else
+           missingValues := true;
         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);
+          if (values[3] <> '') and (values[3] <> '?') then
+          begin
+            val(values[3],alphaF,errPos);
+            if errPos <> 0 then
+            begin
+               parsedValue.alpha := 255;
+               error := true;
+            end
+            else
+            begin
+              if alphaF < 0 then
+                parsedValue.alpha := 0 else
+              if alphaF > 1 then
+                parsedValue.alpha := 255
+              else
+                parsedValue.alpha := round(alphaF*255);
+            end;
+          end else
+            missingValues := true;
         end else
           result.alpha := 255;
+          parsedValue.alpha := 255;
       end else
         result := DefaultColor;
+        error := true;
       exit;
     end;
 …
     if str[1]='#' then delete(str,1,1);
     //add alpha if missing
+    //add alpha if missing (if you want an undefined alpha use '??' or '?')
     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);
+      if errPos <> 0 then
+      if copy(str,1,2) <> '??' then
       begin
+        result := DefaultColor;
+        exit;
+      end;
+      val('$'+copy(str,3,2),result.green,errPos);
+      if errPos <> 0 then
+        val('$'+copy(str,1,2),parsedValue.red,errPos);
+        if errPos <> 0 then error := true;
+      end else missingValues := true;
+      if copy(str,3,2) <> '??' then
       begin
+        result := DefaultColor;
+        exit;
+      end;
+      val('$'+copy(str,5,2),result.blue,errPos);
+      if errPos <> 0 then
+        val('$'+copy(str,3,2),parsedValue.green,errPos);
+        if errPos <> 0 then error := true;
+      end else missingValues := true;
+      if copy(str,5,2) <> '??' then
       begin
+        result := DefaultColor;
+        exit;
+      end;
+      val('$'+copy(str,7,2),result.alpha,errPos);
+      if errPos <> 0 then
+        val('$'+copy(str,5,2),parsedValue.blue,errPos);
+        if errPos <> 0 then error := true;
+      end else missingValues := true;
+      if copy(str,7,2) <> '??' then
       begin
+        result := DefaultColor;
+        exit;
+      end;
+        val('$'+copy(str,7,2),parsedValue.alpha,errPos);
+        if errPos <> 0 then
+        begin
+          error := true;
+          parsedValue.alpha := 255;
+        end;
+      end else missingValues := true;
     end else
     if length(str)=4 then
     begin
+      val('$'+copy(str,1,1),result.red,errPos);
+      if errPos <> 0 then
+      if str[1] <> '?' then
       begin
         result := DefaultColor;
         exit;
       end;
       val('$'+copy(str,2,1),result.green,errPos);
       if errPos <> 0 then
+        val('$'+str[1],parsedValue.red,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.red *= $11;
+      end else missingValues := true;
+      if str[2] <> '?' then
       begin
         result := DefaultColor;
         exit;
       end;
       val('$'+copy(str,3,1),result.blue,errPos);
       if errPos <> 0 then
+        val('$'+str[2],parsedValue.green,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.green *= $11;
+      end else missingValues := true;
+      if str[3] <> '?' then
       begin
         result := DefaultColor;
         exit;
       end;
       val('$'+copy(str,4,1),result.alpha,errPos);
       if errPos <> 0 then
+        val('$'+str[3],parsedValue.blue,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.blue *= $11;
+      end else missingValues := true;
+      if str[4] <> '?' then
       begin
+        result := DefaultColor;
+        exit;
+      end;
+      result.red *= $11;
+      result.green *= $11;
+      result.blue *= $11;
+      result.alpha *= $11;
+        val('$'+str[4],parsedValue.alpha,errPos);
+        if errPos <> 0 then
+        begin
+          error := true;
+          parsedValue.alpha := 255;
+        end else
+          parsedValue.alpha *= $11;
+      end else missingValues := true;
     end else
+      result := DefaultColor;
+  end;
+      error := true; //string format not recognised
+  end;
+end;
+//this function returns the values that can be read from the string, otherwise
+//it fills the gaps with the fallback values. The error boolean is True only
+//if there was invalid values, it is not set to True if there was missing values.
+function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out
+  error: boolean): TBGRAPixel;
+var missingValues: boolean;
+begin
+  result := fallbackValues;
+  TryStrToBGRA(str, result, missingValues, error);
+end;
+{ Read a color, for example in hexadecimal format RRGGBB(AA) or RGB(A). Partial colors are not accepted by this function. }
+function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel;
+var missingValues, error: boolean;
+begin
+  result := BGRABlack;
+  TryStrToBGRA(str, result, missingValues, error);
+  if missingValues or error then result := DefaultColor;
 end;
 …
 begin
   intval := color.Green shl 16 + color.red shl 8 + color.blue;
   result := intval/16777215;
+  result := intval*5.960464832810452e-8;
 end;
 …
 end;
 function PtInRect(pt: TPoint; r: TRect): boolean;
+function PtInRect(const pt: TPoint; r: TRect): boolean;
 var
   temp: integer;
 …
 end;
+function RectWithSize(left, top, width, height: integer): TRect;
+begin
+  result.left := left;
+  result.top := top;
+  result.right := left+width;
+  result.bottom := top+height;
+end;
 function VectLen(dx, dy: single): single;
 begin
 …
   result := sqrt(v.x*v.x+v.y*v.y);
 end;
+{$OPTIMIZATION OFF}  // Modif J.P  5/2013
 function IntersectLine(line1, line2: TLineDef): TPointF;
 var parallel: boolean;
 …
   result := IntersectLine(line1,line2,parallel);
 end;
+{$OPTIMIZATION ON}
 function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
 …
 // Get the cyclic value in the range [0..cycle-1]
 function PositiveMod(value, cycle: integer): integer; inline;
+function PositiveMod(value, cycle: Int32or64): Int32or64; inline;
 begin
   result := value mod cycle;
 …
   byteSqrtTab: packed array of word;
 function Sin65536(value: word): integer;
+function Sin65536(value: word): Int32or64;
 var b: integer;
 begin
 …
 end;
+function Cos65536(value: word): integer;
+begin
+function Cos65536(value: word): Int32or64;
+begin
+  {$PUSH}{$R-}
   result := Sin65536(value+16384); //cosine is translated
+  {$POP}
 end;
 …
 end;
+function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat;
+var stream: TFileStreamUTF8;
+begin
+  try
+    stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite);
+  except
+    result := ifUnknown;
+    exit;
+  end;
+  try
+    result := DetectFileFormat(stream, ExtractFileExt(AFilenameUTF8));
+  finally
+    stream.Free;
+  end;
+end;
+function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string
+  ): TBGRAImageFormat;
+var
+  scores: array[TBGRAImageFormat] of integer;
+  imageFormat,bestImageFormat: TBGRAImageFormat;
+  bestScore: integer;
+  procedure DetectFromStream;
+  var
+    {%H-}magic: packed array[0..7] of byte;
+    {%H-}dwords: packed array[0..9] of DWORD;
+    magicAsText: string;
+    streamStartPos, maxFileSize: Int64;
+    expectedFileSize: DWord;
+    procedure DetectTarga;
+    var
+      paletteCount: integer;
+      {%H-}targaPixelFormat: packed record pixelDepth: byte; imgDescriptor: byte; end;
+    begin
+      if (magic[1] in[$00,$01]) and (magic[2] in[0,1,2,3,9,10,11]) and (maxFileSize >= 18) then
+      begin
+        paletteCount:= magic[5] + magic[6] shl 8;
+        if ((paletteCount = 0) and (magic[7] = 0)) or
+          (magic[7] in [16,24,32]) then //check palette bit count
+        begin
+          AStream.Position:= streamStartPos+16;
+          if AStream.Read({%H-}targaPixelFormat,2) = 2 then
+          begin
+            if (targaPixelFormat.pixelDepth in [8,16,24,32]) and
+              (targaPixelFormat.imgDescriptor and 15 < targaPixelFormat.pixelDepth) then
+                inc(scores[ifTarga],2);
+          end;
+        end;
+      end;
+    end;
+    procedure DetectLazPaint;
+    var
+      w,h: dword;
+      i: integer;
+    begin
+      if (copy(magicAsText,1,8) = 'LazPaint') then //with header
+      begin
+        AStream.Position:= streamStartPos+8;
+        if AStream.Read(dwords,10*4) = 10*4 then
+        begin
+          for i := 0 to 6 do dwords[i] := LEtoN(dwords[i]);
+          if (dwords[0] = 0) and (dwords[1] <= expectedFileSize) and (dwords[5] <= expectedFileSize) and
+             (dwords[9] <= expectedFileSize) and
+            (dwords[6] = 0) then inc(scores[ifLazPaint],2);
+        end;
+      end else //without header
+      if ((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and
+         ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0) then
+      begin
+        w := magic[0] + (magic[1] shl 8);
+        h := magic[4] + (magic[5] shl 8);
+        AStream.Position:= streamStartPos+8;
+        if AStream.Read(dwords,4) = 4 then
+        begin
+          dwords[0] := LEtoN(dwords[0]);
+          if (dwords[0] > 0) and (dwords[0] < 65536) then
+          begin
+            if 12+dwords[0] < expectedFileSize then
+            begin
+              AStream.Position:= streamStartPos+12+dwords[0];
+              if AStream.Read(dwords,6*4) = 6*4 then
+              begin
+                for i := 0 to 5 do dwords[i] := LEtoN(dwords[i]);
+                if (dwords[0] <= w) and (dwords[1] <= h) and
+                  (dwords[2] <= w) and (dwords[3] <= h) and
+                  (dwords[2] >= dwords[0]) and (dwords[3] >= dwords[1]) and
+                  ((dwords[4] = 0) or (dwords[4] = 1)) and
+                  (dwords[5] > 0) then inc(scores[ifLazPaint],1);
+              end;
+            end;
+          end;
+        end;
+      end;
+    end;
+  begin
+    fillchar({%H-}magic, sizeof(magic), 0);
+    fillchar({%H-}dwords, sizeof(dwords), 0);
+    streamStartPos:= AStream.Position;
+    maxFileSize:= AStream.Size - streamStartPos;
+    if maxFileSize < 8 then exit;
+    if AStream.Read(magic,sizeof(magic)) <> sizeof(magic) then
+    begin
+      fillchar(scores,sizeof(scores),0);
+      exit;
+    end;
+    setlength(magicAsText,sizeof(magic));
+    move(magic[0],magicAsText[1],sizeof(magic));
+    if (magic[0] = $ff) and (magic[1] = $d8) then
+    begin
+         inc(scores[ifJpeg]);
+         if (magic[2] = $ff) and (magic[3] >= $c0) then inc(scores[ifJpeg]);
+    end;
+    if (magic[0] = $89) and (magic[1] = $50) and (magic[2] = $4e) and
+      (magic[3] = $47) and (magic[4] = $0d) and (magic[5] = $0a) and
+      (magic[6] = $1a) and (magic[7] = $0a) then inc(scores[ifPng],2);
+    if (copy(magicAsText,1,6)='GIF87a') or (copy(magicAsText,1,6)='GIF89a') then inc(scores[ifGif],2);
+    if (magic[0] = $0a) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) then
+      inc(scores[ifPcx],2);
+    if (copy(magicAsText,1,2)='BM') then
+    begin
+      inc(scores[ifBmp]);
+      expectedFileSize:= magic[2] + (magic[3] shl 8) + (magic[4] shl 16) + (magic[5] shl 24);
+      if expectedFileSize = maxFileSize then inc(scores[ifBmp]);
+    end else
+    if (copy(magicAsText,1,2)='RL') then
+    begin
+      inc(scores[ifBmpMioMap]);
+      if (magic[2] in[0,1]) and (magic[3] = 0) then inc(scores[ifBmpMioMap]);
+    end;
+    if (magic[0] = $00) and (magic[1] = $00) and (magic[2] in[$01,$02]) and (magic[3] = $00) and
+      (magic[4] + (magic[5] shl 8) > 0) then inc(scores[ifIco]);
+    if (copy(magicAsText,1,4) = 'PDN3') then
+    begin
+      expectedFileSize:= 6 + (magic[4] + (magic[5] shl 8) + (magic[6] shl 16)) + 2;
+      if expectedFileSize <= maxFileSize then
+      begin
+        inc(scores[ifPaintDotNet]);
+        if magic[7] = $3c then inc(scores[ifPaintDotNet]);
+      end;
+    end;
+    DetectLazPaint;
+    if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then
+    begin
+      if DefaultBGRAImageReader[ifOpenRaster] = nil then inc(scores[ifOpenRaster]) else
+      with CreateBGRAImageReader(ifOpenRaster) do
+        try
+          if CheckContents(AStream) then inc(scores[ifOpenRaster],2);
+        finally
+          Free;
+        end;
+    end;
+    if (copy(magicAsText,1,4) = '8BPS') and (magic[4] = $00) and (magic[5] = $01) then inc(scores[ifPsd],2);
+    DetectTarga;
+    if (copy(magicAsText,1,2)='II') and (magic[2] = 42) and (magic[3]=0) then inc(scores[ifTiff]) else
+    if (copy(magicAsText,1,2)='MM') and (magic[2] = 0) and (magic[3]=42) then inc(scores[ifTiff]);
+    if (copy(magicAsText,1,8) = '/* XPM *') or (copy(magicAsText,1,6) = '! XPM2') then inc(scores[ifXPixMap]);
+    AStream.Position := streamStartPos;
+  end;
+var
+  extFormat: TBGRAImageFormat;
+begin
+  result := ifUnknown;
+  for imageFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do
+    scores[imageFormat] := 0;
+  ASuggestedExtensionUTF8:= UTF8LowerCase(ASuggestedExtensionUTF8);
+  if (ASuggestedExtensionUTF8 <> '') and (UTF8Copy(ASuggestedExtensionUTF8,1,1) <> '.') then
+    ASuggestedExtensionUTF8 := '.'+ASuggestedExtensionUTF8;
+  extFormat:= SuggestImageFormat(ASuggestedExtensionUTF8);
+  if extFormat <> ifUnknown then inc(scores[extFormat]);
+  If AStream <> nil then DetectFromStream;
+  bestScore := 0;
+  bestImageFormat:= ifUnknown;
+  for imageFormat:=low(TBGRAImageFormat) to high(TBGRAImageFormat) do
+    if scores[imageFormat] > bestScore then
+    begin
+      bestScore:= scores[imageFormat];
+      bestImageFormat:= imageFormat;
+    end;
+  result := bestImageFormat;
+end;
+function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
+var ext: string;
+begin
+  result := ifUnknown;
+  ext := ExtractFileName(AFilenameOrExtensionUTF8);
+  if pos('.', ext) <> 0 then ext := ExtractFileExt(ext) else ext := '.'+ext;
+  ext := UTF8LowerCase(ext);
+  if (ext = '.jpg') or (ext = '.jpeg') then result := ifJpeg else
+  if (ext = '.png') then result := ifPng else
+  if (ext = '.gif') then result := ifGif else
+  if (ext = '.pcx') then result := ifPcx else
+  if (ext = '.bmp') then result := ifBmp else
+  if (ext = '.ico') or (ext = '.cur') then result := ifIco else
+  if (ext = '.pdn') then result := ifPaintDotNet else
+  if (ext = '.lzp') then result := ifLazPaint else
+  if (ext = '.ora') then result := ifOpenRaster else
+  if (ext = '.psd') then result := ifPsd else
+  if (ext = '.tga') then result := ifTarga else
+  if (ext = '.tif') or (ext = '.tiff') then result := ifTiff else
+  if (ext = '.xwd') then result := ifXwd else
+  if (ext = '.xpm') then result := ifXPixMap;
+end;
+function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader;
+begin
+  if DefaultBGRAImageReader[AFormat] = nil then
+  begin
+    case AFormat of
+      ifUnknown: raise exception.Create('The image format is unknown.');
+      ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to read this image.');
+      ifPaintDotNet: raise exception.Create('You need to call BGRAPaintNet.RegisterPaintNetFormat to read this image.');
+    else
+      raise exception.Create('The image reader is not registered for this image format.');
+    end;
+  end;
+  result := DefaultBGRAImageReader[AFormat].Create;
+end;
+function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter;
+begin
+  if DefaultBGRAImageWriter[AFormat] = nil then
+  begin
+    case AFormat of
+      ifUnknown: raise exception.Create('The image format is unknown');
+      ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to write with this image format.');
+    else
+      raise exception.Create('The image writer is not registered for this image format.');
+    end;
+  end;
+  if AFormat = ifPng then
+  begin
+    result := TFPWriterPNG.Create;
+    TFPWriterPNG(result).Indexed := false;
+    TFPWriterPNG(result).WordSized := false;
+    TFPWriterPNG(result).UseAlpha := AHasTransparentPixels;
+  end else
+  if AFormat = ifBmp then
+  begin
+    result := TFPWriterBMP.Create;
+    if AHasTransparentPixels then
+      TFPWriterBMP(result).BitsPerPixel := 32 else
+      TFPWriterBMP(result).BitsPerPixel := 24;
+  end else
+  if AFormat = ifXPixMap then
+  begin
+    result := TFPWriterXPM.Create;
+    TFPWriterXPM(result).ColorCharSize := 2;
+  end else
+    result := DefaultBGRAImageWriter[AFormat].Create;
+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;
+  {$DEFINE INCLUDE_COLOR_LIST}
+  {$I csscolorconst.inc}
+  DefaultBGRAImageWriter[ifJpeg] := TFPWriterJPEG;
+  DefaultBGRAImageWriter[ifPng] := TFPWriterPNG;
+  DefaultBGRAImageWriter[ifBmp] := TFPWriterBMP;
+  DefaultBGRAImageWriter[ifPcx] := TFPWriterPCX;
+  DefaultBGRAImageWriter[ifTarga] := TFPWriterTarga;
+  DefaultBGRAImageWriter[ifXPixMap] := TFPWriterXPM;
+  DefaultBGRAImageWriter[ifTiff] := TFPWriterTiff;
+  //writing XWD not implemented
+  DefaultBGRAImageReader[ifTiff] := TFPReaderTiff;
+  DefaultBGRAImageReader[ifXwd] := TFPReaderXWD;
+  //the other readers are registered by their unit
 finalization
   CSSColors.Free;
+  VGAColors.Free;
 end.

GraphicTest/Packages/bgrabitmap/bgrablend.pas

-              r452
+              r472
 { Draw a series of pixels with alpha blending }
+procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer; mode: TDrawMode; AOpacity:byte);
 procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; overload;
 procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; Count: integer); inline; overload;
 …
 end;
+procedure PutPixels(pdest: PBGRAPixel; psource: PBGRAPixel; copycount: integer;
+  mode: TDrawMode; AOpacity: byte);
+var i: integer; tempPixel: TBGRAPixel;
+begin
+  case mode of
+    dmSet:
+    begin
+      if AOpacity <> 255 then
+          CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount)
+      else
+      begin
+        copycount *= sizeof(TBGRAPixel);
+        move(psource^, pdest^, copycount);
+      end;
+    end;
+    dmSetExceptTransparent:
+    begin
+        if AOpacity <> 255 then
+        begin
+          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;
+    end;
+    dmDrawWithTransparency:
+    begin
+        if AOpacity <> 255 then
+        begin
+          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;
+    end;
+    dmFastBlend:
+    begin
+        if AOpacity <> 255 then
+        begin
+          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;
+    end;
+    dmXor:
+    begin
+      if AOpacity <> 255 then
+      begin
+          for i := copycount - 1 downto 0 do
+          begin
+            FastBlendPixelInline(pdest, TBGRAPixel(PDWord(pdest)^ xor PDword(psource)^), AOpacity);
+            Inc(pdest);
+            Inc(psource);
+          end;
+      end else
+          XorPixels(pdest, psource, copycount);
+    end;
+  end;
+end;
 procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer);
 var
 …
   a1f, a2f, a12, a12m: cardinal;
 begin
+  {$HINTS OFF}
   a12  := 65025 - (not dest^.alpha) * (not c.alpha);
+  {$HINTS ON}
   a12m := a12 shr 1;
 …
   a1f, a2f, a12, a12m: cardinal;
 begin
+  {$HINTS OFF}
   a12  := 65025 - (not dest^.alpha) * (not calpha);
+  {$HINTS ON}
   a12m := a12 shr 1;
 …
   end;
+  {$HINTS OFF}
   a12  := 65025 - (not dest^.alpha) * (not c.alpha);
+  {$HINTS ON}
   a12m := a12 shr 1;

GraphicTest/Packages/bgrabitmap/bgracanvas.pas

-              r452
+              r472
 uses
   Classes, SysUtils, Graphics, GraphType, Types, FPImage, FPCanvas, BGRABitmapTypes;
+  Classes, SysUtils, FPCanvas, Graphics, GraphType, Types, FPImage, BGRABitmapTypes;
 type
 …
 procedure TBGRAFont.SetAntialiasing(const AValue: Boolean);
 begin
+  if AValue and not Antialiasing then
+    Quality := fqFineAntialiasing;
+  if AValue = Antialiasing then exit;
+  if AValue then
+    Quality := fqFineAntialiasing
+  else
+    Quality := fqSystem;
 end;
 …
     if cf.Italic then Style += [fsItalic];
     if cf.Underline then Style += [fsUnderline];
+{$IF FPC_FULLVERSION>=20602} //changed in 2.6.2 and 2.7
+    if cf.StrikeThrough then Style += [fsStrikeOut];
+{$ELSE}
     if cf.StrikeTrough then Style += [fsStrikeOut];
+{$ENDIF}
     Name := cf.Name;
     //Orientation := cf.Orientation;
 …
     dec(x2);
     dec(y2);
+    if (Pen.Style = psSolid) and not Filled then
+    begin
+      ApplyPenStyle;
+      FBitmap.RectangleAntialias(x1,y1,x2,y2,Pen.ActualColor,Pen.ActualWidth);
+      exit;
+    end;
     tex := Brush.BuildTexture(FBitmap);

GraphicTest/Packages/bgrabitmap/bgracanvas2d.pas

-              r452
+              r472
 { To do :
+  draw text with a different precision if the matrix is scaled
+  drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh)
+  -> using FillPoly with texture coordinates
   linear gradient any transformation
   clearPath clipping
   createRadialGradient
-  text functions
   globalCompositeOperation
-  drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh)
   image data functions
+}
 …
 uses
   Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATransform, BGRAGradientScanner;
+  Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATransform, BGRAGradientScanner, BGRAPath;
 type
 …
     globalAlpha: byte;
+    fontName: string;
+    fontStyle: TFontStyles;
+    fontEmHeight: single;
+    textAlign: TAlignment;
+    textBaseline: string;
     lineWidth: single;
     lineCap: TPenEndCap;
 …
     shadowOffsetX,shadowOffsetY,shadowBlur: single;
     shadowColor: TBGRAPixel;
+    shadowFastest: boolean;
     matrix: TAffineMatrix;
 …
   end;
+  TCanvas2dTextSize = record
+    width,height: single;
+  end;
   { TBGRACanvas2D }
   TBGRACanvas2D = class
+  TBGRACanvas2D = class(IBGRAPath)
   private
     FSurface: TBGRACustomBitmap;
 …
     FPathPoints: array of TPointF;
     FPathPointCount: integer;
+    FFontRenderer: TBGRACustomFontRenderer;
+    FLastCoord, FStartCoord: TPointF;
+    function GetCurrentPath: ArrayOfTPointF;
+    function GetFontName: string;
+    function GetFontRenderer: TBGRACustomFontRenderer;
+    function GetFontEmHeight: single;
+    function GetFontString: string;
+    function GetFontStyle: TFontStyles;
     function GetGlobalAlpha: single;
     function GetHasShadow: boolean;
     function GetHeight: Integer;
     function GetLineCap: string;
+    function GetLineCapLCL: TPenEndCap;
     function GetlineJoin: string;
+    function GetlineJoinLCL: TPenJoinStyle;
     function GetLineWidth: single;
+    function GetMatrix: TAffineMatrix;
     function GetMiterLimit: single;
     function GetPixelCenteredCoordinates: boolean;
     function GetShadowBlur: single;
+    function GetShadowFastest: boolean;
     function GetShadowOffset: TPointF;
     function GetShadowOffsetX: single;
     function GetShadowOffsetY: single;
+    function GetTextAlign: string;
+    function GetTextAlignLCL: TAlignment;
+    function GetTextBaseline: string;
     function GetWidth: Integer;
+    procedure SetFontName(AValue: string);
+    procedure SetFontRenderer(AValue: TBGRACustomFontRenderer);
+    procedure SetFontEmHeight(AValue: single);
+    procedure SetFontString(AValue: string);
+    procedure SetFontStyle(AValue: TFontStyles);
     procedure SetGlobalAlpha(const AValue: single);
     procedure SetLineCap(const AValue: string);
+    procedure SetLineCapLCL(AValue: TPenEndCap);
     procedure SetLineJoin(const AValue: string);
     procedure FillPoly(const points: array of TPointF);
     procedure FillStrokePoly(const points: array of TPointF; fillOver: boolean);
+    procedure SetLineJoinLCL(AValue: TPenJoinStyle);
     procedure SetLineWidth(const AValue: single);
+    procedure SetMatrix(AValue: TAffineMatrix);
     procedure SetMiterLimit(const AValue: single);
     procedure SetPixelCenteredCoordinates(const AValue: boolean);
     procedure SetShadowBlur(const AValue: single);
+    procedure SetShadowFastest(AValue: boolean);
     procedure SetShadowOffset(const AValue: TPointF);
     procedure SetShadowOffsetX(const AValue: single);
     procedure SetShadowOffsetY(const AValue: single);
+    procedure SetTextAlign(AValue: string);
+    procedure SetTextAlignLCL(AValue: TAlignment);
+    procedure SetTextBaseine(AValue: string);
     procedure StrokePoly(const points: array of TPointF);
     procedure DrawShadow(const points, points2: array of TPointF);
 …
     function ApplyTransform(const points: array of TPointF): ArrayOfTPointF; overload;
     function ApplyTransform(point: TPointF): TPointF; overload;
+    function GetPenPos: TPointF;
+    function GetPenPos(defaultX, defaultY: single): TPointF;
+    function GetPenPos(defaultPt: TPointF): TPointF;
     procedure AddPoint(point: TPointF);
     procedure AddPoints(const points: array of TPointF);
     procedure AddPointsRev(const points: array of TPointF);
     function ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel;
+    function GetDrawMode: TDrawMode;
+    procedure copyTo({%H-}dest: IBGRAPath); //IBGRAPath
   public
+    antialiasing, linearBlend: boolean;
     constructor Create(ASurface: TBGRACustomBitmap);
     destructor Destroy; override;
 …
     procedure save;
     procedure restore;
+    procedure scale(x,y: single);
+    procedure rotate(angleRad: single);
+    procedure scale(x,y: single); overload;
+    procedure scale(factor: single); overload;
+    procedure rotate(angleRadCW: single);
     procedure translate(x,y: single);
+    procedure transform(a,b,c,d,e,f: single);
+    procedure transform(a,b,c,d,e,f: single); overload;
+    procedure transform(AMatrix: TAffineMatrix); overload;
     procedure setTransform(a,b,c,d,e,f: single);
     procedure resetTransform;
 …
     procedure shadowColor(color: TColor); overload;
     procedure shadowColor(color: string); overload;
+    procedure shadowNone;
     function getShadowColor: TBGRAPixel;
     function createLinearGradient(x0,y0,x1,y1: single): IBGRACanvasGradient2D; overload;
 …
     procedure clearRect(x,y,w,h: single);
+    procedure addPath(APath: IBGRAPath); overload;
+    procedure addPath(ASvgPath: string); overload;
+    procedure path(APath: IBGRAPath); overload;
+    procedure path(ASvgPath: string); overload;
     procedure beginPath;
     procedure closePath;
 …
     procedure moveTo(x,y: single); overload;
     procedure lineTo(x,y: single); overload;
     procedure moveTo(pt: TPointF); overload;
     procedure lineTo(pt: TPointF); overload;
+    procedure moveTo(const pt: TPointF); overload;
+    procedure lineTo(const pt: TPointF); overload;
     procedure polylineTo(const pts: array of TPointF);
     procedure quadraticCurveTo(cpx,cpy,x,y: single); overload;
     procedure quadraticCurveTo(cp,pt: TPointF); overload;
+    procedure quadraticCurveTo(const cp,pt: TPointF); overload;
     procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload;
     procedure bezierCurveTo(cp1,cp2,pt: TPointF); overload;
+    procedure bezierCurveTo(const cp1,cp2,pt: TPointF); overload;
     procedure rect(x,y,w,h: single);
+    procedure roundRect(x,y,w,h,radius: single);
+    procedure roundRect(x,y,w,h,radius: single); overload;
+    procedure roundRect(x,y,w,h,rx,ry: single); overload;
     procedure spline(const pts: array of TPointF; style: TSplineStyle= ssOutside);
     procedure splineTo(const pts: array of TPointF; style: TSplineStyle= ssOutside);
+    procedure arc(x, y, radius, startAngle, endAngle: single; anticlockwise: boolean); overload;
+    procedure arc(x, y, radius, startAngle, endAngle: single); overload;
+    procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
+    procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); overload;
+    procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
+    procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload;
+    procedure arc(const arcDef: TArcDef); overload;
     procedure arcTo(x1, y1, x2, y2, radius: single); overload;
     procedure arcTo(p1,p2: TPointF; radius: single); overload;
+    procedure arcTo(rx, ry, xAngleRadCW: single; largeArc,anticlockwise: boolean; x, y: single);
+    procedure circle(x,y,r: single);
+    procedure ellipse(x,y,rx,ry: single);
+    procedure text(AText: string; x,y: single);
+    procedure fillText(AText: string; x,y: single);
+    procedure strokeText(AText: string; x,y: single);
+    function measureText(AText: string): TCanvas2dTextSize;
     procedure fill;
     procedure stroke;
 …
     function getLineStyle: TBGRAPenStyle;
+    procedure lineStyle(const AValue: array of single);
+    procedure lineStyle(const AValue: array of single); overload;
+    procedure lineStyle(AStyle: TPenStyle); overload;
     property surface: TBGRACustomBitmap read FSurface;
 …
     property pixelCenteredCoordinates: boolean read GetPixelCenteredCoordinates write SetPixelCenteredCoordinates;
     property globalAlpha: single read GetGlobalAlpha write SetGlobalAlpha;
+    property matrix: TAffineMatrix read GetMatrix write SetMatrix;
     property lineWidth: single read GetLineWidth write SetLineWidth;
     property lineCap: string read GetLineCap write SetLineCap;
+    property lineCapLCL: TPenEndCap read GetLineCapLCL write SetLineCapLCL;
     property lineJoin: string read GetlineJoin write SetLineJoin;
+    property lineJoinLCL: TPenJoinStyle read GetlineJoinLCL write SetLineJoinLCL;
     property miterLimit: single read GetMiterLimit write SetMiterLimit;
 …
     property shadowOffset: TPointF read GetShadowOffset write SetShadowOffset;
     property shadowBlur: single read GetShadowBlur write SetShadowBlur;
+    property shadowFastest: boolean read GetShadowFastest write SetShadowFastest;
     property hasShadow: boolean read GetHasShadow;
+    property fontName: string read GetFontName write SetFontName;
+    property fontEmHeight: single read GetFontEmHeight write SetFontEmHeight;
+    property fontStyle: TFontStyles read GetFontStyle write SetFontStyle;
+    property font: string read GetFontString write SetFontString;
+    property textAlignLCL: TAlignment read GetTextAlignLCL write SetTextAlignLCL;
+    property textAlign: string read GetTextAlign write SetTextAlign;
+    property textBaseline: string read GetTextBaseline write SetTextBaseine;
+    property currentPath: ArrayOfTPointF read GetCurrentPath;
+    property fontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer;
+  protected
+    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;
 implementation
 uses Math, BGRAPen, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64;
+uses Types, Math, BGRAPen, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64;
 type
 …
   globalAlpha := 255;
+  fontName := 'Arial';
+  fontEmHeight := 10;
+  fontStyle := [];
+  textAlign:= taLeftJustify;
+  textBaseline := 'alphabetic';
   lineWidth := 1;
   lineCap := pecFlat;
 …
   shadowBlur := 0;
   shadowColor := BGRAPixelTransparent;
+  shadowFastest:= false;
   matrix := AMatrix;
 …
   result.globalAlpha := globalAlpha;
+  result.fontName:= fontName;
+  result.fontEmHeight := fontEmHeight;
+  result.fontStyle := fontStyle;
   result.lineWidth := lineWidth;
   result.lineCap := lineCap;
 …
   result.shadowBlur := shadowBlur;
   result.shadowColor := shadowColor;
+  result.shadowFastest := shadowFastest;
 end;
 …
 function TBGRACanvas2D.GetHeight: Integer;
 begin
+  result := Surface.Height;
+  if Assigned(surface) then
+    result := Surface.Height
+  else
+    result := 0;
 end;
 …
 end;
+function TBGRACanvas2D.GetLineCapLCL: TPenEndCap;
+begin
+  result := currentState.lineCap;
+end;
 function TBGRACanvas2D.GetlineJoin: string;
 begin
 …
 end;
+function TBGRACanvas2D.GetlineJoinLCL: TPenJoinStyle;
+begin
+  result := currentState.lineJoin;
+end;
 function TBGRACanvas2D.getLineStyle: TBGRAPenStyle;
 begin
 …
 end;
+function TBGRACanvas2D.GetMatrix: TAffineMatrix;
+begin
+  result := currentState.matrix;
+end;
 function TBGRACanvas2D.GetMiterLimit: single;
 begin
 …
 end;
+function TBGRACanvas2D.GetShadowFastest: boolean;
+begin
+  result := currentState.shadowFastest;
+end;
 function TBGRACanvas2D.GetShadowOffset: TPointF;
 begin
 …
 end;
+function TBGRACanvas2D.GetTextAlign: string;
+begin
+  case currentState.textAlign of
+    taRightJustify: result := 'right';
+    taCenter: result := 'center';
+  else
+    result := 'left';
+  end;
+end;
+function TBGRACanvas2D.GetTextAlignLCL: TAlignment;
+begin
+  result := currentState.textAlign;
+end;
+function TBGRACanvas2D.GetTextBaseline: string;
+begin
+  result := currentState.textBaseline;
+end;
 function TBGRACanvas2D.GetGlobalAlpha: single;
 begin
   result := currentState.globalAlpha/255;
+end;
+function TBGRACanvas2D.GetCurrentPath: ArrayOfTPointF;
+var i: integer;
+begin
+  setlength(result, FPathPointCount);
+  for i := 0 to high(result) do
+    result[i] := FPathPoints[i];
+end;
+function TBGRACanvas2D.GetFontName: string;
+begin
+  result := currentState.fontName;
+end;
+function TBGRACanvas2D.GetFontRenderer: TBGRACustomFontRenderer;
+var zoom1,zoom2,zoom: single;
+begin
+  if FFontRenderer = nil then
+  begin
+    if FSurface <> nil then
+      result := FSurface.FontRenderer
+    else
+      result := nil;
+  end else
+    result := FFontRenderer;
+  if Assigned(result) then
+  begin
+    result.FontName := currentState.fontName;
+    result.FontStyle := currentState.fontStyle;
+    if antialiasing then
+      result.FontQuality:= fqFineAntialiasing
+    else
+      result.FontQuality := fqSystem;
+    result.FontOrientation := 0;
+    zoom1 := VectLen(currentState.matrix[1,1],currentState.matrix[2,1]);
+    zoom2 := VectLen(currentState.matrix[1,2],currentState.matrix[2,2]);
+    if zoom1>zoom2 then zoom := zoom1 else zoom := zoom2;
+    result.FontEmHeight := round(currentState.fontEmHeight*zoom);
+  end;
+end;
+function TBGRACanvas2D.GetFontEmHeight: single;
+begin
+  result := currentState.fontEmHeight;
+end;
+function TBGRACanvas2D.GetFontString: string;
+var formats: TFormatSettings;
+begin
+  formats := DefaultFormatSettings;
+  formats.DecimalSeparator := '.';
+  result := '';
+  if fsItalic in currentState.fontStyle then
+    result := result+'italic ';
+  if fsBold in currentState.fontStyle then
+    result += 'bold ';
+  result += FloatToStrF(currentState.fontEmHeight,ffGeneral,6,0,formats)+'px ';
+  result += currentState.fontName;
+  result := trim(result);
+end;
+function TBGRACanvas2D.GetFontStyle: TFontStyles;
+begin
+  result := currentState.fontStyle;
 end;
 …
 function TBGRACanvas2D.GetWidth: Integer;
 begin
+  result := Surface.Width;
+  if Assigned(Surface) then
+    result := Surface.Width
+  else
+    result := 0;
+end;
+procedure TBGRACanvas2D.SetFontName(AValue: string);
+begin
+  currentState.fontName := AValue;
+end;
+procedure TBGRACanvas2D.SetFontRenderer(AValue: TBGRACustomFontRenderer);
+begin
+  if AValue = FFontRenderer then exit;
+  FreeAndNil(FFontRenderer);
+  FFontRenderer := AValue;
+end;
+procedure TBGRACanvas2D.SetFontEmHeight(AValue: single);
+begin
+  currentState.fontEmHeight := AValue;
+end;
+procedure TBGRACanvas2D.SetFontString(AValue: string);
+var idxSpace,errPos: integer;
+  attrib,u: string;
+  value: single;
+begin
+  currentState.fontStyle := [];
+  currentState.fontEmHeight := 10;
+  currentState.fontName := 'Arial';
+  AValue := trim(AValue);
+  while AValue <> '' do
+  begin
+    while (AValue <> '') and (AValue[1]in [#0..#32]) do delete(AValue,1,1);
+    idxSpace := pos(' ',AValue);
+    if idxSpace = 0 then
+      attrib := AValue
+    else
+      attrib := copy(AValue,1,idxSpace-1);
+    attrib := lowerCase(attrib);
+    if attrib = '' then break;
+    if (attrib = 'normal') or (attrib = 'small-caps') or (attrib = 'lighter') then
+    begin
+      //nothing
+    end else
+    if (attrib = 'italic') or (attrib = 'oblique') then
+    begin
+      currentState.fontStyle += [fsItalic];
+    end else
+    if (attrib = 'bold') or (attrib = 'bolder') then
+    begin
+      currentState.fontStyle += [fsBold];
+    end else
+    if (attrib[1] in ['.','0'..'9']) then
+    begin
+      u := '';
+      while (length(attrib)>0) and (attrib[length(attrib)] in['a'..'z']) do
+      begin
+        u := attrib[length(attrib)]+u;
+        delete(attrib,length(attrib),1);
+      end;
+      val(attrib,value,errPos);
+      if errPos = 0 then
+      begin
+        if u = '' then //weight
+        begin
+          if value >= 600 then currentState.fontStyle += [fsBold];
+        end else
+        if u = 'px' then currentState.fontEmHeight := value else
+        if u = 'pt' then currentState.fontEmHeight:= value/72*96 else
+        if u = 'in' then currentState.fontEmHeight:= value*96 else
+        if u = 'mm' then currentState.fontEmHeight:= value/25.4*96 else
+        if u = 'cm' then currentState.fontEmHeight:= value/2.54*96;
+      end;
+    end else
+      break;
+    delete(AValue,1,length(attrib)+1);
+  end;
+  AValue := trim(AValue);
+  if AValue <> '' then currentState.fontName := AValue;
+end;
+procedure TBGRACanvas2D.SetFontStyle(AValue: TFontStyles);
+begin
+  currentState.fontStyle:= AValue;
 end;
 …
 end;
+procedure TBGRACanvas2D.SetLineCapLCL(AValue: TPenEndCap);
+begin
+  currentState.lineCap := AValue;
+end;
 procedure TBGRACanvas2D.SetLineJoin(const AValue: string);
 begin
 …
   tempScan: TBGRACustomScanner;
 begin
   if length(points) = 0 then exit;
+  if (length(points) = 0) or (surface = nil) then exit;
   If hasShadow then DrawShadow(points,[]);
   if currentState.clipMask <> nil then
 …
     else
       tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.fillColor));
+    BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true);
+    if self.antialiasing then
+      BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true, linearBlend)
+    else
+      BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, true, GetDrawMode);
     tempScan.free;
   end else
 …
       begin
         tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha);
+        BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true);
+        if self.antialiasing then
+          BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true, linearBlend)
+        else
+          BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, true, GetDrawMode);
         tempScan.Free;
       end else
+        BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, true)
+      begin
+        if self.antialiasing then
+          BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, true, linearBlend)
+        else
+          BGRAPolygon.FillPolyAliasedWithTexture(surface, points, currentState.fillTextureProvider.texture, true, GetDrawMode);
+      end
     end
     else
+      BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true);
+    begin
+      if self.antialiasing then
+        BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true, linearBlend)
+      else
+        BGRAPolygon.FillPolyAliased(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true, GetDrawMode)
+    end
   end;
 end;
 …
   texture: IBGRAScanner;
 begin
   if length(points) = 0 then exit;
+  if (length(points) = 0) or (surface = nil) then exit;
   tempScan := nil;
   tempScan2 := nil;
 …
   if fillOver then multi.PolygonOrder := poFirstOnTop else multi.PolygonOrder:= poLastOnTop;
+  multi.Antialiasing := self.antialiasing;
   multi.Draw(surface);
   tempScan.free;
 …
 end;
+procedure TBGRACanvas2D.SetLineJoinLCL(AValue: TPenJoinStyle);
+begin
+  currentState.lineJoin := AValue;
+end;
 procedure TBGRACanvas2D.lineStyle(const AValue: array of single);
 begin
 …
 end;
+procedure TBGRACanvas2D.lineStyle(AStyle: TPenStyle);
+begin
+  case AStyle of
+    psSolid: lineStyle(SolidPenStyle);
+    psDash: lineStyle(DashPenStyle);
+    psDot: lineStyle(DotPenStyle);
+    psDashDot: lineStyle(DashDotPenStyle);
+    psDashDotDot: lineStyle(DashDotDotPenStyle);
+    psClear: lineStyle(ClearPenStyle);
+  end;
+end;
+function TBGRACanvas2D.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 TBGRACanvas2D._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+function TBGRACanvas2D._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
 procedure TBGRACanvas2D.SetLineWidth(const AValue: single);
 begin
   currentState.lineWidth := AValue;
+end;
+procedure TBGRACanvas2D.SetMatrix(AValue: TAffineMatrix);
+begin
+  currentState.matrix := AValue;
 end;
 …
 end;
+procedure TBGRACanvas2D.SetShadowFastest(AValue: boolean);
+begin
+  currentState.shadowFastest := AValue;
+end;
 procedure TBGRACanvas2D.SetShadowOffset(const AValue: TPointF);
 begin
 …
 begin
   currentState.shadowOffsetY := AValue;
+end;
+procedure TBGRACanvas2D.SetTextAlign(AValue: string);
+begin
+  AValue := trim(LowerCase(AValue));
+  if (AValue = 'left') or (AValue = 'start') then
+    textAlignLCL := taLeftJustify else
+  if (AValue = 'right') or (AValue = 'end') then
+    textAlignLCL := taRightJustify else
+  if AValue = 'center' then
+    textAlignLCL := taCenter;
+end;
+procedure TBGRACanvas2D.SetTextAlignLCL(AValue: TAlignment);
+begin
+  currentState.textAlign := AValue;
+end;
+procedure TBGRACanvas2D.SetTextBaseine(AValue: string);
+begin
+  currentState.textBaseline := trim(lowercase(AValue));
 end;
 …
   contour: array of TPointF;
 begin
   if (length(points)= 0) or (currentState.lineWidth = 0) then exit;
+  if (length(points)= 0) or (currentState.lineWidth = 0) or (surface = nil) then exit;
   contour := ComputeWidePolylinePoints(points,currentState.lineWidth,BGRAPixelTransparent,
       currentState.lineCap,currentState.lineJoin,currentState.lineStyle,[plAutoCycle],miterLimit);
 …
     else
       tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor));
+    BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True);
+    if self.antialiasing then
+      BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True, linearBlend)
+    else
+      BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,tempScan,True,GetDrawMode);
     tempScan.free;
   end else
 …
       texture := nil;
     if texture = nil then
+      BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True)
+    begin
+      if self.antialiasing then
+        BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True, linearBlend)
+      else
+        BGRAPolygon.FillPolyAliased(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True,GetDrawMode)
+    end
     else
+      BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True);
+    begin
+      if self.antialiasing then
+        BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True, linearBlend)
+      else
+        BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,texture,True,GetDrawMode)
+    end;
   end;
 end;
 procedure TBGRACanvas2D.DrawShadow(const points, points2: array of TPointF);
+const invSqrt2 = 1/sqrt(2);
 var ofsPts,ofsPts2: array of TPointF;
     offset: TPointF;
     i: Integer;
     tempBmp,blurred: TBGRACustomBitmap;
+begin
+  if not hasShadow then exit;
+    maxRect: TRect;
+    foundRect: TRect;
+    firstFound: boolean;
+    procedure AddPt(const coord: TPointF);
+    var pixRect: TRect;
+    begin
+      if isEmptyPointF(coord) then exit;
+      pixRect := Types.Rect(round(floor(coord.x)),round(floor(coord.y)),round(ceil(coord.x+0.999))+1,round(ceil(coord.y+0.999))+1);
+      if firstFound then
+      begin
+        foundRect := pixRect;
+        firstFound := false
+      end
+      else
+      begin
+        if pixRect.left < foundRect.left then foundRect.left := pixRect.Left;
+        if pixRect.top < foundRect.top then foundRect.top := pixRect.top;
+        if pixRect.right > foundRect.right then foundRect.right := pixRect.right;
+        if pixRect.bottom > foundRect.bottom then foundRect.bottom := pixRect.bottom;
+      end;
+    end;
+begin
+  if not hasShadow or (surface = nil) then exit;
   offset := PointF(shadowOffsetX,shadowOffsetY);
   setlength(ofsPts, length(points));
 …
   for i := 0 to high(ofsPts2) do
     ofsPts2[i] := points2[i]+offset;
+  tempBmp := surface.NewBitmap(width,height,BGRAPixelTransparent);
+  maxRect := Types.Rect(0,0,width,height);
+  if currentState.clipMask <> nil then
+    foundRect := maxRect
+  else
+  begin
+    firstFound := true;
+    for i := 0 to high(ofsPts) do
+      AddPt(ofsPts[i]);
+    for i := 0 to high(ofsPts2) do
+      AddPt(ofsPts2[i]);
+    if firstFound then exit;
+    InflateRect(foundRect, ceil(shadowBlur),ceil(shadowBlur));
+    if not IntersectRect(foundRect, foundRect,maxRect) then exit;
+    offset := PointF(-foundRect.Left,-foundRect.Top);
+    for i := 0 to high(ofsPts) do
+      ofsPts[i] += offset;
+    for i := 0 to high(ofsPts2) do
+      ofsPts2[i] += offset;
+  end;
+  tempBmp := surface.NewBitmap(foundRect.Right-foundRect.Left,foundRect.Bottom-foundRect.Top,BGRAPixelTransparent);
   tempBmp.FillMode := fmWinding;
   tempBmp.FillPolyAntialias(ofsPts, getShadowColor);
 …
   if shadowBlur > 0 then
   begin
+    if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then
+      blurred := tempBmp.FilterBlurRadial(round(shadowBlur*10),rbPrecise)
+    if shadowFastest then
+    begin
+      if shadowBlur*invSqrt2 >= 0.5 then
+      begin
+        blurred := tempBmp.FilterBlurRadial(round(shadowBlur*invSqrt2),rbBox);
+        tempBmp.Free;
+        tempBmp := blurred;
+      end;
+    end
     else
+      blurred := tempBmp.FilterBlurRadial(round(shadowBlur),rbFast);
+    tempBmp.Free;
+    tempBmp := blurred;
+    begin
+      if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then
+        blurred := tempBmp.FilterBlurRadial(round(shadowBlur*10),rbPrecise)
+      else
+        blurred := tempBmp.FilterBlurRadial(round(shadowBlur),rbFast);
+      tempBmp.Free;
+      tempBmp := blurred;
+    end;
   end;
   if currentState.clipMask <> nil then
     tempBmp.ApplyMask(currentState.clipMask);
   surface.PutImage(0,0,tempBmp,dmDrawWithTransparency,currentState.globalAlpha);
+  surface.PutImage(foundRect.Left,foundRect.Top,tempBmp,GetDrawMode,currentState.globalAlpha);
   tempBmp.Free;
 end;
 …
 procedure TBGRACanvas2D.ClearPoly(const points: array of TPointF);
 begin
+  BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true)
+  if surface = nil then exit;
+  if self.antialiasing then
+    BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true, linearBlend)
+  else
+    BGRAPolygon.FillPolyAliased(surface, points, BGRA(0,0,0,255), true, true, dmSet);
 end;
 …
 end;
 function TBGRACanvas2D.GetPenPos: TPointF;
 begin
   if FPathPointCount = 0 then
     result := PointF(0,0)
+function TBGRACanvas2D.GetPenPos(defaultX,defaultY: single): TPointF;
+begin
+  if isEmptyPointF(FLastCoord) then
+    result := PointF(defaultX,defaultY)
   else
+    result := FPathPoints[FPathPointCount-1];
+    result := FLastCoord;
+end;
+function TBGRACanvas2D.GetPenPos(defaultPt: TPointF): TPointF;
+begin
+  result := GetPenPos(defaultPt.x,defaultPt.y);
 end;
 …
 end;
+function TBGRACanvas2D.GetDrawMode: TDrawMode;
+begin
+  if linearBlend then result := dmLinearBlend else result := dmDrawWithTransparency;
+end;
+procedure TBGRACanvas2D.copyTo(dest: IBGRAPath);
+begin
+  //nothing
+end;
 constructor TBGRACanvas2D.Create(ASurface: TBGRACustomBitmap);
 begin
 …
   StateStack := TList.Create;
   FPathPointCount := 0;
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
   currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil);
   pixelCenteredCoordinates := false;
+  antialiasing := true;
 end;
 …
   StateStack.Free;
   currentState.Free;
+  FreeAndNil(FFontRenderer);
   inherited Destroy;
 end;
 …
   encode64: TBase64EncodingStream;
 begin
+  if surface = nil then exit;
   stream := TMemoryStream.Create;
   if mimeType='image/jpeg' then
 …
 end;
+procedure TBGRACanvas2D.rotate(angleRad: single);
+begin
+  currentState.matrix *= AffineMatrixRotationRad(-angleRad);
+procedure TBGRACanvas2D.scale(factor: single);
+begin
+  currentState.matrix *= AffineMatrixScale(factor,factor);
+end;
+procedure TBGRACanvas2D.rotate(angleRadCW: single);
+begin
+  currentState.matrix *= AffineMatrixRotationRad(-angleRadCW);
 end;
 …
 begin
   currentState.matrix *= AffineMatrix(a,c,e,b,d,f);
+end;
+procedure TBGRACanvas2D.transform(AMatrix: TAffineMatrix);
+begin
+  currentState.matrix *= AMatrix;
 end;
 …
 begin
   shadowColor(StrToBGRA(color));
+end;
+procedure TBGRACanvas2D.shadowNone;
+begin
+  shadowColor(BGRAPixelTransparent);
 end;
 …
 end;
+procedure TBGRACanvas2D.addPath(APath: IBGRAPath);
+begin
+  if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then
+  begin
+    AddPoint(EmptyPointF);
+    FLastCoord := EmptyPointF;
+    FStartCoord := EmptyPointF;
+  end;
+  APath.copyTo(self);
+end;
+procedure TBGRACanvas2D.addPath(ASvgPath: string);
+var p: TBGRAPath;
+begin
+  p := TBGRAPath.Create(ASvgPath);
+  addPath(p);
+  p.Free;
+end;
+procedure TBGRACanvas2D.path(APath: IBGRAPath);
+begin
+  beginPath;
+  addPath(APath);
+end;
+procedure TBGRACanvas2D.path(ASvgPath: string);
+begin
+  beginPath;
+  addPath(ASvgPath);
+end;
 procedure TBGRACanvas2D.beginPath;
 begin
   FPathPointCount := 0;
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
 end;
 …
     while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i);
     AddPoint(FPathPoints[i]);
+    FLastCoord := FStartCoord;
   end;
 end;
 …
       pts[j] := FPathPoints[i+j];
     if closed then
       splinePts := surface.ComputeClosedSpline(pts,style)
+      splinePts := BGRAPath.ComputeClosedSpline(pts,style)
     else
       splinePts := surface.ComputeOpenedSpline(pts,style);
+      splinePts := BGRAPath.ComputeOpenedSpline(pts,style);
     dec(FPathPointCount,nb);
     AddPoints(splinePts);
 …
 end;
 procedure TBGRACanvas2D.moveTo(pt: TPointF);
 begin
   if FPathPointCount <> 0 then
+procedure TBGRACanvas2D.moveTo(const pt: TPointF);
+begin
+  if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then
     AddPoint(EmptyPointF);
   AddPoint(ApplyTransform(pt));
+end;
+procedure TBGRACanvas2D.lineTo(pt: TPointF);
+  FStartCoord := pt;
+  FLastCoord := pt;
+end;
+procedure TBGRACanvas2D.lineTo(const pt: TPointF);
 begin
   AddPoint(ApplyTransform(pt));
+  FLastCoord := pt;
 end;
 procedure TBGRACanvas2D.polylineTo(const pts: array of TPointF);
 begin
+  AddPoints(ApplyTransform(pts));
+  if length(pts)> 0 then
+  begin
+    AddPoints(ApplyTransform(pts));
+    FLastCoord := pts[high(pts)];
+  end;
 end;
 …
   pts : array of TPointF;
 begin
   curve := BezierCurve(GetPenPos,ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y)));
   pts := Surface.ComputeBezierCurve(curve);
+  curve := BezierCurve(ApplyTransform(GetPenPos(cpx,cpy)),ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y)));
+  pts := BGRAPath.ComputeBezierCurve(curve);
   AddPoints(pts);
+end;
+procedure TBGRACanvas2D.quadraticCurveTo(cp, pt: TPointF);
+  FLastCoord := PointF(x,y);
+end;
+procedure TBGRACanvas2D.quadraticCurveTo(const cp, pt: TPointF);
 begin
   quadraticCurveTo(cp.x,cp.y,pt.x,pt.y);
 …
   pts : array of TPointF;
 begin
   curve := BezierCurve(GetPenPos,ApplyTransform(PointF(cp1x,cp1y)),
+  curve := BezierCurve(ApplyTransform(GetPenPos(cp1x,cp1y)),ApplyTransform(PointF(cp1x,cp1y)),
     ApplyTransform(PointF(cp2x,cp2y)),ApplyTransform(PointF(x,y)));
   pts := Surface.ComputeBezierCurve(curve);
+  pts := BGRAPath.ComputeBezierCurve(curve);
   AddPoints(pts);
+end;
+procedure TBGRACanvas2D.bezierCurveTo(cp1, cp2, pt: TPointF);
+  FLastCoord := PointF(x,y);
+end;
+procedure TBGRACanvas2D.bezierCurveTo(const cp1, cp2, pt: TPointF);
 begin
   bezierCurveTo(cp1.x,cp1.y,cp2.x,cp2.y,pt.x,pt.y);
 …
   LineTo(x+w,y+h);
   LineTo(x,y+h);
   LineTo(x,y);
+  closePath;
 end;
 …
   arcTo(PointF(x,y+h),PointF(x,y), radius);
   arcTo(PointF(x,y),PointF(x+w,y), radius);
+  closePath;
+end;
+procedure TBGRACanvas2D.roundRect(x, y, w, h, rx, ry: single);
+begin
+  if (w <= 0) or (h <= 0) then exit;
+  if rx < 0 then rx := 0;
+  if ry < 0 then ry := 0;
+  if (rx = 0) and (ry = 0) then
+  begin
+    rect(x,y,w,h);
+    exit;
+  end;
+  if rx*2 > w then rx := w/2;
+  if ry*2 > h then ry := h/2;
+  moveTo(x+rx,y);
+  lineTo(x+w-rx,y);
+  arcTo(rx,ry,0,false,false,x+w,y+ry);
+  lineTo(x+w,y+h-ry);
+  arcTo(rx,ry,0,false,false,x+w-rx,y+h);
+  lineTo(x+rx,y+h);
+  arcTo(rx,ry,0,false,false,x,y+h-ry);
+  lineTo(x,y+ry);
+  arcTo(rx,ry,0,false,false,x+rx,y);
+  closePath;
 end;
 …
   transf := ApplyTransform(pts);
   if (pts[0] = pts[high(pts)]) and (length(pts) > 1) then
     transf := surface.ComputeClosedSpline(slice(transf, length(transf)-1),style)
+    transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style)
   else
     transf := surface.ComputeOpenedSpline(transf,style);
+    transf := BGRAPath.ComputeOpenedSpline(transf,style);
   AddPoints(transf);
+  FLastCoord := pts[high(pts)];
 end;
 …
   i: Integer;
 begin
+  if length(pts) = 0 then exit;
   transf := ApplyTransform(pts);
   if FPathPointCount <> 0 then
 …
     for i := high(transf) downto 1 do
       transf[i]:= transf[i-1];
     transf[0] := GetPenPos;
   end;
   transf := surface.ComputeOpenedSpline(transf,style);
+    transf[0] := ApplyTransform(GetPenPos(pts[0].x,pts[0].y));
+  end;
+  transf := BGRAPath.ComputeOpenedSpline(transf,style);
   AddPoints(transf);
+end;
+procedure TBGRACanvas2D.arc(x, y, radius, startAngle, endAngle: single;
+  FLastCoord := pts[high(pts)];
+end;
+procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single;
   anticlockwise: boolean);
 var pts: array of TPointF;
 …
   unitAffine: TAffineMatrix;
   v1orig,v2orig,v1ortho,v2ortho: TPointF;
+  startRadCCW,endRadCCW: single;
 begin
   v1orig := PointF(currentState.matrix[1,1],currentState.matrix[2,1]);
 …
   unitAffine := AffineMatrix(v1ortho.x, v2ortho.x, pt.x,
                              v1ortho.y, v2ortho.y, pt.y);
   startAngle := -startAngle;
   endAngle := -endAngle;
+  startRadCCW := -startAngleRadCW;
+  endRadCCW := -endAngleRadCW;
   if not anticlockwise then
   begin
     temp := startAngle;
     startAngle := endAngle;
     endAngle := temp;
     pts := surface.ComputeArcRad(0,0,rx,ry,startAngle,endAngle);
+    temp := startRadCCW;
+    startRadCCW := endRadCCW;
+    endRadCCW:= temp;
+    pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW);
     pts := ApplyTransform(pts,unitAffine);
     AddPointsRev(pts);
   end else
   begin
     pts := surface.ComputeArcRad(0,0,rx,ry,startAngle,endAngle);
+    pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW);
     pts := ApplyTransform(pts,unitAffine);
     AddPoints(pts);
   end;
+end;
+procedure TBGRACanvas2D.arc(x, y, radius, startAngle, endAngle: single);
+begin
+  arc(x,y,radius,startAngle,endAngle,false);
+  FLastCoord := ArcEndPoint(ArcDef(x,y,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise));
+end;
+procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single);
+begin
+  arc(x,y,radius,startAngleRadCW,endAngleRadCW,false);
+end;
+procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
+  anticlockwise: boolean);
+begin
+  arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise))
+end;
+procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single);
+begin
+  arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false))
+end;
+procedure TBGRACanvas2D.arc(const arcDef: TArcDef);
+var previousMatrix: TAffineMatrix;
+begin
+  if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then
+    lineTo(arcDef.center) else
+  begin
+    previousMatrix := currentState.matrix;
+    translate(arcDef.center.x,arcDef.center.y);
+    rotate(arcDef.xAngleRadCW);
+    scale(arcDef.radius.x,arcDef.radius.y);
+    arc(0,0,1,arcDef.startAngleRadCW,arcDef.endAngleRadCW,arcDef.anticlockwise);
+    currentState.matrix := previousMatrix;
+    FLastCoord := ArcEndPoint(arcDef);
+  end;
 end;
 procedure TBGRACanvas2D.arcTo(x1, y1, x2, y2, radius: single);
+var p0,p1,p2,p3,p4,an,bn,cn,c: TPointF;
+    dir, a2, b2, c2, cosx, sinx, d,
+    angle0, angle1: single;
+    anticlockwise: boolean;
+begin
+  if FPathPointCount = 0 then
+    moveTo(x1,y1);
+  radius := abs(radius);
+  p0 := GetPenPos;
+  p1 := PointF(x1,y1);
+  p2 := PointF(x2,y2);
+  if (p0 = p1) or (p1 = p2) or (radius = 0) then
+  begin
+    lineto(x1,y1);
+    exit;
+  end;
+  dir := (x2-x1)*(p0.y-y1) + (y2-y1)*(x1-p0.x);
+  if dir = 0 then
+  begin
+    lineto(x1,y1);
+    exit;
+  end;
+  a2 := (p0.x-x1)*(p0.x-x1) + (p0.y-y1)*(p0.y-y1);
+  b2 := (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2);
+  c2 := (p0.x-x2)*(p0.x-x2) + (p0.y-y2)*(p0.y-y2);
+  cosx := (a2+b2-c2)/(2*sqrt(a2*b2));
+  sinx := sqrt(1 - cosx*cosx);
+  if (sinx = 0) or (cosx = 1) then
+  begin
+    lineto(x1,y1);
+    exit;
+  end;
+  d := radius / ((1 - cosx) / sinx);
+  an := (p1-p0)*(1/sqrt(a2));
+  bn := (p1-p2)*(1/sqrt(b2));
+  p3 := p1 - an*d;
+  p4 := p1 - bn*d;
+  anticlockwise := (dir < 0);
+  cn := PointF(an.y,-an.x)*radius;
+  if not anticlockwise then cn := -cn;
+  c := p3 + cn;
+  angle0 := arctan2((p3.y-c.y), (p3.x-c.x));
+  angle1 := arctan2((p4.y-c.y), (p4.x-c.x));
+  lineTo(p3.x,p3.y);
+  arc(c.x,c.y, radius, angle0, angle1, anticlockwise);
+var p0: TPointF;
+begin
+  p0 := GetPenPos(x1,y1);
+  arc(Html5ArcTo(p0,PointF(x1,y1),PointF(x2,y2),radius));
 end;
 …
 begin
   arcTo(p1.x,p1.y,p2.x,p2.y,radius);
+end;
+procedure TBGRACanvas2D.arcTo(rx, ry, xAngleRadCW: single; largeArc,
+  anticlockwise: boolean; x, y: single);
+begin
+  arc(SvgArcTo(GetPenPos(x,y), rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y)));
+  FLastCoord := PointF(x,y);
+end;
+procedure TBGRACanvas2D.circle(x, y, r: single);
+begin
+  arc(x,y,r,0,0);
+end;
+procedure TBGRACanvas2D.ellipse(x, y, rx, ry: single);
+begin
+  arc(x,y,rx,ry,0,0,0);
+end;
+procedure TBGRACanvas2D.text(AText: string; x, y: single);
+var renderer : TBGRACustomFontRenderer;
+  previousMatrix: TAffineMatrix;
+begin
+  renderer := fontRenderer;
+  if renderer.FontEmHeight <= 0 then exit;
+  previousMatrix := currentState.matrix;
+  scale(currentState.fontEmHeight/renderer.FontEmHeight);
+  if (currentState.textBaseline <> 'top') and
+    (currentState.textBaseline <> 'hanging') then
+  with renderer.GetFontPixelMetric do
+  begin
+    if currentState.textBaseline = 'bottom' then
+       translate(0,-Lineheight)
+    else if currentState.textBaseline = 'middle' then
+       translate(0,-Lineheight/2)
+    else if currentState.textBaseline = 'alphabetic' then
+       translate(0,-baseline);
+  end;
+  if renderer <> nil then
+    renderer.CopyTextPathTo(self, x,y, AText, taLeftJustify);
+  currentState.matrix := previousMatrix;
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
+end;
+procedure TBGRACanvas2D.fillText(AText: string; x, y: single);
+begin
+  beginPath;
+  text(AText,x,y);
+  fill;
+  beginPath;
+end;
+procedure TBGRACanvas2D.strokeText(AText: string; x, y: single);
+begin
+  beginPath;
+  text(AText,x,y);
+  stroke;
+  beginPath;
+end;
+function TBGRACanvas2D.measureText(AText: string): TCanvas2dTextSize;
+var renderer: TBGRACustomFontRenderer;
+begin
+  renderer := fontRenderer;
+  if renderer <> nil then
+  begin
+    with renderer.TextSize(AText) do
+    begin
+      result.width := cx;
+      result.height:= cy;
+    end;
+  end
+  else
+  begin
+    result.width := 0;
+    result.height := 0;
+  end;
 end;
 …
     currentState.clipMask := surface.NewBitmap(width,height,BGRAWhite);
   tempBmp := surface.NewBitmap(width,height,BGRABlack);
+  tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite);
+  if antialiasing then
+    tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite)
+  else
+    tempBmp.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet);
   currentState.clipMask.BlendImage(0,0,tempBmp,boDarken);
   tempBmp.Free;
 …
   if FPathPointCount = 0 then exit;
   if currentState.clipMask = nil then exit;
+  currentState.clipMask.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite);
+  if antialiasing then
+    currentState.clipMask.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite)
+  else
+    currentState.clipMask.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet);
   if currentState.clipMask.Equals(BGRAWhite) then
     FreeAndNil(currentState.clipMask);

GraphicTest/Packages/bgrabitmap/bgracolorint.pas

-              r452
+              r472
   end;
 {$else}
+begin
+  result.r := int64(color1.r)*factor65536 shr 16;
+  result.g := int64(color1.g)*factor65536 shr 16;
+  result.b := int64(color1.b)*factor65536 shr 16;
+  result.a := int64(color1.a)*factor65536 shr 16;
+var prod: int64;
+begin
+  prod := int64(color1.r)*factor65536;
+  if prod >= 0 then result.r := prod shr 16
+  else result.r := -((-prod) shr 16);
+  prod := int64(color1.g)*factor65536;
+  if prod >= 0 then result.g := prod shr 16
+  else result.g := -((-prod) shr 16);
+  prod := int64(color1.b)*factor65536;
+  if prod >= 0 then result.b := prod shr 16
+  else result.b := -((-prod) shr 16);
+  prod := int64(color1.a)*factor65536;
+  if prod >= 0 then result.a := prod shr 16
+  else result.a := -((-prod) shr 16);
 end;
 {$endif}

GraphicTest/Packages/bgrabitmap/bgracompressablebitmap.pas

-              r452
+              r472
      procedure Decompress;
      procedure FreeData;
+     procedure Init;
    public
      CompressionLevel: Tcompressionlevel;
 …
      property Width : Integer read FWidth;
      property Height: Integer read FHeight;
      property Caption : string read FCaption;
+     property Caption : string read FCaption write FCaption;
    end;
 …
 constructor TBGRACompressableBitmap.Create;
 begin
+  FUncompressedData := nil;
+  FCompressedDataArray := nil;
+  FWidth := 0;
+  FHeight := 0;
+  FCaption := '';
+  FCompressionProgress := 0;
+  CompressionLevel := clfastest;
+  Init;
 end;
 constructor TBGRACompressableBitmap.Create(Source: TBGRABitmap);
 begin
+  FUncompressedData := nil;
+  FCompressedDataArray := nil;
+  FWidth := 0;
+  FHeight := 0;
+  FCaption := '';
+  FCompressionProgress := 0;
+  Init;
   Assign(Source);
 end;
 …
   setlength(FCaption,WinReadLongint(AStream));
   AStream.Read(FCaption[1],length(FCaption));
+  if (FWidth=0) or (FHeight = 0) then exit;
+  if (FWidth=0) or (FHeight = 0) then
+  begin
+    FUncompressedData := TMemoryStream.Create;
+    exit;
+  end;
   FBounds.Left := WinReadLongint(AStream);
 …
     FCompressedDataArray[i].CopyFrom(AStream,size);
   end;
+  if FCompressedDataArray = nil then
+    FUncompressedData := TMemoryStream.Create;
 end;
 …
 end;
+procedure TBGRACompressableBitmap.Init;
+begin
+  FUncompressedData := nil;
+  FCompressedDataArray := nil;
+  FWidth := 0;
+  FHeight := 0;
+  FCaption := '';
+  FCompressionProgress := 0;
+  CompressionLevel := clfastest;
+end;
 { Copy a bitmap into this object. As it is copied, you need not
   keep a copy of the source }

GraphicTest/Packages/bgrabitmap/bgracoordpool3d.pas

-              r452
+              r472
 uses
   Classes, SysUtils, BGRABitmapTypes, BGRASSE;
+  Classes, SysUtils, BGRABitmapTypes, BGRASSE, BGRAMatrix3D;
 type
 …
     {32} projectedCoord: TPointF;
     {40} InvZ: single;
     {44} used: longbool;
+    {44} used: wordbool; customNormalUsed: wordbool;
     {48} viewNormal: TPoint3D_128;
+  end; {64}
+  { TBGRACoordPool3D }
+  TBGRACoordPool3D = class
+    {64} customNormal: TPoint3D_128;
+  end; {80}
+  PBGRANormalData3D = ^TBGRANormalData3D;
+  TBGRANormalData3D = packed record
+    {0} customNormal: TPoint3D_128;
+    {16} viewNormal: TPoint3D_128;
+    {32} used: longbool;
+    {36} filler1,filler2,filler3: longword;
+  end; {48}
+  { TBGRAGenericPool }
+  TBGRAGenericPool = class
   private
     FFirstFree: integer;
+    FNbCoord,FCapacity: integer;
+    FNbElements,FCapacity: integer;
+    FElementSize: PtrInt;
+    FUsedCapacity : integer;
+    function GetElement(AIndex: integer): Pointer;
+    procedure SetCapacity(ACapacity: integer);
+  protected
     FPoolData: TMemoryBlockAlign128;
     FUsedCapacity : integer;
     function GetCoordData(AIndex: integer): PBGRACoordData3D;
     procedure SetCapacity(ACapacity: integer);
+    function GetUsed({%H-}AElement: integer): boolean; virtual;
+    procedure SetUsed({%H-}AElement: integer; {%H-}AUsed: boolean); virtual;
+    procedure Remove(AIndex: integer); //does not work if GetUsed/SetUsed are not implemented
   public
     constructor Create(ACapacity: integer);
+    constructor Create(ACapacity: integer; AElementSize: integer);
     destructor Destroy; override;
-    procedure Remove(AIndex: integer);
     function Add: integer;
     property CoordData[AIndex: integer]: PBGRACoordData3D read GetCoordData;
+    property Element[AIndex: integer]: Pointer read GetElement;
     property Capacity: integer read FCapacity;
     property UsedCapacity: integer read FUsedCapacity;
   end;
+  { TBGRACoordPool3D }
+  TBGRACoordPool3D = class(TBGRAGenericPool)
+  private
+    function GetCoordData(AIndex: integer): PBGRACoordData3D;
+  protected
+    function GetUsed(AElement: integer): boolean; override;
+    procedure SetUsed(AElement: integer; AUsed: boolean); override;
+  public
+    procedure Remove(AIndex: integer);
+    constructor Create(ACapacity: integer);
+    procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    property CoordData[AIndex: integer]: PBGRACoordData3D read GetCoordData;
+  end;
+  { TBGRANormalPool3D }
+  TBGRANormalPool3D = class(TBGRAGenericPool)
+  private
+    function GetNormalData(AIndex: integer): PBGRANormalData3D;
+  protected
+    function GetUsed(AElement: integer): boolean; override;
+    procedure SetUsed(AElement: integer; AUsed: boolean); override;
+  public
+    procedure Remove(AIndex: integer);
+    constructor Create(ACapacity: integer);
+    procedure ComputeWithMatrix(const AMatrix: TMatrix3D);
+    property NormalData[AIndex: integer]: PBGRANormalData3D read GetNormalData;
+  end;
 implementation
+{ TBGRACoordPool3D }
+procedure TBGRACoordPool3D.SetCapacity(ACapacity: integer);
+{ TBGRAGenericPool }
+function TBGRAGenericPool.GetElement(AIndex: integer): Pointer;
+begin
+  result := Pointer(PByte(FPoolData.Data)+AIndex*FElementSize);
+end;
+procedure TBGRAGenericPool.SetCapacity(ACapacity: integer);
 var NewPoolData: TMemoryBlockAlign128;
 begin
 …
     else
     begin
       NewPoolData := TMemoryBlockAlign128.Create(ACapacity*sizeof(TBGRACoordData3D));
+      NewPoolData := TMemoryBlockAlign128.Create(ACapacity*FElementSize);
       if FCapacity <> 0 then
       begin
 …
         if FCapacity < ACapacity then
         begin
           move(FPoolData.Data^, NewPoolData.Data^, FCapacity*sizeof(TBGRACoordData3D));
+          move(FPoolData.Data^, NewPoolData.Data^, FCapacity*FElementSize);
           //pad with zeros
           fillchar((pbyte(NewPoolData.Data)+FCapacity*sizeof(TBGRACoordData3D))^,(ACapacity-FCapacity)*sizeof(TBGRACoordData3D),0);
+          fillchar((pbyte(NewPoolData.Data)+FCapacity*FElementSize)^,(ACapacity-FCapacity)*FElementSize,0);
         end
         else //previous block is greater or equal
           move(FPoolData.Data^, NewPoolData.Data^, ACapacity*sizeof(TBGRACoordData3D));
+          move(FPoolData.Data^, NewPoolData.Data^, ACapacity*FElementSize);
         FreeAndNil(FPoolData);
       end else
        //clear new block
         fillchar(pbyte(NewPoolData.Data)^,ACapacity*sizeof(TBGRACoordData3D),0);
+        fillchar(pbyte(NewPoolData.Data)^,ACapacity*FElementSize,0);
       FPoolData := NewPoolData;
 …
 end;
+constructor TBGRACoordPool3D.Create(ACapacity: integer);
+function TBGRAGenericPool.GetUsed(AElement: integer): boolean;
+begin
+  result := false;
+end;
+procedure TBGRAGenericPool.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  //nothing
+end;
+constructor TBGRAGenericPool.Create(ACapacity: integer; AElementSize: integer);
 begin
   FCapacity := 0;
   FPoolData := nil;
   FNbCoord:= 0;
+  FNbElements:= 0;
   FFirstFree := 0;
   FUsedCapacity := 0;
+  FElementSize:= AElementSize;
   SetCapacity(ACapacity);
 end;
+destructor TBGRACoordPool3D.Destroy;
+begin
+  FPoolData.Free;
+destructor TBGRAGenericPool.Destroy;
+begin
+  FreeAndNil(FPoolData);
+  FCapacity := 0;
+  FNbElements:= 0;
+  FFirstFree := 0;
+  FUsedCapacity := 0;
   inherited Destroy;
 end;
+procedure TBGRACoordPool3D.Remove(AIndex: integer);
+begin
+  if CoordData[AIndex]^.used then
+  begin
+    CoordData[AIndex]^.used := false;
+procedure TBGRAGenericPool.Remove(AIndex: integer);
+begin
+  if (AIndex < 0) or (AIndex >= FUsedCapacity) then
+    raise ERangeError.Create('Index out of bounds');
+  if GetUsed(AIndex) then
+  begin
+    SetUsed(AIndex, false);
     if AIndex < FFirstFree then FFirstFree := AIndex;
     if AIndex = FUsedCapacity-1 then
     begin
       while (FUsedCapacity > 0) and not CoordData[FUsedCapacity-1]^.used do
+      while (FUsedCapacity > 0) and not GetUsed(FUsedCapacity-1) do
         dec(FUsedCapacity);
     end;
 …
 end;
 function TBGRACoordPool3D.Add: integer;
+function TBGRAGenericPool.Add: integer;
 begin
   //check for free space
   while FFirstFree < FCapacity do
   begin
     if not CoordData[FFirstFree]^.used then
     begin
       CoordData[FFirstFree]^.used := false;
+    if not GetUsed(FFirstFree) then
+    begin
+      SetUsed(FFirstFree,True);
       result := FFirstFree;
       inc(FFirstFree);
 …
   //no free space
   SetCapacity(FCapacity*2+8);
   CoordData[FFirstFree]^.used := false;
+  SetUsed(FFirstFree, true);
   result := FFirstFree;
   inc(FFirstFree);
 …
 end;
+{ TBGRACoordPool3D }
+constructor TBGRACoordPool3D.Create(ACapacity: integer);
+begin
+  inherited Create(ACapacity,SizeOf(TBGRACoordData3D));
+end;
+procedure TBGRACoordPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D;
+  const AProjection: TProjection3D);
+var
+  P: PBGRACoordData3D;
+  I: NativeInt;
+begin
+  if UsedCapacity = 0 then exit;
+  P := PBGRACoordData3D(FPoolData.Data);
+  {$IFDEF CPUI386}
+  {$asmmode intel}
+  if UseSSE then
+  begin
+    Matrix3D_SSE_Load(AMatrix);
+    asm
+      mov eax,[AProjection]
+      movups xmm4,[eax]
+      xorps xmm1,xmm1
+    end;
+    i := UsedCapacity;
+    if UseSSE3 then
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+        begin
+          MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord);
+          if viewCoord.z > 0 then
+          begin
+            asm
+              mov eax, P
+              movaps xmm3, [eax+16] //viewCoord
+              movaps xmm2,xmm3
+              shufps xmm2,xmm3,2+8+32+128
+              rcpps xmm2,xmm2  //xmm2 = InvZ
+              movss [eax+40],xmm2 //-> InvZ
+              mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+              mulps xmm3,xmm2  //xmm3 *= InvZ
+              movhlps xmm0,xmm4  //xmm0 = Projection.Center
+              addps xmm3,xmm0  //xmm3 += Projection.Center
+              movlps [eax+32],xmm3 //->projectedCoord
+              movaps [eax+48],xmm1 //->normal
+            end;
+          end else
+          asm
+            mov eax, P
+            movlps [eax+32],xmm1  //0->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+          if customNormalUsed then
+            MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal);
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end else
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+        begin
+          MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord);
+          if viewCoord.z > 0 then
+          begin
+            asm
+              mov eax, P
+              movaps xmm3, [eax+16] //viewCoord
+              movaps xmm2,xmm3
+              shufps xmm2,xmm3,2+8+32+128
+              rcpps xmm2,xmm2  //xmm2 = InvZ
+              movss [eax+40],xmm2 //-> InvZ
+              mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+              mulps xmm3,xmm2  //xmm3 *= InvZ
+              movhlps xmm0,xmm4  //xmm0 = Projection.Center
+              addps xmm3,xmm0  //xmm3 += Projection.Center
+              movlps [eax+32],xmm3 //->projectedCoord
+              movaps [eax+48],xmm1 //->normal
+            end;
+          end else
+          asm
+            mov eax, P
+            movlps [eax+32],xmm1  //0 ->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+          if customNormalUsed then
+            MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal);
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end;
+  end
+  else
+  {$ENDIF}
+  begin
+    i := UsedCapacity;
+    while i > 0 do
+    with P^ do
+    begin
+      if used then
+      begin
+        viewCoord := AMatrix*sceneCoord;
+        if customNormalUsed then
+          viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal)
+        else
+          ClearPoint3D_128(viewNormal);
+        if viewCoord.z > 0 then
+        begin
+          InvZ := 1/viewCoord.z;
+          projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
+                                   viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
+        end else
+          projectedCoord := PointF(0,0);
+      end;
+      dec(i);
+      inc(p);
+    end;
+  end;
+end;
 function TBGRACoordPool3D.GetCoordData(AIndex: integer): PBGRACoordData3D;
 begin
 …
 end;
+function TBGRACoordPool3D.GetUsed(AElement: integer): boolean;
+begin
+  Result:= CoordData[AElement]^.used;
+end;
+procedure TBGRACoordPool3D.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  CoordData[AElement]^.used := AUsed;
+end;
+procedure TBGRACoordPool3D.Remove(AIndex: integer);
+begin
+  inherited Remove(AIndex);
+end;
+{ TBGRANormalPool3D }
+function TBGRANormalPool3D.GetNormalData(AIndex: integer): PBGRANormalData3D;
+begin
+  result := PBGRANormalData3D(FPoolData.Data)+AIndex;
+end;
+function TBGRANormalPool3D.GetUsed(AElement: integer): boolean;
+begin
+  Result:= NormalData[AElement]^.used;
+end;
+procedure TBGRANormalPool3D.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  NormalData[AElement]^.used := AUsed;
+end;
+procedure TBGRANormalPool3D.Remove(AIndex: integer);
+begin
+  inherited Remove(AIndex);
+end;
+constructor TBGRANormalPool3D.Create(ACapacity: integer);
+begin
+  inherited Create(ACapacity,SizeOf(TBGRANormalData3D));
+end;
+procedure TBGRANormalPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D);
+var
+  P: PBGRANormalData3D;
+  I: NativeInt;
+begin
+  if UsedCapacity = 0 then exit;
+  P := PBGRANormalData3D(FPoolData.Data);
+  {$IFDEF CPUI386}
+  {$asmmode intel}
+  if UseSSE then
+  begin
+    Matrix3D_SSE_Load(AMatrix);
+    i := UsedCapacity;
+    if UseSSE3 then
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+          MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal);
+        dec(i);
+        inc(p);
+      end;
+    end else
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+          MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal);
+        dec(i);
+        inc(p);
+      end;
+    end;
+  end
+  else
+  {$ENDIF}
+  begin
+    i := UsedCapacity;
+    while i > 0 do
+    with P^ do
+    begin
+      if used then
+        viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal);
+      dec(i);
+      inc(p);
+    end;
+  end;
+end;
 end.

GraphicTest/Packages/bgrabitmap/bgradefaultbitmap.pas

-              r452
+              r472
 uses
+  Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType, FPImgCanv, BGRACanvas, BGRACanvas2D, FPWritePng;
+  Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType, FPImgCanv,
+  BGRACanvas, BGRACanvas2D, FPWritePng, BGRAArrow, BGRAPen;
 type
 …
       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 CheckHorizLineBounds(var x, y, x2: int32or64): boolean; inline;
+    function CheckVertLineBounds(var x, y, y2: int32or64; out delta: int32or64): 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;
 …
     FCanvasFP: TFPImageCanvas;
     FCanvasDrawModeFP: TDrawMode;
     FCanvasPixelProcFP: procedure(x, y: integer; col: TBGRAPixel) of object;
+    FCanvasPixelProcFP: procedure(x, y: int32or64; col: TBGRAPixel) of object;
     //canvas-like with antialiasing and texturing
 …
     //drawing options
     FEraseMode: boolean;      //when polygons are erased instead of drawn
-    FFont: TFont;             //font parameters
     FFontHeight: integer;
     FFontHeightSign: integer; //sign correction
+    FFontRenderer: TBGRACustomFontRenderer;
     { Pen style can be defined by PenStyle property of by CustomPenStyle property.
 …
     FCustomPenStyle:  TBGRAPenStyle;
     FPenStyle: TPenStyle;
+    FArrow: TBGRAArrow;
+    FLineCap: TPenEndCap;
     //Pixel data
 …
       AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean;
     function GetDataPtr: PBGRAPixel; override;
     procedure ClearTransparentPixels;
+    procedure ClearTransparentPixels; override;
     function GetScanlineFast(y: integer): PBGRAPixel; inline;
     function GetLineOrder: TRawImageLineOrder; override;
 …
     function GetAveragePixel: TBGRAPixel; override;
     function CreateAdaptedPngWriter: TFPWriterPNG;
-    function LoadAsBmp32(Str: TStream): boolean; override;
     //drawing
 …
     procedure SetPenStyle(const AValue: TPenStyle); override;
     function GetPenStyle: TPenStyle; override;
+    procedure UpdateFont;
+    function GetLineCap: TPenEndCap; override;
+    procedure SetLineCap(AValue: TPenEndCap); override;
+    function GetArrowEndSize: TPointF; override;
+    function GetArrowStartSize: TPointF; override;
+    procedure SetArrowEndSize(AValue: TPointF); override;
+    procedure SetArrowStartSize(AValue: TPointF); override;
+    function GetArrowEndOffset: single; override;
+    function GetArrowStartOffset: single; override;
+    procedure SetArrowEndOffset(AValue: single); override;
+    procedure SetArrowStartOffset(AValue: single); override;
+    function GetArrowEndRepeat: integer; override;
+    function GetArrowStartRepeat: integer; override;
+    procedure SetArrowEndRepeat(AValue: integer); override;
+    procedure SetArrowStartRepeat(AValue: integer); override;
     function GetFontHeight: integer; override;
     procedure SetFontHeight(AHeight: integer); override;
 …
     procedure SetFontFullHeight(AHeight: integer); override;
     function GetFontPixelMetric: TFontPixelMetric; override;
+    function GetFontRenderer: TBGRACustomFontRenderer; override;
+    procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override;
     function GetClipRect: TRect; override;
     procedure SetClipRect(const AValue: TRect); override;
+    function GetPixelCycleInline(ix,iy: integer; iFactX,iFactY: integer): TBGRAPixel; inline;
+    function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TBGRAPixel;
+    function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
+    function GetPolyLineOption: TBGRAPolyLineOptions;
+    function GetArrow: TBGRAArrow;
+    procedure SetArrowStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); override;
+    procedure SetArrowEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); override;
   public
 …
     function GetUnique: TBGRACustomBitmap;
+    {TFPCustomImage override}
+    constructor Create(AWidth, AHeight: integer); override;
+    procedure SetSize(AWidth, AHeight: integer); override;
+    {Constructors}
+    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}
+    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;
+    {------------------------- Constructors from TFPCustomImage----------------}
+    constructor Create(AWidth, AHeight: integer); override; //Creates a new bitmap, initialize properties and bitmap data
+    procedure SetSize(AWidth, AHeight: integer); override;  //Can only be called with an existing instance of TBGRABitmap.
+                                                            //Sets the dimensions of an existing TBGRABitmap instance.
+    {------------------------- Constructors from TBGRACustomBitmap-------------}
+    constructor Create; override;                    //Creates an image of width and height equal to zero.
+    constructor Create(ABitmap: TBitmap); override;  //Creates an image of dimensions AWidth and AHeight and filled with transparent pixels.
+    constructor Create(AWidth, AHeight: integer; Color: TColor); override;      //Creates an image of dimensions AWidth and AHeight and fills it with the opaque color Color.
+    constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); override;  //Creates an image of dimensions AWidth and AHeight and fills it with Color.
+    constructor Create(AFilename: string); override; // Creates an image by loading its content from the file AFilename.
+                                                     // The encoding of the string is the default one for the operating system.
+                                                     // It is recommended to use the next constructor and UTF8 encoding.
+    constructor Create(AFilename: string; AIsUtf8: boolean); override; //Creates an image by loading its content from the file AFilename.
+                                                                       //The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename.
+    constructor Create(AStream: TStream); override;  // Creates an image by loading its content from the stream AStream.
+    destructor Destroy; override;                    // Free the object and all its resources
+    {------------------------- Quasi-constructors -----------------------------}
+    function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; override;  //Can only be called from an existing instance of TBGRABitmap.
+                                                                                //Creates a new instance with dimensions AWidth and AHeight,
+                                                                                //containing transparent pixels.
+    function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; override;  //Can only be called from an existing instance of TBGRABitmap.
+                                                                                //Creates a new instance with dimensions AWidth and AHeight,
+                                                                                //and fills it with Color.
+    function NewBitmap(Filename: string): TBGRACustomBitmap; override;          //Can only be called from an existing instance of TBGRABitmap.
+                                                                                //Creates a new instance with by loading its content
+                                                                                //from the file Filename. The encoding of the string
+                                                                                //is the default one for the operating system.
+    function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; override; //Can only be called from an existing instance of TBGRABitmap.
+                                                                                //Creates a new instance with by loading its content
+                                                                                //from the file Filename.
     procedure SaveToFile(const filename: string); override;
     procedure SaveToStreamAsPng(Str: TStream); override;
     procedure Assign(ABitmap: TBitmap); override; overload;
+    procedure Assign(ARaster: TRasterImage); override; overload;
     procedure Assign(MemBitmap: TBGRACustomBitmap);override; overload;
     procedure Serialize(AStream: TStream); override;
 …
     {Pixel functions}
+    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 PtInClipRect(x, y: int32or64): boolean; inline;
+    procedure SetPixel(x, y: int32or64; c: TColor); override;
+    procedure SetPixel(x, y: int32or64; c: TBGRAPixel); override;
+    procedure XorPixel(x, y: int32or64; c: TBGRAPixel); override;
+    procedure DrawPixel(x, y: int32or64; c: TBGRAPixel); override;
+    procedure DrawPixel(x, y: int32or64; ec: TExpandedPixel); override;
+    procedure FastBlendPixel(x, y: int32or64; c: TBGRAPixel); override;
+    procedure ErasePixel(x, y: int32or64; alpha: byte); override;
+    procedure AlphaPixel(x, y: int32or64; alpha: byte); override;
+    function GetPixel(x, y: int32or64): TBGRAPixel; override;
+    function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override;
+    function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): 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;
+    function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; override;
+    function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
+    function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; override;
     {Line primitives}
+    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;
+    procedure SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    procedure DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override;
+    procedure HorizLine(x, y, x2: int32or64; texture: IBGRAScanner; ADrawMode : TDrawMode); override;
+    procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); override;
+    procedure SetVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override;
+    procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel;
       maxDiff: byte); override;
     {Shapes}
+    procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
+    procedure DrawPath(APath: IBGRAPath; c: TBGRAPixel; w: single); override;
+    procedure DrawPath(APath: IBGRAPath; texture: IBGRAScanner; w: single); override;
+    procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency); 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 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 DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); 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 DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); override;
     procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); 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 FillPath(APath: IBGRAPath; c: TBGRAPixel); override;
+    procedure FillPath(APath: IBGRAPath; texture: IBGRAScanner); override;
     procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); 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 FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); override;
     procedure FillQuadPerspectiveMappingAntialias(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; ACleanBorders: TRect); override;
     procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
 …
     procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); 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; zbuffer: psingle = nil); 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 ErasePoly(const points: array of TPointF; alpha: byte); override;
     procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); override;
+    procedure FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel; drawmode: TDrawMode); override;
+    procedure FillShape(shape: TBGRACustomFillInfo; texture: IBGRAScanner; drawmode: TDrawMode); override;
+    procedure FillShapeAntialias(shape: TBGRACustomFillInfo; c: TBGRAPixel); override;
+    procedure FillShapeAntialias(shape: TBGRACustomFillInfo; texture: IBGRAScanner); override;
+    procedure EraseShape(shape: TBGRACustomFillInfo; alpha: byte); override;
+    procedure EraseShapeAntialias(shape: TBGRACustomFillInfo; alpha: byte); override;
     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); 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 FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override; overload;
+    procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); override; overload;
     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); override;
     procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); 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: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextOutAngle(x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(x, y: single; 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;
+      BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer;
+      BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    { Draws the UTF8 encoded string, with color c.
+      If align is taLeftJustify, (x,y) is the top-left corner.
+      If align is taCenter, (x,y) is at the top and middle of the text.
+      If align is taRightJustify, (x,y) is the top-right corner.
+      The value of FontOrientation is taken into account, so that the text may be rotated. }
+    procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); override; overload;
+    { Same as above functions, except that the text is filled using texture.
+      The value of FontOrientation is taken into account, so that the text may be rotated. }
+    procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override; overload;
+    { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. }
+    procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); override; overload;
+    procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override; overload;
+    { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect.
+      Additional style information is provided by the style parameter.
+      The color c or texture is used to fill the text. No rotation is applied. }
+    procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override; overload;
+    procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override; overload;
+    { Returns the total size of the string provided using the current font.
+      Orientation is not taken into account, so that the width is along the text.  }
+    function TextSize(sUTF8: string): TSize; override;
     {Spline}
 …
     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 FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ADrawMode: TDrawMode); override;
+    procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ADrawMode: TDrawMode); 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;
 …
     {BGRA bitmap functions}
+    procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); override;
+    procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); override;
     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; ARestoreOffsetAfterRotation: boolean = false); override;
+    procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); override;
+    procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); override;
+    procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
     procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); override;
     procedure BlendImageOver(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte = 255;
 …
     function Equals(comp: TBGRAPixel): boolean; override;
     function GetImageBounds(Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; override;
     function GetImageBounds(Channels: TChannels): TRect; override;
+    function GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect; override;
     function GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect; override;
     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override;
 …
     function Resample(newWidth, newHeight: integer;
       mode: TResampleMode = rmFineResample): TBGRACustomBitmap; override;
     procedure VerticalFlip; override;
     procedure HorizontalFlip; override;
+    procedure VerticalFlip(ARect: TRect); override;
+    procedure HorizontalFlip(ARect: TRect); override;
     function RotateCW: TBGRACustomBitmap; override;
     function RotateCCW: TBGRACustomBitmap; override;
     procedure Negative; override;
+    procedure NegativeRect(ABounds: TRect); override;
     procedure LinearNegative; override;
+    procedure LinearNegativeRect(ABounds: TRect); override;
+    procedure InplaceGrayscale; override;
+    procedure InplaceGrayscale(ABounds: TRect); override;
     procedure SwapRedBlue; override;
     procedure GrayscaleToAlpha; override;
     procedure AlphaToGrayscale; override;
     procedure ApplyMask(mask: TBGRACustomBitmap); override;
+    procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); override;
     procedure ApplyGlobalOpacity(alpha: byte); override;
     procedure ConvertToLinearRGB; override;
     procedure ConvertFromLinearRGB; override;
+    procedure DrawCheckers(ARect: TRect; AColorEven,AColorOdd: TBGRAPixel);
     {Filters}
 …
     function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; override;
     function FilterSmooth: TBGRACustomBitmap; override;
+    function FilterSharpen: TBGRACustomBitmap; override;
+    function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; override;
+    function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; override;
     function FilterContour: TBGRACustomBitmap; override;
+    function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; override;
     function FilterBlurRadial(radius: integer;
       blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; override;
+    function FilterBlurRadial(ABounds: TRect; radius: integer;
+      blurType: TRadialBlurType): TBGRACustomBitmap; override;
     function FilterBlurMotion(distance: integer; angle: single;
       oriented: boolean): TBGRACustomBitmap; override;
+    function FilterBlurMotion(ABounds: TRect; distance: integer; angle: single;
+      oriented: boolean): TBGRACustomBitmap; override;
     function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; override;
+    function FilterCustomBlur(ABounds: TRect; mask: TBGRACustomBitmap): TBGRACustomBitmap; override;
     function FilterEmboss(angle: single): TBGRACustomBitmap; override;
+    function FilterEmboss(angle: single; ABounds: TRect): TBGRACustomBitmap; override;
     function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; override;
     function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; override;
     function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; override;
     function FilterGrayscale: TBGRACustomBitmap; override;
+    function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; override;
     function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; override;
+    function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; override;
+    function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; override;
+    function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; override;
     function FilterSphere: TBGRACustomBitmap; override;
     function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; override;
+    function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; override;
     function FilterCylinder: TBGRACustomBitmap; override;
     function FilterPlane: TBGRACustomBitmap; override;
 …
 uses Math, LCLIntf, LCLType,
   BGRABlend, BGRAFilters, BGRAPen, BGRAText, BGRATextFX, BGRAGradientScanner,
+  BGRABlend, BGRAFilters, BGRAText, BGRATextFX, BGRAGradientScanner,
   BGRAResample, BGRATransform, BGRAPolygon, BGRAPolygonAliased,
   BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
 …
 procedure TBitmapTracker.Changed(Sender: TObject);
 begin
+  FUser.FBitmapModified := True;
+  if FUser <> nil then
+    FUser.FBitmapModified := True;
   inherited Changed(Sender);
 end;
 …
 end;
+{ Update font properties to internal TFont object }
+procedure TBGRADefaultBitmap.UpdateFont;
+begin
+  if FFont.Name <> FontName then
+    FFont.Name := FontName;
+  if FFont.Style <> FontStyle then
+    FFont.Style := FontStyle;
+  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;
+function TBGRADefaultBitmap.GetLineCap: TPenEndCap;
+begin
+  result := FLineCap;
+end;
+procedure TBGRADefaultBitmap.SetLineCap(AValue: TPenEndCap);
+begin
+  if AValue <> FLineCap then
+  begin
+    FLineCap:= AValue;
+    if Assigned(FArrow) then FArrow.LineCap := AValue;
+  end;
+end;
+function TBGRADefaultBitmap.GetArrowEndSize: TPointF;
+begin
+  result := GetArrow.EndSize;
+end;
+function TBGRADefaultBitmap.GetArrowStartSize: TPointF;
+begin
+  result := GetArrow.StartSize;
+end;
+procedure TBGRADefaultBitmap.SetArrowEndSize(AValue: TPointF);
+begin
+  GetArrow.EndSize := AValue;
+end;
+procedure TBGRADefaultBitmap.SetArrowStartSize(AValue: TPointF);
+begin
+  GetArrow.StartSize := AValue;
+end;
+function TBGRADefaultBitmap.GetArrowEndOffset: single;
+begin
+  result := GetArrow.EndOffsetX;
+end;
+function TBGRADefaultBitmap.GetArrowStartOffset: single;
+begin
+  result := GetArrow.StartOffsetX;
+end;
+procedure TBGRADefaultBitmap.SetArrowEndOffset(AValue: single);
+begin
+  GetArrow.EndOffsetX := AValue;
+end;
+procedure TBGRADefaultBitmap.SetArrowStartOffset(AValue: single);
+begin
+  GetArrow.StartOffsetX := AValue;
+end;
+function TBGRADefaultBitmap.GetArrowEndRepeat: integer;
+begin
+  result := GetArrow.EndRepeatCount;
+end;
+function TBGRADefaultBitmap.GetArrowStartRepeat: integer;
+begin
+  result := GetArrow.StartRepeatCount;
+end;
+procedure TBGRADefaultBitmap.SetArrowEndRepeat(AValue: integer);
+begin
+  GetArrow.EndRepeatCount := AValue;
+end;
+procedure TBGRADefaultBitmap.SetArrowStartRepeat(AValue: integer);
+begin
+  GetArrow.StartRepeatCount := AValue;
 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;
+begin
+  result := FontRenderer.GetFontPixelMetric;
+end;
+function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer;
+begin
+  if FFontRenderer = nil then FFontRenderer := TLCLFontRenderer.Create;
+  result := FFontRenderer;
+  result.FontName := FontName;
+  result.FontStyle := FontStyle;
+  result.FontQuality := FontQuality;
+  result.FontOrientation := FontOrientation;
+  result.FontEmHeight := FFontHeight;
+end;
+procedure TBGRADefaultBitmap.SetFontRenderer(AValue: TBGRACustomFontRenderer);
+begin
+  if AValue = FFontRenderer then exit;
+  FFontRenderer.Free;
+  FFontRenderer := AValue
 end;
 …
 end;
+{ Creates a new bitmap. Internally, it uses the same type so that if you
+{ Creates a new bitmap with dimensions AWidth and AHeight and filled with
+  transparent pixels. 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;
 …
 end;
+{ Can only be called from an existing instance of TBGRABitmap.
+  Creates a new instance with dimensions AWidth and AHeight,
+  and fills it with Color. }
 function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer;
   Color: TBGRAPixel): TBGRACustomBitmap;
 …
 end;
+{ Creates a new bitmap and loads it contents from a file }
+{ Creates a new bitmap and loads it contents from a file.
+  The encoding of the string is the default one for the operating system.
+  It is recommended to use the next function and UTF8 encoding }
 function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRACustomBitmap;
 var
 …
   BGRAClass := TBGRABitmapAny(self.ClassType);
   Result    := BGRAClass.Create(Filename);
+end;
+{ Creates a new bitmap and loads it contents from a file.
+  It is recommended to use UTF8 encoding }
+function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap;
+var
+  BGRAClass: TBGRABitmapAny;
+begin
+  BGRAClass := TBGRABitmapAny(self.ClassType);
+  Result    := BGRAClass.Create(Filename,AIsUtf8);
 end;
 …
 {---------------------- Constructors ---------------------------------}
+{ Creates an image of width and height equal to zero. }
 constructor TBGRADefaultBitmap.Create;
 begin
 …
 end;
+{ Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. }
 constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap);
 begin
 …
 end;
+{ Creates an image of dimensions AWidth and AHeight and fills it with the opaque color Color. }
 constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer; Color: TColor);
 begin
 …
 end;
+{ Creates an image of dimensions AWidth and AHeight and fills it with Color. }
 constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer; Color: TBGRAPixel);
 begin
 …
 end;
+{ Creates an image by loading its content from the file AFilename.
+  The encoding of the string is the default one for the operating system.
+  It is recommended to use the next constructor and UTF8 encoding. }
+constructor TBGRADefaultBitmap.Create(AFilename: string);
+begin
+  Init;
+  inherited Create(0, 0);
+  LoadFromFile(Afilename);
+end;
+{ Free the object and all its resources }
 destructor TBGRADefaultBitmap.Destroy;
 begin
   FreeData;
   FFont.Free;
+  FFontRenderer.Free;
   FBitmap.Free;
   FCanvasFP.Free;
   FCanvasBGRA.Free;
   FCanvas2D.Free;
+  FArrow.Free;
   inherited Destroy;
 end;
 …
 {------------------------- Loading functions ----------------------------------}
+constructor TBGRADefaultBitmap.Create(AFilename: string);
+{ Creates an image by loading its content from the file AFilename.
+  The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename. }
+constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean);
 begin
   Init;
+  inherited Create(0, 0);
+  LoadFromFile(Afilename);
+end;
+  inherited Create(0, 0);
+  if AIsUtf8 then
+    LoadFromFileUTF8(Afilename)
+  else
+    LoadFromFile(Afilename);
+end;
+{ Creates an image by loading its content from the stream AStream. }
 constructor TBGRADefaultBitmap.Create(AStream: TStream);
 begin
 …
 end;
 procedure TBGRADefaultBitmap.Assign(ABitmap: TBitmap);
+procedure TBGRADefaultBitmap.Assign(ARaster: TRasterImage);
 var TempBmp: TBitmap;
     ConvertOk: boolean;
 begin
   DiscardBitmapChange;
+  SetSize(ABitmap.Width, ABitmap.Height);
+  if not LoadFromRawImage(ABitmap.RawImage,0,False,False) then
+  SetSize(ARaster.Width, ARaster.Height);
+  if not LoadFromRawImage(ARaster.RawImage,0,False,False) then
+  if ARaster is TBitmap then
   begin //try to convert
     TempBmp := TBitmap.Create;
     TempBmp.Width := ABitmap.Width;
     TempBmp.Height := ABitmap.Height;
     TempBmp.Canvas.Draw(0,0,ABitmap);
+    TempBmp.Width := ARaster.Width;
+    TempBmp.Height := ARaster.Height;
+    TempBmp.Canvas.Draw(0,0,ARaster);
     ConvertOk := LoadFromRawImage(TempBmp.RawImage,0,False,False);
     TempBmp.Free;
     if not ConvertOk then
       raise Exception.Create('Unable to convert image to 24 bit');
+  end;
+  end else
+    raise Exception.Create('Unable to convert image to 24 bit');
   If Empty then AlphaFill(255); // if bitmap seems to be empty, assume
                                 // it is an opaque bitmap without alpha channel
 …
 procedure TBGRADefaultBitmap.Serialize(AStream: TStream);
 var lWidth,lHeight: integer;
+var lWidth,lHeight,y: integer;
 begin
   lWidth := NtoLE(Width);
 …
   AStream.Write(lWidth,sizeof(lWidth));
   AStream.Write(lHeight,sizeof(lHeight));
+  AStream.Write(Data^, NbPixels*sizeof(TBGRAPixel));
+  for y := 0 to Height-1 do
+    AStream.Write(ScanLine[y]^, Width*sizeof(TBGRAPixel));
 end;
 {$hints off}
 procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
 var lWidth,lHeight: integer;
+var lWidth,lHeight,y: integer;
 begin
   AStream.Read(lWidth,sizeof(lWidth));
 …
   lHeight := LEtoN(lHeight);
   SetSize(lWidth,lHeight);
+  AStream.Read(Data^, NbPixels*sizeof(TBGRAPixel));
+  for y := 0 to Height-1 do
+    AStream.Read(ScanLine[y]^, Width*sizeof(TBGRAPixel));
 end;
 {$hints on}
 …
   AStream.Write(zero,sizeof(zero));
   AStream.Write(zero,sizeof(zero));
-end;
-procedure TBGRADefaultBitmap.LoadFromFile(const filename: string);
-var
-  OldDrawMode: TDrawMode;
-begin
-  OldDrawMode := CanvasDrawModeFP;
-  CanvasDrawModeFP := dmSet;
-  ClipRect := rect(0,0,Width,Height);
-  try
-    inherited LoadFromfile(filename);
-  finally
-    CanvasDrawModeFP := OldDrawMode;
-    ClearTransparentPixels;
-  end;
 end;
 …
 { Check if a point is in the clipping rectangle }
 function TBGRADefaultBitmap.PtInClipRect(x, y: integer): boolean;
+function TBGRADefaultBitmap.PtInClipRect(x, y: int32or64): boolean;
 begin
   result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom);
 …
 end;
 function TBGRADefaultBitmap.GetPixelCycleInline(ix, iy: integer; iFactX,
   iFactY: integer): TBGRAPixel;
 var
   ixMod1,ixMod2: integer;
   w1,w2,w3,w4,alphaW: cardinal;
   bSum, gSum, rSum: cardinal;
   aSum: cardinal;
+function TBGRADefaultBitmap.InternalGetPixelCycle256(ix, iy: int32or64; iFactX,
+  iFactY: int32or64): TBGRAPixel;
+var
+  ixMod1,ixMod2: int32or64;
+  w1,w2,w3,w4,alphaW: UInt32or64;
+  bSum, gSum, rSum: UInt32or64;
+  aSum: UInt32or64;
   c:    TBGRAPixel;
 …
   aSum   := 0;
   scan := GetScanlineFast(PositiveMod(iy,Height));
   ixMod1 := PositiveMod(ix,Width); //apply cycle
   c      := (scan + ixMod1)^;
+  scan := GetScanlineFast(iy);
+  ixMod1 := ix;
+  c      := (scan + ix)^;
   alphaW := c.alpha * w1;
   aSum   += alphaW;
 …
   bSum   += c.blue * alphaW;
   Inc(ix);
   ixMod2 := PositiveMod(ix,Width); //apply cycle
+  ixMod2 := ix+1;
+  if ixMod2=Width then ixMod2 := 0;
   c      := (scan + ixMod2)^;
   alphaW := c.alpha * w2;
 …
   Inc(iy);
+  scan := GetScanlineFast(PositiveMod(iy,Height));
+  if iy = Height then iy := 0;
+  scan := GetScanlineFast(iy);
   c      := (scan + ixMod2)^;
 …
   end;
 end;
+function TBGRADefaultBitmap.InternalGetPixel256(ix, iy: int32or64; iFactX,
+  iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
+var
+  w1,w2,w3,w4,alphaW: cardinal;
+  rSum, gSum, bSum: cardinal; //rgbDiv = aSum
+  aSum, aDiv: cardinal;
+  c:    TBGRAPixel;
+  scan: PBGRAPixel;
+begin
+  rSum   := 0;
+  gSum   := 0;
+  bSum   := 0;
+  aSum   := 0;
+  aDiv   := 0;
+  w4 := (iFactX*iFactY+127) shr 8;
+  w3 := iFactY-w4;
+  {$PUSH}{$HINTS OFF}
+  w1 := (256-iFactX)-w3;
+  {$POP}
+  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;
+      aDiv   += 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;
+      aDiv   += 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;
+      aDiv   += 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;
+      aDiv   += w3;
+      aSum   += alphaW;
+      rSum   += c.red * alphaW;
+      gSum   += c.green * alphaW;
+      bSum   += c.blue * alphaW;
+    end;
+  end;
+  if aSum < 128 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;
+    if smoothBorder or (aDiv = 256) then
+      Result.alpha := (aSum + 128) shr 8
+    else
+      Result.alpha := (aSum + aDiv shr 1) div aDiv;
+  end;
+end;
+function TBGRADefaultBitmap.GetPolyLineOption: TBGRAPolyLineOptions;
+begin
+  result := [];
+  if Assigned(FArrow) and FArrow.IsStartDefined then result += [plNoStartCap];
+  if Assigned(FArrow) and FArrow.IsEndDefined then result += [plNoEndCap];
+end;
+function TBGRADefaultBitmap.GetArrow: TBGRAArrow;
+begin
+  if FArrow = nil then
+  begin
+    FArrow := TBGRAArrow.Create;
+    FArrow.LineCap := LineCap;
+  end;
+  result := FArrow;
+end;
 {-------------------------- Pixel functions -----------------------------------}
 procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TBGRAPixel);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.XorPixel(x, y: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.XorPixel(x, y: int32or64; c: TBGRAPixel);
 var
   p : PDWord;
 …
 end;
 procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TColor);
+procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor);
 var
   p: PByte;
 …
 end;
 procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; c: TBGRAPixel);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; ec: TExpandedPixel);
+procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; ec: TExpandedPixel);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.FastBlendPixel(x, y: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.FastBlendPixel(x, y: int32or64; c: TBGRAPixel);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.ErasePixel(x, y: integer; alpha: byte);
+procedure TBGRADefaultBitmap.ErasePixel(x, y: int32or64; alpha: byte);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.AlphaPixel(x, y: integer; alpha: byte);
+procedure TBGRADefaultBitmap.AlphaPixel(x, y: int32or64; alpha: byte);
 begin
   if not PtInClipRect(x,y) then exit;
 …
 end;
 function TBGRADefaultBitmap.GetPixel(x, y: integer): TBGRAPixel;
+function TBGRADefaultBitmap.GetPixel(x, y: int32or64): TBGRAPixel;
 begin
   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then //it is possible to read pixels outside of the cliprect
 …
 end;
+function TBGRADefaultBitmap.GetPixel256(x, y, fracX256, fracY256: int32or64;
+  AResampleFilter: TResampleFilter; smoothBorder: boolean = true): TBGRAPixel;
+begin
+  if (fracX256 = 0) and (fracY256 = 0) then
+    result := GetPixel(x,y)
+  else if AResampleFilter = rfBox then
+  begin
+    if fracX256 >= 128 then inc(x);
+    if fracY256 >= 128 then inc(y);
+    result := GetPixel(x,y);
+  end else
+  begin
+    LoadFromBitmapIfNeeded;
+    result := InternalGetPixel256(x,y,FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter),smoothBorder);
+  end;
+end;
 {$hints off}
 { 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;
+  factX,factY: single;
+  iFactX,iFactY: integer;
+begin
+  ix := floor(x);
+  iy := floor(y);
+  factX := x-ix; //distance from integer coordinate
+  factY := y-iy;
+function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel;
+var
+  ix, iy: Int32or64;
+  iFactX,iFactY: Int32or64;
+begin
+  ix := round(x*256);
+  if (ix<= -256) or (ix>=Width shl 8) then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
+  iy := round(y*256);
+  if (iy<= -256) or (iy>=Height shl 8) then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
+  iFactX := ix and 255; //distance from integer coordinate
+  iFactY := iy and 255;
+  if ix<0 then ix := -1 else ix := ix shr 8;
+  if iy<0 then iy := -1 else iy := iy shr 8;
   //if the coordinate is integer, then call standard GetPixel function
   if (factX = 0) and (factY = 0) then
   begin
     Result := GetPixel(ix, iy);
+  if (iFactX = 0) and (iFactY = 0) then
+  begin
+    Result := (GetScanlineFast(iy)+ix)^;
     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 < 128 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;
+  result := InternalGetPixel256(ix,iy,FineInterpolation256(iFactX,AResampleFilter),FineInterpolation256(iFactY,AResampleFilter),smoothBorder);
 end;
 …
 function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
 var
+  ix, iy: integer;
+  iFactX,iFactY: integer;
+begin
+  ix, iy: Int32or64;
+  iFactX,iFactY: Int32or64;
+begin
+  if FData = nil then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
   LoadFromBitmapIfNeeded;
+  iFactX := round(x*256);
+  iFactY := round(y*256);
+  ix := (iFactX shr 8)+ScanOffset.X;
+  iy := (iFactY shr 8)+ScanOffset.Y;
+  iFactX := iFactX and 255;
+  iFactY := iFactY and 255;
+  ix := round(x*256);
+  iy := round(y*256);
+  iFactX := ix and 255;
+  iFactY := iy and 255;
+  ix := PositiveMod(ix, FWidth shl 8) shr 8;
+  iy := PositiveMod(iy, FHeight shl 8) shr 8;
   if (iFactX = 0) and (iFactY = 0) then
   begin
     result := (ScanLine[PositiveMod(iy, FHeight)]+PositiveMod(ix, FWidth))^;
+    result := (GetScanlineFast(iy)+ix)^;
     exit;
   end;
   if ScanInterpolationFilter <> rfLinear then
   begin
 …
     iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
   end;
+  result := GetPixelCycleInline(ix,iy, iFactX,iFactY);
+  result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
 end;
 …
   ): 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;
+  ix, iy: Int32or64;
+  iFactX,iFactY: Int32or64;
+begin
+  if FData = nil then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
+  ix := round(x*256);
+  iy := round(y*256);
+  iFactX := ix and 255;
+  iFactY := iy and 255;
+  if ix < 0 then ix := -((iFactX-ix) shr 8)
+  else ix := ix shr 8;
+  if iy < 0 then iy := -((iFactY-iy) shr 8)
+  else iy := iy shr 8;
+  result := GetPixelCycle256(ix,iy,iFactX,iFactY,AResampleFilter,repeatX,repeatY);
+end;
+function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
+  fracY256: int32or64; AResampleFilter: TResampleFilter): TBGRAPixel;
+begin
+  if (fracX256 = 0) and (fracY256 = 0) then
+    result := GetPixelCycle(x,y)
+  else if AResampleFilter = rfBox then
+  begin
+    if fracX256 >= 128 then inc(x);
+    if fracY256 >= 128 then inc(y);
+    result := GetPixelCycle(x,y);
+  end else
+  begin
+    LoadFromBitmapIfNeeded;
+    result := InternalGetPixelCycle256(PositiveMod(x,FWidth),PositiveMod(y,FHeight),FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter));
+  end;
+end;
+function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
+  fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean;
+  repeatY: boolean): TBGRAPixel;
+begin
+  if not repeatX and not repeatY then
+    result := GetPixel256(x,y,fracX256,fracY256,AResampleFilter)
+  else if repeatX and repeatY then
+    result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter)
+  else
+  begin
+    if not repeatX then
+    begin
+      if x < 0 then
+      begin
+        if x < -1 then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end;
+        result := GetPixelCycle256(0,y,0,fracY256,AResampleFilter);
+        result.alpha:= result.alpha*fracX256 shr 8;
+        if result.alpha = 0 then
+          result := BGRAPixelTransparent;
+        exit;
+      end;
+      if x >= FWidth-1 then
+      begin
+        if x >= FWidth then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end;
+        result := GetPixelCycle256(FWidth-1,y,0,fracY256,AResampleFilter);
+        result.alpha:= result.alpha*(256-fracX256) shr 8;
+        if result.alpha = 0 then
+          result := BGRAPixelTransparent;
+        exit;
+      end;
+    end else
+    begin
+      if y < 0 then
+      begin
+        if y < -1 then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end;
+        result := GetPixelCycle256(x,0,fracX256,0,AResampleFilter);
+        result.alpha:= result.alpha*fracY256 shr 8;
+        if result.alpha = 0 then
+          result := BGRAPixelTransparent;
+        exit;
+      end;
+      if y >= FHeight-1 then
+      begin
+        if y >= FHeight then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end;
+        result := GetPixelCycle256(x,FHeight-1,fracX256,0,AResampleFilter);
+        result.alpha:= result.alpha*(256-fracY256) shr 8;
+        if result.alpha = 0 then
+          result := BGRAPixelTransparent;
+        exit;
+      end;
     end;
+    if x < 0 then
+    begin
+      alpha := round((0.5+x)*510);
+      x := 0;
+    end
+    else
+    if x > Width-1 then
+    begin
+      alpha := round((Width-0.5-x)*510);
+      x := Width-1;
+    end;
+  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
+    begin
+      alpha := round((0.5+y)*2*alpha);
+      y := 0;
+    end
+    else
+    if y > Height-1 then
+    begin
+      alpha := round((Height-0.5-y)*2*alpha);
+      y := Height-1;
+    end;
+  end;
+  result := GetPixelCycle(x,y,AResampleFilter);
+  if alpha<>255 then
+    result.alpha := ApplyOpacity(result.alpha,alpha);
+    result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter);
+  end;
 end;
 …
     (ARawImage.Description.BlueShift = 8) and
     (ARawImage.Description.ByteOrder = riboMSBFirst)) then
+    mustSwapRedBlue:= true
+  begin
+    mustSwapRedBlue:= true;
+    mustReverse32 := false;
+  end
   else
   begin
 …
 end;
+procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency);
+var constScanner: TBGRAConstantScanner;
+begin
+  if AFadePosition = 0 then
+    FillRect(ARect, Source1, mode) else
+  if AFadePosition = 255 then
+    FillRect(ARect, Source2, mode) else
+  begin
+    constScanner := TBGRAConstantScanner.Create(BGRA(AFadePosition,AFadePosition,AFadePosition,255));
+    CrossFade(ARect, Source1,Source2, constScanner, mode);
+    constScanner.Free;
+  end;
+end;
+procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency);
+var xb,yb: NativeInt;
+  pdest: PBGRAPixel;
+  c: TBGRAPixel;
+  fadePos: byte;
+begin
+  if not IntersectRect(ARect,ARect,ClipRect) then exit;
+  for yb := ARect.top to ARect.Bottom-1 do
+  begin
+    pdest := GetScanlineFast(yb)+ARect.Left;
+    Source1.ScanMoveTo(ARect.left, yb);
+    Source2.ScanMoveTo(ARect.left, yb);
+    AFadeMask.ScanMoveTo(ARect.left, yb);
+    for xb := ARect.left to ARect.Right-1 do
+    begin
+      fadePos := AFadeMask.ScanNextPixel.green;
+      c := MergeBGRAWithGammaCorrection(Source1.ScanNextPixel,not fadePos,Source2.ScanNextPixel,fadePos);
+      case mode of
+      dmSet: pdest^ := c;
+      dmDrawWithTransparency: DrawPixelInlineWithAlphaCheck(pdest, c);
+      dmLinearBlend: FastBlendPixelInline(pdest,c);
+      dmSetExceptTransparent: if c.alpha = 255 then pdest^ := c;
+      end;
+      inc(pdest);
+    end;
+  end;
+  InvalidateBitmap;
+end;
 procedure TBGRADefaultBitmap.DiscardBitmapChange; inline;
 begin
 …
   FillMode := fmWinding;
-  FFont     := TFont.Create;
   FontName  := 'Arial';
   FontStyle := [];
   FontAntialias := False;
   FFontHeight := 20;
-  FFontHeightSign := GetFontHeightSign(FFont);
   PenStyle := psSolid;
 …
 {---------------------------- Line primitives ---------------------------------}
 function TBGRADefaultBitmap.CheckHorizLineBounds(var x,y,x2: integer): boolean; inline;
 var
   temp: integer;
+function TBGRADefaultBitmap.CheckHorizLineBounds(var x,y,x2: int32or64): boolean; inline;
+var
+  temp: int32or64;
 begin
   if (x2 < x) then
 …
 end;
 procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
 begin
   if not CheckHorizLineBounds(x,y,x2) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
 begin
   if not CheckHorizLineBounds(x,y,x2) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
 begin
   if not CheckHorizLineBounds(x,y,x2) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel
+procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel
   );
 begin
 …
 end;
 procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer;
   texture: IBGRAScanner);
+procedure TBGRADefaultBitmap.HorizLine(x, y, x2: int32or64;
+  texture: IBGRAScanner; ADrawMode : TDrawMode);
 begin
   if not CheckHorizLineBounds(x,y,x2) then exit;
   texture.ScanMoveTo(x,y);
   ScannerPutPixels(texture,scanline[y] + x, x2 - x + 1,dmDrawWithTransparency);
+  ScannerPutPixels(texture,scanline[y] + x, x2 - x + 1,ADrawMode);
   InvalidateBitmap;
 end;
 procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
 begin
   if not CheckHorizLineBounds(x,y,x2) then exit;
 …
 end;
 procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: integer; alpha: byte);
+procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte);
 begin
   if alpha = 0 then
 …
 end;
 function TBGRADefaultBitmap.CheckVertLineBounds(var x,y,y2: integer; out delta: integer): boolean; inline;
 var
   temp: integer;
+function TBGRADefaultBitmap.CheckVertLineBounds(var x,y,y2: int32or64; out delta: int32or64): boolean; inline;
+var
+  temp: int32or64;
 begin
   if FLineOrder = riloBottomToTop then
 …
 end;
 procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: integer; c: TBGRAPixel);
 var
   n, delta: integer;
+procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: int32or64; c: TBGRAPixel);
+var
+  n, delta: int32or64;
   p: PBGRAPixel;
 begin
 …
 end;
 procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: integer; c: TBGRAPixel);
 var
   n, delta: integer;
+procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: int32or64; c: TBGRAPixel);
+var
+  n, delta: int32or64;
   p: PBGRAPixel;
 begin
 …
 end;
 procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
 var
   n, delta: integer;
+procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel);
+var
+  n, delta: int32or64;
   p: PBGRAPixel;
 begin
 …
 end;
 procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: integer; alpha: byte);
 var
   n, delta: integer;
+procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte);
+var
+  n, delta: int32or64;
   p: PBGRAPixel;
 begin
 …
 end;
 procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
 var
   n, delta: integer;
+procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel);
+var
+  n, delta: int32or64;
   p: PBGRAPixel;
 begin
 …
 end;
 procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: integer;
+procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: int32or64;
   c, compare: TBGRAPixel; maxDiff: byte);
 begin
 …
 end;
+procedure TBGRADefaultBitmap.SetArrowStart(AStyle: TBGRAArrowStyle;
+  ATipStyle: TPenJoinStyle; ARelativePenWidth: single; ATriangleBackOffset: single);
+begin
+  GetArrow.SetStart(AStyle,ATipStyle,ARelativePenWidth,ATriangleBackOffset);
+end;
+procedure TBGRADefaultBitmap.SetArrowEnd(AStyle: TBGRAArrowStyle;
+  ATipStyle: TPenJoinStyle; ARelativePenWidth: single; ATriangleBackOffset: single);
+begin
+  GetArrow.SetEnd(AStyle,ATipStyle,ARelativePenWidth,ATriangleBackOffset);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; c: TBGRAPixel; w: single);
+var tempCanvas: TBGRACanvas2D;
+begin
+  tempCanvas:= TBGRACanvas2D.Create(self);
+  tempCanvas.strokeStyle(c);
+  tempCanvas.lineWidth := w;
+  tempCanvas.lineStyle(CustomPenStyle);
+  tempCanvas.lineCapLCL := LineCap;
+  tempCanvas.lineJoinLCL := JoinStyle;
+  tempCanvas.path(APath);
+  tempCanvas.stroke;
+  tempCanvas.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; texture: IBGRAScanner; w: single);
+var tempCanvas: TBGRACanvas2D;
+begin
+  tempCanvas:= TBGRACanvas2D.Create(self);
+  tempCanvas.strokeStyle(texture);
+  tempCanvas.lineWidth := w;
+  tempCanvas.lineStyle(CustomPenStyle);
+  tempCanvas.lineCapLCL := LineCap;
+  tempCanvas.lineJoinLCL := JoinStyle;
+  tempCanvas.path(APath);
+  tempCanvas.stroke;
+  tempCanvas.Free;
+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);
+  c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
+begin
+  BGRADrawLineAliased(self,x1,y1,x2,y2,c,DrawLastPixel,ADrawMode);
 end;
 …
   c: TBGRAPixel; DrawLastPixel: boolean);
 begin
   BGRADrawLineAntialias(self,x1,y1,x2,y2,c,DrawLastPixel);
+  BGRADrawLineAntialias(self,x1,y1,x2,y2,c,DrawLastPixel,LinearAntialiasing);
 end;
 …
 begin
   DashPos := 0;
   BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos);
+  BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos,LinearAntialiasing);
 end;
 …
   c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
 begin
   BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos);
+  BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos,LinearAntialiasing);
 end;
 …
   c: TBGRAPixel; w: single);
 begin
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,nil,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,nil,JoinMiterLimit);
 end;
 …
   texture: IBGRAScanner; w: single);
 begin
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,texture,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,texture,JoinMiterLimit);
 end;
 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
   c: TBGRAPixel; w: single; closed: boolean);
+  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);
+  options += GetPolyLineOption;
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,nil,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,nil,JoinMiterLimit)
 end;
 …
     c := BGRAPixelTransparent;
   end;
+  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,texture,JoinMiterLimit);
+  options += GetPolyLineOption;
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,texture,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,texture,JoinMiterLimit);
 end;
 …
   c: TBGRAPixel; w: single);
 begin
+  BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,nil,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,nil,JoinMiterLimit)
 end;
 …
   const points: array of TPointF; texture: IBGRAScanner; w: single);
 begin
+  BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,texture,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,texture,JoinMiterLimit);
 end;
 …
 begin
   if not closed then options := [plRoundCapOpen] else options := [];
+  BGRAPolyLine(self,points,w,c,pecRound,JoinStyle,FCustomPenStyle,options,nil,JoinMiterLimit);
+  options += GetPolyLineOption;
+  if Assigned(FArrow) then
+    BGRAPen.BGRAPolyLine(self,points,w,c,pecRound,JoinStyle,FCustomPenStyle,options,nil,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    BGRAPen.BGRAPolyLine(self,points,w,c,pecRound,JoinStyle,FCustomPenStyle,options,nil,JoinMiterLimit);
+end;
+procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
+  const points: array of TPointF; c: TBGRAPixel; w: single;
+  fillcolor: TBGRAPixel);
+var multi: TBGRAMultishapeFiller;
+begin
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPolygon(points,fillcolor);
+  multi.AddPolygon(ComputeWidePolyline(points,w),c);
+  if LinearAntialiasing then
+    multi.Draw(self,dmLinearBlend)
+  else
+    multi.Draw(self,dmDrawWithTransparency);
+  multi.Free;
 end;
 …
   c: TBGRAPixel; w: single);
 begin
    BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[plCycle],nil,JoinMiterLimit);
+  BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[plCycle],nil,JoinMiterLimit);
 end;
 …
 begin
   BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[plCycle],texture,JoinMiterLimit);
+end;
+procedure TBGRADefaultBitmap.DrawPolygonAntialias(
+  const points: array of TPointF; c: TBGRAPixel; w: single;
+  fillcolor: TBGRAPixel);
+var multi: TBGRAMultishapeFiller;
+begin
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPolygon(points,fillcolor);
+  multi.AddPolygon(ComputeWidePolygon(points,w),c);
+  if LinearAntialiasing then
+    multi.Draw(self,dmLinearBlend)
+  else
+    multi.Draw(self,dmDrawWithTransparency);
+  multi.Free;
 end;
 …
   DrawPolyLineAntialias(points, BGRA(0,0,0,alpha),w);
   FEraseMode := False;
+end;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; c: TBGRAPixel);
+var tempCanvas: TBGRACanvas2D;
+begin
+  tempCanvas:= TBGRACanvas2D.Create(self);
+  tempCanvas.fillStyle(c);
+  tempCanvas.path(APath);
+  tempCanvas.fill;
+  tempCanvas.Free;
+end;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; texture: IBGRAScanner);
+var tempCanvas: TBGRACanvas2D;
+begin
+  tempCanvas:= TBGRACanvas2D.Create(self);
+  tempCanvas.fillStyle(texture);
+  tempCanvas.path(APath);
+  tempCanvas.fill;
+  tempCanvas.Free;
 end;
 …
 end;
+procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  ACleanBorders: TRect);
+var
+  persp: TBGRAPerspectiveScannerTransform;
+  clean: TBGRAExtendedBorderScanner;
+begin
+  clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
+  persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
+  FillPoly([pt1,pt2,pt3,pt4],persp,dmDrawWithTransparency);
+  persp.Free;
+  clean.Free;
+end;
 procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
   pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
 …
   FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
   persp.Free;
+end;
+procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  ACleanBorders: TRect);
+var
+  persp: TBGRAPerspectiveScannerTransform;
+  clean: TBGRAExtendedBorderScanner;
+begin
+  clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
+  persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
+  FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
+  persp.Free;
+  clean.Free;
 end;
 …
 procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel);
 begin
   BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode, FillMode = fmWinding);
+  BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode, FillMode = fmWinding, LinearAntialiasing);
 end;
 …
   texture: IBGRAScanner);
 begin
   BGRAPolygon.FillPolyAntialiasWithTexture(self, points, texture, FillMode = fmWinding);
+  BGRAPolygon.FillPolyAntialiasWithTexture(self, points, texture, FillMode = fmWinding, LinearAntialiasing);
 end;
 …
 end;
+procedure TBGRADefaultBitmap.FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel;
+  drawmode: TDrawMode);
+begin
+  BGRAPolygon.FillShapeAliased(self, shape, c, FEraseMode, nil, FillMode = fmWinding, drawmode);
+end;
+procedure TBGRADefaultBitmap.FillShape(shape: TBGRACustomFillInfo;
+  texture: IBGRAScanner; drawmode: TDrawMode);
+begin
+  BGRAPolygon.FillShapeAliased(self, shape, BGRAPixelTransparent, false, texture, FillMode = fmWinding, drawmode);
+end;
+procedure TBGRADefaultBitmap.FillShapeAntialias(shape: TBGRACustomFillInfo;
+  c: TBGRAPixel);
+begin
+  BGRAPolygon.FillShapeAntialias(self, shape, c, FEraseMode, nil, FillMode = fmWinding, LinearAntialiasing);
+end;
+procedure TBGRADefaultBitmap.FillShapeAntialias(shape: TBGRACustomFillInfo;
+  texture: IBGRAScanner);
+begin
+  BGRAPolygon.FillShapeAntialiasWithTexture(self, shape, texture, FillMode = fmWinding, LinearAntialiasing);
+end;
+procedure TBGRADefaultBitmap.EraseShape(shape: TBGRACustomFillInfo; alpha: byte);
+begin
+  BGRAPolygon.FillShapeAliased(self, shape, BGRA(0, 0, 0, alpha), True, nil, FillMode = fmWinding, dmDrawWithTransparency);
+end;
+procedure TBGRADefaultBitmap.EraseShapeAntialias(shape: TBGRACustomFillInfo;
+  alpha: byte);
+begin
+  FEraseMode := True;
+  FillShapeAntialias(shape, BGRA(0, 0, 0, alpha));
+  FEraseMode := False;
+end;
 procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
   c: TBGRAPixel; w: single);
 …
   if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
     BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode)
+    BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode, LinearAntialiasing)
   else
     DrawPolygonAntialias(ComputeEllipseContour(x,y,rx,ry),c,w);
 …
   if IsClearPenStyle(FCustomPenStyle) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
     BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture)
+    BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture, LinearAntialiasing)
   else
     DrawPolygonAntialias(ComputeEllipseContour(x,y,rx,ry),texture,w);
 …
 procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
 begin
   BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode);
+  BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode, LinearAntialiasing);
 end;
 …
   texture: IBGRAScanner);
 begin
   BGRAPolygon.FillEllipseAntialiasWithTexture(self, x, y, rx, ry, texture);
+  BGRAPolygon.FillEllipseAntialiasWithTexture(self, x, y, rx, ry, texture, LinearAntialiasing);
 end;
 …
   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)
+    BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing)
   else
     DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w);
 …
   if IsClearPenStyle(FCustomPenStyle) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
     BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture)
+    BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing)
   else
     DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w);
 …
   end else
   begin
     if (mode <> dmSet) and (c.alpha = 0) then exit;
+    if (mode <> dmSet) and (mode <> dmXor) and (c.alpha = 0) then exit;
     p := Scanline[y] + x;
 …
         end;
       dmXor:
+        if DWord(c) = 0 then exit
+        else
         for yb := y2 - y downto 0 do
         begin
 …
   c: TBGRAPixel; options: TRoundRectangleOptions);
 begin
   BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False);
+  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False, LinearAntialiasing);
 end;
 …
   ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions);
 begin
   BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture);
+  BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture, LinearAntialiasing);
 end;
 …
   ry: single; alpha: byte; options: TRoundRectangleOptions);
 begin
   BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True);
+  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True, LinearAntialiasing);
 end;
 procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer;
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel);
+begin
+  BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,FillColor);
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency);
+begin
+  BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,FillColor,nil,ADrawMode);
+end;
+procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX,
+  DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode);
+begin
+  BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,BGRAPixelTransparent,nil,ADrawMode,true);
 end;
 {------------------------- Text functions ---------------------------------------}
+procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; 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: single; 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: single; s: string;
+procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
+  sUTF8: string; c: TBGRAPixel; align: TAlignment);
+begin
+  FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align);
+end;
+procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
+  sUTF8: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align);
+end;
+procedure TBGRADefaultBitmap.TextOut(x, y: single; sUTF8: 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: single; s: string;
+  FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),texture,align);
+end;
+procedure TBGRADefaultBitmap.TextOut(x, y: single; sUTF8: string;
   c: TBGRAPixel; align: TAlignment);
 begin
+  UpdateFont;
+  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);
+  FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align);
 end;
 procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer;
+  s: string; style: TTextStyle; c: TBGRAPixel);
+begin
+  UpdateFont;
+  BGRAText.BGRATextRect(self,FFont,FontQuality,ARect,x,y,s,style,c,nil);
+end;
+procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; s: string;
+  sUTF8: string; style: TTextStyle; c: TBGRAPixel);
+begin
+  FontRenderer.TextRect(self,ARect,x,y,sUTF8,style,c);
+end;
+procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; sUTF8: 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;
+begin
+  UpdateFont;
+  result := BGRAText.BGRATextSize(FFont,FontQuality,s,FontAntialiasingLevel);
+  if (result.cy >= 24) and FontAntialias then
+    result := BGRAText.BGRATextSize(FFont,FontQuality,s,4);
+  FontRenderer.TextRect(self,ARect,x,y,sUTF8,style,texture);
+end;
+{ Returns the total size of the string provided using the current font.
+  Orientation is not taken into account, so that the width is along the text.  }
+function TBGRADefaultBitmap.TextSize(sUTF8: string): TSize;
+begin
+  result := FontRenderer.TextSize(sUTF8);
 end;
 …
   w: single): ArrayOfTPointF;
 begin
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[],JoinMiterLimit);
+  if Assigned(FArrow) then
+    Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption,JoinMiterLimit)
 end;
 …
 begin
   if not closed then options := [plRoundCapOpen] else options := [];
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,pecRound,pjsRound,FCustomPenStyle,options,JoinMiterLimit);
+  options += GetPolyLineOption;
+  if Assigned(FArrow) then
+    Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,pecRound,pjsRound,FCustomPenStyle,options,JoinMiterLimit,@FArrow.ComputeStartAt,FArrow.StartOffsetX,@FArrow.ComputeEndAt,FArrow.EndOffsetX)
+  else
+    Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,pecRound,pjsRound,FCustomPenStyle,options,JoinMiterLimit);
 end;
 …
   w: single): ArrayOfTPointF;
 begin
   Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[plCycle],JoinMiterLimit);
+  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption+[plCycle],JoinMiterLimit);
 end;
 …
   endRad: single; quality: single): ArrayOfTPointF;
 begin
   result := BGRAPath.ComputeArc65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi),quality);
+  result := BGRAPath.ComputeArcRad(x,y,rx,ry,startRad,endRad,quality);
 end;
 …
 procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
   color: TBGRAPixel);
+  color: TBGRAPixel; ADrawMode: TDrawMode);
 var
   scan: TBGRACustomScanner;
 …
   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);
+  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,ADrawMode);
   scan.Free;
 end;
 procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
   texture: IBGRAScanner);
+  texture: IBGRAScanner; ADrawMode: TDrawMode);
 var
   scan: TBGRACustomScanner;
 …
   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);
+  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,ADrawMode);
   scan.Free;
 end;
 …
 function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel;
 var
   ix, iy: integer;
   iFactX,iFactY: integer;
+  ix, iy: Int32or64;
+  iFactX,iFactY: Int32or64;
 begin
   if FData = nil then
 …
     exit;
   end;
   iFactX := round(x*256);
   iFactY := round(y*256);
   ix := (iFactX shr 8)+ScanOffset.X;
   iy := (iFactY shr 8)+ScanOffset.Y;
   iFactX := iFactX and 255;
   iFactY := iFactY and 255;
+  LoadFromBitmapIfNeeded;
+  ix := round(x*256);
+  iy := round(y*256);
+  iFactX := ix and 255;
+  iFactY := iy and 255;
+  ix := PositiveMod(ix+(ScanOffset.X shl 8), FWidth shl 8) shr 8;
+  iy := PositiveMod(iy+(ScanOffset.Y shl 8), FHeight shl 8) shr 8;
   if (iFactX = 0) and (iFactY = 0) then
   begin
     result := (GetScanlineFast(PositiveMod(iy, FHeight))+PositiveMod(ix, FWidth))^;
+    result := (GetScanlineFast(iy)+ix)^;
     exit;
   end;
   if ScanInterpolationFilter <> rfLinear then
   begin
 …
     iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
   end;
+  result := GetPixelCycleInline(ix,iy, iFactX,iFactY);
+  result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
 end;
 …
 end;
-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;
 …
   sourcewidth := Source.Width;
   if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
+  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
   copycount := maxxb - minxb + 1;
 …
   sourcewidth := Source.Width;
   if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
+  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
   copycount := maxxb - minxb + 1;
 …
   sourcewidth := Source.Width;
   if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
+  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
   copycount := maxxb - minxb + 1;
 …
 end;
-{ 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; ARestoreOffsetAfterRotation: boolean);
-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;
-    if ARestoreOffsetAfterRotation then
-    begin
-      result.x += imageCenterX;
-      result.y += imageCenterY;
-    end;
-  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);
+  Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis.
+  The output bounds correspond to the pixels that will be affected in the destination. }
+procedure TBGRADefaultBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
+  Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; 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
+    SourceBounds: TRect;
+begin
+  if (Source = nil) or (AOpacity = 0) then exit;
+  IntersectRect(AOutputBounds,AOutputBounds,ClipRect);
+  if IsRectEmpty(AOutputBounds) then exit;
   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);
+    SourceBounds := AOutputBounds;
+    OffsetRect(SourceBounds, -round(origin.x),-round(origin.y));
+    IntersectRect(SourceBounds,SourceBounds,rect(0,0,Source.Width,Source.Height));
+    PutImagePart(round(origin.x)+SourceBounds.Left,round(origin.y)+SourceBounds.Top,Source,SourceBounds,AMode,AOpacity);
     exit;
   end;
   { Create affine transformation }
   affine := TBGRAAffineBitmapTransform.Create(Source);
+  affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter);
   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);
+  FillRect(AOutputBounds,affine,AMode);
   affine.Free;
+end;
+procedure TBGRADefaultBitmap.StretchPutImage(ARect: TRect;
+  Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte);
+begin
+  If (Source = nil) or (AOpacity = 0) then exit;
+  if (ARect.Right-ARect.Left = Source.Width) and (ARect.Bottom-ARect.Top = Source.Height) then
+     PutImage(ARect.Left,ARect.Top,Source,mode,AOpacity)
+  else
+     BGRAResample.StretchPutImage(Source, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, mode, AOpacity);
 end;
 …
 end;
+function TBGRADefaultBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint;
+  ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap;
+begin
+  result := BGRAFilters.FilterTwirl(self, ABounds, ACenter, ARadius, ATurn, AExponent);
+end;
 function TBGRADefaultBitmap.FilterCylinder: TBGRACustomBitmap;
 begin
 …
 end;
+function TBGRADefaultBitmap.FilterSharpen: TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterSharpen(self);
+function TBGRADefaultBitmap.FilterSharpen(Amount: single = 1): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterSharpen(self,round(Amount*256));
+end;
+function TBGRADefaultBitmap.FilterSharpen(ABounds: TRect; Amount: single
+  ): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterSharpen(self,ABounds,round(Amount*256));
 end;
 …
 end;
+function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radius: integer;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := BGRAFilters.CreateRadialBlurTask(self, ABounds, radius, blurType);
+  try
+    result := task.Execute;
+  finally
+    task.Free;
+  end;
+end;
 function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
   useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
 …
 end;
+function TBGRADefaultBitmap.FilterBlurMotion(ABounds: TRect; distance: integer;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := BGRAFilters.CreateMotionBlurTask(self,ABounds,distance,angle,oriented);
+  try
+    Result := task.Execute;
+  finally
+    task.Free;
+  end;
+end;
 function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRACustomBitmap):
 TBGRACustomBitmap;
 …
 end;
+function TBGRADefaultBitmap.FilterCustomBlur(ABounds: TRect;
+  mask: TBGRACustomBitmap): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := BGRAFilters.CreateBlurTask(self, ABounds, mask);
+  try
+    result := task.Execute;
+  finally
+    task.Free;
+  end;
+end;
 function TBGRADefaultBitmap.FilterEmboss(angle: single): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterEmboss(self, angle);
+end;
+function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterEmboss(self, angle, ABounds);
 end;
 …
 end;
+function TBGRADefaultBitmap.FilterGrayscale(ABounds: TRect): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterGrayscale(self, ABounds);
+end;
 function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True):
 TBGRACustomBitmap;
 …
 end;
+function TBGRADefaultBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterNormalize(self, ABounds, eachChannel);
+end;
 function TBGRADefaultBitmap.FilterRotate(origin: TPointF;
   angle: single): TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterRotate(self, origin, angle);
+  angle: single; correctBlur: boolean): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur);
 end;
 …
 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
 …
   It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.VerticalFlip;
 var
   yb:     integer;
+procedure TBGRADefaultBitmap.VerticalFlip(ARect: TRect);
+var
+  yb,h2:     integer;
   line:   PBGRAPixel;
   linesize: integer;
+  linesize, delta: integer;
   PStart: PBGRAPixel;
   PEnd:   PBGRAPixel;
 …
     exit;
+  if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
+  if not IntersectRect(ARect, ARect, rect(0,0,Width,Height)) then exit;
   LoadFromBitmapIfNeeded;
   linesize := Width * sizeof(TBGRAPixel);
+  linesize := (ARect.Right-ARect.Left) * sizeof(TBGRAPixel);
   line     := nil;
   getmem(line, linesize);
+  PStart := Data;
+  PEnd   := Data + (Height - 1) * Width;
+  for yb := 0 to (Height div 2) - 1 do
+  PStart := GetScanlineFast(ARect.Top)+ARect.Left;
+  PEnd   := GetScanlineFast(ARect.Bottom-1)+ARect.Left;
+  h2 := (ARect.Bottom-ARect.Top) div 2;
+  if LineOrder = riloTopToBottom then delta := +Width else delta := -Width;
+  for yb := h2-1 downto 0 do
   begin
     move(PStart^, line^, linesize);
     move(PEnd^, PStart^, linesize);
     move(line^, PEnd^, linesize);
     Inc(PStart, Width);
     Dec(PEnd, Width);
+    Inc(PStart, delta);
+    Dec(PEnd, delta);
   end;
   freemem(line);
 …
   It is an involution, i.e it does nothing when applied twice}
 procedure TBGRADefaultBitmap.HorizontalFlip;
 var
   yb, xb: integer;
+procedure TBGRADefaultBitmap.HorizontalFlip(ARect: TRect);
+var
+  yb, xb, w: integer;
   PStart: PBGRAPixel;
   PEnd:   PBGRAPixel;
 …
     exit;
+  if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
+  if not IntersectRect(ARect, ARect, rect(0,0,Width,Height)) then exit;
+  w := ARect.Right-ARect.Left;
   LoadFromBitmapIfNeeded;
   for yb := 0 to Height - 1 do
   begin
     PStart := Scanline[yb];
     PEnd   := PStart + Width;
     for xb := 0 to (Width div 2) - 1 do
+  for yb := ARect.Top to ARect.Bottom-1 do
+  begin
+    PStart := GetScanlineFast(yb)+ARect.Left;
+    PEnd   := PStart + w;
+    for xb := 0 to (w div 2) - 1 do
     begin
       Dec(PEnd);
 …
   complentary colors (black becomes white etc.).
   It is an involution, i.e it does nothing when applied twice }
+  It is NOT EXACTLY an involution, when applied twice, some color information is lost }
 procedure TBGRADefaultBitmap.Negative;
 var
 …
 end;
+procedure TBGRADefaultBitmap.NegativeRect(ABounds: TRect);
+var p: PBGRAPixel;
+  xb,yb,xcount: integer;
+begin
+  if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
+  xcount := ABounds.Right-ABounds.Left;
+  for yb := ABounds.Top to ABounds.Bottom-1 do
+  begin
+    p := ScanLine[yb]+ABounds.Left;
+    for xb := xcount-1 downto 0 do
+    begin
+      if p^.alpha <> 0 then
+      begin
+        p^.red   := GammaCompressionTab[not GammaExpansionTab[p^.red]];
+        p^.green := GammaCompressionTab[not GammaExpansionTab[p^.green]];
+        p^.blue  := GammaCompressionTab[not GammaExpansionTab[p^.blue]];
+      end;
+      Inc(p);
+    end;
+  end;
+end;
 { Compute negative without gamma correction.
 …
   end;
   InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.LinearNegativeRect(ABounds: TRect);
+var p: PBGRAPixel;
+  xb,yb,xcount: integer;
+begin
+  if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
+  xcount := ABounds.Right-ABounds.Left;
+  for yb := ABounds.Top to ABounds.Bottom-1 do
+  begin
+    p := ScanLine[yb]+ABounds.Left;
+    for xb := xcount-1 downto 0 do
+    begin
+      if p^.alpha <> 0 then
+      begin
+        p^.red   := not p^.red;
+        p^.green := not p^.green;
+        p^.blue  := not p^.blue;
+      end;
+      Inc(p);
+    end;
+  end;
+end;
+procedure TBGRADefaultBitmap.InplaceGrayscale;
+begin
+  InplaceGrayscale(rect(0,0,Width,Height));
+end;
+procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect);
+var
+  task: TFilterTask;
+begin
+  task := CreateGrayscaleTask(self, ABounds);
+  task.Destination := self;
+  task.Execute;
+  task.Free;
 end;
 …
   See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 }
 procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRACustomBitmap);
+procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint);
 var
   p, pmask: PBGRAPixel;
   yb, xb:   integer;
+begin
+  if (Mask.Width <> Width) or (Mask.Height <> Height) then
+    exit;
+  MaskOffsetX,MaskOffsetY,w: integer;
+  opacity: NativeUint;
+begin
+  if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
+  IntersectRect(ARect, ARect, rect(0,0,Width,Height));
+  MaskOffsetX := AMaskRectTopLeft.x - ARect.Left;
+  MaskOffsetY := AMaskRectTopLeft.y - ARect.Top;
+  OffsetRect(ARect, MaskOffsetX, MaskOffsetY);
+  IntersectRect(ARect, ARect, rect(0,0,mask.Width,mask.Height));
+  OffsetRect(ARect, -MaskOffsetX, -MaskOffsetY);
   LoadFromBitmapIfNeeded;
+  for yb := 0 to Height - 1 do
+  begin
+    p     := Scanline[yb];
+    pmask := Mask.Scanline[yb];
+    for xb := Width - 1 downto 0 do
+    begin
+      p^.alpha := ApplyOpacity(p^.alpha, pmask^.red);
+  w := ARect.Right-ARect.Left-1;
+  for yb := ARect.Top to ARect.Bottom - 1 do
+  begin
+    p     := Scanline[yb]+ARect.Left;
+    pmask := Mask.Scanline[yb+MaskOffsetY]+ARect.Left+MaskOffsetX;
+    for xb := w downto 0 do
+    begin
+      opacity := ApplyOpacity(p^.alpha, pmask^.red);
+      if opacity = 0 then p^ := BGRAPixelTransparent
+      else p^.alpha := opacity;
       Inc(p);
       Inc(pmask);
 …
 end;
+procedure TBGRADefaultBitmap.DrawCheckers(ARect: TRect; AColorEven,
+  AColorOdd: TBGRAPixel);
+const tx = 8; ty = 8; //must be a power of 2
+      xMask = tx*2-1;
+var xcount,patY,w,n,patY1,patY2m1,patX,patX1: NativeInt;
+    pdest: PBGRAPixel;
+    delta: PtrInt;
+    actualRect: TRect;
+begin
+  actualRect := ARect;
+  IntersectRect(actualRect, ARect, self.ClipRect);
+  w := actualRect.Right-actualRect.Left;
+  if (w <= 0) or (actualRect.Bottom <= actualRect.Top) then exit;
+  delta := self.Width;
+  if self.LineOrder = riloBottomToTop then delta := -delta;
+  delta := (delta-w)*SizeOf(TBGRAPixel);
+  pdest := self.ScanLine[actualRect.Top]+actualRect.left;
+  patY1 := actualRect.Top - ARect.Top;
+  patY2m1 := actualRect.Bottom - ARect.Top-1;
+  patX1 := (actualRect.Left - ARect.Left) and xMask;
+  for patY := patY1 to patY2m1 do
+  begin
+    xcount := w;
+    if patY and ty = 0 then
+       patX := patX1
+    else
+       patX := (patX1+tx) and xMask;
+    while xcount > 0 do
+    begin
+      if patX and tx = 0 then
+      begin
+        n := 8-patX;
+        if n > xcount then n := xcount;
+        FillDWord(pdest^,n,DWord(AColorEven));
+        dec(xcount,n);
+        inc(pdest,n);
+        patX := tx;
+      end else
+      begin
+        n := 16-patX;
+        if n > xcount then n := xcount;
+        FillDWord(pdest^,n,DWord(AColorOdd));
+        dec(xcount,n);
+        inc(pdest,n);
+        patX := 0;
+      end;
+    end;
+    inc(pbyte(pdest),delta);
+  end;
+  self.InvalidateBitmap;
+end;
 { Get bounds of non zero values of specified channel }
 function TBGRADefaultBitmap.GetImageBounds(Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect;
+begin
+  result := GetImageBounds([Channel], ANothingValue);
+end;
+function TBGRADefaultBitmap.GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect;
 var
   minx, miny, maxx, maxy: integer;
   xb, yb: integer;
   p:      pbyte;
   offset: integer;
+  xb, xb2, yb: integer;
+  p:      PDWord;
+  colorMask, colorZeros: DWord;
 begin
   maxx := -1;
 …
   minx := self.Width;
   miny := self.Height;
+  case Channel of
+    cBlue: offset  := 0;
+    cGreen: offset := 1;
+    cRed: offset   := 2;
+    else
+      offset := 3;
+  end;
+  colorMask := 0;
+  colorZeros := 0;
+  if cBlue in Channels then
+  begin
+    colorMask := colorMask or $ff;
+    colorZeros:= colorZeros or ANothingValue;
+  end;
+  if cGreen in Channels then
+  begin
+    colorMask := colorMask or $ff00;
+    colorZeros:= colorZeros or (ANothingValue shl 8);
+  end;
+  if cRed in Channels then
+  begin
+    colorMask := colorMask or $ff0000;
+    colorZeros:= colorZeros or (ANothingValue shl 16);
+  end;
+  if cAlpha in Channels then
+  begin
+    colorMask := colorMask or $ff000000;
+    colorZeros:= colorZeros or (ANothingValue shl 24);
+  end;
+  colorMask := NtoLE(colorMask);
+  colorZeros := NtoLE(colorZeros);
   for yb := 0 to self.Height - 1 do
   begin
     p := PByte(self.ScanLine[yb]) + offset;
+    p := PDWord(self.ScanLine[yb]);
     for xb := 0 to self.Width - 1 do
     begin
       if p^ <> ANothingValue then
+      if (p^ and colorMask) <> colorZeros then
       begin
         if xb < minx then
 …
         if yb > maxy then
           maxy := yb;
+        inc(p, self.width-1-xb);
+        for xb2 := self.Width-1 downto xb+1 do
+        begin
+          if (p^ and colorMask) <> colorZeros then
+          begin
+            if xb2 > maxx then
+              maxx := xb2;
+            break;
+          end;
+          dec(p);
+        end;
+        break;
       end;
       Inc(p, sizeof(TBGRAPixel));
+      Inc(p);
     end;
   end;
 …
     Result.bottom := maxy + 1;
   end;
-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;

GraphicTest/Packages/bgrabitmap/bgradnetdeserial.pas

-              r452
+              r472
     procedure LoadFromStream(Stream: TStream);
     procedure LoadFromFile(filename: string);
+    procedure LoadFromFileUTF8(filenameUTF8: string);
     function ToString: string; override;
     constructor Create;
 …
 implementation
+uses lazutf8classes;
 const
 …
 begin
   stream := TFileStream.Create(filename, fmOpenRead);
+  try
+    LoadFromStream(stream);
+  finally
+    stream.Free;
+  end;
+end;
+procedure TDotNetDeserialization.LoadFromFileUTF8(filenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead);
   try
     LoadFromStream(stream);

GraphicTest/Packages/bgrabitmap/bgrafillinfo.pas

-              r452
+              r472
 type
-  { TIntersectionInfo }
-  TIntersectionInfo = class
-    interX: single;
-    winding: integer;
-    numSegment: integer;
-    procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer);
-  end;
-  ArrayOfTIntersectionInfo = array of TIntersectionInfo;
   { TFillShapeInfo }
   TFillShapeInfo = class
+  TFillShapeInfo = class(TBGRACustomFillInfo)
     protected
       //compute intersections. the array must be big enough
 …
     public
       //returns true if the same segment number can be curved
       function SegmentsCurved: boolean; virtual;
+      function SegmentsCurved: boolean; override;
       //returns integer bounds
       function GetBounds: TRect; virtual;
+      function GetBounds: TRect; override;
       //compute min-max to be drawn on destination bitmap according to cliprect. Returns false if
       //there is nothing to draw
       function ComputeMinMax(out minx,miny,maxx,maxy: integer; bmpDest: TBGRACustomBitmap): boolean;
+      function ComputeMinMax(out minx,miny,maxx,maxy: integer; bmpDest: TBGRACustomBitmap): boolean; override;
       //check if the point is inside the filling zone
       function IsPointInside(x,y: single; windingMode: boolean): boolean;
+      function IsPointInside(x,y: single; windingMode: boolean): boolean; override;
       //create an array that will contain computed intersections.
       //you may augment, in this case, use CreateIntersectionInfo for new items
       function CreateIntersectionArray: ArrayOfTIntersectionInfo;
       function CreateIntersectionInfo: TIntersectionInfo; virtual; //creates a single info
       procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo);
+      function CreateIntersectionArray: ArrayOfTIntersectionInfo; override;
+      function CreateIntersectionInfo: TIntersectionInfo; override; //creates a single info
+      procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); override;
       //fill a previously created array of intersections with actual intersections at the current y coordinate.
       //nbInter gets the number of computed intersections
       procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean);
+      procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); override;
   end;
 …
   end;
   { TFillPolyInfo }
   TFillPolyInfo = class(TFillShapeInfo)
+  { TCustomFillPolyInfo }
+  TCustomFillPolyInfo = class(TFillShapeInfo)
   private
     function GetNbPoints: integer;
 …
     FEmptyPt:     array of boolean;
     FNext, FPrev: array of integer;
+    function NbMaxIntersection: integer; override;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer; {%H-}dy: single; {%H-}AData: pointer); virtual;
+  public
+    constructor Create(const points: array of TPointF);
+    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; virtual;
+    procedure FreeSegmentData(data: pointer); virtual;
+    function GetBounds: TRect; override;
+    property NbPoints: integer read GetNbPoints;
+  end;
+  { TFillPolyInfo }
+  TFillPolyInfo = class(TCustomFillPolyInfo)
+  protected
     FSlices:   array of TPolySlice;
     FCurSlice: integer;
+    FMaxIntersection: integer;
     function NbMaxIntersection: integer; override;
     procedure ComputeIntersection(cury: single;
 …
     constructor Create(const points: array of TPointF);
     destructor Destroy; override;
+    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; virtual;
+    procedure FreeSegmentData(data: pointer); virtual;
+    function GetBounds: TRect; override;
+    property NbPoints: integer read GetNbPoints;
+  end;
+  POnePassRecord = ^TOnePassRecord;
+  TOnePassRecord = record
+                id: integer;
+                data: pointer;
+                slope: single;
+                winding: integer;
+                includeStartingPoint: boolean;
+                originalY1: single;
+                x1,y1,y2: single;
+                next: POnePassRecord;
+                nextWaiting: POnePassRecord;
+                nextDrawing: POnePassRecord;
+            end;
+  { TOnePassFillPolyInfo }
+  TOnePassFillPolyInfo = class(TCustomFillPolyInfo)
+  private
+    procedure InsertionSortByY;
+    function PartitionByY(left, right: integer): integer;
+    procedure QuickSortByY(left, right: integer);
+    procedure SortByY;
+  protected
+    FOnePass: array of TOnePassRecord;
+    FSortedByY: array of POnePassRecord;
+    FFirstWaiting, FFirstDrawing: POnePassRecord;
+    FShouldInitializeDrawing: boolean;
+    procedure ComputeIntersection(cury: single;
+      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
+  public
+    constructor Create(const points: array of TPointF);
+    function CreateIntersectionArray: ArrayOfTIntersectionInfo; override;
+    destructor Destroy; override;
+  end;
+  { TSimpleFillPolyInfo }
+  TSimpleFillPolyInfo = class(TCustomFillPolyInfo)
+  protected
+    FSimple: array of record
+                  winding: integer;
+                  includeStartingPoint: boolean;
+                  data: pointer;
+    end;
+    procedure ComputeIntersection(cury: single; var inter: ArrayOfTIntersectionInfo;
+      var nbInter: integer); override;
+  public
+    constructor Create(const points: array of TPointF);
+    destructor Destroy; override;
   end;
 procedure AddDensity(dest: PDensity; start,count: integer; value : word); inline;
 function DivByAntialiasPrecision(value: cardinal): cardinal; inline;
 function DivByAntialiasPrecision256(value: cardinal): cardinal; inline;
 function DivByAntialiasPrecision65536(value: cardinal): cardinal; inline;
+function DivByAntialiasPrecision(value: UInt32or64): UInt32or64; inline;
+function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64; inline;
+function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64; inline;
 procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer);
 …
 function IsPointInPolygon(const points: ArrayOfTPointF; point: TPointF
   ; windingMode: boolean): boolean;
 var info: TFillShapeInfo;
 begin
   info := TFillPolyInfo.Create(points);
+var info: TBGRACustomFillInfo;
+begin
+  info := TSimpleFillPolyInfo.Create(points);
   result := info.IsPointInside(point.x+0.5,point.y+0.5,windingMode);
   info.free;
 …
 function IsPointInEllipse(x, y, rx, ry: single; point: TPointF): boolean;
 var info: TFillShapeInfo;
+var info: TBGRACustomFillInfo;
 begin
   info := TFillEllipseInfo.Create(x,y,rx,ry);
 …
 function IsPointInRoundRectangle(x1, y1, x2, y2, rx, ry: single; point: TPointF
   ): boolean;
 var info: TFillShapeInfo;
+var info: TBGRACustomFillInfo;
 begin
   info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,[]);
 …
 end;
 function DivByAntialiasPrecision(value: cardinal): cardinal;
+function DivByAntialiasPrecision(value: UInt32or64): UInt32or64;
 begin             //
   result := value shr AntialiasPrecisionShift;// div AntialiasPrecision;
 end;
 function DivByAntialiasPrecision256(value: cardinal): cardinal;
+function DivByAntialiasPrecision256(value: UInt32or64): UInt32or64;
 begin             //
   result := value shr (AntialiasPrecisionShift+8);// div (256*AntialiasPrecision);
 end;
 function DivByAntialiasPrecision65536(value: cardinal): cardinal;
+function DivByAntialiasPrecision65536(value: UInt32or64): UInt32or64;
 begin             //
   result := value shr (AntialiasPrecisionShift+16);//div (65536*AntialiasPrecision);
-end;
-{ TIntersectionInfo }
-procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding, ANumSegment: integer);
-begin
-  interX := AInterX;
-  winding := AWinding;
-  numSegment := ANumSegment;
 end;
 …
 end;
+{ TFillPolyInfo }
+constructor TFillPolyInfo.Create(const points: array of TPointF);
+function AddSeg(numSlice: integer): integer;
+begin
+  result := FSlices[numSlice].nbSegments;
+  if length(FSlices[numSlice].segments)=FSlices[numSlice].nbSegments then
+    setlength(FSlices[numSlice].segments,FSlices[numSlice].nbSegments*2+2);
+  inc(FSlices[numSlice].nbSegments);
+end;
+{ TCustomFillPolyInfo }
+constructor TCustomFillPolyInfo.Create(const points: array of TPointF);
 var
   i, j, k: integer;
+  i, j: integer;
   First, cur, nbP: integer;
-  yList: array of single;
-  nbYList: integer;
-  ya,yb,temp: single;
-  sliceStart,sliceEnd,idxSeg: integer;
-  idSeg: integer;
 begin
   setlength(FPoints, length(points));
   nbP := 0;
+  first := -1;
   for i := 0 to high(points) do
+  if (i=0) or (points[i]<>points[i-1]) then
+  begin
+  if isEmptyPointF(points[i]) then
+  begin
+    if first<>-1 then
+    begin
+      if nbP = first+1 then //is there only one point?
+      begin
+        dec(nbP);
+        first := -1; //remove subpolygon
+      end else
+      if (FPoints[nbP-1] = FPoints[first]) then
+        dec(nbP); //remove just last looping point
+    end;
+    if first<>-1 then
+    begin
+      FPoints[nbP] := points[i];
+      inc(nbP);
+      first := -1;
+    end;
+  end else
+  if (first=-1) or (points[i]<>points[i-1]) then
+  begin
+    if first = -1 then first := nbP;
     FPoints[nbP] := points[i];
     inc(nbP);
   end;
-  if (nbP>0) and (FPoints[nbP-1] = FPoints[0]) then dec(NbP);
   setlength(FPoints, nbP);
 …
     else
       FSlopes[i]    := EmptySingle;
+end;
+{$hints off}
+function TCustomFillPolyInfo.CreateSegmentData(numPt,nextPt: integer; x, y: single
+  ): pointer;
+begin
+  result := nil;
+end;
+{$hints on}
+procedure TCustomFillPolyInfo.FreeSegmentData(data: pointer);
+begin
+  freemem(data);
+end;
+function TCustomFillPolyInfo.GetBounds: TRect;
+var
+  minx, miny, maxx, maxy, i: integer;
+begin
+  if length(FPoints) = 0 then
+  begin
+    result := rect(0,0,0,0);
+    exit;
+  end;
+  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;
+  Result := rect(minx, miny, maxx + 1, maxy + 1);
+end;
+function TCustomFillPolyInfo.GetNbPoints: integer;
+begin
+  result := length(FPoints);
+end;
+function TCustomFillPolyInfo.NbMaxIntersection: integer;
+begin
+  Result := length(FPoints);
+end;
+procedure TCustomFillPolyInfo.SetIntersectionValues(AInter: TIntersectionInfo;
+  AInterX: Single; AWinding, ANumSegment: integer; dy: single; AData: pointer);
+begin
+  AInter.SetValues( AInterX, AWinding, ANumSegment );
+end;
+{ TFillPolyInfo }
+function TFillPolyInfo.NbMaxIntersection: integer;
+begin
+  Result:= FMaxIntersection;
+end;
+procedure TFillPolyInfo.ComputeIntersection(cury: single;
+  var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
+var
+  j: integer;
+begin
+  if length(FSlices)=0 then exit;
+  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
+  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
+  with FSlices[FCurSlice] do
+  if (cury >= y1) and (cury <= y2) then
+  begin
+    for j := 0 to nbSegments-1 do
+    begin
+      SetIntersectionValues(inter[nbinter], (cury - segments[j].y1) * segments[j].slope + segments[j].x1,
+                                segments[j].winding, segments[j].id, cury - segments[j].y1, segments[j].data );
+      Inc(nbinter);
+    end;
+  end;
+end;
+constructor TFillPolyInfo.Create(const points: array of TPointF);
+  function AddSeg(numSlice: integer): integer;
+  begin
+    result := FSlices[numSlice].nbSegments;
+    if length(FSlices[numSlice].segments)=FSlices[numSlice].nbSegments then
+      setlength(FSlices[numSlice].segments,FSlices[numSlice].nbSegments*2+2);
+    inc(FSlices[numSlice].nbSegments);
+  end;
+var
+  yList: array of single;
+  nbYList: integer;
+  ya,yb,temp: single;
+  sliceStart,sliceEnd,idxSeg: integer;
+  i,j,k,idSeg: integer;
+begin
+  inherited Create(points);
   //slice
 …
   FCurSlice := 0;
+  FMaxIntersection:= 0;
+  for i := 0 to high(FSlices) do
+    if FSlices[i].nbSegments > FMaxIntersection then
+      FMaxIntersection:= FSlices[i].nbSegments;
 end;
 …
 end;
+{$hints off}
+function TFillPolyInfo.CreateSegmentData(numPt,nextPt: integer; x, y: single
+  ): pointer;
+begin
+  result := nil;
+end;
+{$hints on}
+procedure TFillPolyInfo.FreeSegmentData(data: pointer);
+begin
+  freemem(data);
+end;
+function TFillPolyInfo.GetBounds: TRect;
+{ TOnePassFillPolyInfo }
+function TOnePassFillPolyInfo.PartitionByY(left,right: integer): integer;
+  procedure Swap(idx1,idx2: integer); inline;
+  var temp: POnePassRecord;
+  begin
+    temp := FSortedByY[idx1];
+    FSortedByY[idx1] := FSortedByY[idx2];
+    FSortedByY[idx2] := temp;
+  end;
+var pivotIndex: integer;
+    pivotValue: single;
+    storeIndex: integer;
+    i: integer;
+begin
+  pivotIndex := left + random(right-left+1);
+  pivotValue := FSortedByY[pivotIndex]^.y1;
+  swap(pivotIndex,right);
+  storeIndex := left;
+  for i := left to right-1 do
+    if FSortedByY[i]^.y1 <= pivotValue then
+    begin
+      swap(i,storeIndex);
+      inc(storeIndex);
+    end;
+  swap(storeIndex,right);
+  result := storeIndex;
+end;
+procedure TOnePassFillPolyInfo.QuickSortByY(left,right: integer);
+var pivotNewIndex: integer;
+begin
+  if right > left+9 then
+  begin
+    pivotNewIndex := PartitionByY(left,right);
+    QuickSortByY(left,pivotNewIndex-1);
+    QuickSortByY(pivotNewIndex+1,right);
+  end;
+end;
+procedure TOnePassFillPolyInfo.InsertionSortByY;
+var i,j: integer;
+    tempValue: single;
+    tempPtr: POnePassRecord;
+begin
+  for i := 1 to high(FSortedByY) do
+  begin
+    tempPtr := FSortedByY[i];
+    TempValue := tempPtr^.y1;
+    j := i;
+    while (j>0) and (FSortedByY[j-1]^.y1 > TempValue) do
+    begin
+      FSortedByY[j] := FSortedByY[j-1];
+      dec(j);
+    end;
+    FSortedByY[j] := tempPtr;
+  end;
+end;
+procedure TOnePassFillPolyInfo.SortByY;
+var i,nbSorted: integer;
+begin
+  setlength(FSortedByY, length(FPoints));
+  nbSorted := 0;
+  for i := 0 to high(FSortedByY) do
+    if not FEmptyPt[i] then
+    begin
+      FSortedByY[nbSorted] := @FOnePass[i];
+      inc(nbSorted);
+    end;
+  setlength(FSortedByY,nbSorted);
+  if length(FSortedByY) < 10 then InsertionSortByY else
+  begin
+    QuickSortByY(0,high(FSortedByY));
+    InsertionSortByY;
+  end;
+end;
+procedure TOnePassFillPolyInfo.ComputeIntersection(cury: single;
+  var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
 var
+  minx, miny, maxx, maxy, i: integer;
+begin
+  if length(FPoints) = 0 then
+  begin
+    result := rect(0,0,0,0);
+    exit;
+  end;
+  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)
+  p,pprev,pnext: POnePassRecord;
+begin
+  FShouldInitializeDrawing := true;
+  p := FFirstWaiting;
+  while p <> nil do
+  begin
+    if (cury >= p^.y1) then
+    begin
+      if cury <= p^.y2+1 then
+      begin
+        p^.nextDrawing := FFirstDrawing;
+        FFirstDrawing := p;
+      end;
+    end
+      else break;
+    p := p^.nextWaiting;
+  end;
+  FFirstWaiting:= p;
+  p := FFirstDrawing;
+  pprev := nil;
+  while p <> nil do
+  begin
+    pnext := p^.nextDrawing;
+{    if p^.slope = EmptySingle then
+      raise exception.Create('Unexpected');}
+    if ((cury > p^.y1) and (cury <= p^.y2)) or
+       (p^.includeStartingPoint and (cury = p^.y1)) then
+    begin
+{      if nbinter = length(inter) then
+        raise exception.Create('too much'); }
+      if inter[nbinter] = nil then inter[nbinter] := CreateIntersectionInfo;
+      SetIntersectionValues(inter[nbinter], (cury - p^.y1)*p^.slope + p^.x1, p^.winding, p^.id, cury - p^.originalY1, p^.data);
+      inc(nbinter);
+    end else
+    if (cury > p^.y2+1) then
+    begin
+      if pprev <> nil then
+        pprev^.nextDrawing := pnext
       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;
+  Result := rect(minx, miny, maxx + 1, maxy + 1);
+end;
+function TFillPolyInfo.GetNbPoints: integer;
+begin
+  result := length(FPoints);
+end;
+function TFillPolyInfo.NbMaxIntersection: integer;
+begin
+  Result := length(FPoints);
+end;
+procedure TFillPolyInfo.ComputeIntersection(cury: single;
+      var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
+var
+  j: integer;
+begin
+  if length(FSlices)=0 then exit;
+  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
+  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
+  with FSlices[FCurSlice] do
+  if (cury >= y1) and (cury <= y2) then
+  begin
+    for j := 0 to nbSegments-1 do
+    begin
+      inter[nbinter].SetValues( (cury - segments[j].y1) * segments[j].slope + segments[j].x1,
+                                segments[j].winding, segments[j].id );
+      Inc(nbinter);
+    end;
+  end;
+        FFirstDrawing:= pnext;
+      p := pnext;
+      continue;
+    end;
+    pprev := p;
+    p := pnext;
+  end;
+end;
+constructor TOnePassFillPolyInfo.Create(const points: array of TPointF);
+var i,j: integer;
+  p: POnePassRecord;
+  temp: single;
+begin
+  inherited create(points);
+  FShouldInitializeDrawing := true;
+  setlength(FOnePass, length(FPoints));
+  for i := 0 to high(FPoints) do
+  if not FEmptyPt[i] then
+  begin
+    p := @FOnePass[i];
+    j := FNext[i];
+    p^.next := @FOnePass[FNext[i]];
+    p^.id := i;
+    p^.slope := FSlopes[i];
+    if p^.slope <> EmptySingle then
+      p^.data := CreateSegmentData(i, j, FPoints[i].x, FPoints[i].y);
+    p^.y1 := FPoints[i].y;
+    p^.y2 := FPoints[j].y;
+    p^.originalY1 := p^.y1;
+    p^.winding:= ComputeWinding(p^.y1,p^.y2);
+    if p^.y1 < p^.y2 then
+      p^.x1 := FPoints[i].x
+    else
+    if p^.y1 > p^.y2 then
+    begin
+      temp := p^.y1;
+      p^.y1 := p^.y2;
+      p^.y2 := temp;
+      p^.x1 := FPoints[j].x;
+    end;
+  end;
+  SortByY;
+end;
+function TOnePassFillPolyInfo.CreateIntersectionArray: ArrayOfTIntersectionInfo;
+var i: integer;
+  p,pprev: POnePassRecord;
+begin
+  if FShouldInitializeDrawing then
+  begin
+    FShouldInitializeDrawing := false;
+    FFirstWaiting:= nil;
+    pprev := nil;
+    for i := 0 to high(FSortedByY) do
+    begin
+      p := FSortedByY[i];
+      if p^.winding > 0 then
+        p^.includeStartingPoint := p^.next^.winding <= 0
+      else if p^.winding < 0 then
+        p^.includeStartingPoint := p^.next^.winding >= 0;
+      if p^.slope <> EmptySingle then
+      begin
+        if pprev <> nil then
+          pprev^.nextWaiting:= p
+        else
+          FFirstWaiting := p;
+        pprev := p;
+      end;
+    end;
+  end;
+  setlength(result, NbMaxIntersection);
+end;
+destructor TOnePassFillPolyInfo.Destroy;
+var i: integer;
+begin
+  for i := 0 to high(FOnePass) do
+    if FOnePass[i].data<>nil then FreeSegmentData(FOnePass[i].data);
+  FOnePass := nil;
+  inherited Destroy;
+end;
+{ TSimpleFillPolyInfo }
+procedure TSimpleFillPolyInfo.ComputeIntersection(cury: single;
+  var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
+var i,j: integer;
+begin
+  for i := 0 to high(FPoints) do
+    if FSlopes[i] <> EmptySingle then
+    begin
+      j := FNext[i];
+      if ((cury > FPoints[i].y) and (cury <= FPoints[j].y)) or
+        ((cury < FPoints[i].y) and (cury >= FPoints[j].y)) or
+       (FSimple[i].includeStartingPoint and (cury = FPoints[i].y)) then
+     begin
+       SetIntersectionValues(inter[nbinter], (cury - FPoints[i].y)*FSlopes[i] + FPoints[i].x, FSimple[i].winding, i, cury - FPoints[i].y, FSimple[i].data);
+       inc(nbinter);
+     end;
+    end;
+end;
+constructor TSimpleFillPolyInfo.Create(const points: array of TPointF);
+var i,j: integer;
+begin
+  inherited Create(points);
+  setlength(FSimple, length(FPoints));
+  for i := 0 to high(FPoints) do
+  begin
+    j := FNext[i];
+    if j <> -1 then
+      FSimple[i].winding:= ComputeWinding(FPoints[i].y,FPoints[j].y)
+    else
+      FSimple[i].winding:= 0;
+    if FSlopes[i] <> EmptySingle then
+      FSimple[i].data := CreateSegmentData(i, j, FPoints[i].x, FPoints[i].y);
+  end;
+end;
+destructor TSimpleFillPolyInfo.Destroy;
+var i: integer;
+begin
+  for i := 0 to high(FSimple) do
+    if FSimple[i].data <> nil then
+      FreeSegmentData(FSimple[i].data);
+  FSimple := nil;
+  inherited Destroy;
 end;
 …
 end;
+initialization
+  Randomize;
 end.

GraphicTest/Packages/bgrabitmap/bgrafilters.pas

-              r452
+              r472
 uses
   Classes, BGRABitmapTypes;
+type
+  TCheckShouldStopFunc = function(ACurrentY: integer) : boolean of object;
+  { TFilterTask }
+  TFilterTask = class
+  private
+    FCheckShouldStop: TCheckShouldStopFunc;
+    procedure SetDestination(AValue: TBGRACustomBitmap);
+  protected
+    FDestination: TBGRACustomBitmap;
+    FSource: TBGRACustomBitmap;
+    FCurrentY: integer;
+    function GetShouldStop(ACurrentY: integer): boolean;
+    procedure DoExecute; virtual; abstract;
+  public
+    function Execute: TBGRACustomBitmap;
+    property Destination: TBGRACustomBitmap read FDestination write SetDestination;
+    property CheckShouldStop: TCheckShouldStopFunc read FCheckShouldStop write FCheckShouldStop;
+    property CurrentY: integer read FCurrentY;
+  end;
 { The median filter consist in calculating the median value of pixels. Here
 …
 { Sharpen filter add more contrast between pixels }
+function FilterSharpen(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap;
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
 { A radial blur applies a blur with a circular influence, i.e, each pixel
 …
 function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer;
   blurType: TRadialBlurType): TBGRACustomBitmap;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: integer;
+  ABlurType: TRadialBlurType): TFilterTask;
 { The precise blur allow to specify the blur radius with subpixel accuracy }
 function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
   radius: single): TBGRACustomBitmap;
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap;
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TFilterTask;
 { Motion blur merge pixels in a direction. The oriented parameter specifies
 …
 function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
   angle: single; oriented: boolean): TBGRACustomBitmap;
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TFilterTask;
 { General purpose blur filter, with a blur mask as parameter to describe
   how pixels influence each other }
+function FilterBlur(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+function FilterBlur(bmp: TBGRACustomBitmap; blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
 { Emboss filter compute a color difference in the angle direction }
 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap;
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect): TBGRACustomBitmap;
 { Emboss highlight computes a sort of emboss with 45 degrees angle and
 …
 function FilterNormalize(bmp: TBGRACustomBitmap;
   eachChannel: boolean = True): TBGRACustomBitmap;
+function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
+  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;
+  angle: single; correctBlur: boolean = false): TBGRACustomBitmap;
 { Grayscale converts colored pixel into grayscale with same luminosity }
 function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
+function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
 { Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil }
 …
 { Twirl distortion, i.e. a progressive rotation }
 function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
 { Distort the image as if it were on a vertical cylinder }
 …
 implementation
+uses Math, GraphType, Dialogs, BGRATransform;
+uses Math, GraphType, Dialogs, BGRATransform, Types, SysUtils;
+type
+  { TGrayscaleTask }
+  TGrayscaleTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect);
+  protected
+    procedure DoExecute; override;
+  end;
+  { TBoxBlurTask }
+  TBoxBlurTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+    FRadius: integer;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer);
+  protected
+    procedure DoExecute; override;
+  end;
+  { TRadialBlurTask }
+  TRadialBlurTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+    FRadius: integer;
+    FBlurType: TRadialBlurType;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer;
+                       blurType: TRadialBlurType);
+  protected
+    procedure DoExecute; override;
+  end;
+  { TCustomBlurTask }
+  TCustomBlurTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+    FMask: TBGRACustomBitmap;
+    FMaskOwned: boolean;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false);
+    destructor Destroy; override;
+  protected
+    procedure DoExecute; override;
+  end;
+  { TRadialPreciseBlurTask }
+  TRadialPreciseBlurTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+    FRadius: Single;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single);
+  protected
+    procedure DoExecute; override;
+  end;
+  { TMotionBlurTask }
+  TMotionBlurTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+    FDistance,FAngle: single;
+    FOriented: boolean;
+  public
+    constructor Create(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance, AAngle: single; AOriented: boolean);
+  protected
+    procedure DoExecute; override;
+  end;
+procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer;
+  blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; ABounds: TRect;
+  radius: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single;
+  angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlur(bmp: TBGRACustomBitmap; ABounds: TRect;
+   blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
 function FilterSmartZoom3(bmp: TBGRACustomBitmap;
 …
 var
   xb, yb: integer;
+  xb, yb: Int32or64;
   diag1, diag2, h1, h2, v1, v2: TSmartDiff;
   c,c1,c2:      TBGRAPixel;
 …
   function ColorDiff(c1, c2: TBGRAPixel): single;
   var
     max1, max2: integer;
+    max1, max2: Int32or64;
   begin
     if (c1.alpha = 0) and (c2.alpha = 0) then
 …
   end;
   function smartDiff(x1, y1, x2, y2: integer): TSmartDiff;
+  function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff;
   var
     c1, c2, c1m, c2m: TBGRAPixel;
 …
         begin
           c1 := bmp.GetPixel(xb, yb);
           c2 := bmp.GetPixel(integer(xb + 1), integer(yb + 1));
+          c2 := bmp.GetPixel(xb + 1, 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(integer(xb + 1), integer(yb + 1)));
+          Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1));
           if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then
 …
   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;
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
 var
   yb, xb:   integer;
   dx, dy, n, j: integer;
   a_pixels: array[0..nbpix - 1] of TBGRAPixel;
   sumR, sumG, sumB, sumA, RGBdiv, nbA: cardinal;
   tempPixel, refPixel: TBGRAPixel;
   pdest:    PBGRAPixel;
+  yb, xcount: Int32or64;
+  dx, dy: Int32or64;
+  a_pixels: array[-2..1,-2..1] of PBGRAPixel;
+  sumR, sumG, sumB, sumA, {RGBdiv, }nbA: UInt32or64;
+  refPixel: TBGRAPixel;
+  pdest,ptempPixel:    PBGRAPixel;
   bounds:   TRect;
+begin
+  Amount256: boolean;
+  lastXincluded: boolean;
+  alpha,rgbDivShr1: uint32or64;
+begin
+  if IsRectEmpty(ABounds) then exit;
+  Amount256 := AAmount = 256;
   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
+    exit;
+  if not IntersectRect(bounds, bounds,ABounds) then exit;
   bounds.Left   := max(0, bounds.Left - 1);
   bounds.Top    := max(0, bounds.Top - 1);
   bounds.Right  := min(bmp.Width, bounds.Right + 1);
   bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
+  lastXincluded:= bounds.Right < bmp.Width;
   //loop through the destination bitmap
 …
   begin
     pdest := Result.scanline[yb] + bounds.Left;
+    for xb := bounds.Left to bounds.Right - 1 do
+    begin
+    fillchar({%H-}a_pixels,sizeof(a_pixels),0);
+    for dy := -1 to 1 do
+      if (yb+dy >= bounds.Top) and (yb+dy < bounds.Bottom) then
+        a_pixels[dy,1] := bmp.ScanLine[yb+dy]+bounds.Left else
+          a_pixels[dy,1] := nil;
+    xcount := bounds.right-bounds.left;
+    while xcount > 0 do
+    begin
+      dec(xcount);
       //for each pixel, read eight surrounding pixels in the source bitmap
-      n := 0;
       for dy := -1 to 1 do
+        for dx := -1 to 1 do
+          if (dx <> 0) or (dy <> 0) then
+          begin
+            a_pixels[n] := bmp.GetPixel(integer(xb + dx), integer(yb + dy));
+            Inc(n);
+          end;
+        for dx := -1 to 0 do
+          a_pixels[dy,dx] := a_pixels[dy,dx+1];
+      if (xcount > 0) or lastXincluded then
+      begin
+        for dy := -1 to 1 do
+          if a_pixels[dy,0] <> nil then a_pixels[dy,1] := a_pixels[dy,0]+1;
+      end;
       //compute sum
 …
       sumB   := 0;
       sumA   := 0;
       RGBdiv := 0;
+      //RGBdiv := 0;
       nbA    := 0;
        {$hints off}
+      for j := 0 to n - 1 do
+      begin
+        tempPixel := a_pixels[j];
+        sumR      += tempPixel.red * tempPixel.alpha;
+        sumG      += tempPixel.green * tempPixel.alpha;
+        sumB      += tempPixel.blue * tempPixel.alpha;
+        RGBdiv    += tempPixel.alpha;
+        sumA      += tempPixel.alpha;
+        Inc(nbA);
+      end;
+      for dy := -1 to 1 do
+        for dx := -1 to 1 do
+        if (dx<>0) or (dy<>0) then
+        begin
+          ptempPixel := a_pixels[dy,dx];
+          if ptempPixel <> nil then
+          begin
+            alpha := ptempPixel^.alpha;
+            sumR      += ptempPixel^.red * alpha;
+            sumG      += ptempPixel^.green * alpha;
+            sumB      += ptempPixel^.blue * alpha;
+            //RGBdiv    += alpha;
+            sumA      += alpha;
+            Inc(nbA);
+          end;
+        end;
        {$hints on}
       //we finally have an average pixel
       if (RGBdiv = 0) then
+      if ({RGBdiv}sumA = 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;
+        rgbDivShr1:= {RGBDiv}sumA shr 1;
+        refPixel.red   := (sumR + rgbDivShr1) div {RGBdiv}sumA;
+        refPixel.green := (sumG + rgbDivShr1) div {RGBdiv}sumA;
+        refPixel.blue  := (sumB + rgbDivShr1) div {RGBdiv}sumA;
         refPixel.alpha := (sumA + nbA shr 1) div nbA;
       end;
       //read the pixel at the center of the square
       tempPixel := bmp.GetPixel(xb, yb);
+      ptempPixel := a_pixels[0,0];
       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)));
+        tempPixel.green := max(0, min(255, tempPixel.green +
+          integer(tempPixel.green - refPixel.green)));
+        tempPixel.blue  := max(0, min(255, tempPixel.blue +
+          integer(tempPixel.blue - refPixel.blue)));
+        tempPixel.alpha := max(0, min(255, tempPixel.alpha +
+          integer(tempPixel.alpha - refPixel.alpha)));
+      end;
+      pdest^ := tempPixel;
+        if not Amount256 then
+          pdest^ := BGRA( max(0, min($FFFF, Int32or64(ptempPixel^.red shl 8) +
+            AAmount*(ptempPixel^.red - refPixel.red))) shr 8,
+              max(0, min($FFFF, Int32or64(ptempPixel^.green shl 8) +
+            AAmount*(ptempPixel^.green - refPixel.green))) shr 8,
+             max(0, min($FFFF, Int32or64(ptempPixel^.blue shl 8) +
+            AAmount*(ptempPixel^.blue - refPixel.blue))) shr 8,
+             max(0, min($FFFF, Int32or64(ptempPixel^.alpha shl 8) +
+            AAmount*(ptempPixel^.alpha - refPixel.alpha))) shr 8 )
+        else
+          pdest^ := BGRA( max(0, min(255, (ptempPixel^.red shl 1) - refPixel.red)),
+             max(0, min(255, (ptempPixel^.green shl 1) - refPixel.green)),
+             max(0, min(255, (ptempPixel^.blue shl 1) - refPixel.blue)),
+             max(0, min(255, (ptempPixel^.alpha shl 1) - refPixel.alpha)));
+      end else
+        pdest^ := ptempPixel^;
       Inc(pdest);
     end;
   end;
   Result.InvalidateBitmap;
+end;
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer
+  ): TBGRACustomBitmap;
+begin
+  result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount);
 end;
 { Precise blur builds a blur mask with a gradient fill and use
   general purpose blur }
 function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
   radius: single): TBGRACustomBitmap;
+procedure FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
+  ABounds: TRect; radius: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
   blurShape: TBGRACustomBitmap;
 …
   if radius = 0 then
   begin
     result := bmp.Duplicate;
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
     exit;
   end;
 …
     BGRABlack, gtRadial, pointF(intRadius, intRadius), pointF(
     intRadius - radius - 1, intRadius), dmSet);
   Result := FilterBlur(bmp, blurShape);
+  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
   blurShape.Free;
+end;
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single
+  ): TBGRACustomBitmap;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  FilterBlurRadialPrecise(bmp, rect(0,0,bmp.Width,bmp.Height), radius, result, nil);
+end;
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ARadius: single): TFilterTask;
+begin
+  result := TRadialPreciseBlurTask.Create(ABmp,ABounds,ARadius);
 end;
 …
   the vertical sums are kept except for the last column of
   the square }
 function FilterBlurFast(bmp: TBGRACustomBitmap;
   radius: integer): TBGRACustomBitmap;
+procedure FilterBlurFast(bmp: TBGRACustomBitmap; ABounds: TRect;
+  radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
+ {$IFDEF CPU64}{$DEFINE FASTBLUR_DOUBLE}{$ENDIF}
   type
     TRowSum = record
+      sumR,sumG,sumB,rgbDiv,sumA,aDiv: cardinal;
+    end;
+  function ComputeAverage(sum: TRowSum): TBGRAPixel;
+  begin
+      sumR,sumG,sumB,rgbDiv,sumA,aDiv: uint32or64;
+    end;
+    TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF};
+    TExtendedRowSum = record
+      sumR,sumG,sumB,rgbDiv,sumA,aDiv: TExtendedRowValue;
+    end;
+  function ComputeExtendedAverage(sum: TExtendedRowSum): TBGRAPixel;
+  {$IFDEF FASTBLUR_DOUBLE}
+  var v: uint32or64;
+  {$ENDIF}
+  begin
+    {$IFDEF FASTBLUR_DOUBLE}
+    v := round(sum.sumA/sum.aDiv);
+    if v > 255 then result.alpha := 255 else result.alpha := v;
+    v := round(sum.sumR/sum.rgbDiv);
+    if v > 255 then result.red := 255 else result.red := v;
+    v := round(sum.sumG/sum.rgbDiv);
+    if v > 255 then result.green := 255 else result.green := v;
+    v := round(sum.sumB/sum.rgbDiv);
+    if v > 255 then result.blue := 255 else result.blue := v;
+    {$ELSE}
     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;
+    {$ENDIF}
+  end;
+  function ComputeClampedAverage(sum: TRowSum): TBGRAPixel;
+  var v: UInt32or64;
+  begin
+    v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv;
+    if v > 255 then result.alpha := 255 else result.alpha := v;
+    v := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv;
+    if v > 255 then result.red := 255 else result.red := v;
+    v := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv;
+    if v > 255 then result.green := 255 else result.green := v;
+    v := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv;
+    if v > 255 then result.blue := 255 else result.blue := v;
+  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;
 …
 { 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;
+procedure FilterBlurRadialNormal(bmp: TBGRACustomBitmap;
+  ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
   blurShape: TBGRACustomBitmap;
   n: Integer;
+  n: Int32or64;
   p: PBGRAPixel;
 begin
+  if radius = 0 then
+  begin
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
+    exit;
+  end;
   blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite,
 …
     inc(p);
   end;
   Result := FilterBlur(bmp, blurShape);
+  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
   blurShape.Free;
 end;
 { Blur disk creates a disk mask with a FillEllipse }
 function FilterBlurDisk(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;
+procedure FilterBlurDisk(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
   blurShape: TBGRACustomBitmap;
 begin
+  if radius = 0 then
+  begin
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
+    exit;
+  end;
   blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.Fill(BGRABlack);
   blurShape.FillEllipseAntialias(radius, radius, radius + 0.5, radius + 0.5, BGRAWhite);
   Result := FilterBlur(bmp, blurShape);
+  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
   blurShape.Free;
 end;
 { Corona blur use a circle as mask }
 function FilterBlurCorona(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;
+procedure FilterBlurCorona(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
   blurShape: TBGRACustomBitmap;
 begin
+  if radius = 0 then
+  begin
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
+    exit;
+  end;
   blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1);
   blurShape.Fill(BGRABlack);
   blurShape.EllipseAntialias(radius, radius, radius, radius, BGRAWhite, 1);
   Result := FilterBlur(bmp, blurShape);
+  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
   blurShape.Free;
+end;
+function FilterBlurBox(bmp: TBGRACustomBitmap; radius: integer; ADestination: TBGRACustomBitmap): TBGRACustomBitmap;
+var task: TBoxBlurTask;
+begin
+  task := TBoxBlurTask.Create(bmp, rect(0,0,bmp.Width,bmp.Height), radius);
+  task.Destination := ADestination;
+  result := task.Execute;
+  task.Free;
+end;
+procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer;
+  blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
+begin
+  if radius = 0 then
+  begin
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
+    exit;
+  end;
+  case blurType of
+    rbCorona:  FilterBlurCorona(bmp, ABounds, radius, ADestination, ACheckShouldStop);
+    rbDisk:    FilterBlurDisk(bmp, ABounds, radius, ADestination, ACheckShouldStop);
+    rbNormal:  FilterBlurRadialNormal(bmp, ABounds, radius, ADestination, ACheckShouldStop);
+    rbFast:    FilterBlurFast(bmp, ABounds, radius, ADestination, ACheckShouldStop);
+    rbPrecise: FilterBlurRadialPrecise(bmp, ABounds, radius / 10, ADestination, ACheckShouldStop);
+    rbBox:     FilterBlurBox(bmp, radius, ADestination);
+  end;
 end;
 …
   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
+      Result := nil;
+  end;
+  if blurType = rbBox then
+  begin
+    result := FilterBlurBox(bmp,radius,nil);
+  end else
+  begin
+    result := bmp.NewBitmap(bmp.width,bmp.Height);
+    FilterBlurRadial(bmp, rect(0,0,bmp.Width,bmp.height), radius, blurType,result,nil);
+  end;
+end;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: integer;
+  ABlurType: TRadialBlurType): TFilterTask;
+begin
+  if ABlurType = rbBox then
+    result := TBoxBlurTask.Create(ABmp,ABounds,ARadius)
+  else
+    result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType);
 end;
 { 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;
+procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single;
+  angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
   blurShape: TBGRACustomBitmap;
 …
   dx, dy, d: single;
 begin
   if distance = 0 then
   begin
     result := bmp.Duplicate;
+  if distance < 1e-6 then
+  begin
+    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
     exit;
   end;
 …
       pointF(intRadius + dx * (d + 0.5), intRadius + dy * (d + 0.5)),
       dmFastBlend, False);
   Result := FilterBlur(bmp, blurShape);
+  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
   blurShape.Free;
+end;
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  FilterBlurMotion(bmp,rect(0,0,bmp.Width,bmp.Height),distance,angle,oriented,result,nil);
+end;
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ADistance, AAngle: single; AOriented: boolean): TFilterTask;
+begin
+  result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented);
 end;
 { 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;
+procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlurBigMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
+procedure FilterBlurMask64(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
 //make sure value is in the range 0..255
 function clampByte(value: integer): byte; inline;
+function clampByte(value: Int32or64): byte; inline;
 begin
   if value < 0 then result := 0 else
 …
 function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer;
   useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
 var yb,xb, xs,ys, tx,ty: integer;
+var yb,xb, xs,ys, tx,ty: Int32or64;
     psrc,pdest: PBGRAPixel;
     temp,stretched: TBGRACustomBitmap;
 …
       psrc := bmp.scanline[ys]+xs;
       inc(ys,pixelSize);
       for xb := 0 to temp.width-1 do
+      for xb := temp.width-1 downto 0 do
       begin
         pdest^ := psrc^;
 …
 end;
+function FilterBlur(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+function FilterBlur(bmp: TBGRACustomBitmap; blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  FilterBlur(bmp,rect(0,0,bmp.Width,bmp.Height),blurMask,result,nil);
+end;
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean): TFilterTask;
+begin
+  result := TCustomBlurTask.Create(ABmp,ABounds,AMask,AMaskIsThreadSafe);
+end;
+procedure FilterBlur(bmp: TBGRACustomBitmap;
+  ABounds: TRect; blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
+{$IFDEF CPU64}
+begin
+    FilterBlurMask64(bmp,blurMask,ABounds,ADestination,ACheckShouldStop);
+end;
+{$ELSE}
 var
   maskSum: int64;
   i: Integer;
+  i: Int32or64;
   p: PBGRAPixel;
   maskShift: integer;
 …
   //check if sum can be stored in a 32-bit signed integer
   if maskShift = 0 then
+    result := FilterBlurSmallMask(bmp,blurMask) else
+    FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else
+  {$IFDEF CPU32}
   if maskShift < 8 then
+    result := FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift) else
+    result := FilterBlurBigMask(bmp,blurMask);
+end;
+    FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else
+  {$ENDIF}
+    FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop);
+end;
+{$ENDIF}
 //32-bit blur with shift
 function FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
   blurMask: TBGRACustomBitmap; maskShift: integer): TBGRACustomBitmap;
+procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
   var
 …
 //32-bit blur
 function FilterBlurSmallMask(bmp: TBGRACustomBitmap;
   blurMask: TBGRACustomBitmap): TBGRACustomBitmap;
+procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
   var
 …
   {$I blurnormal.inc}
+//64-bit blur
+procedure FilterBlurMask64(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
+  var
+    sumR, sumG, sumB, sumA, Adiv : int64;
+  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;
+procedure FilterBlurBigMask(bmp: TBGRACustomBitmap;
+  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
   var
 …
   {$I blurnormal.inc}
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap;
+begin
+  result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height));
+end;
 { Emboss filter computes the difference between each pixel and the surrounding pixels
   in the specified direction. }
 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap;
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect): TBGRACustomBitmap;
 var
   yb, xb: integer;
+  yb, xb: Int32or64;
   dx, dy: single;
   idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: integer;
+  idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: Int32or64;
   w:      array[1..4] of single;
   iw:     cardinal;
+  iw:     uint32or64;
   c:      array[0..4] of TBGRAPixel;
   i:     integer;
   sumR, sumG, sumB, sumA, RGBdiv, Adiv: cardinal;
+  i:     Int32or64;
+  sumR, sumG, sumB, sumA, RGBdiv, Adiv: UInt32or64;
   tempPixel, refPixel: TBGRAPixel;
   pdest: PBGRAPixel;
   bounds: TRect;
+begin
+  onHorizBorder: boolean;
+  psrc: array[-1..1] of PBGRAPixel;
+begin
+  if IsRectEmpty(ABounds) then exit;
   //compute pixel position and weight
   dx   := cos(angle * Pi / 180);
 …
   bounds := bmp.GetImageBounds;
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    exit;
+  if not IntersectRect(bounds, bounds, ABounds) then exit;
   bounds.Left   := max(0, bounds.Left - 1);
   bounds.Top    := max(0, bounds.Top - 1);
 …
   begin
     pdest := Result.scanline[yb] + bounds.Left;
+    onHorizBorder:= (yb=0) or (yb=bmp.Height-1);
+    psrc[0] := bmp.ScanLine[yb]+bounds.Left;
+    if (yb>0) then psrc[-1] := bmp.ScanLine[yb-1]+bounds.Left else psrc[-1] := nil;
+    if (yb<bmp.Height-1) then psrc[1] := bmp.ScanLine[yb+1]+bounds.Left else psrc[1] := nil;
     for xb := bounds.Left to bounds.Right - 1 do
     begin
+      c[0] := bmp.getPixel(xb, yb);
+      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));
+      c[0] := psrc[0]^;
+      if onHorizBorder or (xb=0) or (xb=bmp.Width-1) then
+      begin
+        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);
+      end else
+      begin
+        c[1] := (psrc[idy1]+idx1)^;
+        c[2] := (psrc[idy2]+idx2)^;
+        c[3] := (psrc[idy3]+idx3)^;
+        c[4] := (psrc[idy4]+idx4)^;
+      end;
       sumR   := 0;
 …
       pdest^ := tempPixel;
       Inc(pdest);
+      inc(psrc[0]);
+      if psrc[-1] <> nil then inc(psrc[-1]);
+      if psrc[1] <> nil then inc(psrc[1]);
     end;
   end;
 …
   FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
 var
   yb, xb: integer;
   c0,c1,c2,c3,c4,c5,c6: integer;
   bmpWidth, bmpHeight: integer;
+  yb, xb: Int32or64;
+  c0,c1,c2,c3,c4,c5,c6: Int32or64;
+  bmpWidth, bmpHeight: Int32or64;
   slope, h: byte;
   sum:      integer;
+  sum:      Int32or64;
   tempPixel, highlight: TBGRAPixel;
   pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
 …
   bounds: TRect;
   borderColorOverride: boolean;
   borderColorLevel: integer;
   currentBorderColor: integer;
+  borderColorLevel: Int32or64;
+  currentBorderColor: Int32or64;
 begin
   borderColorOverride := DefineBorderColor.alpha <> 0;
 …
   FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
 var
   yb, xb: integer;
   c0,c1,c2,c3,c4,c5,c6: integer;
   bmpWidth, bmpHeight: integer;
+  yb, xb: int32or64;
+  c0,c1,c2,c3,c4,c5,c6: int32or64;
+  bmpWidth, bmpHeight: int32or64;
   slope, h: byte;
   sum:      integer;
+  sum:      int32or64;
   tempPixel, highlight: TBGRAPixel;
   pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
 …
   bounds: TRect;
   borderColorOverride: boolean;
   borderColorLevel: integer;
   currentBorderColor: integer;
+  borderColorLevel: int32or64;
+  currentBorderColor: int32or64;
 begin
   borderColorOverride := DefineBorderColor.alpha <> 0;
 …
 end;
+function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean
+  ): TBGRACustomBitmap;
+begin
+  result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel);
+end;
 { 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;
+function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
   eachChannel: boolean = True): TBGRACustomBitmap;
 var
   psrc, pdest: PBGRAPixel;
   c: TExpandedPixel;
   n: integer;
+  xcount,xb,yb: int32or64;
   minValRed, maxValRed, minValGreen, maxValGreen, minValBlue, maxValBlue,
   minAlpha, maxAlpha, addValRed, addValGreen, addValBlue, addAlpha: word;
+  factorValRed, factorValGreen, factorValBlue, factorAlpha: integer;
+begin
+  factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64;
+begin
+  if not IntersectRect(ABounds,ABounds,rect(0,0,bmp.Width,bmp.Height)) then exit;
   Result := bmp.NewBitmap(bmp.Width, bmp.Height);
   bmp.LoadFromBitmapIfNeeded;
-  psrc      := bmp.Data;
   maxValRed := 0;
   minValRed := 65535;
 …
   maxAlpha  := 0;
   minAlpha  := 65535;
+  for n := bmp.Width * bmp.Height - 1 downto 0 do
+  begin
+    c := GammaExpansion(psrc^);
+    Inc(psrc);
+    if c.red > maxValRed then
+      maxValRed := c.red;
+    if c.green > maxValGreen then
+      maxValGreen := c.green;
+    if c.blue > maxValBlue then
+      maxValBlue := c.blue;
+    if c.red < minValRed then
+      minValRed := c.red;
+    if c.green < minValGreen then
+      minValGreen := c.green;
+    if c.blue < minValBlue then
+      minValBlue := c.blue;
+    if c.alpha > maxAlpha then
+      maxAlpha := c.alpha;
+    if c.alpha < minAlpha then
+      minAlpha := c.alpha;
+  xcount := ABounds.Right-ABounds.Left;
+  for yb := ABounds.Top to ABounds.Bottom-1 do
+  begin
+    psrc := bmp.ScanLine[yb]+ABounds.Left;
+    for xb := xcount-1 downto 0 do
+    begin
+      c := GammaExpansion(psrc^);
+      Inc(psrc);
+      if c.red > maxValRed then
+        maxValRed := c.red;
+      if c.green > maxValGreen then
+        maxValGreen := c.green;
+      if c.blue > maxValBlue then
+        maxValBlue := c.blue;
+      if c.red < minValRed then
+        minValRed := c.red;
+      if c.green < minValGreen then
+        minValGreen := c.green;
+      if c.blue < minValBlue then
+        minValBlue := c.blue;
+      if c.alpha > maxAlpha then
+        maxAlpha := c.alpha;
+      if c.alpha < minAlpha then
+        minAlpha := c.alpha;
+    end;
   end;
   if not eachChannel then
 …
   end;
+  psrc  := bmp.Data;
+  pdest := Result.Data;
+  for n := bmp.Width * bmp.Height - 1 downto 0 do
+  begin
+    c := GammaExpansion(psrc^);
+    Inc(psrc);
+    c.red   := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed;
+    c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen;
+    c.blue  := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue;
+    c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha;
+    pdest^  := GammaCompression(c);
+    Inc(pdest);
+  for yb := ABounds.Top to ABounds.Bottom-1 do
+  begin
+    psrc := bmp.ScanLine[yb]+ABounds.Left;
+    pdest := Result.ScanLine[yb]+ABounds.Left;
+    for xb := xcount-1 downto 0 do
+    begin
+      c := GammaExpansion(psrc^);
+      Inc(psrc);
+      c.red   := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed;
+      c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen;
+      c.blue  := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue;
+      c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha;
+      pdest^  := GammaCompression(c);
+      Inc(pdest);
+    end;
   end;
   Result.InvalidateBitmap;
 …
   calculates the position in the source bitmap with an affine transformation }
 function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
   angle: single): TBGRACustomBitmap;
+  angle: single; correctBlur: boolean): TBGRACustomBitmap;
 var
   bounds:     TRect;
 …
   savexysrc, pt: TPointF;
   dx, dy:     single;
   xb, yb:     integer;
+  xb, yb:     int32or64;
   minx, miny, maxx, maxy: single;
+  rf : TResampleFilter;
   function RotatePos(x, y: single): TPointF;
 …
 begin
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
   bounds := bmp.GetImageBounds;
   if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+  begin
+    Result := bmp.NewBitmap(bmp.Width, bmp.Height);
     exit;
+  end;
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if correctBlur then rf := rfHalfCosine else rf := rfLinear;
   //compute new bounding rectangle
 …
     for xb := bounds.left to bounds.right - 1 do
     begin
       pdest^ := bmp.GetPixel(xsrc, ysrc);
+      pdest^ := bmp.GetPixel(xsrc, ysrc, rf);
       Inc(pdest);
       xsrc += dx;
 …
 { Filter grayscale applies BGRAToGrayscale function to all pixels }
 function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+procedure FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
 var
-  bounds:      TRect;
   pdest, psrc: PBGRAPixel;
+  xb, yb:      integer;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  bounds := bmp.GetImageBounds;
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    exit;
+  for yb := bounds.Top to bounds.bottom - 1 do
+  begin
+    pdest := Result.scanline[yb] + bounds.left;
+    psrc  := bmp.scanline[yb] + bounds.left;
+    for xb := bounds.left to bounds.right - 1 do
+  xb, yb:      int32or64;
+begin
+  if IsRectEmpty(ABounds) then exit;
+  for yb := ABounds.Top to ABounds.bottom - 1 do
+  begin
+    if Assigned(ACheckShouldStop) and ACheckShouldStop(yb) then break;
+    pdest := ADestination.scanline[yb] + ABounds.left;
+    psrc  := bmp.scanline[yb] + ABounds.left;
+    for xb := ABounds.left to ABounds.right - 1 do
     begin
       pdest^ := BGRAToGrayscale(psrc^);
 …
     end;
   end;
+  Result.InvalidateBitmap;
+  ADestination.InvalidateBitmap;
+end;
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+begin
+  result := FilterGrayscale(bmp, rect(0,0,bmp.width,bmp.Height));
+end;
+function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  FilterGrayscale(bmp,ABounds,result,nil);
+end;
+function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect
+  ): TFilterTask;
+begin
+  result := TGrayscaleTask.Create(bmp,ABounds);
 end;
 …
 function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
 var
   yb, xb: integer;
+  yb, xb: int32or64;
   c:      array[0..8] of TBGRAPixel;
   i, bmpWidth, bmpHeight: integer;
+  i, bmpWidth, bmpHeight: int32or64;
   slope: byte;
   sum:   integer;
+  sum:   int32or64;
   tempPixel: TBGRAPixel;
   pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
 …
 var
   cx, cy, x, y, len, fact: single;
   xb, yb: integer;
+  xb, yb: int32or64;
   mask:   TBGRACustomBitmap;
 begin
 …
 { Applies twirl scanner. See TBGRATwirlScanner }
 function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; 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);
+  result.FillRect(ABounds, twirl, dmSet);
   twirl.free;
+end;
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint;
+  ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap;
+begin
+  result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent);
 end;
 …
 var
   cx, cy, x, y, len, fact: single;
   xb, yb: integer;
+  xb, yb: int32or64;
 begin
   Result := bmp.NewBitmap(bmp.Width, bmp.Height);
 …
 var
   cy, x1, x2, y1, y2, z1, z2, h: single;
   yb: integer;
+  yb: int32or64;
   resampledBmp: TBGRACustomBitmap;
   resampledBmpWidth: integer;
+  resampledBmpWidth: int32or64;
   resampledFactor,newResampleFactor: single;
   sub,resampledSub: TBGRACustomBitmap;
   partRect: TRect;
   resampleSizeY : integer;
+  resampleSizeY : int32or64;
 begin
   resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch);
 …
   begin
     if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then
       Result := (integer(p1.red) shl 8) + (integer(p1.green) shl 16) +
         integer(p1.blue) < (integer(p2.red) shl 8) + (integer(p2.green) shl 16) +
         integer(p2.blue)
+      Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) +
+        int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) +
+        int32or64(p2.blue)
     else
       Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue);
 …
   nbpix = 9;
 var
   yb, xb:    integer;
   dx, dy, n, i, j, k: integer;
+  yb, xb:    int32or64;
+  dx, dy, n, i, j, k: int32or64;
   a_pixels:  array[0..nbpix - 1] of TBGRAPixel;
   tempPixel, refPixel: TBGRAPixel;
   tempValue: byte;
   sumR, sumG, sumB, sumA, BGRAdiv, nbA: cardinal;
+  sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64;
   tempAlpha: word;
   bounds:    TRect;
 …
         for dx := -1 to 1 do
         begin
           a_pixels[n] := bmp.GetPixel(integer(xb + dx), integer(yb + dy));
+          a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
           if a_pixels[n].alpha = 0 then
             a_pixels[n] := BGRAPixelTransparent;
 …
 end;
+constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
+  radius: integer);
+begin
+  FSource := bmp;
+  FBounds := ABounds;
+  FRadius := radius;
+end;
+procedure TBoxBlurTask.DoExecute;
+type
+  TVertical = record red,green,blue,alpha,count: NativeUint; end;
+  PVertical = ^TVertical;
+var
+  verticals: PVertical;
+  left,right,width,height: NativeInt;
+  delta: PtrInt;
+  procedure PrepareVerticals;
+  var
+    xb,yb: NativeInt;
+    psrc,p: PBGRAPixel;
+    pvert : PVertical;
+  begin
+    fillchar(verticals^, width*sizeof(TVertical), 0);
+    psrc := FSource.ScanLine[FBounds.Top];
+    pvert := verticals;
+    for xb := left to right-1 do
+    begin
+      p := psrc+xb;
+      for yb := 0 to FRadius-1 do
+      begin
+        if yb = height then break;
+        if p^.alpha <> 0 then
+        begin
+          pvert^.red += p^.red * p^.alpha;
+          pvert^.green += p^.green * p^.alpha;
+          pvert^.blue += p^.blue * p^.alpha;
+          pvert^.alpha += p^.alpha;
+        end;
+        inc(pvert^.count);
+        PByte(p) += delta;
+      end;
+      inc(pvert);
+    end;
+  end;
+  procedure NextVerticals(y: integer);
+  var
+    psrc1,psrc2: PBGRAPixel;
+    pvert : PVertical;
+    xb: NativeInt;
+  begin
+    pvert := verticals;
+    if y-FRadius-1 >= 0 then
+      psrc1 := FSource.ScanLine[y-FRadius-1]
+    else
+      psrc1 := nil;
+    if y+FRadius < FSource.Height then
+      psrc2 := FSource.ScanLine[y+FRadius]
+    else
+      psrc2 := nil;
+    for xb := width-1 downto 0 do
+    begin
+      if psrc1 <> nil then
+      begin
+        if psrc1^.alpha <> 0 then
+        begin
+          {$HINTS OFF}
+          pvert^.red -= psrc1^.red * psrc1^.alpha;
+          pvert^.green -= psrc1^.green * psrc1^.alpha;
+          pvert^.blue -= psrc1^.blue * psrc1^.alpha;
+          pvert^.alpha -= psrc1^.alpha;
+          {$HINTS ON}
+        end;
+        dec(pvert^.count);
+        inc(psrc1);
+      end;
+      if psrc2 <> nil then
+      begin
+        if psrc2^.alpha <> 0 then
+        begin
+          pvert^.red += psrc2^.red * psrc2^.alpha;
+          pvert^.green += psrc2^.green * psrc2^.alpha;
+          pvert^.blue += psrc2^.blue * psrc2^.alpha;
+          pvert^.alpha += psrc2^.alpha;
+        end;
+        inc(pvert^.count);
+        inc(psrc2);
+      end;
+      inc(pvert);
+    end;
+  end;
+  procedure MainLoop;
+  var
+    xb,yb,xdest: NativeInt;
+    pdest: PBGRAPixel;
+    pvert : PVertical;
+    sumRed,sumGreen,sumBlue,sumAlpha,sumCount: NativeUInt;
+  begin
+    for yb := FBounds.Top to FBounds.Bottom-1 do
+    begin
+      NextVerticals(yb);
+      if GetShouldStop(yb) then exit;
+      pdest := Destination.ScanLine[yb]+left;
+      sumRed := 0;
+      sumGreen := 0;
+      sumBlue := 0;
+      sumAlpha := 0;
+      sumCount := 0;
+      pvert := verticals;
+      for xb := 0 to FRadius-1 do
+      begin
+        if xb = width then break;
+        sumRed += pvert^.red;
+        sumGreen += pvert^.green;
+        sumBlue += pvert^.blue;
+        sumAlpha += pvert^.alpha;
+        sumCount += pvert^.count;
+        inc(pvert);
+      end;
+      for xdest := 0 to width-1 do
+      begin
+        if xdest-FRadius-1 >= 0 then
+        begin
+          pvert := verticals+(xdest-FRadius-1);
+          sumRed -= pvert^.red;
+          sumGreen -= pvert^.green;
+          sumBlue -= pvert^.blue;
+          sumAlpha -= pvert^.alpha;
+          sumCount -= pvert^.count;
+        end;
+        if xdest+FRadius < width then
+        begin
+          pvert := verticals+(xdest+FRadius);
+          sumRed += pvert^.red;
+          sumGreen += pvert^.green;
+          sumBlue += pvert^.blue;
+          sumAlpha += pvert^.alpha;
+          sumCount += pvert^.count;
+        end;
+        if (sumCount > 0) and (sumAlpha >= (sumCount+1) shr 1) then
+        begin
+          pdest^.red := (sumRed+(sumAlpha shr 1)) div sumAlpha;
+          pdest^.green := (sumGreen+(sumAlpha shr 1)) div sumAlpha;
+          pdest^.blue := (sumBlue+(sumAlpha shr 1)) div sumAlpha;
+          pdest^.alpha := (sumAlpha+(sumCount shr 1)) div sumCount;
+        end else
+          pdest^ := BGRAPixelTransparent;
+        inc(pdest);
+      end;
+    end;
+  end;
+begin
+  if (FBounds.Right <= FBounds.Left) or (FBounds.Bottom <= FBounds.Top) or (FRadius <= 0) then exit;
+  left := FBounds.left;
+  right := FBounds.right;
+  width := right-left;
+  height := FBounds.bottom-FBounds.top;
+  delta := FSource.Width*SizeOf(TBGRAPixel);
+  if FSource.LineOrder = riloBottomToTop then delta := -delta;
+  getmem(verticals, width*sizeof(TVertical));
+  try
+    PrepareVerticals;
+    MainLoop;
+  finally
+    freemem(verticals);
+  end;
+end;
+constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect);
+begin
+  FSource := bmp;
+  FBounds := ABounds;
+end;
+procedure TGrayscaleTask.DoExecute;
+begin
+  FilterGrayscale(FSource,FBounds,Destination,@GetShouldStop);
+end;
+{ TCustomBlurTask }
+constructor TCustomBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
+  AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean);
+begin
+  FSource := bmp;
+  FBounds := ABounds;
+  if AMaskIsThreadSafe then
+  begin
+    FMask := AMask;
+    FMaskOwned := false;
+  end else
+  begin
+    FMask := AMask.Duplicate;
+    FMaskOwned := true;
+  end;
+end;
+destructor TCustomBlurTask.Destroy;
+begin
+  If FMaskOwned then FreeAndNil(FMask);
+  inherited Destroy;
+end;
+procedure TCustomBlurTask.DoExecute;
+begin
+  FilterBlur(FSource,FBounds,FMask,Destination,@GetShouldStop);
+end;
+constructor TMotionBlurTask.Create(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ADistance, AAngle: single; AOriented: boolean);
+begin
+  FSource := ABmp;
+  FBounds := ABounds;
+  FDistance := ADistance;
+  FAngle := AAngle;
+  FOriented:= AOriented;
+end;
+procedure TMotionBlurTask.DoExecute;
+begin
+  FilterBlurMotion(FSource,FBounds,FDistance,FAngle,FOriented,Destination,@GetShouldStop);
+end;
+constructor TRadialPreciseBlurTask.Create(bmp: TBGRACustomBitmap;
+  ABounds: TRect; radius: single);
+begin
+  FSource := bmp;
+  FBounds := ABounds;
+  FRadius := radius;
+end;
+procedure TRadialPreciseBlurTask.DoExecute;
+begin
+  FilterBlurRadialPrecise(FSource,FBounds,FRadius,Destination,@GetShouldStop);
+end;
+{ TRadialBlurTask }
+constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
+  radius: integer; blurType: TRadialBlurType);
+begin
+  FSource := bmp;
+  FBounds := ABounds;
+  FRadius := radius;
+  FBlurType:= blurType;
+end;
+procedure TRadialBlurTask.DoExecute;
+begin
+  FilterBlurRadial(FSource,FBounds,FRadius,FBlurType,Destination,@GetShouldStop);
+end;
+{ TFilterTask }
+function TFilterTask.GetShouldStop(ACurrentY: integer): boolean;
+begin
+  FCurrentY:= ACurrentY;
+  if Assigned(FCheckShouldStop) then
+    result := FCheckShouldStop(ACurrentY)
+  else
+    result := false;
+end;
+function TFilterTask.Execute: TBGRACustomBitmap;
+var DestinationOwned: boolean;
+begin
+  FCurrentY := 0;
+  if Destination = nil then
+  begin
+    FDestination := FSource.NewBitmap(FSource.Width,FSource.Height);
+    DestinationOwned:= true;
+  end else
+    DestinationOwned:= false;
+  try
+    DoExecute;
+    result := Destination;
+    FDestination := nil;
+  except
+    on ex: exception do
+    begin
+      if DestinationOwned then FreeAndNil(FDestination);
+      raise ex;
+    end;
+  end;
+end;
+procedure TFilterTask.SetDestination(AValue: TBGRACustomBitmap);
+begin
+  if FDestination <> nil then
+    raise exception.Create('Destination is already defined');
+  FDestination := AValue;
+end;
 end.

GraphicTest/Packages/bgrabitmap/bgrafreetype.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{
+  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+  This units provide a font renderer with FreeType fonts, using the integrated FreeType font engine in Lazarus.
+  The simplest way to render effects is to use TBGRAFreeTypeFontRenderer class.
+  To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions
+  to draw text like TBGRABitmap.TextOut will use the chosen renderer.
+  >> Note that you need to defined the default FreeType font collection
+  >> using LazFreeTypeFontCollection unit.
+  To set the effects, keep a variable containing
+  the TBGRAFreeTypeFontRenderer class and modify ShadowVisible and other effects parameters. The FontHinted property
+  allows you to choose if the font is snapped to pixels to make it more readable.
+  TBGRAFreeTypeDrawer class is the class that provides basic FreeType drawing
+  by deriving the TFreeTypeDrawer type. You can use it directly, but it is not
+  recommended, because there are less text layout parameters. However, it is
+  necessary if you want to create TBGRATextEffect objects using FreeType fonts.
+}
 interface
 uses
   Classes, SysUtils, Graphics, BGRABitmapTypes, EasyLazFreeType, FPimage;
+  Types, Classes, SysUtils, Graphics, BGRABitmapTypes, EasyLazFreeType, FPimage, BGRAText, BGRATextFX, BGRAPhongTypes, LCLVersion;
 type
+  TBGRAFreeTypeDrawer = class;
+  //this is the class to assign to FontRenderer property of TBGRABitmap
+  { TBGRAFreeTypeFontRenderer }
+  TBGRAFreeTypeFontRenderer = class(TBGRACustomFontRenderer)
+  private
+    FDrawer: TBGRAFreeTypeDrawer;
+    FFont: TFreeTypeFont;
+    function GetCollection: TCustomFreeTypeFontCollection;
+    function GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer;
+    function GetShaderLightPosition: TPoint;
+    procedure SetShaderLightPosition(AValue: TPoint);
+  protected
+    FShaderOwner: boolean;
+    FShader: TCustomPhongShading;
+    procedure UpdateFont;
+    procedure Init;
+  public
+    FontHinted: boolean;
+    ShaderActive: boolean;
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+    OutlineColor: TBGRAPixel;
+    OutlineVisible,OuterOutlineOnly: boolean;
+    OutlineTexture: IBGRAScanner;
+    constructor Create;
+    constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean);
+    function GetFontPixelMetric: TFontPixelMetric; override;
+    procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}c: TBGRAPixel; {%H-}align: TAlignment); override;
+    procedure TextOutAngle({%H-}ADest: TBGRACustomBitmap; {%H-}x, {%H-}y: single; {%H-}orientation: integer; {%H-}s: string; {%H-}texture: IBGRAScanner; {%H-}align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
+    function TextSize(s: string): TSize; override;
+    destructor Destroy; override;
+    property Collection: TCustomFreeTypeFontCollection read GetCollection;
+    property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition;
+  end;
   { TBGRAFreeTypeDrawer }
 …
     FMask: TBGRACustomBitmap;
     FColor: TBGRAPixel;
+    FInCreateTextEffect: boolean;
     procedure RenderDirectly(x, y, tx: integer; data: pointer);
     procedure RenderDirectlyClearType(x, y, tx: integer; data: pointer);
+    function ShadowActuallyVisible :boolean;
+    function OutlineActuallyVisible: boolean;
+    function ShaderActuallyActive : boolean;
   public
     Destination: TBGRACustomBitmap;
     ClearTypeRGBOrder: boolean;
+    Texture: IBGRAScanner;
+    Shader: TCustomPhongShading;
+    ShaderActive: boolean;
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+    OutlineColor: TBGRAPixel;
+    OutlineVisible,OuterOutlineOnly: boolean;
+    OutlineTexture: IBGRAScanner;
     constructor Create(ADestination: TBGRACustomBitmap);
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload;
     procedure DrawText(AText: string; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
+    function CreateTextEffect(AText: string; AFont: TFreeTypeRenderableFont): TBGRATextEffect;
     destructor Destroy; override;
   end;
 implementation
+uses LCLType, BGRABlend, BGRAText;
+uses LCLType, BGRABlend, Math;
+{ TBGRAFreeTypeFontRenderer }
+function TBGRAFreeTypeFontRenderer.GetCollection: TCustomFreeTypeFontCollection;
+begin
+  result := EasyLazFreeType.FontCollection;
+end;
+function TBGRAFreeTypeFontRenderer.GetDrawer(ASurface: TBGRACustomBitmap): TBGRAFreeTypeDrawer;
+begin
+  result := FDrawer;
+  result.ShadowColor := ShadowColor;
+  result.ShadowOffset := ShadowOffset;
+  result.ShadowRadius := ShadowRadius;
+  result.ShadowVisible := ShadowVisible;
+  result.ClearTypeRGBOrder := FontQuality <> fqFineClearTypeBGR;
+  result.Destination := ASurface;
+  result.OutlineColor := OutlineColor;
+  result.OutlineVisible := OutlineVisible;
+  result.OuterOutlineOnly := OuterOutlineOnly;
+  result.OutlineTexture := OutlineTexture;
+  if ShaderActive then result.Shader := FShader
+   else result.Shader := nil;
+end;
+function TBGRAFreeTypeFontRenderer.GetShaderLightPosition: TPoint;
+begin
+  if FShader = nil then
+    result := point(0,0)
+  else
+    result := FShader.LightPosition;
+end;
+procedure TBGRAFreeTypeFontRenderer.SetShaderLightPosition(AValue: TPoint);
+begin
+  if FShader <> nil then
+    FShader.LightPosition := AValue;
+end;
+procedure TBGRAFreeTypeFontRenderer.UpdateFont;
+var fts: TFreeTypeStyles;
+begin
+  fts := [];
+  if fsBold in FontStyle then fts += [ftsBold];
+  if fsItalic in FontStyle then fts += [ftsItalic];
+  try
+    {$IF (lcl_fullversion>=1010000)}
+    FFont.SetNameAndStyle(FontName,fts);
+    {$ELSE}
+    FFont.Name := FontName;
+    FFont.Style := fts;
+    {$ENDIF}
+  except
+    on ex: exception do
+    begin
+    end;
+  end;
+  if FontEmHeight >= 0 then
+    FFont.SizeInPixels := FontEmHeight
+  else
+    FFont.LineFullHeight := -FontEmHeight;
+  case FontQuality of
+    fqSystem:
+    begin
+      FFont.Quality := grqMonochrome;
+      FFont.ClearType := false;
+    end;
+    fqSystemClearType:
+    begin
+      FFont.Quality:= grqLowQuality;
+      FFont.ClearType:= true;
+    end;
+    fqFineAntialiasing:
+    begin
+      FFont.Quality:= grqHighQuality;
+      FFont.ClearType:= false;
+    end;
+    fqFineClearTypeRGB,fqFineClearTypeBGR:
+    begin
+      FFont.Quality:= grqHighQuality;
+      FFont.ClearType:= true;
+    end;
+  end;
+  FFont.Hinted := FontHinted;
+  {$IF (lcl_fullversion>=1010000)}
+  FFont.StrikeOutDecoration := fsStrikeOut in FontStyle;
+  FFont.UnderlineDecoration := fsUnderline in FontStyle;
+  {$ENDIF}
+end;
+procedure TBGRAFreeTypeFontRenderer.Init;
+begin
+  ShaderActive := true;
+  FDrawer := TBGRAFreeTypeDrawer.Create(nil);
+  FFont := TFreeTypeFont.Create;
+  FontHinted:= True;
+  ShadowColor := BGRABlack;
+  ShadowVisible := false;
+  ShadowOffset := Point(5,5);
+  ShadowRadius := 5;
+end;
+constructor TBGRAFreeTypeFontRenderer.Create;
+begin
+  Init;
+end;
+constructor TBGRAFreeTypeFontRenderer.Create(AShader: TCustomPhongShading;
+  AShaderOwner: boolean);
+begin
+  Init;
+  FShader := AShader;
+  FShaderOwner := AShaderOwner;
+end;
+function TBGRAFreeTypeFontRenderer.GetFontPixelMetric: TFontPixelMetric;
+begin
+  UpdateFont;
+  result.Baseline := round(FFont.Ascent);
+  result.CapLine:= round(FFont.Ascent*0.2);
+  result.DescentLine:= round(FFont.Ascent+FFont.Descent);
+  result.Lineheight := round(FFont.LineFullHeight);
+  result.xLine := round(FFont.Ascent*0.45);
+  result.Defined := True;
+end;
+procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
+begin
+end;
+procedure TBGRAFreeTypeFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; texture: IBGRAScanner;
+  align: TAlignment);
+begin
+end;
+procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  FDrawer.Texture := texture;
+  TextOut(ADest,x,y,s,BGRAWhite,align);
+  FDrawer.Texture := nil;
+end;
+procedure TBGRAFreeTypeFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; c: TBGRAPixel; align: TAlignment);
+var
+  ftaAlign: TFreeTypeAlignments;
+begin
+  UpdateFont;
+  ftaAlign:= [ftaTop];
+  case align of
+  taLeftJustify: ftaAlign += [ftaLeft];
+  taCenter: ftaAlign += [ftaCenter];
+  taRightJustify: ftaAlign += [ftaRight];
+  end;
+  GetDrawer(ADest).DrawText(s,FFont,x,y,BGRAToFPColor(c),ftaAlign);
+end;
+procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel);
+var align: TFreeTypeAlignments;
+    intersectedClip,previousClip: TRect;
+begin
+  previousClip := ADest.ClipRect;
+  if style.Clipping then
+  begin
+    intersectedClip := rect(0,0,0,0);
+    if not IntersectRect(intersectedClip, previousClip, ARect) then exit;
+    ADest.ClipRect := intersectedClip;
+  end;
+  UpdateFont;
+  align := [];
+  case style.Alignment of
+  taCenter: begin ARect.Left := x; align += [ftaCenter]; end;
+  taRightJustify: begin ARect.Left := x; align += [ftaRight]; end;
+  else
+    align += [ftaLeft];
+  end;
+  case style.Layout of
+  {$IF (lcl_fullversion>=1010000)}
+  tlCenter: begin ARect.Top := y; align += [ftaVerticalCenter]; end;
+  {$ENDIF}
+  tlBottom: begin ARect.top := y; align += [ftaBottom]; end;
+  else align += [ftaTop];
+  end;
+  try
+    {$IF (lcl_fullversion>=1010000)}
+    if style.Wordbreak then
+      GetDrawer(ADest).DrawTextRect(s, FFont, ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,BGRAToFPColor(c),align)
+    else
+    {$ENDIF}
+    begin
+      case style.Layout of
+      tlCenter: y := (ARect.Top+ARect.Bottom) div 2;
+      tlBottom: y := ARect.Bottom;
+      else
+        y := ARect.Top;
+      end;
+      case style.Alignment of
+      taLeftJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Left,y,BGRAToFPColor(c),align);
+      taCenter: GetDrawer(ADest).DrawText(s,FFont,(ARect.Left+ARect.Right-1) div 2,y,BGRAToFPColor(c),align);
+      taRightJustify: GetDrawer(ADest).DrawText(s,FFont,ARect.Right,y,BGRAToFPColor(c),align);
+      end;
+    end;
+  finally
+    if style.Clipping then
+      ADest.ClipRect := previousClip;
+  end;
+end;
+procedure TBGRAFreeTypeFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle;
+  texture: IBGRAScanner);
+begin
+  FDrawer.Texture := texture;
+  TextRect(ADest,ARect,x,y,s,style,BGRAWhite);
+  FDrawer.Texture := nil;
+end;
+function TBGRAFreeTypeFontRenderer.TextSize(s: string): TSize;
+begin
+  result.cx := round(FFont.TextWidth(s));
+  result.cy := round(FFont.LineFullHeight);
+end;
+destructor TBGRAFreeTypeFontRenderer.Destroy;
+begin
+  FDrawer.Free;
+  FFont.Free;
+  if FShaderOwner then FShader.Free;
+  inherited Destroy;
+end;
 { TBGRAFreeTypeDrawer }
 …
     if (y < 0) or (y >= Destination.height) or (x < 0) or (x > Destination.width-tx) then exit;
-    c := FColor;
     psrc := pbyte(data);
     pdest := Destination.ScanLine[y]+x;
+    while tx > 0 do
+    begin
+      DrawPixelInlineWithAlphaCheck(pdest,c,psrc^);
+      inc(psrc);
+      inc(pdest);
+      dec(tx);
+    if Texture = nil then
+    begin
+      c := FColor;
+      while tx > 0 do
+      begin
+        DrawPixelInlineWithAlphaCheck(pdest,c,psrc^);
+        inc(psrc);
+        inc(pdest);
+        dec(tx);
+      end;
+    end else
+    begin
+      Texture.ScanMoveTo(x,y);
+      while tx > 0 do
+      begin
+        DrawPixelInlineWithAlphaCheck(pdest,Texture.ScanNextPixel,psrc^);
+        inc(psrc);
+        inc(pdest);
+        dec(tx);
+      end;
     end;
   end;
 …
       pdest^.blue := ((psrc+1)^ + (psrc+2)^ + (psrc+2)^) div 3;
     end;
+    BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,nil,ClearTypeRGBOrder);
+  end;
+    BGRAFillClearTypeRGBMask(Destination,x div 3,y,FMask,FColor,Texture,ClearTypeRGBOrder);
+  end;
+end;
+function TBGRAFreeTypeDrawer.ShadowActuallyVisible: boolean;
+begin
+  result := ShadowVisible and (ShadowColor.alpha <> 0);
+end;
+function TBGRAFreeTypeDrawer.OutlineActuallyVisible: boolean;
+begin
+  result := ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible;
+end;
+function TBGRAFreeTypeDrawer.ShaderActuallyActive: boolean;
+begin
+  result := (Shader <> nil) and ShaderActive;
 end;
 …
   Destination := ADestination;
   ClearTypeRGBOrder:= true;
+  ShaderActive := true;
 end;
 procedure TBGRAFreeTypeDrawer.DrawText(AText: string;
   AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
+begin
+  FColor := FPColorToBGRA(AColor);
+  if AFont.ClearType then
+    AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType)
+  else
+    AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly);
+var fx: TBGRATextEffect;
+  procedure DoOutline;
+  begin
+    if OutlineActuallyVisible then
+    begin
+      if OutlineTexture <> nil then
+        fx.DrawOutline(Destination,round(x),round(y), OutlineTexture)
+      else
+        fx.DrawOutline(Destination,round(x),round(y), OutlineColor);
+    end;
+  end;
+begin
+  if not FInCreateTextEffect and (ShadowActuallyVisible or OutlineActuallyVisible or ShaderActuallyActive) then
+  begin
+    fx := CreateTextEffect(AText, AFont);
+    y -= AFont.Ascent;
+    if ShadowActuallyVisible then fx.DrawShadow(Destination, round(x+ShadowOffset.X),round(y+ShadowOffset.Y), ShadowRadius, ShadowColor);
+    if OuterOutlineOnly then DoOutline;
+    if texture <> nil then
+    begin
+      if ShaderActuallyActive then
+        fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture)
+      else
+        fx.Draw(Destination,round(x),round(y), texture);
+    end else
+    begin
+      if ShaderActuallyActive then
+        fx.DrawShaded(Destination,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), FPColorToBGRA(AColor))
+      else
+        fx.Draw(Destination,round(x),round(y), FPColorToBGRA(AColor));
+    end;
+    if not OuterOutlineOnly then DoOutline;
+    fx.Free;
+  end else
+  begin
+    FColor := FPColorToBGRA(AColor);
+    if AFont.ClearType then
+      AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectlyClearType)
+    else
+      AFont.RenderText(AText, x, y, Destination.ClipRect, @RenderDirectly);
+  end;
 end;
 …
 end;
+function TBGRAFreeTypeDrawer.CreateTextEffect(AText: string;
+  AFont: TFreeTypeRenderableFont): TBGRATextEffect;
+var
+  mask: TBGRACustomBitmap;
+  tx,ty,marginHoriz,marginVert: integer;
+  tempDest: TBGRACustomBitmap;
+  tempTex: IBGRAScanner;
+  tempClearType: boolean;
+begin
+  FInCreateTextEffect:= True;
+  try
+    tx := ceil(AFont.TextWidth(AText));
+    ty := ceil(AFont.TextHeight(AText));
+    marginHoriz := ty div 2;
+    marginVert := 1;
+    mask := BGRABitmapFactory.Create(tx+2*marginHoriz,ty+2*marginVert,BGRABlack);
+    tempDest := Destination;
+    tempTex := Texture;
+    tempClearType:= AFont.ClearType;
+    Destination := mask;
+    Texture := nil;
+    AFont.ClearType := false;
+    DrawText(AText,AFont,marginHoriz,marginVert,BGRAWhite,[ftaTop,ftaLeft]);
+    Destination := tempDest;
+    Texture := tempTex;
+    AFont.ClearType := tempClearType;
+    mask.ConvertToLinearRGB;
+    result := TBGRATextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert));
+  finally
+    FInCreateTextEffect:= false;
+  end;
+end;
 destructor TBGRAFreeTypeDrawer.Destroy;
 begin

GraphicTest/Packages/bgrabitmap/bgragradients.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{$i bgrasse.inc}
 interface
 …
                    Color : TBGRAPixel);
     {$ifdef CPUI386}
+    {$ifdef BGRASSE_AVAILABLE}
     procedure DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: integer; ofsX,ofsY: integer;
                    ColorMap : TBGRACustomBitmap);
 …
 implementation
 uses Types, SysUtils, BGRATextFX;
+uses GraphType, Types, SysUtils, BGRATextFX; {GraphType unit used by phongdraw.inc}
 function TextShadow(AWidth, AHeight: Integer; AText: String;
 …
                              Color : TBGRAPixel);
 begin
   {$ifdef CPUI386}
+  {$ifdef BGRASSE_AVAILABLE}
     if UseSSE then
       DrawColorSSE(dest,map,mapAltitude,ofsX,ofsY,Color)
 …
             mapAltitude: integer; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap);
 begin
   {$ifdef CPUI386}
+  {$ifdef BGRASSE_AVAILABLE}
     if UseSSE then
       DrawMapSSE(dest,map,mapAltitude,ofsX,ofsY,ColorMap)
 …
   mapAltitude: integer; ofsX, ofsY: integer; ColorScan: IBGRAScanner);
 begin
   {$ifdef CPUI386}
+  {$ifdef BGRASSE_AVAILABLE}
     if UseSSE then
       DrawScannerSSE(dest,map,mapAltitude,ofsX,ofsY,ColorScan)
 …
   {$I phongdraw.inc }
 {$ifdef CPUI386}
+{$ifdef BGRASSE_AVAILABLE}
 procedure TPhongShading.DrawMapSSE(dest: TBGRACustomBitmap; map: TBGRACustomBitmap;
   mapAltitude: integer; ofsX, ofsY: integer; ColorMap: TBGRACustomBitmap);
 …
 end;
+initialization
+  Randomize;
 end.

GraphicTest/Packages/bgrabitmap/bgragradientscanner.pas

-              r452
+              r472
   end;
+  { TBGRAConstantScanner }
+  TBGRAConstantScanner = class(TBGRAGradientScanner)
+    constructor Create(c: TBGRAPixel);
+  end;
+  { TBGRARandomScanner }
+  TBGRARandomScanner = class(TBGRACustomScanner)
+  private
+    FOpacity: byte;
+    FGrayscale: boolean;
+  public
+    constructor Create(AGrayscale: Boolean; AOpacity: byte);
+    function ScanAtInteger({%H-}X, {%H-}Y: integer): TBGRAPixel; override;
+    function ScanNextPixel: TBGRAPixel; override;
+    function ScanAt({%H-}X, {%H-}Y: Single): TBGRAPixel; override;
+  end;
   { TBGRAGradientTriangleScanner }
 …
 uses BGRABlend;
+{ TBGRAConstantScanner }
+constructor TBGRAConstantScanner.Create(c: TBGRAPixel);
+begin
+  inherited Create(c,c,gtLinear,PointF(0,0),PointF(0,0),false);
+end;
+{ TBGRARandomScanner }
+constructor TBGRARandomScanner.Create(AGrayscale: Boolean; AOpacity: byte);
+begin
+  FGrayscale:= AGrayscale;
+  FOpacity:= AOpacity;
+end;
+function TBGRARandomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel;
+begin
+  Result:=ScanNextPixel;
+end;
+function TBGRARandomScanner.ScanNextPixel: TBGRAPixel;
+begin
+  if FGrayscale then
+  begin
+    result.red := random(256);
+    result.green := result.red;
+    result.blue := result.red;
+    result.alpha:= FOpacity;
+  end else
+    Result:= BGRA(random(256),random(256),random(256),FOpacity);
+end;
+function TBGRARandomScanner.ScanAt(X, Y: Single): TBGRAPixel;
+begin
+  Result:=ScanNextPixel;
+end;
 { TBGRAHueGradient }
 …
   InitScanInline(X,Y);
   if FVertical then
     FHorizColor := ScanAt(X,Y);
+    FHorizColor := ScanNextInline;
 end;
 …
 end;
+initialization
+  Randomize;
 end.

GraphicTest/Packages/bgrabitmap/bgragtkbitmap.pas

-              r452
+              r472
   gdk, gtkdef, gtkProc, gdkpixbuf, glib,
   {$ENDIF}
   FPImage;
+  FPImage, Dialogs;
 {$IFDEF LCLgtk2}
 …
   end;
   //SwapRedBlue;
+  SwapRedBlue;
   P := Rect.TopLeft;
   DpToLP(ACanvas.Handle, P, 1);
+  LPToDP(ACanvas.Handle, P, 1);
   gdk_pixbuf_render_to_drawable(FPixBuf,
     TGtkDeviceContext(ACanvas.Handle).Drawable,
     TGtkDeviceContext(ACanvas.Handle).GC,
+,0,
+    TGtkDeviceContext(ACanvas.Handle).Offset.X + P.X,
+    TGtkDeviceContext(ACanvas.Handle).Offset.Y + P.Y,
+,0, P.X,P.Y,
     Width,Height,
     GDK_RGB_DITHER_NORMAL,0,0);
   //SwapRedBlue;
+  SwapRedBlue;
 end;
 …
   dest := ACanvas.Handle;
+  pos := TGtkDeviceContext(dest).Offset;
+  pos.X += rect.Left;
+  pos.Y += rect.Top;
+  pos := rect.TopLeft;
+  LPtoDP(dest, pos, 1);
   If ALineOrder = riloBottomToTop then VerticalFlip;
   //SwapRedBlue;
+  SwapRedBlue;
   gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable,
     TGtkDeviceContext(Dest).GC, pos.X,pos.Y,
+    TGtkDeviceContext(Dest).GC, pos.x,pos.y,
     AWidth,AHeight, GDK_RGB_DITHER_NORMAL,
     AData, AWidth*sizeof(TBGRAPixel));
   //SwapRedBlue;
+  SwapRedBlue;
   If ALineOrder = riloBottomToTop then VerticalFlip;
 end;
 …
   P := Point(x,y);
   DpToLP(CanvasSource.Handle, P, 1);
+  LPToDP(CanvasSource.Handle, P, 1);
   gdk_pixbuf_get_from_drawable(FPixBuf,
     TGtkDeviceContext(CanvasSource.Handle).Drawable,
+    nil,
+    TGtkDeviceContext(CanvasSource.Handle).Offset.X+P.X,
+    TGtkDeviceContext(CanvasSource.Handle).Offset.Y+P.Y,0,0,Width,Height);
+    nil, P.X,P.Y,0,0,Width,Height);
   SwapRedBlue;
   InvalidateBitmap;

GraphicTest/Packages/bgrabitmap/bgralayers.pas

-              r452
+              r472
   TBGRALayeredBitmap = class;
   TBGRALayeredBitmapClass = class of TBGRALayeredBitmap;
+  TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
+  TBGRALayeredBitmapLoadFromStreamProc = function(AStream: TStream): TBGRALayeredBitmap;
   { TBGRACustomLayeredBitmap }
 …
     function GetLayerName(layer: integer): string; virtual;
     function GetLayerOffset(layer: integer): TPoint; virtual;
-    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
     function GetLayerFrozenRange(layer: integer): integer;
     function GetLayerFrozen(layer: integer): boolean; virtual;
+    function GetLayerUniqueId(layer: integer): integer; virtual;
     procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual;
     function RangeIntersect(first1,last1,first2,last2: integer): boolean;
 …
   public
     procedure SaveToFile(const filename: string); override;
+    procedure SaveToFile(const filenameUTF8: string); override;
     procedure SaveToStream(Stream: TStream); override;
     constructor Create; override;
     destructor Destroy; override;
     function ToString: ansistring; override;
+    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract;
     function ComputeFlatImage: TBGRABitmap; overload;
 …
     property LayerOffset[layer: integer]: TPoint read GetLayerOffset;
     property LayerFrozen[layer: integer]: boolean read GetLayerFrozen;
+    property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId;
     property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified
     property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation;
 …
     FLayers: array of TBGRALayerInfo;
     FWidth,FHeight: integer;
-    function GetLayerUniqueId(layer: integer): integer;
-    procedure SetLayerUniqueId(layer: integer; AValue: integer);
   protected
 …
     procedure SetLayerName(layer: integer; AValue: string);
     procedure SetLayerFrozen(layer: integer; AValue: boolean); override;
+    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
+    function GetLayerUniqueId(layer: integer): integer; override;
+    procedure SetLayerUniqueId(layer: integer; AValue: integer);
   public
     procedure LoadFromFile(const filename: string); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
     procedure LoadFromStream(stream: TStream); override;
     procedure SetSize(AWidth, AHeight: integer); virtual;
 …
     function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
     destructor Destroy; override;
+    constructor Create; override;
+    constructor Create(AWidth, AHeight: integer);
+    constructor Create; override; overload;
+    constructor Create(AWidth, AHeight: integer); virtual; overload;
+    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
     function GetLayerIndexFromId(AIdentifier: integer): integer;
     function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap;
+    function ProduceLayerUniqueId: integer;
     procedure RotateCW;
 …
   end;
+procedure RegisterLayeredBitmapWriter(AExtension: string; AWriter: TBGRALayeredBitmapClass);
+procedure RegisterLayeredBitmapReader(AExtension: string; AReader: TBGRACustomLayeredBitmapClass);
+procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
+procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
+var
+  LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc;
+  LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc;
+type
+  TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object;
+  TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object;
+  TOnLayeredBitmapLoadedProc = procedure() of object;
+procedure OnLayeredBitmapLoadFromStreamStart;
+procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
+procedure OnLayeredBitmapLoadProgress(APercentage: integer);
+procedure OnLayeredBitmapLoaded();
+procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
+     ADone: TOnLayeredBitmapLoadedProc);
+procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
+     ADone: TOnLayeredBitmapLoadedProc);
 implementation
+uses LCLProc;
+var
+  OnLayeredBitmapLoadStartProc: TOnLayeredBitmapLoadStartProc;
+  OnLayeredBitmapLoadProgressProc: TOnLayeredBitmapLoadProgressProc;
+  OnLayeredBitmapLoadedProc: TOnLayeredBitmapLoadedProc;
 var
 …
 end;
 procedure TBGRALayeredBitmap.LoadFromFile(const filename: string);
+procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string);
 var bmp: TBGRABitmap;
     index: integer;
 …
     i: integer;
 begin
   ext := lowercase(ExtractFileExt(filename));
+  ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
   for i := 0 to high(LayeredBitmapReaders) do
     if '.'+LayeredBitmapReaders[i].extension = ext then
 …
       temp := LayeredBitmapReaders[i].theClass.Create;
       try
         temp.LoadFromFile(filename);
+        temp.LoadFromFile(filenameUTF8);
         Assign(temp);
       finally
 …
     end;
   bmp := TBGRABitmap.Create(filename);
+  bmp := TBGRABitmap.Create(filenameUTF8, True);
   Clear;
   SetSize(bmp.Width,bmp.Height);
 …
 var bmp: TBGRABitmap;
    index: integer;
+begin
+   temp: TBGRALayeredBitmap;
+begin
+  if Assigned(LayeredBitmapLoadFromStreamProc) then
+  begin
+    temp := LayeredBitmapLoadFromStreamProc(Stream);
+    if temp <> nil then
+    begin
+      Assign(temp);
+      temp.Free;
+      exit;
+    end;
+  end;
   bmp := TBGRABitmap.Create(stream);
   Clear;
 …
   FLayers[FNbLayers].Visible := true;
   FLayers[FNbLayers].Frozen := false;
   FLayers[FNbLayers].UniqueId := InterLockedIncrement(NextLayerUniqueId);
+  FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId;
   if Shared then
   begin
 …
   result := TBGRALayeredBitmap.Create;
   result.Assign(self, ASharedLayerIds);
+end;
+function TBGRALayeredBitmap.ProduceLayerUniqueId: integer;
+begin
+  result := InterLockedIncrement(NextLayerUniqueId);
 end;
 …
     end;
   result := false;
+end;
+function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer;
+begin
+  result := layer;
 end;
 …
 end;
 procedure TBGRACustomLayeredBitmap.SaveToFile(const filename: string);
+procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string);
 var bmp: TBGRABitmap;
     ext: string;
 …
     i: integer;
 begin
   ext := lowercase(ExtractFileExt(filename));
+  ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
   for i := 0 to high(LayeredBitmapWriters) do
     if '.'+LayeredBitmapWriters[i].extension = ext then
 …
       try
         temp.Assign(self);
         temp.SaveToFile(filename);
+        temp.SaveToFile(filenameUTF8);
       finally
         temp.Free;
 …
   bmp := ComputeFlatImage;
   try
     bmp.SaveToFile(filename);
+    bmp.SaveToFileUTF8(filenameUTF8);
   finally
     bmp.Free;
 …
 procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream);
 begin
+  raise exception.Create('Not implemented');
+  if Assigned(LayeredBitmapSaveToStreamProc) then
+    LayeredBitmapSaveToStreamProc(Stream, self)
+  else
+    raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first');
 end;
 …
   linear := false; //to avoid hint
   for j := firstlayer to lastLayer do
   if (BlendOperation[j] in [boTransparent,boLinearBlend]) or (start= 0) then
+  if (BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0)) then
   begin
     nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend;
 …
 end;
 procedure RegisterLayeredBitmapReader(AExtension: string; AReader: TBGRACustomLayeredBitmapClass);
+procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
 begin
   setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1);
   with LayeredBitmapReaders[high(LayeredBitmapReaders)] do
   begin
     extension:= AExtension;
+    extension:= UTF8LowerCase(AExtensionUTF8);
     theClass := AReader;
   end;
 end;
+procedure RegisterLayeredBitmapWriter(AExtension: string; AWriter: TBGRALayeredBitmapClass);
+begin
+procedure OnLayeredBitmapLoadFromStreamStart;
+begin
+  OnLayeredBitmapLoadStart('<Stream>');
+end;
+procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
+begin
+  if Assigned(OnLayeredBitmapLoadStartProc) then
+    OnLayeredBitmapLoadStartProc(AFilenameUTF8);
+end;
+procedure OnLayeredBitmapLoadProgress(APercentage: integer);
+begin
+  if Assigned(OnLayeredBitmapLoadProgressProc) then
+    OnLayeredBitmapLoadProgressProc(APercentage);
+end;
+procedure OnLayeredBitmapLoaded;
+begin
+  if Assigned(OnLayeredBitmapLoadedProc) then
+    OnLayeredBitmapLoadedProc();
+end;
+procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
+  AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc
+  );
+begin
+  OnLayeredBitmapLoadProgressProc:= AProgress;
+  OnLayeredBitmapLoadStartProc := AStart;
+  OnLayeredBitmapLoadedProc:= ADone;
+end;
+procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
+  AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
+begin
+  if OnLayeredBitmapLoadProgressProc = AProgress then OnLayeredBitmapLoadProgressProc := nil;
+  if OnLayeredBitmapLoadStartProc = AStart then OnLayeredBitmapLoadStartProc := nil;
+  if OnLayeredBitmapLoadedProc = ADone then OnLayeredBitmapLoadedProc := nil;
+end;
+procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
+begin
+  while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1);
   setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1);
   with LayeredBitmapWriters[high(LayeredBitmapWriters)] do
   begin
     extension:= AExtension;
+    extension:= UTF8LowerCase(AExtensionUTF8);
     theClass := AWriter;
   end;

GraphicTest/Packages/bgrabitmap/bgramatrix3d.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{$ifdef CPUI386}
+{$i bgrasse.inc}
+{$ifdef BGRASSE_AVAILABLE}
   {$asmmode intel}
 {$endif}
 …
 type
   TMatrix3D = packed array[1..3,1..4] of single;
+  TProjection3D = packed record
+    Zoom, Center: TPointF;
+  end;
 operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D;
+operator*(const A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
+operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
+function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128;
 operator*(A,B: TMatrix3D): TMatrix3D;
 …
 function MatrixRotateZ(angle: single): TMatrix3D;
 {$IFDEF CPUI386}
+{$IFDEF BGRASSE_AVAILABLE}
 procedure Matrix3D_SSE_Load(const A: TMatrix3D);
 procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
 procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
 {$ENDIF}
 …
 end;
 {$IFDEF CPUI386}
+{$IFDEF BGRASSE_AVAILABLE}
 var SingleConst1 : single = 1;
+procedure Matrix3D_SSE_Load(const A: TMatrix3D);
+begin
+  asm
+    mov eax, A
+    movups xmm5, [eax]
+    movups xmm6, [eax+16]
+    movups xmm7, [eax+32]
+  end;
+end;
+  procedure Matrix3D_SSE_Load(const A: TMatrix3D);
+  begin
+    {$IFDEF cpux86_64}
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+    end;
+    {$ELSE}
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+    end;
+   {$ENDIF}
+  end;
 procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
 …
   oldMt := M.t;
   M.t := SingleConst1;
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+    mov rax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [rax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [rax+4], xmm2
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+    asm
+    mov eax, M
+    movaps xmm0, [eax]
+    mov eax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [eax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [eax+4], xmm2
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+  M.t := oldMt;
+  N.t := 0;
+end;
+procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+var oldMt: single;
+begin
+  oldMt := M.t;
+  M.t := SingleConst1;
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+    mov rax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax+4], xmm2
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
   asm
     mov eax, M
 …
     movaps xmm2,xmm0
     mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
     movss [eax], xmm2
     movaps xmm2,xmm0
     mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
     movss [eax+4], xmm2
     mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
     movss [eax+8], xmm0
   end;
+  {$ENDIF}
   M.t := oldMt;
+  N.t := 0;
+end;
+procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+var oldMt: single;
+begin
+  oldMt := M.t;
+  M.t := SingleConst1;
+end;
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(
+  var M: TPoint3D_128; out N: TPoint3D_128);
+begin
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+    mov rax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [rax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [rax+4], xmm2
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+    asm
+    mov eax, M
+    movaps xmm0, [eax]
+    mov eax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [eax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+    movss [eax+4], xmm2
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+end;
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(
+  var M: TPoint3D_128; out N: TPoint3D_128);
+begin
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+    mov rax, N
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax], xmm2
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax+4], xmm2
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
   asm
     mov eax, M
 …
     movss [eax+8], xmm0
   end;
+  M.t := oldMt;
+end;
+  {$ENDIF}
+end;
 {$ENDIF}
 operator*(const A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
+operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
 {$IFDEF CPUI386}var oldMt: single; {$ENDIF}
 begin
 …
 end;
+function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128;
+begin
+  {$IFDEF CPUI386}
+  if UseSSE then
+  begin
+    if UseSSE3 then
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+      mov eax, M
+      movups xmm0, [eax]
+      mov eax, result
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax], xmm4
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax+4], xmm4
+      mulps xmm0,xmm7
+      haddps xmm0,xmm0
+      haddps xmm0,xmm0
+      movss [eax+8], xmm0
+    end else
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+      mov eax, M
+      movups xmm0, [eax]
+      mov eax, result
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+      movss [eax], xmm4
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+      movss [eax+4], xmm4
+      mulps xmm0,xmm7
+      //mix1
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $4e
+      addps xmm0, xmm3
+      //mix2
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $11
+      addps xmm0, xmm3
+      movss [eax+8], xmm0
+    end;
+  end else
+  {$ENDIF}
+  begin
+    result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3];
+    result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3];
+    result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3];
+    result.t := 0;
+  end;
+end;
 operator*(A,B: TMatrix3D): TMatrix3D;
 begin

GraphicTest/Packages/bgrabitmap/bgraopenraster.pas

-              r452
+              r472
     function GetMemoryStreamAsString(AFilename: string): string;
     procedure UnzipFromStream(AStream: TStream);
+    procedure UnzipFromFile(AFilename: string);
+    procedure ZipToFile(AFilename: string);
+    procedure UnzipFromFile(AFilenameUTF8: string);
+    procedure ZipToFile(AFilenameUTF8: string);
+    procedure ZipToStream(AStream: TStream);
     procedure CopyThumbnailToMemoryStream(AMaxWidth, AMaxHeight: integer);
     procedure AnalyzeZip;
+    procedure PrepareZipToSave;
     function GetMimeType: string; override;
   public
+    constructor Create; override;
+    constructor Create; override; overload;
+    constructor Create(AWidth, AHeight: integer); override; overload;
     procedure Clear; override;
+    function CheckMimeType(AStream: TStream): boolean;
     procedure LoadFromStream(AStream: TStream); override;
+    procedure LoadFromFile(const filename: string); override;
+    procedure SaveToFile(const filename: string); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
+    procedure SaveToFile(const filenameUTF8: string); override;
+    procedure SaveToStream(AStream: TStream); override;
     property MimeType : string read GetMimeType write SetMimeType;
     property StackXML : TXMLDocument read FStackXML;
 …
   TFPReaderOpenRaster = class(TFPCustomImageReader)
+    private
+      FWidth,FHeight,FNbLayers: integer;
     protected
       function InternalCheck(Stream: TStream): boolean; override;
       procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    public
+      property Width: integer read FWidth;
+      property Height: integer read FHeight;
+      property NbLayers: integer read FNbLayers;
+  end;
+  { TFPWriterOpenRaster }
+  TFPWriterOpenRaster = class(TFPCustomImageWriter)
+    protected
+      procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
   end;
 …
 implementation
+uses Graphics, XMLRead, XMLWrite, FPReadPNG, dialogs, BGRABitmapTypes, zstream;
+uses Graphics, XMLRead, XMLWrite, FPReadPNG, dialogs, BGRABitmapTypes, zstream, lazutf8classes,
+  UnzipperExt;
 function IsZipStream(stream: TStream): boolean;
 …
 end;
+{ TFPWriterOpenRaster }
+procedure TFPWriterOpenRaster.InternalWrite(Str: TStream; Img: TFPCustomImage);
+var doc: TBGRAOpenRasterDocument;
+  tempBmp: TBGRABitmap;
+  x,y: integer;
+begin
+  doc := TBGRAOpenRasterDocument.Create;
+  if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else
+  begin
+    tempBmp := TBGRABitmap.Create(img.Width,img.Height);
+    for y := 0 to Img.Height-1 do
+      for x := 0 to img.Width-1 do
+        tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y]));
+    doc.AddOwnedLayer(tempBmp);
+  end;
+  doc.SaveToStream(Str);
+  doc.Free;
+end;
 { TFPReaderOpenRaster }
 function TFPReaderOpenRaster.InternalCheck(Stream: TStream): boolean;
+begin
+ result := IsZipStream(Stream);
+var {%h-}magic: packed array[0..3] of byte;
+  OldPos,BytesRead: Int64;
+  doc : TBGRAOpenRasterDocument;
+begin
+  Result:=false;
+  if Stream=nil then exit;
+  oldPos := stream.Position;
+  BytesRead := Stream.Read({%h-}magic,sizeof(magic));
+  stream.Position:= OldPos;
+  if BytesRead<>sizeof(magic) then exit;
+  if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then
+  begin
+    doc := TBGRAOpenRasterDocument.Create;
+    result := doc.CheckMimeType(Stream);
+    doc.Free;
+  end;
 end;
 …
   x,y: integer;
 begin
+  FWidth := 0;
+  FHeight:= 0;
+  FNbLayers:= 0;
   layeredImage := TBGRAOpenRasterDocument.Create;
   try
 …
     flat := layeredImage.ComputeFlatImage;
     try
+      Img.SetSize(flat.Width,flat.Height);
+      for y := 0 to flat.Height-1 do
+        for x := 0 to flat.Width-1 do
+          Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y));
+      FWidth:= layeredImage.Width;
+      FHeight:= layeredImage.Height;
+      FNbLayers:= layeredImage.NbLayers;
+      if Img is TBGRACustomBitmap then
+        TBGRACustomBitmap(img).Assign(flat)
+      else
+      begin
+        Img.SetSize(flat.Width,flat.Height);
+        for y := 0 to flat.Height-1 do
+          for x := 0 to flat.Width-1 do
+            Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y));
+      end;
     finally
       flat.free;
 …
   for i := stackNode.ChildNodes.Length-1 downto 0 do
   begin
+    OnLayeredBitmapLoadProgress((stackNode.ChildNodes.Length-i)*100 div stackNode.ChildNodes.Length);
     layerNode:= stackNode.ChildNodes[i];
     if (layerNode.NodeName = 'layer') and Assigned(layerNode.Attributes) then
 …
 end;
+procedure TBGRAOpenRasterDocument.LoadFromFile(const filename: string);
+begin
+  UnzipFromFile(filename);
+  AnalyzeZip;
+end;
+procedure TBGRAOpenRasterDocument.SaveToFile(const filename: string);
+procedure TBGRAOpenRasterDocument.PrepareZipToSave;
 var i: integer;
     imageNode,stackNode,layerNode: TDOMElement;
 …
   WriteXMLFile(StackXML, StackStream);
   SetMemoryStream('stack.xml',StackStream);
+  ZipToFile(filename);
+end;
+procedure TBGRAOpenRasterDocument.LoadFromFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(AStream);
+  finally
+    AStream.Free;
+  end;
+end;
+procedure TBGRAOpenRasterDocument.SaveToFile(const filenameUTF8: string);
+begin
+  PrepareZipToSave;
+  ZipToFile(filenameUTF8);
+end;
+procedure TBGRAOpenRasterDocument.SaveToStream(AStream: TStream);
+begin
+  PrepareZipToSave;
+  ZipToStream(AStream);
 end;
 …
 begin
   inherited Create;
+  RegisterOpenRasterFormat;
+end;
+constructor TBGRAOpenRasterDocument.Create(AWidth, AHeight: integer);
+begin
+  inherited Create(AWidth, AHeight);
   RegisterOpenRasterFormat;
 end;
 …
   finally
     FZipInputStream := nil;
   end;
   unzip.Free;
 end;
 procedure TBGRAOpenRasterDocument.UnzipFromFile(AFilename: string);
+    unzip.Free;
+  end;
+end;
+procedure TBGRAOpenRasterDocument.UnzipFromFile(AFilenameUTF8: string);
 var unzip: TUnZipper;
 begin
 …
   unzip := TUnZipper.Create;
   try
     unzip.FileName := AFilename;
+    unzip.FileName := Utf8ToAnsi(AFilenameUTF8);
     unzip.OnCreateStream := @ZipOnCreateStream;
     unzip.OnDoneStream := @ZipOnDoneStream;
     unzip.UnZipAllFiles;
   finally
+  end;
+  unzip.Free;
+end;
+procedure TBGRAOpenRasterDocument.ZipToFile(AFilename: string);
+    unzip.Free;
+  end;
+end;
+procedure TBGRAOpenRasterDocument.ZipToFile(AFilenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate);
+  try
+    ZipToStream(stream);
+  finally
+    stream.Free;
+  end;
+end;
+procedure TBGRAOpenRasterDocument.ZipToStream(AStream: TStream);
 var zip: TZipper;
   i: integer;
 …
   zip := TZipper.Create;
   try
-    zip.FileName := AFilename;
     for i := 0 to high(FFiles) do
     begin
 …
       zip.Entries.AddFileEntry(FFiles[i].Stream,FFiles[i].Filename).CompressionLevel := clnone;
     end;
     zip.ZipAllFiles;
+    zip.SaveToStream(AStream);
   finally
     zip.Free;
 …
   if (Width = 0) or (Height = 0) then exit;
   thumbnail := ComputeFlatImage;
+  CopyBitmapToMemoryStream(thumbnail,'mergedimage.png');
   if (thumbnail.Width > AMaxWidth) or
    (thumbnail.Height > AMaxHeight) then
 …
 end;
+function TBGRAOpenRasterDocument.CheckMimeType(AStream: TStream): boolean;
+var unzip: TUnzipperStreamUtf8;
+  mimeTypeFound: string;
+  oldPos: int64;
+begin
+  result := false;
+  unzip := TUnzipperStreamUtf8.Create;
+  oldPos := AStream.Position;
+  try
+    unzip.InputStream := AStream;
+    mimeTypeFound := unzip.UnzipFileToString('mimetype');
+    if mimeTypeFound = OpenRasterMimeType then result := true;
+  except
+  end;
+  unzip.Free;
+  astream.Position:= OldPos;
+end;
 procedure TBGRAOpenRasterDocument.LoadFromStream(AStream: TStream);
 begin
+  UnzipFromStream(AStream);
+  AnalyzeZip;
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    UnzipFromStream(AStream);
+    AnalyzeZip;
+  finally
+    OnLayeredBitmapLoaded;
+  end;
 end;
 …
   RegisterLayeredBitmapWriter('ora', TBGRAOpenRasterDocument);
   //TPicture.RegisterFileFormat('ora', 'OpenRaster', TBGRAOpenRasterDocument);
+  DefaultBGRAImageReader[ifOpenRaster] := TFPReaderOpenRaster;
+  DefaultBGRAImageWriter[ifOpenRaster] := TFPWriterOpenRaster;
   AlreadyRegistered:= True;
 end;

GraphicTest/Packages/bgrabitmap/bgrapaintnet.pas

-              r452
+              r472
   TPaintDotNetFile = class(TBGRACustomLayeredBitmap)
   public
     procedure LoadFromFile(const filename: string); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
     procedure LoadFromStream(stream: TStream); override;
     procedure Clear; override;
 …
     constructor Create; override;
   protected
+    procedure InternalLoadFromStream(stream: TStream);
     function GetWidth: integer; override;
     function GetHeight: integer; override;
 …
     function GetLayerName(layer: integer): string; override;
   private
-    XmlHeader: string;
-    ThumbNail: TBGRABitmap;
     Content:   TDotNetDeserialization;
     Document:  TSerializedClass;
 …
   TFPReaderPaintDotNet = class(TFPCustomImageReader)
+    private
+      FWidth,FHeight,FNbLayers: integer;
     protected
       function InternalCheck(Stream: TStream): boolean; override;
       procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    public
+      property Width: integer read FWidth;
+      property Height: integer read FHeight;
+      property NbLayers: integer read FNbLayers;
   end;
 function IsPaintDotNetFile(filename: string): boolean;
+function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean;
 function IsPaintDotNetStream(stream: TStream): boolean;
 function LoadPaintDotNetFile(filename: string): TBGRABitmap;
+function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap;
 procedure RegisterPaintNetFormat;
 …
 implementation
 uses zstream, Math, graphtype, Graphics;
+uses zstream, Math, graphtype, Graphics, lazutf8classes, FileUtil;
 {$hints off}
 …
   begin
     stream := TFileStream.Create(filename, fmOpenRead);
+    Result := IsPaintDotNetStream(stream);
+    stream.Free;
+  end;
+end;
+function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean;
+var
+  stream: TFileStreamUTF8;
+begin
+  Result := False;
+  if FileExistsUTF8(filenameUTF8) then
+  begin
+    stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead);
     Result := IsPaintDotNetStream(stream);
     stream.Free;
 …
 function LoadPaintDotNetFile(filename: string): TBGRABitmap;
+begin
+  result := LoadPaintDotNetFileUTF8(SysToUTF8(filename));
+end;
+function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap;
 var
   pdn: TPaintDotNetFile;
 …
   Result := nil;
   try
     pdn.LoadFromFile(filename);
+    pdn.LoadFromFile(filenameUTF8);
     Result := pdn.ComputeFlatImage;
     pdn.Free;
 …
   x,y: integer;
 begin
+  FWidth := 0;
+  FHeight:= 0;
+  FNbLayers:= 0;
   pdn    := TPaintDotNetFile.Create;
   try
 …
     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));
+      FWidth:= pdn.Width;
+      FHeight:= pdn.Height;
+      FNbLayers:= pdn.NbLayers;
+      if Img is TBGRACustomBitmap then
+        TBGRACustomBitmap(Img).Assign(flat) else
+      begin
+        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));
+      end;
     finally
       flat.free;
 …
 { TPaintDotNetFile }
+procedure TPaintDotNetFile.LoadFromFile(const filename: string);
+var
+  stream: TFileStream;
+begin
+  stream := TFileStream.Create(filename, fmOpenRead);
+procedure TPaintDotNetFile.LoadFromFile(const filenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead);
+  OnLayeredBitmapLoadStart(filenameUTF8);
   try
     LoadFromStream(stream);
+    InternalLoadFromStream(stream);
   finally
+    OnLayeredBitmapLoaded;
     stream.Free;
   end;
 …
 procedure TPaintDotNetFile.LoadFromStream(stream: TStream);
+begin
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    InternalLoadFromStream(stream);
+  finally
+    OnLayeredBitmapLoaded;
+  end;
+end;
+procedure TPaintDotNetFile.InternalLoadFromStream(stream: TStream);
 var
   header: packed array[0..3] of char;
 …
   stream.Read(XmlHeaderSize, 3);
   XmlheaderSize := LEtoN(XmlheaderSize);
+  setlength(XmlHeader, XmlHeaderSize);
+  if stream.Read(XmlHeader[1], XmlHeaderSize) <> XmlHeaderSize then
+  if Stream.Position + XmlHeaderSize > stream.Size then
     raise Exception.Create('Xml header size error');
   XmlHeader := Utf8ToAnsi(XmlHeader);
+  Stream.Position:= Stream.Position + XmlHeaderSize;
      {$hints off}
   stream.Read(CompressionFormat, sizeof(CompressionFormat));
 …
   for i := 0 to NbLayers - 1 do
   begin
+    OnLayeredBitmapLoadProgress((i+1)*100 div NbLayers);
     LayerData[i] := TMemoryStream.Create;
     LoadLayer(LayerData[i], Stream, LayerDataSize(i));
 …
 begin
   Result := 'Paint.Net document' + LineEnding + LineEnding;
+  if length(XmlHeader) > 255 then
+    Result += copy(XmlHeader, 1, 255) + '...'
+  else
+    Result += XmlHeader;
+  Result += LineEnding + LineEnding + Content.ToString;
+  Result += Content.ToString;
   for i := 0 to NbLayers - 1 do
   begin
 …
   inherited Create;
   Content   := nil;
-  ThumbNail := nil;
   Document  := nil;
   Layers    := nil;
 …
   i: integer;
 begin
-  XmlHeader := '';
   FreeAndNil(content);
-  FreeAndNil(thumbNail);
   document := nil;
   Layers   := nil;
 …
   RegisterLayeredBitmapReader('pdn', TPaintDotNetFile);
   //TPicture.RegisterFileFormat('pdn', 'Paint.NET image', TPaintDotNetFile);
+  DefaultBGRAImageReader[ifPaintDotNet] := TFPReaderPaintDotNet;
   AlreadyRegistered := true;
 end;

GraphicTest/Packages/bgrabitmap/bgrapath.pas

-              r452
+              r472
 interface
+{ There are different conventions for angles.
+  First is about the unit. It can be one of the following:
+  - degrees (0..360)
+  - radian (0..2*Pi)
+  - tenth of degrees (0..3600)
+  - from 0 to 65536
+  Second is about the origin. It can be one of the following:
+  - right-most position (this is the default origin for radian and 65536)
+  - top-most position (this is the default origin for degrees)
+  Third is about the sign. It can be one of the following:
+  - positive is clockwise (this is the default for degrees)
+  - positive is counterclockwise (this is the default for radian and 65536)
+  TBGRAPath and TBGRACanvas2D follow HTML5 convention which is:
+    (radian, right-most, clockwise) that can be shortened to (radian, clockwise)
+    because right-most is the default for radian. This is abbreviated as "radCW".
+  When radian are CCW, it is also specified in order to make it clear, even
+  if it is the default convention in mathematics.
+  In order to make things easier, there are some functions that accept angles
+  in degrees. The convention used here is the usual degree convention:
+    (degrees, top-most, clockwise) that can be shortened to (degree)
+    because top-most and clockwise is the default for degrees.
+  }
 uses
+  Classes, BGRABitmapTypes;
+  Classes, BGRABitmapTypes, BGRATransform;
+type
+  TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath, peQuadraticBezierTo, peCubicBezierTo, peArc);
+  PBGRAPathElementType = ^TBGRAPathElementType;
+  { TBGRAPath }
+  TBGRAPath = class(IBGRAPath)
+  private
+    function GetSvgString: string;
+    procedure SetSvgString(const AValue: string);
+  protected
+    FData: pbyte;
+    FDataSize: integer;
+    FDataPos: integer;
+    FLastElementType: TBGRAPathElementType;
+    FLastCoord,
+    FStartCoord: TPointF;
+    FExpectedControlPoint: TPointF;
+    FMatrix: TAffineMatrix; //this matrix must have a base of vectors
+                            //orthogonal, of same length and with positive
+                            //orientation in order to preserve arcs
+    FScale,FAngleRadCW: single;
+    procedure NeedSpace(count: integer);
+    procedure StoreCoord(const pt: TPointF);
+    function ReadCoord: TPointF;
+    procedure StoreElementType(value: TBGRAPathElementType);
+    function ReadElementType: TBGRAPathElementType;
+    function ReadArcDef: TArcDef;
+    procedure RewindFloat;
+    procedure Init;
+  public
+    constructor Create; overload;
+    constructor Create(ASvgString: string); overload;
+    destructor Destroy; override;
+    procedure beginPath;
+    procedure closePath;
+    procedure translate(x,y: single);
+    procedure resetTransform;
+    procedure rotate(angleRadCW: single); overload;
+    procedure rotateDeg(angleDeg: single); overload;
+    procedure rotate(angleRadCW: single; center: TPointF); overload;
+    procedure rotateDeg(angleDeg: single; center: TPointF); overload;
+    procedure scale(factor: single);
+    procedure moveTo(x,y: single); overload;
+    procedure lineTo(x,y: single); overload;
+    procedure moveTo(const pt: TPointF); overload;
+    procedure lineTo(const pt: TPointF); overload;
+    procedure polylineTo(const pts: array of TPointF);
+    procedure quadraticCurveTo(cpx,cpy,x,y: single); overload;
+    procedure quadraticCurveTo(const cp,pt: TPointF); overload;
+    procedure quadraticCurve(const curve: TQuadraticBezierCurve); overload;
+    procedure smoothQuadraticCurveTo(x,y: single); overload;
+    procedure smoothQuadraticCurveTo(const pt: TPointF); overload;
+    procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload;
+    procedure bezierCurveTo(const cp1,cp2,pt: TPointF); overload;
+    procedure bezierCurve(const curve: TCubicBezierCurve); overload;
+    procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload;
+    procedure smoothBezierCurveTo(const cp2,pt: TPointF); overload;
+    procedure rect(x,y,w,h: single);
+    procedure roundRect(x,y,w,h,radius: single);
+    procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
+    procedure arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single); overload;
+    procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single; anticlockwise: boolean); overload;
+    procedure arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single); overload;
+    procedure arcTo(x1, y1, x2, y2, radius: single); overload;
+    procedure arcTo(const p1,p2: TPointF; radius: single); overload;
+    procedure arc(const arcDef: TArcDef); overload;
+    procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload;
+    procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload;
+    procedure arcTo(rx,ry, xAngleRadCW: single; largeArc, anticlockwise: boolean; x,y:single);
+    procedure copyTo(dest: IBGRAPath);
+    procedure addPath(const AValue: string); overload;
+    procedure addPath(source: IBGRAPath); overload;
+    property SvgString: string read GetSvgString write SetSvgString;
+  protected
+    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;
 {----------------------- Spline ------------------}
 …
 function ComputeEllipse(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF;
 function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF;
+function ComputeArcRad(x, y, rx, ry: single; startRadCCW,endRadCCW: single; quality: single = 1): ArrayOfTPointF;
+function ComputeArc(const arc: TArcDef; quality: single = 1): ArrayOfTPointF;
 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload;
 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload;
+function Html5ArcTo(const p0, p1, p2: TPointF; radius: single): TArcDef;
+function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc,
+  anticlockwise: boolean; const p1: TPointF): TArcDef;
+function ArcStartPoint(const arc: TArcDef): TPointF;
+function ArcEndPoint(const arc: TArcDef): TPointF;
+function IsLargeArc(const arc: TArcDef): boolean;
 implementation
 uses Math, BGRAResample;
+uses Math, BGRAResample, SysUtils;
 function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
 …
 end;
-{$PUSH}{$R-}
 function ComputeArc65536(x, y, rx, ry: single; start65536,end65536: word; quality: single): ArrayOfTPointF;
 var i,nb: integer;
 …
   for i := 0 to nb-1 do
   begin
+    {$PUSH}{$R-}
     pos := start65536+int64(i)*arclen div (int64(nb)-1);
+    {$POP}
     result[i] := PointF(x+rx*(Cos65536(pos)-32768)/32768,
                         y-ry*(Sin65536(pos)-32768)/32768);
   end;
 end;
-{$R+}
 function ComputeEllipse(x, y, rx, ry: single; quality: single): ArrayOfTPointF;
 begin
   result := ComputeArc65536(x,y,rx,ry,0,0,quality);
+end;
+function ComputeArcRad(x, y, rx, ry: single; startRadCCW, endRadCCW: single;
+  quality: single): ArrayOfTPointF;
+begin
+  result := ComputeArc65536(x,y,rx,ry,round(startRadCCW*32768/Pi) and $ffff,round(endRadCCW*32768/Pi) and $ffff,quality);
+  result[0] := PointF(x+cos(startRadCCW)*rx,y-sin(startRadCCW)*ry);
+  result[high(result)] := PointF(x+cos(endRadCCW)*rx,y-sin(endRadCCW)*ry);
+end;
+function ComputeArc(const arc: TArcDef; quality: single): ArrayOfTPointF;
+var startAngle,endAngle: single;
+    i,n: integer;
+    temp: TPointF;
+    m: TAffineMatrix;
+begin
+  startAngle := -arc.startAngleRadCW;
+  endAngle:= -arc.endAngleRadCW;
+  if not arc.anticlockwise then
+  begin
+    result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,endAngle,startAngle,quality);
+    n := length(result);
+    if n>1 then
+      for i := 0 to (n-2) div 2 do
+      begin
+        temp := result[i];
+        result[i] := result[n-1-i];
+        result[n-1-i] := temp;
+      end;
+  end else
+    result := ComputeArcRad(arc.center.x,arc.center.y,arc.radius.x,arc.radius.y,startAngle,endAngle,quality);
+  if arc.xAngleRadCW <> 0 then
+  begin
+    m := AffineMatrixTranslation(arc.center.x,arc.center.y)*AffineMatrixRotationRad(-arc.xAngleRadCW)*AffineMatrixTranslation(-arc.center.x,-arc.center.y);
+    for i := 0 to high(result) do
+      result[i] := m*result[i];
+  end;
 end;
 …
 end;
+function Html5ArcTo(const p0, p1, p2: TPointF; radius: single
+  ): TArcDef;
+var p3,p4,an,bn,cn,c: TPointF;
+    dir, a2, b2, c2, cosx, sinx, d: single;
+    anticlockwise: boolean;
+begin
+  result.center := p1;
+  result.radius := PointF(0,0);
+  result.xAngleRadCW:= 0;
+  result.startAngleRadCW := 0;
+  result.endAngleRadCW:= 0;
+  result.anticlockwise:= false;
+  radius := abs(radius);
+  if (p0 = p1) or (p1 = p2) or (radius = 0) then exit;
+  dir := (p2.x-p1.x)*(p0.y-p1.y) + (p2.y-p1.y)*(p1.x-p0.x);
+  if dir = 0 then exit;
+  a2 := (p0.x-p1.x)*(p0.x-p1.x) + (p0.y-p1.y)*(p0.y-p1.y);
+  b2 := (p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y);
+  c2 := (p0.x-p2.x)*(p0.x-p2.x) + (p0.y-p2.y)*(p0.y-p2.y);
+  cosx := (a2+b2-c2)/(2*sqrt(a2*b2));
+  sinx := sqrt(1 - cosx*cosx);
+  if (sinx = 0) or (cosx = 1) then exit;
+  d := radius / ((1 - cosx) / sinx);
+  an := (p1-p0)*(1/sqrt(a2));
+  bn := (p1-p2)*(1/sqrt(b2));
+  p3 := p1 - an*d;
+  p4 := p1 - bn*d;
+  anticlockwise := (dir < 0);
+  cn := PointF(an.y,-an.x)*radius;
+  if not anticlockwise then cn := -cn;
+  c := p3 + cn;
+  result.center := c;
+  result.radius:= PointF(radius,radius);
+  result.startAngleRadCW := arctan2((p3.y-c.y), (p3.x-c.x));
+  result.endAngleRadCW := arctan2((p4.y-c.y), (p4.x-c.x));
+  result.anticlockwise:= anticlockwise;
+end;
+function SvgArcTo(const p0: TPointF; rx, ry, xAngleRadCW: single; largeArc,
+  anticlockwise: boolean; const p1: TPointF): TArcDef;
+var
+    p0p,cp: TPointF;
+    cross1,cross2,lambda: single;
+begin
+  if (rx=0) or (ry=0) or (p0 = p1) then
+  begin
+    result.radius := PointF(0,0);
+    result.xAngleRadCW:= 0;
+    result.anticlockwise := false;
+    result.endAngleRadCW := 0;
+    result.startAngleRadCW:= 0;
+    result.center := p1;
+    exit;
+  end;
+  result.xAngleRadCW := xAngleRadCW;
+  result.anticlockwise := anticlockwise;
+  p0p := AffineMatrixRotationRad(xAngleRadCW)*( (p0-p1)*0.5 );
+  //ensure radius is big enough
+  lambda := sqr(p0p.x/rx) + sqr(p0p.y/ry);
+  if lambda > 1 then
+  begin
+    lambda := sqrt(lambda);
+    rx *= lambda;
+    ry *= lambda;
+  end;
+  result.radius := PointF(rx,ry);
+  //compute center
+  cross2 := sqr(rx*p0p.y) + sqr(ry*p0p.x);
+  cross1 := sqr(rx*ry);
+  if cross1 <= cross2 then
+    cp := PointF(0,0)
+  else
+    cp := sqrt((cross1-cross2)/cross2)*
+       PointF(rx*p0p.y/ry, -ry*p0p.x/rx);
+  if largeArc <> anticlockwise then cp := -cp;
+  result.center := AffineMatrixRotationRad(-xAngleRadCW)*cp +
+                  (p0+p1)*0.5;
+  result.startAngleRadCW := arctan2((p0p.y-cp.y)/ry,(p0p.x-cp.x)/rx);
+  result.endAngleRadCW := arctan2((-p0p.y-cp.y)/ry,(-p0p.x-cp.x)/rx);
+end;
+function ArcStartPoint(const arc: TArcDef): TPointF;
+begin
+  result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.startAngleRadCW)*arc.radius.x,
+                                                       sin(arc.startAngleRadCW)*arc.radius.y) + arc.center;
+end;
+function ArcEndPoint(const arc: TArcDef): TPointF;
+begin
+  result := AffineMatrixRotationRad(-arc.xAngleRadCW)*PointF(cos(arc.endAngleRadCW)*arc.radius.x,
+                                                       sin(arc.endAngleRadCW)*arc.radius.y) + arc.center;
+end;
+function IsLargeArc(const arc: TArcDef): boolean;
+var diff,a1,a2: single;
+begin
+  a1 := arc.startAngleRadCW - floor(arc.startAngleRadCW/(2*Pi))*(2*Pi);
+  a2 := arc.endAngleRadCW - floor(arc.endAngleRadCW/(2*Pi))*(2*Pi);
+  if not arc.anticlockwise then
+    diff := a2 - a1
+  else
+    diff := a1 - a2;
+  result := (diff < 0) or (diff >= Pi);
+end;
+{ TBGRAPath }
+function TBGRAPath.GetSvgString: string;
+const RadToDeg = 180/Pi;
+var savedPos: integer;
+    a: TArcDef;
+    formats: TFormatSettings;
+    lastPos,p1: TPointF;
+    implicitCommand: char;
+  function FloatToString(value: single): string;
+  begin
+    result := FloatToStrF(value,ffGeneral,7,0,formats)+' ';
+  end;
+  function CoordToString(const pt: TPointF): string;
+  begin
+    lastPos := pt;
+    result := FloatToString(pt.x)+FloatToString(pt.y);
+  end;
+  function BoolToString(value: boolean): string;
+  begin
+    if value then
+      result := '1 ' else result := '0 ';
+  end;
+  procedure addCommand(command: char; parameters: string);
+  begin
+    if result <> '' then result += ' '; //optional whitespace
+    if command <> implicitCommand then result += command;
+    result += trim(parameters);
+    if command = 'M' then implicitCommand:= 'L'
+    else if command = 'm' then implicitCommand:= 'l'
+    else if command in['z','Z'] then implicitCommand:= #0
+    else implicitCommand := command;
+  end;
+var param: string;
+begin
+  formats := DefaultFormatSettings;
+  formats.DecimalSeparator := '.';
+  result := '';
+  savedPos:= FDataPos;
+  FDataPos := 0;
+  lastPos := EmptyPointF;
+  implicitCommand := #0;
+  while FDataPos < savedPos do
+  begin
+    case ReadElementType of
+    peMoveTo: addCommand('M',CoordToString(ReadCoord));
+    peLineTo: addCommand('L',CoordToString(ReadCoord));
+    peCloseSubPath: addCommand('z','');
+    peQuadraticBezierTo:
+      begin
+        param := CoordToString(ReadCoord);
+        param += CoordToString(ReadCoord);
+        addCommand('Q',param);
+      end;
+    peCubicBezierTo:
+      begin
+        param := CoordToString(ReadCoord);
+        param += CoordToString(ReadCoord);
+        param += CoordToString(ReadCoord);
+        addCommand('C',param);
+      end;
+    peArc:
+      begin
+        a := ReadArcDef;
+        p1 := ArcStartPoint(a);
+        if isEmptyPointF(lastPos) or (p1 <> lastPos) then
+          addCommand('L',CoordToString(p1));
+        param := CoordToString(a.radius);
+        param += FloatToString(a.xAngleRadCW*RadToDeg);
+        param += BoolToString(IsLargeArc(a));
+        param += BoolToString(not a.anticlockwise);
+        param += CoordToString(ArcEndPoint(a));
+        addCommand('A',param);
+      end;
+    end;
+  end;
+  FDataPos := savedPos;
+end;
+procedure TBGRAPath.SetSvgString(const AValue: string);
+begin
+  resetTransform;
+  beginPath;
+  addPath(AValue);
+end;
+procedure TBGRAPath.addPath(const AValue: string);
+var p: integer;
+    numberError: boolean;
+  function parseFloat: single;
+  var numberStart: integer;
+      errPos: integer;
+  begin
+    while (p <= length(AValue)) and (AValue[p] in[#0..#32,',']) do inc(p);
+    numberStart:= p;
+    if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
+    while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do inc(p);
+    if (p <= length(AValue)) and (AValue[p] in['e','E']) then inc(p);
+    if (p <= length(AValue)) and (AValue[p] in['+','-']) then inc(p);
+    while (p <= length(AValue)) and (AValue[p] in['0'..'9','.']) do inc(p);
+    val(copy(AValue,numberStart,p-numberStart),result,errPos);
+    if errPos <> 0 then numberError := true;
+  end;
+  function parseCoord(relative: boolean): TPointF;
+  begin
+    result := PointF(parseFloat,parseFloat);
+    if relative and not isEmptyPointF(FLastCoord) then result += FLastCoord;
+  end;
+var
+  command,implicitCommand: char;
+  relative: boolean;
+  c1,c2,p1: TPointF;
+  a: TArcDef;
+  largeArc: boolean;
+begin
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
+  p := 1;
+  implicitCommand:= #0;
+  while p <= length(AValue) do
+  begin
+    command := AValue[p];
+    if (command in['0'..'9','.','+','-']) and (implicitCommand <> #0) then
+      command := implicitCommand
+    else
+    begin
+      inc(p);
+    end;
+    relative := (command = lowerCase(command));
+    numberError := false;
+    if upcase(command) in ['L','H','V','C','S','Q','T','A'] then
+      implicitCommand:= command; //by default the command repeats
+    case upcase(command) of
+    'Z': begin
+           closePath;
+           implicitCommand:= #0;
+         end;
+    'M': begin
+           p1 := parseCoord(relative);
+           if not numberError then moveTo(p1);
+           if relative then implicitCommand:= 'l' else
+             implicitCommand:= 'L';
+      end;
+    'L': begin
+           p1 := parseCoord(relative);
+           if not numberError then lineTo(p1);
+      end;
+    'H': begin
+        if not isEmptyPointF(FLastCoord) then p1 := FLastCoord
+        else p1 := PointF(0,0);
+        if relative then p1.x += parseFloat
+        else p1.x := parseFloat;
+        if not numberError then lineTo(p1);
+      end;
+    'V': begin
+        if not isEmptyPointF(FLastCoord) then p1 := FLastCoord
+        else p1 := PointF(0,0);
+        if relative then p1.y += parseFloat
+        else p1.y := parseFloat;
+        if not numberError then lineTo(p1);
+      end;
+    'C': begin
+        c1 := parseCoord(relative);
+        c2 := parseCoord(relative);
+        p1 := parseCoord(relative);
+        if not numberError then bezierCurveTo(c1,c2,p1);
+      end;
+    'S': begin
+        c2 := parseCoord(relative);
+        p1 := parseCoord(relative);
+        if not numberError then smoothBezierCurveTo(c2,p1);
+      end;
+    'Q': begin
+        c1 := parseCoord(relative);
+        p1 := parseCoord(relative);
+        if not numberError then quadraticCurveTo(c1,p1);
+      end;
+    'T': begin
+        p1 := parseCoord(relative);
+        if not numberError then smoothQuadraticCurveTo(p1);
+      end;
+    'A': begin
+        a.radius := parseCoord(false);
+        a.xAngleRadCW := parseFloat*Pi/180;
+        largeArc := parseFloat<>0;
+        a.anticlockwise:= parseFloat=0;
+        p1 := parseCoord(relative);
+        arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y);
+      end;
+    end;
+  end;
+end;
+procedure TBGRAPath.addPath(source: IBGRAPath);
+begin
+  source.copyTo(self);
+end;
+procedure TBGRAPath.NeedSpace(count: integer);
+begin
+  if FDataPos + count > FDataSize then
+  begin
+    FDataSize := FDataSize*2+8;
+    ReAllocMem(FData, FDataSize);
+  end;
+end;
+procedure TBGRAPath.StoreCoord(const pt: TPointF);
+begin
+  NeedSpace(sizeof(single)*2);
+  with FMatrix*pt do
+  begin
+    PSingle(FData+FDataPos)^ := x;
+    PSingle(FData+FDataPos+sizeof(single))^ := y;
+  end;
+  Inc(FDataPos, sizeof(single)*2);
+  FLastCoord := pt;
+end;
+function TBGRAPath.ReadCoord: TPointF;
+begin
+  result := PPointF(FData+FDataPos)^;
+  inc(FDataPos,sizeof(TPointF));
+end;
+procedure TBGRAPath.StoreElementType(value: TBGRAPathElementType);
+begin
+  NeedSpace(sizeof(TBGRAPathElementType));
+  PBGRAPathElementType(FData+FDataPos)^ := value;
+  Inc(FDataPos, sizeof(TBGRAPathElementType));
+  FLastElementType:= value;
+end;
+function TBGRAPath.ReadElementType: TBGRAPathElementType;
+begin
+  result := PBGRAPathElementType(FData+FDataPos)^;
+  inc(FDataPos,sizeof(TBGRAPathElementType));
+end;
+function TBGRAPath.ReadArcDef: TArcDef;
+begin
+  result := PArcDef(FData+FDataPos)^;
+  inc(FDataPos,sizeof(TArcDef));
+end;
+procedure TBGRAPath.RewindFloat;
+begin
+  if FDataPos >= sizeof(single) then dec(FDataPos, sizeof(Single));
+end;
+procedure TBGRAPath.Init;
+begin
+  FData := nil;
+  FDataSize := 0;
+  FDataPos := 0;
+  FLastElementType := peNone;
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
+  FExpectedControlPoint := EmptyPointF;
+  resetTransform;
+end;
+constructor TBGRAPath.Create;
+begin
+  Init;
+end;
+constructor TBGRAPath.Create(ASvgString: string);
+begin
+  Init;
+  SvgString:= ASvgString;
+end;
+destructor TBGRAPath.Destroy;
+begin
+  if Assigned(FData) then
+  begin
+    FreeMem(FData);
+    FData := nil;
+  end;
+  inherited Destroy;
+end;
+procedure TBGRAPath.beginPath;
+begin
+  FDataPos := 0;
+end;
+procedure TBGRAPath.closePath;
+begin
+  if (FLastElementType <> peNone) and (FLastElementType <> peCloseSubPath) then
+  begin
+    StoreElementType(peCloseSubPath);
+    FLastCoord := FStartCoord;
+  end;
+end;
+procedure TBGRAPath.translate(x, y: single);
+begin
+  FMatrix *= AffineMatrixTranslation(x,y);
+end;
+procedure TBGRAPath.resetTransform;
+begin
+  FMatrix := AffineMatrixIdentity;
+  FAngleRadCW := 0;
+  FScale:= 1;
+end;
+procedure TBGRAPath.rotate(angleRadCW: single);
+begin
+  FMatrix *= AffineMatrixRotationRad(-angleRadCW);
+  FAngleRadCW += angleRadCW;
+end;
+procedure TBGRAPath.rotateDeg(angleDeg: single);
+const degToRad = Pi/180;
+begin
+  rotate(angleDeg*degToRad);
+end;
+procedure TBGRAPath.rotate(angleRadCW: single; center: TPointF);
+begin
+  translate(center.x,center.y);
+  rotate(angleRadCW);
+  translate(-center.x,-center.y);
+end;
+procedure TBGRAPath.rotateDeg(angleDeg: single; center: TPointF);
+begin
+  translate(center.x,center.y);
+  rotateDeg(angleDeg);
+  translate(-center.x,-center.y);
+end;
+procedure TBGRAPath.scale(factor: single);
+begin
+  FMatrix *= AffineMatrixScale(factor,factor);
+  FScale *= factor;
+end;
+procedure TBGRAPath.moveTo(x, y: single);
+begin
+  moveTo(PointF(x,y));
+end;
+procedure TBGRAPath.lineTo(x, y: single);
+begin
+  lineTo(PointF(x,y));
+end;
+procedure TBGRAPath.moveTo(const pt: TPointF);
+begin
+  if FLastElementType <> peMoveTo then
+  begin
+    StoreElementType(peMoveTo);
+    StoreCoord(pt);
+  end else
+  begin
+    RewindFloat;
+    RewindFloat;
+    StoreCoord(pt);
+  end;
+  FLastCoord := pt;
+  FStartCoord := FLastCoord;
+end;
+procedure TBGRAPath.lineTo(const pt: TPointF);
+begin
+  if not isEmptyPointF(FLastCoord) then
+  begin
+    StoreElementType(peLineTo);
+    StoreCoord(pt);
+    FLastCoord := pt;
+  end else
+    moveTo(pt);
+end;
+procedure TBGRAPath.polylineTo(const pts: array of TPointF);
+var i: integer;
+begin
+  NeedSpace((sizeof(TBGRAPathElementType)+2*sizeof(single))*length(pts));
+  for i := 0 to high(pts) do with pts[i] do lineTo(x,y);
+end;
+procedure TBGRAPath.quadraticCurveTo(cpx, cpy, x, y: single);
+begin
+  quadraticCurveTo(PointF(cpx,cpy),PointF(x,y));
+end;
+procedure TBGRAPath.quadraticCurveTo(const cp, pt: TPointF);
+begin
+  if not isEmptyPointF(FLastCoord) then
+  begin
+    StoreElementType(peQuadraticBezierTo);
+    StoreCoord(cp);
+    StoreCoord(pt);
+    FLastCoord := pt;
+  end else
+    lineTo(pt);
+  FExpectedControlPoint := pt+(pt-cp);
+end;
+procedure TBGRAPath.bezierCurveTo(cp1x, cp1y, cp2x, cp2y, x, y: single);
+begin
+  bezierCurveTo(PointF(cp1x,cp1y),PointF(cp2x,cp2y),PointF(x,y));
+end;
+procedure TBGRAPath.bezierCurveTo(const cp1, cp2, pt: TPointF);
+begin
+  if isEmptyPointF(FLastCoord) then moveTo(cp1);
+  StoreElementType(peCubicBezierTo);
+  StoreCoord(cp1);
+  StoreCoord(cp2);
+  StoreCoord(pt);
+  FLastCoord := pt;
+  FExpectedControlPoint := pt + (pt-cp2);
+end;
+procedure TBGRAPath.bezierCurve(const curve: TCubicBezierCurve);
+begin
+  moveTo(curve.p1);
+  bezierCurveTo(curve.c1,curve.c2,curve.p2);
+end;
+procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single);
+begin
+  smoothBezierCurveTo(PointF(cp2x,cp2y),PointF(x,y));
+end;
+procedure TBGRAPath.smoothBezierCurveTo(const cp2, pt: TPointF);
+begin
+  if (FLastElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedControlPoint) then
+    bezierCurveTo(FExpectedControlPoint,cp2,pt)
+  else if not isEmptyPointF(FLastCoord) then
+    bezierCurveTo(FLastCoord,cp2,pt)
+  else
+    bezierCurveTo(cp2,cp2,pt);
+end;
+procedure TBGRAPath.quadraticCurve(const curve: TQuadraticBezierCurve);
+begin
+  moveTo(curve.p1);
+  quadraticCurveTo(curve.c,curve.p2);
+end;
+procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single);
+begin
+  smoothQuadraticCurveTo(PointF(x,y));
+end;
+procedure TBGRAPath.smoothQuadraticCurveTo(const pt: TPointF);
+begin
+  if (FLastElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedControlPoint) then
+    quadraticCurveTo(FExpectedControlPoint,pt)
+  else if not isEmptyPointF(FLastCoord) then
+    quadraticCurveTo(FLastCoord,pt)
+  else
+    quadraticCurveTo(pt,pt);
+end;
+procedure TBGRAPath.rect(x, y, w, h: single);
+begin
+  moveTo(x,y);
+  lineTo(x+w,y);
+  lineTo(x+w,y+h);
+  lineTo(x,y+h);
+  closePath;
+end;
+procedure TBGRAPath.roundRect(x, y, w, h, radius: single);
+begin
+  if radius <= 0 then
+  begin
+    rect(x,y,w,h);
+    exit;
+  end;
+  if (w <= 0) or (h <= 0) then exit;
+  if radius*2 > w then radius := w/2;
+  if radius*2 > h then radius := h/2;
+  moveTo(x+radius,y);
+  arcTo(PointF(x+w,y),PointF(x+w,y+h), radius);
+  arcTo(PointF(x+w,y+h),PointF(x,y+h), radius);
+  arcTo(PointF(x,y+h),PointF(x,y), radius);
+  arcTo(PointF(x,y),PointF(x+w,y), radius);
+  closePath;
+end;
+procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single;
+  anticlockwise: boolean);
+begin
+  arc(cx,cy,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise);
+end;
+procedure TBGRAPath.arc(cx, cy, radius, startAngleRadCW, endAngleRadCW: single);
+begin
+  arc(cx,cy,radius,startAngleRadCW,endAngleRadCW,false);
+end;
+procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single;
+  anticlockwise: boolean);
+const degToRad = Pi/180;
+begin
+  arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad,anticlockwise);
+end;
+procedure TBGRAPath.arcDeg(cx, cy, radius, startAngleDeg, endAngleDeg: single);
+const degToRad = Pi/180;
+begin
+  arc(cx,cy,radius,(startAngleDeg-90)*degToRad,(endAngleDeg-90)*degToRad);
+end;
+procedure TBGRAPath.arcTo(x1, y1, x2, y2, radius: single);
+begin
+  arcTo(PointF(x1,y1), PointF(x2,y2), radius);
+end;
+procedure TBGRAPath.arcTo(const p1, p2: TPointF; radius: single);
+var p0 : TPointF;
+begin
+  if isEmptyPointF(FLastCoord) then
+    p0 := p1 else p0 := FLastCoord;
+  arc(Html5ArcTo(p0,p1,p2,radius));
+end;
+procedure TBGRAPath.arc(const arcDef: TArcDef);
+var transformedArc: TArcDef;
+begin
+  if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then
+    lineTo(arcDef.center)
+  else
+  begin
+    if isEmptyPointF(FLastCoord) then
+      moveTo(ArcStartPoint(arcDef));
+    StoreElementType(peArc);
+    NeedSpace(sizeof(TArcDef));
+    transformedArc.anticlockwise := arcDef.anticlockwise;
+    transformedArc.startAngleRadCW := arcDef.startAngleRadCW;
+    transformedArc.endAngleRadCW := arcDef.endAngleRadCW;
+    transformedArc.center := FMatrix*arcDef.center;
+    transformedArc.radius := arcDef.radius*FScale;
+    transformedArc.xAngleRadCW := arcDef.xAngleRadCW+FAngleRadCW;
+    PArcDef(FData+FDataPos)^ := transformedArc;
+    inc(FDataPos, sizeof(TArcDef));
+    FLastCoord := ArcEndPoint(arcDef);
+  end;
+end;
+procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW,
+  endAngleRadCW: single);
+begin
+  arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false));
+end;
+procedure TBGRAPath.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
+  anticlockwise: boolean);
+begin
+  arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise));
+end;
+procedure TBGRAPath.arcTo(rx, ry, xAngleRadCW: single; largeArc,
+  anticlockwise: boolean; x, y: single);
+begin
+  if isEmptyPointF(FLastCoord) then
+    moveTo(x,y)
+  else
+    arc(SvgArcTo(FLastCoord, rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y)));
+end;
+procedure TBGRAPath.copyTo(dest: IBGRAPath);
+var savedPos: integer;
+    cp1,cp2,p1: TPointF;
+begin
+  savedPos:= FDataPos;
+  FDataPos := 0;
+  while FDataPos < savedPos do
+  begin
+    case ReadElementType of
+    peMoveTo: dest.moveTo(ReadCoord);
+    peLineTo: dest.lineTo(ReadCoord);
+    peCloseSubPath: dest.closePath;
+    peQuadraticBezierTo:
+      begin
+        cp1 := ReadCoord;
+        p1 := ReadCoord;
+        dest.quadraticCurveTo(cp1,p1);
+      end;
+    peCubicBezierTo:
+      begin
+        cp1 := ReadCoord;
+        cp2 := ReadCoord;
+        p1 := ReadCoord;
+        dest.bezierCurveTo(cp1,cp2,p1);
+      end;
+    peArc: dest.arc(ReadArcDef);
+    end;
+  end;
+  FDataPos := savedPos;
+end;
+function TBGRAPath.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 TBGRAPath._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+function TBGRAPath._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
 end.

GraphicTest/Packages/bgrabitmap/bgrapen.pas

-              r452
+              r472
   TBGRAPolyLineOption = (plRoundCapOpen, //specifies that the line ending is opened
                          plCycle,        //specifies that it is a polygon
+                         plAutoCycle);   //specifies that a cycle must be used if the last point is the first point
+                         plAutoCycle,    //specifies that a cycle must be used if the last point is the first point
+                         plNoStartCap,
+                         plNoEndCap);
   TBGRAPolyLineOptions = set of TBGRAPolyLineOption;
+  TComputeArrowHeadProc = function(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF of object;
 { Draw a polyline with specified parameters. If a scanner is specified, it is used as a texture.
 …
 procedure BGRAPolyLine(bmp: TBGRACustomBitmap; const linepts: array of TPointF;
      width: single; pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
      options: TBGRAPolyLineOptions; scan: IBGRAScanner = nil; miterLimit: single = 2);
+     options: TBGRAPolyLineOptions; scan: IBGRAScanner = nil; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; arrowStartPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; arrowEndPos: single = 0);
 { Compute the path for a polyline }
 function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single;
           pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
           options: TBGRAPolyLineOptions; miterLimit: single = 2): ArrayOfTPointF;
+          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; wantedStartArrowPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; WantedEndArrowPos: single = 0): ArrayOfTPointF;
 { Compute the path for a poly-polyline }
 function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; width: single;
           pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
           options: TBGRAPolyLineOptions; miterLimit: single = 2): ArrayOfTPointF;
+          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; arrowStartPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; arrowEndPos: single = 0): ArrayOfTPointF;
 {--------------------- Pixel line procedures --------------------------}
 …
 //aliased version
 procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean);
+procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency);
 procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean);
 //antialiased version
 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
   c: TBGRAPixel; DrawLastPixel: boolean);
+procedure BGRADrawLineAntialias({%H-}dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
+  c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean = false);
 procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
   calpha: byte; DrawLastPixel: boolean);
 …
 //antialiased version with bicolor dashes (to draw a frame)
 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
   c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
+  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean = false);
 //length added to ensure accepable alpha join (using TBGRAMultishapeFiller is still better)
 …
 procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
+  c: TBGRAPixel; DrawLastPixel: boolean);
+  c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
+var
+  Y, X: integer;
+  DX, DY, SX, SY, E: integer;
+  PixelProc: procedure (x, y: int32or64; c: TBGRAPixel) of object;
+begin
+  if (Y1 = Y2) then
+  begin
+    if (X1 = X2) then
+    begin
+      if DrawLastPixel then
+        dest.DrawPixel(X1, Y1, c, ADrawMode);
+    end else
+    begin
+      if not DrawLastPixel then
+      begin
+        if X2 > X1 then dec(X2) else inc(X2);
+      end;
+      dest.HorizLine(X1,Y1,X2,c, ADrawMode);
+    end;
+    Exit;
+  end else
+  if (X1 = X2) then
+  begin
+    if not DrawLastPixel then
+    begin
+      if Y2 > Y1 then dec(Y2) else inc(Y2);
+    end;
+    dest.VertLine(X1,Y1,Y2,c, ADrawMode);
+  end;
+  DX := X2 - X1;
+  DY := Y2 - Y1;
+  if (ADrawMode = dmSetExceptTransparent) and (c.alpha <> 255) then exit else
+  if c.alpha = 0 then
+  begin
+    if ADrawMode in[dmDrawWithTransparency,dmLinearBlend] then exit;
+    if (ADrawMode = dmXor) and (DWord(c)=0) then exit;
+  end;
+  case ADrawMode of
+  dmDrawWithTransparency: PixelProc := @dest.DrawPixel;
+  dmXor: PixelProc := @dest.XorPixel;
+  dmLinearBlend: PixelProc := @dest.FastBlendPixel;
+  else
+    PixelProc := @dest.SetPixel;
+  end;
+  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
+      PixelProc(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
+      PixelProc(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
+    PixelProc(X2, Y2, c);
+end;
+procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2,
+  y2: integer; alpha: byte; DrawLastPixel: boolean);
 var
   Y, X: integer;
 …
   begin
     if DrawLastPixel then
       dest.DrawPixel(X1, Y1, c);
+      dest.ErasePixel(X1, Y1, alpha);
     Exit;
   end;
 …
     while X <> X2 do
     begin
       dest.DrawPixel(X, Y, c);
+      dest.ErasePixel(X, Y, alpha);
       if E >= 0 then
       begin
 …
     while Y <> Y2 do
     begin
       dest.DrawPixel(X, Y, c);
+      dest.ErasePixel(X, Y, alpha);
       if E >= 0 then
       begin
 …
   if DrawLastPixel then
     dest.DrawPixel(X2, Y2, c);
+    dest.ErasePixel(X2, Y2, alpha);
 end;
 procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2,
   y2: integer; alpha: byte; DrawLastPixel: boolean);
 var
   Y, X: integer;
+procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
+  c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean);
+var
+  Y, X:  integer;
   DX, DY, SX, SY, E: integer;
+  alpha: NativeUInt;
+  pixelproc: procedure(x,y: int32or64; c: TBGRAPixel) of object;
 begin
+  if LinearBlend then
+    pixelproc := @dest.FastBlendPixel
+  else
+    pixelproc := @dest.DrawPixel;
   if (Y1 = Y2) and (X1 = X2) then
   begin
     if DrawLastPixel then
       dest.ErasePixel(X1, Y1, alpha);
+      pixelproc(X1, Y1, c);
     Exit;
   end;
 …
   X := X1;
   Y := Y1;
   if DX > DY then
   begin
     E := DY - DX shr 1;
+    E := 0;
     while X <> X2 do
     begin
+      dest.ErasePixel(X, Y, alpha);
+      if E >= 0 then
+      alpha := c.alpha * E div DX;
+      pixelproc(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
+      pixelproc(X, Y + SY, BGRA(c.red, c.green, c.blue, alpha));
+      Inc(E, DY);
+      if E >= DX then
       begin
         Inc(Y, SY);
 …
       end;
       Inc(X, SX);
-      Inc(E, DY);
     end;
   end
   else
   begin
     E := DX - DY shr 1;
+    E := 0;
     while Y <> Y2 do
     begin
+      dest.ErasePixel(X, Y, alpha);
+      if E >= 0 then
+      alpha := c.alpha * E div DY;
+      pixelproc(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
+      pixelproc(X + SX, Y, BGRA(c.red, c.green, c.blue, alpha));
+      Inc(E, DX);
+      if E >= DY then
       begin
         Inc(X, SX);
 …
       end;
       Inc(Y, SY);
+      Inc(E, DX);
+    end;
+  end;
+    end;
+  end;
   if DrawLastPixel then
     dest.ErasePixel(X2, Y2, alpha);
+    pixelproc(X2, Y2, c);
 end;
 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
   c: TBGRAPixel; DrawLastPixel: boolean);
+procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2,
+  y2: integer; calpha: byte; DrawLastPixel: boolean);
 var
   Y, X:  integer;
   DX, DY, SX, SY, E: integer;
   alpha: single;
+  alpha: NativeUInt;
 begin
 …
   begin
     if DrawLastPixel then
       dest.DrawPixel(X1, Y1, c);
+      dest.ErasePixel(X1, Y1, calpha);
     Exit;
   end;
 …
     while X <> X2 do
     begin
+      alpha := 1 - E / DX;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
+      dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
+        round(c.alpha * sqrt(1 - alpha))));
+      alpha := calpha * E div DX;
+      dest.ErasePixel(X, Y, calpha - alpha);
+      dest.ErasePixel(X, Y + SY, alpha);
       Inc(E, DY);
       if E >= DX then
 …
     while Y <> Y2 do
     begin
+      alpha := 1 - E / DY;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
+      dest.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
+    dest.DrawPixel(X2, Y2, c);
+end;
+procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2,
+  y2: integer; calpha: byte; 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
+      dest.ErasePixel(X1, Y1, calpha);
+    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;
+      dest.ErasePixel(X, Y, round(calpha * sqrt(alpha)));
+      dest.ErasePixel(X, Y + SY, round(calpha * 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;
+      dest.ErasePixel(X, Y, round(calpha * sqrt(alpha)));
+      dest.ErasePixel(X + SX, Y, round(calpha * sqrt(1 - alpha)));
+      alpha := calpha * E div DY;
+      dest.ErasePixel(X, Y, calpha - alpha);
+      dest.ErasePixel(X + SX, Y, alpha);
       Inc(E, DX);
       if E >= DY then
 …
 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
   c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
+  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean);
 var
   Y, X:  integer;
   DX, DY, SX, SY, E: integer;
   alpha: single;
+  alpha: NativeUInt;
   c:     TBGRAPixel;
 begin
 …
   if DashLen <= 0 then
   begin
     BGRADrawLineAntialias(dest,x1,y1,x2,y2,MergeBGRA(c1,c2),DrawLastPixel);
+    BGRADrawLineAntialias(dest,x1,y1,x2,y2,MergeBGRA(c1,c2),DrawLastPixel,LinearBlend);
     exit;
   end;
 …
     while X <> X2 do
     begin
+      alpha := 1 - E / DX;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
+      dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
+        round(c.alpha * sqrt(1 - alpha))));
+      alpha := c.alpha * E div DX;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
+      dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue, alpha));
       Inc(E, DY);
       if E >= DX then
 …
     while Y <> Y2 do
     begin
+      alpha := 1 - E / DY;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
+      dest.DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
+        round(c.alpha * sqrt(1 - alpha))));
+      alpha := c.alpha * E div DY;
+      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
+      dest.DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue, alpha));
       Inc(E, DX);
       if E >= DY then
 …
   procedure AddPt(pt: TPointF);
   begin
+    if nbStyled = length(styledPts) then
+      setlength(styledPts,nbStyled*2+4);
+    styledPts[nbStyled] := pt;
+    inc(nbStyled);
+    if (nbStyled = 0) or (pt <> styledPts[nbStyled-1]) then
+    begin
+      if nbStyled = length(styledPts) then
+        setlength(styledPts,nbStyled*2+4);
+      styledPts[nbStyled] := pt;
+      inc(nbStyled);
+    end;
   end;
 …
 procedure BGRAPolyLine(bmp: TBGRACustomBitmap; const linepts: array of TPointF; width: single;
           pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
           options: TBGRAPolyLineOptions; scan: IBGRAScanner; miterLimit: single);
+          options: TBGRAPolyLineOptions; scan: IBGRAScanner; miterLimit: single; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single);
 var
   widePolylinePoints: ArrayOfTPointF;
 begin
   widePolylinePoints := ComputeWidePolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit);
+  widePolylinePoints := ComputeWidePolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
   if scan <> nil then
     bmp.FillPolyAntialias(widePolylinePoints,scan)
 …
 function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single;
           pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
+          options: TBGRAPolyLineOptions; miterLimit: single): ArrayOfTPointF;
+var
+          options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; wantedStartArrowPos: single; arrowEnd: TComputeArrowHeadProc; wantedEndArrowPos: single): ArrayOfTPointF;
+var
+  startArrowPos, startArrowDir, endArrowPos, endArrowDir: TPointF;
+  startArrowLinePos, endArrowLinePos: single;
   borders : array of record
               leftSide,rightSide: TLineDef;
 …
               pts[lastPointIndex] - borders[lastPointIndex-1].leftDir);
     if (lastPointIndex = high(pts)) and (linecap = pecRound) then
+    if (lastPointIndex = high(pts)) and (linecap = pecRound) and not (plNoEndCap in options) then
     begin
       if not (plRoundCapOpen in options) then
 …
       end;
       FlushLine(-1);
+    end;
+  end;
+  procedure FinalizeArray;
+  var arrowStartData, arrowEndData: ArrayOfTPointF;
+    finalNb,i,delta: integer;
+    hasStart,hasEnd: boolean;
+  begin
+    if assigned(arrowStart) and not isEmptyPointF(startArrowPos) then
+      arrowStartData := arrowStart(startArrowPos, startArrowDir, width, startArrowLinePos)
+    else
+      arrowStartData := nil;
+    if assigned(arrowEnd) and not isEmptyPointF(endArrowPos) then
+      arrowEndData := arrowEnd(endArrowPos, endArrowDir, width, endArrowLinePos)
+    else
+      arrowEndData := nil;
+    hasStart := length(arrowStartData)>0;
+    hasEnd := length(arrowEndData)>0;
+    finalNb := NbPolyAcc;
+    if hasStart then
+    begin
+      delta := length(arrowStartData)+1;
+      finalNb += delta;
+    end else delta := 0;
+    if hasEnd then finalNb += length(arrowEndData)+1;
+    SetLength(Result, finalNb);
+    if hasStart then
+    begin
+      for i := NbPolyAcc-1 downto 0 do
+        result[i+delta] := result[i];
+      result[delta-1] := EmptyPointF;
+      for i := 0 to high(arrowStartData) do
+        result[i] := arrowStartData[i];
+    end;
+    if hasEnd then
+    begin
+      delta += NbPolyAcc+1;
+      result[delta-1] := EmptyPointF;
+      for i := 0 to high(arrowEndData) do
+        result[i+delta] := arrowEndData[i];
     end;
   end;
 …
   ShouldFlushLine, HasLittleBorder, NormalRestart: Boolean;
   pt1,pt2,pt3,pt4: TPointF;
+  linePos: single;
+  startArrowDone,endArrowDone: boolean;
 begin
   Result := nil;
   if length(linepts)=0 then exit;
+  if (length(linepts)=0) or (width = 0) then exit;
   if IsClearPenStyle(penstyle) then exit;
   for i := 0 to high(linepts) do
 …
   if (plAutoCycle in options) and (length(linepts) >= 2) and (linepts[0]=linepts[high(linepts)]) then
     options := options + [plCycle];
+  if plNoEndCap in options then options := options - [plRoundCapOpen];
   hw := width / 2;
 …
     exit;
   end;
+  startArrowDir := EmptyPointF;
+  startArrowPos := EmptyPointF;
+  endArrowDir := EmptyPointF;
+  endArrowPos := EmptyPointF;
+  startArrowDone := @arrowStart = nil;
+  endArrowDone := @arrowEnd = nil;
   //init computed points arrays
 …
   NbPolyAcc := 0;
+  if not endArrowDone then
+  begin
+    wantedEndArrowPos:= -wantedEndArrowPos*width;
+    linePos := 0;
+    for i := high(pts) downto 1 do
+    begin
+      dir := pts[i-1]-pts[i];
+      len := sqrt(dir*dir);
+      dir *= 1/len;
+      if not endArrowDone and (linePos+len >= wantedEndArrowPos) then
+      begin
+        endArrowPos := pts[i];
+        endArrowDir := -dir;
+        endArrowLinePos := -linePos/width;
+        endArrowDone := true;
+        break;
+      end;
+      linePos += len;
+    end;
+  end;
+  wantedStartArrowPos:= -wantedStartArrowPos*width;
+  linePos := 0;
   //compute borders
   setlength(borders, length(pts)-1);
 …
     len := sqrt(dir*dir);
     dir *= 1/len;
+    if (linecap = pecSquare) and ((i=0) or (i=high(pts)-1)) then //for square cap, just start and end further
+    if not startArrowDone and (linePos+len >= wantedStartArrowPos) then
+    begin
+      startArrowPos := pts[i];
+      startArrowDir := -dir;
+      startArrowLinePos := -linePos/width;
+      startArrowDone := true;
+    end;
+    if (linecap = pecSquare) and ((not (plNoStartCap in options) and (i=0)) or
+      (not (plNoEndCap in options) and (i=high(pts)-1))) then //for square cap, just start and end further
     begin
       if i=0 then
 …
       dir *= 1/len;
     end else
     if (linecap = pecRound) and (i=0) and not (plCycle in options) then
+    if not (plNoStartCap in options) and (linecap = pecRound) and (i=0) and not (plCycle in options) then
       AddRoundCap(pts[0], -dir ,true);
 …
     borders[i].rightSide.origin := pts[i] - borders[i].leftDir;
     borders[i].rightSide.dir := dir;
+    linePos += len;
   end;
 …
     FlushLine(high(pts));
   SetLength(Result, NbPolyAcc);
+  FinalizeArray;
 end;
 …
   width: single; pencolor: TBGRAPixel; linecap: TPenEndCap;
   joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
   options: TBGRAPolyLineOptions; miterLimit: single): ArrayOfTPointF;
+  options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single): ArrayOfTPointF;
 var
 …
       for j := startIndex to endIndexP1-1 do
         subPts[j-startIndex] := linepts[j];
       tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit);
+      tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
       if length(results) = nbresults then
         setlength(results,(nbresults+1)*2);

GraphicTest/Packages/bgrabitmap/bgrapolygon.pas

-              r452
+              r472
 { This unit contains polygon drawing functions and spline functions.
   Shapes are drawn using a TFillShapeInfo object, which calculates the
+  Shapes are drawn using a TBGRACustomFillInfo object, which calculates the
   intersection of an horizontal line and the polygon.
   Various shapes are handled :
+  - TFillPolyInfo : polygon
+  - TFillPolyInfo : polygon scanned in any order
+  - TOnePassFillPolyInfo : polygon scanned from top to bottom
   - TFillEllipseInfo : ellipse
   - TFillBorderEllipseInfo : ellipse border
 …
   Classes, SysUtils, Graphics, BGRABitmapTypes, BGRAFillInfo;
 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;
+procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false);
+procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
+  scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false);
+procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
   c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
 …
     nbShapes: integer;
     shapes: array of record
         info: TFillShapeInfo;
+        info: TBGRACustomFillInfo;
         internalInfo: boolean;
         texture: IBGRAScanner;
 …
         bounds: TRect;
       end;
     procedure AddShape(AInfo: TFillShapeInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
+    procedure AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
     function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean;
   public
 …
     constructor Create;
     destructor Destroy; override;
     procedure AddShape(AShape: TFillShapeInfo; AColor: TBGRAPixel);
     procedure AddShape(AShape: TFillShapeInfo; ATexture: IBGRAScanner);
+    procedure AddShape(AShape: TBGRACustomFillInfo; AColor: TBGRAPixel);
+    procedure AddShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner);
     procedure AddPolygon(const points: array of TPointF; AColor: TBGRAPixel);
     procedure AddPolygon(const points: array of TPointF; 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);
+    procedure Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency);
   end;
 …
   scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode);
 procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
   c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean);
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean = false);
 procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; points: array of TPointF;
   scan: IBGRAScanner; NonZeroWinding: boolean);
+  scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false);
 procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
   c: TBGRAPixel; EraseMode: boolean);
+  c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
 procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
   scan: IBGRAScanner);
+  scan: IBGRAScanner; LinearBlend: boolean = false);
 procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
   c: TBGRAPixel; EraseMode: boolean);
+  c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
 procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
   scan: IBGRAScanner);
+  scan: IBGRAScanner; LinearBlend: boolean = false);
 procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
   options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+  options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
 procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
   options: TRoundRectangleOptions; scan: IBGRAScanner);
+  options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false);
 procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
   options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+  options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
 procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
   options: TRoundRectangleOptions; scan: IBGRAScanner);
+  options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false);
 procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
 …
 uses Math, BGRABlend, BGRAGradientScanner, BGRATransform;
 procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
   c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean);
+procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
+  c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
 var
   inter:   array of TIntersectionInfo;
 …
   density: PDensity;
+  xb, yb, yc, i, j: integer;
+  xb, yb, yc, i: integer;
+  tempDensity: UInt32or64;
   x1, x2, x1b,x2b: single;
 …
       curdens: single;
       pdens: pdensity;
+      newvalue: Int32or64;
   begin
     if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then
 …
       if ix1 = ix2 then
+        (density + (ix1 - minx))^ -= round((x2 - x1)*(density1+density2)/2)
+      begin
+        newValue := (density + (ix1 - minx))^ - round((x2 - x1)*(density1+density2)/2);
+        if newValue < 0 then newValue := 0;
+        if newValue > 256 then newValue := 256;
+        (density + (ix1 - minx))^ := newValue
+      end
       else
       begin
+        (density + (ix1 - minx))^ := max(0, (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) );
+        newValue := (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) ;
+        if newValue < 0 then newValue := 0;
+        if newValue > 256 then newValue := 256;
+        (density + (ix1 - minx))^ := newValue;
         if (ix2 <= maxx) then
+          (density + (ix2 - minx))^ := max(0, (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2) );
+        begin
+          newValue := (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2);
+          if newValue < 0 then newValue := 0;
+          if newValue > 256 then newValue := 256;
+          (density + (ix2 - minx))^ := newValue;
+        end;
       end;
       if ix2 > ix1 + 1 then
 …
         for n := ix2-1-(ix1+1) downto 0 do
         begin
+          pdens^ -= round(curdens);
+          newValue := pdens^ - round(curdens);
+          if newValue < 0 then newValue := 0;
+          if newValue > 256 then newValue := 256;
+          pdens^ := newValue;
           curdens += slope;
           inc(pdens);
 …
     end;
+    if optimised then
+      {$i renderdensity256.inc}
+    else
+      {$define PARAM_ANTIALIASINGFACTOR}
+      {$i renderdensity256.inc}
+    if LinearBlend then
+    begin
+      if optimised then
+        {$define PARAM_LINEARANTIALIASING}
+        {$i renderdensity256.inc}
+      else
+        {$define PARAM_LINEARANTIALIASING}
+        {$define PARAM_ANTIALIASINGFACTOR}
+        {$i renderdensity256.inc}
+    end else
+    begin
+      if optimised then
+        {$i renderdensity256.inc}
+      else
+        {$define PARAM_ANTIALIASINGFACTOR}
+        {$i renderdensity256.inc}
+    end;
   end;
 …
 end;
 procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TFillShapeInfo;
+procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
   c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
 var
 …
     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;
+      x1 := inter[i + i].interX+AliasingOfs.X;
+      x2 := inter[i + i+ 1].interX+AliasingOfs.X;
       if x1 <> x2 then
 …
 procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap;
   shapeInfo: TFillShapeInfo; scan: IBGRAScanner; NonZeroWinding: boolean);
 begin
   FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding);
+  shapeInfo: TBGRACustomFillInfo; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
+begin
+  FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding,LinearBlend);
 end;
 …
   c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode);
 var
   info: TFillPolyInfo;
+  info: TCustomFillPolyInfo;
 begin
   if length(points) < 3 then
     exit;
   info := TFillPolyInfo.Create(points);
+  info := TOnePassFillPolyInfo.Create(points);
   FillShapeAliased(bmp, info, c, EraseMode, nil, NonZeroWinding, drawmode);
   info.Free;
 …
   points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode);
 var
   info: TFillPolyInfo;
+  info: TCustomFillPolyInfo;
 begin
   if length(points) < 3 then
     exit;
   info := TFillPolyInfo.Create(points);
+  info := TOnePassFillPolyInfo.Create(points);
   FillShapeAliased(bmp, info, BGRAPixelTransparent,False,scan, NonZeroWinding, drawmode);
   info.Free;
 …
 procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
   c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean);
 var
   info: TFillPolyInfo;
+  c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean);
+var
+  info: TCustomFillPolyInfo;
 begin
   if length(points) < 3 then
     exit;
   info := TFillPolyInfo.Create(points);
   FillShapeAntialias(bmp, info, c, EraseMode, nil, NonZeroWinding);
+  info := TOnePassFillPolyInfo.Create(points);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, NonZeroWinding, LinearBlend);
   info.Free;
 end;
 procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap;
+  points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean
+  );
+var
+  info: TFillPolyInfo;
+  points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
+var
+  info: TCustomFillPolyInfo;
 begin
   if length(points) < 3 then
     exit;
   info := TFillPolyInfo.Create(points);
   FillShapeAntialiasWithTexture(bmp, info, scan, NonZeroWinding);
+  info := TOnePassFillPolyInfo.Create(points);
+  FillShapeAntialiasWithTexture(bmp, info, scan, NonZeroWinding, LinearBlend);
   info.Free;
 end;
 procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
   c: TBGRAPixel; EraseMode: boolean);
+  c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean);
 var
   info: TFillEllipseInfo;
 …
   info := TFillEllipseInfo.Create(x, y, rx, ry);
   FillShapeAntialias(bmp, info, c, EraseMode, nil, False);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
   info.Free;
 end;
 procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
   ry: single; scan: IBGRAScanner);
+  ry: single; scan: IBGRAScanner; LinearBlend: boolean);
 var
   info: TFillEllipseInfo;
 …
   info := TFillEllipseInfo.Create(x, y, rx, ry);
   FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
   info.Free;
 end;
 procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
   c: TBGRAPixel; EraseMode: boolean);
+  c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean);
 var
   info: TFillBorderEllipseInfo;
 …
     exit;
   info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
   FillShapeAntialias(bmp, info, c, EraseMode, nil, False);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
   info.Free;
 end;
 procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
   ry, w: single; scan: IBGRAScanner);
+  ry, w: single; scan: IBGRAScanner; LinearBlend: boolean);
 var
   info: TFillBorderEllipseInfo;
 …
     exit;
   info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
   FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
   info.Free;
 end;
 …
 { TBGRAMultishapeFiller }
 procedure TBGRAMultishapeFiller.AddShape(AInfo: TFillShapeInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
+procedure TBGRAMultishapeFiller.AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
 begin
   if length(shapes) = nbShapes then
 …
 end;
 procedure TBGRAMultishapeFiller.AddShape(AShape: TFillShapeInfo; AColor: TBGRAPixel);
+procedure TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo; AColor: TBGRAPixel);
 begin
   AddShape(AShape,False,nil,nil,AColor);
 end;
 procedure TBGRAMultishapeFiller.AddShape(AShape: TFillShapeInfo;
+procedure TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo;
   ATexture: IBGRAScanner);
 begin
 …
 begin
   if length(points) <= 2 then exit;
   AddShape(TFillPolyInfo.Create(points),True,nil,nil,AColor);
+  AddShape(TOnePassFillPolyInfo.Create(points),True,nil,nil,AColor);
 end;
 …
 begin
   if length(points) <= 2 then exit;
   AddShape(TFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent);
+  AddShape(TOnePassFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent);
 end;
 …
 begin
   grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
   AddShape(TFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
+  AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
 end;
 …
 begin
   mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
   AddShape(TFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent);
+  AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent);
 end;
 …
 begin
   persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
   AddShape(TFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent);
+  AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent);
 end;
 …
 end;
 procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap);
+procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency);
 var
   shapeRow: array of record
 …
       procedure AddSegment(xa,xb: single);
       var nb: PInteger;
-          prevNb,k: integer;
       begin
         nb := @shapeRow[dest].nbinter;
         if length(shapeRow[dest].inter) < nb^+2 then
+          setlength(shapeRow[dest].inter, nb^*2+2);
+        with shapeRow[dest] do
         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;
+          if inter[nb^] = nil then inter[nb^] := shapes[dest].info.CreateIntersectionInfo;
+          inter[nb^].interX := xa;
+          if inter[nb^+1] = nil then inter[nb^+1] := shapes[dest].info.CreateIntersectionInfo;
+          inter[nb^+1].interX := xb;
         end;
-        shapeRow[dest].inter[nb^].interX := xa;
-        shapeRow[dest].inter[nb^+1].interX := xb;
         inc(nb^,2);
       end;
 …
 var
     AliasingOfs: TPointF;
+    useAA: boolean;
   procedure AddOneLineDensity(cury: single);
 …
       begin
         //fill density
         if not Antialiasing then
+        if not useAA then
         begin
           for i := 0 to nbinter div 2 - 1 do
 …
 begin
   if nbShapes = 0 then exit;
+  useAA := Antialiasing and (ADrawMode in [dmDrawWithTransparency,dmLinearBlend]);
   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,
+    if useAA then
+      FillShapeAntialias(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,FillMode = fmWinding, ADrawMode=dmLinearBlend) else
+      FillShapeAliased(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,FillMode = fmWinding, ADrawMode,
         AliasingIncludeBottomRight);
     exit;
 …
     end;
     If Antialiasing then
+    If useAA then
     begin
       //precision scan
 …
       FillChar(sums[rowminx-minx],(rowmaxx-rowminx+1)*sizeof(sums[0]),0);
       if Antialiasing then
+      if useAA then
         {$define PARAM_ANTIALIASINGFACTOR}
         {$i multishapeline.inc}
 …
       xb := rowminx;
       nextSum := @sums[xb-minx];
+      while xb <= rowmaxx do
+      begin
+        curSum := nextSum;
+        inc(nextSum);
+        with curSum^ do
+        begin
+          if sumA <> 0 then
+      case ADrawMode of
+        dmDrawWithTransparency:
+          while xb <= rowmaxx do
           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
+            curSum := nextSum;
+            inc(nextSum);
+            with curSum^ do
             begin
+              inc(xb);
+              inc(nextSum);
+              inc(count);
+              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
+                  DrawExpandedPixelInlineNoAlphaCheck(pdest,ec,sumA) else
+                   DrawExpandedPixelsInline(pdest, ec, count );
+                inc(pdest,count-1);
+              end;
             end;
+            if count = 1 then
+              DrawExpandedPixelInlineWithAlphaCheck(pdest,ec) else
+               DrawExpandedPixelsInline(pdest, ec, count );
+            inc(pdest,count-1);
+            inc(xb);
+            inc(pdest);
           end;
+        end;
+        inc(xb);
+        inc(pdest);
+        dmLinearBlend:
+          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
+                  DrawPixelInlineNoAlphaCheck(pdest,GammaCompression(ec)) else
+                   DrawPixelsInline(pdest, GammaCompression(ec), count );
+                inc(pdest,count-1);
+              end;
+            end;
+            inc(xb);
+            inc(pdest);
+          end;
+        dmXor:
+          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;
+                XorInline(pdest,GammaCompression(ec),count);
+                inc(pdest,count-1);
+              end;
+            end;
+            inc(xb);
+            inc(pdest);
+          end;
+        dmSet:
+          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;
+                FillInline(pdest,GammaCompression(ec),count);
+                inc(pdest,count-1);
+              end;
+            end;
+            inc(xb);
+            inc(pdest);
+          end;
+        dmSetExceptTransparent:
+          while xb <= rowmaxx do
+          begin
+            curSum := nextSum;
+            inc(nextSum);
+            with curSum^ do
+            begin
+              if sumA >= 255 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;
+                FillInline(pdest,GammaCompression(ec),count);
+                inc(pdest,count-1);
+              end;
+            end;
+            inc(xb);
+            inc(pdest);
+          end;
       end;
     end;
 …
 procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2,
   rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean);
+  rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean);
 var
   info: TFillRoundRectangleInfo;
 …
   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);
+  FillShapeAntialias(bmp, info, c, EraseMode,nil, False, LinearBlend);
   info.Free;
 end;
 …
 procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
   y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions;
   scan: IBGRAScanner);
+  scan: IBGRAScanner; LinearBlend: boolean);
 var
   info: TFillRoundRectangleInfo;
 …
   if (x1 = x2) or (y1 = y2) then exit;
   info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options);
   FillShapeAntialiasWithTexture(bmp, info, scan, False);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
   info.Free;
 end;
 …
 procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2,
   y2, rx, ry, w: single; options: TRoundRectangleOptions; c: TBGRAPixel;
   EraseMode: boolean);
+  EraseMode: boolean; LinearBlend: boolean);
 var
   info: TFillBorderRoundRectInfo;
 …
   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);
+  FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
   info.Free;
 end;
 …
 procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
   y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions;
   scan: IBGRAScanner);
+  scan: IBGRAScanner; LinearBlend: boolean);
 var
   info: TFillBorderRoundRectInfo;
 …
   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);
+  FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
   info.Free;
 end;
 …
   end else
   begin
     FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False);
     FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False);
+    FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False, False);
+    FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False, False);
   end;
   info.Free;
 end;
-initialization
-  Randomize;
 end.

GraphicTest/Packages/bgrabitmap/bgrapolygonaliased.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{$i bgrasse.inc}
 interface
 …
 uses
   Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRAPolygon, BGRASSE;
+  Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE;
 type
 …
   { TPolygonLinearColorGradientInfo }
   TPolygonLinearColorGradientInfo = class(TFillPolyInfo)
+  TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo)
   protected
     FColors: array of TColorF;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
   public
     constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel);
     function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
     function CreateIntersectionInfo: TIntersectionInfo; override;
-    procedure ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
   end;
 …
   { TPolygonPerspectiveColorGradientInfo }
   TPolygonPerspectiveColorGradientInfo = class(TFillPolyInfo)
+  TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo)
   protected
     FColors: array of TColorF;
     FPointsZ: array of single;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
   public
     constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel);
     function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
     function CreateIntersectionInfo: TIntersectionInfo; override;
-    procedure ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
   end;
 …
   { TPolygonLinearTextureMappingInfo }
   TPolygonLinearTextureMappingInfo = class(TFillPolyInfo)
+  TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo)
   protected
     FTexCoords: array of TPointF;
     FLightnesses: array of Word;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
   public
     constructor Create(const points: array of TPointF; const texCoords: array of TPointF);
 …
     function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
     function CreateIntersectionInfo: TIntersectionInfo; override;
-    procedure ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
   end;
 …
   { TPolygonPerspectiveTextureMappingInfo }
   TPolygonPerspectiveTextureMappingInfo = class(TFillPolyInfo)
+  TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo)
   protected
     FTexCoords: array of TPointF;
     FPointsZ: array of single;
     FLightnesses: array of Word;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
   public
     constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF);
 …
     function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
     function CreateIntersectionInfo: TIntersectionInfo; override;
-    procedure ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
   end;
   { TPolygonPerspectiveMappingShaderInfo }
   TPolygonPerspectiveMappingShaderInfo = class(TFillPolyInfo)
+  TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo)
   protected
     FTexCoords: array of TPointF;
     FPositions3D, FNormals3D: array of TPoint3D_128;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
   public
     constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF);
 …
     function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
     function CreateIntersectionInfo: TIntersectionInfo; override;
-    procedure ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
   end;
 …
 { Aliased round rectangle }
 procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil);
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
+  skipFill: boolean = false);
 implementation
 …
 { TPolygonPerspectiveColorGradientInfo }
+procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PPerspectiveColorInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PPerspectiveColorInfo(AData);
+  TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
+  TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
+end;
 constructor TPolygonPerspectiveColorGradientInfo.Create(
 …
 end;
-procedure TPolygonPerspectiveColorGradientInfo.ComputeIntersection(
-  cury: single; var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
-var
-  j: integer;
-  dy: single;
-  info: PPerspectiveColorInfo;
-begin
-  if length(FSlices)=0 then exit;
-  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
-  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
-  with FSlices[FCurSlice] do
-  if (cury >= y1) and (cury <= y2) then
-  begin
-    for j := 0 to nbSegments-1 do
-    begin
-      dy := cury - segments[j].y1;
-      inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
-      inter[nbinter].winding := segments[j].winding;
-      info := PPerspectiveColorInfo(segments[j].data);
-      TPerspectiveColorGradientIntersectionInfo(inter[nbinter]).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
-      TPerspectiveColorGradientIntersectionInfo(inter[nbinter]).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
-      Inc(nbinter);
-    end;
-  end;
-end;
 { TPolygonLinearColorGradientInfo }
+procedure TPolygonLinearColorGradientInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PLinearColorInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PLinearColorInfo(AData);
+  TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy;
+end;
 constructor TPolygonLinearColorGradientInfo.Create(
 …
 begin
   Result:= TLinearColorGradientIntersectionInfo.Create;
-end;
-procedure TPolygonLinearColorGradientInfo.ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
-var
-  j: integer;
-  dy: single;
-  info: PLinearColorInfo;
-begin
-  if length(FSlices)=0 then exit;
-  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
-  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
-  with FSlices[FCurSlice] do
-  if (cury >= y1) and (cury <= y2) then
-  begin
-    for j := 0 to nbSegments-1 do
-    begin
-      dy := cury - segments[j].y1;
-      inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
-      inter[nbinter].winding := segments[j].winding;
-      info := PLinearColorInfo(segments[j].data);
-      TLinearColorGradientIntersectionInfo(inter[nbinter]).color := info^.Color + info^.ColorSlopes*dy;
-      Inc(nbinter);
-    end;
-  end;
 end;
 …
         r,g,b,a: integer;
        end;
     {$IFDEF CPUI386} c: TBGRAPixel; {$ENDIF}
+    {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF}
   begin
     t := ((ix1+0.5)-x1)/(x2-x1);
 …
     pdest := bmp.ScanLine[yb]+ix1;
     {$IFDEF CPUI386} {$asmmode intel}
+    {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel}
     If UseSSE then
     begin
 …
 { TPolygonLinearTextureMappingInfo }
+procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PLinearTextureInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PLinearTextureInfo(AData);
+  TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
+  if FLightnesses<>nil then
+    TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
+  else
+    TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768;
+end;
 constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF;
   const texCoords: array of TPointF);
 …
 begin
   result := TLinearTextureMappingIntersectionInfo.Create;
-end;
-procedure TPolygonLinearTextureMappingInfo.ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
-var
-  j: integer;
-  dy: single;
-  info: PLinearTextureInfo;
-begin
-  if length(FSlices)=0 then exit;
-  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
-  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
-  with FSlices[FCurSlice] do
-  if (cury >= y1) and (cury <= y2) then
-  begin
-    for j := 0 to nbSegments-1 do
-    begin
-      dy := cury - segments[j].y1;
-      inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
-      inter[nbinter].winding := segments[j].winding;
-      info := PLinearTextureInfo(segments[j].data);
-      TLinearTextureMappingIntersectionInfo(inter[nbinter]).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
-      if FLightnesses<>nil then
-        TLinearTextureMappingIntersectionInfo(inter[nbinter]).lightness := round(info^.lightness + info^.lightnessSlope*dy)
-      else
-        TLinearTextureMappingIntersectionInfo(inter[nbinter]).lightness := 32768;
-      Inc(nbinter);
-    end;
-  end;
 end;
 …
     z,invZ,InvZStep: single;
     r,g,b,a: integer;
     {$IFDEF CPUI386}minVal,maxVal: single;
+    {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single;
     cInt: packed record
       r,g,b,a: integer;
 …
     {$DEFINE PARAM_USEZBUFFER}
       zbufferpos := zbuffer + yb*bmp.Width + ix1;
       {$IFDEF CPUI386}
+      {$IFDEF BGRASSE_AVAILABLE}
       If UseSSE then
       begin
 …
     end else
     begin
       {$IFDEF CPUI386}
+      {$IFDEF BGRASSE_AVAILABLE}
       If UseSSE then
       begin
 …
 {From LazRGBGraphics}
 procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil);
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
+  skipFill: boolean = false);
 var
   CX, CY, CX1, CY1, A, B, NX, NY: single;
 …
   LX, LY: integer;
   RowStart,RowEnd: integer;
+  eBorderColor,eFillColor: TExpandedPixel;
+  PixelProc: procedure (x, y: int32or64; c: TBGRAPixel) of object;
+  skipBorder: boolean;
   procedure AddEdge(X, Y: integer);
 …
   Dec(y2);
-  eBorderColor := GammaExpansion(BorderColor);
-  eFillColor := GammaExpansion(FillColor);
   if (X1 = X2) and (Y1 = Y2) then
   begin
     dest.DrawPixel(X1, Y1, eBorderColor);
+    dest.DrawPixel(X1, Y1, BorderColor, ADrawMode);
     Exit;
   end;
 …
   if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
   begin
     dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
+    dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
     Exit;
   end;
 …
   if (LX > X2 - X1) or (LY > Y2 - Y1) then
   begin
+    dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
+    if FillTexture <> nil then
+      dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillTexture, dmDrawWithTransparency) else
+      dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, dmDrawWithTransparency);
+    dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
+    if not skipFill then
+      if FillTexture <> nil then
+        dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillTexture, ADrawMode) else
+        dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, ADrawMode);
     Exit;
   end;
 …
   end;
+  case ADrawMode of
+  dmSetExceptTransparent: begin PixelProc := @dest.SetPixel; skipBorder:= BorderColor.alpha <> 255; end;  dmDrawWithTransparency: begin PixelProc := @dest.DrawPixel; skipBorder:= BorderColor.alpha = 0; end;
+  dmXor: begin PixelProc := @dest.XorPixel; skipBorder:= DWord(BorderColor) = 0; end;
+  dmLinearBlend: begin PixelProc := @dest.FastBlendPixel; skipBorder:= BorderColor.alpha = 0; end;
+  else
+  begin PixelProc := @dest.SetPixel; skipBorder := false; end;
+  end;
   J := 0;
   while J < Length(EdgeList) do
 …
     if (J = 0) and (Frac(CY) > 0) then
     begin
+      if not skipBorder then
       for I := EdgeList[J].X to EdgeList[J].Y do
       begin
         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
         dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, eBorderColor);
+        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
+        PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
       end;
+      if FillTexture <> nil then
+        dest.DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
+          Pred(EdgeList[J].X), FillTexture) else
+        dest.DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
+          Pred(EdgeList[J].X), eFillColor);
+      if not SkipFill then
+        if FillTexture <> nil then
+          dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
+            Pred(EdgeList[J].X), FillTexture, ADrawMode) else
+          dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
+            Pred(EdgeList[J].X), FillColor, ADrawMode);
     end
     else
 …
         S := -Succ(EdgeList[J].Y);
+      if not skipBorder then
       for I := S to EdgeList[J].Y do
       begin
         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
         dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), eBorderColor);
+        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
+        PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
       end;
     end
     else
     begin
+      if not skipBorder then
       for I := EdgeList[J].X to EdgeList[J].Y do
       begin
         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
         dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), eBorderColor);
+        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
+        PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
         if Floor(CX) + I <> Ceil(CX) - Succ(I) then
         begin
           dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, eBorderColor);
           dest.DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), eBorderColor);
+          PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
+          PixelProc(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor);
         end;
       end;
       RowStart := Ceil(CX) - EdgeList[J].X;
       RowEnd := Floor(CX) + Pred(EdgeList[J].X);
       if RowEnd >= RowStart then
       begin
         if FillTexture <> nil then
+      if not SkipFill then
+      begin
+        RowStart := Ceil(CX) - EdgeList[J].X;
+        RowEnd := Floor(CX) + Pred(EdgeList[J].X);
+        if RowEnd >= RowStart then
         begin
+          dest.DrawHorizLine(RowStart, Floor(CY) + J,
+            RowEnd, FillTexture);
+          dest.DrawHorizLine(RowStart, Ceil(CY) - Succ(J),
+            RowEnd, FillTexture);
+        end else
+        begin
+          dest.DrawHorizLine(RowStart, Floor(CY) + J,
+            RowEnd, eFillColor);
+          dest.DrawHorizLine(RowStart, Ceil(CY) - Succ(J),
+            RowEnd, eFillColor);
+          if FillTexture <> nil then
+          begin
+            dest.HorizLine(RowStart, Floor(CY) + J,
+              RowEnd, FillTexture, ADrawMode);
+            dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
+              RowEnd, FillTexture, ADrawMode);
+          end else
+          begin
+            dest.HorizLine(RowStart, Floor(CY) + J,
+              RowEnd, FillColor, ADrawMode);
+            dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
+              RowEnd, FillColor, ADrawMode);
+          end;
         end;
       end;
     end;
     Inc(J);

GraphicTest/Packages/bgrabitmap/bgraresample.pas

-              r452
+              r472
   without interpolation filters.
+  SimpleStretch does a fast stretch by splitting the image into zones defined
+  by integers. This can be quite ugly.
+  SimpleStretch does a boxed resample with limited antialiasing.
   FineResample uses floating point coordinates to get an antialiased resample.
 …
 uses
   SysUtils, BGRABitmapTypes;
+  Types, SysUtils, BGRABitmapTypes;
 {------------------------------- Simple stretch ------------------------------------}
 …
 function SimpleStretch(bmp: TBGRACustomBitmap;
   NewWidth, NewHeight: integer): TBGRACustomBitmap;
+procedure StretchPutImage(bmp: TBGRACustomBitmap;
+  NewWidth, NewHeight: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte);
+procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX,factorY: integer; dest: TBGRACustomBitmap; OffsetX,OffsetY: Integer; ADrawMode: TDrawMode);
+function DownSample(source: TBGRACustomBitmap; factorX,factorY: integer): TBGRACustomBitmap;
 {---------------------------- Interpolation filters --------------------------------}
 …
   end;
+  { TLanczosKernel }
+  TLanczosKernel = class(TWideKernelFilter)
+  private
+    FNumberOfLobes: integer;
+    FFactor: ValReal;
+    procedure SetNumberOfLobes(AValue: integer);
+  public
+    constructor Create(ANumberOfLobes: integer);
+    function Interpolation(t: single): single; override;
+    function ShouldCheckRange: boolean; override;
+    function KernelWidth: single; override;
+    property NumberOfLobes : integer read FNumberOfLobes write SetNumberOfLobes;
+  end;
 function CreateInterpolator(style: TSplineStyle): TWideKernelFilter;
 …
 implementation
+uses GraphType, Math;
+{-------------------------------- Simple stretch ------------------------------------}
+function FastSimpleStretchLarger(bmp: TBGRACustomBitmap;
+  xFactor, yFactor: integer): TBGRACustomBitmap;
+uses GraphType, Math, BGRABlend;
+function SimpleStretch(bmp: TBGRACustomBitmap;
+  newWidth, newHeight: integer): TBGRACustomBitmap;
+begin
+  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
+  begin
+    Result := bmp.Duplicate;
+    exit;
+  end;
+  Result := bmp.NewBitmap(NewWidth, NewHeight);
+  StretchPutImage(bmp, newWidth,newHeight, result, 0,0, dmSet, 255);
+end;
+procedure StretchPutImage(bmp: TBGRACustomBitmap; NewWidth, NewHeight: integer;
+  dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode; AOpacity: byte);
+type
+  TTransitionState = (tsNone, tsPlain, tsLeft, tsMiddle, tsRight);
 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
+  x_src,y_src, y_src2, prev_y_src, prev_y_src2: NativeInt;
+  inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src,
+  acc_x_src2, acc_y_src2: NativeInt;
+  x_dest, y_dest: NativeInt;
+  PDest, PSrc1, PSrc2: PBGRAPixel;
+  vertColors: packed array[1..2] of TBGRAPixel;
+  DeltaSrcX: NativeInt;
+  targetRect: TRect;
+  tempData: PBGRAPixel;
+  prevHorizTransition,horizTransition,prevVertTransition,vertTransition: TTransitionState;
+  horizSlightlyDifferent,vertSlightlyDifferent: boolean;
+  procedure LinearMix(PSrc: PBGRAPixel; DeltaSrc: integer; AccSrcQuarter: boolean;
+        PDest: PBGRAPixel; slightlyDifferent: boolean; var transition: TTransitionState);
+  var
+    asum: NativeInt;
+    a1,a2: NativeInt;
+    newTransition: TTransitionState;
+  begin
+    if DeltaSrc=0 then
+    begin
+      PDest^ := PSrc^;
+      transition:= tsPlain;
+    end
+    else
+    begin
+      if slightlyDifferent then
+      begin
+        if AccSrcQuarter then newTransition:= tsRight else
+          newTransition:= tsLeft;
+      end else
+        newTransition:= tsMiddle;
+      if (newTransition = tsMiddle) or ((newTransition = tsRight) and (transition = tsLeft)) or
+        ((newTransition = tsLeft) and (transition = tsRight)) then
+      begin
+        transition:= tsMiddle;
+        asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha;
+        if asum = 0 then
+          pdest^ := BGRAPixelTransparent
+        else if asum = 510 then
+        begin
+          pdest^.alpha := 255;
+          pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red + 1) shr 1;
+          pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green + 1) shr 1;
+          pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue + 1) shr 1;
+        end else
+        begin
+          pdest^.alpha := asum shr 1;
+          a1 := psrc^.alpha;
+          a2 := (psrc+DeltaSrc)^.alpha;
+          pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum;
+          pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum;
+          pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum;
+        end;
+      end else
+      if newTransition = tsRight then
+      begin
+        transition := tsRight;
+        asum := psrc^.alpha + (psrc+DeltaSrc)^.alpha*3;
+        if asum = 0 then
+          pdest^ := BGRAPixelTransparent
+        else if asum = 1020 then
+        begin
+          pdest^.alpha := 255;
+          pdest^.red := (psrc^.red + (psrc+DeltaSrc)^.red*3 + 2) shr 2;
+          pdest^.green := (psrc^.green + (psrc+DeltaSrc)^.green*3 + 2) shr 2;
+          pdest^.blue := (psrc^.blue + (psrc+DeltaSrc)^.blue*3 + 2) shr 2;
+        end else
+        begin
+          pdest^.alpha := asum shr 2;
+          a1 := psrc^.alpha;
+          a2 := (psrc+DeltaSrc)^.alpha;
+          pdest^.red := (psrc^.red*a1 + (psrc+DeltaSrc)^.red*a2*3 + (asum shr 1)) div asum;
+          pdest^.green := (psrc^.green*a1 + (psrc+DeltaSrc)^.green*a2*3 + (asum shr 1)) div asum;
+          pdest^.blue := (psrc^.blue*a1 + (psrc+DeltaSrc)^.blue*a2*3 + (asum shr 1)) div asum;
+        end;
+      end else
+      begin
+        transition:= tsLeft;
+        asum := psrc^.alpha*3 + (psrc+DeltaSrc)^.alpha;
+        if asum = 0 then
+          pdest^ := BGRAPixelTransparent
+        else if asum = 1020 then
+        begin
+          pdest^.alpha := 255;
+          pdest^.red := (psrc^.red*3 + (psrc+DeltaSrc)^.red + 2) shr 2;
+          pdest^.green := (psrc^.green*3 + (psrc+DeltaSrc)^.green + 2) shr 2;
+          pdest^.blue := (psrc^.blue*3 + (psrc+DeltaSrc)^.blue + 2) shr 2;
+        end else
+        begin
+          pdest^.alpha := asum shr 2;
+          a1 := psrc^.alpha;
+          a2 := (psrc+DeltaSrc)^.alpha;
+          pdest^.red := (psrc^.red*a1*3 + (psrc+DeltaSrc)^.red*a2 + (asum shr 1)) div asum;
+          pdest^.green := (psrc^.green*a1*3 + (psrc+DeltaSrc)^.green*a2 + (asum shr 1)) div asum;
+          pdest^.blue := (psrc^.blue*a1*3 + (psrc+DeltaSrc)^.blue*a2 + (asum shr 1)) div asum;
+        end;
+      end;
+    end;
+  end;
+begin
+  if (newWidth <= 0) or (newHeight <= 0) or (bmp.Width <= 0)
+    or (bmp.Height <= 0) then
     exit;
+  targetRect := rect(0,0,NewWidth,NewHeight);
+  if OffsetX < dest.ClipRect.Left then targetRect.Left:= dest.ClipRect.Left-OffsetX;
+  if OffsetY < dest.ClipRect.Top then targetRect.Top:= dest.ClipRect.Top-OffsetY;
+  if OffsetX+NewWidth > dest.ClipRect.Right then targetRect.Right := dest.ClipRect.Right-OffsetX;
+  if OffsetY+NewHeight > dest.ClipRect.Bottom then targetRect.Bottom := dest.ClipRect.Bottom-OffsetY;
+  if (targetRect.Right <= targetRect.Left) or (targetRect.Bottom <= targetRect.Top) 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);
+  if (ADrawMode <> dmSet) or (AOpacity <> 255) then
+     getmem(tempData, (targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel) )
+  else
+      tempData := nil;
+  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;
+  prev_y_src := -1;
+  prev_y_src2 := -1;
+  acc_y_src := targetRect.Top*mod_y_src;
+  y_src     := targetRect.Top*inc_y_src + (acc_y_src div NewHeight);
+  acc_y_src := acc_y_src mod NewHeight;
+  y_src     := y_src+ (bmp.Height div 4) div newheight;
+  acc_y_src := acc_y_src+ (bmp.Height div 4) mod newheight;
+  y_src2     := y_src+ (bmp.Height div 2) div newheight;
+  acc_y_src2 := acc_y_src+ (bmp.Height div 2) mod newheight;
+  if acc_y_src2 > NewHeight then
+  begin
+    dec(acc_y_src2, NewHeight);
+    inc(y_src2);
+  end;
+  horizSlightlyDifferent := (NewWidth > bmp.Width*2 div 3) and (NewWidth < bmp.Width*4 div 3);
+  prevVertTransition:= tsNone;
+  vertSlightlyDifferent := (NewHeight > bmp.Height*2 div 3) and (NewHeight < bmp.Height*4 div 3);
+  for y_dest := targetRect.Top to targetRect.Bottom - 1 do
+  begin
+    if (y_src = prev_y_src) and (y_src2 = prev_y_src2) and not vertSlightlyDifferent then
+    begin
+      if tempData = nil then
+        move((dest.ScanLine[y_dest-1+OffsetY]+OffsetX+targetRect.Left)^,(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left)^,(targetRect.Right-targetRect.Left)*sizeof(TBGRAPixel))
+      else
+        PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity);
+    end else
+    begin
+      if tempData = nil then
+         PDest := dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left
+      else
+        PDest := tempData;
+      PSrc1 := bmp.Scanline[y_src];
+      acc_x_src := targetRect.Left*mod_x_src;
+      x_src     := targetRect.Left*inc_x_src + (acc_x_src div NewWidth);
+      acc_x_src := acc_x_src mod NewWidth;
+      x_src     := x_src+ (bmp.Width div 4) div NewWidth;
+      acc_x_src := acc_x_src+ (bmp.Width div 4) mod NewWidth;
+      DeltaSrcX := (bmp.Width div 2) div NewWidth;
+      acc_x_src2 := acc_x_src+ (bmp.Width div 2) mod NewWidth;
+      if acc_x_src2 > NewWidth then
+      begin
+        dec(acc_x_src2, NewWidth);
+        inc(DeltaSrcX);
+      end;
+      inc(Psrc1, x_src);
+      prevHorizTransition := tsNone;
+      if y_src2=y_src then
+      begin
+        horizTransition:= prevHorizTransition;
+        for x_dest := targetRect.left to targetRect.right - 1 do
+        begin
+          LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, PDest, horizSlightlyDifferent, horizTransition);
+          Inc(PSrc1, inc_x_src);
+          Inc(acc_x_src, mod_x_src);
+          if acc_x_src >= newWidth then
+          begin
+            Dec(acc_x_src, newWidth);
+            Inc(PSrc1);
+            dec(DeltaSrcX);
+          end;
+          Inc(acc_x_src2, mod_x_src);
+          if acc_x_src2 >= newWidth then
+          begin
+            Dec(acc_x_src2, newWidth);
+            Inc(DeltaSrcX);
+          end;
+          inc(PDest);
         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('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);
+        prevVertTransition:= tsPlain;
+      end else
+      begin
+        PSrc2 := bmp.Scanline[y_src2]+x_src;
+        for x_dest := targetRect.left to targetRect.right - 1 do
+        begin
+          horizTransition:= prevHorizTransition;
+          LinearMix(psrc1, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[1], horizSlightlyDifferent, horizTransition);
+          horizTransition:= prevHorizTransition;
+          LinearMix(psrc2, DeltaSrcX, acc_x_src2 >= NewWidth shr 2, @vertColors[2], horizSlightlyDifferent, horizTransition);
+          prevHorizTransition:= horizTransition;
+          vertTransition:= prevVertTransition;
+          LinearMix(@vertColors[1],1,acc_y_src2 >= NewHeight shr 2,PDest,vertSlightlyDifferent,vertTransition);
+          Inc(PSrc1, inc_x_src);
+          Inc(PSrc2, inc_x_src);
+          Inc(acc_x_src, mod_x_src);
+          if acc_x_src >= newWidth then
+          begin
+            Dec(acc_x_src, newWidth);
+            Inc(PSrc1);
+            Inc(PSrc2);
+            dec(DeltaSrcX);
+          end;
+          Inc(acc_x_src2, mod_x_src);
+          if acc_x_src2 >= newWidth then
+          begin
+            Dec(acc_x_src2, newWidth);
+            Inc(DeltaSrcX);
+          end;
+          inc(PDest);
         end;
+        Inc(PDest, delta);
+      end;
+    end;
+  end;
+  Result.InvalidateBitmap;
+end;
+function SimpleStretchSmallerFactor2(source: TBGRACustomBitmap): TBGRACustomBitmap;
+var xb,yb: integer;
+        prevVertTransition:= vertTransition;
+      end;
+      if tempData <> nil then
+         PutPixels(dest.ScanLine[y_dest+OffsetY]+OffsetX+targetRect.Left,tempData,targetRect.right-targetRect.left,ADrawMode,AOpacity);
+    end;
+    prev_y_src := y_src;
+    prev_y_src2 := y_src2;
+    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;
+    Inc(y_src2, inc_y_src);
+    Inc(acc_y_src2, mod_y_src);
+    if acc_y_src2 >= newheight then
+    begin
+      Dec(acc_y_src2, newheight);
+      Inc(y_src2);
+    end;
+  end;
+  dest.InvalidateBitmap;
+  if Assigned(tempData) then FreeMem(tempData);
+end;
+procedure DownSamplePutImage2(source: TBGRACustomBitmap;
+  dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode);
+const factorX = 2; factorY = 2; nbi= factorX*factorY;
+var xb,yb,ys: NativeInt;
     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);
+    asum,maxsum: NativeUInt;
+    newWidth,newHeight: NativeInt;
+    r,g,b: NativeUInt;
+begin
+  if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then
+     raise exception.Create('Source size must be a multiple of factorX and factorY');
+  newWidth := source.Width div factorX;
+  newHeight := source.Height div factorY;
+  ys := 0;
+  maxsum := 255*NativeInt(factorX)*NativeInt(factorY);
   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];
+    pdest := dest.ScanLine[yb+OffsetY]+OffsetX;
+    psrc1 := source.Scanline[ys]; inc(ys);
+    psrc2 := source.Scanline[ys]; inc(ys);
     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
+      asum := 0;
+      asum := psrc1^.alpha + psrc2^.alpha + (psrc1+1)^.alpha + (psrc2+1)^.alpha;
+      if asum = maxsum 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;
+        r := psrc1^.red + psrc2^.red + (psrc1+1)^.red + (psrc2+1)^.red;
+        g := psrc1^.green + psrc2^.green + (psrc1+1)^.green + (psrc2+1)^.green;
+        b := psrc1^.blue + psrc2^.blue + (psrc1+1)^.blue + (psrc2+1)^.blue;
+        inc(psrc1,factorX); inc(psrc2,factorX);
+        pdest^.red := (r + (nbi shr 1)) shr 2;
+        pdest^.green := (g + (nbi shr 1)) shr 2;
+        pdest^.blue := (b + (nbi shr 1)) 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);
+      if ADrawMode <> dmSetExceptTransparent then
+      begin
+        if asum = 0 then
+        begin
+          if ADrawMode = dmSet then
+            pdest^ := BGRAPixelTransparent;
+          inc(psrc1,factorX); inc(psrc2,factorX);
+        end
+        else
+        begin
+          r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha;
+          g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha;
+          b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha;
+          inc(psrc1,factorX); inc(psrc2,factorX);
+          if ADrawMode = dmSet then
+          begin
+            pdest^.alpha := (asum + (nbi shr 1)) shr 2;
+            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
+          else
+          begin
+            if ADrawMode = dmDrawWithTransparency then
+              DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum,
+                 (g + (asum shr 1)) div asum,
+                 (b + (asum shr 1)) div asum,
+                 (asum + (nbi shr 1)) shr 2)) else
+             if ADrawMode = dmFastBlend then
+               FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum,
+                  (g + (asum shr 1)) div asum,
+                  (b + (asum shr 1)) div asum,
+                  (asum + (nbi shr 1)) shr 2));
+          end;
+        end;
+      end;
       inc(pdest);
     end;
 …
 end;
+function SimpleStretchSmallerFactor4(source: TBGRACustomBitmap): TBGRACustomBitmap;
+var xb,yb: integer;
+procedure DownSamplePutImage3(source: TBGRACustomBitmap;
+  dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode);
+const factorX = 3; factorY = 3; nbi= factorX*factorY;
+var xb,yb,ys: NativeInt;
     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);
+    psrc1,psrc2,psrc3: PBGRAPixel;
+    asum,maxsum: NativeUInt;
+    newWidth,newHeight: NativeInt;
+    r,g,b: NativeUInt;
+begin
+  if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then
+     raise exception.Create('Source size must be a multiple of factorX and factorY');
+  newWidth := source.Width div factorX;
+  newHeight := source.Height div factorY;
+  ys := 0;
+  maxsum := 255*NativeInt(factorX)*NativeInt(factorY);
   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];
+    pdest := dest.ScanLine[yb+OffsetY]+OffsetX;
+    psrc1 := source.Scanline[ys]; inc(ys);
+    psrc2 := source.Scanline[ys]; inc(ys);
+    psrc3 := source.Scanline[ys]; inc(ys);
     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
+      asum := 0;
+      asum := psrc1^.alpha + psrc2^.alpha + psrc3^.alpha
+           + (psrc1+1)^.alpha + (psrc2+1)^.alpha + (psrc3+1)^.alpha
+           + (psrc1+2)^.alpha + (psrc2+2)^.alpha + (psrc3+2)^.alpha;
+      if asum = maxsum 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;
+        r := psrc1^.red + psrc2^.red + psrc3^.red
+           + (psrc1+1)^.red + (psrc2+1)^.red + (psrc3+1)^.red
+           + (psrc1+2)^.red + (psrc2+2)^.red + (psrc3+2)^.red;
+        g := psrc1^.green + psrc2^.green + psrc3^.green
+           + (psrc1+1)^.green + (psrc2+1)^.green + (psrc3+1)^.green
+           + (psrc1+2)^.green + (psrc2+2)^.green + (psrc3+2)^.green;
+        b := psrc1^.blue + psrc2^.blue + psrc3^.blue
+           + (psrc1+1)^.blue + (psrc2+1)^.blue + (psrc3+1)^.blue
+           + (psrc1+2)^.blue + (psrc2+2)^.blue + (psrc3+2)^.blue;
+        inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX);
+        pdest^.red := (r + (nbi shr 1)) div 9;
+        pdest^.green := (g + (nbi shr 1)) div 9;
+        pdest^.blue := (b + (nbi shr 1)) div 9;
       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);
+      if ADrawMode <> dmSetExceptTransparent then
+      begin
+        if asum = 0 then
+        begin
+          if ADrawMode = dmSet then
+            pdest^ := BGRAPixelTransparent;
+          inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX);
+        end
+        else
+        begin
+          r := psrc1^.red*psrc1^.alpha + psrc2^.red*psrc2^.alpha + psrc3^.red*psrc3^.alpha
+            + (psrc1+1)^.red*(psrc1+1)^.alpha + (psrc2+1)^.red*(psrc2+1)^.alpha + (psrc3+1)^.red*(psrc3+1)^.alpha
+            + (psrc1+2)^.red*(psrc1+2)^.alpha + (psrc2+2)^.red*(psrc2+2)^.alpha + (psrc3+2)^.red*(psrc3+2)^.alpha;
+          g := psrc1^.green*psrc1^.alpha + psrc2^.green*psrc2^.alpha + psrc3^.green*psrc3^.alpha
+            + (psrc1+1)^.green*(psrc1+1)^.alpha + (psrc2+1)^.green*(psrc2+1)^.alpha + (psrc3+1)^.green*(psrc3+1)^.alpha
+            + (psrc1+2)^.green*(psrc1+2)^.alpha + (psrc2+2)^.green*(psrc2+2)^.alpha + (psrc3+2)^.green*(psrc3+2)^.alpha;
+          b := psrc1^.blue*psrc1^.alpha + psrc2^.blue*psrc2^.alpha + psrc3^.blue*psrc3^.alpha
+            + (psrc1+1)^.blue*(psrc1+1)^.alpha + (psrc2+1)^.blue*(psrc2+1)^.alpha + (psrc3+1)^.blue*(psrc3+1)^.alpha
+            + (psrc1+2)^.blue*(psrc1+2)^.alpha + (psrc2+2)^.blue*(psrc2+2)^.alpha + (psrc3+2)^.blue*(psrc3+2)^.alpha;
+          inc(psrc1,factorX); inc(psrc2,factorX); inc(psrc3,factorX);
+          if ADrawMode = dmSet then
+          begin
+            pdest^.alpha := (asum + (nbi shr 1)) div 9;
+            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
+          else
+          begin
+            if ADrawMode = dmDrawWithTransparency then
+              DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum,
+                 (g + (asum shr 1)) div asum,
+                 (b + (asum shr 1)) div asum,
+                 (asum + (nbi shr 1)) div 9)) else
+             if ADrawMode = dmFastBlend then
+               FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum,
+                  (g + (asum shr 1)) div asum,
+                  (b + (asum shr 1)) div asum,
+                  (asum + (nbi shr 1)) div 9));
+          end;
+        end;
+      end;
       inc(pdest);
     end;
 …
 end;
+function SimpleStretchSmallerFactor(source: TBGRACustomBitmap; fx,fy: integer): TBGRACustomBitmap;
+var xb,yb,ys,iy,ix: integer;
+    pdest: PBGRAPixel;
+procedure DownSamplePutImage(source: TBGRACustomBitmap; factorX, factorY: integer;
+  dest: TBGRACustomBitmap; OffsetX, OffsetY: Integer; ADrawMode: TDrawMode);
+var xb,yb,ys,iy,ix: NativeInt;
+    pdest,psrci: 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);
+    asum,maxsum: NativeUInt;
+    newWidth,newHeight: NativeInt;
+    r,g,b,nbi: NativeUInt;
+begin
+  if ADrawMode = dmXor then raise exception.Create('dmXor drawmode not supported');
+  if (factorX = 2) and (factorY = 2) then
+  begin
+     DownSamplePutImage2(source,dest,OffsetX,OffsetY,ADrawMode);
+     exit;
+  end;
+  if (factorX = 3) and (factorY = 3) then
+  begin
+     DownSamplePutImage3(source,dest,OffsetX,OffsetY,ADrawMode);
+     exit;
+  end;
+  if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then
+     raise exception.Create('Source size must be a multiple of factorX and factorY');
+  newWidth := source.Width div factorX;
+  newHeight := source.Height div factorY;
   ys := 0;
   maxsum := 255*fx*fy;
   nbi := fx*fy;
   setlength(psrc, fy);
+  maxsum := 255*NativeInt(factorX)*NativeInt(factorY);
+  nbi := factorX*factorY;
+  setlength(psrc, factorY);
   for yb := 0 to newHeight-1 do
   begin
     pdest := result.ScanLine[yb];
     for iy := fy-1 downto 0 do
+    pdest := dest.ScanLine[yb+OffsetY]+OffsetX;
+    for iy := factorY-1 downto 0 do
     begin
       psrc[iy] := source.Scanline[ys];
 …
     begin
       asum := 0;
       for iy := fy-1 downto 0 do
+      for iy := factorY-1 downto 0 do
       begin
         psrci := psrc[iy];
         for ix := fx-1 downto 0 do
+        for ix := factorX-1 downto 0 do
           asum += (psrci+ix)^.alpha;
       end;
+      if asum = 0 then
+        pdest^ := BGRAPixelTransparent
+      else if asum = maxsum then
+      if asum = maxsum then
       begin
         pdest^.alpha := 255;
 …
         g := 0;
         b := 0;
+        for iy := fy-1 downto 0 do
+        begin
+          psrci := psrc[iy];
+          for ix := fx-1 downto 0 do
+        for iy := factorY-1 downto 0 do
+          for ix := factorX-1 downto 0 do
           begin
             with (psrci+ix)^ do
+            with psrc[iy]^ do
             begin
               r += red;
 …
               b += blue;
             end;
+            inc(psrc[iy]);
           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
+      if ADrawMode <> dmSetExceptTransparent then
+      begin
+        if asum = 0 then
+        begin
+          if ADrawMode = dmSet then
+            pdest^ := BGRAPixelTransparent;
+          for iy := factorY-1 downto 0 do
+            inc(psrc[iy],factorX);
+        end
+        else
+        begin
+          r := 0;
+          g := 0;
+          b := 0;
+          for iy := factorY-1 downto 0 do
+            for ix := factorX-1 downto 0 do
+            begin
+              with psrc[iy]^ do
+              begin
+                r += red*alpha;
+                g += green*alpha;
+                b += blue*alpha;
+              end;
+              inc(psrc[iy]);
+            end;
+          if ADrawMode = dmSet then
           begin
+            with (psrci+ix)^ do
+            begin
+              r += integer(red)*integer(alpha);
+              g += integer(green)*integer(alpha);
+              b += integer(blue)*integer(alpha);
+            end;
+            pdest^.alpha := (asum + (nbi shr 1)) div nbi;
+            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
+          else
+          begin
+            if ADrawMode = dmDrawWithTransparency then
+              DrawPixelInlineWithAlphaCheck(pdest,BGRA((r + (asum shr 1)) div asum,
+                 (g + (asum shr 1)) div asum,
+                 (b + (asum shr 1)) div asum,
+                 (asum + (nbi shr 1)) div nbi)) else
+             if ADrawMode = dmFastBlend then
+               FastBlendPixelInline(pdest,BGRA((r + (asum shr 1)) div asum,
+                  (g + (asum shr 1)) div asum,
+                  (b + (asum shr 1)) div asum,
+                  (asum + (nbi shr 1)) div nbi));
           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);
+      end;
       inc(pdest);
     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;
+function DownSample(source: TBGRACustomBitmap; factorX, factorY: integer): TBGRACustomBitmap;
+begin
+  if (source.Width mod factorX <> 0) or (source.Height mod factorY <> 0) then
+     raise exception.Create('Source size must be a multiple of factorX and factorY');
+  result := source.NewBitmap(source.Width div factorX, source.Height div factorY);
+  DownSamplePutImage(source,factorX,factorY,result,0,0,dmSet);
 end;
 …
 function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single;
 begin
+  if ResampleFilter = rfLinear then
+    result := t else
+  if ResampleFilter <= rfLinear then
+  begin
+    if ResampleFilter = rfBox then
+    begin
+       result := round(t);
+    end else
+      result := t;
+  end else
   begin
     if t <= 0.5 then
 …
 function FineInterpolation256(t256: integer; ResampleFilter: TResampleFilter): integer;
 begin
+  if ResampleFilter = rfLinear then
+    result := t256 else
+  if ResampleFilter <= rfLinear then
+  begin
+    if ResampleFilter = rfBox then
+    begin
+      if t256 < 128 then
+        result := 0
+      else
+        result := 256;
+    end
+    else
+      result := t256;
+  end else
   begin
     if t256 <= 128 then
 …
 begin
   Result := 2;
+end;
+{ TLanczosKernel }
+{ by stab }
+procedure TLanczosKernel.SetNumberOfLobes(AValue: integer);
+begin
+  if AValue < 1 then AValue := 1;
+  if FNumberOfLobes=AValue then Exit;
+  FNumberOfLobes:=AValue;
+  if AValue = 1 then FFactor := 1.5 else FFactor := AValue;
+end;
+constructor TLanczosKernel.Create(ANumberOfLobes: integer);
+begin
+  NumberOfLobes:= ANumberOfLobes;
+end;
+function TLanczosKernel.Interpolation(t: single): single;
+var Pi_t: ValReal;
+begin
+  if t = 0 then
+    Result := 1
+  else if t < FNumberOfLobes then
+  begin
+    Pi_t := pi * t;
+    Result := FFactor * sin(Pi_t) * sin(Pi_t / FNumberOfLobes) /
+      (Pi_t * Pi_t)
+  end
+  else
+    Result := 0;
+end;
+function TLanczosKernel.ShouldCheckRange: boolean;
+begin
+  Result := True;
+end;
+function TLanczosKernel.KernelWidth: single;
+begin
+  Result := FNumberOfLobes;
 end;
 …
   tempFilter1,tempFilter2: TWideKernelFilter;
 begin
+  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
+  begin
+    Result := bmp.Duplicate;
+    exit;
+  end;
   case ResampleFilter of
     rfBicubic: //blur
 …
     begin
       tempFilter1 := TSplineKernel.Create;
+      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
+      tempFilter1.Free;
+      exit;
+    end;
+    rfLanczos2,rfLanczos3,rfLanczos4:
+    begin
+      tempFilter1 := TLanczosKernel.Create(ord(ResampleFilter)-ord(rfLanczos2)+2);
       result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
       tempFilter1.Free;
 …
   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, ResampleFilter)

GraphicTest/Packages/bgrabitmap/bgrascene3d.pas

-              r452
+              r472
 type
+  TProjection3D = BGRAMatrix3D.TProjection3D;
+  TBox3D = record
+    min,max: TPoint3D;
+  end;
+  TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
+  TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
+  TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
+  TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
+  TRenderingOptions = record
+    LightingInterpolation: TLightingInterpolation3D;
+    AntialiasingMode: TAntialiasingMode3D;
+    AntialiasingResampleLevel: integer;
+    PerspectiveMode: TPerspectiveMode3D;
+    TextureInterpolation: boolean;
+    MinZ: single;
+  end;
   PSceneLightingContext = ^TSceneLightingContext;
   TSceneLightingContext = packed record
 …
     SaturationHigh: integer;
     SaturationHighF: single;
-  end;
-  TProjection3D = packed record
-    Zoom, Center: TPointF;
-  end;
-  TBox3D = record
-    min,max: TPoint3D;
-  end;
-  TLightingNormal3D = (lnNone, lnFace, lnVertex, lnFaceVertexMix);
-  TLightingInterpolation3D = (liLowQuality, liSpecularHighQuality, liAlwaysHighQuality);
-  TAntialiasingMode3D = (am3dNone, am3dMultishape, am3dResample);
-  TPerspectiveMode3D = (pmLinearMapping, pmPerspectiveMapping, pmZBuffer);
-type
-  TRenderingOptions = record
-    LightingInterpolation: TLightingInterpolation3D;
-    AntialiasingMode: TAntialiasingMode3D;
-    AntialiasingResampleLevel: integer;
-    PerspectiveMode: TPerspectiveMode3D;
-    TextureInterpolation: boolean;
-    MinZ: single;
   end;
 …
     function GetLightCount: integer;
     function GetMaterial(AIndex: integer): IBGRAMaterial3D;
+    function GetNormalCount: integer;
     function GetObject(AIndex: integer): IBGRAObject3D;
     function GetVertexCount: integer;
 …
     function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
     procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual;
+    function FetchTexture({%H-}AName: string; out texSize: TPointF): IBGRAScanner; virtual;
   public
 …
     DefaultMaterial : IBGRAMaterial3D;
     RenderingOptions: TRenderingOptions;
+    UnknownColor: TBGRAPixel;
     constructor Create;
     constructor Create(ASurface: TBGRACustomBitmap);
     destructor Destroy; override;
     procedure Clear;
+    procedure Clear; virtual;
     function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
+    function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
+    function LoadObjectFromStream(AStream: TStream; SwapFacesOrientation: boolean = true): IBGRAObject3D;
+    procedure LoadMaterialsFromFile(AFilename: string);
+    procedure LoadMaterialsFromFileUTF8(AFilename: string);
+    procedure LoadMaterialsFromStream(AStream: TStream);
     procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
     procedure LookLeft(angleDeg: single);
 …
     function CreateMaterial: IBGRAMaterial3D;
     function CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
+    function GetMaterialByName(AName: string): IBGRAMaterial3D;
     procedure UpdateMaterials; virtual;
     procedure UpdateMaterial(AMaterialName: string); virtual;
+    procedure ForEachVertex(ACallback: TVertex3DCallback);
+    procedure ForEachFace(ACallback: TFace3DCallback);
     property ViewCenter: TPointF read GetViewCenter write SetViewCenter;
     property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter;
 …
     property Object3DCount: integer read FObjectCount;
     property VertexCount: integer read GetVertexCount;
+    property NormalCount: integer read GetNormalCount;
     property FaceCount: integer read GetFaceCount;
     property Zoom: TPointF read GetZoom write SetZoom;
 …
 implementation
+uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D;
+uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D, BGRAResample,
+  lazutf8classes;
 {$i lightingclasses3d.inc}
+{$i vertex3d.inc}
+{$i face3d.inc}
 type
 …
     function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
     function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
     procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
     function GetColor: TBGRAPixel;
     function GetLight: Single;
 …
     function GetFaceCount: integer;
     function GetTotalVertexCount: integer;
+    function GetTotalNormalCount: integer;
     function GetMaterial: IBGRAMaterial3D;
     procedure SetLightingNormal(const AValue: TLightingNormal3D);
 …
     function GetRefCount: integer;
     procedure SetBiface(AValue : boolean);
+  end;
+{$i shape3D.inc}
+type
+  { TBGRAPart3D }
+  TBGRAPart3D = class(TInterfacedObject,IBGRAPart3D)
+  private
+    FVertices: array of IBGRAVertex3D;
+    FVertexCount: integer;
+    FMatrix: TMatrix3D;
+    FParts: array of IBGRAPart3D;
+    FPartCount: integer;
+    FContainer: IBGRAPart3D;
+    FCoordPool: TBGRACoordPool3D;
+  public
+    constructor Create(AContainer: IBGRAPart3D);
+    destructor Destroy; override;
+    procedure Clear(ARecursive: boolean);
+    function Add(x,y,z: single): IBGRAVertex3D;
+    function Add(pt: TPoint3D): IBGRAVertex3D;
+    function Add(pt: TPoint3D_128): IBGRAVertex3D;
+    function Add(const coords: array of single): arrayOfIBGRAVertex3D;
+    function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
+    function Add(const pts: array of TPoint3D_128): arrayOfIBGRAVertex3D;
+    procedure Add(const pts: array of IBGRAVertex3D);
+    procedure Add(AVertex: IBGRAVertex3D);
+    procedure RemoveVertex(Index: integer);
+    function GetBoundingBox: TBox3D;
+    function GetRadius: single;
+    function GetMatrix: TMatrix3D;
+    function GetPart(AIndex: Integer): IBGRAPart3D;
+    function GetPartCount: integer;
+    function GetVertex(AIndex: Integer): IBGRAVertex3D;
+    function GetVertexCount: integer;
+    function GetTotalVertexCount: integer;
+    function GetContainer: IBGRAPart3D;
+    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+    procedure ResetTransform;
+    procedure Translate(x,y,z: single; Before: boolean = true);
+    procedure Translate(ofs: TPoint3D; Before: boolean = true);
+    procedure Scale(size: single; Before: boolean = true);
+    procedure Scale(x,y,z: single; Before: boolean = true);
+    procedure Scale(size: TPoint3D; Before: boolean = true);
+    procedure RotateXDeg(angle: single; Before: boolean = true);
+    procedure RotateYDeg(angle: single; Before: boolean = true);
+    procedure RotateZDeg(angle: single; Before: boolean = true);
+    procedure RotateXRad(angle: single; Before: boolean = true);
+    procedure RotateYRad(angle: single; Before: boolean = true);
+    procedure RotateZRad(angle: single; Before: boolean = true);
+    procedure SetMatrix(const AValue: TMatrix3D);
+    procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    function ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
+    procedure NormalizeViewNormal;
+    function CreatePart: IBGRAPart3D;
+    procedure LookAt(ALookWhere,ATopDir: TPoint3D);
+    procedure RemoveUnusedVertices;
+    function IndexOf(AVertex: IBGRAVertex3D): integer;
+  end;
+  { TBGRAFace3D }
+  PBGRAFaceVertexDescription = ^TBGRAFaceVertexDescription;
+  TBGRAFaceVertexDescription = record
+       Vertex: IBGRAVertex3D;
+       Color: TBGRAPixel;
+       TexCoord: TPointF;
+       ColorOverride: boolean;
+       TexCoordOverride: boolean;
+     end;
+  TBGRAFace3D = class(TInterfacedObject,IBGRAFace3D)
+  private
+    FVertices: packed array of TBGRAFaceVertexDescription;
+    FVertexCount: integer;
+    FTexture: IBGRAScanner;
+    FMaterial: IBGRAMaterial3D;
+    FMaterialName: string;
+    FParentTexture: boolean;
+    FViewNormal: TPoint3D_128;
+    FViewCenter: TPoint3D_128;
+    FObject3D : IBGRAObject3D;
+    FBiface: boolean;
+    FLightThroughFactor: single;
+    FLightThroughFactorOverride: boolean;
+    function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription;
+  public
+    function GetObject3D: IBGRAObject3D;
+    constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D);
+    destructor Destroy; override;
+    procedure AddVertex(AVertex: IBGRAVertex3D);
+    function GetParentTexture: boolean;
+    function GetTexture: IBGRAScanner;
+    function GetVertex(AIndex: Integer): IBGRAVertex3D;
+    function GetVertexColor(AIndex: Integer): TBGRAPixel;
+    function GetVertexColorOverride(AIndex: Integer): boolean;
+    function GetVertexCount: integer;
+    function GetMaterial: IBGRAMaterial3D;
+    function GetMaterialName: string;
+    function GetTexCoord(AIndex: Integer): TPointF;
+    function GetTexCoordOverride(AIndex: Integer): boolean;
+    function GetViewNormal: TPoint3D;
+    function GetViewNormal_128: TPoint3D_128;
+    function GetViewCenter: TPoint3D;
+    function GetViewCenter_128: TPoint3D_128;
+    function GetViewCenterZ: single;
+    function GetBiface: boolean;
+    function GetLightThroughFactor: single;
+    function GetLightThroughFactorOverride: boolean;
+    procedure SetParentTexture(const AValue: boolean);
+    procedure SetTexture(const AValue: IBGRAScanner);
+    procedure SetColor(AColor: TBGRAPixel);
+    procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
+    procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
+    procedure SetTexCoord(AIndex: Integer; const AValue: TPointF);
+    procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
+    procedure SetBiface(const AValue: boolean);
+    procedure SetLightThroughFactor(const AValue: single);
+    procedure SetLightThroughFactorOverride(const AValue: boolean);
+    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+    procedure ComputeViewNormalAndCenter;
+    procedure SetMaterial(const AValue: IBGRAMaterial3D);
+    procedure SetMaterialName(const AValue: string);
+    function GetAsObject: TObject;
+    property Texture: IBGRAScanner read GetTexture write SetTexture;
+    property ParentTexture: boolean read GetParentTexture write SetParentTexture;
+    property VertexCount: integer read GetVertexCount;
+    property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
+    property VertexColor[AIndex: Integer]: TBGRAPixel read GetVertexColor write SetVertexColor;
+    property VertexColorOverride[AIndex: Integer]: boolean read GetVertexColorOverride write SetVertexColorOverride;
+    property TexCoord[AIndex: Integer]: TPointF read GetTexCoord write SetTexCoord;
+    property TexCoordOverride[AIndex: Integer]: boolean read GetTexCoordOverride write SetTexCoordOverride;
+    property ViewNormal: TPoint3D read GetViewNormal;
+    property ViewNormal_128: TPoint3D_128 read GetViewNormal_128;
+    property ViewCenter: TPoint3D read GetViewCenter;
+    property ViewCenter_128: TPoint3D_128 read GetViewCenter_128;
+    property ViewCenterZ: single read GetViewCenterZ;
+    property Object3D: IBGRAObject3D read GetObject3D;
+    property Biface: boolean read GetBiface write SetBiface;
+    property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
+    property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
+    property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
+    property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription;
+  end;
+  { TBGRAVertex3D }
+  TBGRAVertex3D = class(TInterfacedObject,IBGRAVertex3D)
+  private
+    FColor: TBGRAPixel;
+    FParentColor: boolean;
+    FLight: Single;
+    FTexCoord: TPointF;
+    FCoordPool: TBGRACoordPool3D;
+    FCoordPoolIndex: integer;
+    function GetCoordData: PBGRACoordData3D;
+    procedure Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+  public
+    constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload;
+    constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload;
+    destructor Destroy; override;
+    function GetColor: TBGRAPixel;
+    function GetLight: Single;
+    function GetViewNormal: TPoint3D;
+    function GetViewNormal_128: TPoint3D_128;
+    function GetSceneCoord: TPoint3D;
+    function GetSceneCoord_128: TPoint3D_128;
+    function GetTexCoord: TPointF;
+    function GetViewCoord: TPoint3D;
+    function GetViewCoord_128: TPoint3D_128;
+    function GetUsage: integer;
+    procedure SetColor(const AValue: TBGRAPixel);
+    procedure SetLight(const AValue: Single);
+    procedure SetViewNormal(const AValue: TPoint3D);
+    procedure SetViewNormal_128(const AValue: TPoint3D_128);
+    procedure NormalizeViewNormal;
+    procedure AddViewNormal(const AValue: TPoint3D_128);
+    procedure SetSceneCoord(const AValue: TPoint3D);
+    procedure SetSceneCoord_128(const AValue: TPoint3D_128);
+    procedure SetTexCoord(const AValue: TPointF);
+    procedure SetViewCoord(const AValue: TPoint3D);
+    procedure SetViewCoord_128(const AValue: TPoint3D_128);
+    function GetViewCoordZ: single;
+    function GetParentColor: Boolean;
+    procedure SetParentColor(const AValue: Boolean);
+    function GetProjectedCoord: TPointF;
+    procedure SetProjectedCoord(const AValue: TPointF);
+    procedure ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    property SceneCoord: TPoint3D read GetSceneCoord write SetSceneCoord;
+    property SceneCoord_128: TPoint3D_128 read GetSceneCoord_128 write SetSceneCoord_128;
+    property ViewCoord: TPoint3D read GetViewCoord write SetViewCoord;
+    property ViewCoord_128: TPoint3D_128 read GetViewCoord_128 write SetViewCoord_128;
+    property ViewCoordZ: single read GetViewCoordZ;
+    property ProjectedCoord: TPointF read GetProjectedCoord write SetProjectedCoord;
+    property TexCoord: TPointF read GetTexCoord write SetTexCoord;
+    property Color: TBGRAPixel read GetColor write SetColor;
+    property ParentColor: Boolean read GetParentColor write SetParentColor;
+    property Light: Single read GetLight write SetLight;
+    property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
+    property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
+    property Usage: integer read GetUsage;
+    property CoordData: PBGRACoordData3D read GetCoordData;
+    function GetAsObject: TObject;
+  end;
+{ TBGRAVertex3D }
+procedure TBGRAVertex3D.Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+begin
+  FCoordPool := ACoordPool;
+  FCoordPoolIndex := FCoordPool.Add;
+  FColor := BGRAWhite;
+  FParentColor := True;
+  FLight := 1;
+  SceneCoord_128 := ASceneCoord;
+end;
+function TBGRAVertex3D.GetCoordData: PBGRACoordData3D;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex];
+end;
+constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D);
+begin
+  Init(ACoordPool, Point3D_128(ASceneCoord));
+end;
+constructor TBGRAVertex3D.Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+begin
+  Init(ACoordPool, ASceneCoord);
+end;
+destructor TBGRAVertex3D.Destroy;
+begin
+  FCoordPool.Remove(FCoordPoolIndex);
+  inherited Destroy;
+end;
+function TBGRAVertex3D.GetColor: TBGRAPixel;
+begin
+  result := FColor;
+end;
+function TBGRAVertex3D.GetLight: Single;
+begin
+  result := FLight;
+end;
+function TBGRAVertex3D.GetViewNormal: TPoint3D;
+begin
+  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
+end;
+function TBGRAVertex3D.GetViewNormal_128: TPoint3D_128;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal;
+end;
+function TBGRAVertex3D.GetSceneCoord: TPoint3D;
+begin
+  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord);
+end;
+function TBGRAVertex3D.GetSceneCoord_128: TPoint3D_128;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord;
+end;
+function TBGRAVertex3D.GetTexCoord: TPointF;
+begin
+  result := FTexCoord;
+end;
+function TBGRAVertex3D.GetViewCoord: TPoint3D;
+begin
+  result := Point3D(FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord);
+end;
+function TBGRAVertex3D.GetViewCoord_128: TPoint3D_128;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord;
+end;
+function TBGRAVertex3D.GetUsage: integer;
+begin
+  result := frefcount;
+end;
+procedure TBGRAVertex3D.SetColor(const AValue: TBGRAPixel);
+begin
+  FColor := AValue;
+  FParentColor := false;
+end;
+procedure TBGRAVertex3D.SetLight(const AValue: Single);
+begin
+  FLight := AValue;
+end;
+procedure TBGRAVertex3D.SetViewNormal(const AValue: TPoint3D);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := Point3D_128(AValue);
+end;
+procedure TBGRAVertex3D.SetViewNormal_128(const AValue: TPoint3D_128);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal := AValue;
+end;
+procedure TBGRAVertex3D.SetSceneCoord(const AValue: TPoint3D);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := Point3D_128(AValue);
+end;
+procedure TBGRAVertex3D.SetSceneCoord_128(const AValue: TPoint3D_128);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.sceneCoord := AValue;
+end;
+procedure TBGRAVertex3D.SetTexCoord(const AValue: TPointF);
+begin
+  FTexCoord := AValue;
+end;
+procedure TBGRAVertex3D.SetViewCoord(const AValue: TPoint3D);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := Point3D_128(AValue);
+end;
+procedure TBGRAVertex3D.SetViewCoord_128(const AValue: TPoint3D_128);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord := AValue;
+end;
+function TBGRAVertex3D.GetViewCoordZ: single;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex]^.viewCoord.Z;
+end;
+function TBGRAVertex3D.GetParentColor: Boolean;
+begin
+  result := FParentColor;
+end;
+procedure TBGRAVertex3D.SetParentColor(const AValue: Boolean);
+begin
+  FParentColor := AValue;
+end;
+function TBGRAVertex3D.GetProjectedCoord: TPointF;
+begin
+  result := FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord;
+end;
+procedure TBGRAVertex3D.SetProjectedCoord(const AValue: TPointF);
+begin
+  FCoordPool.CoordData[FCoordPoolIndex]^.projectedCoord := AValue;
+end;
+procedure TBGRAVertex3D.ComputeCoordinateAndClearNormal(const AMatrix: TMatrix3D; const AProjection : TProjection3D);
+var P: PBGRACoordData3D;
+begin
+  P := FCoordPool.CoordData[FCoordPoolIndex];
+  with p^ do
+  begin
+    viewCoord := AMatrix*sceneCoord;
+    ClearPoint3D_128(viewNormal);
+    if viewCoord.z > 0 then
+    begin
+      InvZ := 1/viewCoord.z;
+      projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
+                               viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
+    end else
+      projectedCoord := PointF(0,0);
+  end;
+end;
+function TBGRAVertex3D.GetAsObject: TObject;
+begin
+  result := self;
+end;
+procedure TBGRAVertex3D.NormalizeViewNormal;
+begin
+  Normalize3D_128(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal);
+end;
+procedure TBGRAVertex3D.AddViewNormal(const AValue: TPoint3D_128);
+begin
+  Add3D_Aligned(FCoordPool.CoordData[FCoordPoolIndex]^.viewNormal, AValue);
+end;
+{ TBGRAFace3D }
+function TBGRAFace3D.GetVertexDescription(AIndex : integer
+  ): PBGRAFaceVertexDescription;
+begin
+  result := @FVertices[AIndex];
+end;
+function TBGRAFace3D.GetObject3D: IBGRAObject3D;
+begin
+  result := FObject3D;
+end;
+constructor TBGRAFace3D.Create(AObject3D: IBGRAObject3D;
+  AVertices: array of IBGRAVertex3D);
+var
+  i: Integer;
+begin
+  SetLength(FVertices, length(AVertices));
+  for i:= 0 to high(AVertices) do
+    AddVertex(AVertices[i]);
+  FObject3D := AObject3D;
+  FBiface := false;
+  FParentTexture := True;
+  FLightThroughFactor:= 0;
+  FLightThroughFactorOverride:= false;
+end;
+destructor TBGRAFace3D.Destroy;
+begin
+  fillchar(FTexture,sizeof(FTexture),0);
+  inherited Destroy;
+end;
+procedure TBGRAFace3D.AddVertex(AVertex: IBGRAVertex3D);
+begin
+  if FVertexCount = length(FVertices) then
+    setlength(FVertices, FVertexCount*2+3);
+  with FVertices[FVertexCount] do
+  begin
+    Color := BGRAWhite;
+    ColorOverride := false;
+    TexCoord := PointF(0,0);
+    TexCoordOverride := false;
+    Vertex := AVertex;
+  end;
+  inc(FVertexCount);
+end;
+function TBGRAFace3D.GetParentTexture: boolean;
+begin
+  result := FParentTexture;
+end;
+function TBGRAFace3D.GetTexture: IBGRAScanner;
+begin
+  result := FTexture;
+end;
+function TBGRAFace3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FVertices[AIndex].Vertex;
+end;
+procedure TBGRAFace3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  FVertices[AIndex].Vertex := AValue;
+end;
+function TBGRAFace3D.GetVertexColor(AIndex: Integer): TBGRAPixel;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FVertices[AIndex].Color;
+end;
+function TBGRAFace3D.GetVertexColorOverride(AIndex: Integer): boolean;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FVertices[AIndex].ColorOverride;
+end;
+function TBGRAFace3D.GetVertexCount: integer;
+begin
+  result := FVertexCount;
+end;
+function TBGRAFace3D.GetMaterial: IBGRAMaterial3D;
+begin
+  result := FMaterial;
+end;
+function TBGRAFace3D.GetMaterialName: string;
+begin
+  result := FMaterialName;
+end;
+procedure TBGRAFace3D.SetParentTexture(const AValue: boolean);
+begin
+  FParentTexture := AValue;
+end;
+procedure TBGRAFace3D.SetTexture(const AValue: IBGRAScanner);
+begin
+  FTexture := AValue;
+  FParentTexture := false;
+end;
+procedure TBGRAFace3D.SetColor(AColor: TBGRAPixel);
+var i: integer;
+begin
+  for i := 0 to GetVertexCount-1 do
+    SetVertexColor(i,AColor);
+end;
+procedure TBGRAFace3D.SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel
+  );
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  with FVertices[AIndex] do
+  begin
+    Color := AValue;
+    ColorOverride := true;
+  end;
+end;
+procedure TBGRAFace3D.SetVertexColorOverride(AIndex: Integer;
+  const AValue: boolean);
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  FVertices[AIndex].ColorOverride := AValue;
+end;
+function TBGRAFace3D.GetTexCoord(AIndex: Integer): TPointF;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FVertices[AIndex].TexCoord;
+end;
+function TBGRAFace3D.GetTexCoordOverride(AIndex: Integer): boolean;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FVertices[AIndex].TexCoordOverride;
+end;
+procedure TBGRAFace3D.SetTexCoord(AIndex: Integer; const AValue: TPointF);
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  FVertices[AIndex].TexCoord := AValue;
+  FVertices[AIndex].TexCoordOverride := true;
+end;
+procedure TBGRAFace3D.SetTexCoordOverride(AIndex: Integer; const AValue: boolean
+  );
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise Exception.Create('Index out of bounds');
+  FVertices[AIndex].TexCoordOverride := AValue;
+end;
+function TBGRAFace3D.GetViewNormal: TPoint3D;
+begin
+  result := Point3D(FViewNormal);
+end;
+function TBGRAFace3D.GetViewNormal_128: TPoint3D_128;
+begin
+  result := FViewNormal;
+end;
+function TBGRAFace3D.GetViewCenter: TPoint3D;
+begin
+  result := Point3D(FViewCenter);
+end;
+function TBGRAFace3D.GetViewCenter_128: TPoint3D_128;
+begin
+  result := FViewCenter;
+end;
+function TBGRAFace3D.GetViewCenterZ: single;
+begin
+  result := FViewCenter.Z;
+end;
+function TBGRAFace3D.GetBiface: boolean;
+begin
+  result := FBiface;
+end;
+procedure TBGRAFace3D.SetBiface(const AValue: boolean);
+begin
+  FBiface := AValue;
+end;
+function TBGRAFace3D.GetLightThroughFactor: single;
+begin
+  result := FLightThroughFactor;
+end;
+function TBGRAFace3D.GetLightThroughFactorOverride: boolean;
+begin
+  result := FLightThroughFactorOverride;
+end;
+procedure TBGRAFace3D.SetLightThroughFactor(const AValue: single);
+begin
+  if AValue < 0 then
+    FLightThroughFactor := 0
+  else
+    FLightThroughFactor:= AValue;
+  FLightThroughFactorOverride := true;
+end;
+procedure TBGRAFace3D.SetLightThroughFactorOverride(const AValue: boolean);
+begin
+  FLightThroughFactorOverride := AValue;
+end;
+procedure TBGRAFace3D.ComputeViewNormalAndCenter;
+var v1,v2: TPoint3D_128;
+  i: Integer;
+  p0,p1,p2: IBGRAVertex3D;
+begin
+  if FVertexCount < 3 then
+    ClearPoint3D_128(FViewNormal)
+  else
+  begin
+    p0 := FVertices[0].Vertex;
+    p1 := FVertices[1].Vertex;
+    p2 := FVertices[2].Vertex;
+    v1 := p1.ViewCoord_128 - p0.ViewCoord_128;
+    v2 := p2.ViewCoord_128 - p1.ViewCoord_128;
+    VectProduct3D_128(v2,v1,FViewNormal);
+    Normalize3D_128(FViewNormal);
+    for i := 0 to FVertexCount-1 do
+      FVertices[i].Vertex.AddViewNormal(FViewNormal);
+  end;
+  ClearPoint3D_128(FViewCenter);
+  if FVertexCount > 0 then
+  begin
+    for i := 0 to FVertexCount-1 do
+      FViewCenter += FVertices[i].Vertex.ViewCoord_128;
+    FViewCenter *= 1/FVertexCount;
+  end;
+end;
+procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D);
+begin
+  FMaterial := AValue;
+end;
+procedure TBGRAFace3D.SetMaterialName(const AValue: string);
+begin
+  if AValue <> FMaterialName then
+  begin
+    FMaterialName := AValue;
+    FObject3D.Scene.UseMaterial(FMaterialName, self);
+  end;
+end;
+function TBGRAFace3D.GetAsObject: TObject;
+begin
+  result := self;
+end;
+{ TBGRAPart3D }
+procedure TBGRAPart3D.LookAt(ALookWhere,ATopDir: TPoint3D);
+var ZDir, XDir, YDir: TPoint3D_128;
+    ViewPoint: TPoint3D_128;
+    CurPart: IBGRAPart3D;
+    ComposedMatrix: TMatrix3D;
+begin
+  YDir := -Point3D_128(ATopDir);
+  if IsPoint3D_128_Zero(YDir) then exit;
+  Normalize3D_128(YDir);
+  ComposedMatrix := FMatrix;
+  CurPart := self.FContainer;
+  while CurPart <> nil do
+  begin
+    ComposedMatrix := CurPart.Matrix*ComposedMatrix;
+    CurPart := CurPart.Container;
+  end;
+  ViewPoint := ComposedMatrix*Point3D_128_Zero;
+  ZDir := Point3D_128(ALookWhere)-ViewPoint;
+  if IsPoint3D_128_Zero(ZDir) then exit;
+  Normalize3D_128(ZDir);
+  VectProduct3D_128(YDir,ZDir,XDir);
+  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
+  FMatrix := Matrix3D(XDir,YDir,ZDir,ViewPoint);
+  ComposedMatrix := MatrixIdentity3D;
+  CurPart := self.FContainer;
+  while CurPart <> nil do
+  begin
+    ComposedMatrix := CurPart.Matrix*ComposedMatrix;
+    CurPart := CurPart.Container;
+  end;
+  FMatrix := MatrixInverse3D(ComposedMatrix)*FMatrix;
+end;
+procedure TBGRAPart3D.RemoveUnusedVertices;
+var
+  i: Integer;
+begin
+  for i := FVertexCount-1 downto 0 do
+    if FVertices[i].Usage <= 2 then RemoveVertex(i);
+  for i := 0 to FPartCount-1 do
+    FParts[i].RemoveUnusedVertices;
+end;
+function TBGRAPart3D.IndexOf(AVertex: IBGRAVertex3D): integer;
+var i: integer;
+begin
+  for i := 0 to FVertexCount-1 do
+    if FVertices[i] = AVertex then
+    begin
+      result := i;
+      exit;
+    end;
+  result := -1;
+end;
+procedure TBGRAPart3D.Add(AVertex: IBGRAVertex3D);
+begin
+  if FVertexCount = length(FVertices) then
+    setlength(FVertices, FVertexCount*2+3);
+  FVertices[FVertexCount] := AVertex;
+  inc(FVertexCount);
+end;
+procedure TBGRAPart3D.RemoveVertex(Index: integer);
+var i: integer;
+begin
+  if (Index >= 0) and (Index < FVertexCount) then
+  begin
+    for i := Index to FVertexCount-2 do
+      FVertices[i] := FVertices[i+1];
+    FVertices[FVertexCount-1] := nil;
+    dec(FVertexCount);
+  end;
+end;
+function TBGRAPart3D.GetRadius: single;
+var i: integer;
+    pt: TPoint3D_128;
+    d: single;
+begin
+  result := 0;
+  for i := 0 to GetVertexCount-1 do
+  begin
+    pt := GetVertex(i).SceneCoord_128;
+    d:= sqrt(DotProduct3D_128(pt,pt));
+    if d > result then result := d;
+  end;
+end;
+constructor TBGRAPart3D.Create(AContainer: IBGRAPart3D);
+begin
+  FContainer := AContainer;
+  FMatrix := MatrixIdentity3D;
+  FCoordPool := TBGRACoordPool3D.Create(4);
+end;
+destructor TBGRAPart3D.Destroy;
+begin
+  FCoordPool.Free;
+  inherited Destroy;
+end;
+procedure TBGRAPart3D.Clear(ARecursive: boolean);
+var i: integer;
+begin
+  FVertices := nil;
+  FVertexCount := 0;
+  if ARecursive then
+  begin
+    for i := 0 to FPartCount-1 do
+      FParts[i].Clear(ARecursive);
+    FParts := nil;
+    FPartCount := 0;
+  end;
+end;
+function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D;
+begin
+  result := TBGRAVertex3D.Create(FCoordPool,Point3D(x,y,z));
+  Add(result);
+end;
+function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D;
+begin
+  result := TBGRAVertex3D.Create(FCoordPool,pt);
+  Add(result);
+end;
+function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D;
+begin
+  result := TBGRAVertex3D.Create(FCoordPool,pt);
+  Add(result);
+end;
+function TBGRAPart3D.Add(const coords: array of single
+  ): arrayOfIBGRAVertex3D;
+var pts: array of TPoint3D;
+    CoordsIdx: integer;
+    i: Integer;
+begin
+  if length(coords) mod 3 <> 0 then
+    raise exception.Create('Array size must be a multiple of 3');
+  setlength(pts, length(coords) div 3);
+  coordsIdx := 0;
+  for i := 0 to high(pts) do
+  begin
+    pts[i] := Point3D(coords[CoordsIdx],coords[CoordsIdx+1],coords[CoordsIdx+2]);
+    inc(coordsIdx,3);
+  end;
+  result := Add(pts);
+end;
+function TBGRAPart3D.Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
+var
+  i: Integer;
+begin
+  setlength(result, length(pts));
+  for i := 0 to high(pts) do
+    result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
+  Add(result);
+end;
+function TBGRAPart3D.Add(const pts: array of TPoint3D_128
+  ): arrayOfIBGRAVertex3D;
+var
+  i: Integer;
+begin
+  setlength(result, length(pts));
+  for i := 0 to high(pts) do
+    result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
+  Add(result);
+end;
+procedure TBGRAPart3D.Add(const pts: array of IBGRAVertex3D);
+var
+  i: Integer;
+begin
+  if FVertexCount + length(pts) > length(FVertices) then
+    setlength(FVertices, (FVertexCount*2 + length(pts))+1);
+  for i := 0 to high(pts) do
+  begin
+    FVertices[FVertexCount] := pts[i];
+    inc(FVertexCount);
+  end;
+end;
+function TBGRAPart3D.GetBoundingBox: TBox3D;
+var i: integer;
+    pt: TPoint3D_128;
+begin
+  if GetVertexCount > 0 then
+  begin
+    result.min := GetVertex(0).SceneCoord;
+    result.max := result.min;
+  end else
+  begin
+    result.min := Point3D(0,0,0);
+    result.max := Point3D(0,0,0);
+    exit;
+  end;
+  for i := 1 to GetVertexCount-1 do
+  begin
+    pt := GetVertex(i).SceneCoord_128;
+    if pt.x < result.min.x then result.min.x := pt.x else
+    if pt.x > result.max.x then result.max.x := pt.x;
+    if pt.y < result.min.y then result.min.y := pt.y else
+    if pt.y > result.max.y then result.max.y := pt.y;
+    if pt.z < result.min.z then result.min.z := pt.z else
+    if pt.z > result.max.z then result.max.z := pt.z;
+  end;
+end;
+function TBGRAPart3D.GetMatrix: TMatrix3D;
+begin
+  result := FMatrix;
+end;
+function TBGRAPart3D.GetPart(AIndex: Integer): IBGRAPart3D;
+begin
+  if (AIndex < 0) or (AIndex >= FPartCount) then
+    raise exception.Create('Index of out bounds');
+  result := FParts[AIndex];
+end;
+function TBGRAPart3D.GetPartCount: integer;
+begin
+  result := FPartCount;
+end;
+function TBGRAPart3D.GetVertex(AIndex: Integer): IBGRAVertex3D;
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise exception.Create('Index of out bounds');
+  result := FVertices[AIndex];
+end;
+function TBGRAPart3D.GetVertexCount: integer;
+begin
+  result := FVertexCount;
+end;
+function TBGRAPart3D.GetTotalVertexCount: integer;
+var i: integer;
+begin
+  result := GetVertexCount;
+  for i := 0 to GetPartCount-1 do
+    result += GetPart(i).GetTotalVertexCount;
+end;
+procedure TBGRAPart3D.ResetTransform;
+begin
+  FMatrix := MatrixIdentity3D;
+end;
+procedure TBGRAPart3D.Scale(size: single; Before: boolean = true);
+begin
+  Scale(size,size,size,Before);
+end;
+procedure TBGRAPart3D.Scale(x, y, z: single; Before: boolean = true);
+begin
+  Scale(Point3D(x,y,z),Before);
+end;
+procedure TBGRAPart3D.Scale(size: TPoint3D; Before: boolean = true);
+begin
+  if Before then
+    FMatrix *= MatrixScale3D(size)
+  else
+    FMatrix := MatrixScale3D(size)*FMatrix;
+end;
+procedure TBGRAPart3D.RotateXDeg(angle: single; Before: boolean = true);
+begin
+  RotateXRad(-angle*Pi/180, Before);
+end;
+procedure TBGRAPart3D.RotateYDeg(angle: single; Before: boolean = true);
+begin
+  RotateYRad(-angle*Pi/180, Before);
+end;
+procedure TBGRAPart3D.RotateZDeg(angle: single; Before: boolean = true);
+begin
+  RotateZRad(-angle*Pi/180, Before);
+end;
+procedure TBGRAPart3D.RotateXRad(angle: single; Before: boolean = true);
+begin
+  if Before then
+    FMatrix *= MatrixRotateX(angle)
+  else
+    FMatrix := MatrixRotateX(angle) * FMatrix;
+end;
+procedure TBGRAPart3D.RotateYRad(angle: single; Before: boolean = true);
+begin
+  if Before then
+    FMatrix *= MatrixRotateY(angle)
+  else
+    FMatrix := MatrixRotateY(angle) * FMatrix;
+end;
+procedure TBGRAPart3D.RotateZRad(angle: single; Before: boolean = true);
+begin
+  if Before then
+    FMatrix *= MatrixRotateZ(angle)
+  else
+    FMatrix := MatrixRotateZ(angle) * FMatrix;
+end;
+procedure TBGRAPart3D.SetMatrix(const AValue: TMatrix3D);
+begin
+  FMatrix := AValue;
+end;
+procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+var
+  i: Integer;
+  Composed: TMatrix3D;
+  P: PBGRACoordData3D;
+begin
+  Composed := AMatrix* self.FMatrix;
+  {$IFDEF CPUI386}
+  if UseSSE then
+  begin
+    Matrix3D_SSE_Load(Composed);
+    asm
+      mov eax,[AProjection]
+      movups xmm4,[eax]
+      xorps xmm1,xmm1
+    end;
+    P := FCoordPool.CoordData[0];
+    i := FCoordPool.UsedCapacity;
+    if UseSSE3 then
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord);
+        if viewCoord.z > 0 then
+        begin
+          asm
+            mov eax, P
+            movaps xmm3, [eax+16] //viewCoord
+            movaps xmm2,xmm3
+            shufps xmm2,xmm3,2+8+32+128
+            rcpps xmm2,xmm2  //xmm2 = InvZ
+            movss [eax+40],xmm2 //-> InvZ
+            mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+            mulps xmm3,xmm2  //xmm3 *= InvZ
+            movhlps xmm0,xmm4  //xmm2 = Projection.Center
+            addps xmm3,xmm0  //xmm3 += Projection.Center
+            movlps [eax+32],xmm3 //->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+        end else
+        asm
+          mov eax, P
+          movlps [eax+32],xmm1  //0 ->projectedCoord
+          movaps [eax+48],xmm1 //->normal
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end else
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord);
+        if viewCoord.z > 0 then
+        begin
+          asm
+            mov eax, P
+            movaps xmm3, [eax+16] //viewCoord
+            movaps xmm2,xmm3
+            shufps xmm2,xmm3,2+8+32+128
+            rcpps xmm2,xmm2  //xmm2 = InvZ
+            movss [eax+40],xmm2 //-> InvZ
+            mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+            mulps xmm3,xmm2  //xmm3 *= InvZ
+            movhlps xmm0,xmm4  //xmm2 = Projection.Center
+            addps xmm3,xmm0  //xmm3 += Projection.Center
+            movlps [eax+32],xmm3 //->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+        end else
+        asm
+          mov eax, P
+          movlps [eax+32],xmm1  //0 ->projectedCoord
+          movaps [eax+48],xmm1 //->normal
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end;
+  end
+  else
+  {$ENDIF}
+  begin
+    P := FCoordPool.CoordData[0];
+    i := FCoordPool.UsedCapacity;
+    while i > 0 do
+    with P^ do
+    begin
+      viewCoord := Composed*sceneCoord;
+      ClearPoint3D_128(viewNormal);
+      if viewCoord.z > 0 then
+      begin
+        InvZ := 1/viewCoord.z;
+        projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
+                                 viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
+      end else
+        projectedCoord := PointF(0,0);
+      dec(i);
+      inc(p);
+    end;
+  end;
+  for i := 0 to FPartCount-1 do
+    FParts[i].ComputeWithMatrix(Composed,AProjection);
+end;
+function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
+var part: IBGRAPart3D;
+  newViewCoord: TPoint3D_128;
+  InvZ: single;
+begin
+  newViewCoord := FMatrix * ASceneCoord;
+  part := FContainer;
+  while part <> nil do
+  begin
+    newViewCoord := part.Matrix * newViewCoord;
+    part := part.Container;
+  end;
+  if NewViewCoord.z > 0 then
+  begin
+    InvZ := 1/NewViewCoord.z;
+    result := PointF(NewViewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
+                     NewViewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
+  end else
+    result := PointF(0,0);
+end;
+procedure TBGRAPart3D.NormalizeViewNormal;
+var
+  i: Integer;
+begin
+  for i := 0 to FVertexCount-1 do
+    FVertices[i].NormalizeViewNormal;
+  for i := 0 to FPartCount-1 do
+    FParts[i].NormalizeViewNormal;
+end;
+procedure TBGRAPart3D.Translate(x, y, z: single; Before: boolean = true);
+begin
+  Translate(Point3D(x,y,z),Before);
+end;
+procedure TBGRAPart3D.Translate(ofs: TPoint3D; Before: boolean = true);
+begin
+  if Before then
+    FMatrix *= MatrixTranslation3D(ofs)
+  else
+    FMatrix := MatrixTranslation3D(ofs)*FMatrix;
+end;
+function TBGRAPart3D.CreatePart: IBGRAPart3D;
+begin
+  if FPartCount = length(FParts) then
+    setlength(FParts, FPartCount*2+1);
+  result := TBGRAPart3D.Create(self);
+  FParts[FPartCount] := result;
+  inc(FPartCount);
+end;
+function TBGRAPart3D.GetContainer: IBGRAPart3D;
+begin
+  result := FContainer;
+end;
+procedure TBGRAPart3D.SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+begin
+  if (AIndex < 0) or (AIndex >= FVertexCount) then
+    raise exception.Create('Index of out bounds');
+  FVertices[AIndex] := AValue;
+end;
+{ TBGRAObject3D }
+procedure TBGRAObject3D.AddFace(AFace: IBGRAFace3D);
+begin
+  if FFaceCount = length(FFaces) then
+     setlength(FFaces,FFaceCount*2+3);
+  FFaces[FFaceCount] := AFace;
+  inc(FFaceCount);
+end;
+constructor TBGRAObject3D.Create(AScene: TBGRAScene3D);
+begin
+  FColor := BGRAWhite;
+  FLight := 1;
+  FTexture := nil;
+  FMainPart := TBGRAPart3D.Create(nil);
+  FLightingNormal:= AScene.DefaultLightingNormal;
+  FParentLighting:= True;
+  FScene := AScene;
+end;
+destructor TBGRAObject3D.Destroy;
+begin
+  fillchar(FTexture,sizeof(FTexture),0);
+  inherited Destroy;
+end;
+procedure TBGRAObject3D.Clear;
+begin
+  FFaces := nil;
+  FFaceCount := 0;
+  FMainPart.Clear(True);
+end;
+function TBGRAObject3D.GetColor: TBGRAPixel;
+begin
+  result := FColor;
+end;
+function TBGRAObject3D.GetLight: Single;
+begin
+  result := FLight;
+end;
+function TBGRAObject3D.GetTexture: IBGRAScanner;
+begin
+  result := FTexture;
+end;
+function TBGRAObject3D.GetMainPart: IBGRAPart3D;
+begin
+  result := FMainPart;
+end;
+procedure TBGRAObject3D.SetColor(const AValue: TBGRAPixel);
+begin
+  FColor := AValue;
+  FTexture := nil;
+end;
+procedure TBGRAObject3D.SetLight(const AValue: Single);
+begin
+  FLight := AValue;
+end;
+procedure TBGRAObject3D.SetTexture(const AValue: IBGRAScanner);
+begin
+  FTexture := AValue;
+end;
+procedure TBGRAObject3D.SetMaterial(const AValue: IBGRAMaterial3D);
+begin
+  FMaterial := AValue;
+end;
+procedure TBGRAObject3D.RemoveUnusedVertices;
+begin
+  GetMainPart.RemoveUnusedVertices;
+end;
+procedure TBGRAObject3D.SeparatePart(APart: IBGRAPart3D);
+var
+  vertexInfo: array of record
+       orig,dup: IBGRAVertex3D;
+     end;
+  i,j: integer;
+  inPart,outPart: boolean;
+  idxV: integer;
+begin
+  setlength(vertexInfo, APart.VertexCount);
+  for i := 0 to high(vertexInfo) do
+    with vertexInfo[i] do
+    begin
+      orig := APart.Vertex[i];
+      dup := APart.Add(orig.SceneCoord_128);
+    end;
+  for i := 0 to GetFaceCount-1 do
+    with GetFace(i) do
+    begin
+      inPart := false;
+      outPart := false;
+      for j := 0 to VertexCount-1 do
+        if (APart.IndexOf(Vertex[j]) <> -1) then
+          inPart := true
+        else
+          outPart := true;
+      if inPart and not outPart then
+      begin
+        for j := 0 to VertexCount-1 do
+        begin
+          idxV := APart.IndexOf(Vertex[j]);
+          if idxV <> -1 then
+            Vertex[j] := vertexInfo[idxV].dup;
+        end;
+      end;
+    end;
+  for i := APart.VertexCount-1 downto 0 do
+    APart.RemoveVertex(i);
+end;
+function TBGRAObject3D.GetScene: TBGRAScene3D;
+begin
+  result := FScene;
+end;
+function TBGRAObject3D.GetRefCount: integer;
+begin
+  result := RefCount;
+end;
+procedure TBGRAObject3D.SetBiface(AValue: boolean);
+var i: integer;
+begin
+  for i := 0 to GetFaceCount-1 do
+    GetFace(i).Biface := AValue;
+end;
+function TBGRAObject3D.GetLightingNormal: TLightingNormal3D;
+begin
+  result := FLightingNormal;
+end;
+function TBGRAObject3D.GetParentLighting: boolean;
+begin
+  result := FParentLighting;
+end;
+procedure TBGRAObject3D.SetLightingNormal(const AValue: TLightingNormal3D);
+begin
+  FLightingNormal := AValue;
+  FParentLighting:= False;
+end;
+procedure TBGRAObject3D.SetParentLighting(const AValue: boolean);
+begin
+  FParentLighting:= AValue;
+end;
+procedure TBGRAObject3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+var
+  i: Integer;
+begin
+  FMainPart.ComputeWithMatrix(AMatrix,AProjection);
+  for i := 0 to FFaceCount-1 do
+    FFaces[i].ComputeViewNormalAndCenter;
+  FMainPart.NormalizeViewNormal;
+end;
+function TBGRAObject3D.AddFaceReversed(const AVertices: array of IBGRAVertex3D
+  ): IBGRAFace3D;
+var
+  tempVertices: array of IBGRAVertex3D;
+  i: Integer;
+begin
+  setlength(tempVertices,length(AVertices));
+  for i := 0 to high(tempVertices) do
+    tempVertices[i] := AVertices[high(AVertices)-i];
+  result := AddFace(tempVertices);
+end;
+function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
+begin
+  result := TBGRAFace3D.Create(self,AVertices);
+  AddFace(result);
+end;
+function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
+  ABiface: boolean): IBGRAFace3D;
+begin
+  result := TBGRAFace3D.Create(self,AVertices);
+  result.Biface := ABiface;
+  AddFace(result);
+end;
+function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
+var Face: IBGRAFace3D;
+begin
+  Face := TBGRAFace3D.Create(self,AVertices);
+  Face.Texture := ATexture;
+  AddFace(Face);
+  result := face;
+end;
+function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
+  AColor: TBGRAPixel): IBGRAFace3D;
+var Face: IBGRAFace3D;
+begin
+  Face := TBGRAFace3D.Create(self,AVertices);
+  Face.SetColor(AColor);
+  Face.Texture := nil;
+  AddFace(Face);
+  result := face;
+end;
+function TBGRAObject3D.AddFace(const AVertices: array of IBGRAVertex3D;
+  AColors: array of TBGRAPixel): IBGRAFace3D;
+var
+  i: Integer;
+begin
+  if length(AColors) <> length(AVertices) then
+    raise Exception.Create('Dimension mismatch');
+  result := TBGRAFace3D.Create(self,AVertices);
+  for i := 0 to high(AColors) do
+    result.VertexColor[i] := AColors[i];
+  AddFace(result);
+end;
+function TBGRAObject3D.GetFace(AIndex: integer): IBGRAFace3D;
+begin
+  if (AIndex < 0) or (AIndex >= FFaceCount) then
+    raise Exception.Create('Index out of bounds');
+  result := FFaces[AIndex];
+end;
+function TBGRAObject3D.GetFaceCount: integer;
+begin
+  result := FFaceCount;
+end;
+function TBGRAObject3D.GetTotalVertexCount: integer;
+begin
+  result := GetMainPart.TotalVertexCount;
+end;
+function TBGRAObject3D.GetMaterial: IBGRAMaterial3D;
+begin
+  result := FMaterial;
+end;
+    procedure ForEachVertex(ACallback: TVertex3DCallback);
+    procedure ForEachFace(ACallback: TFace3DCallback);
+  end;
+{$i part3d.inc}
+{$i object3d.inc}
+{$i shapes3d.inc}
 { TBGRAScene3D }
 …
 end;
+function TBGRAScene3D.GetNormalCount: integer;
+var i: integer;
+begin
+  result := 0;
+  for i := 0 to Object3DCount-1 do
+    result += Object3D[i].TotalNormalCount;
+end;
 function TBGRAScene3D.GetAmbiantLightness: single;
 begin
 …
 procedure TBGRAScene3D.Init;
 begin
+  UnknownColor := BGRA(0,128,255);
   FAutoZoom := True;
   FAutoViewCenter := True;
 …
 var i: integer;
 begin
+  for i := 0 to FLights.Count-1 do
+    TBGRALight3D(FLights[i])._Release;
+  FLights.Clear;
   for i := 0 to FObjectCount-1 do
     FObjects[i].Clear;
   FObjects := nil;
   FObjectCount := 0;
+  for i := 0 to FLights.Count-1 do
     IBGRALight3D(TBGRALight3D(FLights[i]))._Release;
   FLights.Clear;
 end;
+{$hints off}
+  FMaterials := nil;
+  FMaterialCount := 0;
+  DefaultMaterial := CreateMaterial;
+end;
 procedure TBGRAScene3D.UseMaterial(AMaterialName: string; AFace: IBGRAFace3D);
+var color: TBGRAPixel;
+begin
+  color := BGRA(0,128,255);
+  AFace.SetColor(color);
+end;
+{$hints on}
+  function ParseColor(text: string): TBGRAPixel;
+  var
+    color,tempColor: TBGRAPixel;
+  begin
+    color := UnknownColor;
+    if copy(text,1,2) = 'dk' then
+    begin
+      tempcolor := ParseColor(copy(text,3,length(text)-2));
+      tempcolor := MergeBGRA(tempcolor,3,BGRABlack,1);
+      color := StrToBGRA('dark'+copy(text,3,length(text)-2),tempcolor);
+    end;
+    if copy(text,1,2) = 'lt' then
+    begin
+      tempcolor := ParseColor(copy(text,3,length(text)-2));
+      tempcolor := MergeBGRA(tempcolor,3,BGRAWhite,1);
+      color := StrToBGRA('light'+copy(text,3,length(text)-2),tempcolor);
+    end;
+    Color := StrToBGRA(StringReplace(text,'deep','dark',[]),Color);
+    Color := StrToBGRA(StringReplace(text,'dark','deep',[]),Color);
+    Color := StrToBGRA(text,Color);
+    result := color;
+  end;
+var
+  mat: IBGRAMaterial3D;
+  c: TBGRAPixel;
+begin
+  mat := GetMaterialByName(AMaterialName);
+  if mat = nil then
+  begin
+    mat := CreateMaterial;
+    mat.Name := AMaterialName;
+    c := ParseColor(AMaterialName);
+    mat.AmbiantColor := c;
+    mat.DiffuseColor := c;
+  end;
+  AFace.Material := mat;
+end;
+function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner;
+begin
+  result := nil;
+  texSize := PointF(1,1);
+end;
 function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D;
+var t: textfile;
+    s: string;
+var source: TFileStream;
+begin
+  source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
+  try
+    result := LoadObjectFromStream(source,SwapFacesOrientation);
+  finally
+    source.free;
+  end;
+end;
+function TBGRAScene3D.LoadObjectFromFileUTF8(AFilename: string;
+  SwapFacesOrientation: boolean): IBGRAObject3D;
+var source: TFileStreamUTF8;
+begin
+  source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite);
+  try
+    result := LoadObjectFromStream(source,SwapFacesOrientation);
+  finally
+    source.free;
+  end;
+end;
+function TBGRAScene3D.LoadObjectFromStream(AStream: TStream;
+  SwapFacesOrientation: boolean): IBGRAObject3D;
+var s: string;
+  secondValue,thirdValue: string;
   function GetNextToken: string;
   var idxStart,idxEnd: integer;
+  var idxStart,idxEnd,idxSlash: integer;
   begin
     idxStart := 1;
     while (idxStart <= length(s)) and (s[idxStart]=' ') do inc(idxStart);
+    while (idxStart <= length(s)) and (s[idxStart]in[' ',#9]) do inc(idxStart);
     if idxStart > length(s) then
     begin
 …
     end;
     idxEnd := idxStart;
     while (idxEnd < length(s)) and (s[idxEnd+1]<> ' ') do inc(idxEnd);
+    while (idxEnd < length(s)) and not (s[idxEnd+1]in[' ',#9]) do inc(idxEnd);
     result := copy(s,idxStart, idxEnd-idxStart+1);
     delete(s,1,idxEnd);
+    if pos('/',result) <> 0 then result := copy(result,1,pos('/',result)-1);
+    idxSlash := pos('/',result);
+    if idxSlash <> 0 then
+    begin
+      secondValue:= copy(result,idxSlash+1,length(result)-idxSlash);
+      result := copy(result,1,idxSlash-1);
+      idxSlash:= pos('/',secondValue);
+      if idxSlash <> 0 then
+      begin
+        thirdValue:= copy(secondValue,idxSlash+1,length(secondValue)-idxSlash);
+        secondValue:= copy(secondValue,1,idxSlash-1);
+      end else
+        thirdValue:= '';
+    end else
+    begin
+      secondValue:= '';
+      thirdValue:= '';
+    end;
+  end;
+type
+  TFaceVertexExtra = record
+    normal: IBGRANormal3D;
+    texCoord: TPointF;
   end;
 …
     x,y,z : single;
     code : integer;
+    vertices: array of IBGRAVertex3D;
+    NbVertices,v,i: integer;
+    faceVertices: array of IBGRAVertex3D;
+    faceExtra: array of TFaceVertexExtra;
+    NbFaceVertices,v,v2,v3,i: integer;
     tempV: IBGRAVertex3D;
+    tempN: TFaceVertexExtra;
     materialname: string;
     face: IBGRAFace3D;
+begin
+    lines: TStringList;
+    lineIndex: integer;
+    texCoords: array of TPointF;
+    nbTexCoords: integer;
+begin
+  lines := TStringList.Create;
+  lines.LoadFromStream(AStream);
   result := CreateObject;
+  assignfile(t,AFilename);
+  reset(t);
+  vertices := nil;
+  NbVertices:= 0;
+  faceVertices := nil;
+  faceExtra := nil;
+  NbFaceVertices:= 0;
   materialname := 'default';
+  while not eof(t) do
+  begin
+    readln(t,s);
+  lineIndex := 0;
+  texCoords := nil;
+  nbTexCoords:= 0;
+  while lineIndex < lines.Count do
+  begin
+    s := lines[lineIndex];
+    if pos('#',s) <> 0 then
+      s := copy(s,1,pos('#',s)-1);
+    inc(lineIndex);
     lineType := GetNextToken;
     if lineType = 'v' then
 …
       result.MainPart.Add(x,y,z);
     end else
+    if lineType = 'vt' then
+    begin
+      val(GetNextToken,x,code);
+      val(GetNextToken,y,code);
+      if nbTexCoords >= length(texCoords) then
+        setlength(texCoords, length(texCoords)*2+1);
+      texCoords[nbTexCoords] := PointF(x,y);
+      inc(nbTexCoords);
+    end else
+    if lineType = 'vn' then
+    begin
+      val(GetNextToken,x,code);
+      val(GetNextToken,y,code);
+      val(GetNextToken,z,code);
+      result.MainPart.AddNormal(x,y,z);
+      result.LightingNormal := lnVertex;
+    end else
     if lineType = 'usemtl' then
       materialname := trim(s)
 …
     if lineType = 'f' then
     begin
       NbVertices:= 0;
+      NbFaceVertices:= 0;
       repeat
         val(GetNextToken,v,code);
+        if (code = 0) and (v < 0) then v := result.MainPart.VertexCount+1+v;
         if (code = 0) and (v >= 1) and (v <= result.MainPart.VertexCount) then
         begin
+          if length(vertices) = nbvertices then
+            setlength(vertices, length(vertices)*2+1);
+          vertices[NbVertices] := result.MainPart.Vertex[v-1];
+          inc(NbVertices);
+          if length(faceVertices) = NbFaceVertices then
+          begin
+            setlength(faceVertices, length(faceVertices)*2+1);
+            setlength(faceExtra, length(faceExtra)*2+1);
+          end;
+          faceVertices[NbFaceVertices] := result.MainPart.Vertex[v-1];
+          val(secondValue,v2,code);
+          if (code = 0) and (v2 < 0) then v2 := nbTexCoords+1+v2;
+          if (code = 0) and (v2 >= 1) and (v2-1 < nbTexCoords) then
+            faceExtra[NbFaceVertices].texCoord := texCoords[v2-1]
+          else if nbTexCoords > v-1 then
+            faceExtra[NbFaceVertices].texCoord := texCoords[v-1]
+          else
+            faceExtra[NbFaceVertices].texCoord := PointF(0,0);
+          val(thirdValue,v3,code);
+          if (code = 0) and (v3 < 0) then v3 := result.MainPart.NormalCount+1+v3;
+          if code = 0 then
+            faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v3-1]
+          else if result.MainPart.NormalCount > v-1 then
+            faceExtra[NbFaceVertices].normal := result.MainPart.Normal[v-1]
+          else
+            faceExtra[NbFaceVertices].normal := nil;
+          inc(NbFaceVertices);
         end else break;
       until false;
       if NbVertices > 2 then
+      if NbFaceVertices > 2 then
       begin
         if SwapFacesOrientation then
           for i := 0 to NbVertices div 2-1 do
+          for i := 0 to NbFaceVertices div 2-1 do
           begin
+            tempV := vertices[i];
+            vertices[i] := vertices[NbVertices-1-i];
+            vertices[NbVertices-1-i] := tempV;
+            tempV := faceVertices[i];
+            faceVertices[i] := faceVertices[NbFaceVertices-1-i];
+            faceVertices[NbFaceVertices-1-i] := tempV;
+            tempN := faceExtra[i];
+            faceExtra[i] := faceExtra[NbFaceVertices-1-i];
+            faceExtra[NbFaceVertices-1-i] := tempN;
           end;
+        face := result.AddFace(slice(vertices,NbVertices));
+        face := result.AddFace(slice(faceVertices,NbFaceVertices));
+        for i := 0 to NbFaceVertices-1 do
+        begin
+          face.SetNormal(i, faceExtra[i].normal);
+          face.SetTexCoord(i, faceExtra[i].texCoord);
+        end;
         face.MaterialName := materialname;
       end;
     end;
   end;
+  closefile(t);
+  lines.Free;
+end;
+procedure TBGRAScene3D.LoadMaterialsFromFile(AFilename: string);
+var source: TFileStream;
+begin
+  source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
+  try
+    LoadMaterialsFromStream(source);
+  finally
+    source.free;
+  end;
+end;
+procedure TBGRAScene3D.LoadMaterialsFromFileUTF8(AFilename: string);
+var source: TFileStreamUTF8;
+begin
+  source := TFileStreamUTF8.Create(AFilename,fmOpenRead,fmShareDenyWrite);
+  try
+    LoadMaterialsFromStream(source);
+  finally
+    source.free;
+  end;
+end;
+procedure TBGRAScene3D.LoadMaterialsFromStream(AStream: TStream);
+var
+  s: String;
+  function GetNextToken: string;
+  var idxStart,idxEnd: integer;
+  begin
+    idxStart := 1;
+    while (idxStart <= length(s)) and (s[idxStart]in[#9,' ']) do inc(idxStart);
+    if idxStart > length(s) then
+    begin
+      result := '';
+      exit;
+    end;
+    idxEnd := idxStart;
+    while (idxEnd < length(s)) and not (s[idxEnd+1]in[#9,' ']) do inc(idxEnd);
+    result := copy(s,idxStart, idxEnd-idxStart+1);
+    delete(s,1,idxEnd);
+  end;
+  function GetSingle: single;
+  var code: integer;
+  begin
+    val(GetNextToken,result,code);
+  end;
+  function GetColorF: TColorF;
+  var r,g,b: single;
+    code: integer;
+  begin
+    val(GetNextToken,r,code);
+    val(GetNextToken,g,code);
+    val(GetNextToken,b,code);
+    result := ColorF(r,g,b,1);
+  end;
+var
+  lines: TStringList;
+  lineIndex: integer;
+  lineType: String;
+  currentMaterial: IBGRAMaterial3D;
+  materialName: string;
+  texZoom: TPointF;
+  v: single;
+begin
+  lines := TStringList.Create;
+  lines.LoadFromStream(AStream);
+  lineIndex := 0;
+  while lineIndex < lines.Count do
+  begin
+    s := lines[lineIndex];
+    if pos('#',s) <> 0 then
+      s := copy(s,1,pos('#',s)-1);
+    inc(lineIndex);
+    lineType := GetNextToken;
+    if lineType = 'newmtl' then
+    begin
+      materialName := trim(s);
+      currentMaterial := GetMaterialByName(materialName);
+      if currentMaterial = nil then
+      begin
+        currentMaterial := CreateMaterial;
+        currentMaterial.Name := materialName;
+      end;
+    end else
+    if currentMaterial <> nil then
+    begin
+      if lineType = 'Ka' then currentMaterial.AmbiantColorF := GetColorF else
+      if lineType = 'Kd' then currentMaterial.DiffuseColorF := GetColorF else
+      if lineType = 'Ks' then currentMaterial.SpecularColorF := GetColorF else
+      if (lineType = 'map_Ka') or (lineType = 'map_Kd') then
+      begin
+        currentMaterial.Texture := FetchTexture(trim(s),texZoom);
+        texZoom.y := -texZoom.y;
+        currentMaterial.TextureZoom := texZoom;
+      end else
+      if lineType = 'Ns' then currentMaterial.SpecularIndex := round(GetSingle) else
+      if lineType = 'd' then
+      begin
+        v := GetSingle;
+        if v > 1 then
+          currentMaterial.SimpleAlpha := 255
+        else if v < 0 then
+          currentMaterial.SimpleAlpha := 0
+        else
+          currentMaterial.SimpleAlpha := round(v*255);
+      end;
+    end;
+  end;
+  lines.Free;
 end;
 …
             LColors[idxL] := BGRA(128,128,128)
           else
+          begin
             if ColorOverride then
               LColors[idxL] := Color
 …
                 LColors[idxL] := tempV.Color;
             end;
+          end;
           if TexCoordOverride then
 …
           else
             LTexCoord[idxL] := tempV.TexCoord;
+          with LMaterial.GetTextureZoom do
+          begin
+            LTexCoord[idxL].x *= x;
+            LTexCoord[idxL].y *= y;
+          end;
           with tempV.CoordData^ do
 …
             LZ[idxL] := viewCoord.Z;
           end;
+          if Normal <> nil then
+            LNormal3D[idxL] := Normal.ViewNormal_128;
         end;
       end;
 …
        VCount := VertexCount;
        if VCount < 3 then exit;
-       if ParentTexture then
-         LTexture := Object3D.Texture
-       else
-         LTexture := Texture;
        if Material <> nil then
 …
        else
          exit;
+       if ParentTexture then
+       begin
+         if LMaterial.GetTexture <> nil then
+           LTexture := LMaterial.GetTexture
+         else
+           LTexture := Object3D.Texture
+       end
+       else
+         LTexture := Texture;
        LLightNormal := Object3D.LightingNormal;
 …
   procedure DrawWithResample;
   var
     tempSurface,resampledTempSurface: TBGRACustomBitmap;
+    tempSurface: TBGRACustomBitmap;
   begin
     tempSurface := ASurface.NewBitmap(ASurface.Width*RenderingOptions.AntialiasingResampleLevel,ASurface.Height*RenderingOptions.AntialiasingResampleLevel);
     InternalRender(tempSurface, am3dNone, RenderingOptions.AntialiasingResampleLevel);
+    resampledTempSurface := tempSurface.Resample(ASurface.Width,ASurface.Height,rmSimpleStretch);
+    BGRAResample.DownSamplePutImage(tempSurface,RenderingOptions.AntialiasingResampleLevel,RenderingOptions.AntialiasingResampleLevel,
+                 ASurface, 0,0, dmDrawWithTransparency);
     tempSurface.Free;
-    ASurface.PutImage(0,0,resampledTempSurface,dmDrawWithTransparency);
-    resampledTempSurface.Free;
   end;
 …
   Color: TBGRAPixel): TBGRAPixel;
 var i: Integer;
+begin
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+  if not m.GetAutoSimpleColor then Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetSimpleColorInt));
   Context^.lightness := FAmbiantLightness;
 …
   Color: TBGRAPixel): TBGRAPixel;
 var i: Integer;
+begin
+  Context^.diffuseColor := FAmbiantLightColor;
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+  if m.GetAutoAmbiantColor then
+    Context^.diffuseColor := FAmbiantLightColor
+  else
+    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
   i := FLights.Count-1;
 …
   Color: TBGRAPixel): TBGRAPixel;
 var i: Integer;
+begin
+  Context^.diffuseColor := FAmbiantLightColor;
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+  if m.GetAutoAmbiantColor then
+    Context^.diffuseColor := FAmbiantLightColor
+  else
+    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
   Context^.specularColor := ColorInt65536(0,0,0,0);
 …
 end;
-{$hints off}
 function TBGRAScene3D.ApplyNoLighting(Context: PSceneLightingContext;
   Color: TBGRAPixel): TBGRAPixel;
+begin
+  result := Color;
+var
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+  if not m.GetAutoAmbiantColor then
+    result := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt))
+  else
+    result := Color;
 end;
 function TBGRAScene3D.ApplyLightingWithAmbiantLightnessOnly(
   Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+begin
+var
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+  if not m.GetAutoAmbiantColor then
+    Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetAmbiantColorInt));
   if FAmbiantLightness <= 0 then
     result := BGRA(0,0,0,color.alpha)
 …
     result := ApplyIntensityFast(Color, FAmbiantLightness);
 end;
-{$hints on}
 function TBGRAScene3D.CreateObject: IBGRAObject3D;
 …
 end;
+function TBGRAScene3D.GetMaterialByName(AName: string): IBGRAMaterial3D;
+var i: integer;
+begin
+  for i := 0 to MaterialCount-1 do
+    if AName = Material[i].Name then
+    begin
+      result := Material[i];
+      exit;
+    end;
+  result := nil;
+end;
 procedure TBGRAScene3D.UpdateMaterials;
 var i,j: integer;
 …
 end;
+procedure TBGRAScene3D.ForEachVertex(ACallback: TVertex3DCallback);
+var i: integer;
+begin
+  for i := 0 to Object3DCount-1 do
+    Object3D[i].ForEachVertex(ACallback);
+end;
+procedure TBGRAScene3D.ForEachFace(ACallback: TFace3DCallback);
+var i: integer;
+begin
+  for i := 0 to Object3DCount-1 do
+    Object3D[i].ForEachFace(ACallback);
+end;
+initialization
+  Randomize;
 end.

GraphicTest/Packages/bgrabitmap/bgrascene3dinterface.inc

-              r452
+              r472
   { IBGRALight3D }
   IBGRALight3D = interface
+  IBGRALight3D = interface ['{85C683B6-07AC-4B8D-9324-06BC22882433}']
     procedure ComputeDiffuseLightness(Context: PSceneLightingContext);
     procedure ComputeDiffuseColor(Context: PSceneLightingContext);
 …
   end;
   IBGRAPointLight3D = interface(IBGRALight3D)
+  IBGRAPointLight3D = interface(IBGRALight3D) ['{C939900D-DDD6-49F0-B1E9-E29F94FDB4C8}']
     function GetVertex: IBGRAVertex3D;
     procedure SetVertex(const AValue: IBGRAVertex3D);
 …
   end;
   IBGRADirectionalLight3D = interface(IBGRALight3D)
+  IBGRADirectionalLight3D = interface(IBGRALight3D) ['{8D575CEE-8DD2-46FB-9BCC-17DE3DAAF53D}']
     function GetDirection: TPoint3D;
     procedure SetDirection(const AValue: TPoint3D);
 …
   IBGRAMaterial3D = interface
+    function GetAmbiantAlpha: byte;
+    function GetAutoAmbiantColor: boolean;
     function GetAutoDiffuseColor: boolean;
+    function GetAutoSimpleColor: boolean;
     function GetAutoSpecularColor: boolean;
+    function GetAmbiantColor: TBGRAPixel;
+    function GetAmbiantColorF: TColorF;
+    function GetAmbiantColorInt: TColorInt65536;
+    function GetDiffuseAlpha: byte;
     function GetDiffuseColor: TBGRAPixel;
     function GetDiffuseColorF: TColorF;
     function GetDiffuseColorInt: TColorInt65536;
     function GetLightThroughFactor: single;
+    function GetName: string;
     function GetSaturationHigh: single;
     function GetSaturationLow: single;
+    function GetSimpleAlpha: byte;
+    function GetSimpleColor: TBGRAPixel;
+    function GetSimpleColorF: TColorF;
+    function GetSimpleColorInt: TColorInt65536;
     function GetSpecularColor: TBGRAPixel;
     function GetSpecularColorF: TColorF;
 …
     function GetSpecularIndex: integer;
     function GetSpecularOn: boolean;
+    function GetTexture: IBGRAScanner;
+    function GetTextureZoom: TPointF;
+    procedure SetAmbiantAlpha(AValue: byte);
     procedure SetAutoDiffuseColor(const AValue: boolean);
     procedure SetAutoSpecularColor(const AValue: boolean);
+    procedure SetAmbiantColor(const AValue: TBGRAPixel);
+    procedure SetAmbiantColorF(const AValue: TColorF);
+    procedure SetAmbiantColorInt(const AValue: TColorInt65536);
+    procedure SetDiffuseAlpha(AValue: byte);
     procedure SetDiffuseColor(const AValue: TBGRAPixel);
     procedure SetDiffuseColorF(const AValue: TColorF);
     procedure SetDiffuseColorInt(const AValue: TColorInt65536);
     procedure SetLightThroughFactor(const AValue: single);
+    procedure SetName(const AValue: string);
     procedure SetSaturationHigh(const AValue: single);
     procedure SetSaturationLow(const AValue: single);
+    procedure SetSimpleAlpha(AValue: byte);
+    procedure SetSimpleColor(AValue: TBGRAPixel);
+    procedure SetSimpleColorF(AValue: TColorF);
+    procedure SetSimpleColorInt(AValue: TColorInt65536);
     procedure SetSpecularColor(const AValue: TBGRAPixel);
     procedure SetSpecularColorF(const AValue: TColorF);
 …
     procedure SetSpecularIndex(const AValue: integer);
     function GetAsObject: TObject;
+    procedure SetTexture(AValue: IBGRAScanner);
+    procedure SetTextureZoom(AValue: TPointF);
+    property AutoSimpleColor: boolean read GetAutoSimpleColor;
+    property SimpleColor: TBGRAPixel read GetSimpleColor write SetSimpleColor;
+    property SimpleColorF: TColorF read GetSimpleColorF write SetSimpleColorF;
+    property SimpleColorInt: TColorInt65536 read GetSimpleColorInt write SetSimpleColorInt;
+    property SimpleAlpha: byte read GetSimpleAlpha write SetSimpleAlpha;
+    property AmbiantColor: TBGRAPixel read GetAmbiantColor write SetAmbiantColor;
+    property AmbiantColorF: TColorF read GetAmbiantColorF write SetAmbiantColorF;
+    property AmbiantColorInt: TColorInt65536 read GetAmbiantColorInt write SetAmbiantColorInt;
+    property AutoAmbiantColor: boolean read GetAutoAmbiantColor;
+    property AmbiantAlpha: byte read GetAmbiantAlpha write SetAmbiantAlpha;
+    property Texture: IBGRAScanner read GetTexture write SetTexture;
+    property TextureZoom: TPointF read GetTextureZoom write SetTextureZoom;
     property DiffuseColor: TBGRAPixel read GetDiffuseColor write SetDiffuseColor;
 …
     property DiffuseColorInt: TColorInt65536 read GetDiffuseColorInt write SetDiffuseColorInt;
     property AutoDiffuseColor: boolean read GetAutoDiffuseColor write SetAutoDiffuseColor;
+    property DiffuseAlpha: byte read GetDiffuseAlpha write SetDiffuseAlpha;
     property SaturationLow: single read GetSaturationLow write SetSaturationLow;
     property SaturationHigh: single read GetSaturationHigh write SetSaturationHigh;
 …
     property LightThroughFactor: single read GetLightThroughFactor write SetLightThroughFactor;
+    property Name: string read GetName write SetName;
+  end;
+  { IBGRANormal3D }
+  IBGRANormal3D = interface
+    function GetCustomNormal: TPoint3D;
+    function GetCustomNormal_128: TPoint3D_128;
+    function GetViewNormal: TPoint3D;
+    function GetViewNormal_128: TPoint3D_128;
+    procedure SetCustomNormal(AValue: TPoint3D);
+    procedure SetCustomNormal_128(AValue: TPoint3D_128);
+    procedure SetViewNormal(AValue: TPoint3D);
+    procedure SetViewNormal_128(AValue: TPoint3D_128);
+    property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
+    property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
+    property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
+    property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
   end;
 …
   IBGRAVertex3D = interface
     function GetColor: TBGRAPixel;
+    function GetCustomFlags: DWord;
+    function GetCustomNormal: TPoint3D;
+    function GetCustomNormal_128: TPoint3D_128;
     function GetLight: Single;
     function GetProjectedCoord: TPointF;
 …
     function GetViewCoordZ: single;
     procedure SetColor(const AValue: TBGRAPixel);
+    procedure SetCustomFlags(AValue: DWord);
+    procedure SetCustomNormal(AValue: TPoint3D);
+    procedure SetCustomNormal_128(AValue: TPoint3D_128);
     procedure SetLight(const AValue: Single);
     procedure SetProjectedCoord(const AValue: TPointF);
 …
     property ViewNormal: TPoint3D read GetViewNormal write SetViewNormal;
     property ViewNormal_128: TPoint3D_128 read GetViewNormal_128 write SetViewNormal_128;
+    property CustomNormal: TPoint3D read GetCustomNormal write SetCustomNormal;
+    property CustomNormal_128: TPoint3D_128 read GetCustomNormal_128 write SetCustomNormal_128;
     property Usage: integer read GetUsage;
+    property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
     function GetAsObject: TObject;
   end;
   arrayOfIBGRAVertex3D = array of IBGRAVertex3D;
+  TVertex3DCallback = procedure(AVertex: IBGRAVertex3D) of object;
   { IBGRAPart3D }
 …
     function Add(x,y,z: single): IBGRAVertex3D;
     function Add(pt: TPoint3D): IBGRAVertex3D;
+    function Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D;
     function Add(pt: TPoint3D_128): IBGRAVertex3D;
+    function Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D;
+    function AddNormal(x,y,z: single): IBGRANormal3D;
+    function AddNormal(pt: TPoint3D): IBGRANormal3D;
+    function AddNormal(pt: TPoint3D_128): IBGRANormal3D;
     function Add(const coords: array of single): arrayOfIBGRAVertex3D;
     function Add(const pts: array of TPoint3D): arrayOfIBGRAVertex3D;
 …
     procedure Add(const pts: array of IBGRAVertex3D);
     procedure Add(AVertex: IBGRAVertex3D);
+    function GetTotalNormalCount: integer;
     function IndexOf(AVertex: IBGRAVertex3D): integer;
     procedure RemoveVertex(Index: integer);
+    procedure RemoveNormal(Index: integer);
     function GetBoundingBox: TBox3D;
     function GetMatrix: TMatrix3D;
 …
     function GetVertex(AIndex: Integer): IBGRAVertex3D;
     function GetVertexCount: integer;
+    function GetNormal(AIndex: Integer): IBGRANormal3D;
+    function GetNormalCount: integer;
     function GetTotalVertexCount: integer;
     function GetContainer: IBGRAPart3D;
 …
     procedure Scale(size: TPoint3D; Before: boolean = true);
     procedure SetMatrix(const AValue: TMatrix3D);
+    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+    procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
+    procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
     procedure Translate(x,y,z: single; Before: boolean = true);
     procedure Translate(ofs: TPoint3D; Before: boolean = true);
 …
     procedure RemoveUnusedVertices;
     function CreatePart: IBGRAPart3D;
+    procedure ForEachVertex(ACallback: TVertex3DCallback);
     property VertexCount: integer read GetVertexCount;
+    property NormalCount: integer read GetNormalCount;
     property Vertex[AIndex: Integer]: IBGRAVertex3D read GetVertex write SetVertex;
+    property Normal[AIndex: Integer]: IBGRANormal3D read GetNormal write SetNormal;
     property Matrix: TMatrix3D read GetMatrix write SetMatrix;
     property PartCount: integer read GetPartCount;
 …
     property BoundingBox: TBox3D read GetBoundingBox;
     property TotalVertexCount: integer read GetTotalVertexCount;
+    property TotalNormalCount: integer read GetTotalNormalCount;
     property Container: IBGRAPart3D read GetContainer;
   end;
 …
   IBGRAFace3D = interface
     procedure AddVertex(AVertex: IBGRAVertex3D);
+    function AddVertex(AVertex: IBGRAVertex3D): integer;
     function GetBiface: boolean;
+    function GetCustomFlags: DWord;
     function GetLightThroughFactorOverride: boolean;
     function GetMaterial: IBGRAMaterial3D;
 …
     function GetTexture: IBGRAScanner;
     function GetVertex(AIndex: Integer): IBGRAVertex3D;
+    function GetNormal(AIndex: Integer): IBGRANormal3D;
     function GetVertexColor(AIndex: Integer): TBGRAPixel;
     function GetVertexColorOverride(AIndex: Integer): boolean;
 …
     function GetViewNormal_128: TPoint3D_128;
     function GetLightThroughFactor: single;
+    procedure SetCustomFlags(AValue: DWord);
     procedure SetLightThroughFactor(const AValue: single);
     procedure SetBiface(const AValue: boolean);
 …
     procedure SetTexCoordOverride(AIndex: Integer; const AValue: boolean);
     procedure SetTexture(const AValue: IBGRAScanner);
+    procedure SetVertex(AIndex: Integer; const AValue: IBGRAVertex3D);
+    procedure SetVertex(AIndex: Integer; AValue: IBGRAVertex3D);
+    procedure SetNormal(AIndex: Integer; AValue: IBGRANormal3D);
     procedure SetVertexColor(AIndex: Integer; const AValue: TBGRAPixel);
     procedure SetVertexColorOverride(AIndex: Integer; const AValue: boolean);
 …
     property MaterialName: string read GetMaterialName write SetMaterialName;
     function GetAsObject: TObject;
+  end;
+    property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
+  end;
+  TFace3DCallback = procedure(AFace: IBGRAFace3D) of object;
   { IBGRAObject3D }
 …
     function GetMaterial: IBGRAMaterial3D;
     function GetRefCount: integer;
+    function GetTotalNormalCount: integer;
     function GetTotalVertexCount: integer;
     function GetLight: Single;
 …
     procedure SetParentLighting(const AValue: boolean);
     procedure SetTexture(const AValue: IBGRAScanner);
     procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
     procedure RemoveUnusedVertices;
+    procedure ForEachVertex(ACallback: TVertex3DCallback);
+    procedure ForEachFace(ACallback: TFace3DCallback);
     function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
     function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
 …
     property ParentLighting: boolean read GetParentLighting write SetParentLighting;
     property TotalVertexCount: integer read GetTotalVertexCount;
+    property TotalNormalCount: integer read GetTotalNormalCount;
     property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
     property Scene: TBGRAScene3D read GetScene;

GraphicTest/Packages/bgrabitmap/bgraslicescaling.pas

-              r452
+              r472
     // or as a local owned copy in other cases
     constructor Create(ABitmap: TBGRABitmap;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false);
     constructor Create(ABitmap: TBitmap;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
     constructor Create(AFilename: string;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+    constructor Create(AFilename: string; AIsUtf8: boolean;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
     constructor Create(AStream: TStream;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
     constructor Create(ABitmap: TBGRABitmap);
+    constructor Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false);
     constructor Create(ABitmap: TBitmap);
     constructor Create(AFilename: string);
+    constructor Create(AFilename: string; AIsUtf8: boolean);
     constructor Create(AStream: TStream);
     constructor Create;
 …
     constructor Create(ABitmap: TBGRABitmap;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
       Direction: TSliceScalingDirection);
+      Direction: TSliceScalingDirection; ABitmapOwner: boolean = false);
     constructor Create(ABitmap: TBitmap;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
       Direction: TSliceScalingDirection);
+    constructor Create(AFilename: string;
+    constructor Create(ABitmapFilename: string;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection);
+    constructor Create(ABitmapFilename: string; AIsUtf8: boolean;
       AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
       Direction: TSliceScalingDirection);
 …
       Direction: TSliceScalingDirection);
     destructor Destroy; override;
     constructor Create(Filename, Section: string);
+    constructor Create(AIniFilename, ASection: string; AIsUtf8Filename: boolean= false);
   public
     procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
 …
 constructor TBGRAMultiSliceScaling.Create(ABitmap: TBGRABitmap;
   AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
   Direction: TSliceScalingDirection);
+  Direction: TSliceScalingDirection; ABitmapOwner: boolean = false);
 var
   i: integer;
 …
 begin
   FBitmap := ABitmap;
   FBitmapOwned := false;
+  FBitmapOwned := ABitmapOwner;
   ItemWidth := ABitmap.Width;
   ItemHeight := ABitmap.Height;
 …
 begin
   Create(TBGRABitmap.Create(ABitmap), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction);
+  FBitmapOwned := true;
+end;
+constructor TBGRAMultiSliceScaling.Create(AFilename: string;
+    NumberOfItems, Direction, True);
+end;
+constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string;
   AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
   Direction: TSliceScalingDirection);
 begin
+  Create(TBGRABitmap.Create(AFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction);
+  FBitmapOwned := true;
+  Create(TBGRABitmap.Create(ABitmapFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
+end;
+constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; AIsUtf8: boolean;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection);
+begin
+  Create(TBGRABitmap.Create(ABitmapFilename,AIsUtf8), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
 end;
 …
 begin
   Create(TBGRABitmap.Create(AStream), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction);
+  FBitmapOwned := true;
+    NumberOfItems, Direction, True);
 end;
 …
 end;
+constructor TBGRAMultiSliceScaling.Create(Filename, Section: string);
+constructor TBGRAMultiSliceScaling.Create(AIniFilename, ASection: string;
+  AIsUtf8Filename: boolean);
 var
   i: integer;
 …
   Direction: TSliceScalingDirection;
   defaultRepeat: string;
+  IniPath,BitmapFilename: string;
+begin
+  if FileExistsUTF8(Filename) then
+  begin
+    temp := TMemIniFile.Create(Filename);
+    IniPath := ExtractFilePath(Filename);
+    if temp.ReadBool(Section, 'HorizontalDirection', False) then
+      Direction := sdHorizontal
+    else
+      Direction := sdVertical;
+    BitmapFilename := temp.ReadString(Section, 'Bitmap', '');
+    if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then
+      BitmapFilename := IniPath+copy(BitmapFilename,3,Length(BitmapFilename)-2);
+    Create(
+      BitmapFilename,
+      temp.ReadInteger(Section, 'MarginTop', 0),
+      temp.ReadInteger(Section, 'MarginRight', 0),
+      temp.ReadInteger(Section, 'MarginBottom', 0),
+      temp.ReadInteger(Section, 'MarginLeft', 0),
+      temp.ReadInteger(Section, 'NumberOfItems', 1),
+      Direction);
+    defaultRepeat := temp.ReadString(Section, 'Repeat', 'Auto');
+    for i := 0 to High(FSliceScalingArray) do
+      FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(Section, 'Repeat'+IntToStr(i+1), defaultRepeat);
+    temp.Free;
+  end;
+  IniPathUTF8,BitmapFilename: string;
+begin
+  if AIsUtf8Filename then
+  begin
+    if not FileExistsUTF8(AIniFilename) then exit;
+    temp := TMemIniFile.Create(UTF8ToSys(AIniFilename));
+    IniPathUTF8 := ExtractFilePath(AIniFilename);
+  end else
+  begin
+    if not FileExists(AIniFilename) then exit;
+    temp := TMemIniFile.Create(AIniFilename);
+    IniPathUTF8 := SysToUTF8(ExtractFilePath(AIniFilename));
+  end;
+  if temp.ReadBool(ASection, 'HorizontalDirection', False) then
+    Direction := sdHorizontal
+  else
+    Direction := sdVertical;
+  BitmapFilename := temp.ReadString(ASection, 'Bitmap', '');
+  if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then
+    BitmapFilename := IniPathUTF8+SysToUTF8(copy(BitmapFilename,3,Length(BitmapFilename)-2));
+  Create(
+    BitmapFilename,True,
+    temp.ReadInteger(ASection, 'MarginTop', 0),
+    temp.ReadInteger(ASection, 'MarginRight', 0),
+    temp.ReadInteger(ASection, 'MarginBottom', 0),
+    temp.ReadInteger(ASection, 'MarginLeft', 0),
+    temp.ReadInteger(ASection, 'NumberOfItems', 1),
+    Direction);
+  defaultRepeat := temp.ReadString(ASection, 'Repeat', 'Auto');
+  for i := 0 to High(FSliceScalingArray) do
+    FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(ASection, 'Repeat'+IntToStr(i+1), defaultRepeat);
+  temp.Free;
 end;
 …
 constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false);
+begin
+  Create(ABitmap, ABitmapOwner);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+constructor TBGRASliceScaling.Create(ABitmap: TBitmap;
   AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
 begin
 …
 end;
-constructor TBGRASliceScaling.Create(ABitmap: TBitmap;
-  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
-begin
-  Create(ABitmap);
-  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
-end;
 constructor TBGRASliceScaling.Create(AFilename: string;
   AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
 …
 end;
+constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+begin
+  Create(AFilename, AIsUtf8);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
 constructor TBGRASliceScaling.Create(AStream: TStream;
   AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
 …
 end;
 constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap);
+constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false);
 begin
   Init;
   FBitmap := ABitmap;
   FBitmapOwned := False;
+  FBitmapOwned := ABitmapOwner;
   FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
 end;
 …
   Init;
   FBitmap := TBGRABitmap.Create(AFilename);
+  FBitmapOwned := True;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean);
+begin
+  Init;
+  FBitmap := TBGRABitmap.Create(AFilename,AIsUtf8);
   FBitmapOwned := True;
   FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);

GraphicTest/Packages/bgrabitmap/bgrasse.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{$i bgrasse.inc}
 interface
 …
 var UseSSE, UseSSE2, UseSSE3 : boolean;
 {$ifdef CPUI386}
+{$ifdef BGRASSE_AVAILABLE}
   {$asmmode intel}
   //SSE rotate singles
 …
   procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single);
   operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128;
   operator + (const v1,v2: TPoint3D_128): TPoint3D_128;
+  operator + (constref v1,v2: TPoint3D_128): TPoint3D_128;
   operator - (const v1,v2: TPoint3D_128): TPoint3D_128;
   operator - (const v: TPoint3D_128): TPoint3D_128; inline;
   operator = (const v1,v2: TPoint3D_128): boolean; inline;
   procedure ClearPoint3D_128(out v: TPoint3D_128);
   {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
   procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128);
   {$ENDIF}
 …
 var
   Add3D_Aligned : procedure (var dest: TPoint3D_128; const src: TPoint3D_128);
+  Add3D_Aligned : procedure (var dest: TPoint3D_128; constref src: TPoint3D_128);
   Normalize3D_128 : procedure (var v: TPoint3D_128);
   VectProduct3D_128 : procedure (const u,v: TPoint3D_128; out w: TPoint3D_128);
   DotProduct3D_128 : function (const v1,v2: TPoint3D_128): single;
+  DotProduct3D_128 : function (constref v1,v2: TPoint3D_128): single;
 const
 …
 end;
 operator + (const v1,v2: TPoint3D_128): TPoint3D_128;
+operator + (constref v1,v2: TPoint3D_128): TPoint3D_128;
 {$ifdef CPUI386} assembler;
 asm
 …
 {$endif}
 {$ifdef CPUI386}
 procedure Add3D_AlignedSSE(var dest: TPoint3D_128; const src: TPoint3D_128); assembler;
 asm
   movaps xmm0, [eax]
   movups xmm1, [edx]
+{$ifdef BGRASSE_AVAILABLE}
+procedure Add3D_AlignedSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); assembler;
+asm
+  movaps xmm0, [dest]
+  movups xmm1, [src]
   addps xmm0, xmm1
   movaps [eax], xmm0
 end;
 {$endif}
 procedure Add3D_NoSSE(var dest: TPoint3D_128; const src: TPoint3D_128);
+  movaps [dest], xmm0
+end;
+{$endif}
+procedure Add3D_NoSSE(var dest: TPoint3D_128; constref src: TPoint3D_128);
 {$ifdef CPUI386} assembler;
 asm
 …
 procedure ClearPoint3D_128(out v: TPoint3D_128);
+{$ifdef CPUI386}
+begin
+{$ifdef cpux86_64} assembler;
+asm
+  push rbx
+  mov rax,v
+  xor rbx,rbx
+  mov [rax],rbx
+  mov [rax+8],rbx
+  pop rbx
+end;
+{$else}
+  {$ifdef CPUI386} assembler;
+  asm
+    push ebx
+    mov eax,v
+    xor ebx,ebx
+    mov [eax],ebx
+    mov [eax+4],ebx
+    mov [eax+8],ebx
+    pop ebx
+  end;
+  {$else}
+  var p: pdword;
+  begin
+    p := @v;
+    p^ := 0;
+    inc(p);
+    p^ := 0;
+    inc(p);
+    p^ := 0;
+  end;
+  {$endif}
+{$endif}
+procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128);
+{$ifdef BGRASSE_AVAILABLE} assembler;
  asm
+   push ebx
+   mov eax,v
+   xor ebx,ebx
+   mov [eax],ebx
+   mov [eax+4],ebx
+   mov [eax+8],ebx
+   pop ebx
+  xorps xmm0,xmm0
+  {$ifdef cpux86_64}
+  mov rax,v
+  movaps [rax],xmm0
+  {$else}
+  mov eax,v
+  movaps [eax],xmm0
+  {$endif}
  end;
-end;
 {$else}
 var p: pdword;
 …
 {$endif}
-procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128);
-{$ifdef CPUI386}
-begin
- asm
-   xorps xmm0,xmm0
-   movaps [eax],xmm0
- end;
-end;
-{$else}
-var p: pdword;
-begin
-  p := @v;
-  p^ := 0;
-  inc(p);
-  p^ := 0;
-  inc(p);
-  p^ := 0;
-end;
-{$endif}
 function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean;
 begin
 …
 {$endif}
 {$ifdef CPUI386}
 function DotProduct3D_128_SSE3(const v1,v2: TPoint3D_128): single; assembler;
+{$ifdef BGRASSE_AVAILABLE}
+function DotProduct3D_128_SSE3(constref v1,v2: TPoint3D_128): single; assembler;
 asm
   movups xmm0, [v1]
 …
 {$endif}
 function DotProduct3D_128_NoSSE(const v1,v2: TPoint3D_128): single;
+function DotProduct3D_128_NoSSE(constref v1,v2: TPoint3D_128): single;
 begin
   result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
 …
 end;
 {$ifdef CPUI386}
+{$ifdef BGRASSE_AVAILABLE}
 procedure Normalize3D_128_SSE1(var v: TPoint3D_128);
 var len: single;
 begin
   asm
+    mov eax, v
+    movups xmm0, [eax]
+    movaps xmm1, xmm0
+    mulps xmm0, xmm0
+    {$i sseloadv.inc}
+    movaps xmm2, xmm1
+    mulps xmm2, xmm2
     //mix1
     movaps xmm7, xmm0
+    movaps xmm7, xmm2
     shufps xmm7, xmm7, $4e
     addps xmm0, xmm7
+    addps xmm2, xmm7
     //mix2
     movaps xmm7, xmm0
+    movaps xmm7, xmm2
     shufps xmm7, xmm7, $11
     addps xmm0, xmm7
     movss len, xmm0
+    addps xmm2, xmm7
+    movss len, xmm2
   end;
   if (len = 0) then exit;
 …
   end else
   asm
+    rsqrtps xmm0, xmm0
+    mulps xmm0, xmm1  //apply
+    mov eax, v
+    movups [eax], xmm0
+  end;
+end;
+{$endif}
+{$ifdef CPUI386}
+    rsqrtps xmm2, xmm2
+    mulps xmm1, xmm2  //apply
+    {$i ssesavev.inc}
+  end;
+end;
+{$endif}
+{$ifdef BGRASSE_AVAILABLE}
 procedure Normalize3D_128_SSE3(var v: TPoint3D_128);
 var len: single;
 begin
   asm
+    mov eax, v
+    movups xmm0, [eax]
+    movaps xmm1, xmm0
+    mulps xmm0, xmm0
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss len, xmm0
+    {$i sseloadv.inc}
+    movaps xmm2, xmm1
+    mulps xmm2, xmm2
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss len, xmm2
   end;
   if (len = 0) then exit;
 …
   end else
   asm
+    rsqrtps xmm0, xmm0
+    mulps xmm0, xmm1  //apply
+    mov eax, v
+    movups [eax], xmm0
+    rsqrtps xmm2, xmm2
+    mulps xmm1, xmm2  //apply
+    {$i ssesavev.inc}
   end;
 end;
 …
 var InvLen: single;
 begin
   {$ifdef CPUI386}
+  {$ifdef BGRASSE_AVAILABLE}
     if UseSSE then
     begin
       asm
+        mov eax, v
+        movups xmm0, [eax]
+        movaps xmm1, xmm0
+        mulps xmm0, xmm0
+        {$i sseloadv.inc}
+        movaps xmm2, xmm1
+        mulps xmm2, xmm2
       end;
       if UseSSE3 then
       asm
         haddps xmm0,xmm0
         haddps xmm0,xmm0
         movss SqLen, xmm0
+        haddps xmm2,xmm2
+        haddps xmm2,xmm2
+        movss SqLen, xmm2
       end else
       asm
         //mix1
         movaps xmm7, xmm0
+        movaps xmm7, xmm2
         shufps xmm7, xmm7, $4e
         addps xmm0, xmm7
+        addps xmm2, xmm7
         //mix2
         movaps xmm7, xmm0
+        movaps xmm7, xmm2
         shufps xmm7, xmm7, $11
         addps xmm0, xmm7
         movss SqLen, xmm0
+        addps xmm2, xmm7
+        movss SqLen, xmm2
       end;
       if SqLen = 0 then exit;
 …
       end else
       asm
+        rsqrtps xmm0, xmm0
+        mulps xmm0, xmm1  //apply
+        mov eax, v
+        movups [eax], xmm0
+        rsqrtps xmm2, xmm2
+        mulps xmm1, xmm2  //apply
+        {$i ssesavev.inc}
       end;
     end
 …
 end;
+{$ifdef CPUI386}
+procedure VectProduct3D_128_SSE(const u,v: TPoint3D_128; out w: TPoint3D_128); assembler;
+asm
+  mov eax, u
+  movups xmm6, [eax]
+{$ifdef BGRASSE_AVAILABLE}
+procedure VectProduct3D_128_SSE(constref u,v: TPoint3D_128; out w: TPoint3D_128); assembler;
+asm
+  {$ifdef cpux86_64}
+  mov rax,u
+  movups xmm6,[rax]
+  {$else}
+  mov eax,u
+  movups xmm6,[eax]
+  {$endif}
   movaps xmm4, xmm6
   shufps xmm6, xmm6, Shift231
+  mov eax, v
+  movups xmm7, [eax]
+  {$ifdef cpux86_64}
+  mov rax,v
+  movups xmm7,[rax]
+  {$else}
+  mov eax,v
+  movups xmm7,[eax]
+  {$endif}
   movaps xmm5,xmm7
   shufps xmm7, xmm7, Shift312
 …
   subps xmm3,xmm4
+  {$ifdef cpux86_64}
+  mov rax,w
+  movups [rax],xmm3
+  {$else}
   mov eax,w
+  movups [eax], xmm3
+  movups [eax],xmm3
+  {$endif}
 end;
 {$endif}
 …
 {$hints off}
 constructor TMemoryBlockAlign128.Create(size: integer);
 {$IFDEF CPUI386}
+{$IFDEF BGRASSE_AVAILABLE}
 var
   delta: cardinal;
+  delta: PtrUInt;
 begin
   getmem(FContainer, size+15);
   delta := cardinal(FContainer) and 15;
+  delta := PtrUInt(FContainer) and 15;
   if delta <> 0 then delta := 16-delta;
   FData := pbyte(FContainer)+delta;
 …
 end;
 {$ifdef CPUI386}   {$ASMMODE ATT}
+{$ifdef BGRASSE_AVAILABLE}
 function sse3_support : boolean;
 …
   begin
+    {$IFDEF CPUI386}
      if cpuid_support then
        begin
           asm
              pushl %ebx
              movl $1,%eax
+             push ebx
+             mov eax,1
              cpuid
              movl %ecx,_ecx
              popl %ebx
+             mov _ecx,ecx
+             pop ebx
           end;
           sse3_support:=(_ecx and 1)<>0;
 …
      else
        sse3_support:=false;
+    {$ELSE}
+    asm
+       push rbx
+       mov eax,1
+       cpuid
+       mov _ecx,ecx
+       pop rbx
+    end;
+    sse3_support:=(_ecx and 1)<>0;
+    {$ENDIF}
   end;
 {$endif}
 …
   {$ifdef CPUI386}
   UseSSE := is_sse_cpu and FLAG_ENABLED_SSE;
+  {$else}
+    {$ifdef cpux86_64}
+    UseSSE := FLAG_ENABLED_SSE;
+    {$else}
+    UseSSE := false;
+    {$endif}
+  {$endif}
+  {$IFDEF BGRASSE_AVAILABLE}
   if UseSSE then
   begin
+    {$ifdef cpux86_64}
+    UseSSE2 := true;
+    {$else}
     UseSSE2 := is_sse2_cpu;
+    {$endif}
     UseSSE3 := sse3_support;
 …
   end
   else
   {$endif}
+  {$ENDIF}
   begin
     UseSSE := false;

GraphicTest/Packages/bgrabitmap/bgratext.pas

-              r452
+              r472
 interface
+{ Text functions use a temporary bitmap where the operating system text drawing is used.
+{
+  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+  This unit provides basic text rendering functions using LCL, and general
+  text definitions.
+  Text functions use a temporary bitmap where the operating system text drawing is used.
   Then it is scaled down (if antialiasing is activated), and colored.
+  These routines are rather slow. }
+  These routines are rather slow, so you may use other font renderers
+  like TBGRATextEffectFontRenderer in BGRATextFX if you want to use LCL fonts,
+  or, if you have TrueType fonts files, you may use TBGRAFreeTypeFontRenderer
+  in BGRAFreeType. }
 uses
+  Classes, Types, SysUtils, Graphics, BGRABitmapTypes;
+procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; s: string;
+  Classes, Types, SysUtils, Graphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask;
+type
+  TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object;
+  { TCustomLCLFontRenderer }
+  TCustomLCLFontRenderer = class(TBGRACustomFontRenderer)
+  protected
+    FFont: TFont;             //font parameters
+    FWordBreakHandler: TWordBreakHandler;
+    procedure UpdateFont; virtual;
+    function TextSizeNoUpdateFont(sUTF8: string): TSize;
+    procedure InternalTextWordBreak(ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+    procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; ATexture: IBGRAScanner);
+  public
+    procedure SplitText(var ATextUTF8: string; AMaxWidth: integer; out ARemainsUTF8: string);
+    function GetFontPixelMetric: TFontPixelMetric; override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
+    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+    procedure TextWordBreak(ADest: TBGRACustomBitmap; AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+    function TextSize(sUTF8: string): TSize; override;
+    constructor Create;
+    destructor Destroy; override;
+    property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler;
+  end;
+  { TLCLFontRenderer }
+  TLCLFontRenderer = class(TCustomLCLFontRenderer)
+  protected
+    function TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
+  public
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); override;
+  end;
+function CleanTextOutString(s: string): string; //this works with UTF8 strings as well
+function RemoveLineEnding(var s: string; indexByte: integer): boolean; //this works with UTF8 strings however the index is the byte index
+function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean;
+procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
   c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
 procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientation: integer;
   s: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
+procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientationTenthDegCCW: integer;
+  sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
 procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
+  s: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
+function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
+function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: integer): TSize;
+function GetFontHeightSign(AFont: TFont): integer;
+  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
+function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
+function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: integer): TSize;
+function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
+procedure BGRADefaultWordBreakHandler(var ABefore,AAfter: string);
+function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload;
+function BGRATextUnderline(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF; overload;
+function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF; overload;
+function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline, AEmHeight, AXHeight: single): ArrayOfTPointF; overload;
+function GetFontHeightSign: integer;
 function FontEmHeightSign: integer;
 function FontFullHeightSign: integer;
+function LCLFontAvailable: boolean;
+procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true);
 procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; RGBOrder: boolean=true);
 procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x,y: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner = nil; KeepRGBOrder: boolean=true);
+const FontAntialiasingLevel = 6;
+procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap;
+    x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner);
+const FontAntialiasingLevel = {$IFDEF LINUX}3{$ELSE}6{$ENDIF}; //linux rendering is already great
 const FontDefaultQuality = fqAntialiased;
 …
 implementation
 uses Math, BGRABlend;
+uses GraphType, Math, BGRABlend, LCLProc;
 const MaxPixelMetricCount = 100;
 var
+  LCLFontDisabledValue: boolean;
   TempBmp: TBitmap;
   FontHeightSignComputed: boolean;
 …
   size: TSize;
 begin
+  if not LCLFontAvailable then
+  begin
+    top := 0;
+    bottom := 0;
+    totalHeight := 0;
+    exit;
+  end;
   size := BGRAOriginalTextSize(font,fqSystem,text,FontAntialiasingLevel);
   mask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack);
 …
 end;
+function GetFontHeightSign(AFont: TFont): integer;
+const DefaultFontHeightSign = -1;
+function BGRATextUnderline(ATopLeft: TPointF;
+  AWidth: Single; AMetrics: TFontPixelMetric): ArrayOfTPointF;
+begin
+  result := BGRATextUnderline(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine);
+end;
+function BGRATextUnderline(ATopLeft: TPointF;
+  AWidth: Single; ABaseline, AEmHeight: single): ArrayOfTPointF;
+var height,y: single;
+begin
+  height := AEmHeight*0.1;
+  y := ATopLeft.y+ABaseline+1.5*height;
+  result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y),
+                   PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter,
+                   SolidPenStyle, []);
+end;
+function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single;
+  AMetrics: TFontPixelMetric): ArrayOfTPointF;
+begin
+  result := BGRATextStrikeOut(ATopLeft, AWidth, AMetrics.Baseline,AMetrics.Baseline-AMetrics.CapLine,AMetrics.Baseline-AMetrics.xLine);
+end;
+function BGRATextStrikeOut(ATopLeft: TPointF; AWidth: Single; ABaseline,
+  AEmHeight, AXHeight: single): ArrayOfTPointF;
+var height,y: single;
+begin
+  height := AEmHeight*0.075;
+  y := ATopLeft.y+ABaseline-AXHeight*0.5;
+  result := ComputeWidePolylinePoints([PointF(ATopLeft.x,y),
+                   PointF(ATopLeft.x+AWidth,y)],height,BGRABlack,pecFlat,pjsMiter,
+                   SolidPenStyle, []);
+end;
+function GetFontHeightSign: integer;
 var
   HeightP1, HeightM1: integer;
 begin
+  if LCLFontDisabledValue then
+  begin
+    result := DefaultFontHeightSign;
+    exit;
+  end;
   if FontHeightSignComputed then
   begin
 …
   end;
+  if tempBmp = nil then tempBmp := TBitmap.Create;
+  tempBmp.Canvas.Font.Assign(AFont);
+  tempBmp.Canvas.Font.Height := 20;
+  HeightP1  := tempBmp.Canvas.TextExtent('Hg').cy;
+  tempBmp.Canvas.Font.Height := -20;
+  HeightM1  := tempBmp.Canvas.TextExtent('Hg').cy;
+  if HeightP1 > HeightM1 then
+    FontHeightSignValue := 1
+  else
+    FontHeightSignValue := -1;
+  if WidgetSet.LCLPlatform = lpNoGUI then
+  begin
+    LCLFontDisabledValue:= True;
+    result := -1;
+    exit;
+  end;
+  try
+    if tempBmp = nil then tempBmp := TBitmap.Create;
+    tempBmp.Canvas.Font.Name := 'Arial';
+    tempBmp.Canvas.Font.Style := [];
+    tempBmp.Canvas.Font.Height := 20;
+    HeightP1  := tempBmp.Canvas.TextExtent('Hg').cy;
+    tempBmp.Canvas.Font.Height := -20;
+    HeightM1  := tempBmp.Canvas.TextExtent('Hg').cy;
+    if HeightP1 > HeightM1 then
+      FontHeightSignValue := 1
+    else
+      FontHeightSignValue := -1;
+  except
+    on ex: Exception do
+    begin
+      LCLFontDisabledValue := True;
+      result := -1;
+      exit;
+    end;
+  end;
   FontHeightSignComputed := true;
   result := FontHeightSignValue;
 …
 function FontEmHeightSign: integer;
+var f: TFont;
+begin
+  if FontHeightSignComputed then
+  begin
+    result := FontHeightSignValue;
+    exit;
+  end;
+  f:= TFont.Create;
+  f.Name := 'Arial';
+  result := GetFontHeightSign(f);
+  f.Free;
+begin
+  result := GetFontHeightSign;
 end;
 …
 end;
+procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
+function LCLFontAvailable: boolean;
+begin
+  if not FontHeightSignComputed then GetFontHeightSign;
+  result := not LCLFontDisabledValue;
+end;
+procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: NativeInt; maskRowSize: NativeInt; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
 var
   pdest: PBGRAPixel;
 …
   yMask,n: integer;
   a: byte;
   pmask: PBGRAPixel;
+  pmask: PByte;
   dx:integer;
   miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer;
 …
 begin
   alphaLineLen := mask.Width+2;
+  alphaLineLen := maskWidth+2;
   xThird -= 1; //for first subpixel
 …
   if y >= dest.ClipRect.Top then miny := 0
     else miny := dest.ClipRect.Top-y;
   if y+mask.Height-1 < dest.ClipRect.Bottom then
     maxy := mask.Height-1 else
+  if y+maskHeight-1 < dest.ClipRect.Bottom then
+    maxy := maskHeight-1 else
       maxy := dest.ClipRect.Bottom-1-y;
 …
   end;
   if x*3+xThird+mask.Width-1 < dest.ClipRect.Right*3 then
   begin
     maxx := (x*3+xThird+mask.Width-1) div 3;
+  if x*3+xThird+maskWidth-1 < dest.ClipRect.Right*3 then
+  begin
+    maxx := (x*3+xThird+maskWidth-1) div 3;
     alphaMaxX := alphaLineLen-1;
     rightOnSide := false;
 …
       if leftOnSide then
       begin
         pmask := mask.ScanLine[yMask]+(alphaMinX-1);
         a := pmask^.green div 3;
+        pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize;
+        a := pmask^ div 3;
         v1 := a+a;
         v2 := a;
         v3 := 0;
         inc(pmask);
+        inc(pmask, maskPixelSize);
       end else
       begin
         pmask := mask.ScanLine[yMask];
+        pmask := maskData + (yMask*maskRowSize);
         v1 := 0;
         v2 := 0;
 …
       for n := countBetween-1 downto 0 do
       begin
         a := pmask^.green div 3;
+        a := pmask^ div 3;
         v1 += a;
         v2 += a;
         v3 += a;
         inc(pmask);
+        inc(pmask, maskPixelSize);
         NextAlpha(v1);
 …
       if rightOnSide then
       begin
         a := pmask^.green div 3;
+        a := pmask^ div 3;
         v1 += a;
         v2 += a+a;
 …
     end;
   end;
+end;
+procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
+  y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
+  texture: IBGRAScanner; RGBOrder: boolean);
+var delta: NativeInt;
+begin
+  delta := mask.Width;
+  BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLine[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder);
+end;
+procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
+var delta: NativeInt;
+begin
+  delta := mask.Width*sizeof(TBGRAPixel);
+  if mask.LineOrder = riloBottomToTop then
+    delta := -delta;
+  BGRAFillClearTypeMaskPtr(dest,x,y,xThird,pbyte(mask.ScanLine[0])+1,sizeof(TBGRAPixel),delta,mask.Width,mask.Height,color,texture,RGBOrder);
 end;
 …
 end;
+function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
+begin
+  if tempBmp = nil then tempBmp := TBitmap.Create;
+  tempBmp.Canvas.Font := Font;
+  if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel else
+    tempBmp.Canvas.Font.Height := Font.Height;
+  Result.cx := 0;
+  Result.cy := 0;
+  tempBmp.Canvas.Font.GetTextSize(s, Result.cx, Result.cy);
+end;
+function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; s: string; CustomAntialiasingLevel: Integer): TSize;
+begin
+  result := BGRAOriginalTextSize(Font, Quality, s, CustomAntialiasingLevel);
+function BGRAOriginalTextSizeEx(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer; out actualAntialiasingLevel: integer): TSize;
+begin
+  actualAntialiasingLevel:= CustomAntialiasingLevel;
+  if not LCLFontAvailable then
+    result := Size(0,0)
+  else
+  begin
+    try
+      if tempBmp = nil then tempBmp := TBitmap.Create;
+      tempBmp.Canvas.Font := Font;
+      if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then
+      begin
+        tempBmp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel;
+      end else
+      begin
+        tempBmp.Canvas.Font.Height := Font.Height;
+        actualAntialiasingLevel:= 1;
+      end;
+      Result.cx := 0;
+      Result.cy := 0;
+      tempBmp.Canvas.Font.GetTextSize(sUTF8, Result.cx, Result.cy);
+    except
+      on ex: exception do
+      begin
+        result := Size(0,0);
+        LCLFontDisabledValue := True;
+      end;
+    end;
+  end;
+end;
+function BGRAOriginalTextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
+var actualAntialiasingLevel: integer;
+begin
+  result := BGRAOriginalTextSizeEx(Font, Quality, sUTF8, CustomAntialiasingLevel, actualAntialiasingLevel);
+end;
+procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string);
+var p: integer;
+begin
+  if (AAfter <> '') and (ABefore <> '') and (AAfter[1]<> ' ') and (ABefore[length(ABefore)] <> ' ') then
+  begin
+    p := length(ABefore);
+    while (p > 1) and (ABefore[p-1] <> ' ') do dec(p);
+    if p > 1 then //can put the word after
+    begin
+      AAfter := copy(ABefore,p,length(ABefore)-p+1)+AAfter;
+      ABefore := copy(ABefore,1,p-1);
+    end else
+    begin //cannot put the word after, so before
+    end;
+  end;
+  while (ABefore <> '') and (ABefore[length(ABefore)] =' ') do delete(ABefore,length(ABefore),1);
+  while (AAfter <> '') and (AAfter[1] =' ') do delete(AAfter,1,1);
+end;
+function BGRATextSize(Font: TFont; Quality: TBGRAFontQuality; sUTF8: string; CustomAntialiasingLevel: Integer): TSize;
+begin
+  result := BGRAOriginalTextSize(Font, Quality, sUTF8, CustomAntialiasingLevel);
   if Quality in[fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing] then
   begin
 …
 procedure FilterOriginalText(Quality: TBGRAFontQuality; CustomAntialiasingLevel: Integer; var temp: TBGRACustomBitmap;
   c: TBGRAPixel; tex: IBGRAScanner);
+  out grayscaleMask: TGrayscaleMask);
 var
+  n: integer;
+  maxAlpha: NativeUint;
+  pb: PByte;
+  multiplyX: integer;
   resampled: TBGRACustomBitmap;
+  P:       PBGRAPixel;
+  n,xb,yb,v: integer;
+  alpha, maxAlpha: integer;
+begin
+begin
+  grayscaleMask := nil;
   case Quality of
+  fqFineClearTypeBGR,fqFineClearTypeRGB:
+    begin
+  fqFineClearTypeBGR,fqFineClearTypeRGB,fqFineAntialiasing:
+    begin
+      if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then multiplyX:= 3 else multiplyX:= 1;
       if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then
       begin
         temp.ResampleFilter := rfSpline;
+        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*3),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
+        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
+        grayscaleMask := TGrayscaleMask.Create(resampled,cGreen);
+        FreeAndNil(resampled);
       end else
+        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel*3),round(temp.Height/CustomAntialiasingLevel),rmSimpleStretch);
+        grayscaleMask := TGrayscaleMask.CreateDownSample(temp, round(temp.width/CustomAntialiasingLevel*multiplyX),round(temp.Height/CustomAntialiasingLevel));
+      FreeAndNil(temp);
       maxAlpha := 0;
+      p := resampled.Data;
+      for n := resampled.NbPixels - 1 downto 0 do
+      begin
+        alpha    := P^.green;
+        if alpha > maxAlpha then maxAlpha := alpha;
+        Inc(p);
+      pb := grayscaleMask.Data;
+      for n := grayscaleMask.NbPixels - 1 downto 0 do
+      begin
+        if Pb^ > maxAlpha then maxAlpha := Pb^;
+        Inc(pb);
       end;
       if maxAlpha <> 0 then
       begin
         p := resampled.Data;
         for n := resampled.NbPixels - 1 downto 0 do
+      if (maxAlpha <> 0) and (maxAlpha <> 255) then
+      begin
+        pb := grayscaleMask.Data;
+        for n := grayscaleMask.NbPixels - 1 downto 0 do
         begin
+          v:= integer(p^.green * 255) div maxAlpha;
+          p^.red := v;
+          p^.green := v;
+          p^.blue := v;
+          Inc(p);
+          pb^:= pb^ * 255 div maxAlpha;
+          Inc(pb);
         end;
       end;
+      temp.Free;
+      temp := resampled;
+    end;
+  fqFineAntialiasing:
+    begin
+      if (temp.Height < CustomAntialiasingLevel*8) and (temp.Height >= CustomAntialiasingLevel*3) then
+      begin
+        temp.ResampleFilter := rfSpline;
+        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel),round(temp.Height/CustomAntialiasingLevel),rmFineResample);
+      end else
+        resampled := temp.Resample(round(temp.width/CustomAntialiasingLevel),round(temp.Height/CustomAntialiasingLevel),rmSimpleStretch);
+      maxAlpha := 0;
+      if tex = nil then
+      begin
+        p := resampled.Data;
+        for n := resampled.NbPixels - 1 downto 0 do
+        begin
+          alpha    := P^.green;
+          if alpha > maxAlpha then maxAlpha := alpha;
+          if alpha = 0 then
+            p^:= BGRAPixelTransparent else
+          begin
+            p^.red   := c.red;
+            p^.green := c.green;
+            p^.blue  := c.blue;
+            p^.alpha := alpha;
+          end;
+          Inc(p);
+        end;
+        if maxAlpha <> 0 then
+        begin
+          p := resampled.Data;
+          for n := resampled.NbPixels - 1 downto 0 do
+          begin
+            p^.alpha := integer(p^.alpha * c.alpha) div maxAlpha;
+            Inc(p);
+          end;
+        end;
+      end else
+      begin
+        p := resampled.Data;
+        for n := resampled.NbPixels - 1 downto 0 do
+        begin
+          alpha    := P^.green;
+          if alpha > maxAlpha then maxAlpha := alpha;
+          Inc(p);
+        end;
+        if maxAlpha = 0 then
+          resampled.FillTransparent
+    end;
+  fqSystem:
+    begin
+      grayscaleMask := TGrayscaleMask.Create(temp, cGreen);
+      FreeAndNil(temp);
+      pb := grayscaleMask.Data;
+      for n := grayscaleMask.NbPixels - 1 downto 0 do
+      begin
+        pb^:= GammaExpansionTab[pb^] shr 8;
+        Inc(pb);
+      end;
+    end;
+  end;
+end;
+function CleanTextOutString(s: string): string;
+var idxIn, idxOut: integer;
+begin
+  setlength(result, length(s));
+  idxIn := 1;
+  idxOut := 1;
+  while IdxIn <= length(s) do
+  begin
+    if not (s[idxIn] in[#13,#10,#9]) then //those characters are always 1 byte long so it is the same with UTF8
+    begin
+      result[idxOut] := s[idxIn];
+      inc(idxOut);
+    end;
+    inc(idxIn);
+  end;
+  setlength(result, idxOut-1);
+end;
+function RemoveLineEnding(var s: string; indexByte: integer): boolean;
+begin //we can ignore UTF8 character length because #13 and #10 are always 1 byte long
+      //so this function can be applied to UTF8 strings as well
+  result := false;
+  if length(s) >= indexByte then
+  begin
+    if s[indexByte] in[#13,#10] then
+    begin
+      result := true;
+      if length(s) >= indexByte+1 then
+      begin
+        if (s[indexByte+1] <> s[indexByte]) and (s[indexByte+1] in[#13,#10]) then
+          delete(s,indexByte,2)
         else
+          for yb := 0 to resampled.Height-1 do
+          begin
+            p := resampled.ScanLine[yb];
+            tex.ScanMoveTo(0,yb);
+            for xb := 0 to resampled.Width-1 do
+            begin
+              c := tex.ScanNextPixel;
+              alpha    := integer(P^.green*c.alpha) div maxAlpha;
+              if alpha = 0 then
+                p^:= BGRAPixelTransparent else
+              begin
+                c.alpha := alpha;
+                p^ := c;
+              end;
+              Inc(p);
+            end;
+          end;
+      end;
+      temp.Free;
+      temp := resampled;
+    end;
+  fqSystem:
+    begin
+      if tex = nil then
+      begin
+        p := temp.Data;
+        for n := temp.NbPixels - 1 downto 0 do
+        begin
+          alpha    := GammaExpansionTab[P^.green] shr 8;
+          alpha    := (c.alpha * alpha) div (255);
+          if alpha = 0 then p^:= BGRAPixelTransparent else
+          begin
+            p^.red   := c.red;
+            p^.green := c.green;
+            p^.blue  := c.blue;
+            p^.alpha := alpha;
+          end;
+          Inc(p);
+        end;
+      end else
+      begin
+        for yb := 0 to temp.Height-1 do
+        begin
+          p := temp.Scanline[yb];
+          tex.ScanMoveTo(0,yb);
+          for xb := 0 to temp.Width-1 do
+          begin
+            c := tex.ScanNextPixel;
+            alpha    := GammaExpansionTab[P^.green] shr 8;
+            alpha    := (c.alpha * alpha) div (255);
+            if alpha = 0 then p^:= BGRAPixelTransparent else
+            begin
+              p^.red   := c.red;
+              p^.green := c.green;
+              p^.blue  := c.blue;
+              p^.alpha := alpha;
+            end;
+            Inc(p);
+          end;
+        end;
+      end;
+    end;
+  end;
+end;
+procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; s: string;
+          delete(s,indexByte,1);
+      end
+        else
+          delete(s,indexByte,1);
+    end;
+  end;
+end;
+function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean;
+var indexByte: integer;
+    pIndex: PChar;
+begin
+  pIndex := UTF8CharStart(@sUTF8[1],length(sUTF8),indexUTF8);
+  if pIndex = nil then
+  begin
+    result := false;
+    exit;
+  end;
+  indexByte := pIndex - @sUTF8[1];
+  result := RemoveLineEnding(sUTF8, indexByte);
+end;
+procedure BGRAInternalRenderText(dest: TBGRACustomBitmap; Quality: TBGRAFontQuality; grayscale: TGrayscaleMask; temp: TBGRACustomBitmap;
+  x,y,xThird: integer; c: TBGRAPixel; tex: IBGRAScanner);
+begin
+  if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB,fqSystemClearType] then
+  begin
+    if grayscale <> nil then
+      BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird, grayscale,c,tex,Quality=fqFineClearTypeRGB)
+    else if temp <> nil then
+      BGRAFillClearTypeRGBMask(dest,x,y, temp,c,tex);
+  end
+  else
+  begin
+    if grayscale <> nil then
+    begin
+      if tex <> nil then
+        grayscale.DrawAsAlpha(dest, x, y, tex) else
+        grayscale.DrawAsAlpha(dest, x, y, c);
+    end
+    else if temp <> nil then
+      dest.PutImage(x, y, temp, dmDrawWithTransparency);
+  end;
+end;
+procedure BGRATextOut(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; sUTF8: string;
   c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
 var
 …
   x,y :integer;
   deltaX: single;
+begin
+  grayscale: TGrayscaleMask;
+  sizeFactor: integer;
+begin
+  if not LCLFontAvailable then exit;
   if CustomAntialiasingLevel = 0 then
     CustomAntialiasingLevel:= FontAntialiasingLevel;
 …
   if Font.Orientation mod 3600 <> 0 then
   begin
     BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,s,c,tex,align);
     exit;
   end;
   size := BGRAOriginalTextSize(Font,Quality,s,CustomAntialiasingLevel);
+    BGRATextOutAngle(bmp,Font,Quality,xf,yf,Font.Orientation,sUTF8,c,tex,align);
+    exit;
+  end;
+  size := BGRAOriginalTextSizeEx(Font,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
   if (size.cx = 0) or (size.cy = 0) then
     exit;
 …
   if (size.cy >= 144) and (Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (CustomAntialiasingLevel > 4) then
   begin
+    BGRATextOut(bmp,Font,Quality,xf,yf,s,c,tex,align,4);
+    exit;
+  end;
+  if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
+  begin
+    case align of
+      taLeftJustify: ;
+      taCenter: xf -= size.cx/2/CustomAntialiasingLevel;
+      taRightJustify: xf -= size.cx/CustomAntialiasingLevel;
+    end;
+  end else
+  begin
+    case align of
+      taLeftJustify: ;
+      taCenter: xf -= size.cx/2;
+      taRightJustify: xf -= size.cx;
+    end;
+    BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align,4);
+    exit;
+  end;
+  case align of
+    taLeftJustify: ;
+    taCenter: xf -= size.cx/2/sizeFactor;
+    taRightJustify: xf -= size.cx/sizeFactor;
   end;
 …
   tempSize.cx := size.cx;
   tempSize.cy := size.cy;
   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
   begin
     tempSize.cx += CustomAntialiasingLevel-1;
     tempSize.cx -= tempSize.cx mod CustomAntialiasingLevel;
     tempSize.cy += CustomAntialiasingLevel-1;
     tempSize.cy -= tempSize.cy mod CustomAntialiasingLevel;
+  if sizeFactor <> 1 then
+  begin
+    tempSize.cx += sizeFactor-1;
+    tempSize.cx -= tempSize.cx mod sizeFactor;
+    tempSize.cy += sizeFactor-1;
+    tempSize.cy -= tempSize.cy mod sizeFactor;
     deltaX := xf-floor(xf);
 …
       deltaX -= xThird/3;
     end;
     subX := round(CustomAntialiasingLevel*deltaX);
+    subX := round(sizeFactor*deltaX);
     x := round(floor(xf));
     if subX <> 0 then inc(tempSize.cx, CustomAntialiasingLevel);
     subY := round(CustomAntialiasingLevel*(yf-floor(yf)));
+    if subX <> 0 then inc(tempSize.cx, sizeFactor);
+    subY := round(sizeFactor*(yf-floor(yf)));
     y := round(floor(yf));
     if subY <> 0 then inc(tempSize.cy, CustomAntialiasingLevel);
+    if subY <> 0 then inc(tempSize.cy, sizeFactor);
   end else
   begin
 …
   xMargin := size.cy div 2;
   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
   begin
     xMargin += CustomAntialiasingLevel-1;
     xMargin -= xMargin mod CustomAntialiasingLevel;
+  if sizeFactor <> 1 then
+  begin
+    xMargin += sizeFactor-1;
+    xMargin -= xMargin mod sizeFactor;
   end;
   tempSize.cx += xMargin*2;
 …
   temp := bmp.NewBitmap(tempSize.cx, tempSize.cy, BGRABlack);
   temp.Canvas.Font := Font;
+  if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then temp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel
+   else temp.Canvas.Font.Height := Font.Height;
+  temp.Canvas.Font.Height := Font.Height*sizeFactor;
   temp.Canvas.Font.Color := clWhite;
   temp.Canvas.Brush.Style := bsClear;
+  temp.Canvas.TextOut(xMargin+subX, subY, s);
+  FilterOriginalText(Quality,CustomAntialiasingLevel, temp,c,tex);
+  if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then
+    BGRAFillClearTypeMask(bmp,x-round(xMargin/CustomAntialiasingLevel),y,xThird, temp,c,tex,Quality=fqFineClearTypeRGB)
+  else
+  begin
+    if Quality = fqSystemClearType then
+      BGRAFillClearTypeRGBMask(bmp,x-xMargin,y, temp,c,tex)
+    else if Quality = fqFineAntialiasing then
+      bmp.PutImage(x-round(xMargin/CustomAntialiasingLevel), y, temp, dmDrawWithTransparency)
+    else bmp.PutImage(x-xMargin, y, temp, dmDrawWithTransparency);
+  end;
+  temp.Free;
+end;
+procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single; orientation: integer;
+  s: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
+  temp.Canvas.TextOut(xMargin+subX, subY, sUTF8);
+  FilterOriginalText(Quality,CustomAntialiasingLevel, temp, grayscale);
+  dec(x,round(xMargin/sizeFactor));
+  BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,xThird, c,tex);
+  if temp <> nil then temp.Free;
+  if grayscale <> nil then grayscale.Free;
+end;
+procedure BGRATextOutAngle(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; xf, yf: single;
+  orientationTenthDegCCW: integer;
+  sUTF8: string; c: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; CustomAntialiasingLevel: Integer = 0);
 var
   x,y: integer;
 …
   TempFont: TFont;
   oldOrientation: integer;
+  grayscale:TGrayscaleMask;
   procedure rotBoundsAdd(pt: TPointF);
 …
 begin
+  if not LCLFontAvailable then exit;
   if CustomAntialiasingLevel = 0 then
     CustomAntialiasingLevel:= FontAntialiasingLevel;
   if orientation mod 3600 = 0 then
+  if orientationTenthDegCCW mod 3600 = 0 then
   begin
     oldOrientation := Font.Orientation;
     Font.Orientation := 0;
     BGRATextOut(bmp,Font,Quality,xf,yf,s,c,tex,align);
+    BGRATextOut(bmp,Font,Quality,xf,yf,sUTF8,c,tex,align);
     Font.Orientation := oldOrientation;
     exit;
 …
   TempFont := TFont.Create;
   TempFont.Assign(Font);
   TempFont.Orientation := orientation;
+  TempFont.Orientation := orientationTenthDegCCW;
   TempFont.Height := Font.Height;
   size := BGRAOriginalTextSize(TempFont,Quality,s,CustomAntialiasingLevel);
+  size := BGRAOriginalTextSizeEx(TempFont,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
   if (size.cx = 0) or (size.cy = 0) then
   begin
 …
     exit;
   end;
+  if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
+    sizeFactor := CustomAntialiasingLevel
+  else
+    sizeFactor := 1;
+  cosA := cos(orientation*Pi/1800);
+  sinA := sin(orientation*Pi/1800);
+  tempFont.Free;
+  cosA := cos(orientationTenthDegCCW*Pi/1800);
+  sinA := sin(orientationTenthDegCCW*Pi/1800);
   TopRight := PointF(cosA*size.cx,-sinA*size.cx);
   BottomRight := PointF(cosA*size.cx+sinA*size.cy,cosA*size.cy-sinA*size.cx);
 …
   temp.Canvas.Font := Font;
   temp.Canvas.Font.Color := clWhite;
   temp.Canvas.Font.Orientation := orientation;
+  temp.Canvas.Font.Orientation := orientationTenthDegCCW;
   temp.Canvas.Font.Height := round(Font.Height*sizeFactor);
   temp.Canvas.Brush.Style := bsClear;
+  temp.Canvas.TextOut(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY, s);
+  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,c,tex);
+  if Quality in [fqFineClearTypeRGB,fqFineClearTypeBGR] then
+    BGRAFillClearTypeMask(bmp, x, y, 0, temp, c,tex,Quality = fqFineClearTypeRGB) else
+  begin
+    if Quality = fqSystemClearType then
+      BGRAFillClearTypeRGBMask(bmp, x, y, temp, c,tex)
+    else
+      bmp.PutImage(x, y, temp, dmDrawWithTransparency);
+  end;
+  temp.Canvas.TextOut(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY, sUTF8);
+  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
+  BGRAInternalRenderText(bmp, Quality, grayscale,temp, x,y,0, c,tex);
   temp.Free;
   tempFont.Free;
+  grayscale.Free;
 end;
 procedure BGRATextRect(bmp: TBGRACustomBitmap; Font: TFont; Quality: TBGRAFontQuality; ARect: TRect; x, y: integer;
   s: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
+  sUTF8: string; style: TTextStyle; c: TBGRAPixel; tex: IBGRAScanner; CustomAntialiasingLevel: Integer = 0);
 var
   lim: TRect;
 …
   sizeFactor: integer;
   cr: TRect;
+begin
+  grayscale:TGrayscaleMask;
+begin
+  if not LCLFontAvailable then exit;
   if CustomAntialiasingLevel = 0 then
     CustomAntialiasingLevel:= FontAntialiasingLevel;
 …
   temp.Canvas.Font.Color := clWhite;
   temp.Canvas.Brush.Style := bsClear;
+  temp.Canvas.TextRect(rect(lim.Left-ARect.Left, lim.Top-ARect.Top, (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), (x - lim.Left)*sizeFactor, (y - lim.Top)*sizeFactor, s, style);
+  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,c,tex);
+  if Quality in [fqFineClearTypeBGR,fqFineClearTypeRGB] then
+    BGRAFillClearTypeMask(bmp,lim.Left, lim.Top, 0, temp, c,tex,Quality = fqFineClearTypeRGB)
+  else if Quality = fqSystemClearType then
+    BGRAFillClearTypeRGBMask(bmp,lim.Left, lim.Top, temp, c,tex)
+  temp.Canvas.TextRect(rect(lim.Left-ARect.Left, lim.Top-ARect.Top, (ARect.Right-ARect.Left)*sizeFactor, (ARect.Bottom-ARect.Top)*sizeFactor), (x - lim.Left)*sizeFactor, (y - lim.Top)*sizeFactor, sUTF8, style);
+  FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
+  BGRAInternalRenderText(bmp, Quality, grayscale,temp, lim.left,lim.top,0, c,tex);
+  temp.Free;
+  grayscale.Free;
+end;
+{ TLCLFontRenderer }
+function TLCLFontRenderer.TextSurfaceSmaller(sUTF8: string; ARect: TRect): boolean;
+begin
+  with TextSize(sUTF8) do
+    result := cx*cy < (ARect.Right-ARect.Left)*(ARect.Bottom-ARect.Top);
+end;
+procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
+  y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel);
+begin
+  if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
+  begin
+    InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
+    exit;
+  end;
+  UpdateFont;
+  BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,c,nil);
+end;
+procedure TLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x,
+  y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner);
+begin
+  if not style.Clipping or TextSurfaceSmaller(sUTF8,ARect) then
+  begin
+    InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
+    exit;
+  end;
+  UpdateFont;
+  BGRAText.BGRATextRect(ADest,FFont,FontQuality,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
+end;
+{ TCustomLCLFontRenderer }
+{ Update font properties to internal TFont object }
+procedure TCustomLCLFontRenderer.UpdateFont;
+begin
+  if FFont.Name <> FontName then
+    FFont.Name := FontName;
+  if FFont.Style <> FontStyle then
+    FFont.Style := FontStyle;
+  if FFont.Height <> FontEmHeight * FontEmHeightSign then
+    FFont.Height := FontEmHeight * FontEmHeightSign;
+  if FFont.Orientation <> FontOrientation then
+    FFont.Orientation := FontOrientation;
+  if FontQuality = fqSystemClearType then
+    FFont.Quality := fqCleartype
   else
+    bmp.PutImage(lim.Left, lim.Top, temp, dmDrawWithTransparency);
+  temp.Free;
+    FFont.Quality := FontDefaultQuality;
+end;
+function TCustomLCLFontRenderer.TextSizeNoUpdateFont(sUTF8: string): TSize;
+begin
+  result := BGRAText.BGRATextSize(FFont,FontQuality,sUTF8,FontAntialiasingLevel);
+  if (result.cy >= 24) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) then
+    result := BGRAText.BGRATextSize(FFont,FontQuality,sUTF8,4);
+end;
+procedure TCustomLCLFontRenderer.SplitText(var ATextUTF8: string;
+  AMaxWidth: integer; out ARemainsUTF8: string);
+var p,totalWidth: integer;
+begin
+  if ATextUTF8= '' then
+  begin
+    ARemainsUTF8 := '';
+    exit;
+  end;
+  if RemoveLineEnding(ATextUTF8,1) then
+  begin
+    ARemainsUTF8:= ATextUTF8;
+    ATextUTF8 := '';
+    exit;
+  end;
+  UpdateFont;
+  p := 1;
+  inc(p, UTF8CharacterLength(@ATextUTF8[p])); //UTF8 chars may be more than 1 byte long
+  while p < length(ATextUTF8)+1 do
+  begin
+    if RemoveLineEnding(ATextUTF8,p) then
+    begin
+      ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+      ATextUTF8 := copy(ATextUTF8,1,p-1);
+      exit;
+    end;
+    totalWidth := TextSizeNoUpdateFont(copy(ATextUTF8,1,p+UTF8CharacterLength(@ATextUTF8[p])-1)).cx; //copy whole last UTF8 char
+    if totalWidth > AMaxWidth then
+    begin
+      ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+      ATextUTF8 := copy(ATextUTF8,1,p-1); //this includes the whole last UTF8 char
+      if Assigned(FWordBreakHandler) then
+        FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
+          BGRADefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
+      exit;
+    end;
+    inc(p, UTF8CharacterLength(@ATextUTF8[p]));
+  end;
+  ARemainsUTF8 := '';
+end;
+function TCustomLCLFontRenderer.GetFontPixelMetric: TFontPixelMetric;
+var fxFont: TFont;
+begin
+  UpdateFont;
+  if FontQuality in[fqSystem,fqSystemClearType] 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);
+    FxFont.Free;
+  end;
+end;
+procedure TCustomLCLFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer;
+  sUTF8: string; c: TBGRAPixel; align: TAlignment);
+begin
+  UpdateFont;
+  BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,orientationTenthDegCCW,sUTF8,c,nil,align);
+end;
+procedure TCustomLCLFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer;
+  sUTF8: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  UpdateFont;
+  BGRAText.BGRATextOutAngle(ADest,FFont,FontQuality,x,y,orientationTenthDegCCW,sUTF8,BGRAPixelTransparent,texture,align);
+end;
+procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string;
+  texture: IBGRAScanner; align: TAlignment);
+var mode : TBGRATextOutImproveReadabilityMode;
+begin
+  UpdateFont;
+  if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
+  begin
+    case FontQuality of
+      fqFineClearTypeBGR: mode := irClearTypeBGR;
+      fqFineClearTypeRGB: mode := irClearTypeRGB;
+    else
+      mode := irNormal;
+    end;
+    BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,BGRAPixelTransparent,texture,align,mode);
+  end else
+    BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,BGRAPixelTransparent,texture,align);
+end;
+procedure TCustomLCLFontRenderer.TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel;
+  align: TAlignment);
+var mode : TBGRATextOutImproveReadabilityMode;
+begin
+  UpdateFont;
+  if Assigned(BGRATextOutImproveReadabilityProc) and (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
+  begin
+    case FontQuality of
+      fqFineClearTypeBGR: mode := irClearTypeBGR;
+      fqFineClearTypeRGB: mode := irClearTypeRGB;
+    else
+      mode := irNormal;
+    end;
+    BGRATextOutImproveReadabilityProc(ADest,FFont,x,y,sUTF8,c,nil,align,mode);
+  end else
+    BGRAText.BGRATextOut(ADest,FFont,FontQuality,x,y,sUTF8,c,nil,align);
+end;
+procedure TCustomLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string;
+  style: TTextStyle; c: TBGRAPixel);
+begin
+  InternalTextRect(ADest,ARect,x,y,sUTF8,style,c,nil);
+end;
+procedure TCustomLCLFontRenderer.TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string;
+  style: TTextStyle; texture: IBGRAScanner);
+begin
+  InternalTextRect(ADest,ARect,x,y,sUTF8,style,BGRAPixelTransparent,texture);
+end;
+procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
+  AText: string; x, y, AMaxWidth: integer; AColor: TBGRAPixel;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+begin
+  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,AColor,nil,AHorizAlign,AVertAlign);
+end;
+procedure TCustomLCLFontRenderer.TextWordBreak(ADest: TBGRACustomBitmap;
+  AText: string; x, y, AMaxWidth: integer; ATexture: IBGRAScanner;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+begin
+  InternalTextWordBreak(ADest,AText,x,y,AMaxWidth,BGRAPixelTransparent,ATexture,AHorizAlign,AVertAlign);
+end;
+procedure TCustomLCLFontRenderer.InternalTextWordBreak(
+  ADest: TBGRACustomBitmap; ATextUTF8: string; x, y, AMaxWidth: integer;
+  AColor: TBGRAPixel; ATexture: IBGRAScanner; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var ARemains: string;
+  stepX,stepY: integer;
+  lines: TStringList;
+  i: integer;
+  lineShift: single;
+begin
+  if (ATextUTF8 = '') or (AMaxWidth <= 0) then exit;
+  stepX := 0;
+  stepY := TextSize('Hg').cy;
+  if AVertAlign = tlTop then
+  begin
+    repeat
+      SplitText(ATextUTF8, AMaxWidth, ARemains);
+      if ATexture <> nil then
+        TextOut(ADest,x,y,ATextUTF8,ATexture,AHorizAlign)
+      else
+        TextOut(ADest,x,y,ATextUTF8,AColor,AHorizAlign);
+      ATextUTF8 := ARemains;
+      X+= stepX;
+      Y+= stepY;
+    until ARemains = '';
+  end else
+  begin
+    lines := TStringList.Create;
+    repeat
+      SplitText(ATextUTF8, AMaxWidth, ARemains);
+      lines.Add(ATextUTF8);
+      ATextUTF8 := ARemains;
+    until ARemains = '';
+    if AVertAlign = tlCenter then lineShift := lines.Count/2
+    else if AVertAlign = tlBottom then lineShift := lines.Count
+    else lineShift := 0;
+    X -= round(stepX*lineShift);
+    Y -= round(stepY*lineShift);
+    for i := 0 to lines.Count-1 do
+    begin
+      if ATexture <> nil then
+        TextOut(ADest,x,y,lines[i],ATexture,AHorizAlign)
+      else
+        TextOut(ADest,x,y,lines[i],AColor,AHorizAlign);
+      X+= stepX;
+      Y+= stepY;
+    end;
+    lines.Free;
+  end;
+end;
+procedure TCustomLCLFontRenderer.InternalTextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel;
+  ATexture: IBGRAScanner);
+var
+  previousClip, intersected: TRect;
+  oldOrientation: integer;
+begin
+  previousClip := ADest.ClipRect;
+  if style.Clipping then
+  begin
+    intersected := rect(0,0,0,0);
+    if not IntersectRect(intersected, previousClip, ARect) then exit;
+    ADest.ClipRect := intersected;
+  end;
+  oldOrientation:= FontOrientation;
+  FontOrientation:= 0;
+  if not (style.Alignment in[taCenter,taRightJustify]) then ARect.Left := x;
+  if not (style.Layout in[tlCenter,tlBottom]) then ARect.top := y;
+  if ARect.Right <= ARect.Left then exit;
+  if style.Layout = tlCenter then Y := (ARect.Top+ARect.Bottom) div 2 else
+  if style.Layout = tlBottom then Y := ARect.Bottom else
+    Y := ARect.Top;
+  if style.Alignment = taCenter then X := (ARect.Left+ARect.Right) div 2 else
+  if style.Alignment = taRightJustify then X := ARect.Right else
+    X := ARect.Left;
+  if style.Wordbreak then
+    InternalTextWordBreak(ADest,sUTF8,X,Y,ARect.Right-ARect.Left,c,ATexture,style.Alignment,style.Layout)
+  else
+  begin
+    if style.Layout = tlCenter then Y -= TextSize(sUTF8).cy div 2;
+    if style.Layout = tlBottom then Y -= TextSize(sUTF8).cy;
+    if ATexture <> nil then
+      TextOut(ADest,X,Y,sUTF8,ATexture,style.Alignment)
+    else
+      TextOut(ADest,X,Y,sUTF8,c,style.Alignment);
+  end;
+  FontOrientation:= oldOrientation;
+  if style.Clipping then
+    ADest.ClipRect := previousClip;
+end;
+function TCustomLCLFontRenderer.TextSize(sUTF8: string): TSize;
+begin
+  UpdateFont;
+  result := TextSizeNoUpdateFont(sUTF8);
+end;
+constructor TCustomLCLFontRenderer.Create;
+begin
+  FFont := TFont.Create;
+end;
+destructor TCustomLCLFontRenderer.Destroy;
+begin
+  FFont.Free;
+  inherited Destroy;
 end;

GraphicTest/Packages/bgrabitmap/bgratextfx.pas

-              r452
+              r472
 {$mode objfpc}{$H+}
+{
+  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+  This unit provide text effects. The simplest way to render effects is to use TBGRATextEffectFontRenderer class.
+  To do this, create an instance of this class and assign it to a TBGRABitmap.FontRenderer property. Now functions
+  to draw text like TBGRABitmap.TextOut will use the chosen renderer. To set the effects, keep a variable containing
+  the TBGRATextEffectFontRenderer class and modify ShadowVisible and other effects parameters.
+  The TBGRATextEffectFontRenderer class makes use of other classes depending on the situation. For example,
+  TBGRATextEffect, which is also in this unit, provides effects on a text mask. But the renderer also uses
+  BGRAVectorize unit in order to have big texts or to rotate them at will.
+  Note that you may need TBGRATextEffect if you want to have more control over text effects, especially
+  if you always draw the same text. Keeping the same TBGRATextEffect object will avoid creating the text
+  mask over and over again.
+  TextShadow function is a simple function to compute an image containing a text with shadow.
+}
 interface
 uses
   Classes, SysUtils, Graphics, Types, BGRABitmapTypes, BGRAPhongTypes;
+  Classes, SysUtils, Graphics, Types, BGRABitmapTypes, BGRAPhongTypes, BGRAText, BGRAVectorize;
 type
+  TBGRATextEffect = class;
+  { TBGRATextEffectFontRenderer }
+  TBGRATextEffectFontRenderer = class(TCustomLCLFontRenderer)
+  private
+    function GetShaderLightPosition: TPoint;
+    function GetVectorizedRenderer: TBGRAVectorizedFontRenderer;
+    procedure SetShaderLightPosition(AValue: TPoint);
+  protected
+    FShaderOwner: boolean;
+    FShader: TCustomPhongShading;
+    FVectorizedRenderer: TBGRAVectorizedFontRenderer;
+    function ShadowActuallyVisible :boolean;
+    function ShaderActuallyActive: boolean;
+    function OutlineActuallyVisible: boolean;
+    procedure Init;
+    function VectorizedFontNeeded: boolean;
+    procedure InternalTextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; texture: IBGRAScanner; align: TAlignment);
+  public
+    ShaderActive: boolean;
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+    ShadowQuality: TRadialBlurType;
+    OutlineColor: TBGRAPixel;
+    OutlineWidth: single;
+    OutlineVisible,OuterOutlineOnly: boolean;
+    OutlineTexture: IBGRAScanner;
+    constructor Create;
+    constructor Create(AShader: TCustomPhongShading; AShaderOwner: boolean);
+    destructor Destroy; override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer;
+      s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer;
+      s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string;
+      texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel;
+      align: TAlignment); override;
+    function TextSize(sUTF8: string): TSize; override;
+    property Shader: TCustomPhongShading read FShader;
+    property ShaderLightPosition: TPoint read GetShaderLightPosition write SetShaderLightPosition;
+    property VectorizedFontRenderer: TBGRAVectorizedFontRenderer read GetVectorizedRenderer;
+  end;
   { TBGRATextEffect }
 …
   TBGRATextEffect = class
   private
+    FShadowQuality: TRadialBlurType;
     function GetBounds: TRect;
+    function GetHeight: integer;
+    function GetMaskHeight: integer;
+    class function GetOutlineWidth: integer; static;
     function GetShadowBounds(ARadius: integer): TRect;
+    function GetWidth: integer;
+    function GetMaskWidth: integer;
+    function GetTextHeight: integer;
+    function GetTextWidth: integer;
+    procedure SetShadowQuality(AValue: TRadialBlurType);
   protected
     FTextMask: TBGRACustomBitmap;
 …
     FShadingAltitude: integer;
     FShadingRounded: boolean;
     FWidth,FHeight: integer;
+    FTextSize: TSize;
     FOffset: TPoint;
     procedure DrawMaskMulticolored(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; const AColors: array of TBGRAPixel);
     procedure DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; AColor: TBGRAPixel);
     procedure DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; ATexture: IBGRAScanner);
+    function DrawMaskMulticolored(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; const AColors: array of TBGRAPixel): TRect;
+    function DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; AColor: TBGRAPixel): TRect;
+    function DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,Y: Integer; ATexture: IBGRAScanner): TRect;
     function InternalDrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect;
+    procedure InitImproveReadability(AText: string; Font: TFont; SubOffsetX,SubOffsetY: single);
     procedure Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
+    procedure InitWithFontName(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
   public
     constructor Create(AText: string; Font: TFont; Antialiasing: boolean);
     constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
     constructor Create(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
+    constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean);
+    constructor Create(AText: string; AFontName: string; AFullHeight: integer; Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
+    constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean);
+    constructor Create(AText: string; AFontName: string; AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,SubOffsetY: single);
+    constructor Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint);
     procedure ApplySphere;
     procedure ApplyVerticalCylinder;
     procedure ApplyHorizontalCylinder;
     procedure Draw(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel);
     procedure Draw(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner);
     procedure Draw(ADest: TBGRACustomBitmap; X, Y: integer; AColor: TBGRAPixel; AAlign: TAlignment);
     procedure Draw(ADest: TBGRACustomBitmap; X, Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment);
+    function Draw(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect;
+    function Draw(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect;
+    function Draw(ADest: TBGRACustomBitmap; X, Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect;
+    function Draw(ADest: TBGRACustomBitmap; X, Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
     function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ARounded: Boolean = true): TRect;
 …
     function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; AAlign: TAlignment; ARounded: Boolean = true): TRect;
     procedure DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel);
     procedure DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment);
     procedure DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel);
     procedure DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner);
     procedure DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel; AAlign: TAlignment);
     procedure DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment);
     procedure DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel);
     procedure DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment);
+    function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel): TRect;
+    function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
+    function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel): TRect;
+    function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect;
     destructor Destroy; override;
     property TextMask: TBGRACustomBitmap read FTextMask;
     property TextMaskOffset: TPoint read FOffset;
+    property Width: integer read GetWidth;
+    property Height: integer read GetHeight;
+    property Width: integer read GetTextWidth; deprecated;
+    property Height: integer read GetTextHeight; deprecated;
+    property MaskWidth: integer read GetMaskWidth;
+    property MaskHeight: integer read GetMaskHeight;
+    property TextSize: TSize read FTextSize;
+    property TextWidth: integer read GetTextWidth;
+    property TextHeight: integer read GetTextHeight;
     property Bounds: TRect read GetBounds;
     property ShadowBounds[ARadius: integer]: TRect read GetShadowBounds;
+    property ShadowQuality: TRadialBlurType read FShadowQuality write SetShadowQuality;
+    class property OutlineWidth: integer read GetOutlineWidth;
   end;
 …
     AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
 procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; useClearType: boolean; ClearTypeRGBOrder: boolean);
+procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
 implementation
+uses BGRAGradientScanner, BGRAText, GraphType, Math;
+procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; useClearType: boolean; ClearTypeRGBOrder: boolean);
+uses BGRAGradientScanner, GraphType, Math, BGRAGrayscaleMask;
+const DefaultOutlineWidth = 3;
+procedure BGRATextOutImproveReadability(bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
 var
+  useClearType,clearTypeRGBOrder: boolean;
   metric: TFontPixelMetric;
   deltaX: single;
 …
   toAdd: integer;
   lines: array[0..3] of integer;
   parts: array[0..3] of TBGRACustomBitmap;
   n,nbLines,v: integer;
   alphaMax: byte;
+  parts: array[0..3] of TGrayscaleMask;
+  n,nbLines: integer;
+  alphaMax: NativeUint;
   ptrPart: TBGRACustomBitmap;
   pmask: PBGRAPixel;
+  pmask: PByte;
   fx: TBGRATextEffect;
   FxFont: TFont;
 …
 begin
+  useClearType:= mode in[irClearTypeRGB,irClearTypeBGR];
+  clearTypeRGBOrder := mode <> irClearTypeBGR;
   deltaX := xf-floor(xf);
   x := round(floor(xf));
 …
     begin
       if ClearTypeRGBOrder then
+        BGRATextOut(bmp, AFont, fqFineClearTypeRGB, xf,yf, text, color, tex, align) else
+        BGRATextOut(bmp, AFont, fqFineClearTypeRGB, xf,yf, text, color, tex, align)
+      else
         BGRATextOut(bmp, AFont, fqFineClearTypeBGR, xf,yf, text, color, tex, align)
     end else
 …
     fx := TBGRATextEffect.Create(text,FxFont,False,deltaX*FontAntialiasingLevel,0,FontAntialiasingLevel,FontAntialiasingLevel) else
     fx := TBGRATextEffect.Create(text,FxFont,False,0,0,3,0);
+  if fx.TextMask = nil then
+  begin
+    fx.Free;
+    FxFont.Free;
+    exit;
+  end;
   alphaMax := 0;
   prevCenter := 0;
 …
       ptrPart := fx.TextMask.GetPtrBitmap(fromy,lines[yb]);
       if useClearType then
         parts[yb] := ptrPart.Resample(round(ptrPart.Width/FontAntialiasingLevel*3),round(ptrPart.Height/FontAntialiasingLevel),rmSimpleStretch)
+        parts[yb] := TGrayscaleMask.CreateDownSample(ptrPart,round(ptrPart.Width/FontAntialiasingLevel*3),round(ptrPart.Height/FontAntialiasingLevel))
       else
         parts[yb] := ptrPart.Resample(round(ptrPart.Width/FontAntialiasingLevel),round(ptrPart.Height/FontAntialiasingLevel),rmSimpleStretch);
+        parts[yb] := TGrayscaleMask.CreateDownSample(ptrPart,round(ptrPart.Width/FontAntialiasingLevel),round(ptrPart.Height/FontAntialiasingLevel));
       ptrPart.Free;
       if alphaMax < 255 then
       begin
         pmask := parts[yb].data;
+        pmask := parts[yb].Data;
         for n := parts[yb].NbPixels-1 downto 0 do
         begin
+          v := pmask^.green;
+          if v > alphaMax then alphaMax := v;
+          if pmask^ > alphaMax then alphaMax := pmask^;
           inc(pmask);
         end;
 …
   begin
     case align of
     taCenter: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.Width/2)/FontAntialiasingLevel+deltaX)*3);
     taRightJustify: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.Width)/FontAntialiasingLevel+deltaX)*3);
+    taCenter: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel+deltaX)*3);
+    taRightJustify: xThird:= xThird+round(((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel+deltaX)*3);
     else xThird:= xThird+round((fx.TextMaskOffset.x/FontAntialiasingLevel+deltaX)*3);
     end;
 …
   begin
     case align of
     taCenter: x:= x+round((fx.TextMaskOffset.x-fx.Width/2)/FontAntialiasingLevel);
     taRightJustify: x:= x+round((fx.TextMaskOffset.x-fx.Width)/FontAntialiasingLevel);
+    taCenter: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth/2)/FontAntialiasingLevel);
+    taRightJustify: x:= x+round((fx.TextMaskOffset.x-fx.TextWidth)/FontAntialiasingLevel);
     else x:= x+round(fx.TextMaskOffset.x/FontAntialiasingLevel);
     end;
 …
       for n := parts[yb].NbPixels-1 downto 0 do
       begin
+        v := integer(pmask^.green)*255 div alphaMax;
+        if v > 255 then v := 255;
+        pmask^.green := v;
+        pmask^.red := v;
+        pmask^.blue := v;
+        pmask^ := pmask^*255 div alphaMax;
         inc(pmask);
       end;
     end;
     if useClearType then
+      BGRAFillClearTypeGrayscaleMask(bmp,x,cury,xThird,parts[yb],color,tex,ClearTypeRGBOrder)
+    else if mode = irMask then
+      parts[yb].Draw(bmp,x,cury)
+    else
     begin
       if tex <> nil then
+        bmp.FillClearTypeMask(x,cury,xThird,parts[yb],tex,ClearTypeRGBOrder) else
+        bmp.FillClearTypeMask(x,cury,xThird,parts[yb],color,ClearTypeRGBOrder);
+    end else
+    begin
+      if tex <> nil then
+        bmp.FillMask(x,cury,parts[yb],tex) else
+        bmp.FillMask(x,cury,parts[yb],color);
+        parts[yb].DrawAsAlpha(bmp,x,cury,tex) else
+        parts[yb].DrawAsAlpha(bmp,x,cury,color);
     end;
     inc(cury,parts[yb].Height);
 …
 function TextShadow(AWidth,AHeight: Integer; AText: String; AFontHeight: Integer; ATextColor,AShadowColor: TBGRAPixel;
+  AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True; AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
+  AOffSetX,AOffSetY: Integer; ARadius: Integer = 0; AFontStyle: TFontStyles = []; AFontName: String = 'Default'; AShowText: Boolean = True;
+  AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
 var
   bmpOut,bmpSdw: TBGRACustomBitmap; OutTxtSize: TSize; OutX,OutY: Integer;
 …
 end;
+{ TBGRATextEffectFontRenderer }
+function TBGRATextEffectFontRenderer.GetShaderLightPosition: TPoint;
+begin
+  if FShader = nil then
+    result := point(0,0)
+  else
+    result := FShader.LightPosition;
+end;
+function TBGRATextEffectFontRenderer.GetVectorizedRenderer: TBGRAVectorizedFontRenderer;
+begin
+  FVectorizedRenderer.FontEmHeight := FontEmHeight;
+  FVectorizedRenderer.FontName := FontName;
+  FVectorizedRenderer.FontOrientation:= FontOrientation;
+  FVectorizedRenderer.FontQuality := FontQuality;
+  FVectorizedRenderer.FontStyle:= FontStyle;
+  FVectorizedRenderer.ShadowColor := ShadowColor;
+  FVectorizedRenderer.ShadowVisible := ShadowVisible;
+  FVectorizedRenderer.ShadowOffset := ShadowOffset;
+  FVectorizedRenderer.ShadowRadius := ShadowRadius;
+  FVectorizedRenderer.OutlineColor := OutlineColor;
+  FVectorizedRenderer.OutlineVisible := OutlineVisible;
+  FVectorizedRenderer.OutlineWidth := OutlineWidth;
+  FVectorizedRenderer.OutlineTexture := OutlineTexture;
+  FVectorizedRenderer.OuterOutlineOnly := OuterOutlineOnly;
+  result := FVectorizedRenderer;
+end;
+procedure TBGRATextEffectFontRenderer.SetShaderLightPosition(AValue: TPoint);
+begin
+  if FShader <> nil then
+    FShader.LightPosition := AValue;
+end;
+function TBGRATextEffectFontRenderer.ShadowActuallyVisible: boolean;
+begin
+  result := ShadowVisible and (ShadowColor.alpha <> 0);
+end;
+function TBGRATextEffectFontRenderer.ShaderActuallyActive: boolean;
+begin
+  result := (FShader <> nil) and ShaderActive;
+end;
+function TBGRATextEffectFontRenderer.OutlineActuallyVisible: boolean;
+begin
+  result := (OutlineWidth <> 0) and ((OutlineTexture <> nil) or (OutlineColor.alpha <> 0)) and OutlineVisible;
+end;
+procedure TBGRATextEffectFontRenderer.Init;
+begin
+  ShaderActive := true;
+  ShadowColor := BGRABlack;
+  ShadowVisible := false;
+  ShadowOffset := Point(5,5);
+  ShadowRadius := 5;
+  ShadowQuality:= rbFast;
+  OutlineColor := BGRAPixelTransparent;
+  OutlineVisible := True;
+  OutlineWidth:= DefaultOutlineWidth;
+  OuterOutlineOnly:= false;
+  FVectorizedRenderer := TBGRAVectorizedFontRenderer.Create;
+end;
+function TBGRATextEffectFontRenderer.VectorizedFontNeeded: boolean;
+var bAntialiasing, bBigFont, bSpecialOutline, bOriented, bEffectVectorizedSupported: boolean;
+  textsz: TSize;
+begin
+  bAntialiasing := FontQuality in [fqFineAntialiasing,fqFineClearTypeRGB,fqFineClearTypeBGR];
+  textsz := inherited TextSize('Hg');
+  bBigFont := (not OutlineActuallyVisible and (textsz.cy >= 24)) or
+     (OutlineActuallyVisible and (textsz.cy > 42));
+  bSpecialOutline:= OutlineActuallyVisible and (abs(OutlineWidth) <> DefaultOutlineWidth);
+  bOriented := FontOrientation <> 0;
+  bEffectVectorizedSupported := OutlineActuallyVisible or ShadowActuallyVisible;
+  if ShaderActuallyActive and (FontOrientation = 0) then
+    result := false //shader not supported by vectorized font
+  else
+    result := bSpecialOutline or
+              (bAntialiasing and bBigFont) or
+              (bOriented and bEffectVectorizedSupported);
+end;
+procedure TBGRATextEffectFontRenderer.InternalTextOut(ADest: TBGRACustomBitmap;
+  x, y: single; s: string; c: TBGRAPixel; texture: IBGRAScanner;
+  align: TAlignment);
+var fx: TBGRATextEffect;
+  procedure DoOutline;
+  begin
+    if OutlineActuallyVisible then
+    begin
+      if OutlineTexture <> nil then
+        fx.DrawOutline(ADest,round(x),round(y), OutlineTexture, align)
+      else
+        fx.DrawOutline(ADest,round(x),round(y), OutlineColor, align);
+    end;
+  end;
+begin
+  UpdateFont;
+  if (FFont.Orientation <> 0) or (not ShaderActuallyActive and not ShadowActuallyVisible and not OutlineActuallyVisible) then
+  begin
+    if texture <> nil then
+      inherited TextOut(ADest,x,y,s,texture,align)
+    else
+      inherited TextOut(ADest,x,y,s,c,align);
+    exit;
+  end;
+  fx := TBGRATextEffect.Create(s, FFont, FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB], x-floor(x),y-floor(y));
+  if ShadowActuallyVisible then
+  begin
+    fx.ShadowQuality := ShadowQuality;
+    fx.DrawShadow(ADest,round(x)+ShadowOffset.X,round(y)+ShadowOffset.Y,ShadowRadius,ShadowColor, align);
+  end;
+  if OuterOutlineOnly then DoOutline;
+  if texture <> nil then
+  begin
+    if ShaderActuallyActive then
+      fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), texture, align)
+    else
+      fx.Draw(ADest,round(x),round(y), texture, align);
+  end else
+  begin
+    if ShaderActuallyActive then
+      fx.DrawShaded(ADest,floor(x),floor(y), Shader, round(fx.TextSize.cy*0.05), c, align)
+    else
+      fx.Draw(ADest,round(x),round(y), c, align);
+  end;
+  if not OuterOutlineOnly then DoOutline;
+  fx.Free;
+end;
+constructor TBGRATextEffectFontRenderer.Create;
+begin
+  inherited Create;
+  FShader := nil;
+  FShaderOwner:= false;
+  Init;
+end;
+constructor TBGRATextEffectFontRenderer.Create(AShader: TCustomPhongShading;
+  AShaderOwner: boolean);
+begin
+  inherited Create;
+  Init;
+  FShader := AShader;
+  FShaderOwner := AShaderOwner;
+end;
+destructor TBGRATextEffectFontRenderer.Destroy;
+begin
+  if FShaderOwner then FShader.Free;
+  FVectorizedRenderer.Free;
+  inherited Destroy;
+end;
+procedure TBGRATextEffectFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; texture: IBGRAScanner;
+  align: TAlignment);
+begin
+  VectorizedFontRenderer.TextOutAngle(ADest, x, y, orientation, s, texture, align);
+end;
+procedure TBGRATextEffectFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
+begin
+  VectorizedFontRenderer.TextOutAngle(ADest, x, y, orientation, s, c, align);
+end;
+procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  if VectorizedFontNeeded then
+    VectorizedFontRenderer.TextOut(ADest,x,y,s,texture,align)
+  else
+    InternalTextOut(ADest,x,y,s,BGRAPixelTransparent,texture,align);
+end;
+procedure TBGRATextEffectFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; c: TBGRAPixel; align: TAlignment);
+begin
+  if VectorizedFontNeeded then
+    VectorizedFontRenderer.TextOut(ADest,x,y,s,c,align)
+  else
+    InternalTextOut(ADest,x,y,s,c,nil,align);
+end;
+function TBGRATextEffectFontRenderer.TextSize(sUTF8: string): TSize;
+begin
+  if VectorizedFontNeeded then
+    result := VectorizedFontRenderer.TextSize(sUTF8)
+  else
+  begin
+    result := inherited TextSize(sUTF8);
+  end;
+end;
 { TBGRATextEffect }
 …
 end;
+function TBGRATextEffect.GetHeight: integer;
+begin
+  result := FHeight;
+function TBGRATextEffect.GetMaskHeight: integer;
+begin
+  if FTextMask = nil then
+    result := 0
+  else
+    result := FTextMask.Height;
+end;
+class function TBGRATextEffect.GetOutlineWidth: integer; static;
+begin
+  result := DefaultOutlineWidth;
 end;
 …
 end;
+function TBGRATextEffect.GetWidth: integer;
+begin
+  result := FWidth;
+end;
+procedure TBGRATextEffect.DrawMaskMulticolored(ADest: TBGRACustomBitmap;
+  AMask: TBGRACustomBitmap; X, Y: Integer; const AColors: array of TBGRAPixel);
+function TBGRATextEffect.GetMaskWidth: integer;
+begin
+  if FTextMask = nil then
+    result := 0
+  else
+    result := FTextMask.Width;
+end;
+function TBGRATextEffect.GetTextHeight: integer;
+begin
+  result := FTextSize.cy;
+end;
+function TBGRATextEffect.GetTextWidth: integer;
+begin
+  result := FTextSize.cx;
+end;
+procedure TBGRATextEffect.SetShadowQuality(AValue: TRadialBlurType);
+begin
+  if FShadowQuality=AValue then Exit;
+  FShadowQuality:=AValue;
+  FreeAndNil(FShadowMask);
+end;
+function TBGRATextEffect.DrawMaskMulticolored(ADest: TBGRACustomBitmap;
+  AMask: TBGRACustomBitmap; X, Y: Integer; const AColors: array of TBGRAPixel
+  ): TRect;
 var
   scan: TBGRASolidColorMaskScanner;
 …
   emptyCol, nextCol: boolean;
 begin
+  if (AMask = nil) or (length(AColors)=0) then exit;
+  if (AMask = nil) or (length(AColors)=0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
   if (length(AColors)=0) then
   begin
     DrawMask(ADest,AMask,X,Y,AColors[0]);
+    result := DrawMask(ADest,AMask,X,Y,AColors[0]);
     exit;
   end;
 …
     ADest.FillRect(X+startX,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
   scan.Free;
+end;
+procedure TBGRATextEffect.DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,
+  Y: Integer; AColor: TBGRAPixel);
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
+end;
+function TBGRATextEffect.DrawMask(ADest: TBGRACustomBitmap;
+  AMask: TBGRACustomBitmap; X, Y: Integer; AColor: TBGRAPixel): TRect;
 var
   scan: TBGRACustomScanner;
 begin
+  if AMask = nil then exit;
+  if AMask = nil then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
   scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColor);
   ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
   scan.Free;
+end;
+procedure TBGRATextEffect.DrawMask(ADest: TBGRACustomBitmap; AMask: TBGRACustomBitmap; X,
+  Y: Integer; ATexture: IBGRAScanner);
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
+end;
+function TBGRATextEffect.DrawMask(ADest: TBGRACustomBitmap;
+  AMask: TBGRACustomBitmap; X, Y: Integer; ATexture: IBGRAScanner): TRect;
 var
   scan: TBGRACustomScanner;
 begin
+  if AMask = nil then exit;
+  if AMask = nil then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
   scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),ATexture);
   ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
   scan.Free;
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
 end;
 …
   iBlurRadius: integer;
 begin
   if FTextMask = nil then
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
   begin
     result := EmptyRect;
 …
   end;
+  inc(X, FOffset.X);
+  Inc(Y, FOffset.Y);
   if ATexture <> nil then
     Shader.DrawScan(ADest,FShadingMask,Altitude,X+FOffset.X,Y+FOffset.Y, ATexture)
+    Shader.DrawScan(ADest,FShadingMask,Altitude,X,Y, ATexture)
   else
+    Shader.Draw(ADest,FShadingMask,Altitude,X+FOffset.X,Y+FOffset.Y, AColor);
+  result := rect(X+FOffset.X,Y+FOffset.Y, X+FOffset.X+FShadingMask.Width,Y+FOffset.Y+FShadingMask.Height);
+end;
+procedure TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel; AAlign: TAlignment);
+    Shader.Draw(ADest,FShadingMask,Altitude,X,Y, AColor);
+  result := rect(X,Y, X+FShadingMask.Width,Y+FShadingMask.Height);
+end;
+procedure TBGRATextEffect.InitImproveReadability(AText: string; Font: TFont;
+  SubOffsetX, SubOffsetY: single);
+var size: TSize;
+  overhang: integer;
+begin
+  if SubOffsetX < 0 then SubOffsetX := 0;
+  if SubOffsetY < 0 then SubOffsetY := 0;
+  size := BGRATextSize(Font, fqFineAntialiasing, AText, FontAntialiasingLevel);
+  FTextSize := size;
+  if size.cy = 0 then FTextSize.cy := BGRATextSize(Font, fqFineAntialiasing, 'Hg', FontAntialiasingLevel).cy;
+  overhang := size.cy div 2;
+  size.cx += 2*overhang + ceil(SubOffsetX);
+  size.cy += 2 + ceil(SubOffsetY);
+  FOffset := Point(-overhang,-1); //include overhang
+  FTextMask := BGRABitmapFactory.Create(size.cx,size.cy,BGRABlack);
+  BGRATextOutImproveReadability(FTextMask, Font, overhang+SubOffsetX,1+SubOffsetY, AText, BGRAWhite, nil, taLeftJustify, irMask);
+end;
+function TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
   taLeftJustify: Draw(ADest,X,Y,AColor);
   taRightJustify: Draw(ADest,X-Width,Y,AColor);
   taCenter: Draw(ADest,X-Width div 2,Y,AColor);
   end;
 end;
 procedure TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
   ATexture: IBGRAScanner; AAlign: TAlignment);
+  taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,AColor);
+  taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,AColor);
+  else result := Draw(ADest,X,Y,AColor);
+  end;
+end;
+function TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
   taLeftJustify: Draw(ADest,X,Y,ATexture);
   taRightJustify: Draw(ADest,X-Width,Y,ATexture);
   taCenter: Draw(ADest,X-Width div 2,Y,ATexture);
+  taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,ATexture);
+  taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,ATexture);
+  else result := Draw(ADest,X,Y,ATexture);
   end;
 end;
 …
   Case AAlign of
   taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,AColor,ARounded);
   taRightJustify: result := DrawShaded(ADest,X-Width,Y,Shader,Altitude,AColor,ARounded);
   taCenter: result := DrawShaded(ADest,X-Width div 2,Y,Shader,Altitude,AColor,ARounded);
+  taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,AColor,ARounded);
+  taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,AColor,ARounded);
   else
     result := EmptyRect;
 …
   Case AAlign of
   taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,ATexture,ARounded);
   taRightJustify: result := DrawShaded(ADest,X-Width,Y,Shader,Altitude,ATexture,ARounded);
   taCenter: result := DrawShaded(ADest,X-Width div 2,Y,Shader,Altitude,ATexture,ARounded);
+  taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,ATexture,ARounded);
+  taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,ATexture,ARounded);
   else
     result := EmptyRect;
 …
 end;
+procedure TBGRATextEffect.Init(AText: string; Font: TFont;
+  Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
+constructor TBGRATextEffect.Create(AText: string; AFontName: string;
+  AFullHeight: integer; Antialiasing: boolean);
+begin
+  InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, 0, 0);
+end;
+constructor TBGRATextEffect.Create(AText: string; AFontName: string;
+  AFullHeight: integer; Antialiasing: boolean; SubOffsetX, SubOffsetY: single);
+begin
+  InitWithFontName(AText, AFontName, AFullHeight, [], Antialiasing, SubOffsetX, SubOffsetY);
+end;
+constructor TBGRATextEffect.Create(AText: string; AFontName: string;
+  AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean);
+begin
+  InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, 0, 0);
+end;
+constructor TBGRATextEffect.Create(AText: string; AFontName: string;
+  AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX,
+  SubOffsetY: single);
+begin
+  InitWithFontName(AText, AFontName, AFullHeight, AStyle, Antialiasing, SubOffsetX, SubOffsetY);
+end;
+constructor TBGRATextEffect.Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,
+  AHeight: integer; AOffset: TPoint);
+begin
+  FTextSize := Size(AWidth,AHeight);
+  FOffset := AOffset;
+  if not AMaskOwner then
+    FTextMask := AMask.Duplicate()
+  else
+    FTextMask := AMask;
+end;
+procedure TBGRATextEffect.Init(AText: string; Font: TFont; Antialiasing: boolean; SubOffsetX,SubOffsetY: single; GrainX, GrainY: Integer);
+const FXAntialiasingLevel = FontAntialiasingLevel;
 var temp: TBGRACustomBitmap;
     size: TSize;
 …
     iSubX,iSubY: integer;
 begin
+  FShadowQuality := rbFast;
+  if Antialiasing and Assigned(BGRATextOutImproveReadabilityProc) then
+  begin
+    InitImproveReadability(AText, Font, SubOffsetX,SubOffsetY);
+    exit;
+  end;
   if Antialiasing then
     quality := fqFineAntialiasing
   else
     quality := fqSystem;
   size := BGRAOriginalTextSize(Font,quality,AText,FontAntialiasingLevel);
+  size := BGRAOriginalTextSize(Font,quality,AText,FXAntialiasingLevel);
   if (size.cx = 0) or (size.cy = 0) then
   begin
     size := BGRATextSize(Font,quality,'Hg',FontAntialiasingLevel);
     FWidth := 0;
     FHeight := size.cy;
+    size := BGRATextSize(Font,quality,'Hg',FXAntialiasingLevel);
+    FTextSize.cx := 0;
+    FTextSize.cy := size.cy;
     FOffset := Point(0,0);
     exit;
   end;
+  FTextSize := size;
   sizeX := size.cx+size.cy;
 …
   if Antialiasing then
   begin
     sizeX := (sizeX + FontAntialiasingLevel-1);
     sizeX -= sizeX mod FontAntialiasingLevel;
     sizeY := (sizeY + FontAntialiasingLevel-1);
     sizeY -= sizeY mod FontAntialiasingLevel;
+    sizeX := (sizeX + FXAntialiasingLevel-1);
+    sizeX -= sizeX mod FXAntialiasingLevel;
+    sizeY := (sizeY + FXAntialiasingLevel-1);
+    sizeY -= sizeY mod FXAntialiasingLevel;
     if SubOffsetX <> 0 then
     begin
       sizeX += ceil(SubOffsetX*FontAntialiasingLevel);
       iSubX := round(SubOffsetX*FontAntialiasingLevel);
+      sizeX += ceil(SubOffsetX*FXAntialiasingLevel);
+      iSubX := round(SubOffsetX*FXAntialiasingLevel);
     end;
     if SubOffsetY <> 0 then
     begin
       sizeY += ceil(SubOffsetY*FontAntialiasingLevel);
       iSubY := round(SubOffsetY*FontAntialiasingLevel);
     end;
     OnePixel := FontAntialiasingLevel;
+      sizeY += ceil(SubOffsetY*FXAntialiasingLevel);
+      iSubY := round(SubOffsetY*FXAntialiasingLevel);
+    end;
+    OnePixel := FXAntialiasingLevel;
   end else
   begin
 …
   if Antialiasing then
   begin
     FWidth := round(size.cx/FontAntialiasingLevel);
     FHeight := round(size.cy/FontAntialiasingLevel);
     FOffset := Point(round(FOffset.X/FontAntialiasingLevel),round(FOffset.Y/FontAntialiasingLevel));
     FTextMask := temp.Resample(round(temp.width/FontAntialiasingLevel),round(temp.Height/FontAntialiasingLevel),rmSimpleStretch);
+    FTextSize.cx := round(FTextSize.cx/FXAntialiasingLevel);
+    FTextSize.cy := round(FTextSize.cy/FXAntialiasingLevel);
+    FOffset := Point(round(FOffset.X/FXAntialiasingLevel),round(FOffset.Y/FXAntialiasingLevel));
+    FTextMask := temp.Resample(round(temp.width/FXAntialiasingLevel),round(temp.Height/FXAntialiasingLevel),rmSimpleStretch);
     maxAlpha := 0;
 …
   else
   begin
-    FWidth := size.cx;
-    FHeight := size.cy;
     FTextMask := temp;
     p := FTextMask.data;
 …
     end;
   end;
+end;
+procedure TBGRATextEffect.InitWithFontName(AText: string; AFontName: string;
+  AFullHeight: integer; AStyle: TFontStyles; Antialiasing: boolean; SubOffsetX, SubOffsetY: single);
+var lFont: TFont;
+begin
+  lFont := TFont.Create;
+  lFont.Name := AFontName;
+  lFont.Height := AFullHeight * FontFullHeightSign;
+  lFont.Style := AStyle;
+  Init(AText, lFont, Antialiasing, SubOffsetX, SubOffsetY, 0,0);
+  lFont.Free;
 end;
 …
 end;
+procedure TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel);
+begin
+  if FTextMask = nil then exit;
+  DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+procedure TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner);
+begin
+  if FTextMask = nil then exit;
+  DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,ATexture);
+end;
+procedure TBGRATextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X, Y: integer;
+  const AColors: array of TBGRAPixel);
+begin
+  if FTextMask = nil then exit;
+  DrawMaskMulticolored(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColors);
+end;
+procedure TBGRATextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X,
+  Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment);
+function TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel): TRect;
+begin
+  result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+function TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner): TRect;
+begin
+  result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,ATexture);
+end;
+function TBGRATextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X,
+  Y: integer; const AColors: array of TBGRAPixel): TRect;
+begin
+  result := DrawMaskMulticolored(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColors);
+end;
+function TBGRATextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X,
+  Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
+  taLeftJustify: DrawMulticolored(ADest,X,Y,AColors);
+  taRightJustify: DrawMulticolored(ADest,X-Width,Y,AColors);
+  taCenter: DrawMulticolored(ADest,X-Width div 2,Y,AColors);
+  end;
+end;
+procedure TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel);
+begin
+  if FTextMask = nil then exit;
+  taRightJustify: result := DrawMulticolored(ADest,X-TextSize.cx,Y,AColors);
+  taCenter: result := DrawMulticolored(ADest,X-TextSize.cx div 2,Y,AColors);
+  else result := DrawMulticolored(ADest,X,Y,AColors);
+  end;
+end;
+function TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel): TRect;
+begin
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
   if FOutlineMask = nil then
   begin
 …
     FOutlineMask.LinearNegative;
   end;
+  DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+procedure TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner);
+begin
+  if FTextMask = nil then exit;
+  result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+function TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner): TRect;
+begin
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
   if FOutlineMask = nil then
   begin
 …
     FOutlineMask.LinearNegative;
   end;
   DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,ATexture);
 end;
 procedure TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
   AColor: TBGRAPixel; AAlign: TAlignment);
+  result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,ATexture);
+end;
+function TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
   taLeftJustify: DrawOutline(ADest,X,Y,AColor);
   taRightJustify: DrawOutline(ADest,X-Width,Y,AColor);
   taCenter: DrawOutline(ADest,X-Width div 2,Y,AColor);
   end;
 end;
 procedure TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
   ATexture: IBGRAScanner; AAlign: TAlignment);
+  taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,AColor);
+  taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,AColor);
+  else result := DrawOutline(ADest,X,Y,AColor);
+  end;
+end;
+function TBGRATextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
   taLeftJustify: DrawOutline(ADest,X,Y,ATexture);
   taRightJustify: DrawOutline(ADest,X-Width,Y,ATexture);
   taCenter: DrawOutline(ADest,X-Width div 2,Y,ATexture);
   end;
 end;
+procedure TBGRATextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,Radius: integer;
   AColor: TBGRAPixel);
 begin
   if Radius <= 0 then
   begin
     Draw(ADest,X,Y,AColor);
+  taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,ATexture);
+  taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,ATexture);
+  else result := DrawOutline(ADest,X,Y,ATexture);
+  end;
+end;
+function TBGRATextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,
+  Radius: integer; AColor: TBGRAPixel): TRect;
+begin
+  if (Radius <= 0) or (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := Draw(ADest,X,Y,AColor);
     exit;
   end;
+  if FTextMask = nil then exit;
+  if FShadowRadius <> Radius then
+  if (FShadowRadius <> Radius) or (FShadowMask = nil) then
   begin
     FShadowRadius := Radius;
 …
     FShadowMask := BGRABitmapFactory.Create(FTextMask.Width+Radius*2,FTextMask.Height+Radius*2,BGRABlack);
     FShadowMask.PutImage(Radius,Radius,FTextMask,dmSet);
+    BGRAReplace(FShadowMask, FShadowMask.FilterBlurRadial(Radius,rbFast));
+  end;
+  DrawMask(ADest,FShadowMask,X-Radius+FOffset.X,Y-Radius+FOffset.Y,AColor)
+end;
+procedure TBGRATextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,
+  Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment);
+    BGRAReplace(FShadowMask, FShadowMask.FilterBlurRadial(Radius,ShadowQuality));
+  end;
+  Inc(X,FOffset.X-Radius);
+  Inc(Y,FOffset.Y-Radius);
+  DrawMask(ADest,FShadowMask,X,Y,AColor);
+  result := rect(X,Y,X+FShadowMask.Width,Y+FShadowMask.Height);
+end;
+function TBGRATextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,
+  Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect;
 begin
   Case AAlign of
   taLeftJustify: DrawShadow(ADest,X,Y,Radius,AColor);
   taRightJustify: DrawShadow(ADest,X-Width,Y,Radius,AColor);
   taCenter: DrawShadow(ADest,X-Width div 2,Y,Radius,AColor);
+  taRightJustify: result := DrawShadow(ADest,X-TextSize.cx,Y,Radius,AColor);
+  taCenter: result := DrawShadow(ADest,X-TextSize.cx div 2,Y,Radius,AColor);
+  else result := DrawShadow(ADest,X,Y,Radius,AColor);
   end;
 end;
 …
 end;
+initialization
+  BGRATextOutImproveReadabilityProc := @BGRATextOutImproveReadability;
 end.

GraphicTest/Packages/bgrabitmap/bgratransform.pas

-              r452
+              r472
     TopLeft, TopRight,
     BottomLeft: TPointF;
     function EmptyBox: TAffineBox;
     function AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox;
+    class function EmptyBox: TAffineBox;
+    class function AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox;
     property BottomRight: TPointF read GetBottomRight;
     property IsEmpty: boolean read GetIsEmpty;
 …
     procedure Invert;
     procedure Translate(OfsX,OfsY: Single);
     procedure RotateDeg(Angle: Single);
     procedure RotateRad(Angle: Single);
+    procedure RotateDeg(AngleCW: Single);
+    procedure RotateRad(AngleCCW: Single);
     procedure MultiplyBy(AMatrix: TAffineMatrix);
     procedure Fit(Origin,HAxis,VAxis: TPointF); virtual;
 …
     FRepeatImageX,FRepeatImageY: boolean;
     FResampleFilter : TResampleFilter;
+    FBuffer: PBGRAPixel;
+    FBufferSize: Int32or64;
     procedure Init(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean= false; ARepeatImageY: Boolean= false; AResampleFilter: TResampleFilter = rfLinear);
   public
     constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImage: Boolean= false; AResampleFilter: TResampleFilter = rfLinear);
     constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean; ARepeatImageY: Boolean; AResampleFilter: TResampleFilter = rfLinear);
+    destructor Destroy; override;
     function InternalScanCurrentPixel: TBGRAPixel; override;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
+    function IsScanPutPixelsDefined: boolean; override;
     procedure Fit(Origin, HAxis, VAxis: TPointF); override;
   end;
 …
   end;
+  { TBGRAExtendedBorderScanner }
+  TBGRAExtendedBorderScanner = class(TBGRACustomScanner)
+  protected
+    FSource: IBGRAScanner;
+    FBounds: TRect;
+  public
+    constructor Create(ASource: IBGRAScanner; ABounds: TRect);
+    function ScanAt(X,Y: Single): TBGRAPixel; override;
+  end;
   { TBGRAScannerOffset }
 …
 function IsAffineMatrixInversible(M: TAffineMatrix): boolean;
+//check if the matrix is a translation (including the identity)
+function IsAffineMatrixTranslation(M: TAffineMatrix): boolean;
+//check if the matrix is a scaling (including a projection i.e. with factor 0)
+function IsAffineMatrixScale(M: TAffineMatrix): boolean;
+//check if the matrix is the identity
+function IsAffineMatrixIdentity(M: TAffineMatrix): boolean;
 //compute inverse (check if inversible before)
 function AffineMatrixInverse(M: TAffineMatrix): TAffineMatrix;
 …
 function AffineMatrixLinear(v1,v2: TPointF): TAffineMatrix;
+//define a rotation matrix (positive radians are counter clock wise)
+function AffineMatrixRotationRad(Angle: Single): TAffineMatrix;
+//Positive degrees are clock wise
+function AffineMatrixRotationDeg(Angle: Single): TAffineMatrix;
+//define a rotation matrix (positive radians are counter-clockwise)
+//(assuming the y-axis is pointing down)
+function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix;
+//Positive degrees are clockwise
+//(assuming the y-axis is pointing down)
+function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix;
 //define the identity matrix (that do nothing)
 …
     FMatrix: TPerspectiveTransform;
     FScanAtProc: TScanAtFunction;
+    function GetIncludeOppositePlane: boolean;
+    procedure SetIncludeOppositePlane(AValue: boolean);
   public
     constructor Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF);
 …
     function ScanAt(X, Y: Single): TBGRAPixel; override;
     function ScanNextPixel: TBGRAPixel; override;
+    property IncludeOppositePlane: boolean read GetIncludeOppositePlane write SetIncludeOppositePlane;
   end;
 …
     sx ,shy ,w0 ,shx ,sy ,w1 ,tx ,ty ,w2 : single;
     scanDenom,scanNumX,scanNumY: single;
+    FOutsideValue: TPointF;
+    FIncludeOppositePlane: boolean;
+    procedure Init;
   public
     constructor Create; overload;
 …
     procedure ScanMoveTo(x,y:single);
     function ScanNext: TPointF;
+    property OutsideValue: TPointF read FOutsideValue write FOutsideValue;
+    property IncludeOppositePlane: boolean read FIncludeOppositePlane write FIncludeOppositePlane;
   end;
 …
 implementation
 uses BGRABlend;
+uses BGRABlend, GraphType;
 function AffineMatrix(m11, m12, m13, m21, m22, m23: single): TAffineMatrix;
 …
 begin
   result := M[1,1]*M[2,2]-M[1,2]*M[2,1] <> 0;
+end;
+function IsAffineMatrixTranslation(M: TAffineMatrix): boolean;
+begin
+  result := (m[1,1]=1) and (m[1,2]=0) and (m[2,1] = 1) and (m[2,2]=0);
+end;
+function IsAffineMatrixScale(M: TAffineMatrix): boolean;
+begin
+  result := (M[1,3]=0) and (M[2,3]=0) and
+            (M[1,2]=0) and (M[2,1]=0);
+end;
+function IsAffineMatrixIdentity(M: TAffineMatrix): boolean;
+begin
+  result := IsAffineMatrixTranslation(M) and (M[1,3]=0) and (M[2,3]=0);
 end;
 …
 end;
+function AffineMatrixRotationRad(Angle: Single): TAffineMatrix;
+begin
+  result := AffineMatrix(cos(Angle),  sin(Angle), 0,
+                         -sin(Angle), cos(Angle), 0);
+end;
+function AffineMatrixRotationDeg(Angle: Single): TAffineMatrix;
+begin
+  result := AffineMatrixRotationRad(-Angle*Pi/180);
+function AffineMatrixRotationRad(AngleCCW: Single): TAffineMatrix;
+begin
+  result := AffineMatrix(cos(AngleCCW),  sin(AngleCCW), 0,
+                         -sin(AngleCCW), cos(AngleCCW), 0);
+end;
+function AffineMatrixRotationDeg(AngleCW: Single): TAffineMatrix;
+const DegToRad = -Pi/180;
+begin
+  result := AffineMatrixRotationRad(AngleCW*DegToRad);
 end;
 …
 begin
   result := PointF(M[1,1],M[2,1])*PointF(M[1,2],M[2,2]) = 0;
+end;
+{ TBGRAExtendedBorderScanner }
+constructor TBGRAExtendedBorderScanner.Create(ASource: IBGRAScanner;
+  ABounds: TRect);
+begin
+  FSource := ASource;
+  FBounds := ABounds;
+end;
+function TBGRAExtendedBorderScanner.ScanAt(X, Y: Single): TBGRAPixel;
+begin
+  if x < FBounds.Left then x := FBounds.Left;
+  if y < FBounds.Top then y := FBounds.Top;
+  if x > FBounds.Right-1 then x := FBounds.Right-1;
+  if y > FBounds.Bottom-1 then y := FBounds.Bottom-1;
+  result := FSource.ScanAt(X,Y);
 end;
 …
 end;
 function TAffineBox.EmptyBox: TAffineBox;
+class function TAffineBox.EmptyBox: TAffineBox;
 begin
   result.TopLeft := EmptyPointF;
 …
 end;
 function TAffineBox.AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox;
+class function TAffineBox.AffineBox(ATopLeft, ATopRight, ABottomLeft: TPointF): TAffineBox;
 begin
   result.TopLeft := ATopLeft;
 …
 end;
+//transformations are inverted because the effect on the resulting image
+//is the inverse of the transformation. This is due to the fact
+//that the matrix is applied to source coordinates, not destination coordinates
 procedure TBGRAAffineScannerTransform.Translate(OfsX, OfsY: Single);
 begin
 …
 end;
 procedure TBGRAAffineScannerTransform.RotateDeg(Angle: Single);
 begin
   MultiplyBy(AffineMatrixRotationDeg(-Angle));
 end;
 procedure TBGRAAffineScannerTransform.RotateRad(Angle: Single);
 begin
   MultiplyBy(AffineMatrixRotationRad(-Angle));
+procedure TBGRAAffineScannerTransform.RotateDeg(AngleCW: Single);
+begin
+  MultiplyBy(AffineMatrixRotationDeg(-AngleCW));
+end;
+procedure TBGRAAffineScannerTransform.RotateRad(AngleCCW: Single);
+begin
+  MultiplyBy(AffineMatrixRotationRad(-AngleCCW));
 end;
 …
   FRepeatImageY := ARepeatImageY;
   FResampleFilter:= AResampleFilter;
+  FBufferSize:= 0;
 end;
 …
 end;
+destructor TBGRAAffineBitmapTransform.Destroy;
+begin
+  FreeMem(FBuffer);
+end;
 function TBGRAAffineBitmapTransform.InternalScanCurrentPixel: TBGRAPixel;
 begin
+  if FRepeatImageX or FRepeatImageY then
+    result := FBitmap.GetPixelCycle(FCurX,FCurY,FResampleFilter,FRepeatImageX,FRepeatImageY)
+  result := FBitmap.GetPixelCycle(FCurX,FCurY,FResampleFilter,FRepeatImageX,FRepeatImageY);
+end;
+procedure TBGRAAffineBitmapTransform.ScanPutPixels(pdest: PBGRAPixel;
+  count: integer; mode: TDrawMode);
+var p: PBGRAPixel;
+  n: integer;
+  posX4096, posY4096: Int32or64;
+  deltaX4096,deltaY4096: Int32or64;
+  ix,iy,shrMask,w,h: Int32or64;
+  py0: PByte;
+  deltaRow: Int32or64;
+begin
+  w := FBitmap.Width;
+  h := FBitmap.Height;
+  if (w = 0) or (h = 0) then exit;
+  posX4096 := round(FCurX*4096);
+  deltaX4096:= round(FMatrix[1,1]*4096);
+  posY4096 := round(FCurY*4096);
+  deltaY4096:= round(FMatrix[2,1]*4096);
+  shrMask := -1;
+  shrMask := shrMask shr 12;
+  shrMask := not shrMask;
+  if mode = dmSet then
+    p := pdest
   else
+    result := FBitmap.GetPixel(FCurX,FCurY,FResampleFilter);
+  begin
+    if count > FBufferSize then
+    begin
+      FBufferSize := count;
+      ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel));
+    end;
+    p := FBuffer;
+  end;
+  if FResampleFilter = rfBox then
+  begin
+    posX4096 += 2048;
+    posY4096 += 2048;
+    py0 := PByte(FBitmap.ScanLine[0]);
+    if FBitmap.LineOrder = riloTopToBottom then
+      deltaRow := FBitmap.Width*sizeof(TBGRAPixel) else
+      deltaRow := -FBitmap.Width*sizeof(TBGRAPixel);
+    if FRepeatImageX or FRepeatImageY then
+    begin
+      for n := count-1 downto 0 do
+      begin
+        if posX4096 < 0 then ix := (posX4096 shr 12) or shrMask else ix := posX4096 shr 12;
+        if posY4096 < 0 then iy := (posY4096 shr 12) or shrMask else iy := posY4096 shr 12;
+        if FRepeatImageX then ix := PositiveMod(ix,w);
+        if FRepeatImageY then iy := PositiveMod(iy,h);
+        if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then
+          p^ := BGRAPixelTransparent
+        else
+          p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^;
+        inc(p);
+        posX4096 += deltaX4096;
+        posY4096 += deltaY4096;
+      end;
+    end else
+    begin
+     for n := count-1 downto 0 do
+     begin
+       if posX4096 < 0 then ix := (posX4096 shr 12) or shrMask else ix := posX4096 shr 12;
+       if posY4096 < 0 then iy := (posY4096 shr 12) or shrMask else iy := posY4096 shr 12;
+       if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then
+         p^ := BGRAPixelTransparent
+       else
+         p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^;
+       inc(p);
+       posX4096 += deltaX4096;
+       posY4096 += deltaY4096;
+     end;
+    end;
+  end else
+  begin
+   if FRepeatImageX and FRepeatImageY then
+   begin
+     for n := count-1 downto 0 do
+     begin
+       if posX4096 < 0 then ix := (posX4096 shr 12) or shrMask else ix := posX4096 shr 12;
+       if posY4096 < 0 then iy := (posY4096 shr 12) or shrMask else iy := posY4096 shr 12;
+       p^ := FBitmap.GetPixelCycle256(ix,iy, (posX4096 shr 4) and 255, (posY4096 shr 4) and 255,FResampleFilter);
+       inc(p);
+       posX4096 += deltaX4096;
+       posY4096 += deltaY4096;
+     end;
+   end else
+   if FRepeatImageX or FRepeatImageY then
+   begin
+     for n := count-1 downto 0 do
+     begin
+       if posX4096 < 0 then ix := (posX4096 shr 12) or shrMask else ix := posX4096 shr 12;
+       if posY4096 < 0 then iy := (posY4096 shr 12) or shrMask else iy := posY4096 shr 12;
+       p^ := FBitmap.GetPixelCycle256(ix,iy, (posX4096 shr 4) and 255, (posY4096 shr 4) and 255,FResampleFilter, FRepeatImageX,FRepeatImageY);
+       inc(p);
+       posX4096 += deltaX4096;
+       posY4096 += deltaY4096;
+     end;
+   end else
+   begin
+    for n := count-1 downto 0 do
+    begin
+      if posX4096 < 0 then ix := (posX4096 shr 12) or shrMask else ix := posX4096 shr 12;
+      if posY4096 < 0 then iy := (posY4096 shr 12) or shrMask else iy := posY4096 shr 12;
+      p^ := FBitmap.GetPixel256(ix,iy, (posX4096 shr 4) and 255, (posY4096 shr 4) and 255,FResampleFilter);
+      inc(p);
+      posX4096 += deltaX4096;
+      posY4096 += deltaY4096;
+    end;
+   end;
+  end;
+  if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255);
+end;
+function TBGRAAffineBitmapTransform.IsScanPutPixelsDefined: boolean;
+begin
+  Result:=true;
 end;
 …
 { TBGRAPerspectiveScannerTransform }
+function TBGRAPerspectiveScannerTransform.GetIncludeOppositePlane: boolean;
+begin
+  if FMatrix = nil then
+    result := false
+  else
+    result := FMatrix.IncludeOppositePlane;
+end;
+procedure TBGRAPerspectiveScannerTransform.SetIncludeOppositePlane(
+  AValue: boolean);
+begin
+  if FMatrix <> nil then
+    FMatrix.IncludeOppositePlane := AValue;
+end;
 constructor TBGRAPerspectiveScannerTransform.Create(texture: IBGRAScanner; texCoord1,texCoord2: TPointF; const quad: array of TPointF);
 begin
 …
     FMatrix := nil
   else
+  begin
     FMatrix := TPerspectiveTransform.Create(quad,texCoord1.x,texCoord1.y,texCoord2.x,texCoord2.y);
+    FMatrix.OutsideValue := EmptyPointF;
+  end;
   FTexture := texture;
   FScanAtProc:= @FTexture.ScanAt;
 …
     FMatrix := nil
   else
+  begin
     FMatrix := TPerspectiveTransform.Create(quad,texCoordsQuad);
+    FMatrix.OutsideValue := EmptyPointF;
+  end;
   FTexture := texture;
   FScanAtProc:= @FTexture.ScanAt;
 …
   begin
     ptSource := FMatrix.Apply(PointF(X,Y));
+    Result:= FScanAtProc(ptSource.X, ptSource.Y);
+    if ptSource.x = EmptySingle then
+      result := BGRAPixelTransparent
+    else
+      Result:= FScanAtProc(ptSource.X, ptSource.Y);
   end;
 end;
 …
   begin
     ptSource := FMatrix.ScanNext;
+    Result:= FScanAtProc(ptSource.X, ptSource.Y);
+    if ptSource.x = EmptySingle then
+      result := BGRAPixelTransparent
+    else
+      Result:= FScanAtProc(ptSource.X, ptSource.Y);
   end;
 end;
 …
 { TPerspectiveTransform }
+procedure TPerspectiveTransform.Init;
+begin
+  FOutsideValue := PointF(0,0);
+  FIncludeOppositePlane:= True;
+end;
 constructor TPerspectiveTransform.Create;
 begin
+  Init;
   AssignIdentity;
 end;
 …
   const quad: array of TPointF);
 begin
+  Init;
   MapRectToQuad(x1 ,y1 ,x2 ,y2 ,quad );
 end;
 …
   x2, y2: single);
 begin
+  Init;
   MapQuadToRect(quad, x1,y1,x2,y2);
 end;
 …
   destQuad: array of TPointF);
 begin
+  Init;
   MapQuadToQuad(srcQuad,destQuad);
 end;
 …
   m : single;
 begin
+  m:= pt.x * w0 + pt.y * w1 + w2 ;
+  if m=0 then
+  begin
+    result.x := 0;
+    result.y := 0;
+  end else
+  m:= pt.x * w0 + pt.y * w1 + w2;
+  if (m=0) or (not FIncludeOppositePlane and (m < 0)) then
+    result := FOutsideValue
+  else
   begin
    m := 1/m;
 …
 var m: single;
 begin
+  if ScanDenom = 0 then
+  begin
+    result.x := 0;
+    result.y := 0;
+  end else
+  if (ScanDenom = 0) or (not FIncludeOppositePlane and (ScanDenom < 0)) then
+    result := FOutsideValue
+  else
   begin
    m := 1/scanDenom;

GraphicTest/Packages/bgrabitmap/bgratypewriter.pas

-              r452
+              r472
   protected
     FIdentifier: string;
+    procedure WriteHeader(AStream: TStream; AName: string; AContentSize: longint);
+    class procedure ReadHeader(AStream: TStream; out AName: string; out AContentSize: longint);
+    function ContentSize: integer; virtual;
+    function HeaderName: string; virtual;
+    procedure WriteContent(AStream: TStream); virtual;
+    procedure ReadContent(AStream: TStream); virtual;
   public
     Width,Height: single;
     constructor Create(AIdentifier: string); virtual;
+    procedure Path(ADest: TBGRACanvas2D; AMatrix: TAffineMatrix); virtual; abstract;
+    constructor Create(AStream: TStream); virtual;
+    procedure Path({%H-}ADest: IBGRAPath; {%H-}AMatrix: TAffineMatrix); virtual;
     property Identifier: string read FIdentifier;
+  end;
+    procedure SaveToStream(AStream: TStream);
+    class function LoadFromStream(AStream: TStream): TBGRAGlyph;
+  end;
+  TGlyphPointCurveMode= (cmAuto, cmCurve, cmAngle);
   { TBGRAPolygonalGlyph }
 …
     FQuadraticCurves: boolean;
     Points: array of TPointF;
+    CurveMode: array of TGlyphPointCurveMode;
     Curves: array of record
       isCurvedToNext,isCurvedToPrevious: boolean;
 …
     function MaybeCurve(start1,end1,start2,end2: integer): boolean;
     procedure ComputeQuadraticCurves;
+    function ContentSize: integer; override;
+    function HeaderName: string; override;
+    procedure WriteContent(AStream: TStream); override;
+    procedure ReadContent(AStream: TStream); override;
+    procedure Init;
   public
     Offset: TPointF;
+    Closed: boolean;
+    MinimumDotProduct: single;
     constructor Create(AIdentifier: string); override;
+    procedure SetPoints(const APoints: array of TPointF);
+    procedure Path(ADest: TBGRACanvas2D; AMatrix: TAffineMatrix); override;
+    constructor Create(AStream: TStream); override;
+    procedure SetPoints(const APoints: array of TPointF); overload;
+    procedure SetPoints(const APoints: array of TPointF; const ACurveMode: array of TGlyphPointCurveMode); overload;
+    procedure Path(ADest: IBGRAPath; AMatrix: TAffineMatrix); override;
     property QuadraticCurves: boolean read FQuadraticCurves write SetQuadraticCurves;
+  end;
+  TBGRACustomTypeWriterHeader = record
+    HeaderName: String;
+    NbGlyphs: integer;
   end;
 …
     function GetGlyph(AIdentifier: string): TBGRAGlyph; virtual;
     procedure SetGlyph(AIdentifier: string; AValue: TBGRAGlyph);
     procedure TextPath(ADest: TBGRACanvas2D; AText: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft);
+    procedure TextPath(ADest: TBGRACanvas2D; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment; ADrawEachChar: boolean);
     procedure GlyphPath(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft);
     procedure DrawLastPath(ADest: TBGRACanvas2D);
 …
     procedure AddGlyph(AGlyph: TBGRAGlyph);
     function GetGlyphMatrix(AGlyph: TBGRAGlyph; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix;
     function GetTextMatrix(AText: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix;
+    function GetTextMatrix(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment): TAffineMatrix;
     property Glyph[AIdentifier: string]: TBGRAGlyph read GetGlyph write SetGlyph;
+    function CustomHeaderSize: integer; virtual;
+    procedure WriteCustomHeader(AStream: TStream); virtual;
+    function ReadCustomTypeWriterHeader(AStream: TStream): TBGRACustomTypeWriterHeader;
+    procedure ReadAdditionalHeader({%H-}AStream: TStream); virtual;
+    function HeaderName: string; virtual;
   public
     OutlineMode: TBGRATypeWriterOutlineMode;
+    DrawGlyphsSimultaneously : boolean;
     constructor Create;
+    procedure SaveGlyphsToFile(AFilenameUTF8: string);
+    procedure SaveGlyphsToStream(AStream: TStream);
+    procedure LoadGlyphsFromFile(AFilenameUTF8: string);
+    procedure LoadGlyphsFromStream(AStream: TStream);
     procedure DrawGlyph(ADest: TBGRACanvas2D; AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft);
+    procedure DrawText(ADest: TBGRACanvas2D; AText: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft);
+    procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual;
+    procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft); virtual;
     function GetGlyphBox(AIdentifier: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox;
+    function GetTextBox(AText: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox;
+    function GetTextGlyphBoxes(AText: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes;
+    function GetTextBox(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TAffineBox;
+    function GetTextGlyphBoxes(ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes;
+    procedure NeedGlyphRange(AUnicodeFrom, AUnicodeTo: Cardinal);
+    procedure NeedGlyphAnsiRange;
     destructor Destroy; override;
   end;
+function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload;
+function ComputeEasyBezier(APoints: array of TPointF; ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF; overload;
 implementation
+uses LCLProc;
+uses LCLProc, lazutf8classes;
+{$i winstream.inc}
+function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF;
+var
+  glyph: TBGRAPolygonalGlyph;
+  canvas2D: TBGRACanvas2D;
+  i: integer;
+begin
+  if length(APoints) <= 2 then
+  begin
+    setlength(result, length(APoints));
+    for i := 0 to high(result) do
+      result[i] := APoints[i];
+    exit;
+  end;
+  glyph := TBGRAPolygonalGlyph.Create('');
+  glyph.QuadraticCurves := true;
+  glyph.Closed:= AClosed;
+  glyph.MinimumDotProduct := AMinimumDotProduct;
+  glyph.SetPoints(APoints);
+  canvas2D := TBGRACanvas2D.Create(nil);
+  canvas2D.pixelCenteredCoordinates := true;
+  glyph.Path(canvas2D,AffineMatrixIdentity);
+  glyph.Free;
+  result := canvas2D.currentPath;
+  canvas2D.free;
+end;
+function ComputeEasyBezier(APoints: array of TPointF;
+  ACurveMode: array of TGlyphPointCurveMode; AClosed: boolean;
+  AMinimumDotProduct: single): ArrayOfTPointF;
+var
+  glyph: TBGRAPolygonalGlyph;
+  canvas2D: TBGRACanvas2D;
+  i: integer;
+begin
+  if length(APoints) <= 2 then
+  begin
+    setlength(result, length(APoints));
+    for i := 0 to high(result) do
+      result[i] := APoints[i];
+    exit;
+  end;
+  glyph := TBGRAPolygonalGlyph.Create('');
+  glyph.QuadraticCurves := true;
+  glyph.Closed:= AClosed;
+  glyph.MinimumDotProduct := AMinimumDotProduct;
+  glyph.SetPoints(APoints, ACurveMode);
+  canvas2D := TBGRACanvas2D.Create(nil);
+  canvas2D.pixelCenteredCoordinates := true;
+  glyph.Path(canvas2D,AffineMatrixIdentity);
+  glyph.Free;
+  result := canvas2D.currentPath;
+  canvas2D.free;
+end;
 { TBGRAPolygonalGlyph }
 …
   if lv <> 0 then v *= 1/lv;
   result := u*v > 0.707;
+  result := u*v > MinimumDotProduct;
 end;
 …
   FirstPointIndex := 0;
   for i := 0 to high(points) do
+    Curves[i].isCurvedToPrevious := false;
+  for i := 0 to high(points) do
   begin
     Curves[i].isCurvedToNext := false;
-    Curves[i].isCurvedToPrevious := false;
     Curves[i].Center := EmptyPointF;
     Curves[i].ControlPoint := EmptyPointF;
 …
       Curves[i].Center := (points[i]+points[NextPt])*0.5;
       Curves[i].NextCenter := (points[NextPt]+points[NextPt2])*0.5;
-      Curves[i].isCurvedToNext:= MaybeCurve(i,NextPt,NextPt,NextPt2);
-      Curves[NextPt].isCurvedToPrevious := Curves[i].isCurvedToNext;
       Curves[i].ControlPoint := points[NextPt];
+      if (i < high(points)-1) or Closed then
+      begin
+        case CurveMode[nextPt] of
+          cmAuto: Curves[i].isCurvedToNext:= MaybeCurve(i,NextPt,NextPt,NextPt2);
+          cmCurve: Curves[i].isCurvedToNext:= true;
+          else Curves[i].isCurvedToNext:= false;
+        end;
+        Curves[NextPt].isCurvedToPrevious := Curves[i].isCurvedToNext;
+      end;
     end;
   end;
+end;
+function TBGRAPolygonalGlyph.ContentSize: integer;
+begin
+  Result:= (inherited ContentSize) + sizeof(single)*2 + 4 + sizeof(single)*2*length(Points);
+end;
+function TBGRAPolygonalGlyph.HeaderName: string;
+begin
+  Result:='TBGRAPolygonalGlyph';
+end;
+procedure TBGRAPolygonalGlyph.WriteContent(AStream: TStream);
+var i: integer;
+begin
+  inherited WriteContent(AStream);
+  WinWritePointF(AStream, Offset);
+  WinWriteLongint(AStream,length(Points));
+  for i := 0 to high(Points) do
+    WinWritePointF(AStream, Points[i]);
+end;
+procedure TBGRAPolygonalGlyph.ReadContent(AStream: TStream);
+var i: integer;
+  tempPts: array of TPointF;
+begin
+  inherited ReadContent(AStream);
+  Offset := WinReadPointF(AStream);
+  SetLength(tempPts, WinReadLongint(AStream));
+  for i := 0 to high(tempPts) do
+    tempPts[i] := WinReadPointF(AStream);
+  SetPoints(tempPts);
+end;
+procedure TBGRAPolygonalGlyph.Init;
+begin
+  Closed := True;
+  MinimumDotProduct := 0.707;
 end;
 …
   inherited Create(AIdentifier);
   Offset := PointF(0,0);
+  Init;
+end;
+constructor TBGRAPolygonalGlyph.Create(AStream: TStream);
+begin
+  inherited Create(AStream);
+  Init;
 end;
 …
   for i := 0 to high(points) do
     points[i] := APoints[i];
+  setlength(CurveMode, length(APoints));
+  for i := 0 to high(CurveMode) do
+    CurveMode[i] := cmAuto;
   Curves := nil;
 end;
+procedure TBGRAPolygonalGlyph.Path(ADest: TBGRACanvas2D; AMatrix: TAffineMatrix);
+procedure TBGRAPolygonalGlyph.SetPoints(const APoints: array of TPointF;
+  const ACurveMode: array of TGlyphPointCurveMode);
+var i: integer;
+begin
+  if length(APoints) <> length(ACurveMode) then
+    raise exception.Create('Dimension mismatch');
+  SetLength(Points,length(APoints));
+  for i := 0 to high(points) do
+    points[i] := APoints[i];
+  setlength(CurveMode, length(ACurveMode));
+  for i := 0 to high(CurveMode) do
+    CurveMode[i] := ACurveMode[i];
+  Curves := nil;
+end;
+procedure TBGRAPolygonalGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix);
 var i: integer;
   nextMove: boolean;
   startCoord: TPointF;
 begin
   if Points = nil then exit;
 …
   nextMove := true;
   AMatrix := AMatrix*AffineMatrixTranslation(Offset.X,Offset.Y);
   for i := 0 to high(Points) do
     if isEmptyPointF(Points[i]) then
 …
         nextMove := false;
       end else
+      begin
         ADest.lineTo(AMatrix*Points[i]);
+      end;
     end;
+  if not nextmove then ADest.closePath;
+  if not nextmove then
+    ADest.closePath;
 end;
 { TBGRAGlyph }
+procedure TBGRAGlyph.WriteHeader(AStream: TStream; AName: string;
+  AContentSize: longint);
+begin
+  WinWriteByte(AStream, length(AName));
+  AStream.Write(AName[1],length(AName));
+  WinWriteLongint(AStream, AContentSize);
+end;
+class procedure TBGRAGlyph.ReadHeader(AStream: TStream; out AName: string; out
+  AContentSize: longint);
+var NameLength: integer;
+begin
+  NameLength := WinReadByte(AStream);
+  setlength(AName,NameLength);
+  AStream.Read(AName[1],length(AName));
+  AContentSize := WinReadLongint(AStream);
+end;
+function TBGRAGlyph.ContentSize: integer;
+begin
+  result := 4+length(FIdentifier)+sizeof(single)*2;
+end;
+function TBGRAGlyph.HeaderName: string;
+begin
+  result := 'TBGRAGlyph';
+end;
+procedure TBGRAGlyph.WriteContent(AStream: TStream);
+begin
+  WinWriteLongint(AStream,length(FIdentifier));
+  AStream.Write(FIdentifier[1],length(FIdentifier));
+  WinWriteSingle(AStream,Width);
+  WinWriteSingle(AStream,Height);
+end;
+procedure TBGRAGlyph.ReadContent(AStream: TStream);
+var lIdentifierLength: integer;
+begin
+  lIdentifierLength:= WinReadLongint(AStream);
+  setlength(FIdentifier, lIdentifierLength);
+  AStream.Read(FIdentifier[1],length(FIdentifier));
+  Width := WinReadSingle(AStream);
+  Height := WinReadSingle(AStream);
+end;
 constructor TBGRAGlyph.Create(AIdentifier: string);
 begin
   FIdentifier:= AIdentifier;
+end;
+constructor TBGRAGlyph.Create(AStream: TStream);
+begin
+  ReadContent(AStream);
+end;
+procedure TBGRAGlyph.Path(ADest: IBGRAPath; AMatrix: TAffineMatrix);
+begin
+  //nothing
+end;
+procedure TBGRAGlyph.SaveToStream(AStream: TStream);
+begin
+  WriteHeader(AStream, HeaderName, ContentSize);
+  WriteContent(AStream);
+end;
+class function TBGRAGlyph.LoadFromStream(AStream: TStream) : TBGRAGlyph;
+var lName: string;
+  lContentSize: integer;
+  EndPosition: Int64;
+begin
+  ReadHeader(AStream,lName,lContentSize);
+  EndPosition := AStream.Position + lContentSize;
+  if lName = 'TBGRAPolygonalGlyph' then
+    result := TBGRAPolygonalGlyph.Create(AStream)
+  else if lName = 'TBGRAGlyph' then
+    result := TBGRAGlyph.Create(AStream)
+  else
+    raise exception.Create('Unknown glyph type (' + lName + ')');
+  AStream.Position:= EndPosition;
 end;
 …
   TypeWriterMatrix := AffineMatrixIdentity;
   OutlineMode:= twoFill;
+  DrawGlyphsSimultaneously := false;
 end;
 …
 end;
 procedure TBGRACustomTypeWriter.DrawText(ADest: TBGRACanvas2D; AText: string;
+procedure TBGRACustomTypeWriter.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string;
   X, Y: Single; AAlign: TBGRATypeWriterAlignment);
 begin
+  TextPath(ADest, AText, X,Y, AAlign);
+  DrawLastPath(ADest);
+  TextPath(ADest, ATextUTF8, X,Y, AAlign, (OutlineMode <> twoPath) and not DrawGlyphsSimultaneously);
+end;
+procedure TBGRACustomTypeWriter.CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X,Y: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft);
+var
+  pstr: pchar;
+  left,charlen: integer;
+  nextchar: string;
+  g: TBGRAGlyph;
+  m,m2: TAffineMatrix;
+begin
+  if ATextUTF8 = '' then exit;
+  m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
+  m2 := m;
+  pstr := @ATextUTF8[1];
+  left := length(ATextUTF8);
+  while left > 0 do
+  begin
+    charlen := UTF8CharacterLength(pstr);
+    setlength(nextchar, charlen);
+    move(pstr^, nextchar[1], charlen);
+    inc(pstr,charlen);
+    dec(left,charlen);
+    g := GetGlyph(nextchar);
+    if g <> nil then
+    begin
+      if AAlign in [twaLeft,twaMiddle,twaRight] then
+        m2 := m*AffineMatrixTranslation(0,-g.Height/2) else
+      if AAlign in [twaBottomLeft,twaBottom,twaBottomRight] then
+        m2 := m*AffineMatrixTranslation(0,-g.Height)
+      else
+        m2 := m;
+      g.Path(ADest, m2);
+      m := m*AffineMatrixTranslation(g.Width,0);
+    end;
+  end;
 end;
 …
 end;
 function TBGRACustomTypeWriter.GetTextBox(AText: string; X, Y: Single;
+function TBGRACustomTypeWriter.GetTextBox(ATextUTF8: string; X, Y: Single;
   AAlign: TBGRATypeWriterAlignment): TAffineBox;
 var
 …
 begin
   if AText = '' then result := TAffineBox.EmptyBox else
   begin
     m := GetTextMatrix(AText,X,Y,AAlign);
+  if ATextUTF8 = '' then result := TAffineBox.EmptyBox else
+  begin
+    m := GetTextMatrix(ATextUTF8,X,Y,AAlign);
     minY := 0;
     maxY := 0;
     totalWidth := 0;
     pstr := @AText[1];
     left := length(AText);
+    pstr := @ATextUTF8[1];
+    left := length(ATextUTF8);
     while left > 0 do
     begin
 …
 end;
 function TBGRACustomTypeWriter.GetTextGlyphBoxes(AText: string; X, Y: Single;
+function TBGRACustomTypeWriter.GetTextGlyphBoxes(ATextUTF8: string; X, Y: Single;
   AAlign: TBGRATypeWriterAlignment): TGlyphBoxes;
 var
 …
 begin
   if AText = '' then result := nil else
   begin
     setlength(result, UTF8Length(AText));
     m := GetTextMatrix(AText,X,Y,AAlign);
     pstr := @AText[1];
     left := length(AText);
+  if ATextUTF8 = '' then result := nil else
+  begin
+    setlength(result, UTF8Length(ATextUTF8));
+    m := GetTextMatrix(ATextUTF8,X,Y,AAlign);
+    pstr := @ATextUTF8[1];
+    left := length(ATextUTF8);
     numChar := 0;
     while left > 0 do
 …
 end;
+procedure TBGRACustomTypeWriter.TextPath(ADest: TBGRACanvas2D; AText: string; X,
+  Y: Single; AAlign: TBGRATypeWriterAlignment);
+procedure TBGRACustomTypeWriter.NeedGlyphRange(AUnicodeFrom, AUnicodeTo: Cardinal);
+var c: cardinal;
+begin
+  for c := AUnicodeFrom to AUnicodeTo do
+    GetGlyph(UnicodeToUTF8(c));
+end;
+procedure TBGRACustomTypeWriter.NeedGlyphAnsiRange;
+var i: integer;
+begin
+  for i := 0 to 255 do
+    GetGlyph(AnsiToUtf8(chr(i)));
+end;
+procedure TBGRACustomTypeWriter.TextPath(ADest: TBGRACanvas2D; ATextUTF8: string; X,
+  Y: Single; AAlign: TBGRATypeWriterAlignment; ADrawEachChar: boolean);
 var
   pstr: pchar;
 …
   m,m2: TAffineMatrix;
 begin
   ADest.beginPath;
   if AText = '' then exit;
   m := GetTextMatrix(AText, X,Y,AAlign);
+  if not ADrawEachChar then ADest.beginPath;
+  if ATextUTF8 = '' then exit;
+  m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
   m2 := m;
   pstr := @AText[1];
   left := length(AText);
+  pstr := @ATextUTF8[1];
+  left := length(ATextUTF8);
   while left > 0 do
   begin
 …
       else
         m2 := m;
+      if ADrawEachChar then ADest.beginPath;
       g.Path(ADest, m2);
+      if ADrawEachChar then DrawLastPath(ADest);
       m := m*AffineMatrixTranslation(g.Width,0);
     end;
 …
 end;
+procedure TBGRACustomTypeWriter.SaveGlyphsToStream(AStream: TStream);
+var Enumerator: TAvgLvlTreeNodeEnumerator;
+begin
+  WinWriteLongint(AStream,CustomHeaderSize);
+  WriteCustomHeader(AStream);
+  Enumerator := FGlyphs.GetEnumerator;
+  while Enumerator.MoveNext do
+    TBGRAGlyph(Enumerator.Current.Data).SaveToStream(AStream);
+  Enumerator.Free;
+end;
+procedure TBGRACustomTypeWriter.LoadGlyphsFromFile(AFilenameUTF8: string);
+var Stream: TFileStreamUTF8;
+begin
+  Stream := nil;
+  try
+    Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead);
+    LoadGlyphsFromStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+procedure TBGRACustomTypeWriter.LoadGlyphsFromStream(AStream: TStream);
+var Header: TBGRACustomTypeWriterHeader;
+  i: integer;
+  g: TBGRAGlyph;
+  HeaderSize: integer;
+  GlyphStartPosition: Int64;
+begin
+  HeaderSize := WinReadLongint(AStream);
+  GlyphStartPosition:= AStream.Position+HeaderSize;
+  Header := ReadCustomTypeWriterHeader(AStream);
+  if header.HeaderName <> HeaderName then
+    raise exception.Create('Invalid file format ("'+header.HeaderName+'" should be "'+HeaderName+'")');
+  ReadAdditionalHeader(AStream);
+  AStream.Position:= GlyphStartPosition;
+  for i := 0 to Header.NbGlyphs-1 do
+  begin
+    g := TBGRAGlyph.LoadFromStream(AStream);
+    AddGlyph(g);
+  end;
+end;
+procedure TBGRACustomTypeWriter.SaveGlyphsToFile(AFilenameUTF8: string);
+var Stream: TFileStreamUTF8;
+begin
+  Stream := nil;
+  try
+    Stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate or fmOpenWrite);
+    SaveGlyphsToStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
 function TBGRACustomTypeWriter.GetGlyphMatrix(AGlyph: TBGRAGlyph; X, Y: Single;
   AAlign: TBGRATypeWriterAlignment): TAffineMatrix;
 …
 end;
 function TBGRACustomTypeWriter.GetTextMatrix(AText: string; X, Y: Single;
+function TBGRACustomTypeWriter.GetTextMatrix(ATextUTF8: string; X, Y: Single;
   AAlign: TBGRATypeWriterAlignment): TAffineMatrix;
 var
 …
   begin
     totalWidth := 0;
     pstr := @AText[1];
     left := length(AText);
+    pstr := @ATextUTF8[1];
+    left := length(ATextUTF8);
     while left > 0 do
     begin
 …
 end;
+function TBGRACustomTypeWriter.CustomHeaderSize: integer;
+begin
+  result := 1+length(HeaderName)+4;
+end;
+procedure TBGRACustomTypeWriter.WriteCustomHeader(AStream: TStream);
+var lHeaderName: string;
+begin
+  lHeaderName:= HeaderName;
+  WinWriteByte(AStream,length(lHeaderName));
+  AStream.Write(lHeaderName[1],length(lHeaderName));
+  WinWriteLongint(AStream,FGlyphs.Count);
+end;
+function TBGRACustomTypeWriter.ReadCustomTypeWriterHeader(AStream: TStream
+  ): TBGRACustomTypeWriterHeader;
+begin
+  setlength(result.HeaderName, WinReadByte(AStream));
+  AStream.Read(result.HeaderName[1],length(result.HeaderName));
+  result.NbGlyphs:= WinReadLongint(AStream);
+end;
+procedure TBGRACustomTypeWriter.ReadAdditionalHeader(AStream: TStream);
+begin
+  //nothing
+end;
+function TBGRACustomTypeWriter.HeaderName: string;
+begin
+  result := 'TBGRACustomTypeWriter';
+end;
 destructor TBGRACustomTypeWriter.Destroy;
 begin

GraphicTest/Packages/bgrabitmap/bgravectorize.pas

-              r452
+              r472
 interface
+{
+  Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+  This unit provides vectorizers :
+  - VectorizeMonochrome function vectorizes a back'n'white image
+  - TBGRAVectorizedFont allows to vectorize and to load vectorized font and draw them
+  TBGRAVectorizedFontRenderer class works like other font renderers, i.e., it can
+  be assigned to the FontRenderer property. You can use it in two different modes :
+  - if you supply a directory, it will look for *.glyphs files in it to load fonts
+  - if you don't supply a directory, fonts will be vectorized from LCL
+  Note that unless you want to supply your own glyphs files, you don't need
+  to use explicitely this renderer, because TBGRATextEffectFontRenderer will
+  make use of it if necessary, according to effects parameters used.
+}
 uses
+  Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATypewriter, BGRATransform, BGRACanvas2D;
+  Types, Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATypewriter, BGRATransform, BGRACanvas2D, BGRAText;
+//vectorize a monochrome bitmap
 function VectorizeMonochrome(ASource: TBGRACustomBitmap; zoom: single; PixelCenteredCoordinates: boolean): ArrayOfTPointF;
 type
+  TBGRAVectorizedFont = class;
+  //this is the class to assign to FontRenderer property of TBGRABitmap
+  { TBGRAVectorizedFontRenderer }
+  TBGRAVectorizedFontRenderer = class(TBGRACustomFontRenderer)
+  protected
+    FVectorizedFontArray: array of record
+        FontName: string;
+        FontStyle: TFontStyles;
+        VectorizedFont: TBGRAVectorizedFont;
+      end;
+    FVectorizedFont: TBGRAVectorizedFont;
+    FCanvas2D: TBGRACanvas2D;
+    FDirectoryUTF8: string;
+    function OutlineActuallyVisible: boolean;
+    procedure UpdateFont;
+    function GetCanvas2D(ASurface: TBGRACustomBitmap): TBGRACanvas2D;
+    procedure InternalTextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner);
+    procedure Init;
+  public
+    MaxFontResolution: integer;
+    OutlineVisible: boolean;
+    OutlineWidth: single;
+    OutlineColor: TBGRAPixel;
+    OutlineTexture: IBGRAScanner;
+    OuterOutlineOnly: boolean;
+    ShadowVisible: boolean;
+    ShadowColor: TBGRAPixel;
+    ShadowRadius: integer;
+    ShadowOffset: TPoint;
+    constructor Create;
+    constructor Create(ADirectoryUTF8: string);
+    function GetFontPixelMetric: TFontPixelMetric; override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); override;
+    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; s: string; c: TBGRAPixel; align: TAlignment); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
+    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
+    procedure CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment); override;
+    function TextSize(s: string): TSize; override;
+    destructor Destroy; override;
+  end;
   TGlyphSizes = array of record
             Glyph: String;
 …
   end;
+  TWordBreakHandler = procedure(var ABefore, AAfter: string) of object;
+  TBGRAVectorizedFontHeader = record
+    Name: string;
+    Style: TFontStyles;
+    EmHeightRatio: single;
+    Resolution: integer;
+    PixelMetric: TFontPixelMetric;
+  end;
+  TBGRAGlyphsInfo = record
+    Name: string;
+    Style: TFontStyles;
+    NbGlyphs: integer;
+  end;
   { TBGRAVectorizedFont }
 …
     FItalicSlope: single;
     FWordBreakHandler: TWordBreakHandler;
+    FDirectory: string;
+    FDirectoryContent: array of record
+      Filename: string;
+      FontName: string;
+      FontStyle: TFontStyles;
+    end;
+    FFontEmHeightRatioComputed: boolean;
+    FFontEmHeightRatio: single;
+    FFontPixelMetric: TFontPixelMetric;
+    FFontPixelMetricComputed: boolean;
+    FFontFound: boolean;
+    function GetEmHeight: single;
+    function GetFontPixelMetric: TFontPixelMetric;
+    function GetLCLHeight: single;
+    function GetVectorizeLCL: boolean;
+    procedure SetEmHeight(AValue: single);
     procedure SetItalicSlope(AValue: single);
+    procedure SetLCLHeight(AValue: single);
     procedure SetOrientation(AValue: single);
     procedure SetQuadraticCurves(AValue: boolean);
 …
     procedure SetName(AValue: string);
     procedure SetStyle(AValue: TFontStyles);
+    function GetFontEmHeightRatio: single;
+    procedure SetVectorizeLCL(AValue: boolean);
   protected
     procedure UpdateFont;
 …
     function GetGlyph(AIdentifier: string): TBGRAGlyph; override;
     procedure DefaultWordBreakHandler(var ABefore, AAfter: string);
+    procedure Init(AVectorize: boolean);
+    function CustomHeaderSize: integer; override;
+    procedure WriteCustomHeader(AStream: TStream); override;
+    procedure ReadAdditionalHeader(AStream: TStream); override;
+    function ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader;
+    function HeaderName: string; override;
+    procedure SetDirectory(const AValue: string);
   public
+    UnderlineDecoration,StrikeOutDecoration: boolean;
     constructor Create;
+    constructor Create(AVectorizeLCL: boolean);
     destructor Destroy; override;
     function GetGlyphSize(AIdentifier:string): TPointF;
     function GetTextGlyphSizes(AText:string): TGlyphSizes;
     function GetTextSize(AText:string): TPointF;
+    procedure SplitText(var AText: string; AMaxWidth: single; out ARemains: string);
+    procedure DrawTextWordBreak(ADest: TBGRACanvas2D; AText: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    procedure DrawTextRect(ADest: TBGRACanvas2D; AText: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    procedure DrawTextRect(ADest: TBGRACanvas2D; AText: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    function GetTextWordBreakGlyphBoxes(AText: string; X,Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes;
+    function GetTextRectGlyphBoxes(AText: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes;
+    function GetTextRectGlyphBoxes(AText: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes;
+    procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string);
+    procedure DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft); override;
+    procedure CopyTextPathTo(ADest: IBGRAPath; ATextUTF8: string; X, Y: Single;
+      AAlign: TBGRATypeWriterAlignment=twaTopLeft); override;
+    procedure DrawTextWordBreak(ADest: TBGRACanvas2D; ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    procedure DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft);
+    function GetTextWordBreakGlyphBoxes(ATextUTF8: string; X,Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment = twaTopLeft): TGlyphBoxes;
+    function GetTextRectGlyphBoxes(ATextUTF8: string; X1,Y1,X2,Y2: Single; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes;
+    function GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft,ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment=twaTopLeft): TGlyphBoxes;
+    procedure UpdateDirectory;
+    function LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo;
     property Resolution: integer read FResolution write SetResolution;
     property Style: TFontStyles read FStyle write SetStyle;
     property Name: string read FName write SetName;
+    property LCLHeight: single read GetLCLHeight write SetLCLHeight;
+    property EmHeight: single read GetEmHeight write SetEmHeight;
     property FullHeight: single read FFullHeight write SetFullHeight;
     property FontMatrix: TAffineMatrix read FFontMatrix write SetFontMatrix;
 …
     property ItalicSlope: single read FItalicSlope write SetItalicSlope;
     property OnWordBreak: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler;
+    property Directory: string read FDirectory write SetDirectory;
+    property FontEmHeightRatio: single read GetFontEmHeightRatio;
+    property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;
+    property FontFound: boolean read FFontFound;
+    property VectorizeLCL: boolean read GetVectorizeLCL write SetVectorizeLCL;
   end;
 implementation
+uses BGRAText, LCLProc, Types;
+uses LCLProc, FileUtil, lazutf8classes;
+{$i winstream.inc}
 function VectorizeMonochrome(ASource: TBGRACustomBitmap; zoom: single; PixelCenteredCoordinates: boolean): ArrayOfTPointF;
 const unitShift = 6;
 …
           (ord(cur[1])+ord(cur[3])+ord(cur[7])+ord(cur[9]) = 3)) then
       begin
         if (not cur[6] and not cur[9] and not cur[8] and ((ASource.getPixel(integer(x-1),integer(y-2)).green <= 128) or (ASource.getPixel(integer(x+2),integer(y+1)).green <= 128)) ) or
           (not cur[8] and not cur[7] and not cur[4] and ((ASource.getPixel(integer(x-2),integer(y+1)).green <= 128) or (ASource.getPixel(integer(x+1),integer(y-2)).green <= 128)) ) or
           (not cur[4] and not cur[1] and not cur[2] and ((ASource.getPixel(integer(x+1),integer(y+2)).green <= 128) or (ASource.getPixel(integer(x-2),integer(y-1)).green <= 128)) ) or
           (not cur[2] and not cur[3] and not cur[6] and ((ASource.getPixel(integer(x-1),integer(y+2)).green <= 128) or (ASource.getPixel(integer(x+2),integer(y-1)).green <= 128)) ) then
+        if (not cur[6] and not cur[9] and not cur[8] and ((ASource.getPixel(x-1,y-2).green <= 128) or (ASource.getPixel(x+2,y+1).green <= 128)) ) or
+          (not cur[8] and not cur[7] and not cur[4] and ((ASource.getPixel(x-2,y+1).green <= 128) or (ASource.getPixel(x+1,y-2).green <= 128)) ) or
+          (not cur[4] and not cur[1] and not cur[2] and ((ASource.getPixel(x+1,y+2).green <= 128) or (ASource.getPixel(x-2,y-1).green <= 128)) ) or
+          (not cur[2] and not cur[3] and not cur[6] and ((ASource.getPixel(x-1,y+2).green <= 128) or (ASource.getPixel(x+2,y-1).green <= 128)) ) then
             ortho[y,x] := true;
       end;
 …
 end;
+{ TBGRAVectorizedFontRenderer }
+function TBGRAVectorizedFontRenderer.OutlineActuallyVisible: boolean;
+begin
+  result := OutlineVisible and (abs(OutlineWidth) > 0) and (OutlineColor.Alpha <> 0) or (OutlineTexture <> nil);
+end;
+procedure TBGRAVectorizedFontRenderer.UpdateFont;
+var i,neededResolution: integer;
+begin
+  FVectorizedFont := nil;
+  FontName := Trim(FontName);
+  for i := 0 to high(FVectorizedFontArray) do
+    if (CompareText(FVectorizedFontArray[i].FontName,FontName)=0) and
+      (FVectorizedFontArray[i].FontStyle = FontStyle) then
+    begin
+      FVectorizedFont := FVectorizedFontArray[i].VectorizedFont;
+      break;
+    end;
+  if FVectorizedFont = nil then
+  begin
+    FVectorizedFont:= TBGRAVectorizedFont.Create(False);
+    FVectorizedFont.Name := FontName;
+    FVectorizedFont.Style := FontStyle;
+    FVectorizedFont.Directory := FDirectoryUTF8;
+    if not FVectorizedFont.FontFound and LCLFontAvailable then
+      FVectorizedFont.VectorizeLCL := True;
+    Setlength(FVectorizedFontArray,length(FVectorizedFontArray)+1);
+    FVectorizedFontArray[high(FVectorizedFontArray)].FontName := FontName;
+    FVectorizedFontArray[high(FVectorizedFontArray)].FontStyle := FontStyle;
+    FVectorizedFontArray[high(FVectorizedFontArray)].VectorizedFont := FVectorizedFont;
+  end;
+  if FontEmHeight > 0 then
+    FVectorizedFont.EmHeight := FontEmHeight
+  else
+    FVectorizedFont.FullHeight:= -FontEmHeight;
+  if OutlineActuallyVisible then
+  begin
+    if OuterOutlineOnly then
+      FVectorizedFont.OutlineMode := twoFillOverStroke
+    else
+      FVectorizedFont.OutlineMode := twoStrokeOverFill;
+    FVectorizedFont.QuadraticCurves := False;
+  end
+  else
+  begin
+    FVectorizedFont.OutlineMode := twoFill;
+    FVectorizedFont.QuadraticCurves := FVectorizedFont.FullHeight > FVectorizedFont.Resolution*0.8;
+  end;
+  if FVectorizedFont.VectorizeLCL then
+  begin
+    neededResolution := trunc((FVectorizedFont.FullHeight+80)/50)*50;
+    if neededResolution > MaxFontResolution then neededResolution := MaxFontResolution;
+    if FVectorizedFont.Resolution < neededResolution then FVectorizedFont.Resolution:= neededResolution;
+  end;
+end;
+function TBGRAVectorizedFontRenderer.GetCanvas2D(ASurface: TBGRACustomBitmap
+  ): TBGRACanvas2D;
+begin
+  if (FCanvas2D = nil) or (FCanvas2D.surface <> ASurface) then
+  begin
+    FCanvas2D.Free;
+    FCanvas2D := TBGRACanvas2D.Create(ASurface);
+  end;
+  result := FCanvas2D;
+  FCanvas2D.antialiasing:= FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB];
+  if OutlineTexture <> nil then
+    FCanvas2D.strokeStyle(OutlineTexture)
+  else
+    FCanvas2D.strokeStyle(OutlineColor);
+  FCanvas2D.lineWidth := abs(OutlineWidth);
+  if not ShadowVisible then
+    FCanvas2D.shadowColor(BGRAPixelTransparent)
+  else
+  begin
+    FCanvas2D.shadowColor(ShadowColor);
+    FCanvas2D.shadowBlur:= ShadowRadius;
+    FCanvas2D.shadowOffset := PointF(ShadowOffset.X,ShadowOffset.Y);
+  end;
+end;
+procedure TBGRAVectorizedFontRenderer.InternalTextRect(
+  ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string;
+  style: TTextStyle; c: TBGRAPixel; texture: IBGRAScanner);
+var
+  twAlign : TBGRATypeWriterAlignment;
+  c2D: TBGRACanvas2D;
+  intersectedClip,previousClip: TRect;
+begin
+  previousClip := ADest.ClipRect;
+  if style.Clipping then
+  begin
+    intersectedClip := rect(0,0,0,0);
+    if not IntersectRect(intersectedClip, previousClip, ARect) then exit;
+    ADest.ClipRect := intersectedClip;
+  end;
+  UpdateFont;
+  FVectorizedFont.Orientation := 0;
+  case style.Alignment of
+    taCenter: case style.Layout of
+              tlCenter: twAlign := twaMiddle;
+              tlBottom: twAlign := twaBottom;
+              else twAlign:= twaTop;
+              end;
+    taRightJustify:
+              case style.Layout of
+              tlCenter: twAlign := twaRight;
+              tlBottom: twAlign := twaBottomRight;
+              else twAlign := twaTopRight;
+              end;
+    else
+              case style.Layout of
+              tlCenter: twAlign := twaLeft;
+              tlBottom: twAlign := twaBottomLeft;
+              else twAlign:= twaTopLeft;
+              end;
+  end;
+  c2D := GetCanvas2D(ADest);
+  if texture = nil then
+    c2D.fillStyle(c)
+  else
+    c2D.fillStyle(texture);
+  if style.Wordbreak then
+    FVectorizedFont.DrawTextRect(c2D, sUTF8, x-0.5,y-0.5,ARect.Right-0.5,ARect.Bottom-0.5, twAlign)
+  else
+  begin
+    case style.Layout of
+    tlCenter: y := (ARect.Top+ARect.Bottom) div 2;
+    tlBottom: y := ARect.Bottom;
+    end;
+    case style.Alignment of
+    taCenter: FVectorizedFont.DrawText(c2D, sUTF8, (ARect.Left+ARect.Right-1)/2,y-0.5, twAlign);
+    taRightJustify: FVectorizedFont.DrawText(c2D, sUTF8, ARect.Right-0.5,y-0.5, twAlign);
+    else
+      FVectorizedFont.DrawText(c2D, sUTF8, x-0.5,y-0.5, twAlign);
+    end;
+  end;
+  if style.Clipping then
+    ADest.ClipRect := previousClip;
+end;
+procedure TBGRAVectorizedFontRenderer.Init;
+begin
+  FVectorizedFontArray := nil;
+  FDirectoryUTF8 := '';
+  OutlineVisible:= True;
+  OutlineColor := BGRAPixelTransparent;
+  OuterOutlineOnly := false;
+  ShadowColor := BGRABlack;
+  ShadowVisible := false;
+  ShadowOffset := Point(5,5);
+  ShadowRadius := 5;
+  MaxFontResolution := 300;
+end;
+constructor TBGRAVectorizedFontRenderer.Create;
+begin
+  Init;
+end;
+constructor TBGRAVectorizedFontRenderer.Create(ADirectoryUTF8: string);
+begin
+  Init;
+  FDirectoryUTF8 := ADirectoryUTF8;
+end;
+function TBGRAVectorizedFontRenderer.GetFontPixelMetric: TFontPixelMetric;
+var factor: single;
+begin
+  UpdateFont;
+  result := FVectorizedFont.FontPixelMetric;
+  if FVectorizedFont.Resolution > 0 then
+  begin
+    factor := FVectorizedFont.FullHeight/FVectorizedFont.Resolution;
+    result.Baseline := round(result.Baseline*factor);
+    result.CapLine := round(result.CapLine*factor);
+    result.Lineheight := round(result.Lineheight*factor);
+    result.DescentLine := round(result.DescentLine*factor);
+    result.xLine := round(result.xLine*factor);
+  end;
+end;
+procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment);
+var
+  twAlign : TBGRATypeWriterAlignment;
+  c2D: TBGRACanvas2D;
+  ofs: TPointF;
+begin
+  UpdateFont;
+  FVectorizedFont.Orientation := orientation;
+  case align of
+    taCenter: twAlign:= twaMiddle;
+    taRightJustify: twAlign := twaRight;
+    else twAlign:= twaLeft;
+  end;
+  c2D := GetCanvas2D(ADest);
+  c2D.fillStyle(c);
+  ofs := PointF(x,y);
+  ofs += AffineMatrixRotationDeg(-orientation*0.1)*PointF(0,FVectorizedFont.FullHeight*0.5);
+  FVectorizedFont.DrawText(c2D, s, ofs.x,ofs.y, twAlign);
+end;
+procedure TBGRAVectorizedFontRenderer.TextOutAngle(ADest: TBGRACustomBitmap; x,
+  y: single; orientation: integer; s: string; texture: IBGRAScanner;
+  align: TAlignment);
+var
+  twAlign : TBGRATypeWriterAlignment;
+  c2D: TBGRACanvas2D;
+begin
+  UpdateFont;
+  FVectorizedFont.Orientation := orientation;
+  case align of
+    taCenter: twAlign:= twaTop;
+    taRightJustify: twAlign := twaTopRight;
+    else twAlign:= twaTopLeft;
+  end;
+  c2D := GetCanvas2D(ADest);
+  c2D.fillStyle(texture);
+  FVectorizedFont.DrawText(c2D, s, x,y, twAlign);
+end;
+procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; texture: IBGRAScanner; align: TAlignment);
+begin
+  TextOutAngle(ADest,x,y,FontOrientation,s,texture,align);
+end;
+procedure TBGRAVectorizedFontRenderer.TextOut(ADest: TBGRACustomBitmap; x,
+  y: single; s: string; c: TBGRAPixel; align: TAlignment);
+begin
+  TextOutAngle(ADest,x,y,FontOrientation,s,c,align);
+end;
+procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel);
+begin
+  InternalTextRect(ADest,ARect,x,y,s,style,c,nil);
+end;
+procedure TBGRAVectorizedFontRenderer.TextRect(ADest: TBGRACustomBitmap;
+  ARect: TRect; x, y: integer; s: string; style: TTextStyle;
+  texture: IBGRAScanner);
+begin
+  InternalTextRect(ADest,ARect,x,y,s,style,BGRAPixelTransparent,texture);
+end;
+procedure TBGRAVectorizedFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment);
+var
+  twAlign : TBGRATypeWriterAlignment;
+  ofs: TPointF;
+begin
+  UpdateFont;
+  FVectorizedFont.Orientation := 0;
+  case align of
+    taCenter: twAlign:= twaMiddle;
+    taRightJustify: twAlign := twaRight;
+    else twAlign:= twaLeft;
+  end;
+  ofs := PointF(x,y);
+  ofs += PointF(0,FVectorizedFont.FullHeight*0.5);
+  FVectorizedFont.CopyTextPathTo(ADest, s, ofs.x,ofs.y, twAlign);
+end;
+function TBGRAVectorizedFontRenderer.TextSize(s: string): TSize;
+var sizeF: TPointF;
+begin
+  UpdateFont;
+  sizeF := FVectorizedFont.GetTextSize(s);
+  result.cx := round(sizeF.x);
+  result.cy := round(sizeF.y);
+end;
+destructor TBGRAVectorizedFontRenderer.Destroy;
+var i: integer;
+begin
+  FCanvas2D.Free;
+  for i := 0 to high(FVectorizedFontArray) do
+    FVectorizedFontArray[i].VectorizedFont.Free;
+  FVectorizedFontArray := nil;
+  inherited Destroy;
+end;
 { TBGRAVectorizedFont }
 …
 end;
+procedure TBGRAVectorizedFont.SetLCLHeight(AValue: single);
+begin
+  if (AValue > 0) xor (FontEmHeightSign < 0) then
+    EmHeight := abs(AValue)
+  else
+    FullHeight := abs(AValue);
+end;
+function TBGRAVectorizedFont.GetEmHeight: single;
+begin
+  result := FullHeight * FontEmHeightRatio;
+end;
+function TBGRAVectorizedFont.GetFontPixelMetric: TFontPixelMetric;
+begin
+  if not FFontPixelMetricComputed and (FFont <> nil) then
+  begin
+    FFontPixelMetric := BGRAText.GetFontPixelMetric(FFont);
+    FFontPixelMetricComputed := true;
+  end;
+  result := FFontPixelMetric;
+end;
+function TBGRAVectorizedFont.GetLCLHeight: single;
+begin
+  result := FullHeight * FontFullHeightSign;
+end;
+function TBGRAVectorizedFont.GetVectorizeLCL: boolean;
+begin
+  result := FFont <> nil;
+end;
+procedure TBGRAVectorizedFont.SetEmHeight(AValue: single);
+begin
+  if FontEmHeightRatio > 0 then
+    FullHeight := AValue / FontEmHeightRatio;
+end;
 procedure TBGRAVectorizedFont.SetQuadraticCurves(AValue: boolean);
 begin
 …
 end;
+function TBGRAVectorizedFont.GetFontEmHeightRatio: single;
+var
+  lEmHeight, lFullHeight: single;
+  OldHeight: integer;
+begin
+  if not FFontEmHeightRatioComputed then
+  begin
+    if FFont <> nil then
+    begin
+      OldHeight := FFont.Height;
+      FFont.Height := FontEmHeightSign * 100;
+      lEmHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy;
+      FFont.Height := FontFullHeightSign * 100;
+      lFullHeight := BGRATextSize(FFont, fqSystem, 'Hg', 1).cy;
+      if lEmHeight = 0 then
+        FFontEmHeightRatio := 1
+      else
+        FFontEmHeightRatio := lFullHeight/lEmHeight;
+      FFontEmHeightRatioComputed := true;
+      FFont.Height := OldHeight;
+    end else
+    begin
+      result := 1;
+      exit;
+    end;
+  end;
+  result := FFontEmHeightRatio;
+end;
+procedure TBGRAVectorizedFont.SetVectorizeLCL(AValue: boolean);
+begin
+  if AValue then
+  begin
+    if FFont = nil then
+      FFont := TFont.Create;
+  end else
+  begin
+    if FFont <> nil then
+      FreeAndNil(FFont);
+  end;
+  UpdateFont;
+end;
 procedure TBGRAVectorizedFont.UpdateFont;
+begin
+  ClearGlyphs;
+  FFont.Name := FName;
+  FFont.Style := FStyle;
+  FFont.Height := FontFullHeightSign * FResolution;
+var i: integer;
+  bestIndex, bestDistance: integer;
+  distance: integer;
+begin
+  if FFont <> nil then
+  begin
+    ClearGlyphs;
+    FFont.Name := FName;
+    FFont.Style := FStyle;
+    FFont.Height := FontFullHeightSign * FResolution;
+    FFontEmHeightRatio := 1;
+    FFontEmHeightRatioComputed := false;
+    fillchar(FFontPixelMetric,sizeof(FFontPixelMetric),0);
+    FFontPixelMetricComputed := false;
+    FFontFound := True;
+  end else
+  begin
+    bestIndex := -1;
+    bestDistance := 1000;
+    for i := 0 to high(FDirectoryContent) do
+    begin
+      if CompareText(FDirectoryContent[i].FontName,FName) = 0 then
+      begin
+        distance := 0;
+        if (fsBold in FDirectoryContent[i].FontStyle) xor (fsBold in FStyle) then distance += 10;
+        if (fsItalic in FDirectoryContent[i].FontStyle) xor (fsItalic in FStyle) then distance += 5;
+        if (fsStrikeOut in FDirectoryContent[i].FontStyle) xor (fsStrikeOut in FStyle) then distance += 1;
+        if (fsUnderline in FDirectoryContent[i].FontStyle) xor (fsUnderline in FStyle) then distance += 1;
+        if (bestIndex = -1) or (distance < bestDistance) then
+        begin
+          bestIndex := i;
+          bestDistance := distance;
+          if FDirectoryContent[i].FontStyle = FStyle then break;
+        end;
+      end;
+    end;
+    if bestIndex <> -1 then
+    begin
+      if not (fsItalic in FDirectoryContent[bestIndex].FontStyle) and (fsItalic in FStyle) then
+        ItalicSlope := 0.25
+      else if (fsItalic in FDirectoryContent[bestIndex].FontStyle) and not (fsItalic in FStyle) then
+        ItalicSlope := -0.25
+      else
+        ItalicSlope := 0;
+      UnderlineDecoration := not (fsUnderline in FDirectoryContent[bestIndex].FontStyle) and (fsUnderline in FStyle);
+      StrikeOutDecoration := not (fsStrikeOut in FDirectoryContent[bestIndex].FontStyle) and (fsStrikeOut in FStyle);
+      ClearGlyphs;
+      LoadGlyphsFromFile(FDirectoryContent[bestIndex].Filename);
+      FFontFound := True;
+    end else
+      FFontFound := false;
+  end;
 end;
 …
 begin
   inherited Create;
+  FName := 'Arial';
+  FStyle := [];
+  FFontMatrix := AffineMatrixIdentity;
+  FOrientation := 0;
+  FResolution := 100;
+  FFont := TFont.Create;
+  FBuffer := BGRABitmapFactory.Create;
+  FFullHeight := 20;
+  FItalicSlope := 0;
+  UpdateFont;
+  UpdateMatrix;
+  FWordBreakHandler:= nil;
+  Init(True);
+end;
+constructor TBGRAVectorizedFont.Create(AVectorizeLCL: boolean);
+begin
+  inherited Create;
+  Init(AVectorizeLCL);
 end;
 …
 end;
 procedure TBGRAVectorizedFont.SplitText(var AText: string; AMaxWidth: single;
   out ARemains: string);
+procedure TBGRAVectorizedFont.SplitText(var ATextUTF8: string; AMaxWidth: single;
+  out ARemainsUTF8: string);
 var
   pstr: pchar;
+  left,charlen: integer;
+  p,left,charlen: integer;
+  totalWidth: single;
+  firstChar: boolean;
   nextchar: string;
   g: TBGRAGlyph;
-  totalWidth: single;
-  firstChar: boolean;
 begin
   totalWidth := 0;
   if AText = '' then
   begin
     ARemains := '';
+  if ATextUTF8 = '' then
+  begin
+    ARemainsUTF8 := '';
     exit;
   end else
   begin
+    pstr := @AText[1];
+    left := length(AText);
+    p := 1;
+    pstr := @ATextUTF8[1];
+    left := length(ATextUTF8);
     firstChar := true;
     while left > 0 do
     begin
+      if RemoveLineEnding(ATextUTF8,p) then
+      begin
+        ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+        ATextUTF8 := copy(ATextUTF8,1,p-1);
+        exit;
+      end;
       charlen := UTF8CharacterLength(pstr);
       setlength(nextchar, charlen);
 …
       begin
         totalWidth += g.Width*FullHeight;
         if (totalWidth > AMaxWidth) and not firstChar then
+        if not firstChar and (totalWidth > AMaxWidth) then
         begin
           ARemains:= copy(AText,length(AText)-left+1,left);
           AText := copy(AText, 1, length(AText)-left);
+          ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+          ATextUTF8 := copy(ATextUTF8,1,p-1);
           if Assigned(FWordBreakHandler) then
             FWordBreakHandler(AText,ARemains) else
               DefaultWordBreakHandler(AText,ARemains);
+            FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
+              DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
           exit;
         end;
 …
       dec(left,charlen);
+      inc(p,charlen);
       firstChar := false;
     end;
   end;
+  ARemains := ''; //no split
+  ARemainsUTF8 := ''; //no split
+end;
+procedure TBGRAVectorizedFont.DrawText(ADest: TBGRACanvas2D; ATextUTF8: string; X,
+  Y: Single; AAlign: TBGRATypeWriterAlignment);
+var underlinePoly: ArrayOfTPointF;
+  m: TAffineMatrix;
+  i: integer;
+  deltaY: single;
+begin
+  inherited DrawText(ADest, ATextUTF8, X, Y, AAlign);
+  if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else
+  if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else
+    deltaY := 0;
+  if UnderlineDecoration and (Resolution > 0) then
+  begin
+    underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution,
+      (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution);
+    if underlinePoly <> nil then
+    begin
+      m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
+      for i := 0 to high(underlinePoly) do
+        underlinePoly[i] := m*underlinePoly[i];
+      if OutlineMode <> twoPath then ADest.beginPath;
+      ADest.polylineTo(underlinePoly);
+      DrawLastPath(ADest);
+    end;
+  end;
+  if StrikeOutDecoration and (Resolution > 0) then
+  begin
+    underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution,
+      (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution);
+    if underlinePoly <> nil then
+    begin
+      m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
+      for i := 0 to high(underlinePoly) do
+        underlinePoly[i] := m*underlinePoly[i];
+      if OutlineMode <> twoPath then ADest.beginPath;
+      ADest.polylineTo(underlinePoly);
+      DrawLastPath(ADest);
+    end;
+  end;
+end;
+procedure TBGRAVectorizedFont.CopyTextPathTo(ADest: IBGRAPath;
+  ATextUTF8: string; X, Y: Single; AAlign: TBGRATypeWriterAlignment);
+var underlinePoly: ArrayOfTPointF;
+  m: TAffineMatrix;
+  i: integer;
+  deltaY: single;
+begin
+  inherited CopyTextPathTo(ADest,ATextUTF8, X, Y, AAlign);
+  if AAlign in [twaBottom,twaBottomLeft,twaBottomRight] then deltaY := -1 else
+  if AAlign in [twaLeft,twaMiddle,twaRight] then deltaY := -0.5 else
+    deltaY := 0;
+  if UnderlineDecoration and (Resolution > 0) then
+  begin
+    underlinePoly := BGRATextUnderline(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution,
+      (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution);
+    if underlinePoly <> nil then
+    begin
+      m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
+      ADest.moveTo(m*underlinePoly[0]);
+      for i := 1 to high(underlinePoly) do
+        ADest.lineTo(m*underlinePoly[i]);
+      ADest.closePath;
+    end;
+  end;
+  if StrikeOutDecoration and (Resolution > 0) then
+  begin
+    underlinePoly := BGRATextStrikeOut(PointF(0,deltaY), GetTextSize(ATextUTF8).x/FullHeight, FontPixelMetric.Baseline/Resolution,
+      (FontPixelMetric.Baseline-FontPixelMetric.CapLine)/Resolution, (FontPixelMetric.Baseline-FontPixelMetric.xLine)/Resolution);
+    if underlinePoly <> nil then
+    begin
+      m := GetTextMatrix(ATextUTF8, X,Y,AAlign);
+      ADest.moveTo(m*underlinePoly[0]);
+      for i := 1 to high(underlinePoly) do
+        ADest.lineTo(m*underlinePoly[i]);
+      ADest.closePath;
+    end;
+  end;
 end;
 procedure TBGRAVectorizedFont.DrawTextWordBreak(ADest: TBGRACanvas2D;
   AText: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment);
+  ATextUTF8: string; X, Y, MaxWidth: Single; AAlign: TBGRATypeWriterAlignment);
 var ARemains: string;
   step: TPointF;
 …
   lineAlignment: TBGRATypeWriterAlignment;
 begin
   if (AText = '') or (MaxWidth <= 0) then exit;
+  if (ATextUTF8 = '') or (MaxWidth <= 0) then exit;
   oldItalicSlope:= ItalicSlope;
 …
     Y += step.Y*lineShift;
     repeat
       SplitText(AText, MaxWidth, ARemains);
       DrawText(ADest,AText,X,Y,lineAlignment);
       AText := ARemains;
+      SplitText(ATextUTF8, MaxWidth, ARemains);
+      DrawText(ADest,ATextUTF8,X,Y,lineAlignment);
+      ATextUTF8 := ARemains;
       X+= step.X;
       Y+= step.Y;
 …
     lines := TStringList.Create;
     repeat
       SplitText(AText, MaxWidth, ARemains);
       lines.Add(AText);
       AText := ARemains;
+      SplitText(ATextUTF8, MaxWidth, ARemains);
+      lines.Add(ATextUTF8);
+      ATextUTF8 := ARemains;
     until ARemains = '';
     if AAlign in[twaLeft,twaMiddle,twaRight] then lineShift := lines.Count/2-0.5
 …
 end;
 procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; AText: string;
+procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string;
   X1, Y1, X2, Y2: Single; AAlign: TBGRATypeWriterAlignment);
 var X,Y: single;
 …
   oldOrientation:= Orientation;
   Orientation:= 0;
   DrawTextWordBreak(ADest,AText,X,Y,X2-X1,AAlign);
+  DrawTextWordBreak(ADest,ATextUTF8,X,Y,X2-X1,AAlign);
   Orientation:= oldOrientation;
 end;
 procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; AText: string;
+procedure TBGRAVectorizedFont.DrawTextRect(ADest: TBGRACanvas2D; ATextUTF8: string;
   ATopLeft, ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment);
 begin
   DrawTextRect(ADest,AText,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign);
 end;
 function TBGRAVectorizedFont.GetTextWordBreakGlyphBoxes(AText: string; X, Y,
+  DrawTextRect(ADest,ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign);
+end;
+function TBGRAVectorizedFont.GetTextWordBreakGlyphBoxes(ATextUTF8: string; X, Y,
   MaxWidth: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes;
 var ARemains: string;
 …
 begin
   result := nil;
   if AText = '' then exit;
+  if ATextUTF8 = '' then exit;
   oldItalicSlope:= ItalicSlope;
 …
   lines := TStringList.Create;
   repeat
     SplitText(AText, MaxWidth, ARemains);
     lines.Add(AText);
     AText := ARemains;
+    SplitText(ATextUTF8, MaxWidth, ARemains);
+    lines.Add(ATextUTF8);
+    ATextUTF8 := ARemains;
   until ARemains = '';
 …
 end;
 function TBGRAVectorizedFont.GetTextRectGlyphBoxes(AText: string; X1, Y1, X2,
+function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; X1, Y1, X2,
   Y2: Single; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes;
 var X,Y,oldOrientation: single;
 …
   oldOrientation:= Orientation;
   Orientation:= 0;
   result := GetTextWordBreakGlyphBoxes(AText,X,Y,X2-X1,AAlign);
+  result := GetTextWordBreakGlyphBoxes(ATextUTF8,X,Y,X2-X1,AAlign);
   Orientation:= oldOrientation;
 end;
 function TBGRAVectorizedFont.GetTextRectGlyphBoxes(AText: string; ATopLeft,
+function TBGRAVectorizedFont.GetTextRectGlyphBoxes(ATextUTF8: string; ATopLeft,
   ABottomRight: TPointF; AAlign: TBGRATypeWriterAlignment): TGlyphBoxes;
 begin
+  result := GetTextRectGlyphBoxes(AText,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign);
+  result := GetTextRectGlyphBoxes(ATextUTF8,ATopLeft.X,ATopLeft.Y,ABottomRight.X,ABottomRight.Y,AAlign);
+end;
+procedure TBGRAVectorizedFont.UpdateDirectory;
+var
+  NbFiles: integer;
+  SearchRec: TSearchRec;
+  Info: TBGRAGlyphsInfo;
+  Fullname: string;
+begin
+  NbFiles := 0;
+  FDirectoryContent := nil;
+  if FDirectory = '' then exit;
+  if (length(FDirectory) > 0) and not (FDirectory[length(FDirectory)] in AllowDirectorySeparators) then
+    FDirectory += DirectorySeparator;
+  if FindFirstUTF8(FDirectory +'*.glyphs', faAnyFile, SearchRec) = 0 then
+  repeat
+    if (faDirectory or faVolumeId or faSysFile) and SearchRec.Attr = 0 then
+    begin
+      Fullname := FDirectory+SearchRec.Name;
+      Info := LoadGlyphsInfo(Fullname);
+      if (info.Name <> '') and (info.NbGlyphs > 0) then
+      begin
+        if NbFiles = length(FDirectoryContent) then
+          setlength(FDirectoryContent,2*NbFiles+1);
+        FDirectoryContent[NbFiles].Filename:= Fullname;
+        FDirectoryContent[NbFiles].FontName:= info.Name;
+        FDirectoryContent[NbFiles].FontStyle:= info.Style;
+        inc(NbFiles);
+      end;
+    end;
+  until FindNext(SearchRec) <> 0;
+  SetLength(FDirectoryContent,NbFiles);
+end;
+function TBGRAVectorizedFont.LoadGlyphsInfo(AFilenameUTF8: string): TBGRAGlyphsInfo;
+var Stream: TFileStreamUTF8;
+  twHeader: TBGRACustomTypeWriterHeader;
+  vfHeader: TBGRAVectorizedFontHeader;
+begin
+  result.Name := '';
+  result.NbGlyphs := 0;
+  result.Style := [];
+  Stream := nil;
+  try
+    Stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead);
+    Stream.Position := 4;
+    twHeader := ReadCustomTypeWriterHeader(Stream);
+    result.NbGlyphs := twHeader.NbGlyphs;
+    if twHeader.HeaderName = HeaderName then
+    begin
+      vfHeader := ReadVectorizedFontHeader(Stream);
+      result.Name := vfHeader.Name;
+      result.Style:= vfHeader.Style;
+    end;
+  except
+    on ex:exception do
+    begin
+    end;
+  end;
+  Stream.Free;
 end;
 …
 begin
   Result:=inherited GetGlyph(AIdentifier);
   if (result = nil) and (FResolution > 0) then
+  if (result = nil) and (FResolution > 0) and (FFont <> nil) then
   begin
     g := TBGRAPolygonalGlyph.Create(AIdentifier);
 …
 procedure TBGRAVectorizedFont.DefaultWordBreakHandler(var ABefore,AAfter: string);
+var p: integer;
+begin
+  if (AAfter <> '') and (ABefore <> '') and (AAfter[1]<> ' ') and (ABefore[length(ABefore)] <> ' ') then
+  begin
+    p := length(ABefore);
+    while (p > 1) and (ABefore[p-1] <> ' ') do dec(p);
+    if p > 1 then //can put the word after
+    begin
+      AAfter := copy(ABefore,p,length(ABefore)-p+1)+AAfter;
+      ABefore := copy(ABefore,1,p-1);
+    end else
+    begin //cannot put the word after, so before
+    end;
+  end;
+  while (ABefore <> '') and (ABefore[length(ABefore)] =' ') do delete(ABefore,length(ABefore),1);
+  while (AAfter <> '') and (AAfter[1] =' ') do delete(AAfter,1,1);
+begin
+  BGRADefaultWordBreakHandler(ABefore,AAfter);
+end;
+procedure TBGRAVectorizedFont.Init(AVectorize: boolean);
+begin
+  FName := 'Arial';
+  FStyle := [];
+  FFontMatrix := AffineMatrixIdentity;
+  FOrientation := 0;
+  FResolution := 100;
+  FFontEmHeightRatio := 1;
+  FFontEmHeightRatioComputed := false;
+  if AVectorize then
+    FFont := TFont.Create
+  else
+    FFont := nil;
+  FBuffer := BGRABitmapFactory.Create;
+  FFullHeight := 20;
+  FItalicSlope := 0;
+  UpdateFont;
+  UpdateMatrix;
+  FWordBreakHandler:= nil;
+end;
+function TBGRAVectorizedFont.CustomHeaderSize: integer;
+begin
+  Result:= (inherited CustomHeaderSize) + 4+length(FName)+4 + sizeof(single) + 4 + 5*4;
+end;
+procedure TBGRAVectorizedFont.WriteCustomHeader(AStream: TStream);
+var metric: TFontPixelMetric;
+begin
+  inherited WriteCustomHeader(AStream);
+  WinWriteLongint(AStream, length(FName));
+  AStream.Write(FName[1],length(FName));
+  WinWriteLongint(AStream, integer(FStyle));
+  WinWriteSingle(AStream, FontEmHeightRatio);
+  WinWriteLongint(AStream, Resolution);
+  metric := FontPixelMetric;
+  WinWriteLongint(AStream, metric.Baseline);
+  WinWriteLongint(AStream, metric.xLine);
+  WinWriteLongint(AStream, metric.CapLine);
+  WinWriteLongint(AStream, metric.DescentLine);
+  WinWriteLongint(AStream, metric.Lineheight);
+end;
+procedure TBGRAVectorizedFont.ReadAdditionalHeader(AStream: TStream);
+var Header: TBGRAVectorizedFontHeader;
+begin
+  inherited ReadAdditionalHeader(AStream);
+  Header := ReadVectorizedFontHeader(AStream);
+  FName := Header.Name;
+  FStyle := Header.Style;
+  if header.EmHeightRatio <> 0 then
+  begin
+    FFontEmHeightRatio := Header.EmHeightRatio;
+    FFontEmHeightRatioComputed := true;
+  end else
+  begin
+    FFontEmHeightRatio := 1;
+    FFontEmHeightRatioComputed := false;
+  end;
+  FFontPixelMetric := Header.PixelMetric;
+  FFontPixelMetricComputed := True;
+  if FFont = nil then
+    FResolution := Header.Resolution;
+end;
+function TBGRAVectorizedFont.ReadVectorizedFontHeader(AStream: TStream): TBGRAVectorizedFontHeader;
+var lNameLength: integer;
+begin
+  lNameLength := WinReadLongint(AStream);
+  setlength(result.Name, lNameLength);
+  AStream.Read(result.Name[1],length(result.Name));
+  result.Style := TFontStyles(WinReadLongint(AStream));
+  result.EmHeightRatio:= WinReadSingle(AStream);
+  result.Resolution := WinReadLongint(AStream);
+  result.PixelMetric.Baseline := WinReadLongint(AStream);
+  result.PixelMetric.xLine := WinReadLongint(AStream);
+  result.PixelMetric.CapLine := WinReadLongint(AStream);
+  result.PixelMetric.DescentLine := WinReadLongint(AStream);
+  result.PixelMetric.Lineheight := WinReadLongint(AStream);
+  result.PixelMetric.Defined := result.PixelMetric.Lineheight > 0;
+end;
+function TBGRAVectorizedFont.HeaderName: string;
+begin
+  Result:= 'TBGRAVectorizedFont';
+end;
+procedure TBGRAVectorizedFont.SetDirectory(const AValue: string);
+begin
+  if Trim(AValue) = Trim(FDirectory) then exit;
+  FDirectory := Trim(AValue);
+  UpdateDirectory;
+  UpdateFont;
 end;

GraphicTest/Packages/bgrabitmap/bgrawinbitmap.pas

-              r452
+              r472
 procedure TWinBitmapTracker.Changed(Sender: TObject);
 begin
+  FUser.AlphaCorrectionNeeded;
+  if FUser <> nil then
+    FUser.AlphaCorrectionNeeded;
   inherited Changed(Sender);
 end;

GraphicTest/Packages/bgrabitmap/blendpixelinline.inc

-              r452
+              r472
   aw := GammaExpansionTab[a];
   bw := GammaExpansionTab[b];
+  {$HINTS OFF}
   Result := GammaCompressionTab[aw+bw-(longword(aw)*longword(bw) shr 15)];
+  {$HINTS ON}
 end;
 …
 function ByteLinearExclusionInline(a, b: byte): byte; inline;
 begin
+  {$HINTS OFF}
   Result := a+b-(a*b shr 7);
+  {$HINTS ON}
 end;

GraphicTest/Packages/bgrabitmap/blurfast.inc

-              r452
+              r472
 var
   blurRow: array of cardinal;
+  blurRow: array of UInt32or64;
   { Compute weights of pixels in a row }
 …
 var
   srcDelta,
   weightShift: integer;
+  verticalWeightShift, horizontalWeightShift: integer;
   { Compute blur result in a vertical direction }
 …
       aDiv += w;
       aw := aw shr weightShift;
+      aw := aw shr verticalWeightShift;
       {$hints off}
       sumR += c.red*aw;
 …
   sumStartIndex,curIndex: integer;
   total: TRowSum;
+  extendedTotal: TExtendedRowSum;
   yb,xb,xs,ys1,ys2,x: integer;
   w: cardinal;
   pdest: PBGRAPixel;
   bmpWidth,bmpHeight : integer;
   radiusSquare: integer;
+  accumulationFactor: double;
   bounds: TRect;
 …
   if radius = 0 then
   begin
     result := bmp.Duplicate;
+    ADestination.PutImage(0,0,bmp,dmSet);
     exit;
   end;
 …
   bmpHeight := bmp.Height;
   //create output
+  result := bmp.NewBitmap(bmpWidth,bmpHeight);
+  if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then
+    raise exception.Create('Dimension mismatch');
   bounds := bmp.GetImageBounds;
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    exit;
+  if IsRectEmpty(bounds) then exit;
   bounds.Left   := max(0, bounds.Left - radius);
   bounds.Top    := max(0, bounds.Top - radius);
   bounds.Right  := min(bmp.Width, bounds.Right + radius);
   bounds.Bottom := min(bmp.Height, bounds.Bottom + radius);
+  radiusSquare := sqr((radius+1)*(radius+2) div 2);
+  weightShift := 0;
+  while radiusSquare > 16384 do //18496 do
+  begin
+    radiusSquare := radiusSquare shr 1;
+    inc(weightShift);
+  if not IntersectRect(bounds,bounds,ABounds) then exit;
+  accumulationFactor := (radius+2)*(radius+1) div 2 + (radius+1)*radius div 2;
+  verticalWeightShift := 0;
+  while accumulationFactor > (high(UInt32or64) shr 16) + 1 do
+  begin
+    inc(verticalWeightShift);
+    accumulationFactor *= 0.5;
+  end;
+  horizontalWeightShift:= 0;
+  accumulationFactor *= ((radius+2)*(radius+1) div 2 + (radius+1)*radius div 2);
+  while accumulationFactor > (high(UInt32or64) shr 16) + 1 do
+  begin
+    inc(horizontalWeightShift);
+    accumulationFactor *= 0.5;
   end;
   ComputeBlurRow;
 …
   for yb := bounds.top to bounds.bottom-1 do
   begin
+    if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break;
     //evalute available vertical range
     if yb - radius < 0 then
 …
     sumStartIndex := 0;
     pdest := result.scanline[yb]+bounds.left;
+    pdest := ADestination.scanline[yb]+bounds.left;
     for xb := bounds.left to bounds.right-1 do
     begin
       //add vertical rows
-      {$hints off}
-      fillchar(total,sizeof(total),0);
-      {$hints on}
       curIndex:= sumStartIndex;
+      for xs := 0 to high(sums) do
+      with sums[curIndex] do
+      begin
+        w := blurRow[xs];
+        total.sumA += sumA*w;
+        total.aDiv += aDiv*w;
+        total.sumR += sumR*w;
+        total.sumG += sumG*w;
+        total.sumB += sumB*w;
+        total.rgbDiv += rgbDiv*w;
+        inc(curIndex);
+        if curIndex = length(sums) then curIndex := 0;
+      if horizontalWeightShift > 4 then
+      begin //we don't want to loose too much precision
+        {$hints off}
+        fillchar(extendedTotal,sizeof(extendedTotal),0);
+        {$hints on}
+        for xs := 0 to high(sums) do
+        with sums[curIndex] do
+        begin
+          w := blurRow[xs];
+          extendedTotal.sumA += TExtendedRowValue(sumA)*w;
+          extendedTotal.aDiv += TExtendedRowValue(aDiv)*w;
+          extendedTotal.sumR += TExtendedRowValue(sumR)*w;
+          extendedTotal.sumG += TExtendedRowValue(sumG)*w;
+          extendedTotal.sumB += TExtendedRowValue(sumB)*w;
+          extendedTotal.rgbDiv += TExtendedRowValue(rgbDiv)*w;
+          inc(curIndex);
+          if curIndex = length(sums) then curIndex := 0;
+        end;
+        if (extendedTotal.aDiv > 0) and (extendedTotal.rgbDiv > 0) then
+          pdest^:= ComputeExtendedAverage(extendedTotal)
+        else
+          pdest^:= BGRAPixelTransparent;
+      end else
+      if horizontalWeightShift > 0 then
+      begin //lossy but efficient way
+        {$hints off}
+        fillchar(total,sizeof(total),0);
+        {$hints on}
+        for xs := 0 to high(sums) do
+        with sums[curIndex] do
+        begin
+          w := blurRow[xs];
+          total.sumA += sumA*w shr horizontalWeightShift;
+          total.aDiv += aDiv*w shr horizontalWeightShift;
+          total.sumR += sumR*w shr horizontalWeightShift;
+          total.sumG += sumG*w shr horizontalWeightShift;
+          total.sumB += sumB*w shr horizontalWeightShift;
+          total.rgbDiv += rgbDiv*w shr horizontalWeightShift;
+          inc(curIndex);
+          if curIndex = length(sums) then curIndex := 0;
+        end;
+        if (total.aDiv > 0) and (total.rgbDiv > 0) then
+          pdest^:= ComputeClampedAverage(total)
+        else
+          pdest^:= BGRAPixelTransparent;
+      end else
+      begin //normal way
+        {$hints off}
+        fillchar(total,sizeof(total),0);
+        {$hints on}
+        for xs := 0 to high(sums) do
+        with sums[curIndex] do
+        begin
+          w := blurRow[xs];
+          total.sumA += sumA*w;
+          total.aDiv += aDiv*w;
+          total.sumR += sumR*w;
+          total.sumG += sumG*w;
+          total.sumB += sumB*w;
+          total.rgbDiv += rgbDiv*w;
+          inc(curIndex);
+          if curIndex = length(sums) then curIndex := 0;
+        end;
+        if (total.aDiv > 0) and (total.rgbDiv > 0) then
+          pdest^:= ComputeAverage(total)
+        else
+          pdest^:= BGRAPixelTransparent;
       end;
-      if (total.aDiv > 0) and (total.rgbDiv > 0) then
-        pdest^:= ComputeAverage(total)
-      else
-        pdest^:= BGRAPixelTransparent;
       inc(pdest);
       //shift vertical rows
 …
     end;
   end;
+  ADestination.InvalidateBitmap;
 end;

GraphicTest/Packages/bgrabitmap/blurnormal.inc

-              r452
+              r472
     //evaluate required bounds taking blur radius into acount
     bounds := bmp.GetImageBounds;
     if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    if IsRectEmpty(bounds) then
     begin
       result := false;
 …
     bounds.Right  := min(bmp.Width, bounds.Right + maskWidth - 1 - blurOfs.X);
     bounds.Bottom := min(bmp.Height, bounds.Bottom + maskHeight - 1 - blurOfs.Y);
+    if not IntersectRect(bounds, bounds, ABounds) then
+    begin
+      result := false;
+      exit;
+    end;
     //init scanlines
 …
   LoadMask;
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then
+    raise exception.Create('Dimension mismatch');
   if not PrepareScan then exit; //nothing to do
 …
   for yb := bounds.Top to bounds.Bottom - 1 do
   begin
+    pdest := Result.ScanLine[yb] + bounds.Left;
+    if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break;
+    pdest := ADestination.ScanLine[yb] + bounds.Left;
     //compute vertical range
     mindy := max(-blurOfs.Y, -yb);
 …
     ShiftScan(yb-blurOfs.Y+maskHeight);
   end;
   Result.InvalidateBitmap;
+  ADestination.InvalidateBitmap;
 end;
 {$undef PARAM_MASKSHIFT}

GraphicTest/Packages/bgrabitmap/csscolorconst.inc

-              r452
+              r472
+{$IFDEF INCLUDE_COLOR_CONST}
+{$UNDEF INCLUDE_COLOR_CONST}
 const
+  //VGA colors
+  VGABlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
+  VGAGray: TBGRAPixel = (blue: 128; green: 128; red: 128; alpha: 255);
+  VGASilver: TBGRAPixel = (blue: 192; green: 192; red: 192; alpha: 255);
+  VGAWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
+  VGAMaroon: TBGRAPixel = (blue: 0; green: 0; red: 128; alpha: 255);
+  VGARed: TBGRAPixel = (blue: 0; green: 0; red: 255; alpha: 255);
+  VGAPurple: TBGRAPixel = (blue: 128; green: 0; red: 128; alpha: 255);
+  VGAFuchsia: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
+  VGAGreen: TBGRAPixel = (blue: 0; green: 128; red: 0; alpha: 255);
+  VGALime: TBGRAPixel = (blue: 0; green: 255; red: 0; alpha: 255);
+  VGAOlive: TBGRAPixel = (blue: 0; green: 128; red: 128; alpha: 255);
+  VGAYellow: TBGRAPixel = (blue: 0; green: 255; red: 255; alpha: 255);
+  VGANavy: TBGRAPixel = (blue: 128; green: 0; red: 0; alpha: 255);
+  VGABlue: TBGRAPixel = (blue: 255; green: 0; red: 0; alpha: 255);
+  VGATeal: TBGRAPixel = (blue: 128; green: 128; red: 0; alpha: 255);
+  VGAAqua: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
   //Red colors
   CSSIndianRed: TBGRAPixel = (blue: 92; green: 92; red: 205; alpha: 255);
 …
   CSSDarkSlateGray: TBGRAPixel = (blue: 79; green: 79; red: 47; alpha: 255);
   CSSBlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
+{$ENDIF}
+{$IFDEF INCLUDE_COLOR_LIST}
+{$UNDEF INCLUDE_COLOR_LIST}
+  VGAColors := TBGRAColorList.Create;
+  VGAColors.Add('Black',VGABlack);
+  VGAColors.Add('Gray',VGAGray);
+  VGAColors.Add('Silver',VGASilver);
+  VGAColors.Add('White',VGAWhite);
+  VGAColors.Add('Maroon',VGAMaroon);
+  VGAColors.Add('Red',VGARed);
+  VGAColors.Add('Purple',VGAPurple);
+  VGAColors.Add('Fuchsia',VGAFuchsia);
+  VGAColors.Add('Green',VGAGreen);
+  VGAColors.Add('Lime',VGALime);
+  VGAColors.Add('Olive',VGAOlive);
+  VGAColors.Add('Yellow',VGAYellow);
+  VGAColors.Add('Navy',VGANavy);
+  VGAColors.Add('Blue',VGABlue);
+  VGAColors.Add('Teal',VGATeal);
+  VGAColors.Add('Aqua',VGAAqua);
+  VGAColors.Finished;
+  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;
+{$ENDIF}

GraphicTest/Packages/bgrabitmap/filldensitysegment256.inc

-              r452
+              r472
       if ix1 = ix2 then
         (density + (ix1 - minx))^ += round((x2 - x1)*256)
+        (density + (ix1 - minx))^ += round((x2-ix2)*256) - round((x1-ix1)*256)
       else
       begin
         (density + (ix1 - minx))^ += round((1 - (x1 - ix1))*256);
+        (density + (ix1 - minx))^ += 256 - round((x1 - ix1)*256);
         if (ix2 <= maxx) then
           (density + (ix2 - minx))^ += round((x2 - ix2)*256);

GraphicTest/Packages/bgrabitmap/lightingclasses3d.inc

-              r452
+              r472
   TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D)
   private
+    FDiffuseColorInt: TColorInt65536;
+    FName: string;
+    FTexture: IBGRAScanner;
+    FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean;
+    FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536;
     FDiffuseLightness: integer;
+    FTextureZoom: TPointF;
     FSpecularColorInt: TColorInt65536;
-    FAutoDiffuseColor,FAutoSpecularColor: boolean;
     FSpecularIndex: integer;
     FSpecularOn: boolean;
     FSaturationLowF: single;
     FSaturationHighF: single;
 …
     procedure UpdateSpecular;
+    procedure UpdateSimpleColor;
     procedure ComputePowerTable;
   public
 …
     destructor Destroy; override;
+    function GetAutoAmbiantColor: boolean;
     function GetAutoDiffuseColor: boolean;
     function GetAutoSpecularColor: boolean;
+    function GetAutoSimpleColor: boolean;
+    function GetAmbiantAlpha: byte;
+    function GetAmbiantColor: TBGRAPixel;
+    function GetAmbiantColorF: TColorF;
+    function GetAmbiantColorInt: TColorInt65536;
+    function GetDiffuseAlpha: byte;
     function GetDiffuseColor: TBGRAPixel;
     function GetDiffuseColorF: TColorF;
 …
     function GetSaturationHigh: single;
     function GetSaturationLow: single;
+    function GetSimpleAlpha: byte;
+    function GetSimpleColor: TBGRAPixel;
+    function GetSimpleColorF: TColorF;
+    function GetSimpleColorInt: TColorInt65536;
+    function GetTexture: IBGRAScanner;
+    function GetTextureZoom: TPointF;
+    procedure SetAutoAmbiantColor(const AValue: boolean);
     procedure SetAutoDiffuseColor(const AValue: boolean);
     procedure SetAutoSpecularColor(const AValue: boolean);
+    procedure SetAmbiantAlpha(AValue: byte);
+    procedure SetAmbiantColor(const AValue: TBGRAPixel);
+    procedure SetAmbiantColorF(const AValue: TColorF);
+    procedure SetAmbiantColorInt(const AValue: TColorInt65536);
+    procedure SetDiffuseAlpha(AValue: byte);
     procedure SetDiffuseColor(const AValue: TBGRAPixel);
     procedure SetDiffuseColorF(const AValue: TColorF);
 …
     procedure SetSaturationHigh(const AValue: single);
     procedure SetSaturationLow(const AValue: single);
+    procedure SetSimpleAlpha(AValue: byte);
+    procedure SetSimpleColor(AValue: TBGRAPixel);
+    procedure SetSimpleColorF(AValue: TColorF);
+    procedure SetSimpleColorInt(AValue: TColorInt65536);
+    procedure SetTexture(AValue: IBGRAScanner);
+    procedure SetTextureZoom(AValue: TPointF);
+    function GetName: string;
+    procedure SetName(const AValue: string);
     function GetSpecularOn: boolean;
 …
 procedure TBGRAMaterial3D.UpdateSpecular;
 begin
+  FAutoSpecularColor := (FSpecularColorInt.r = 65536) and (FSpecularColorInt.g = 65536) and (FSpecularColorInt.b = 65536) and (FSpecularColorInt.a = 65536);
   FSpecularOn := (FSpecularIndex > 0) and ((FSpecularColorInt.r <> 0) or (FSpecularColorInt.g <> 0) or (FSpecularColorInt.b <> 0) or
                                             FAutoSpecularColor);
+end;
+procedure TBGRAMaterial3D.UpdateSimpleColor;
+begin
+  FSimpleColorInt := (FAmbiantColorInt+FDiffuseColorInt)*32768;
+  FAutoSimpleColor := (FSimpleColorInt.r = 65536) and (FSimpleColorInt.g = 65536) and (FSimpleColorInt.b = 65536) and (FSimpleColorInt.a = 65536);
 end;
 …
 constructor TBGRAMaterial3D.Create;
 begin
+  SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
   SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
-  FAutoDiffuseColor:= True;
-  FSpecularColorInt := ColorInt65536(0,0,0);
-  FAutoSpecularColor:= True;
   FSpecularIndex := 10;
   FSpecularOn := false;
+  SetSpecularColorInt(ColorInt65536(0,0,0));
   FLightThroughFactor:= 0;
   SetSaturationLow(2);
   SetSaturationHigh(3);
+  FTexture := nil;
+  FTextureZoom := PointF(1,1);
   FPowerTableSize := 128;
   FPowerTableSizeF := FPowerTableSize;
 …
 end;
+function TBGRAMaterial3D.GetAutoAmbiantColor: boolean;
+begin
+  result := FAutoAmbiantColor;
+end;
+procedure TBGRAMaterial3D.SetDiffuseAlpha(AValue: byte);
+begin
+  if AValue = 0 then
+    FDiffuseColorInt.a := 0
+  else
+    FDiffuseColorInt.a := AValue*257+1;
+  UpdateSimpleColor;
+end;
 function TBGRAMaterial3D.GetAutoDiffuseColor: boolean;
 begin
 …
 end;
+function TBGRAMaterial3D.GetAutoSimpleColor: boolean;
+begin
+  result := FAutoSimpleColor;
+end;
+function TBGRAMaterial3D.GetAmbiantAlpha: byte;
+var v: integer;
+begin
+  if FAmbiantColorInt.a < 128 then
+    result := 0
+  else
+  begin
+    v := (FAmbiantColorInt.a-128) shr 8;
+    if v > 255 then v := 255;
+    result := v;
+  end;
+end;
+function TBGRAMaterial3D.GetAmbiantColor: TBGRAPixel;
+begin
+  result := ColorIntToBGRA(FAmbiantColorInt);
+end;
+function TBGRAMaterial3D.GetAmbiantColorF: TColorF;
+begin
+  result := ColorInt65536ToColorF(FAmbiantColorInt);
+end;
+function TBGRAMaterial3D.GetAmbiantColorInt: TColorInt65536;
+begin
+  result := FAmbiantColorInt;
+end;
+function TBGRAMaterial3D.GetDiffuseAlpha: byte;
+var v: integer;
+begin
+  if FDiffuseColorInt.a < 128 then
+    result := 0
+  else
+  begin
+    v := (FDiffuseColorInt.a-128) shr 8;
+    if v > 255 then v := 255;
+    result := v;
+  end;
+end;
 function TBGRAMaterial3D.GetDiffuseColor: TBGRAPixel;
 begin
 …
 end;
+function TBGRAMaterial3D.GetSimpleAlpha: byte;
+begin
+  result := (GetAmbiantAlpha + GetDiffuseAlpha) shr 1;
+end;
+function TBGRAMaterial3D.GetSimpleColor: TBGRAPixel;
+begin
+  result := ColorIntToBGRA(GetSimpleColorInt);
+end;
+function TBGRAMaterial3D.GetSimpleColorF: TColorF;
+begin
+  result := ColorInt65536ToColorF(GetSimpleColorInt);
+end;
+function TBGRAMaterial3D.GetSimpleColorInt: TColorInt65536;
+begin
+  result := (GetAmbiantColorInt + GetDiffuseColorInt)*32768;
+end;
+function TBGRAMaterial3D.GetTexture: IBGRAScanner;
+begin
+  result := FTexture;
+end;
+function TBGRAMaterial3D.GetTextureZoom: TPointF;
+begin
+  result := FTextureZoom;
+end;
+procedure TBGRAMaterial3D.SetAutoAmbiantColor(const AValue: boolean);
+begin
+  If AValue then
+    SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
+end;
 procedure TBGRAMaterial3D.SetAutoDiffuseColor(const AValue: boolean);
 begin
+  FAutoDiffuseColor:= AValue;
+  If AValue then
+    SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
 end;
 procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean);
 begin
+  FAutoSpecularColor:= AValue;
+  UpdateSpecular;
+  If AValue then
+    SetSpecularColorInt(ColorInt65536(65536,65536,65536));
+end;
+procedure TBGRAMaterial3D.SetAmbiantAlpha(AValue: byte);
+begin
+  if AValue = 0 then
+    FAmbiantColorInt.a := 0
+  else
+    FAmbiantColorInt.a := AValue*257+1;
+  UpdateSimpleColor;
+end;
+procedure TBGRAMaterial3D.SetAmbiantColor(const AValue: TBGRAPixel);
+begin
+  FAmbiantColorInt := BGRAToColorInt(AValue);
+  FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
+  UpdateSimpleColor;
+end;
+procedure TBGRAMaterial3D.SetAmbiantColorF(const AValue: TColorF);
+begin
+  FAmbiantColorInt := ColorFToColorInt65536(AValue);
+  FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
+  UpdateSimpleColor;
+end;
+procedure TBGRAMaterial3D.SetAmbiantColorInt(const AValue: TColorInt65536);
+begin
+  FAmbiantColorInt := AValue;
+  FAutoAmbiantColor := (FAmbiantColorInt.r = 65536) and (FAmbiantColorInt.g = 65536) and (FAmbiantColorInt.b = 65536) and (FAmbiantColorInt.a = 65536);
+  UpdateSimpleColor;
 end;
 …
   FDiffuseColorInt := BGRAToColorInt(AValue);
   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
+  FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
+  UpdateSimpleColor;
 end;
 …
   FDiffuseColorInt := ColorFToColorInt65536(AValue);
   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
+  FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
+  UpdateSimpleColor;
 end;
 …
   FDiffuseColorInt := AValue;
   FDiffuseLightness := (FDiffuseColorInt.r + FDiffuseColorInt.g + FDiffuseColorInt.b) div 6;
+  FAutoDiffuseColor:= (FDiffuseColorInt.r = 65536) and (FDiffuseColorInt.g = 65536) and (FDiffuseColorInt.b = 65536);
+  UpdateSimpleColor;
 end;
 …
 begin
   FSaturationLowF:= AValue;
+end;
+procedure TBGRAMaterial3D.SetSimpleAlpha(AValue: byte);
+begin
+  SetAmbiantAlpha(AValue);
+  SetDiffuseAlpha(AValue);
+end;
+procedure TBGRAMaterial3D.SetSimpleColor(AValue: TBGRAPixel);
+begin
+  SetAmbiantColor(AValue);
+  SetDiffuseColor(AValue);
+end;
+procedure TBGRAMaterial3D.SetSimpleColorF(AValue: TColorF);
+begin
+  SetAmbiantColorF(AValue);
+  SetDiffuseColorF(AValue);
+end;
+procedure TBGRAMaterial3D.SetSimpleColorInt(AValue: TColorInt65536);
+begin
+  SetAmbiantColorInt(AValue);
+  SetDiffuseColorInt(AValue);
+end;
+procedure TBGRAMaterial3D.SetTexture(AValue: IBGRAScanner);
+begin
+  FTexture := AValue;
+end;
+procedure TBGRAMaterial3D.SetTextureZoom(AValue: TPointF);
+begin
+  FTextureZoom := AValue;
+end;
+function TBGRAMaterial3D.GetName: string;
+begin
+  result := FName;
+end;
+procedure TBGRAMaterial3D.SetName(const AValue: string);
+begin
+  FName := AValue;
 end;
 …
     end
     else
       NH *= FPowerTableSize;
+      PowerTablePos := NH*FPowerTableSize;
     {$ELSE}
     PowerTablePos := NH;
 …
     Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
   else
     Context^.diffuseColor += FDiffuseColorInt*round(DiffuseIntensity*65536);
+    Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
   if FAutoSpecularColor then
     Context^.specularColor += ALightColor*round(SpecularIntensity* NnH*65536)
   else
     Context^.specularColor += FSpecularColorInt*round(SpecularIntensity* NnH*65536);
+    Context^.specularColor += ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536);
 end;
 …
     Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
   else
     Context^.diffuseColor += FDiffuseColorInt*round(DiffuseIntensity*65536);
+    Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
 end;
 …
   begin
     if FDiffuseLightness <> 32768 then
       Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,FDiffuseLightness)
+      Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness))
     else
       Context^.lightness += DiffuseLightnessTerm32768;
+      Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness);
   end;
 end;
 …
 function TBGRADirectionalLight3D.GetDirection: TPoint3D;
 begin
   result := Point3D(FDirection.x,FDirection.y,FDirection.z);
+  result := Point3D(-FDirection.x,-FDirection.y,-FDirection.z);
 end;

GraphicTest/Packages/bgrabitmap/lineartexscan.inc

-              r452
+              r472
+{$i bgrasse.inc}
   var
     xLen: single;       //horizontal length in pixels
 …
   {$ENDIF}
     {$IFDEF CPUI386}
+    {$IFDEF BGRASSE_AVAILABLE}
     if UseSSE then
     begin

GraphicTest/Packages/bgrabitmap/perspectivescan.inc

-              r452
+              r472
+{$i bgrasse.inc}
   var
     //loop variables
 …
   {$ENDIF}
   {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
     if UseSSE then
     begin

GraphicTest/Packages/bgrabitmap/perspectivescan2.inc

-              r452
+              r472
+{$asmmode intel}
+{$i bgrasse.inc}
+{$ifdef BGRASSE_AVAILABLE}{$asmmode intel}{$endif}
     {$IFDEF PARAM_USESSE}
       asm
       {$IFDEF PARAM_USESHADER}
+         mov eax, ShaderContext
+         movaps xmm2, [eax+32] //positionInvZ
+         movaps xmm3, [eax+48] //normalInvZ
+         {$IFDEF cpux86_64}
+          mov rax, ShaderContext
+          movaps xmm2, [rax+32] //positionInvZ
+          movaps xmm3, [rax+48] //normalInvZ
+         {$ELSE}
+          mov eax, ShaderContext
+          movaps xmm2, [eax+32] //positionInvZ
+          movaps xmm3, [eax+48] //normalInvZ
+         {$ENDIF}
       {$ENDIF}
       {$IFNDEF PARAM_USESOLIDCOLOR}
 …
            {$IFDEF PARAM_USESHADER}
+             {$ifdef cpux86_64}
+             mov rax, ShaderContext
+             {$else}
              mov eax, ShaderContext
+             {$endif}
              mulps xmm2, xmm4       //positionInvZ*zPos (A)
              mulps xmm3, xmm4       //normalInvZ*zPos
+             {$ifdef cpux86_64}
+             movaps [rax+0], xmm2   //(A) Position
+             {$else}
              movaps [eax+0], xmm2   //(A) Position
+             {$endif}
              //normalize
 …
              {$ENDIF}
+             xorps xmm7,xmm7
+             comiss xmm3,xmm7
+             jna @skipnormal
              rsqrtps xmm3,xmm3
              mulps xmm3, xmm1  //apply
+             @skipnormal:
+             {$ifdef cpux86_64}
+             movaps [rax+16], xmm3  //Normal
+             {$else}
              movaps [eax+16], xmm3  //Normal
+             {$endif}
            {$ENDIF}
 …
       {$IFDEF PARAM_USESHADER}
         {$IFDEF PARAM_USESSE}
+           {$ifdef cpux86_64}
            asm
              mov eax, ShaderContext
              movaps xmm2, [eax+32] //PositionInvZ
              movaps xmm1, [eax+64] //PositionStepInvZ
              movaps xmm3, [eax+48] //NormalInvZ
              movaps xmm0, [eax+80] //NormalStepInvZ
+             mov rax, ShaderContext
+             movaps xmm2, [rax+32] //PositionInvZ
+             movaps xmm1, [rax+64] //PositionStepInvZ
+             movaps xmm3, [rax+48] //NormalInvZ
+             movaps xmm0, [rax+80] //NormalStepInvZ
              addps xmm2, xmm1
              addps xmm3, xmm0
              movaps [eax+32], xmm2
              movaps [eax+48], xmm3
+             movaps [rax+32], xmm2
+             movaps [rax+48], xmm3
            end;
+{asm
+  mov eax, ShaderContext
+  movaps xmm2, [eax+32] //PositionInvZ
+  movaps xmm1, [eax+64] //PositionStepInvZ
+  addps xmm2, xmm1
+  movaps [eax+32], xmm2
+  movaps xmm3, [eax+48] //NormalInvZ
+  movaps xmm1, [eax+80] //NormalStepInvZ
+  addps xmm3, xmm1
+  movaps [eax+48], xmm3
+end;}
+           {$else}
+            asm
+              mov eax, ShaderContext
+              movaps xmm2, [eax+32] //PositionInvZ
+              movaps xmm1, [eax+64] //PositionStepInvZ
+              movaps xmm3, [eax+48] //NormalInvZ
+              movaps xmm0, [eax+80] //NormalStepInvZ
+              addps xmm2, xmm1
+              addps xmm3, xmm0
+              movaps [eax+32], xmm2
+              movaps [eax+48], xmm3
+            end;
+           {$endif}
         {$ELSE}
           with ShaderContext^ do

GraphicTest/Packages/bgrabitmap/phongdraw.inc

-              r452
+              r472
   x,y : integer;      // Coordinates of point in height map.
   vS1,vS2: TPoint3D_128; // surface vectors (plane)
+  deltaDown: Int32or64;
+  IsLineUp,IsLineDown: boolean;
 begin
+  if map = nil then exit;
   {$ifndef PARAM_SIMPLECOLOR}
     {$ifndef PARAM_SCANNER}
 …
                   LightPosition.Y-ofsY,
                   LightPositionZ);
-  {$ifdef PARAM_PHONGSSE}
-  asm
-    movups xmm1, vLS
-  end;
-  LightDestFactor4 := Point3D_128(LightDestFactor,LightDestFactor,LightDestFactor,LightDestFactor);
-  {$endif}
   //surface vectors
 …
   vV := Point3D_128(0,0,1);
   dist := 0;
   LdotN := 0;
   NnH := 0;
+  {$ifdef PARAM_PHONGSSE}
+  LightDestFactor4 := Point3D_128(LightDestFactor,LightDestFactor,LightDestFactor,LightDestFactor);
+  {$endif}
+  if map.LineOrder = riloTopToBottom then
+    deltaDown := map.Width*sizeof(TBGRAPixel)
+  else
+    deltaDown := -map.Width*sizeof(TBGRAPixel);
   for y := miny to maxy do
   begin
 …
       {$endif}
     {$endif}
+    IsLineUp := y > 0;
+    IsLineDown := y < map.Height-1;
+    mcTop := BGRAPixelTransparent;
+    mcBottom := BGRAPixelTransparent;
     for x := minx to maxx do
     begin
       mcLeft := mc;
       mc := mcRight;
-      inc(pmap);
       if x < map.width-1 then
         mcRight := pmap^ else
+        mcRight := (pmap+1)^ else
         mcRight := BGRAPixelTransparent;
       if mc.alpha = 0 then
 …
         {$endif}
         inc(pdest);
+        inc(pmap);
         continue;
       end;
       //compute surface vectors
+      mcTop := map.GetPixel(x,y-1);
+      mcBottom := map.GetPixel(x,y+1);
+      if IsLineUp then mcTop := pbgrapixel(pbyte(pmap)-deltaDown)^;
+      if IsLineDown then mcBottom := pbgrapixel(pbyte(pmap)+deltaDown)^;
+      inc(pmap);
       z := MapHeight(mc)*mapAltitude;
       if mcLeft.alpha = 0 then
 …
       begin
         {$DEFINE PARAM_USESSE3}
+        asm
+          movups xmm1, vLS
+        end;
         {$i phongdrawsse.inc}
         {$UNDEF PARAM_USESSE3}
       end else
       begin
+        asm
+          movups xmm1, vLS
+        end;
         {$i phongdrawsse.inc}
       end;
 …
         NH := DotProduct3D_128(vH,vN);
-        if NH <= 0 then
-          NnH := 0
-        else
-          NnH := exp(SpecularIndex*ln(NH));
       {$endif}
 …
         NnH := 0
       else
         NnH := exp(SpecularIndex*ln(NH));
+        NnH := exp(SpecularIndex*ln(NH));  //to be optimized
       distfactor := LightSourceIntensity / (dist*LightSourceDistanceFactor + LightSourceDistanceTerm);

GraphicTest/Packages/bgrabitmap/phongdrawsse.inc

-              r452
+              r472
         //vL := vLS- vP*LightDestFactor;
         movups xmm4, vP
         movss xmm6,LightDestFactor4
         mulps xmm6, xmm4
+        movups xmm6,LightDestFactor4
+        mulps xmm6, xmm4   //keep xmm4 = vP
         movaps xmm0, xmm1
         subps xmm0, xmm6

GraphicTest/Packages/bgrabitmap/phonglight.inc

-              r452
+              r472
+{$i bgrasse.inc}
 var
   dist2,LdotN,NdotH,lightEnergy,diffuse : single;
+  {%H-}dist2,LdotN,NdotH,lightEnergy,diffuse : single;
 const
   minus_05 = -0.5;
 begin
   {$IFDEF CPUI386}If UseSSE then
+  {$IFDEF BGRASSE_AVAILABLE}If UseSSE then
   begin
     with Context^ do

GraphicTest/Packages/bgrabitmap/phonglightsse.inc

-              r452
+              r472
     {$asmmode intel}
     asm
+      {$ifdef cpux86_64}
+      mov rax, Context
+      movaps xmm0,[rax+160] //Context^.vL
+      movaps xmm2,[rax+192] //Context^.vH
+      movaps xmm1,[rax+16] //Context^.Normal
+      {$else}
       mov eax, Context
       movaps xmm0,[eax+160] //Context^.vL
       movaps xmm2,[eax+192] //Context^.vH
       movaps xmm1,[eax+16] //Context^.Normal
+      {$endif}
       {$IFDEF PARAM_POINTLIGHT}
+        {$ifdef cpux86_64}
+        movaps xmm6,[rax+0]  //Context^.Position
+        {$else}
         movaps xmm6,[eax+0]  //Context^.Position
+        {$endif}
         subps xmm0,xmm6      //xmm0 = vL
         movaps xmm6, xmm0

GraphicTest/Packages/bgrabitmap/polyaliaspersp.inc

-              r452
+              r472
 { TPolygonPerspectiveTextureMappingInfo }
+procedure TPolygonPerspectiveTextureMappingInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var info: PPerspectiveTextureInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PPerspectiveTextureInfo(AData);
+  TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
+  TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
+  if FLightnesses<>nil then
+    TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
+  else
+    TPerspectiveTextureMappingIntersectionInfo(AInter).lightness := 32768;
+end;
 constructor TPolygonPerspectiveTextureMappingInfo.Create(
 …
 begin
   Result:= TPerspectiveTextureMappingIntersectionInfo.Create;
-end;
-procedure TPolygonPerspectiveTextureMappingInfo.ComputeIntersection(cury: single;
-      var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
-var
-  j: integer;
-  dy: single;
-  info: PPerspectiveTextureInfo;
-begin
-  if length(FSlices)=0 then exit;
-  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
-  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
-  with FSlices[FCurSlice] do
-  if (cury >= y1) and (cury <= y2) then
-  begin
-    for j := 0 to nbSegments-1 do
-    begin
-      dy := cury - segments[j].y1;
-      inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
-      inter[nbinter].winding := segments[j].winding;
-      info := PPerspectiveTextureInfo(segments[j].data);
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
-      if FLightnesses<>nil then
-        TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).lightness := round(info^.lightness + info^.lightnessSlope*dy)
-      else
-        TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).lightness := 32768;
-      Inc(nbinter);
-    end;
-  end;
 end;
 …
 { TPolygonPerspectiveMappingShaderInfo }
+procedure TPolygonPerspectiveMappingShaderInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var info : PPerspectiveTextureInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PPerspectiveTextureInfo(AData);
+  TPerspectiveTextureMappingIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
+  TPerspectiveTextureMappingIntersectionInfo(AInter).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
+  TPerspectiveTextureMappingIntersectionInfo(AInter).Position3D := info^.Position3D + info^.Position3DSlope*dy;
+  TPerspectiveTextureMappingIntersectionInfo(AInter).Normal3D := info^.Normal3D + info^.Normal3DSlope*dy;
+end;
 constructor TPolygonPerspectiveMappingShaderInfo.Create(
   const points: array of TPointF; const points3D: array of TPoint3D;
 …
 end;
-procedure TPolygonPerspectiveMappingShaderInfo.ComputeIntersection(
-  cury: single; var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
-var
-  j: integer;
-  dy: single;
-  info: PPerspectiveTextureInfo;
-begin
-  if length(FSlices)=0 then exit;
-  while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
-  while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
-  with FSlices[FCurSlice] do
-  if (cury >= y1) and (cury <= y2) then
-  begin
-    for j := 0 to nbSegments-1 do
-    begin
-      dy := cury - segments[j].y1;
-      inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
-      inter[nbinter].winding := segments[j].winding;
-      info := PPerspectiveTextureInfo(segments[j].data);
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).texCoordDivByZ := info^.TexCoordDivByZ + info^.TexCoordDivByZSlopes*dy;
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).Position3D := info^.Position3D + info^.Position3DSlope*dy;
-      TPerspectiveTextureMappingIntersectionInfo(inter[nbinter]).Normal3D := info^.Normal3D + info^.Normal3DSlope*dy;
-      Inc(nbinter);
-    end;
-  end;
-end;

GraphicTest/Packages/bgrabitmap/readme.txt

r452	r472
1		BGRABitmap ~~v6.2~~ - Drawing routines with alpha blending and antialiasing with Lazarus.
	1	BGRABitmap - Drawing routines with alpha blending and antialiasing with Lazarus.
2	2
3	3	These routines allow to manipulate 32bit images in BGRA format.

GraphicTest/Packages/bgrabitmap/renderdensity256.inc

-              r452
+              r472
           for xb := densMinX to densMaxX do
           begin
             j := pdens^;
+            tempDensity := pdens^;
             Inc(pdens);
             c := pscan^;
             inc(pscan);
+            if j <> 0 then
+              DrawPixelInlineWithAlphaCheck(pdest, BGRA(c.red, c.green, c.blue,
+            if tempDensity <> 0 then
+              {$ifdef PARAM_LINEARANTIALIASING}
+              FastBlendPixelInline
+              {$else}
+              DrawPixelInlineWithAlphaCheck{$endif}(pdest, BGRA(c.red, c.green, c.blue,
               {$ifdef PARAM_ANTIALIASINGFACTOR}DivByAntialiasPrecision256{$endif}
               (c.alpha * j
+              (c.alpha * tempDensity
               {$ifdef PARAM_ANTIALIASINGFACTOR} ) {$else} +128) shr 8 {$endif}
               ));
 …
           for xb := densMinX to densMaxX do
           begin
             j := pdens^;
+            tempDensity := pdens^;
             Inc(pdens);
             c := ScanNextPixelProc();
+            if j <> 0 then
+              DrawPixelInlineWithAlphaCheck(pdest, BGRA(c.red, c.green, c.blue,
+            if tempDensity <> 0 then
+              {$ifdef PARAM_LINEARANTIALIASING}
+              FastBlendPixelInline
+              {$else}
+              DrawPixelInlineWithAlphaCheck{$endif}(pdest, BGRA(c.red, c.green, c.blue,
               {$ifdef PARAM_ANTIALIASINGFACTOR}DivByAntialiasPrecision256{$endif}
               (c.alpha * j
+              (c.alpha * tempDensity
               {$ifdef PARAM_ANTIALIASINGFACTOR} ) {$else} +128) shr 8 {$endif}
               ));
 …
         for xb := densMinX to densMaxX do
         begin
           j := pdens^;
+          tempDensity := pdens^;
           Inc(pdens);
           if j <> 0 then
+          if tempDensity <> 0 then
             ErasePixelInline(pdest,
             {$ifdef PARAM_ANTIALIASINGFACTOR}DivByAntialiasPrecision256{$endif}
             (c.alpha * j
+            (c.alpha * tempDensity
             {$ifdef PARAM_ANTIALIASINGFACTOR} ) {$else} +128) shr 8 {$endif}
             );
 …
         for xb := densMinX to densMaxX do
         begin
           j := pdens^;
+          tempDensity := pdens^;
           Inc(pdens);
           if j <> 0 then
+          if tempDensity <> 0 then
           begin
             c2.alpha :=
               {$ifdef PARAM_ANTIALIASINGFACTOR}DivByAntialiasPrecision256{$endif}
               (c.alpha * j
+              (c.alpha * tempDensity
               {$ifdef PARAM_ANTIALIASINGFACTOR} ) {$else} +128) shr 8 {$endif}
+              ;
+            {$ifdef PARAM_LINEARANTIALIASING}
+            FastBlendPixelInline(pdest, c2);
+            {$else}
             DrawPixelInlineExpandedOrNotWithAlphaCheck(pdest, ec, c2);
+            {$endif}
           end;
           Inc(pdest);
 …
   end
 {$undef PARAM_ANTIALIASINGFACTOR}
+{$undef PARAM_LINEARANTIALIASING}

GraphicTest/UDrawForm.lfm

-              r444
+              r472
   Top = 208
   Width = 327
-  BorderStyle = bsDialog
   Caption = 'Draw frame'
   FormStyle = fsStayOnTop
   OnCreate = FormCreate
   LCLVersion = '1.1'
+  LCLVersion = '1.5'
 end

GraphicTest/UDrawForm.pas

-              r445
+              r472
     procedure FormCreate(Sender: TObject);
   private
+    { private declarations }
   public
+    FrameSize: TPoint;
     EraseBackgroundEnabled: Boolean;
     procedure EraseBackground(DC: HDC); override;

GraphicTest/UDrawMethod.pas

-              r471
+              r472
     FControl: TControl;
     FFPS: Real;
+    FParent: TWinControl;
   public
     Caption: string;
 …
     procedure DrawFrame(FastBitmap: TFastBitmap); virtual;
     procedure DrawFrameTiming(FastBitmap: TFastBitmap);
+    procedure UpdateSettings; virtual;
     property Control: TControl read FControl;
   end;
 …
   TDrawMethodImage = class(TDrawMethod)
     Image: TImage;
+    procedure UpdateSettings; override;
     procedure Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat); override;
     procedure Done; override;
 …
     PaintBox: TPaintBox;
     procedure Paint(Sender: TObject); virtual;
+    procedure UpdateSettings; override;
     procedure Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat); override;
     procedure Done; override;
 …
     TextureId: GLuint;
     OpenGLBitmap: Pointer;
+    procedure UpdateSettings; override;
     procedure InitGL;
     procedure OpenGLControlResize(Sender: TObject);
 …
 begin
+end;
+procedure TDrawMethodPaintBox.UpdateSettings;
+begin
+  inherited UpdateSettings;
+  PaintBox.ControlStyle := FParent.ControlStyle;
 end;
 …
   PaintBox.OnPaint := Paint;
   PaintBox.Show;
+  UpdateSettings;
 end;
 …
 { TDrawMethodImage }
+procedure TDrawMethodImage.UpdateSettings;
+begin
+  inherited;
+  Image.ControlStyle := FParent.ControlStyle;
+end;
 procedure TDrawMethodImage.Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat);
 …
   Image.Picture.Bitmap.SetSize(Size.X, Size.Y);
   Image.Show;
+  UpdateSettings;
 end;
 …
   end;
   GetMem(OpenGLBitmap, OpenGLControl.Width * OpenGLControl.Height * SizeOf(Integer));
+  UpdateSettings;
 end;
 …
 begin
   glViewport(0, 0, OpenGLControl.Width, OpenGLControl.Height);
+end;
+procedure TDrawMethodOpenGL.UpdateSettings;
+begin
+  inherited UpdateSettings;
+  OpenGLControl.ControlStyle := FParent.ControlStyle;
 end;
 …
 procedure TDrawMethod.Init(Parent: TWinControl; Size: TPoint; PixelFormat: TPixelFormat);
 begin
+  FParent := Parent;
 end;
 …
 end;
+procedure TDrawMethod.UpdateSettings;
+begin
+end;
 end.

GraphicTest/UMainForm.lfm

-              r470
+              r472
       TabOrder = 8
     end
     object CheckBox1: TCheckBox
+    object CheckBoxOpaque: TCheckBox
       Left = 400
       Height = 27
 …
       Anchors = [akLeft, akBottom]
       Caption = 'Opaque'
       OnChange = CheckBox1Change
+      OnChange = CheckBoxOpaqueChange
       TabOrder = 9
     end
 …
       ParentColor = False
     end
     object ComboBox1: TComboBox
+    object ComboBoxPixelFormat: TComboBox
       Left = 136
       Height = 37
 …
       Anchors = [akLeft, akBottom]
       ItemHeight = 0
       OnChange = ComboBox1Change
+      OnChange = ComboBoxPixelFormatChange
       Style = csDropDownList
       TabOrder = 10
 …
     end
   end
+  object TimerUpdateSettings: TTimer
+    OnTimer = TimerUpdateSettingsTimer
+    left = 272
+    top = 264
+  end
 end

GraphicTest/UMainForm.pas

-              r471
+              r472
     ButtonSingleTest: TButton;
     ButtonStop: TButton;
     CheckBox1: TCheckBox;
+    CheckBoxOpaque: TCheckBox;
     CheckBoxDoubleBuffered: TCheckBox;
     CheckBoxEraseBackground: TCheckBox;
     ComboBox1: TComboBox;
+    ComboBoxPixelFormat: TComboBox;
     FileExit1: TFileExit;
     FloatSpinEdit1: TFloatSpinEdit;
 …
     TabSheet1: TTabSheet;
     TabSheet2: TTabSheet;
+    TimerUpdateSettings: TTimer;
     TimerUpdateList: TTimer;
     procedure AExportAsWikiTextExecute(Sender: TObject);
 …
     procedure ATestOneMethodExecute(Sender: TObject);
     procedure ATestStopExecute(Sender: TObject);
     procedure CheckBox1Change(Sender: TObject);
+    procedure CheckBoxOpaqueChange(Sender: TObject);
     procedure CheckBoxDoubleBufferedChange(Sender: TObject);
     procedure CheckBoxEraseBackgroundChange(Sender: TObject);
     procedure ComboBox1Change(Sender: TObject);
+    procedure ComboBoxPixelFormatChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
 …
     procedure SpinEditWidthChange(Sender: TObject);
     procedure TimerUpdateListTimer(Sender: TObject);
+    procedure TimerUpdateSettingsTimer(Sender: TObject);
   private
+    FCurrentMethod: TDrawMethod;
     MethodIndex: Integer;
     SingleTestActive: Boolean;
 …
     procedure UpdateMethodList;
     procedure UpdateInterface;
-    procedure UpdateFrameSize;
     procedure RegisterDrawMethods;
     procedure RegisterDrawMethod(MethodClass: TDrawMethodClass);
 …
     Scenes: TObjectList; // TObjectList<TFastBitmap>
     SceneIndex: Integer;
+    property CurrentMethod: TDrawMethod read FCurrentMethod;
   end;
 …
   for PF := Low(TPixelFormat) to High(TPixelFormat) do
     ComboBox1.Items.Add(GetEnumName(TypeInfo(TPixelFormat), Integer(PF)));
+    ComboBoxPixelFormat.Items.Add(GetEnumName(TypeInfo(TPixelFormat), Integer(PF)));
   PageControl1.TabIndex := 0;
 …
   StartTime: TDateTime;
 begin
+  FCurrentMethod := Method;
   with Method do begin
     Init(DrawForm, FrameSize, PixelFormat);
 …
     Done;
   end;
+  FCurrentMethod := nil;
 end;
 …
 end;
 procedure TMainForm.CheckBox1Change(Sender: TObject);
 begin
   if CheckBox1.Checked then
+procedure TMainForm.CheckBoxOpaqueChange(Sender: TObject);
+begin
+  if CheckBoxOpaque.Checked then
     DrawForm.ControlStyle := DrawForm.ControlStyle + [csOpaque]
     else DrawForm.ControlStyle := DrawForm.ControlStyle - [csOpaque];
+  if Assigned(FCurrentMethod) then
+    FCurrentMethod.UpdateSettings;
 end;
 …
 end;
 procedure TMainForm.ComboBox1Change(Sender: TObject);
 begin
   PixelFormat := TPixelFormat(ComboBox1.ItemIndex);
+procedure TMainForm.ComboBoxPixelFormatChange(Sender: TObject);
+begin
+  PixelFormat := TPixelFormat(ComboBoxPixelFormat.ItemIndex);
   UpdateInterface;
 end;
 …
 procedure TMainForm.FormShow(Sender: TObject);
 begin
-  UpdateFrameSize;
   UpdateMethodList;
   UpdateInterface;
   DrawForm.Show;
+  DrawForm.Left := Left + Width;
+  DrawForm.Top := Top;
 end;
 …
 begin
   FrameSize.Y := SpinEditHeight.Value;
-  UpdateFrameSize;
 end;
 …
 begin
   FrameSize.X := SpinEditWidth.Value;
-  UpdateFrameSize;
 end;
 …
 begin
   UpdateMethodList;
+end;
+procedure TMainForm.TimerUpdateSettingsTimer(Sender: TObject);
+begin
+  if (FrameSize.X <> DrawForm.FrameSize.X) or
+    (FrameSize.Y <> DrawForm.FrameSize.Y) then begin
+      DrawForm.FrameSize := FrameSize;
+      DrawForm.ClientWidth := FrameSize.X;
+      DrawForm.ClientHeight := FrameSize.Y;
+      GenerateSceneFrames;
+    end;
 end;
 …
   CheckBoxDoubleBuffered.Checked := DrawForm.DoubleBuffered;
   CheckBoxEraseBackground.Checked := DrawForm.EraseBackgroundEnabled;
+  CheckBox1.Checked := csOpaque in DrawForm.ControlStyle;
+  ComboBox1.ItemIndex := Integer(PixelFormat);
+end;
+procedure TMainForm.UpdateFrameSize;
+begin
+  DrawForm.ClientWidth := FrameSize.X;
+  DrawForm.ClientHeight := FrameSize.Y;
+  GenerateSceneFrames;
+  CheckBoxOpaque.Checked := csOpaque in DrawForm.ControlStyle;
+  ComboBoxPixelFormat.ItemIndex := Integer(PixelFormat);
 end;

Context Navigation

Legend:

Download in other formats: