Changeset 494

GraphicTest/GraphicTest.lpi

-              r472
+              r494
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UMainForm"/>
       </Unit1>
       <Unit2>
         <Filename Value="UPlatform.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UPlatform"/>
       </Unit2>
       <Unit3>
         <Filename Value="UDrawMethod.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UDrawMethod"/>
       </Unit3>
       <Unit4>
         <Filename Value="UFastBitmap.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UFastBitmap"/>
       </Unit4>
       <Unit5>
 …
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UDrawForm"/>
       </Unit5>
       <Unit6>
         <Filename Value="Methods/UCanvasPixels.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UCanvasPixels"/>
       </Unit6>
       <Unit7>
 …
         <Filename Value="Methods/ULazIntfImageColorsCopy.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="ULazIntfImageColorsCopy"/>
       </Unit8>
       <Unit9>
 …
         <Filename Value="Methods/UBGRABitmapPaintBox.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UBGRABitmapPaintBox"/>
       </Unit10>
       <Unit11>
         <Filename Value="Methods/UBitmapRawImageDataPaintBox.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UBitmapRawImageDataPaintBox"/>
       </Unit11>
       <Unit12>
 …
         <Filename Value="Methods/UOpenGLMethod.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UOpenGLMethod"/>
       </Unit15>
       <Unit16>
         <Filename Value="Methods/UOpenGLPBOMethod.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UOpenGLPBOMethod"/>
       </Unit16>
       <Unit17>
         <Filename Value="Methods/UGraphics32Method.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UGraphics32Method"/>
       </Unit17>
     </Units>

GraphicTest/GraphicTest.lpr

r471	r494
8	8	{$ENDIF}{$ENDIF}
9	9	Interfaces, // this includes the LCL widgetset
10		Forms, ~~laz~~openglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
	10	Forms, openglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
11	11	UDrawForm, bgrabitmappack,
12	12	{$IFDEF GRAPHICS32}GR32_L,{$ENDIF}

GraphicTest/Packages/bgrabitmap/bgraanimatedgif.pas

-              r472
+              r494
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 interface
 uses
+  Classes, SysUtils, Graphics, FPImage, BGRABitmap, BGRABitmapTypes;
+  Classes, SysUtils, BGRAGraphics, FPImage, BGRABitmap, BGRABitmapTypes,
+  BGRAPalette, BGRAGifFormat;
 type
+  TDisposeMode = (dmNone, dmKeep, dmErase, dmRestore);
+  TGifSubImage = record
+    Image:    TBGRABitmap;
+    Position: TPoint;
+    Delay:    integer;
+    disposeMode: TDisposeMode;
+    TransparentColor: TBGRAPixel;
+  end;
+  TGifSubImageArray = array of TGifSubImage;
+  TDisposeMode = BGRAGifFormat.TDisposeMode;
+  TGifSubImage = BGRAGifFormat.TGifSubImage;
+  TGifSubImageArray = BGRAGifFormat.TGifSubImageArray;
+  //how to deal with the background under the GIF animation
   TGifBackgroundMode = (gbmSimplePaint, gbmEraseBackground,
     gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously);
 …
   TBGRAAnimatedGif = class(TGraphic)
   private
+    FAspectRatio: single;
     FWidth, FHeight:  integer;
     FBackgroundColor: TColor;
 …
     FTimeAccumulator: double;
     FCurrentImage, FWantedImage: integer;
     FFullAnimationTime: double;
+    FTotalAnimationTime: int64;
     FPreviousDisposeMode: TDisposeMode;
 …
     FImageChanged: boolean;
+    procedure CheckFrameIndex(AIndex: integer);
     function GetCount: integer;
+    function GetFrameDelayMs(AIndex: integer): integer;
+    function GetFrameDisposeMode(AIndex: integer): TDisposeMode;
+    function GetFrameHasLocalPalette(AIndex: integer): boolean;
+    function GetFrameImage(AIndex: integer): TBGRABitmap;
+    function GetFrameImagePos(AIndex: integer): TPoint;
     function GetTimeUntilNextImage: integer;
     procedure Render(StretchWidth, StretchHeight: integer);
+    procedure SetAspectRatio(AValue: single);
+    procedure SetBackgroundColor(AValue: TColor);
+    procedure SetFrameDelayMs(AIndex: integer; AValue: integer);
+    procedure SetFrameDisposeMode(AIndex: integer; AValue: TDisposeMode);
+    procedure SetFrameHasLocalPalette(AIndex: integer; AValue: boolean);
+    procedure SetFrameImage(AIndex: integer; AValue: TBGRABitmap);
+    procedure SetFrameImagePos(AIndex: integer; AValue: TPoint);
     procedure UpdateSimple(Canvas: TCanvas; ARect: TRect;
       DrawOnlyIfChanged: boolean = True);
 …
   protected
     FImages: TGifSubImageArray;
-    procedure LoadImages(stream: TStream);
     {TGraphic}
 …
     function GetTransparent: boolean; override;
     function GetWidth: integer; override;
+    procedure SetHeight(Value: integer); override;
+    procedure SetTransparent(Value: boolean); override;
+    procedure SetWidth(Value: integer); override;
+    procedure SetHeight({%H-}Value: integer); override;
+    procedure SetTransparent({%H-}Value: boolean); override;
+    procedure SetWidth({%H-}Value: integer); override;
+    procedure ClearViewer; virtual;
   public
 …
     constructor Create; override;
     function Duplicate: TBGRAAnimatedGif;
+    function AddFrame(AImage: TFPCustomImage; X,Y: integer; ADelayMs: integer;
+      ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false) : integer;
+    procedure InsertFrame(AIndex: integer; AImage: TBGRABitmap; X,Y: integer; ADelayMs: integer;
+      ADisposeMode: TDisposeMode = dmErase; AHasLocalPalette: boolean = false);
     {TGraphic}
 …
     class function GetFileExtensions: string; override;
+    procedure SetSize(AWidth,AHeight: integer); virtual;
+    procedure SaveToStream(Stream: TStream; AQuantizer: TBGRAColorQuantizerAny;
+      ADitheringAlgorithm: TDitheringAlgorithm); virtual; overload;
     procedure Clear; override;
     destructor Destroy; override;
 …
     procedure Hide(Canvas: TCanvas; ARect: TRect); overload;
     property BackgroundColor: TColor Read FBackgroundColor;
+    property BackgroundColor: TColor Read FBackgroundColor write SetBackgroundColor;
     property Count: integer Read GetCount;
     property Width: integer Read FWidth;
 …
     property CurrentImage: integer Read FCurrentImage Write SetCurrentImage;
     property TimeUntilNextImageMs: integer read GetTimeUntilNextImage;
+  end;
+  { TFPReaderGIF }
+  TFPReaderGIF = class(TFPCustomImageReader)
+    property FrameImage[AIndex: integer]: TBGRABitmap read GetFrameImage write SetFrameImage;
+    property FrameHasLocalPalette[AIndex: integer]: boolean read GetFrameHasLocalPalette write SetFrameHasLocalPalette;
+    property FrameImagePos[AIndex: integer]: TPoint read GetFrameImagePos write SetFrameImagePos;
+    property FrameDelayMs[AIndex: integer]: integer read GetFrameDelayMs write SetFrameDelayMs;
+    property FrameDisposeMode[AIndex: integer]: TDisposeMode read GetFrameDisposeMode write SetFrameDisposeMode;
+    property AspectRatio: single read FAspectRatio write SetAspectRatio;
+    property TotalAnimationTimeMs: Int64 read FTotalAnimationTime;
+  end;
+  { TBGRAReaderGIF }
+  TBGRAReaderGIF = class(TFPCustomImageReader)
   protected
     procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
     function InternalCheck(Str: TStream): boolean; override;
+  end;
+  { TBGRAWriterGIF }
+  TBGRAWriterGIF = class(TFPCustomImageWriter)
+  protected
+    procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
   end;
 …
 implementation
 uses BGRABlend, lazutf8classes;
+uses BGRABlend, BGRAUTF8{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF};
 const
 …
   {$ENDIF}
-type
-  TGIFSignature = packed array[1..6] of char;
-  TGIFScreenDescriptor = packed record
-    Width, Height: word;
-    flags, background, map: byte;
-  end;
-  TGIFImageDescriptor = packed record
-    x, y, Width, Height: word;
-    flags: byte;
-  end;
-  TGIFExtensionBlock = packed record
-    functioncode: byte;
-  end;
-  TGIFGraphicControlExtension = packed record
-    flags:      byte;
-    delaytime:  word;
-    transcolor: byte;
-  end;
 { TBGRAAnimatedGif }
 …
 begin
   Result := 'gif';
+end;
+procedure TBGRAAnimatedGif.SetSize(AWidth, AHeight: integer);
+begin
+  ClearViewer;
+  FWidth := AWidth;
+  FHeight := AHeight;
+end;
+procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream;
+      AQuantizer: TBGRAColorQuantizerAny;
+      ADitheringAlgorithm: TDitheringAlgorithm);
+var data: TGIFData;
+begin
+  data.Height:= Height;
+  data.Width := Width;
+  data.AspectRatio := 1;
+  data.BackgroundColor := BackgroundColor;
+  data.Images := FImages;
+  GIFSaveToStream(data, Stream, AQuantizer, ADitheringAlgorithm);
 end;
 …
   begin
     FInternalVirtualScreen := TBGRABitmap.Create(FWidth, FHeight);
     if Count = 0 then
+    if (Count = 0) and (BackgroundColor <> clNone) then
       FInternalVirtualScreen.Fill(BackgroundColor)
     else
 …
     if not FPaused then
       FTimeAccumulator += (curDate - FPrevDate) * 24 * 60 * 60 * 1000;
     if FFullAnimationTime > 0 then FTimeAccumulator:= frac(FTimeAccumulator/FFullAnimationTime)*FFullAnimationTime;
+    if FTotalAnimationTime > 0 then FTimeAccumulator:= frac(FTimeAccumulator/FTotalAnimationTime)*FTotalAnimationTime;
     nextImage := FCurrentImage;
     while FTimeAccumulator > FImages[nextImage].Delay do
     begin
       FTimeAccumulator -= FImages[nextImage].Delay;
+    while FTimeAccumulator > FImages[nextImage].DelayMs do
+    begin
+      FTimeAccumulator -= FImages[nextImage].DelayMs;
       Inc(nextImage);
       if nextImage >= Count then
 …
         FInternalVirtualScreen.PutImage(Position.X, Position.Y, Image,
           dmSetExceptTransparent);
       FPreviousDisposeMode := disposeMode;
+      FPreviousDisposeMode := DisposeMode;
     end;
 …
 end;
+procedure TBGRAAnimatedGif.SetAspectRatio(AValue: single);
+begin
+  if AValue < 0.25 then AValue := 0.25;
+  if AValue > 4 then AValue := 4;
+  if FAspectRatio=AValue then Exit;
+  FAspectRatio:=AValue;
+end;
+procedure TBGRAAnimatedGif.SetBackgroundColor(AValue: TColor);
+begin
+  if FBackgroundColor=AValue then Exit;
+  FBackgroundColor:=AValue;
+end;
+procedure TBGRAAnimatedGif.SetFrameDelayMs(AIndex: integer; AValue: integer);
+begin
+  CheckFrameIndex(AIndex);
+  if AValue < 0 then AValue := 0;
+  FTotalAnimationTime := FTotalAnimationTime + AValue - FImages[AIndex].DelayMs;
+  FImages[AIndex].DelayMs := AValue;
+end;
+procedure TBGRAAnimatedGif.SetFrameDisposeMode(AIndex: integer;
+  AValue: TDisposeMode);
+begin
+  CheckFrameIndex(AIndex);
+  FImages[AIndex].DisposeMode := AValue;
+end;
+procedure TBGRAAnimatedGif.SetFrameHasLocalPalette(AIndex: integer;
+  AValue: boolean);
+begin
+  CheckFrameIndex(AIndex);
+  FImages[AIndex].HasLocalPalette := AValue;
+end;
+procedure TBGRAAnimatedGif.SetFrameImage(AIndex: integer; AValue: TBGRABitmap);
+var ACopy: TBGRABitmap;
+begin
+  CheckFrameIndex(AIndex);
+  ACopy := AValue.Duplicate as TBGRABitmap;
+  FImages[AIndex].Image.FreeReference;
+  FImages[AIndex].Image := ACopy;
+end;
+procedure TBGRAAnimatedGif.SetFrameImagePos(AIndex: integer; AValue: TPoint);
+begin
+  CheckFrameIndex(AIndex);
+  FImages[AIndex].Position := AValue;
+end;
 procedure TBGRAAnimatedGif.UpdateSimple(Canvas: TCanvas; ARect: TRect;
   DrawOnlyIfChanged: boolean = True);
 …
 end;
+procedure TBGRAAnimatedGif.CheckFrameIndex(AIndex: integer);
+begin
+  if (AIndex < 0) or (AIndex >= Count) then Raise ERangeError.Create('Index out of bounds');
+end;
 function TBGRAAnimatedGif.GetCount: integer;
 begin
   Result := length(FImages);
+end;
+function TBGRAAnimatedGif.GetFrameDelayMs(AIndex: integer): integer;
+begin
+  CheckFrameIndex(AIndex);
+  result := FImages[AIndex].DelayMs;
+end;
+function TBGRAAnimatedGif.GetFrameDisposeMode(AIndex: integer): TDisposeMode;
+begin
+  CheckFrameIndex(AIndex);
+  result := FImages[AIndex].DisposeMode;
+end;
+function TBGRAAnimatedGif.GetFrameHasLocalPalette(AIndex: integer): boolean;
+begin
+  CheckFrameIndex(AIndex);
+  result := FImages[AIndex].HasLocalPalette;
+end;
+function TBGRAAnimatedGif.GetFrameImage(AIndex: integer): TBGRABitmap;
+begin
+  CheckFrameIndex(AIndex);
+  result := FImages[AIndex].Image;
+end;
+function TBGRAAnimatedGif.GetFrameImagePos(AIndex: integer): TPoint;
+begin
+  CheckFrameIndex(AIndex);
+  result := FImages[AIndex].Position;
 end;
 …
     acc := FTimeAccumulator;
     if not FPaused then acc += (Now- FPrevDate) * 24 * 60 * 60 * 1000;
     if acc >= FImages[FCurrentImage].Delay then
+    if acc >= FImages[FCurrentImage].DelayMs then
       result := 0
     else
       result := round(FImages[FCurrentImage].Delay-FTimeAccumulator);
+      result := round(FImages[FCurrentImage].DelayMs-FTimeAccumulator);
   end;
 end;
 constructor TBGRAAnimatedGif.Create(filenameUTF8: string);
-var
-  Stream: TFileStreamUTF8;
 begin
   inherited Create;
   Init;
+  Stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead or fmShareDenyWrite);
+  LoadFromStream(Stream);
+  Stream.Free;
+  LoadFromFile(filenameUTF8);
 end;
 …
 end;
+function TBGRAAnimatedGif.AddFrame(AImage: TFPCustomImage; X, Y: integer;
+  ADelayMs: integer; ADisposeMode: TDisposeMode; AHasLocalPalette: boolean
+  ): integer;
+begin
+  result := length(FImages);
+  setlength(FImages, length(FImages)+1);
+  if ADelayMs < 0 then ADelayMs:= 0;
+  with FImages[result] do
+  begin
+    Image := TBGRABitmap.Create(AImage);
+    Position := Point(x,y);
+    DelayMs := ADelayMs;
+    HasLocalPalette := AHasLocalPalette;
+    DisposeMode := ADisposeMode;
+  end;
+  inc(FTotalAnimationTime, ADelayMs);
+end;
+procedure TBGRAAnimatedGif.InsertFrame(AIndex: integer; AImage: TBGRABitmap; X,
+  Y: integer; ADelayMs: integer; ADisposeMode: TDisposeMode;
+  AHasLocalPalette: boolean);
+var i: integer;
+begin
+  if (AIndex < 0) or (AIndex > Count) then
+    raise ERangeError.Create('Index out of bounds');
+  setlength(FImages, length(FImages)+1);
+  if ADelayMs < 0 then ADelayMs:= 0;
+  for i := high(FImages) downto AIndex+1 do
+    FImages[i] := FImages[i-1];
+  with FImages[AIndex] do
+  begin
+    Image := AImage.Duplicate as TBGRABitmap;
+    Position := Point(x,y);
+    DelayMs := ADelayMs;
+    HasLocalPalette := AHasLocalPalette;
+    DisposeMode := ADisposeMode;
+  end;
+  inc(FTotalAnimationTime, ADelayMs);
+end;
 procedure TBGRAAnimatedGif.LoadFromStream(Stream: TStream);
+var data: TGIFData;
+  i: integer;
+begin
+  data := GIFLoadFromStream(Stream);
+  ClearViewer;
+  Clear;
+  FWidth  := data.Width;
+  FHeight := data.Height;
+  FBackgroundColor := data.BackgroundColor;
+  FAspectRatio:= data.AspectRatio;
+  SetLength(FImages, length(data.Images));
+  FTotalAnimationTime:= 0;
+  for i := 0 to high(FImages) do
+  begin
+    FImages[i] := data.Images[i];
+    FTotalAnimationTime += FImages[i].DelayMs;
+  end;
+end;
+procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream);
+begin
+  SaveToStream(Stream, BGRAColorQuantizerFactory, daFloydSteinberg);
+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;
+procedure TBGRAAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect);
+begin
+  if FBackgroundImage <> nil then
+    FreeAndNil(FBackgroundImage);
+  SaveBackgroundOnce(ACanvas, Rect);
+  if FPreviousVirtualScreen <> nil then
+  begin
+    FPreviousVirtualScreen.FreeReference;
+    FPreviousVirtualScreen := nil;
+  end;
+  Render(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
+  FStretchedVirtualScreen.Draw(ACanvas, Rect.Left, Rect.Top, false);
+  FImageChanged := False;
+  FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.Duplicate);
+end;
+function TBGRAAnimatedGif.GetEmpty: boolean;
+begin
+  Result := (length(FImages) = 0);
+end;
+function TBGRAAnimatedGif.GetHeight: integer;
+begin
+  Result := FHeight;
+end;
+function TBGRAAnimatedGif.GetTransparent: boolean;
+begin
+  Result := True;
+end;
+function TBGRAAnimatedGif.GetWidth: integer;
+begin
+  Result := FWidth;
+end;
+procedure TBGRAAnimatedGif.SetHeight(Value: integer);
+begin
+  //not implemented
+end;
+procedure TBGRAAnimatedGif.SetTransparent(Value: boolean);
+begin
+  //not implemented
+end;
+procedure TBGRAAnimatedGif.SetWidth(Value: integer);
+begin
+  //not implemented
+end;
+procedure TBGRAAnimatedGif.ClearViewer;
 begin
   FCurrentImage    := -1;
 …
   FPreviousVirtualScreen := nil;
-  EraseColor := clBlack;
   FPreviousDisposeMode := dmNone;
-  FWidth  := 0;
-  FHeight := 0;
-  if Stream <> nil then
-    LoadImages(Stream);
-end;
-procedure TBGRAAnimatedGif.SaveToStream(Stream: TStream);
-begin
-  //not implemented
-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);
-  procedure DumpData;
-  var
-    Count: byte;
-  begin
-    repeat
-      stream.Read(Count, 1);
-      stream.position := stream.position + Count;
-    until (Count = 0) or (stream.position >= stream.size);
-  end;
-type
-  TRGB = packed record
-    r, g, b: byte;
-  end;
-  TPalette = array of TBGRAPixel;
-  function rgbToColor(rgb: TRGB): TBGRAPixel;
-  begin
-    Result.red   := rgb.r;
-    Result.green := rgb.g;
-    Result.blue  := rgb.b;
-    Result.alpha := 255;
-  end;
-const
-  GIFScreenDescriptor_GlobalColorTableFlag = $80;
-  GIFImageDescriptor_LocalColorTableFlag = $80;
-  GIFImageDescriptor_InterlacedFlag = $40;
-  GIFGraphicControlExtension_TransparentFlag = $01;
-const
-  ilstart: array[1..4] of longint = (0, 4, 2, 1);
-  ilstep: array[1..4] of longint = (8, 8, 4, 2);
-var
-  NewImages: array of TGifSubImage;
-  NbImages:  integer;
-  GIFSignature: TGIFSignature;
-  GIFScreenDescriptor: TGIFScreenDescriptor;
-  GIFBlockID:   char;
-  GIFImageDescriptor: TGIFImageDescriptor;
-  globalPalette: TPalette;
-  localPalette:  TPalette;
-  transcolorIndex: integer;
-  delay: integer;
-  disposeMode: TDisposeMode;
-  procedure LoadGlobalPalette;
-  var
-    NbEntries, i: integer;
-    rgb: TRGB;
-  begin
-    NbEntries := 1 shl (GIFScreenDescriptor.flags and $07 + 1);
-    setlength(globalPalette, NbEntries);
-    for i := 0 to NbEntries - 1 do
-    begin
-      stream.Read(rgb, 3);
-      globalPalette[i] := rgbToColor(rgb);
-    end;
-  end;
-  procedure LoadLocalPalette;
-  var
-    NbEntries, i: integer;
-    rgb: TRGB;
-  begin
-    NbEntries := 1 shl (GIFImageDescriptor.flags and $07 + 1);
-    setlength(localPalette, NbEntries);
-    for i := 0 to NbEntries - 1 do
-    begin
-      stream.Read(rgb, 3);
-      localPalette[i] := rgbToColor(rgb);
-    end;
-  end;
-  procedure decodeGIFLZW(image: TBGRABitmap; const pal: TPalette; interlaced: boolean);
-  var
-    xd, yd: longint;
-  const
-    tablen = 4095;
-  type
-    Pstr = ^Tstr;
-    Tstr = record
-      prefix: Pstr;
-      suffix: longint;
-    end;
-    Pstrtab = ^Tstrtab;
-    Tstrtab = array[0..tablen] of Tstr;
-  var
-    strtab:   Pstrtab;
-    oldcode, curcode, clearcode, endcode: longint;
-    codesize, codelen, codemask: longint;
-    stridx:   longint;
-    bitbuf, bitsinbuf: longint;
-    bytbuf:   packed array[0..255] of byte;
-    bytinbuf, bytbufidx: byte;
-    endofsrc: boolean;
-    xcnt, ycnt, ystep, pass: longint;
-    procedure InitStringTable;
-    var
-      i: longint;
-    begin
-      new(strtab);
-      clearcode := 1 shl codesize;
-      endcode   := clearcode + 1;
-      stridx    := endcode + 1;
-      codelen   := codesize + 1;
-      codemask  := (1 shl codelen) - 1;
-      for i := 0 to clearcode - 1 do
-      begin
-        strtab^[i].prefix := nil;
-        strtab^[i].suffix := i;
-      end;
-      for i := clearcode to tablen do
-      begin
-        strtab^[i].prefix := nil;
-        strtab^[i].suffix := 0;
-      end;
-    end;
-    procedure ClearStringTable;
-    var
-      i: longint;
-    begin
-      clearcode := 1 shl codesize;
-      endcode   := clearcode + 1;
-      stridx    := endcode + 1;
-      codelen   := codesize + 1;
-      codemask  := (1 shl codelen) - 1;
-      for i := clearcode to tablen do
-      begin
-        strtab^[i].prefix := nil;
-        strtab^[i].suffix := 0;
-      end;
-    end;
-    procedure DoneStringTable;
-    begin
-      dispose(strtab);
-    end;
-    function GetNextCode: longint;
-    begin
-      while (bitsinbuf < codelen) do
-      begin
-        if (bytinbuf = 0) then
-        begin
-          stream.Read(bytinbuf, 1);
-          if (bytinbuf = 0) then
-            endofsrc := True;
-          stream.Read(bytbuf, bytinbuf);
-          bytbufidx := 0;
-        end;
-        bitbuf := bitbuf or (longint(byte(bytbuf[bytbufidx])) shl bitsinbuf);
-        Inc(bytbufidx);
-        Dec(bytinbuf);
-        Inc(bitsinbuf, 8);
-      end;
-      Result := bitbuf and codemask;
-      {DBG(bitbuf AND codemask);}
-      bitbuf := bitbuf shr codelen;
-      Dec(bitsinbuf, codelen);
-    end;
-    procedure AddStr2Tab(prefix: Pstr; suffix: longint);
-    begin
-      strtab^[stridx].prefix := prefix;
-      strtab^[stridx].suffix := suffix;
-      Inc(stridx);
-      case stridx of
-..1: codelen      := 1;
-..3: codelen      := 2;
-..7: codelen      := 3;
-..15: codelen     := 4;
-..31: codelen    := 5;
-..63: codelen    := 6;
-..127: codelen   := 7;
-..255: codelen  := 8;
-..511: codelen  := 9;
-..1023: codelen := 10;
-..2047: codelen := 11;
-..4096: codelen := 12;
-      end;
-      codemask := (1 shl codelen) - 1;
-    end;
-    function Code2Str(code: longint): Pstr;
-    begin
-      Result := addr(strtab^[code]);
-    end;
-    procedure WriteStr(s: Pstr);
-    var
-      colorIndex: integer;
-    begin
-      if (s^.prefix <> nil) then
-        WriteStr(s^.prefix);
-      if (ycnt >= yd) then
-      begin
-        if interlaced then
-        begin
-          while (ycnt >= yd) and (pass < 5) do
-          begin
-            Inc(pass);
-            ycnt  := ilstart[pass];
-            ystep := ilstep[pass];
-          end;
-        end;
-      end;
-      colorIndex := s^.suffix;
-      if (colorIndex <> transcolorIndex) and (colorIndex >= 0) and
-        (colorIndex < length(pal)) then
-        image.setpixel(xcnt, ycnt, pal[colorIndex]);
-      Inc(xcnt);
-      if (xcnt >= xd) then
-      begin
-        xcnt := 0;
-        Inc(ycnt, ystep);
-        if not interlaced then
-          if (ycnt >= yd) then
-          begin
-            Inc(pass);
-          end;
-      end;
-    end;
-    function firstchar(s: Pstr): byte;
-    begin
-      while (s^.prefix <> nil) do
-        s    := s^.prefix;
-      Result := s^.suffix;
-    end;
-  begin
-    {DBG('lzw start');}
-    endofsrc := False;
-    xd   := image.Width;
-    yd   := image.Height;
-    xcnt := 0;
-    if interlaced then
-    begin
-      pass  := 1;
-      ycnt  := ilstart[pass];
-      ystep := ilstep[pass];
-    end
-    else
-    begin
-      pass  := 4;
-      ycnt  := 0;
-      ystep := 1;
-    end;
-    oldcode   := 0;
-    bitbuf    := 0;
-    bitsinbuf := 0;
-    bytinbuf  := 0;
-    bytbufidx := 0;
-    codesize  := 0;
-    stream.Read(codesize, 1);
-    {DBG(codesize);}
-    InitStringTable;
-    curcode := getnextcode;
-    {DBG(curcode);}
-    while (curcode <> endcode) and (pass < 5) and not endofsrc{ AND NOT finished} do
-    begin
-{DBG('-----');
-DBG(curcode);
-DBGw(stridx);}
-      if (curcode = clearcode) then
-      begin
-        ClearStringTable;
-        repeat
-          curcode := getnextcode;
-          {DBG('lzw clear');}
-        until (curcode <> clearcode);
-        if (curcode = endcode) then
-          break;
-        WriteStr(code2str(curcode));
-        oldcode := curcode;
-      end
-      else
-      begin
-        if (curcode < stridx) then
-        begin
-          WriteStr(Code2Str(curcode));
-          AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(curcode)));
-          oldcode := curcode;
-        end
-        else
-        begin
-          if (curcode > stridx) then
-            break;
-          AddStr2Tab(Code2Str(oldcode), firstchar(Code2Str(oldcode)));
-          WriteStr(Code2Str(stridx - 1));
-          oldcode := curcode;
-        end;
-      end;
-      curcode := getnextcode;
-    end;
-    DoneStringTable;
-    {putimage(0,0,image);}
-{DBG('lzw end');
-DBG(bytinbuf);}
-    if not endofsrc then
-      DumpData;
-    {DBG('lzw finished');}
-  end;
-  procedure LoadImage;
-  var
-    imgWidth, imgHeight: integer;
-    img:     TBGRABitmap;
-    Interlaced: boolean;
-    palette: TPalette;
-  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
-      LoadLocalPalette
-    else
-      localPalette := nil;
-    if localPalette <> nil then
-      palette := localPalette
-    else
-      palette := globalPalette;
-    imgWidth := GIFImageDescriptor.Width;
-    imgHeight := GIFImageDescriptor.Height;
-    if length(NewImages) <= NbImages then
-      setlength(NewImages, length(NewImages) * 2 + 1);
-    img := TBGRABitmap.Create(imgWidth, imgHeight);
-    img.Fill(BGRAPixelTransparent);
-    NewImages[NbImages].Image    := img;
-    NewImages[NbImages].Position := point(GIFImageDescriptor.x, GIFImageDescriptor.y);
-    NewImages[NbImages].Delay    := Delay;
-    NewImages[NbImages].disposeMode := disposeMode;
-    if (transcolorIndex >= 0) and (transcolorIndex < length(palette)) then
-      NewImages[nbImages].TransparentColor := palette[transcolorIndex]
-    else
-      NewImages[nbImages].TransparentColor := BGRAPixelTransparent;
-    Inc(NbImages);
-    Interlaced := GIFImageDescriptor.flags and GIFImageDescriptor_InterlacedFlag =
-      GIFImageDescriptor_InterlacedFlag;
-    DecodeGIFLZW(img, palette, Interlaced);
-  end;
-  procedure ChangeImages;
-  var
-    i: integer;
-  begin
-    Clear;
-    SetLength(FImages, NbImages);
-    FFullAnimationTime:= 0;
-    for i := 0 to Count - 1 do
-    begin
-      FImages[i] := NewImages[i];
-      FFullAnimationTime += NewImages[i].Delay;
-    end;
-  end;
-  procedure ReadExtension;
-  var
-    GIFExtensionBlock: TGIFExtensionBlock;
-    GIFGraphicControlExtension: TGIFGraphicControlExtension;
-    mincount, Count:   byte;
-  begin
-    stream.Read(GIFExtensionBlock, sizeof(GIFExtensionBlock));
-    case GIFExtensionBlock.functioncode of
-      $F9:
-      begin
-        stream.Read(Count, 1);
-        if Count < sizeof(GIFGraphicControlExtension) then
-          mincount := 0
-        else
-        begin
-          mincount := sizeof(GIFGraphicControlExtension);
-          stream.Read(GIFGraphicControlExtension, mincount);
-          GIFGraphicControlExtension.delaytime := LEtoN(GIFGraphicControlExtension.delaytime);
-          if GIFGraphicControlExtension.flags and
-            GIFGraphicControlExtension_TransparentFlag =
-            GIFGraphicControlExtension_TransparentFlag then
-            transcolorIndex := GIFGraphicControlExtension.transcolor
-          else
-            transcolorIndex := -1;
-          if GIFGraphicControlExtension.delaytime <> 0 then
-            Delay     := GIFGraphicControlExtension.delaytime * 10;
-          disposeMode := TDisposeMode((GIFGraphicControlExtension.flags shr 2) and 7);
-        end;
-        stream.Position := Stream.Position + Count - mincount;
-        DumpData;
-      end;
-      else
-      begin
-        DumpData;
-      end;
-    end;
-  end;
-begin
-  NewImages := nil;
-  NbImages  := 0;
-  transcolorIndex := -1;
-  Delay     := 100;
-  FBackgroundColor := clBlack;
-  FWidth    := 0;
-  FHeight   := 0;
-  disposeMode := dmErase;
-  stream.Read(GIFSignature, sizeof(GIFSignature));
-  if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and (GIFSignature[3] = 'F') then
-  begin
-    stream.Read(GIFScreenDescriptor, sizeof(GIFScreenDescriptor));
-    GIFScreenDescriptor.Width := LEtoN(GIFScreenDescriptor.Width);
-    GIFScreenDescriptor.Height := LEtoN(GIFScreenDescriptor.Height);
-    FWidth  := GIFScreenDescriptor.Width;
-    FHeight := GIFScreenDescriptor.Height;
-    if (GIFScreenDescriptor.flags and GIFScreenDescriptor_GlobalColorTableFlag =
-      GIFScreenDescriptor_GlobalColorTableFlag) then
-    begin
-      LoadGlobalPalette;
-      if GIFScreenDescriptor.background < length(globalPalette) then
-        FBackgroundColor :=
-          BGRAToColor(globalPalette[GIFScreenDescriptor.background]);
-    end;
-    repeat
-      stream.Read(GIFBlockID, sizeof(GIFBlockID));
-      case GIFBlockID of
-        ';': ;
-        ',': LoadImage;
-        '!': ReadExtension;
-        else
-        begin
-          raise Exception.Create('TBGRAAnimatedGif: unexpected block type');
-          break;
-        end;
-      end;
-    until (GIFBlockID = ';') or (stream.Position >= stream.size);
-  end
-  else
-    raise Exception.Create('TBGRAAnimatedGif: invalid header');
-  ChangeImages;
-end;
-procedure TBGRAAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect);
-begin
-  if FBackgroundImage <> nil then
-    FreeAndNil(FBackgroundImage);
-  SaveBackgroundOnce(ACanvas, Rect);
-  if FPreviousVirtualScreen <> nil then
-  begin
-    FPreviousVirtualScreen.FreeReference;
-    FPreviousVirtualScreen := nil;
-  end;
-  Render(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
-  FStretchedVirtualScreen.Draw(ACanvas, Rect.Left, Rect.Top, false);
-  FImageChanged := False;
-  FPreviousVirtualScreen := TBGRABitmap(FStretchedVirtualScreen.Duplicate);
-end;
-function TBGRAAnimatedGif.GetEmpty: boolean;
-begin
-  Result := (length(FImages) = 0);
-end;
-function TBGRAAnimatedGif.GetHeight: integer;
-begin
-  Result := FHeight;
-end;
-function TBGRAAnimatedGif.GetTransparent: boolean;
-begin
-  Result := True;
-end;
-function TBGRAAnimatedGif.GetWidth: integer;
-begin
-  Result := FWidth;
-end;
-procedure TBGRAAnimatedGif.SetHeight(Value: integer);
-begin
-  //not implemented
-end;
-procedure TBGRAAnimatedGif.SetTransparent(Value: boolean);
-begin
-  //not implemented
-end;
-procedure TBGRAAnimatedGif.SetWidth(Value: integer);
-begin
-  //not implemented
 end;
 …
     FWantedImage := Index;
 end;
-{$HINTS ON}
 procedure TBGRAAnimatedGif.Clear;
 …
           end;
           PChangePix  := PLongWord(FPreviousVirtualScreen.ScanLine[0]);
           PNewPix     := PLongWord(FStretchedVirtualScreen.ScanLine[0]);
           PBackground := PLongWord(FBackgroundImage.ScanLine[0]);
           PNewBackground := PLongWord(NewBackgroundImage.ScanLine[0]);
+          PChangePix  := PLongWord(FPreviousVirtualScreen.Data);
+          PNewPix     := PLongWord(FStretchedVirtualScreen.Data);
+          PBackground := PLongWord(FBackgroundImage.Data);
+          PNewBackground := PLongWord(NewBackgroundImage.Data);
           for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do
           begin
 …
           else
           begin
             PChangePix  := PLongWord(FPreviousVirtualScreen.ScanLine[0]);
             PNewPix     := PLongWord(FStretchedVirtualScreen.ScanLine[0]);
             PBackground := PLongWord(FBackgroundImage.ScanLine[0]);
+            PChangePix  := PLongWord(FPreviousVirtualScreen.Data);
+            PNewPix     := PLongWord(FStretchedVirtualScreen.Data);
+            PBackground := PLongWord(FBackgroundImage.Data);
             for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do
             begin
 …
       begin
         shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate);
         p     := shape.ScanLine[0];
+        p     := shape.Data;
         for n := shape.NbPixels - 1 downto 0 do
         begin
 …
       begin
         shape := TBGRABitmap(FPreviousVirtualScreen.Duplicate);
         p     := shape.ScanLine[0];
         pback := FBackgroundImage.ScanLine[0];
+        p     := shape.Data;
+        pback := FBackgroundImage.Data;
         for n := shape.NbPixels - 1 downto 0 do
         begin
 …
     else
     begin
       PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]);
       PNewPix    := PLongWord(FStretchedVirtualScreen.ScanLine[0]);
+      PChangePix := PLongWord(FPreviousVirtualScreen.Data);
+      PNewPix    := PLongWord(FStretchedVirtualScreen.Data);
       for n := FStretchedVirtualScreen.NbPixels - 1 downto 0 do
       begin
 …
 end;
 { TFPReaderGIF }
 procedure TFPReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage);
+{ TBGRAReaderGIF }
+procedure TBGRAReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage);
 var
   gif:  TBGRAAnimatedGif;
 …
 end;
+{$HINTS OFF}
+function TFPReaderGIF.InternalCheck(Str: TStream): boolean;
+function TBGRAReaderGIF.InternalCheck(Str: TStream): boolean;
 var
   GIFSignature: TGIFSignature;
 …
   savepos := str.Position;
   try
+    fillchar({%H-}GIFSignature, sizeof(GIFSignature), 0);
     str.Read(GIFSignature, sizeof(GIFSignature));
     if (GIFSignature[1] = 'G') and (GIFSignature[2] = 'I') and
 …
 end;
+{$HINTS ON}
+{ TBGRAWriterGIF }
+procedure TBGRAWriterGIF.InternalWrite(Str: TStream; Img: TFPCustomImage);
+var
+  gif: TBGRAAnimatedGif;
+begin
+  gif := TBGRAAnimatedGif.Create;
+  try
+    gif.SetSize(Img.Width,Img.Height);
+    gif.AddFrame(Img, 0,0,0);
+    gif.SaveToStream(Str, BGRAColorQuantizerFactory, daFloydSteinberg);
+  except
+    on ex: EColorQuantizerMissing do
+    begin
+      FreeAndNil(gif);
+      raise EColorQuantizerMissing.Create('Please define the color quantizer factory. You can do that with the following statements: Uses BGRAPalette, BGRAColorQuantization; BGRAColorQuantizerFactory:= TBGRAColorQuantizer;');
+    end;
+    on ex: Exception do
+    begin
+      FreeAndNil(gif);
+      raise ex;
+    end;
+  end;
+  FreeAndNil(gif);
+end;
 initialization
+  DefaultBGRAImageReader[ifGif] := TBGRAReaderGIF;
+  DefaultBGRAImageWriter[ifGif] := TBGRAWriterGIF;
   //Free Pascal Image
   ImageHandlers.RegisterImageReader('Animated GIF', TBGRAAnimatedGif.GetFileExtensions,
+    TFPReaderGIF);
+    TBGRAReaderGIF);
+  ImageHandlers.RegisterImageWriter('Animated GIF', TBGRAAnimatedGif.GetFileExtensions,
+    TBGRAWriterGIF);
+  {$IFDEF BGRABITMAP_USE_LCL}
   //Lazarus Picture
   TPicture.RegisterFileFormat(TBGRAAnimatedGif.GetFileExtensions, 'Animated GIF',
     TBGRAAnimatedGif);
+  {$ENDIF}
 end.

GraphicTest/Packages/bgrabitmap/bgraarrow.pas

-              r472
+              r494
 uses
   Classes, SysUtils, BGRABitmapTypes, Graphics;
+  Classes, SysUtils, BGRABitmapTypes, BGRAGraphics;
 type
   { TBGRAArrow }
   TBGRAArrow = class
+  TBGRAArrow = class(TBGRACustomArrow)
   private
     FLineCap: TPenEndCap;
 …
         ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; const AWidth: single; AOffsetX: single;
         ARepeatCount: integer; ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF;
-    function GetIsEndDefined: boolean;
-    function GetIsStartDefined: boolean;
-    procedure SetEndOffsetX(AValue: single);
-    procedure SetEndRepeatCount(AValue: integer);
-    procedure SetEndSizeFactor(AValue: TPointF);
-    procedure SetLineCap(AValue: TPenEndCap);
-    procedure SetStartOffsetX(AValue: single);
-    procedure SetStartRepeatCount(AValue: integer);
-    procedure SetStartSizeFactor(AValue: TPointF);
     procedure SetWidth(AValue: single);
+  protected
+    function GetEndRepeatCount: integer; override;
+    function GetEndSizeFactor: TPointF; override;
+    function GetIsEndDefined: boolean; override;
+    function GetIsStartDefined: boolean; override;
+    function GetEndOffsetX: single; override;
+    function GetStartOffsetX: single; override;
+    function GetStartRepeatCount: integer; override;
+    function GetStartSizeFactor: TPointF; override;
+    procedure SetEndOffsetX(AValue: single); override;
+    procedure SetEndRepeatCount(AValue: integer); override;
+    procedure SetEndSizeFactor(AValue: TPointF); override;
+    procedure SetStartOffsetX(AValue: single); override;
+    procedure SetStartRepeatCount(AValue: integer); override;
+    procedure SetStartSizeFactor(AValue: TPointF); override;
+    function GetLineCap: TPenEndCap; override;
+    procedure SetLineCap(AValue: TPenEndCap); override;
+    procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
+    procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
   public
     constructor Create;
+    procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle;
+        ARelativePenWidth: single; ATriangleBackOffset: single);
+    procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle;
+        ARelativePenWidth: single; ATriangleBackOffset: single);
+    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF;
+    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF;
+    property IsStartDefined: boolean read GetIsStartDefined;
+    property IsEndDefined: boolean read GetIsEndDefined;
+    property LineCap: TPenEndCap read FLineCap write SetLineCap;
+    property StartSize: TPointF read FStartSizeFactor write SetStartSizeFactor;
+    property EndSize: TPointF read FEndSizeFactor write SetEndSizeFactor;
+    property StartOffsetX: single read FStartOffsetX write SetStartOffsetX;
+    property EndOffsetX: single read FEndOffsetX write SetEndOffsetX;
+    property StartRepeatCount: integer read FStartRepeatCount write SetStartRepeatCount;
+    property EndRepeatCount: integer read FEndRepeatCount write SetEndRepeatCount;
+    procedure StartAsNone; override;
+    procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure StartAsTail; override;
+    procedure EndAsNone; override;
+    procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure EndAsTail; override;
+    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
+    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
   end;
 …
 end;
+function TBGRAArrow.GetEndOffsetX: single;
+begin
+  result := FEndOffsetX;
+end;
+function TBGRAArrow.GetStartOffsetX: single;
+begin
+  result := FStartOffsetX;
+end;
+function TBGRAArrow.GetStartRepeatCount: integer;
+begin
+  result := FStartRepeatCount;
+end;
+function TBGRAArrow.GetStartSizeFactor: TPointF;
+begin
+  result := FStartSizeFactor;
+end;
 procedure TBGRAArrow.SetEndOffsetX(AValue: single);
 begin
 …
   FEndComputed:= false;
   FEnd := nil;
+end;
+function TBGRAArrow.GetLineCap: TPenEndCap;
+begin
+  result := FLineCap;
 end;
 …
 end;
+function TBGRAArrow.GetEndRepeatCount: integer;
+begin
+  Result:= FEndRepeatCount;
+end;
+function TBGRAArrow.GetEndSizeFactor: TPointF;
+begin
+  Result:= FEndSizeFactor;
+end;
 constructor TBGRAArrow.Create;
 begin
 …
   FStartSizeFactor := PointF(2,2);
   FEndSizeFactor := PointF(2,2);
+end;
+procedure TBGRAArrow.StartAsNone;
+begin
+  SetStart(asNone);
+end;
+procedure TBGRAArrow.StartAsClassic(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
+      SetStart(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetStart(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetStart(asFlipped,join,ARelativePenWidth)
+    else
+      SetStart(asNormal,join,ARelativePenWidth)
+  end;
+end;
+procedure TBGRAArrow.StartAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetStart(asTriangle, join,1,ABackOffset);
+end;
+procedure TBGRAArrow.StartAsTail;
+begin
+  SetStart(asTail);
+end;
+procedure TBGRAArrow.EndAsNone;
+begin
+  SetEnd(asNone);
+end;
+procedure TBGRAArrow.EndAsClassic(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
+      SetEnd(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetEnd(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetEnd(asFlipped,join,ARelativePenWidth)
+    else
+      SetEnd(asNormal,join,ARelativePenWidth)
+  end;
+end;
+procedure TBGRAArrow.EndAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetEnd(asTriangle, join,1, ABackOffset);
+end;
+procedure TBGRAArrow.EndAsTail;
+begin
+  SetEnd(asTail);
 end;

GraphicTest/Packages/bgrabitmap/bgrabitmap.pas

-              r472
+              r494
                  Free easy-to-use memory bitmap 32-bit,
 -bit for each channel, transparency.
+                 Channels in that order : B G R A
+                 Channels can be in the following orders:
+                 - B G R A (recommended for Windows, required for fpGUI)
+                 - R G B A (recommended for Gtk and MacOS)
                  - Drawing primitives
 …
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 interface
 …
 uses
   Classes, SysUtils,
 {$IFDEF LCLwin32}
   BGRAWinBitmap,
+{$IFDEF BGRABITMAP_USE_FPGUI}
+    BGRAfpGUIBitmap,
 {$ELSE}
+  {$IFDEF LCLgtk}
+  BGRAGtkBitmap,
+  {$ELSE}
+    {$IFDEF LCLgtk2}
+  BGRAGtkBitmap,
+    {$ELSE}
+      {$IFDEF LCLqt}
+  BGRAQtBitmap,
+      {$ELSE}
+  BGRADefaultBitmap,
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+        {$IFDEF BGRABITMAP_USE_LCL}
+          {$IFDEF LCLwin32}
+                BGRAWinBitmap,
+          {$ELSE}
+                {$IFDEF LCLgtk}
+                BGRAGtkBitmap,
+                {$ELSE}
+                  {$IFDEF LCLgtk2}
+                BGRAGtkBitmap,
+                  {$ELSE}
+                        {$IFDEF LCLqt}
+                BGRAQtBitmap,
+                        {$ELSE}
+              {$IFDEF DARWIN}
+        BGRAMacBitmap,
+              {$ELSE}
+                BGRALCLBitmap,
+              {$ENDIF}
+                        {$ENDIF}
+                  {$ENDIF}
+                {$ENDIF}
+          {$ENDIF}
+        {$ELSE}
+          BGRANoGuiBitmap,
+        {$ENDIF}
 {$ENDIF}
   Graphics;
+  BGRAGraphics;
 type
 {$IFDEF LCLwin32}
   TBGRABitmap = TBGRAWinBitmap;
+{$IFDEF BGRABITMAP_USE_FPGUI}
+  TBGRABitmap = class(TBGRAfpGUIBitmap);
 {$ELSE}
+  {$IFDEF LCLgtk}
+  TBGRABitmap = TBGRAGtkBitmap;
+  {$ELSE}
+    {$IFDEF LCLgtk2}
+  TBGRABitmap = TBGRAGtkBitmap;
+    {$IFDEF BGRABITMAP_USE_LCL}
+      {$IFDEF LCLwin32}
+        TBGRABitmap = class(TBGRAWinBitmap);
+      {$ELSE}
+        {$IFDEF LCLgtk}
+        TBGRABitmap = class(TBGRAGtkBitmap);
+        {$ELSE}
+          {$IFDEF LCLgtk2}
+        TBGRABitmap = class(TBGRAGtkBitmap);
+          {$ELSE}
+            {$IFDEF LCLqt}
+        TBGRABitmap = class(TBGRAQtBitmap);
+            {$ELSE}
+              {$IFDEF DARWIN}
+        TBGRABitmap = class(TBGRAMacBitmap);
+              {$ELSE}
+        TBGRABitmap = class(TBGRALCLBitmap);
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF}
+      {$ENDIF}
     {$ELSE}
+      {$IFDEF LCLqt}
+  TBGRABitmap = TBGRAQtBitmap;
+      {$ELSE}
+  TBGRABitmap = TBGRADefaultBitmap;
+      {$ENDIF}
+      TBGRABitmap = class(TBGRANoGUIBitmap);
     {$ENDIF}
-  {$ENDIF}
 {$ENDIF}
 …
 implementation
 uses GraphType, BGRABitmapTypes, BGRAReadBMP, BGRAReadGif,
   BGRAReadIco, bgrareadjpeg, BGRAReadLzp, BGRAReadPCX,
+uses BGRABitmapTypes, BGRAReadBMP, BGRAReadBmpMioMap, BGRAReadGif,
+  BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, BGRAReadPCX,
   BGRAReadPng, BGRAReadPSD, BGRAReadTGA, BGRAReadXPM,
   BGRAWriteLzp;

GraphicTest/Packages/bgrabitmap/bgrabitmappack.lpk

-              r472
+              r494
 <?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <Package Version="4">
     <PathDelim Value="\"/>
     <Name Value="BGRABitmapPack"/>
-    <AddToProjectUsesSection Value="True"/>
     <Author Value="Circular"/>
     <CompilerOptions>
 …
       <CodeGeneration>
         <Optimizations>
+          <OptimizationLevel Value="3"/>
           <VariablesInRegisters Value="True"/>
-          <OptimizationLevel Value="3"/>
         </Optimizations>
       </CodeGeneration>
 …
         </Debugging>
       </Linking>
-      <Other>
-        <CompilerMessages>
-          <UseMsgFile Value="True"/>
-        </CompilerMessages>
-        <CompilerPath Value="$(CompPath)"/>
-      </Other>
     </CompilerOptions>
     <Description Value="Drawing routines with alpha blending and antialiasing"/>
     <License Value="modified LGPL"/>
     <Version Major="8" Minor="1"/>
     <Files Count="91">
+    <Version Major="9" Minor="3"/>
+    <Files Count="108">
       <Item1>
         <Filename Value="bgraanimatedgif.pas"/>
 …
       </Item27>
       <Item28>
         <Filename Value="bgrascene3dinterface.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgraslicescaling.pas"/>
+        <UnitName Value="BGRASliceScaling"/>
       </Item28>
       <Item29>
         <Filename Value="bgraslicescaling.pas"/>
         <UnitName Value="BGRASliceScaling"/>
+        <Filename Value="bgrasse.pas"/>
+        <UnitName Value="BGRASSE"/>
       </Item29>
       <Item30>
         <Filename Value="bgrasse.pas"/>
         <UnitName Value="BGRASSE"/>
+        <Filename Value="bgrastreamlayers.pas"/>
+        <UnitName Value="BGRAStreamLayers"/>
       </Item30>
       <Item31>
         <Filename Value="bgrastreamlayers.pas"/>
         <UnitName Value="BGRAStreamLayers"/>
+        <Filename Value="bgratext.pas"/>
+        <UnitName Value="BGRAText"/>
       </Item31>
       <Item32>
         <Filename Value="bgratext.pas"/>
         <UnitName Value="BGRAText"/>
+        <Filename Value="bgratextfx.pas"/>
+        <UnitName Value="BGRATextFX"/>
       </Item32>
       <Item33>
         <Filename Value="bgratextfx.pas"/>
         <UnitName Value="BGRATextFX"/>
+        <Filename Value="bgratransform.pas"/>
+        <UnitName Value="BGRATransform"/>
       </Item33>
       <Item34>
         <Filename Value="bgratransform.pas"/>
         <UnitName Value="BGRATransform"/>
+        <Filename Value="bgratypewriter.pas"/>
+        <UnitName Value="BGRATypewriter"/>
       </Item34>
       <Item35>
         <Filename Value="bgratypewriter.pas"/>
         <UnitName Value="BGRATypewriter"/>
+        <Filename Value="bgravectorize.pas"/>
+        <UnitName Value="BGRAVectorize"/>
       </Item35>
       <Item36>
         <Filename Value="bgravectorize.pas"/>
         <UnitName Value="BGRAVectorize"/>
+        <Filename Value="blendpixelinline.inc"/>
+        <Type Value="Binary"/>
       </Item36>
       <Item37>
         <Filename Value="blendpixelinline.inc"/>
+        <Filename Value="blendpixels.inc"/>
         <Type Value="Binary"/>
       </Item37>
       <Item38>
         <Filename Value="blendpixels.inc"/>
+        <Filename Value="blendpixelsover.inc"/>
         <Type Value="Binary"/>
       </Item38>
       <Item39>
         <Filename Value="blendpixelsover.inc"/>
+        <Filename Value="blurfast.inc"/>
         <Type Value="Binary"/>
       </Item39>
       <Item40>
         <Filename Value="blurfast.inc"/>
+        <Filename Value="blurnormal.inc"/>
         <Type Value="Binary"/>
       </Item40>
       <Item41>
         <Filename Value="blurnormal.inc"/>
+        <Filename Value="csscolorconst.inc"/>
         <Type Value="Binary"/>
       </Item41>
       <Item42>
         <Filename Value="csscolorconst.inc"/>
+        <Filename Value="lightingclasses3d.inc"/>
         <Type Value="Binary"/>
       </Item42>
       <Item43>
         <Filename Value="filldensity256.inc"/>
+        <Filename Value="lineartexscan.inc"/>
         <Type Value="Binary"/>
       </Item43>
       <Item44>
         <Filename Value="filldensitysegment256.inc"/>
+        <Filename Value="lineartexscan2.inc"/>
         <Type Value="Binary"/>
       </Item44>
       <Item45>
         <Filename Value="lightingclasses3d.inc"/>
+        <Filename Value="multishapeline.inc"/>
         <Type Value="Binary"/>
       </Item45>
       <Item46>
         <Filename Value="lineartexscan.inc"/>
+        <Filename Value="perspectivecolorscan.inc"/>
         <Type Value="Binary"/>
       </Item46>
       <Item47>
         <Filename Value="lineartexscan2.inc"/>
+        <Filename Value="perspectivescan.inc"/>
         <Type Value="Binary"/>
       </Item47>
       <Item48>
         <Filename Value="multishapeline.inc"/>
+        <Filename Value="perspectivescan2.inc"/>
         <Type Value="Binary"/>
       </Item48>
       <Item49>
         <Filename Value="perspectivecolorscan.inc"/>
+        <Filename Value="phongdraw.inc"/>
         <Type Value="Binary"/>
       </Item49>
       <Item50>
         <Filename Value="perspectivescan.inc"/>
+        <Filename Value="phongdrawsse.inc"/>
         <Type Value="Binary"/>
       </Item50>
       <Item51>
         <Filename Value="perspectivescan2.inc"/>
+        <Filename Value="phonglight.inc"/>
         <Type Value="Binary"/>
       </Item51>
       <Item52>
         <Filename Value="phongdraw.inc"/>
+        <Filename Value="phonglightsse.inc"/>
         <Type Value="Binary"/>
       </Item52>
       <Item53>
         <Filename Value="phongdrawsse.inc"/>
+        <Filename Value="polyaliaspersp.inc"/>
         <Type Value="Binary"/>
       </Item53>
       <Item54>
         <Filename Value="phonglight.inc"/>
+        <Filename Value="shapes3d.inc"/>
         <Type Value="Binary"/>
       </Item54>
       <Item55>
         <Filename Value="phonglightsse.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrasse.inc"/>
+        <UnitName Value="bgrasse"/>
       </Item55>
       <Item56>
         <Filename Value="polyaliaspersp.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgragrayscalemask.pas"/>
+        <UnitName Value="BGRAGrayscaleMask"/>
       </Item56>
       <Item57>
         <Filename Value="renderdensity256.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrareadbmp.pas"/>
+        <UnitName Value="BGRAReadBMP"/>
       </Item57>
       <Item58>
         <Filename Value="shapes3d.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrareadgif.pas"/>
+        <UnitName Value="BGRAReadGif"/>
       </Item58>
       <Item59>
         <Filename Value="winstream.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrareadpcx.pas"/>
+        <UnitName Value="BGRAReadPCX"/>
       </Item59>
       <Item60>
         <Filename Value="bgrasse.inc"/>
         <UnitName Value="bgrasse"/>
+        <Filename Value="bgrareadpng.pas"/>
+        <UnitName Value="BGRAReadPng"/>
       </Item60>
       <Item61>
         <Filename Value="sseloadv.inc"/>
         <UnitName Value="sseloadv"/>
+        <Filename Value="bgrareadpsd.pas"/>
+        <UnitName Value="BGRAReadPSD"/>
       </Item61>
       <Item62>
         <Filename Value="ssesavev.inc"/>
         <UnitName Value="ssesavev"/>
+        <Filename Value="bgrathumbnail.pas"/>
+        <UnitName Value="BGRAThumbnail"/>
       </Item62>
       <Item63>
         <Filename Value="bgragrayscalemask.pas"/>
         <UnitName Value="BGRAGrayscaleMask"/>
+        <Filename Value="bgrareadtga.pas"/>
+        <UnitName Value="BGRAReadTGA"/>
       </Item63>
       <Item64>
         <Filename Value="bgrareadbmp.pas"/>
         <UnitName Value="BGRAReadBMP"/>
+        <Filename Value="bgrareadico.pas"/>
+        <UnitName Value="BGRAReadIco"/>
       </Item64>
       <Item65>
         <Filename Value="bgrareadgif.pas"/>
         <UnitName Value="BGRAReadGif"/>
+        <Filename Value="bgrareadjpeg.pas"/>
+        <UnitName Value="BGRAReadJpeg"/>
       </Item65>
       <Item66>
         <Filename Value="bgrareadpcx.pas"/>
         <UnitName Value="BGRAReadPCX"/>
+        <Filename Value="bgrareadlzp.pas"/>
+        <UnitName Value="BGRAReadLzp"/>
       </Item66>
       <Item67>
         <Filename Value="bgrareadpng.pas"/>
         <UnitName Value="BGRAReadPng"/>
+        <Filename Value="unzipperext.pas"/>
+        <UnitName Value="UnzipperExt"/>
       </Item67>
       <Item68>
         <Filename Value="bgrareadpsd.pas"/>
         <UnitName Value="BGRAReadPSD"/>
+        <Filename Value="bgralzpcommon.pas"/>
+        <UnitName Value="BGRALzpCommon"/>
       </Item68>
       <Item69>
         <Filename Value="bgrathumbnail.pas"/>
         <UnitName Value="BGRAThumbnail"/>
+        <Filename Value="bgrawritelzp.pas"/>
+        <UnitName Value="BGRAWriteLzp"/>
       </Item69>
       <Item70>
         <Filename Value="bgrareadtga.pas"/>
         <UnitName Value="BGRAReadTGA"/>
+        <Filename Value="bgrareadxpm.pas"/>
+        <UnitName Value="BGRAReadXPM"/>
       </Item70>
       <Item71>
         <Filename Value="bgrareadico.pas"/>
         <UnitName Value="BGRAReadIco"/>
+        <Filename Value="bgrasvg.pas"/>
+        <UnitName Value="BGRASVG"/>
       </Item71>
       <Item72>
         <Filename Value="bgrareadjpeg.pas"/>
         <UnitName Value="bgrareadjpeg"/>
+        <Filename Value="bgraunits.pas"/>
+        <UnitName Value="BGRAUnits"/>
       </Item72>
       <Item73>
         <Filename Value="bgrareadlzp.pas"/>
         <UnitName Value="BGRAReadLzp"/>
+        <Filename Value="bgrasvgshapes.pas"/>
+        <UnitName Value="BGRASVGShapes"/>
       </Item73>
       <Item74>
         <Filename Value="unzipperext.pas"/>
         <UnitName Value="UnzipperExt"/>
+        <Filename Value="bgrasvgtype.pas"/>
+        <UnitName Value="BGRASVGType"/>
       </Item74>
       <Item75>
         <Filename Value="bgralzpcommon.pas"/>
         <UnitName Value="BGRALzpCommon"/>
+        <Filename Value="bgrareadbmpmiomap.pas"/>
+        <UnitName Value="BGRAReadBmpMioMap"/>
       </Item75>
       <Item76>
         <Filename Value="bgrawritelzp.pas"/>
         <UnitName Value="BGRAWriteLzp"/>
+        <Filename Value="bgraarrow.pas"/>
+        <UnitName Value="BGRAArrow"/>
       </Item76>
       <Item77>
         <Filename Value="bgrareadxpm.pas"/>
         <UnitName Value="BGRAReadXPM"/>
+        <Filename Value="vertex3d.inc"/>
+        <Type Value="Binary"/>
       </Item77>
       <Item78>
         <Filename Value="bgrasvg.pas"/>
         <UnitName Value="BGRASVG"/>
+        <Filename Value="face3d.inc"/>
+        <Type Value="Binary"/>
       </Item78>
       <Item79>
         <Filename Value="bgraunits.pas"/>
         <UnitName Value="BGRAUnits"/>
+        <Filename Value="part3d.inc"/>
+        <Type Value="Binary"/>
       </Item79>
       <Item80>
         <Filename Value="bgrasvgshapes.pas"/>
         <UnitName Value="BGRASVGShapes"/>
+        <Filename Value="object3d.inc"/>
+        <Type Value="Binary"/>
       </Item80>
       <Item81>
         <Filename Value="bgrasvgtype.pas"/>
         <UnitName Value="BGRASVGType"/>
+        <Filename Value="bgrapalette.pas"/>
+        <UnitName Value="BGRAPalette"/>
       </Item81>
       <Item82>
         <Filename Value="bgrareadbmpmiomap.pas"/>
         <UnitName Value="BGRAReadBmpMioMap"/>
+        <Filename Value="bgracolorquantization.pas"/>
+        <UnitName Value="BGRAColorQuantization"/>
       </Item82>
       <Item83>
         <Filename Value="bgraarrow.pas"/>
         <UnitName Value="BGRAArrow"/>
+        <Filename Value="bgradithering.pas"/>
+        <UnitName Value="BGRADithering"/>
       </Item83>
       <Item84>
         <Filename Value="vertex3d.inc"/>
+        <Filename Value="paletteformats.inc"/>
         <Type Value="Binary"/>
       </Item84>
       <Item85>
         <Filename Value="face3d.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrautf8.pas"/>
+        <UnitName Value="BGRAUTF8"/>
       </Item85>
       <Item86>
         <Filename Value="part3d.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgralclbitmap.pas"/>
+        <UnitName Value="BGRALCLBitmap"/>
       </Item86>
       <Item87>
         <Filename Value="object3d.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgrawritepng.pas"/>
+        <UnitName Value="BGRAWritePNG"/>
       </Item87>
       <Item88>
         <Filename Value="bgrapalette.pas"/>
         <UnitName Value="BGRAPalette"/>
+        <Filename Value="bgragifformat.pas"/>
+        <UnitName Value="BGRAGifFormat"/>
       </Item88>
       <Item89>
         <Filename Value="bgracolorquantization.pas"/>
         <UnitName Value="BGRAColorQuantization"/>
+        <Filename Value="geometrytypes.inc"/>
+        <Type Value="Binary"/>
       </Item89>
       <Item90>
         <Filename Value="bgradithering.pas"/>
         <UnitName Value="BGRADithering"/>
+        <Filename Value="bgracustombitmap.inc"/>
+        <Type Value="Binary"/>
       </Item90>
       <Item91>
         <Filename Value="paletteformats.inc"/>
         <Type Value="Binary"/>
+        <Filename Value="bgragraphics.pas"/>
+        <UnitName Value="BGRAGraphics"/>
       </Item91>
+      <Item92>
+        <Filename Value="bgrascenetypes.pas"/>
+        <UnitName Value="BGRASceneTypes"/>
+      </Item92>
+      <Item93>
+        <Filename Value="bgrarenderer3d.pas"/>
+        <UnitName Value="BGRARenderer3D"/>
+      </Item93>
+      <Item94>
+        <Filename Value="bgrawritebmpmiomap.pas"/>
+        <UnitName Value="BGRAWriteBmpMioMap"/>
+      </Item94>
+      <Item95>
+        <Filename Value="bgraopengltype.pas"/>
+        <UnitName Value="BGRAOpenGLType"/>
+      </Item95>
+      <Item96>
+        <Filename Value="bgraspritegl.pas"/>
+        <UnitName Value="BGRASpriteGL"/>
+      </Item96>
+      <Item97>
+        <Filename Value="bgraopengl.pas"/>
+        <UnitName Value="BGRAOpenGL"/>
+      </Item97>
+      <Item98>
+        <Filename Value="bgracanvasgl.pas"/>
+        <UnitName Value="BGRACanvasGL"/>
+      </Item98>
+      <Item99>
+        <Filename Value="bgrafontgl.pas"/>
+        <UnitName Value="BGRAFontGL"/>
+      </Item99>
+      <Item100>
+        <Filename Value="bgraopengl3d.pas"/>
+        <UnitName Value="BGRAOpenGL3D"/>
+      </Item100>
+      <Item101>
+        <Filename Value="blurbox.inc"/>
+        <Type Value="Text"/>
+      </Item101>
+      <Item102>
+        <Filename Value="bgraphoxo.pas"/>
+        <UnitName Value="BGRAPhoxo"/>
+      </Item102>
+      <Item103>
+        <Filename Value="bgrafilterscanner.pas"/>
+        <UnitName Value="BGRAFilterScanner"/>
+      </Item103>
+      <Item104>
+        <Filename Value="bgrafiltertype.pas"/>
+        <UnitName Value="BGRAFilterType"/>
+      </Item104>
+      <Item105>
+        <Filename Value="bgrafilterblur.pas"/>
+        <UnitName Value="BGRAFilterBlur"/>
+      </Item105>
+      <Item106>
+        <Filename Value="bgramultifiletype.pas"/>
+        <UnitName Value="bgramultifiletype"/>
+      </Item106>
+      <Item107>
+        <Filename Value="bgrawinresource.pas"/>
+        <UnitName Value="BGRAWinResource"/>
+      </Item107>
+      <Item108>
+        <Filename Value="bgralazresource.pas"/>
+        <UnitName Value="BGRALazResource"/>
+      </Item108>
     </Files>
     <RequiredPkgs Count="2">

GraphicTest/Packages/bgrabitmap/bgrabitmappack.pas

-              r472
+              r494
   BGRATransform, BGRATypewriter, BGRAVectorize, BGRAGrayscaleMask,
   BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, BGRAReadPSD,
   BGRAThumbnail, BGRAReadTGA, BGRAReadIco, bgrareadjpeg, BGRAReadLzp,
+  BGRAThumbnail, BGRAReadTGA, BGRAReadIco, BGRAReadJpeg, BGRAReadLzp,
   UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRASVG, BGRAUnits,
   BGRASVGShapes, BGRASVGType, BGRAReadBmpMioMap, BGRAArrow, BGRAPalette,
+  BGRAColorQuantization, BGRADithering;
+  BGRAColorQuantization, BGRADithering, BGRAUTF8, BGRALCLBitmap, BGRAWritePNG,
+  BGRAGifFormat, BGRAGraphics, BGRASceneTypes, BGRARenderer3D,
+  BGRAWriteBmpMioMap, BGRAOpenGLType, BGRASpriteGL, BGRAOpenGL, BGRACanvasGL,
+  BGRAFontGL, BGRAOpenGL3D, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType,
+  BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRALazResource;
 implementation

GraphicTest/Packages/bgrabitmap/bgrabitmaptypes.pas

-              r472
+              r494
        --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause.
+               If you are using LCL types, add also BGRAGraphics unit.
  ****************************************************************************
 …
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 interface
 uses
+  Classes, Types, Graphics, FPImage, FPImgCanv, GraphType;
+  Classes, Types, BGRAGraphics,
+  FPImage, FPImgCanv{$IFDEF BGRABITMAP_USE_LCL}, GraphType{$ENDIF},
+  BGRAMultiFileType;
 type
+  //pointer for direct pixel access
+  PBGRAPixel = ^TBGRAPixel;
+  TMultiFileContainer = BGRAMultiFileType.TMultiFileContainer;
   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
+  TExpandedPixel = packed record
+    red, green, blue, alpha: word;
+  end;
+  //pixel color defined in HSL colorspace
+  THSLAPixel = packed record
+    hue, saturation, lightness, alpha: word;
+  end;
+  TGSBAPixel = THSLAPixel;
+  //general purpose color variable with floating point values
+  TColorF = packed array[1..4] of single;
+  { These types are used as parameters }
+  TDrawMode = (dmSet,                   //replace pixels
+               dmSetExceptTransparent,  //draw pixels with alpha=255
+               dmLinearBlend,           //blend without gamma correction
+               dmDrawWithTransparency,  //normal blending with gamma correction
+               dmXor);                  //bitwise xor for all channels
+  TChannel = (cRed, cGreen, cBlue, cAlpha);
+  TChannels = set of TChannel;
+  //floodfill option
+  TFloodfillMode = (fmSet,                   //set pixels
+                    fmDrawWithTransparency,  //draw fill color with transparency
+                    fmProgressive);          //draw fill color with transparency according to similarity with start color
+  TResampleMode = (rmSimpleStretch,   //low quality resample
+                   rmFineResample);   //use resample filters 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
+                     rfBicubic,       //simple bi-cubic filter (blur)
+                     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);
+{=== Miscellaneous types ===}
+type
+  {* Options when doing a floodfill (also called bucket fill) }
+  TFloodfillMode = (
+    {** Pixels that are filled are replaced }
+    fmSet,
+    {** Pixels that are filled are drawn upon with the fill color }
+    fmDrawWithTransparency,
+    {** Pixels that are filled are drawn upon to the extent that the color underneath is similar to
+        the start color. The more different the different is, the less it is drawn upon }
+    fmProgressive);
+  {* Specifies how much smoothing is applied to the computation of the median }
+  TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth);
+  {* Specifies the shape of a predefined blur }
+  TRadialBlurType = (
+    {** Gaussian-like, pixel importance decreases progressively }
+    rbNormal,
+    {** Disk blur, pixel importance does not decrease progressively }
+    rbDisk,
+    {** Pixel are considered when they are at a certain distance }
+    rbCorona,
+    {** Gaussian-like, but 10 times smaller than ''rbNormal'' }
+    rbPrecise,
+    {** Gaussian-like but simplified to be computed faster }
+    rbFast,
+    {** Box blur, pixel importance does not decrease progressively
+        and the pixels are included when they are in a square.
+        This is much faster than ''rbFast'' however you may get
+        square shapes in the resulting image }
+    rbBox);
+  TEmbossOption = (eoTransparent, eoPreserveHue);
+  TEmbossOptions = set of TEmbossOption;
+  TTextLayout = BGRAGraphics.TTextLayout;
 const
+  tlTop = BGRAGraphics.tlTop;
+  tlCenter = BGRAGraphics.tlCenter;
+  tlBottom = BGRAGraphics.tlBottom;
+  // checks the bounds of an image in the given clipping rectangle
+  function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer; const cliprect: TRect): boolean;
+{==== Imported from GraphType ====}
+//if this unit is defined, otherwise
+//define here the types used by the library.
+{$IFDEF BGRABITMAP_USE_LCL}
+  type
+    { Order of the lines in an image }
+    TRawImageLineOrder = GraphType.TRawImageLineOrder;
+    { Order of the bits in a byte containing pixel values }
+    TRawImageBitOrder = GraphType.TRawImageBitOrder;
+    { Order of the bytes in a group of byte containing pixel values }
+    TRawImageByteOrder = GraphType.TRawImageByteOrder;
+    { Definition of a single line 3D bevel }
+    TGraphicsBevelCut = GraphType.TGraphicsBevelCut;
+  const
+    riloTopToBottom = GraphType.riloTopToBottom;   // The first line (line 0) is the top line
+    riloBottomToTop = GraphType.riloBottomToTop;   // The first line (line 0) is the bottom line
+    riboBitsInOrder = GraphType.riboBitsInOrder;   // Bit 0 is pixel 0
+    riboReversedBits = GraphType.riboReversedBits; // Bit 0 is pixel 7 (Bit 1 is pixel 6, ...)
+    riboLSBFirst = GraphType.riboLSBFirst; // least significant byte first (little endian)
+    riboMSBFirst = GraphType.riboMSBFirst; // most significant byte first (big endian)
+    fsSurface = GraphType.fsSurface; //type is defined as Graphics.TFillStyle
+    fsBorder = GraphType.fsBorder;
+    bvNone = GraphType.bvNone;
+    bvLowered = GraphType.bvLowered;
+    bvRaised = GraphType.bvRaised;
+    bvSpace = GraphType.bvSpace;
+{$ELSE}
+  type
+    {* Order of the lines in an image }
+    TRawImageLineOrder = (
+      {** The first line in memory (line 0) is the top line }
+      riloTopToBottom,
+      {** The first line in memory (line 0) is the bottom line }
+      riloBottomToTop);
+    {* Order of the bits in a byte containing pixel values }
+    TRawImageBitOrder = (
+      {** The lowest bit is on the left. So with a monochrome picture, bit 0 would be pixel 0 }
+      riboBitsInOrder,
+      {** The lowest bit is on the right. So with a momochrome picture, bit 0 would be pixel 7 (bit 1 would be pixel 6, ...) }
+      riboReversedBits);
+    {* Order of the bytes in a group of byte containing pixel values }
+    TRawImageByteOrder = (
+      {** Least significant byte first (little endian) }
+      riboLSBFirst,
+      {** most significant byte first (big endian) }
+      riboMSBFirst);
+    {* Definition of a single line 3D bevel }
+    TGraphicsBevelCut =
+    (
+      {** No bevel }
+      bvNone,
+      {** Shape is lowered, light is on the bottom-right corner }
+      bvLowered,
+      {** Shape is raised, light is on the top-left corner }
+      bvRaised,
+      {** Shape is at the same level, there is no particular lighting }
+      bvSpace);
+{$ENDIF}
+{$DEFINE INCLUDE_INTERFACE}
+{$I bgrapixel.inc}
+{$DEFINE INCLUDE_INTERFACE}
+{$I geometrytypes.inc}
+{$DEFINE INCLUDE_INTERFACE}
+{$i csscolorconst.inc}
+{$DEFINE INCLUDE_SCANNER_INTERFACE }
+{$I bgracustombitmap.inc}
+{==== Integer math ====}
+  {* Computes the value modulo cycle, and if the ''value'' is negative, the result
+     is still positive }
+  function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload;
+  { Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
+    They use a table to store already computed values. The return value is an integer
+    ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is
+instead of 1. The input has a period of 65536, so you can supply any integer
+    without applying a modulo. }
+  { Compute all values now }
+  procedure PrecalcSin65536;
+  {* Returns an integer approximation of the sine. Value ranges from 0 to 65535,
+     where 65536 corresponds to the next cycle }
+  function Sin65536(value: word): Int32or64; inline;
+  {* Returns an integer approximation of the cosine. Value ranges from 0 to 65535,
+     where 65536 corresponds to the next cycle }
+  function Cos65536(value: word): Int32or64; inline;
+  {* Returns the square root of the given byte, considering that
+is equal to unity }
+  function ByteSqrt(value: byte): byte; inline;
+{==== Types provided for fonts ====}
+type
+  {* Quality to be used to render text }
+  TBGRAFontQuality = (
+    {** Use the system capabilities. It is rather fast however it may be
+        not be smoothed. }
+    fqSystem,
+    {** Use the system capabilities to render with ClearType. This quality is
+        of course better than fqSystem however it may not be perfect.}
+    fqSystemClearType,
+    {** Garanties a high quality antialiasing. }
+    fqFineAntialiasing,
+    {** Fine antialiasing with ClearType in assuming an LCD display in red/green/blue order }
+    fqFineClearTypeRGB,
+    {** Fine antialiasing with ClearType in assuming an LCD display in blue/green/red order }
+    fqFineClearTypeBGR);
+  {* Measurements of a font }
+  TFontPixelMetric = record
+    {** The values have been computed }
+    Defined: boolean;
+    {** Position of the baseline, where most letters lie }
+    Baseline,
+    {** Position of the top of the small letters (x being one of them) }
+    xLine,
+    {** Position of the top of the UPPERCASE letters }
+    CapLine,
+    {** Position of the bottom of letters like g and p }
+    DescentLine,
+    {** Total line height including line spacing defined by the font }
+    Lineheight: integer;
+  end;
+  {* Vertical anchoring of the font. When text is drawn, a start coordinate
+      is necessary. Text can be positioned in different ways. This enum
+      defines what position it is regarding the font }
+  TFontVerticalAnchor = (
+    {** The top of the font. Everything will be drawn below the start coordinate. }
+    fvaTop,
+    {** The center of the font }
+    fvaCenter,
+    {** The top of capital letters }
+    fvaCapLine,
+    {** The center of capital letters }
+    fvaCapCenter,
+    {** The top of small letters }
+    fvaXLine,
+    {** The center of small letters }
+    fvaXCenter,
+    {** The baseline, the bottom of most letters }
+    fvaBaseline,
+    {** The bottom of letters that go below the baseline }
+    fvaDescentLine,
+    {** The bottom of the font. Everything will be drawn above the start coordinate }
+    fvaBottom);
+  {* Definition of a function that handles work-break }
+  TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object;
+  {* Alignment for a typewriter, that does not have any more information
+     than a square shape containing glyphs }
+  TBGRATypeWriterAlignment = (twaTopLeft, twaTop, twaTopRight, twaLeft, twaMiddle, twaRight, twaBottomLeft, twaBottom, twaBottomRight);
+  {* How a typewriter must render its content on a Canvas2d }
+  TBGRATypeWriterOutlineMode = (twoPath, twoFill, twoStroke, twoFillOverStroke, twoStrokeOverFill, twoFillThenStroke, twoStrokeThenFill);
+  { TBGRACustomFontRenderer }
+  {* Abstract class for all font renderers }
+  TBGRACustomFontRenderer = class
+    {** Specifies the font to use. Unless the font renderer accept otherwise,
+        the name is in human readable form, like 'Arial', 'Times New Roman', ...  }
+    FontName: string;
+    {** 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 }
+    FontStyle: TFontStyles;
+    {** Specifies the quality of rendering. Default value is fqSystem }
+    FontQuality : TBGRAFontQuality;
+    {** Specifies the rotation of the text, for functions that support text rotation.
+        It is expressed in tenth of degrees, positive values going counter-clockwise }
+    FontOrientation: 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 }
+    FontEmHeight: integer;
+    {** 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;
+    {** 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; 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'' 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;
+    {** Same as above except a ''texture'' is used to fill the text }
+    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;
+  {* Output mode for the improved renderer for readability. This is used by the font renderer based on LCL in ''BGRAText'' }
+  TBGRATextOutImproveReadabilityMode = (irMask, irNormal, irClearTypeRGB, irClearTypeBGR);
+{** Removes line ending and tab characters from a string (for a function
+    like ''TextOut'' that does not handle this). this works with UTF8 strings
+    as well }
+function CleanTextOutString(s: string): string;
+{** Remove the line ending at the specified position or return False.
+    This works with UTF8 strings however the index is the byte index }
+function RemoveLineEnding(var s: string; indexByte: integer): boolean;
+{** Remove the line ending at the specified position or return False.
+    The index is the character index, that may be different from the
+    byte index }
+function RemoveLineEndingUTF8(var sUTF8: string; indexUTF8: integer): boolean;
+{** Default word break handler, that simply divide when there is a space }
+procedure BGRADefaultWordBreakHandler(var ABefore, AAfter: string);
+{==== Images and resampling ====}
+type
+  {* How the resample is to be computed }
+  TResampleMode = (
+    {** Low quality resample by repeating pixels, stretching them }
+    rmSimpleStretch,
+    {** Use resample filters. This gives high
+        quality resampling however this the proportion changes slightly because
+        the first and last pixel are considered to occupy only half a unit as
+        they are considered as the border of the picture
+        (pixel-centered coordinates) }
+    rmFineResample);
+  {* List of resample filter to be used with ''rmFineResample'' }
+  TResampleFilter = (
+    {** Equivalent of simple stretch with high quality and pixel-centered coordinates }
+    rfBox,
+    {** Linear interpolation giving slow transition between pixels }
+    rfLinear,
+    {** Mix of ''rfLinear'' and ''rfCosine'' giving medium speed stransition between pixels }
+    rfHalfCosine,
+    {** Cosine-like interpolation giving fast transition between pixels }
+    rfCosine,
+    {** Simple bi-cubic filter (blurry) }
+    rfBicubic,
+    {** Mitchell filter, good for downsizing interpolation }
+    rfMitchell,
+    {** Spline filter, good for upsizing interpolation, however slightly blurry }
+    rfSpline,
+    {** Lanczos with radius 2, blur is corrected }
+    rfLanczos2,
+    {** Lanczos with radius 3, high contrast }
+    rfLanczos3,
+    {** Lanczos with radius 4, high contrast }
+    rfLanczos4,
+    {** Best quality using rfMitchell or rfSpline }
+    rfBestQuality);
+const
+  {** List of strings to represent resample filters }
   ResampleFilterStr : array[TResampleFilter] of string =
    ('Box','Linear','HalfCosine','Cosine','Bicubic','Mitchell','Spline',
     'Lanczos2','Lanczos3','Lanczos4','BestQuality');
+function StrToResampleFilter(str: string): TResampleFilter;
+  {** Gives the sample filter represented by a string }
+  function StrToResampleFilter(str: string): TResampleFilter;
 type
+  TBGRAImageFormat = (ifUnknown, ifJpeg, ifPng, ifGif, ifBmp, ifIco, ifPcx, ifPaintDotNet, ifLazPaint, ifOpenRaster,
+    ifPsd, ifTarga, ifTiff, ifXwd, ifXPixMap, ifBmpMioMap);
+  {* List of image formats }
+  TBGRAImageFormat = (
+    {** Unknown format }
+    ifUnknown,
+    {** JPEG format, opaque, lossy compression }
+    ifJpeg,
+    {** PNG format, transparency, lossless compression }
+    ifPng,
+    {** GIF format, single transparent color, lossless in theory but only low number of colors allowed }
+    ifGif,
+    {** BMP format, transparency, no compression. Note that transparency is
+        not supported by all BMP readers so it is not recommended to avoid
+        storing images with transparency in this format }
+    ifBmp,
+    {** ICO format, contains different sizes of the same image }
+    ifIco,
+    {** PCX format, opaque, rudimentary lossless compression }
+    ifPcx,
+    {** Paint.NET format, layers, lossless compression }
+    ifPaintDotNet,
+    {** LazPaint format, layers, lossless compression }
+    ifLazPaint,
+    {** OpenRaster format, layers, lossless compression }
+    ifOpenRaster,
+    {** Phoxo format, layers }
+    ifPhoxo,
+    {** Photoshop format, layers, rudimentary lossless compression }
+    ifPsd,
+    {** Targa format (TGA), transparency, rudimentary lossless compression }
+    ifTarga,
+    {** TIFF format, limited support }
+    ifTiff,
+    {** X-Window capture, limited support }
+    ifXwd,
+    {** X-Pixmap, text encoded image, limited support }
+    ifXPixMap,
+    {** iGO BMP, limited support }
+    ifBmpMioMap);
+  {* Options when loading an image }
+  TBGRALoadingOption = (
+     {** Do not clear RGB channels when alpha is zero (not recommended) }
+     loKeepTransparentRGB,
+     {** Consider BMP to be opaque if no alpha value is provided (for compatibility) }
+     loBmpAutoOpaque,
+     {** Load JPEG quickly however with a lower quality }
+     loJpegQuick);
+  TBGRALoadingOptions = set of TBGRALoadingOption;
 var
+  {** List of stream readers for images }
   DefaultBGRAImageReader: array[TBGRAImageFormat] of TFPCustomImageReaderClass;
+  {** List of stream writers for images }
   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, 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/ }
+  TBlendOperation = (boLinearBlend, boTransparent,                                  //blending
+    boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boDivide, boNiceGlow, boSoftLight, boHardLight, //lighting
+    boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn, //masking
+    boDifference, boLinearDifference, boExclusion, boLinearExclusion, boSubtract, boLinearSubtract, boSubtractInverse, boLinearSubtractInverse,
+    boNegation, boLinearNegation, boXor);         //negative
+const
+  boGlowMask = boGlow;
+  boLinearMultiply = boMultiply;
+  boNonLinearOverlay = boDarkOverlay;
+  EmptyRect : TRect = (left:0; top:0; right:0; bottom: 0);
+const
+  BlendOperationStr : array[TBlendOperation] of string =
+   ('LinearBlend', 'Transparent',
+    'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'Divide', 'NiceGlow', 'SoftLight', 'HardLight',
+    'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn',
+    'Difference', 'LinearDifference', 'Exclusion', 'LinearExclusion', 'Subtract', 'LinearSubtract', 'SubtractInverse', 'LinearSubtractInverse',
+    'Negation', 'LinearNegation', 'Xor');
+function StrToBlendOperation(str: string): TBlendOperation;
+type
+  TGradientType = (gtLinear, gtReflected, gtDiamond, gtRadial);
+const
+  GradientTypeStr : array[TGradientType] of string =
+  ('Linear','Reflected','Diamond','Radial');
+function StrToGradientType(str: string): TGradientType;
+type
+  { A pen style is defined as a list of floating number. The first number is the length of the first dash,
+    the second number is the length of the first gap, the third number is the length of the second dash...
+    It must have an even number of values. }
+  TBGRAPenStyle = Array Of Single;
+  TRoundRectangleOption = (rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare,
+                           rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel,rrDefault);
+  TRoundRectangleOptions = set of TRoundRectangleOption;
+  TPolygonOrder = (poNone, poFirstOnTop, poLastOnTop); //see TBGRAMultiShapeFiller in BGRAPolygon
+function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle;
+{ Point, polygon and curve structures }
+type
+  PPointF = ^TPointF;
+  TPointF = packed record
+    x, y: single;
+  end;
+  ArrayOfTPointF = array of TPointF;
+  TArcOption = (aoClosePath, aoPie, aoFillPath);
+  TArcOptions = set of TArcOption;
+  TCubicBezierCurve = record
+    p1,c1,c2,p2: TPointF;
+  end;
+  TQuadraticBezierCurve = record
+    p1,c,p2: TPointF;
+  end;
+  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,
+                              twaLeft, twaMiddle, twaRight,
+                              twaBottomLeft, twaBottom, twaBottomRight);
+  TBGRATypeWriterOutlineMode = (twoPath, twoFill, twoStroke, twoFillOverStroke, twoStrokeOverFill, twoFillThenStroke, twoStrokeThenFill);
+function ConcatPointsF(const APolylines: array of ArrayOfTPointF): ArrayOfTPointF;
+function Point3D(x,y,z: single): TPoint3D;
+operator = (const v1,v2: TPoint3D): boolean; inline;
+operator * (const v1,v2: TPoint3D): single; inline;
+operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
+operator - (const v1,v2: TPoint3D): TPoint3D; inline;
+operator - (const v: TPoint3D): TPoint3D; inline;
+operator + (const v1,v2: TPoint3D): TPoint3D; inline;
+procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
+procedure Normalize3D(var v: TPoint3D); inline;
+function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
+function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
+function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload;
+function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef;
+{ Useful constants }
+const
+  dmFastBlend = dmLinearBlend;
+  EmptySingle: single = -3.402823e38;                        //used as a separator in floating point lists
+  EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38); //used as a separator in TPointF lists
+  BGRAPixelTransparent: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 0);
+  BGRAWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
+  BGRABlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
+  { This color is needed for drawing black shapes on the standard TCanvas, because
+    when drawing with pure black, there is no way to know if something has been
+    drawn or if it is transparent }
+  clBlackOpaque = TColor($010000);
+{$DEFINE INCLUDE_COLOR_CONST}
+{$i csscolorconst.inc}
+type
+  TBGRAColorDefinition = record
+    Name: string;
+    Color: TBGRAPixel;
+  end;
+  { TBGRAColorList }
+  TBGRAColorList = class
+  protected
+    FFinished: boolean;
+    FNbColors: integer;
+    FColors: array of TBGRAColorDefinition;
+    function GetByIndex(Index: integer): TBGRAPixel;
+    function GetByName(Name: string): TBGRAPixel;
+    function GetName(Index: integer): string;
+  public
+    constructor Create;
+    procedure Add(Name: string; 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;
+    property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default;
+    property Name[Index: integer]: string read GetName;
+    property Count: integer read FNbColors;
+  end;
+var
+  VGAColors, CSSColors: TBGRAColorList;
+function isEmptyPointF(pt: TPointF): boolean;
+type
+  TFontPixelMetric = record
+    Defined: boolean;
+    Baseline, xLine, CapLine, DescentLine, Lineheight: integer;
+  end;
+  { A scanner is like an image, but its content has no limit and can be calculated on the fly.
+    It must not implement reference counting. }
+  IBGRAScanner = interface
+    procedure ScanMoveTo(X,Y: Integer);
+    function ScanNextPixel: TBGRAPixel;
+    function ScanAt(X,Y: Single): TBGRAPixel;
+    function ScanAtInteger(X,Y: integer): TBGRAPixel;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode);
+    function IsScanPutPixelsDefined: 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 }
+  TBGRACustomBitmap = class(TFPCustomImage,IBGRAScanner) // a bitmap can be used as a scanner
+  private
+    function GetFontAntialias: Boolean;
+    procedure SetFontAntialias(const AValue: Boolean);
+  protected
+     { accessors to properies }
+     function 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;
+     function GetDataPtr: PBGRAPixel; virtual; abstract;
+     function GetNbPixels: integer; virtual; abstract;
+     function CheckEmpty: boolean; virtual; abstract;
+     function GetHasTransparentPixels: boolean; virtual; abstract;
+     function GetAverageColor: TColor; virtual; abstract;
+     function GetAveragePixel: TBGRAPixel; virtual; abstract;
+     procedure SetCanvasOpacity(AValue: byte); virtual; abstract;
+     function GetScanLine(y: integer): PBGRAPixel; virtual; abstract;
+     function GetRefCount: integer; virtual; abstract;
+     function GetBitmap: TBitmap; virtual; abstract;
+     function GetLineOrder: TRawImageLineOrder; virtual; abstract;
+     function GetCanvasFP: TFPImageCanvas; virtual; abstract;
+     function GetCanvasDrawModeFP: TDrawMode; virtual; abstract;
+     procedure SetCanvasDrawModeFP(const AValue: TDrawMode); virtual; abstract;
+     function GetCanvas: TCanvas; virtual; abstract;
+     function GetCanvasOpacity: byte; virtual; abstract;
+     function GetCanvasAlphaCorrection: boolean; virtual; abstract;
+     procedure SetCanvasAlphaCorrection(const AValue: boolean); virtual; abstract;
+     function GetFontHeight: integer; virtual; abstract;
+     procedure SetFontHeight(AHeight: integer); virtual; abstract;
+     function GetFontFullHeight: integer; virtual; abstract;
+     procedure SetFontFullHeight(AHeight: integer); virtual; abstract;
+     function GetPenStyle: TPenStyle; virtual; abstract;
+     procedure SetPenStyle(const AValue: TPenStyle); virtual; abstract;
+     function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract;
+     procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); virtual; abstract;
+     function GetClipRect: TRect; virtual; abstract;
+     procedure SetClipRect(const AValue: TRect); virtual; abstract;
+     function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
+     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;              //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
+     JoinStyle: TPenJoinStyle;
+     JoinMiterLimit: single;
+     FillMode:  TFillMode;  //winding or alternate
+     LinearAntialiasing: boolean;
+     { The resample filter is used when resizing the bitmap, and
+       scan interpolation filter is used when the bitmap is used
+       as a scanner (IBGRAScanner) }
+     ResampleFilter,
+     ScanInterpolationFilter: TResampleFilter;
+     ScanOffset: TPoint;
+     constructor Create; virtual; abstract; overload;
+     constructor Create(ABitmap: TBitmap); virtual; abstract; overload;
+     constructor Create(AWidth, AHeight: integer; Color: TColor); virtual; abstract; overload;
+     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); virtual; abstract; overload;
+     constructor Create(AFilename: string); virtual; abstract; overload;
+     constructor Create(AFilename: string; AIsUtf8Filename: boolean); virtual; abstract; overload;
+     constructor Create(AStream: TStream); virtual; abstract; overload;
+     function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; virtual; abstract; overload;
+     function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; virtual; abstract; overload;
+     function NewBitmap(Filename: string): TBGRACustomBitmap; virtual; abstract; overload;
+     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 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 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;
+     procedure Deserialize(AStream: TStream); virtual; abstract;
+     {Pixel functions}
+     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: 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 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: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure 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; c: TBGRAPixel; w: single); virtual; abstract; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure 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: integer; alpha: byte; DrawLastPixel: boolean); virtual; abstract; overload;
+     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); virtual; abstract; overload;
+     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); virtual; abstract; overload;
+     procedure 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 FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
+     procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); virtual; abstract; overload;
+     procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
+     procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
+     procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);  virtual; abstract; overload;
+     procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
+     procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
+     procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
+     procedure 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 FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); virtual; abstract; overload;
+     procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); virtual; abstract; overload;
+     procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); virtual; abstract; overload;
+     procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); virtual; abstract; overload;
+     procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode); virtual; abstract;
+     procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode); virtual; abstract;
+     procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel); virtual; abstract;
+     procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner); virtual; abstract;
+     procedure ErasePoly(const points: array of TPointF; alpha: byte); virtual; abstract;
+     procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); virtual; abstract;
+     procedure 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 EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); virtual; abstract;
+     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract;
+     procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); virtual; abstract;
+     procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); virtual; abstract;
+     procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); virtual; abstract;
+     procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); virtual; abstract;
+     procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
+     procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
+     procedure Rectangle(x, y, x2, y2: integer; c: TColor); virtual; overload;
+     procedure Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
+     procedure Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual;overload;
+     procedure Rectangle(r: TRect; c: TColor); virtual; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single); virtual; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract; overload;
+     procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
+     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel; 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; overload;
+     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); virtual; abstract;
+     procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); virtual; abstract;
+     procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); virtual; abstract;
+     procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); virtual; abstract;
+     procedure TextOut(x, y: 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}
+     function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
+     function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
+     function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; virtual; abstract;
+     function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
+     function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; deprecated;
+     function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; deprecated;
+     function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; virtual; abstract;
+     {Filling}
+     procedure FillTransparent; virtual;
+     procedure NoClip; virtual; abstract;
+     procedure ApplyGlobalOpacity(alpha: byte); virtual; abstract;
+     procedure Fill(c: TColor); virtual; overload;
+     procedure Fill(c: TBGRAPixel); virtual; overload;
+     procedure Fill(texture: IBGRAScanner; mode: TDrawMode); virtual; abstract; overload;
+     procedure Fill(texture: IBGRAScanner); virtual; abstract; overload;
+     procedure Fill(c: TBGRAPixel; start, Count: integer); virtual; abstract; overload;
+     procedure DrawPixels(c: TBGRAPixel; start, Count: integer); virtual; abstract;
+     procedure AlphaFill(alpha: byte); virtual; overload;
+     procedure AlphaFill(alpha: byte; start, Count: integer); virtual; abstract; overload;
+     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; 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;
+     procedure ReplaceColor(before, after: TColor); virtual; abstract; overload;
+     procedure ReplaceColor(before, after: TBGRAPixel); virtual; abstract; overload;
+     procedure ReplaceTransparent(after: TBGRAPixel); virtual; abstract; overload;
+     procedure FloodFill(X, Y: integer; Color: TBGRAPixel;
+       mode: TFloodfillMode; Tolerance: byte = 0); virtual;
+     procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
+       mode: TFloodfillMode; Tolerance: byte = 0); virtual; abstract;
+     procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
+       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+       gammaColorCorrection: boolean = True; Sinus: Boolean=False); virtual; abstract;
+     procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
+       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+       Sinus: Boolean=False); virtual; abstract;
+     function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
+                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; virtual; abstract;
+     {Canvas drawing functions}
+     procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+       AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
+     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
+     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual; abstract;
+     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); virtual; abstract;
+     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); virtual; abstract;
+     procedure DrawPart(ARect: TRect; Canvas: TCanvas; x, y: integer; Opaque: boolean); virtual;
+     function GetPart(ARect: TRect): TBGRACustomBitmap; virtual; abstract;
+     function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; virtual; abstract;
+     procedure InvalidateBitmap; virtual; abstract;         //call if you modify with Scanline
+     procedure LoadFromBitmapIfNeeded; virtual; abstract;   //call to ensure that bitmap data is up to date
+     {BGRA bitmap functions}
+     procedure 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; 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;
+         ALinearBlend: boolean = false); virtual; abstract;
+     function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; virtual; abstract;
+     function Equals(comp: TBGRACustomBitmap): boolean; virtual; abstract;
+     function Equals(comp: TBGRAPixel): boolean; virtual; abstract;
+     function Resample(newWidth, newHeight: integer;
+       mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract;
+     procedure VerticalFlip; virtual; 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 SwapRedBlue; virtual; abstract;
+     procedure GrayscaleToAlpha; virtual; abstract;
+     procedure AlphaToGrayscale; 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; ANothingValue: Byte = 0): TRect; virtual; abstract;
+     function GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect; virtual; abstract;
+     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract;
+     {Filters}
+     function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
+     function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
+     function FilterSmooth: TBGRACustomBitmap; virtual; abstract;
+     function FilterSharpen(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 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 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 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 AverageColor: TColor Read GetAverageColor;
+     property AveragePixel: TBGRAPixel Read GetAveragePixel;
+     property CanvasFP: TFPImageCanvas read GetCanvasFP;
+     property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP;
+     property Canvas: TCanvas Read GetCanvas;
+     property CanvasOpacity: byte Read GetCanvasOpacity Write SetCanvasOpacity;
+     property CanvasAlphaCorrection: boolean
+       Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
+     property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle;
+     property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle;
+     property ClipRect: TRect read GetClipRect write SetClipRect;
+     { 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 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
+     function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual; abstract;
+     procedure ScanMoveTo(X,Y: Integer); virtual; abstract;
+     function ScanNextPixel: TBGRAPixel; virtual; abstract;
+     function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
+     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
+     function IsScanPutPixelsDefined: boolean; virtual;
+  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;
+  { TBGRACustomScanner }
+  TBGRACustomScanner = class(IBGRAScanner)
+  private
+    FCurX,FCurY: integer;
+  public
+    function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual;
+    procedure ScanMoveTo(X,Y: Integer); virtual;
+    function ScanNextPixel: TBGRAPixel; virtual;
+    function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
+    function IsScanPutPixelsDefined: boolean; virtual;
+  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;
+  { TBGRACustomGradient }
+  TBGRACustomGradient = class
+  public
+    function GetColorAt(position: integer): TBGRAPixel; virtual; abstract;
+    function GetColorAtF(position: single): TBGRAPixel; virtual;
+    function GetAverageColor: TBGRAPixel; virtual; abstract;
+    function GetMonochrome: boolean; virtual; abstract;
+    property Monochrome: boolean read GetMonochrome;
+  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(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: Int32or64): Int32or64;
+function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
+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 HueDiff(h1, h2: word): word;
+function GetHue(ec: TExpandedPixel): word;
+function ColorImportance(ec: TExpandedPixel): word;
+function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
+function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
+function GSBAToHSLA(c: TGSBAPixel): THSLAPixel;
+function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
+function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline;
+function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline;
+function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
+function GrayscaleToBGRA(lightness: word): TBGRAPixel;
+function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; overload;
+function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; weight2: byte): TBGRAPixel;
+function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload;
+function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload;
+function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload;
+function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline;
+function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline;
+function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; overload; inline;
+function HSLA(hue, saturation, lightness: word): THSLAPixel; overload; inline;
+function ColorToBGRA(color: TColor): TBGRAPixel; overload;
+function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload;
+function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
+function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
+function BGRAToColor(c: TBGRAPixel): TColor;
+operator = (const c1, c2: TBGRAPixel): boolean; inline;
+function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
+function BGRAWordDiff(c1, c2: TBGRAPixel): word;
+function BGRADiff(c1, c2: TBGRAPixel): byte;
+operator - (const c1, c2: TColorF): TColorF; inline;
+operator + (const c1, c2: TColorF): TColorF; inline;
+operator * (const c1, c2: TColorF): TColorF; inline;
+operator * (const c1: TColorF; factor: single): TColorF; inline;
+function ColorF(red,green,blue,alpha: single): TColorF;
+function BGRAToStr(c: TBGRAPixel; 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 }
+function MapHeight(Color: TBGRAPixel): Single;
+{ Get TBGRAPixel to store height [0..1] }
+function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
+{ Gamma conversion arrays. Should be used as readonly }
+var
+  // TBGRAPixel -> TExpandedPixel
+  GammaExpansionTab:   packed array[0..255] of word;
+  // TExpandedPixel -> TBGRAPixel
+  GammaCompressionTab: packed array[0..65535] of byte;
+{ Point functions }
+function PointF(x, y: single): TPointF;
+function PointsF(const pts: array of TPointF): ArrayOfTPointF;
+operator = (const pt1, pt2: TPointF): boolean; inline;
+operator - (const pt1, pt2: TPointF): TPointF; inline;
+operator - (const pt2: TPointF): TPointF; inline;
+operator + (const pt1, pt2: TPointF): TPointF; inline;
+operator * (const pt1, pt2: TPointF): single; inline; //scalar product
+operator * (const pt1: TPointF; factor: single): TPointF; inline;
+operator * (factor: single; const pt1: TPointF): TPointF; inline;
+function PtInRect(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;
+{ Line and polygon functions }
+type
+    TLineDef = record
+       origin, dir: TPointF;
+    end;
+function IntersectLine(line1, line2: TLineDef): TPointF;
+function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
+function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
+function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
+{ Cyclic functions }
+function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload;
+{ Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
+  They use a table to store already computed values. The return value is an integer
+  ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is
+instead of 1. The input has a period of 65536, so you can supply any integer
+  without applying a modulo. }
+procedure PrecalcSin65536; // compute all values now
+function Sin65536(value: word): 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;
+  {** Detect the file format of a given file }
+  function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat;
+  {** Detect the file format of a given stream. ''ASuggestedExtensionUTF8'' can
+      be provided to guess the format }
+  function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string = ''): TBGRAImageFormat;
+  {** Returns the file format that is most likely to be stored in the
+      given filename (according to its extension) }
+  function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
+  {** Returns a likely image extension for the format }
+  function SuggestImageExtension(AFormat: TBGRAImageFormat): string;
+  {** Create an image reader for the given format }
+  function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader;
+  {** Create an image writer for the given format. ''AHasTransparentPixels''
+      specifies if alpha channel must be supported }
+  function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter;
+{$DEFINE INCLUDE_INTERFACE}
+{$I bgracustombitmap.inc}
 implementation
 uses Math, SysUtils, FileUtil, lazutf8classes, LCLProc,
+uses Math, SysUtils, BGRAUTF8,
   FPReadTiff, FPReadXwd, FPReadXPM,
   FPWriteTiff, FPWriteJPEG, FPWritePNG, FPWriteBMP, FPWritePCX,
+  FPWriteTiff, FPWriteJPEG, BGRAWritePNG, FPWriteBMP, FPWritePCX,
   FPWriteTGA, FPWriteXPM;
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$I geometrytypes.inc}
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$I csscolorconst.inc}
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$I bgracustombitmap.inc}
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$I bgrapixel.inc}
+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
+          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 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 StrToResampleFilter(str: string): TResampleFilter;
 …
 end;
-function StrToBlendOperation(str: string): TBlendOperation;
-var op: TBlendOperation;
-begin
-  result := boTransparent;
-  str := LowerCase(str);
-  for op := low(TBlendOperation) to high(TBlendOperation) do
-    if str = LowerCase(BlendOperationStr[op]) then
-    begin
-      result := op;
-      exit;
-    end;
-end;
-function StrToGradientType(str: string): TGradientType;
-var gt: TGradientType;
-begin
-  result := gtLinear;
-  str := LowerCase(str);
-  for gt := low(TGradientType) to high(TGradientType) do
-    if str = LowerCase(GradientTypeStr[gt]) then
-    begin
-      result := gt;
-      exit;
-    end;
-end;
-{ Make a pen style. Need an even number of values. See TBGRAPenStyle }
-function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single;
-  dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle;
-var
-  i: Integer;
-begin
-  if dash4 <> 0 then
-  begin
-    setlength(result,8);
-    result[6] := dash4;
-    result[7] := space4;
-    result[4] := dash3;
-    result[5] := space3;
-    result[2] := dash2;
-    result[3] := space2;
-  end else
-  if dash3 <> 0 then
-  begin
-    setlength(result,6);
-    result[4] := dash3;
-    result[5] := space3;
-    result[2] := dash2;
-    result[3] := space2;
-  end else
-  if dash2 <> 0 then
-  begin
-    setlength(result,4);
-    result[2] := dash2;
-    result[3] := space2;
-  end else
-  begin
-    setlength(result,2);
-  end;
-  result[0] := dash1;
-  result[1] := space1;
-  for i := 0 to high(result) do
-    if result[i]=0 then
-      raise exception.Create('Zero is not a valid value');
-end;
-{ Bézier curves definitions. See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve }
-function ConcatPointsF(const APolylines: array of ArrayOfTPointF
-  ): ArrayOfTPointF;
-var
-  i,pos,count:integer;
-  j: Integer;
-begin
-  count := 0;
-  for i := 0 to high(APolylines) do
-    inc(count,length(APolylines[i]));
-  setlength(result,count);
-  pos := 0;
-  for i := 0 to high(APolylines) do
-    for j := 0 to high(APolylines[i]) do
-    begin
-      result[pos] := APolylines[i][j];
-      inc(pos);
-    end;
-end;
-operator-(const v: TPoint3D): TPoint3D;
-begin
-  result.x := -v.x;
-  result.y := -v.y;
-  result.z := -v.z;
-end;
-operator + (const v1,v2: TPoint3D): TPoint3D; inline;
-begin
-  result.x := v1.x+v2.x;
-  result.y := v1.y+v2.y;
-  result.z := v1.z+v2.z;
-end;
-operator - (const v1,v2: TPoint3D): TPoint3D; inline;
-begin
-  result.x := v1.x-v2.x;
-  result.y := v1.y-v2.y;
-  result.z := v1.z-v2.z;
-end;
-operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
-begin
-  result.x := v1.x*factor;
-  result.y := v1.y*factor;
-  result.z := v1.z*factor;
-end;
-function Point3D(x, y, z: single): TPoint3D;
-begin
-  result.x := x;
-  result.y := y;
-  result.z := z;
-end;
-operator=(const v1, v2: TPoint3D): boolean;
-begin
-  result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z);
-end;
-operator * (const v1,v2: TPoint3D): single; inline;
-begin
-  result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
-end;
-procedure Normalize3D(var v: TPoint3D); inline;
-var len: double;
-begin
-  len := v*v;
-  if len = 0 then exit;
-  len := sqrt(len);
-  v.x /= len;
-  v.y /= len;
-  v.z /= len;
-end;
-procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
-begin
-  w.x := u.y*v.z-u.z*v.y;
-  w.y := u.z*v.x-u.x*v.z;
-  w.z := u.x*v.Y-u.y*v.x;
-end;
-// Define a Bézier curve with two control points.
-function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve;
-begin
-  result.p1 := origin;
-  result.c1 := control1;
-  result.c2 := control2;
-  result.p2 := destination;
-end;
-// Define a Bézier curve with one control point.
-function BezierCurve(origin, control, destination: TPointF
-  ): TQuadraticBezierCurve;
-begin
-  result.p1 := origin;
-  result.c := control;
-  result.p2 := destination;
-end;
-//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;
+{ TBGRACustomGradient }
+function TBGRACustomGradient.GetColorAtF(position: single): TBGRAPixel;
+begin
+  position *= 65536;
+  if position < low(integer) then
+    result := GetColorAt(low(Integer))
+  else if position > high(integer) then
+    result := GetColorAt(high(Integer))
+  else
+    result := GetColorAt(round(position));
+end;
+{ TBGRAColorList }
+function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[Index].Color;
+end;
+function TBGRAColorList.GetByName(Name: string): TBGRAPixel;
+var i: integer;
+begin
+  i := IndexOf(Name);
+  if i = -1 then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[i].Color;
+end;
+function TBGRAColorList.GetName(Index: integer): string;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := ''
+  else
+    result := FColors[Index].Name;
+end;
+constructor TBGRAColorList.Create;
+begin
+  FNbColors:= 0;
+  FColors := nil;
+  FFinished:= false;
+end;
+procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel);
+begin
+  if FFinished then
+    raise Exception.Create('This list is already finished');
+  if length(FColors) = FNbColors then
+    SetLength(FColors, FNbColors*2+1);
+  FColors[FNbColors].Name := Name;
+  FColors[FNbColors].Color := Color;
+  inc(FNbColors);
+end;
+procedure TBGRAColorList.Finished;
+begin
+  if FFinished then exit;
+  FFinished := true;
+  SetLength(FColors, FNbColors);
+end;
+function TBGRAColorList.IndexOf(Name: string): integer;
+var i: integer;
+begin
+  for i := 0 to FNbColors-1 do
+    if CompareText(Name, FColors[i].Name) = 0 then
+    begin
+      result := i;
+      exit;
+    end;
+  result := -1;
+end;
+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 }
+function TBGRACustomBitmap.GetFontAntialias: Boolean;
+begin
+  result := FontQuality <> fqSystem;
+end;
+procedure TBGRACustomBitmap.SetFontAntialias(const AValue: Boolean);
+begin
+  if AValue and not FontAntialias then
+    FontQuality := fqFineAntialiasing
+  else if not AValue and (FontQuality <> fqSystem) then
+    FontQuality := fqSystem;
+end;
+{ These declaration make sure that these methods are virtual }
+procedure TBGRACustomBitmap.LoadFromFile(const filename: string);
+begin
+  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
+  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;
+procedure TBGRACustomBitmap.SaveToFile(const filename: string;
+  Handler: TFPCustomImageWriter);
+begin
+  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;
+{ LoadFromStream uses TFPCustomImage routine, which uses
+  Colors property to access pixels. That's why the
+  FP drawing mode is temporarily changed to load
+  bitmaps properly }
+procedure TBGRACustomBitmap.LoadFromStream(Str: TStream;
+  Handler: TFPCustomImageReader);
+var
+  OldDrawMode: TDrawMode;
+begin
+  OldDrawMode := CanvasDrawModeFP;
+  CanvasDrawModeFP := dmSet;
+  try
+    inherited LoadFromStream(Str, Handler);
+  finally
+    CanvasDrawModeFP := OldDrawMode;
+  end;
+end;
+{ Look for a pixel considering the bitmap is repeated in both directions }
+function TBGRACustomBitmap.GetPixelCycle(x, y: int32or64): TBGRAPixel;
+begin
+  if (Width = 0) or (Height = 0) then
+    Result := BGRAPixelTransparent
+  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;
+{ Pixel polylines are constructed by concatenation }
+procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint;
+  c: TBGRAPixel; DrawLastPixel: boolean);
+var i: integer;
+begin
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,true);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1));
+end;
+procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint; c1,
+  c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
+var i: integer;
+  DashPos: integer;
+begin
+   DashPos := 0;
+   if length(points) = 1 then
+   begin
+     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c1);
+   end
+   else
+     for i := 0 to high(points)-1 do
+       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c1,c2,dashLen,DrawLastPixel and (i=high(points)-1),DashPos);
+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);
+begin
+  Rectangle(x, y, x2, y2, ColorToBGRA(c), dmSet);
+end;
+procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode
+  );
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, c, mode);
+end;
+procedure TBGRACustomBitmap.Rectangle(r: TRect; BorderColor,
+  FillColor: TBGRAPixel; mode: TDrawMode);
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, BorderColor, FillColor, mode);
+end;
+procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TColor);
+begin
+  Rectangle(r.left, r.top, r.right, r.bottom, c);
+end;
+procedure TBGRACustomBitmap.RectangleAntialias(x, y, x2, y2: single;
+  c: TBGRAPixel; w: single);
+begin
+  RectangleAntialias(x, y, x2, y2, c, w, BGRAPixelTransparent);
+end;
+procedure TBGRACustomBitmap.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
+  FillRect(r.Left, r.top, r.right, r.bottom, c);
+end;
+procedure TBGRACustomBitmap.FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
+begin
+  FillRect(r.Left, r.top, r.right, r.bottom, c, mode);
+end;
+procedure TBGRACustomBitmap.FillRect(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
+  FillRect(x, y, x2, y2, ColorToBGRA(c), dmSet);
+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: 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, 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: TTextStyle;
+begin
+  {$hints off}
+  FillChar(style,sizeof(style),0);
+  {$hints on}
+  style.Alignment := halign;
+  style.Layout := valign;
+  style.Wordbreak := true;
+  style.ShowPrefix := false;
+  style.Clipping := false;
+  TextRect(ARect,ARect.Left,ARect.Top,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: TTextStyle;
+begin
+  {$hints off}
+  FillChar(style,sizeof(style),0);
+  {$hints on}
+  style.Alignment := halign;
+  style.Layout := valign;
+  style.Wordbreak := true;
+  style.ShowPrefix := false;
+  style.Clipping := false;
+  TextRect(ARect,ARect.Left,ARect.Top,sUTF8,style,texture);
+end;
+function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry: single): ArrayOfTPointF;
+begin
+  result := ComputeEllipseContour(x,y,rx,ry);
+end;
+function TBGRACustomBitmap.ComputeEllipse(x, y, rx, ry, w: single
+  ): ArrayOfTPointF;
+begin
+  result := ComputeEllipseBorder(x,y,rx,ry,w);
+end;
+procedure TBGRACustomBitmap.FillTransparent;
+begin
+  Fill(BGRAPixelTransparent);
+end;
+procedure TBGRACustomBitmap.Fill(c: TColor);
+begin
+  Fill(ColorToBGRA(c));
+end;
+procedure TBGRACustomBitmap.Fill(c: TBGRAPixel);
+begin
+  Fill(c, 0, NbPixels);
+end;
+procedure TBGRACustomBitmap.AlphaFill(alpha: byte);
+begin
+  AlphaFill(alpha, 0, NbPixels);
+end;
+procedure TBGRACustomBitmap.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;
+procedure TBGRACustomBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel;
+  mode: TFloodfillMode; Tolerance: byte);
+begin
+  ParallelFloodFill(X,Y,Self,Color,mode,Tolerance);
+end;
+procedure TBGRACustomBitmap.DrawPart(ARect: TRect; Canvas: TCanvas; x,
+  y: integer; Opaque: boolean);
+var
+  partial: TBGRACustomBitmap;
+begin
+  partial := GetPart(ARect);
+  if partial <> nil then
+  begin
+    partial.Draw(Canvas, x, y, Opaque);
+    partial.Free;
+  end;
+end;
+procedure TBGRACustomBitmap.PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
+begin
+  PutImageAngle(x,y,source,0);
+end;
+procedure TBGRACustomBitmap.PutImagePart(x, y: integer;
+  Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte);
+var w,h,sourcex,sourcey,nx,ny,xb,yb,destx,desty: integer;
+    oldClip,newClip: TRect;
+begin
+  if (Source = nil) or (AOpacity = 0) then exit;
+  w := SourceRect.Right-SourceRect.Left;
+  h := SourceRect.Bottom-SourceRect.Top;
+  if (w <= 0) or (h <= 0) or (Source.Width = 0) or (Source.Height = 0) then exit;
+  sourcex := PositiveMod(SourceRect.Left, Source.Width);
+  sourcey := PositiveMod(SourceRect.Top, Source.Height);
+  nx := (sourceX+w + Source.Width-1) div Source.Width;
+  ny := (sourceY+h + Source.Height-1) div Source.Height;
+  oldClip := ClipRect;
+  newClip := rect(x,y,x+w,y+h);
+  if not IntersectRect(newClip,newClip,oldClip) then exit;
+  ClipRect := newClip;
+  desty := y-sourcey;
+  for yb := 0 to ny-1 do
+  begin
+    destx := x-sourcex;
+    for xb := 0 to nx-1 do
+    begin
+      self.PutImage(destx,desty,Source,mode,AOpacity);
+      inc(destx,Source.Width);
+    end;
+    inc(desty,Source.Height);
+  end;
+  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;
+{ Interface gateway }
+function TBGRACustomBitmap.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  if GetInterface(iid, obj) then
+    Result := S_OK
+  else
+    Result := longint(E_NOINTERFACE);
+end;
+{ There is no automatic reference counting, but it is compulsory to define these functions }
+function TBGRACustomBitmap._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+function TBGRACustomBitmap._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+{$hints off}
+procedure TBGRACustomBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  //do nothing
+end;
+{$hints on}
+function TBGRACustomBitmap.IsScanPutPixelsDefined: boolean;
+begin
+  result := False;
+end;
+{********************** End of TBGRACustomBitmap **************************}
+{ TBGRACustomScanner }
+{ The abstract class record the position so that a derived class
+  need only to redefine ScanAt }
+function TBGRACustomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel;
+begin
+  result := ScanAt(X,Y);
+end;
+procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer);
+begin
+  FCurX := X;
+  FCurY := Y;
+end;
+{ Call ScanAt to determine pixel value }
+function TBGRACustomScanner.ScanNextPixel: TBGRAPixel;
+begin
+  result := ScanAt(FCurX,FCurY);
+  Inc(FCurX);
+end;
+{$hints off}
+procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  //do nothing
+end;
+{$hints on}
+function TBGRACustomScanner.IsScanPutPixelsDefined: boolean;
+begin
+  result := false;
+end;
+{ Interface gateway }
+function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  if GetInterface(iid, obj) then
+    Result := S_OK
+  else
+    Result := longint(E_NOINTERFACE);
+end;
+{ There is no automatic reference counting, but it is compulsory to define these functions }
+function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+{********************** End of TBGRACustomScanner **************************}
+{ The gamma correction is approximated here by a power function }
+const
+  GammaExpFactor   = 1.7; //exponent
+  redWeightShl10   = 306; // = 0.299
+  greenWeightShl10 = 601; // = 0.587
+  blueWeightShl10  = 117; // = 0.114
+var
+  GammaLinearFactor: single;
+procedure InitGamma;
+var
+  i: integer;
+{$IFDEF WINCE}
+  j,prevpos,curpos,midpos: integer;
+{$ENDIF}
+begin
+  //the linear factor is used to normalize expanded values in the range 0..65535
+  GammaLinearFactor := 65535 / power(255, GammaExpFactor);
+{$IFDEF WINCE}
+  curpos := 0;
+  GammaExpansionTab[0] := 0;
+  GammaCompressionTab[0] := 0;
+  for i := 0 to 255 do
+  begin
+    prevpos := curpos;
+    curpos := round(power(i, GammaExpFactor) * GammaLinearFactor);
+    if i = 1 then curpos := 1; //to avoid information loss
+    GammaExpansionTab[i] := curpos;
+    midpos := (prevpos+1+curpos) div 2;
+    for j := prevpos+1 to midpos-1 do
+      GammaCompressionTab[j] := i-1;
+    for j := midpos to curpos do
+      GammaCompressionTab[j] := i;
+  end;
+{$ELSE}
+  for i := 0 to 255 do
+    GammaExpansionTab[i] := round(power(i, GammaExpFactor) * GammaLinearFactor);
+  for i := 0 to 65535 do
+    GammaCompressionTab[i] := round(power(i / GammaLinearFactor, 1 / GammaExpFactor));
+  GammaExpansionTab[1]   := 1; //to avoid information loss
+  GammaCompressionTab[1] := 1;
+{$ENDIF}
+end;
+{************************** Color functions **************************}
+begin {optional implementation} end;
 function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb,
 …
   result := true;
-end;
-{ The intensity is defined here as the maximum value of any color component }
-function GetIntensity(const c: TExpandedPixel): word; inline;
-begin
-  Result := c.red;
-  if c.green > Result then
-    Result := c.green;
-  if c.blue > Result then
-    Result := c.blue;
-end;
-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;
-begin
-  curIntensity := GetIntensity(c);
-  if curIntensity = 0 then //suppose it's gray if there is no color information
-  begin
-    Result.red := intensity;
-    Result.green := intensity;
-    Result.blue := intensity;
-    result.alpha := c.alpha;
-  end
-  else
-  begin
-    //linear interpolation to reached wanted intensity
-    Result.red   := (c.red * intensity + (curIntensity shr 1)) div curIntensity;
-    Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity;
-    Result.blue  := (c.blue * intensity + (curIntensity shr 1)) div curIntensity;
-    Result.alpha := c.alpha;
-  end;
-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(const c: TExpandedPixel): word; inline;
-begin
-  Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 +
-    c.blue * blueWeightShl10 + 512) shr 10;
-end;
-function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
-var
-  curLightness: word;
-begin
-  curLightness := GetLightness(c);
-  if lightness = curLightness then
-  begin //no change
-    Result := 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
-    Result.red   := 65535;
-    Result.green := 65535;
-    Result.blue  := 65535;
-    Result.alpha := c.alpha;
-    exit;
-  end;
-  if lightness = 0 then  //set to black
-  begin
-    Result.red   := 0;
-    Result.green := 0;
-    Result.blue  := 0;
-    Result.alpha := c.alpha;
-    exit;
-  end;
-  if curLightness = 0 then  //set from black
-  begin
-    Result.red   := lightness;
-    Result.green := lightness;
-    Result.blue  := lightness;
-    Result.alpha := c.alpha;
-    exit;
-  end;
-  if lightness < curLightness then //darker is easy
-  begin
-    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;
-  //lighter and grayer
-  Result := c;
-  AddedWhiteness := lightness - curLightness;
-  maxBeforeWhite := 65535 - AddedWhiteness;
-  clip   := False;
-  if Result.red <= maxBeforeWhite then
-    Inc(Result.red, AddedWhiteness)
-  else
-  begin
-    Result.red := 65535;
-    clip := True;
-  end;
-  if Result.green <= maxBeforeWhite then
-    Inc(Result.green, AddedWhiteness)
-  else
-  begin
-    Result.green := 65535;
-    clip := True;
-  end;
-  if Result.blue <= maxBeforeWhite then
-    Inc(Result.blue, AddedWhiteness)
-  else
-  begin
-    Result.blue := 65535;
-    clip := True;
-  end;
-  if clip then //light and whiter
-  begin
-    curLightness   := GetLightness(Result);
-    addedWhiteness := lightness - curLightness;
-    maxBeforeWhite := 65535 - curlightness;
-    Result.red     := Result.red + addedWhiteness * (65535 - Result.red) div
-      maxBeforeWhite;
-    Result.green   := Result.green + addedWhiteness * (65535 - Result.green) div
-      maxBeforeWhite;
-    Result.blue    := Result.blue + addedWhiteness * (65535 - Result.blue) div
-      maxBeforeWhite;
-  end;
-end;
-function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel;
-var
-  r,g,b: word;
-  lightness256: byte;
-begin
-  if lightness <= 32768 then
-  begin
-    if lightness = 32768 then
-      result := color else
-    begin
-      lightness256 := GammaCompressionTab[lightness shl 1];
-      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
-                     color.blue * lightness256 shr 8, color.alpha);
-    end;
-  end else
-  begin
-    if lightness = 65535 then
-      result := BGRA(255,255,255,color.alpha) else
-    begin
-      lightness -= 32767;
-      r := GammaExpansionTab[color.red];
-      g := GammaExpansionTab[color.green];
-      b := GammaExpansionTab[color.blue];
-      result := BGRA(GammaCompressionTab[ r + (not r)*lightness shr 15 ],
-                     GammaCompressionTab[ g + (not g)*lightness shr 15 ],
-                     GammaCompressionTab[ b + (not b)*lightness shr 15 ],
-                     color.alpha);
-    end;
-  end;
-end;
-function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
-{$ifdef CPUI386} {$asmmode intel} assembler;
-  asm
-    imul edx
-    shl edx, 17
-    shr eax, 15
-    or edx, eax
-    mov result, edx
-  end;
-{$ELSE}
-begin
-  result := int64(lightness1)*lightness2 shr 15;
-end;
-{$ENDIF}
-function ApplyIntensityFast(color: TBGRAPixel; lightness: longword): TBGRAPixel;
-var
-    maxValue,invMaxValue,r,g,b: longword;
-    lightness256: byte;
-begin
-  if lightness <= 32768 then
-  begin
-    if lightness = 32768 then
-      result := color else
-    begin
-      lightness256 := GammaCompressionTab[lightness shl 1];
-      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
-                     color.blue * lightness256 shr 8, color.alpha);
-    end;
-  end else
-  begin
-    r := CombineLightness(GammaExpansionTab[color.red], lightness);
-    g := CombineLightness(GammaExpansionTab[color.green], lightness);
-    b := CombineLightness(GammaExpansionTab[color.blue], lightness);
-    maxValue := r;
-    if g > maxValue then maxValue := g;
-    if b > maxValue then maxValue := b;
-    if maxValue <= 65535 then
-      result := BGRA(GammaCompressionTab[r],
-                     GammaCompressionTab[g],
-                     GammaCompressionTab[b],
-                     color.alpha)
-    else
-    begin
-      invMaxValue := (longword(2147483647)+longword(maxValue-1)) div maxValue;
-      maxValue := (maxValue-65535) shr 1;
-      r := r*invMaxValue shr 15 + maxValue;
-      g := g*invMaxValue shr 15 + maxValue;
-      b := b*invMaxValue shr 15 + maxValue;
-      if r >= 65535 then result.red := 255 else
-        result.red := GammaCompressionTab[r];
-      if g >= 65535 then result.green := 255 else
-        result.green := GammaCompressionTab[g];
-      if b >= 65535 then result.blue := 255 else
-        result.blue := GammaCompressionTab[b];
-      result.alpha := color.alpha;
-    end;
-  end;
-end;
-{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space }
-function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
-begin
-  result := ExpandedToHSLA(GammaExpansion(c));
-end;
-procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline;
-const
-  deg60  = 10922;
-  deg120 = 21845;
-  deg240 = 43690;
-var
-  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
-  else
-  if b < min then
-    min  := b;
-  minMax := max - min;
-  if minMax = 0 then
-    dest.hue := 0
-  else
-  if max = r then
-    {$PUSH}{$RANGECHECKS OFF}
-    dest.hue := ((g - b) * deg60) div minMax
-    {$POP}
-  else
-  if max = g then
-    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
-    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 NativeUInt =
-     (13653, 10923, 8192, 13653, 10923, 8192);
-  segmentSrc: array[0..5] of NativeUInt =
-     (10923, 10922, 10923, 10923, 10922, 10923);
-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
-      g += segmentDest[1];
-      h -= segmentSrc[1];
-      if h < segmentSrc[2] then
-        g += h * segmentDest[2] div segmentSrc[2]
-      else
-      begin
-        g += segmentDest[2];
-        h -= segmentSrc[2];
-        if h < segmentSrc[3] then
-          g += h * segmentDest[3] div segmentSrc[3]
-        else
-        begin
-          g += segmentDest[3];
-          h -= segmentSrc[3];
-          if h < segmentSrc[4] then
-            g += h * segmentDest[4] div segmentSrc[4]
-          else
-          begin
-            g += segmentDest[4];
-            h -= segmentSrc[4];
-            g += h * segmentDest[5] div segmentSrc[5];
-          end;
-        end;
-      end;
-    end;
-  end;
-  result := g;
-end;
-function GtoH(ghue: word): word;
-const
-  segment: array[0..5] of NativeUInt =
-     (13653, 10923, 8192, 13653, 10923, 8192);
-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
-      g -= segment[1];
-      if g < segment[2] then
-        result := g * (32768-21845) div segment[2] + 21845
-      else
-      begin
-        g -= segment[2];
-        if g < segment[3] then
-          result := g * (43691-32768) div segment[3] + 32768
-        else
-        begin
-          g -= segment[3];
-          if g < segment[4] then
-            result := g * (54613-43691) div segment[4] + 43691
-          else
-          begin
-            g -= segment[4];
-            result := g * (65536-54613) div segment[5] + 54613;
-          end;
-        end;
-      end;
-    end;
-  end;
-end;
-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* UInt32or64(not result.lightness) div 32767;
-  result.lightness := lightness;
-  result.hue := HtoG(result.hue);
-end;
-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;
-  deg60  = 8192;
-  deg120 = deg60 * 2;
-  deg180 = deg60 * 3;
-  deg240 = deg60 * 4;
-  deg360 = deg60 * 6;
-  function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline;
-  begin
-    if h < deg180 then
-    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, 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 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   := (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(const c: THSLAPixel): TBGRAPixel;
-var ec: TExpandedPixel;
-begin
-  ec := HSLAToExpanded(c);
-  Result := GammaCompression(ec);
-end;
-function HueDiff(h1, h2: word): word;
-begin
-  result := abs(integer(h1)-integer(h2));
-  if result > 32768 then result := 65536-result;
-end;
-function GetHue(ec: TExpandedPixel): word;
-const
-  deg60  = 8192;
-  deg120 = deg60 * 2;
-  deg240 = deg60 * 4;
-  deg360 = deg60 * 6;
-var
-  min, max, minMax: integer;
-  r,g,b: integer;
-begin
-  r := ec.red;
-  g := ec.green;
-  b := ec.blue;
-  min := r;
-  max := r;
-  if g > max then
-    max := g
-  else
-  if g < min then
-    min := g;
-  if b > max then
-    max := b
-  else
-  if b < min then
-    min  := b;
-  minMax := max - min;
-  if minMax = 0 then
-    Result := 0
-  else
-  if max = r then
-    Result := (((g - b) * deg60) div
-      minMax + deg360) mod deg360
-  else
-  if max = g then
-    Result := ((b - r) * deg60) div minMax + deg120
-  else
-    {max = b} Result :=
-      ((r - g) * deg60) div minMax + deg240;
-  Result   := (Result shl 16) div deg360; //normalize
-end;
-function ColorImportance(ec: TExpandedPixel): word;
-var min,max: word;
-begin
-  min := ec.red;
-  max := ec.red;
-  if ec.green > max then
-    max := ec.green
-  else
-  if ec.green < min then
-    min := ec.green;
-  if ec.blue > max then
-    max := ec.blue
-  else
-  if ec.blue < min then
-    min  := ec.blue;
-  result := max - min;
-end;
-function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
-var ec: TExpandedPixel;
-    lightness: word;
-begin
-  c.hue := GtoH(c.hue);
-  lightness := c.lightness;
-  c.lightness := 32768;
-  ec := HSLAToExpanded(c);
-  result := GammaCompression(SetLightness(ec, lightness));
-end;
-function 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;
-{ Apply gamma correction using conversion tables }
-function GammaExpansion(c: TBGRAPixel): TExpandedPixel;
-begin
-  Result.red   := GammaExpansionTab[c.red];
-  Result.green := GammaExpansionTab[c.green];
-  Result.blue  := GammaExpansionTab[c.blue];
-  Result.alpha := c.alpha shl 8 + c.alpha;
-end;
-function GammaCompression(const ec: TExpandedPixel): TBGRAPixel;
-begin
-  Result.red   := GammaCompressionTab[ec.red];
-  Result.green := GammaCompressionTab[ec.green];
-  Result.blue  := GammaCompressionTab[ec.blue];
-  Result.alpha := ec.alpha shr 8;
-end;
-function GammaCompression(red, green, blue, alpha: word): TBGRAPixel;
-begin
-  Result.red   := GammaCompressionTab[red];
-  Result.green := GammaCompressionTab[green];
-  Result.blue  := GammaCompressionTab[blue];
-  Result.alpha := alpha shr 8;
-end;
-// Conversion to grayscale by taking into account
-// different color weights
-function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
-var
-  ec:    TExpandedPixel;
-  gray:  word;
-  cgray: byte;
-begin
-  if c.alpha = 0 then
-  begin
-    result := BGRAPixelTransparent;
-    exit;
-  end;
-  //gamma expansion
-  ec    := GammaExpansion(c);
-  //gray composition
-  gray  := (ec.red * redWeightShl10 + ec.green * greenWeightShl10 +
-    ec.blue * blueWeightShl10 + 512) shr 10;
-  //gamma compression
-  cgray := GammaCompressionTab[gray];
-  Result.red := cgray;
-  Result.green := cgray;
-  Result.blue := cgray;
-  Result.alpha := c.alpha;
-end;
-function GrayscaleToBGRA(lightness: word): TBGRAPixel;
-begin
-  result.red := GammaCompressionTab[lightness];
-  result.green := result.red;
-  result.blue := result.red;
-  result.alpha := $ff;
-end;
-function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel;
-var
-  sumR,sumG,sumB,sumA: NativeUInt;
-  i: integer;
-begin
-  if length(colors)<=0 then
-  begin
-    result := BGRAPixelTransparent;
-    exit;
-  end;
-  sumR := 0;
-  sumG := 0;
-  sumB := 0;
-  sumA := 0;
-  for i := 0 to high(colors) do
-  with colors[i] do
-  begin
-    sumR += red*alpha;
-    sumG += green*alpha;
-    sumB += blue*alpha;
-    sumA += alpha;
-  end;
-  if sumA > 0 then
-  begin
-    result.red := (sumR + sumA shr 1) div sumA;
-    result.green := (sumG + sumA shr 1) div sumA;
-    result.blue := (sumB + sumA shr 1) div sumA;
-    result.alpha := sumA div longword(length(colors));
-  end
-  else
-    result := BGRAPixelTransparent;
-end;
-{ Merge linearly two colors of same importance }
-function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
-var c12: cardinal;
-begin
-  if (c1.alpha = 0) then
-    Result := c2
-  else
-  if (c2.alpha = 0) then
-    Result := c1
-  else
-  begin
-    c12 := c1.alpha + c2.alpha;
-    Result.red   := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12;
-    Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12;
-    Result.blue  := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12;
-    Result.alpha := (c12 + 1) shr 1;
-  end;
-end;
-function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel;
-  weight2: integer): TBGRAPixel;
-var
-    f1,f2,f12: int64;
-begin
-  if (weight1 = 0) then
-  begin
-    if (weight2 = 0) then
-      result := BGRAPixelTransparent
-    else
-      Result := c2
-  end
-  else
-  if (weight2 = 0) then
-    Result := c1
-  else
-  if (weight1+weight2 = 0) then
-    Result := BGRAPixelTransparent
-  else
-  begin
-    f1 := int64(c1.alpha)*weight1;
-    f2 := int64(c2.alpha)*weight2;
-    f12 := f1+f2;
-    if f12 = 0 then
-      result := BGRAPixelTransparent
-    else
-    begin
-      Result.red   := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12;
-      Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12;
-      Result.blue  := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12;
-      {$hints off}
-      Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2);
-      {$hints on}
-    end;
-  end;
-end;
-function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel;
-  weight2: byte): TBGRAPixel;
-var
-    w1,w2,f1,f2,f12,a: UInt32or64;
-begin
-  w1 := weight1;
-  w2 := weight2;
-  if (w1 = 0) then
-  begin
-    if (w2 = 0) then
-      result := BGRAPixelTransparent
-    else
-      Result := c2
-  end
-  else
-  if (w2 = 0) then
-    Result := c1
-  else
-  begin
-    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;
-    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;
-{ Merge two colors of same importance }
-function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel;
-var c12: cardinal;
-begin
-  if (ec1.alpha = 0) then
-    Result := ec2
-  else
-  if (ec2.alpha = 0) then
-    Result := ec1
-  else
-  begin
-    c12 := ec1.alpha + ec2.alpha;
-    Result.red   := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12;
-    Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12;
-    Result.blue  := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12;
-    Result.alpha := (c12 + 1) shr 1;
-  end;
-end;
-function BGRA(red, green, blue, alpha: byte): TBGRAPixel;
-begin
-  Result.red   := red;
-  Result.green := green;
-  Result.blue  := blue;
-  Result.alpha := alpha;
-end;
-function BGRA(red, green, blue: byte): TBGRAPixel; overload;
-begin
-  Result.red   := red;
-  Result.green := green;
-  Result.blue  := blue;
-  Result.alpha := 255;
-end;
-{ Convert a TColor value to a TBGRAPixel value. Note that
-  you need to call ColorToRGB first if you use a system
-  color identifier like clWindow. }
-{$PUSH}{$R-}
-function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel;
-begin
-  Result.hue   := hue;
-  Result.saturation := saturation;
-  Result.lightness  := lightness;
-  Result.alpha := alpha;
-end;
-function HSLA(hue, saturation, lightness: word): THSLAPixel;
-begin
-  Result.hue   := hue;
-  Result.saturation := saturation;
-  Result.lightness  := lightness;
-  Result.alpha := $ffff;
-end;
-function ColorToBGRA(color: TColor): TBGRAPixel; overload;
-begin
-  Result.red   := color;
-  Result.green := color shr 8;
-  Result.blue  := color shr 16;
-  Result.alpha := 255;
-end;
-function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload;
-begin
-  Result.red   := color;
-  Result.green := color shr 8;
-  Result.blue  := color shr 16;
-  Result.alpha := opacity;
-end;
-{$POP}
-{ Conversion from TFPColor to TBGRAPixel assuming TFPColor
-  is already gamma compressed }
-function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
-begin
-  with AValue do
-    Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
-end;
-function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
-begin
-  result.red := AValue.red shl 8 + AValue.red;
-  result.green := AValue.green shl 8 + AValue.green;
-  result.blue := AValue.blue shl 8 + AValue.blue;
-  result.alpha := AValue.alpha shl 8 + AValue.alpha;
-end;
-function BGRAToColor(c: TBGRAPixel): TColor;
-begin
-  Result := c.red + (c.green shl 8) + (c.blue shl 16);
-end;
-operator = (const c1, c2: TBGRAPixel): boolean;
-begin
-  if (c1.alpha = 0) and (c2.alpha = 0) then
-    Result := True
-  else
-    Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and
-      (c1.green = c2.green) and (c1.blue = c2.blue);
-end;
-function LessStartSlope65535(value: word): word;
-var factor: word;
-begin
-  factor := 4096 - (not value)*3 shr 7;
-  result := value*factor shr 12;
-end;
-function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
-var
-  CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2,
-  CompGreenAlpha2, CompBlueAlpha2: integer;
-  DiffAlpha: word;
-  ColorDiff: word;
-  TempHueDiff: word;
-begin
-  CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535
-  CompGreenAlpha1 := ec1.green * ec1.alpha shr 16;
-  CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16;
-  CompRedAlpha2 := ec2.red * ec2.alpha shr 16;
-  CompGreenAlpha2 := ec2.green * ec2.alpha shr 16;
-  CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16;
-  Result    := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 +
-    Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 +
-    Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10;
-  ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2));
-  if ColorDiff > 0 then
-  begin
-    TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2)));
-    if TempHueDiff < 32768 then
-      TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4
-    else
-      TempHueDiff := TempHueDiff shr 3;
-    Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12;
-  end;
-  DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha));
-  if DiffAlpha > Result then
-    Result := DiffAlpha;
-end;
-function BGRAWordDiff(c1, c2: TBGRAPixel): word;
-begin
-  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2));
-end;
-function BGRADiff(c1,c2: TBGRAPixel): byte;
-begin
-  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8;
-end;
-operator-(const c1, c2: TColorF): TColorF;
-begin
-  result[1] := c1[1]-c2[1];
-  result[2] := c1[2]-c2[2];
-  result[3] := c1[3]-c2[3];
-  result[4] := c1[4]-c2[4];
-end;
-operator+(const c1, c2: TColorF): TColorF;
-begin
-  result[1] := c1[1]+c2[1];
-  result[2] := c1[2]+c2[2];
-  result[3] := c1[3]+c2[3];
-  result[4] := c1[4]+c2[4];
-end;
-operator*(const c1, c2: TColorF): TColorF;
-begin
-  result[1] := c1[1]*c2[1];
-  result[2] := c1[2]*c2[2];
-  result[3] := c1[3]*c2[3];
-  result[4] := c1[4]*c2[4];
-end;
-operator*(const c1: TColorF; factor: single): TColorF;
-begin
-  result[1] := c1[1]*factor;
-  result[2] := c1[2]*factor;
-  result[3] := c1[3]*factor;
-  result[4] := c1[4]*factor;
-end;
-function ColorF(red, green, blue, alpha: single): TColorF;
-begin
-  result[1] := red;
-  result[2] := green;
-  result[3] := blue;
-  result[4] := alpha;
-end;
-{ Write a color in hexadecimal format RRGGBBAA 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;
-type
-    arrayOfString = array of string;
-function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString;
-var idxOpen,start,cur: integer;
-begin
-    result := nil;
-    idxOpen := pos('(',str);
-    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
-       if str[cur] in[',',')'] then
-       begin
-         setlength(result,length(result)+1);
-         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
-      setlength(result,length(result)+1);
-      result[high(result)] := copy(str,start,length(str)-start+1);
-    end;
-end;
-function ParseColorValue(str: string; var flagError: boolean): byte;
-var pourcent,unclipped,{%H-}errPos: integer;
-begin
-  if str = '' then result := 0 else
-  begin
-    if str[length(str)]='%' then
-    begin
-      val(copy(str,1,length(str)-1),pourcent,errPos);
-      if errPos <> 0 then flagError := true;
-      if pourcent < 0 then result := 0 else
-      if pourcent > 100 then result := 255 else
-        result := pourcent*255 div 100;
-    end else
-    begin
-      val(str,unclipped,errPos);
-      if errPos <> 0 then flagError := true;
-      if unclipped < 0 then result := 0 else
-      if unclipped > 255 then result := 255 else
-        result := unclipped;
-    end;
-  end;
-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;
-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;
-    alphaF: single;
-    idx: integer;
-begin
-  str := Trim(str);
-  error := false;
-  if (str = '') or (str = '?') then
-  begin
-    missingValues := true;
-    exit;
-  end else
-    missingValues := false;
-  str := StringReplace(lowerCase(str),'grey','gray',[]);
-  //VGA color names
-  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
-    idx := CSSColors.IndexOf(str);
-    if idx <> -1 then
-    begin
-      parsedValue := CSSColors[idx];
-      exit;
-    end;
-    //CSS RGB notation
-    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,error);
-      if (length(values)=3) or (length(values)=4) then
-      begin
-        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
-          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
-          parsedValue.alpha := 255;
-      end else
-        error := true;
-      exit;
-    end;
-    //remove HTML notation header
-    if str[1]='#' then delete(str,1,1);
-    //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';
-    //hex notation
-    if length(str)=8 then
-    begin
-      if copy(str,1,2) <> '??' then
-      begin
-        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
-        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
-        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
-        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
-      if str[1] <> '?' then
-      begin
-        val('$'+str[1],parsedValue.red,errPos);
-        if errPos <> 0 then error := true;
-        parsedValue.red *= $11;
-      end else missingValues := true;
-      if str[2] <> '?' then
-      begin
-        val('$'+str[2],parsedValue.green,errPos);
-        if errPos <> 0 then error := true;
-        parsedValue.green *= $11;
-      end else missingValues := true;
-      if str[3] <> '?' then
-      begin
-        val('$'+str[3],parsedValue.blue,errPos);
-        if errPos <> 0 then error := true;
-        parsedValue.blue *= $11;
-      end else missingValues := true;
-      if str[4] <> '?' then
-      begin
-        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
-      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;
-function MapHeight(Color: TBGRAPixel): Single;
-var intval: integer;
-begin
-  intval := color.Green shl 16 + color.red shl 8 + color.blue;
-  result := intval*5.960464832810452e-8;
-end;
-function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
-var intval: integer;
-begin
-  if Height >= 1 then result := BGRA(255,255,255,alpha) else
-  if Height <= 0 then result := BGRA(0,0,0,alpha) else
-  begin
-    intval := round(Height*16777215);
-    result := BGRA(intval shr 8,intval shr 16,intval,alpha);
-  end;
-end;
-{********************** Point functions **************************}
-function PointF(x, y: single): TPointF;
-begin
-  Result.x := x;
-  Result.y := y;
-end;
-function PointsF(const pts: array of TPointF): ArrayOfTPointF;
-var
-  i: Integer;
-begin
-  setlength(result, length(pts));
-  for i := 0 to high(pts) do result[i] := pts[i];
-end;
-operator =(const pt1, pt2: TPointF): boolean;
-begin
-  result := (pt1.x = pt2.x) and (pt1.y = pt2.y);
-end;
-operator-(const pt1, pt2: TPointF): TPointF;
-begin
-  result.x := pt1.x-pt2.x;
-  result.y := pt1.y-pt2.y;
-end;
-operator-(const pt2: TPointF): TPointF;
-begin
-  result.x := -pt2.x;
-  result.y := -pt2.y;
-end;
-operator+(const pt1, pt2: TPointF): TPointF;
-begin
-  result.x := pt1.x+pt2.x;
-  result.y := pt1.y+pt2.y;
-end;
-operator*(const pt1, pt2: TPointF): single;
-begin
-  result := pt1.x*pt2.x + pt1.y*pt2.y;
-end;
-operator*(const pt1: TPointF; factor: single): TPointF;
-begin
-  result.x := pt1.x*factor;
-  result.y := pt1.y*factor;
-end;
-operator*(factor: single; const pt1: TPointF): TPointF;
-begin
-  result.x := pt1.x*factor;
-  result.y := pt1.y*factor;
-end;
-function PtInRect(const pt: TPoint; r: TRect): boolean;
-var
-  temp: integer;
-begin
-  if r.right < r.left then
-  begin
-    temp    := r.left;
-    r.left  := r.right;
-    r.Right := temp;
-  end;
-  if r.bottom < r.top then
-  begin
-    temp     := r.top;
-    r.top    := r.bottom;
-    r.bottom := temp;
-  end;
-  Result := (pt.X >= r.left) and (pt.Y >= r.top) and (pt.X < r.right) and
-    (pt.y < r.bottom);
-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(dx*dx+dy*dy);
-end;
-function VectLen(v: TPointF): 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;
-begin
-  result := IntersectLine(line1,line2,parallel);
-end;
-{$OPTIMIZATION ON}
-function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
-var divFactor: double;
-begin
-  parallel := false;
-  //if lines are parallel
-  if ((line1.dir.x = line2.dir.x) and (line1.dir.y = line2.dir.y)) or
-     ((abs(line1.dir.y) < 1e-6) and (abs(line2.dir.y) < 1e-6)) then
-  begin
-       parallel := true;
-       //return the center of the segment between line origins
-       result.x := (line1.origin.x+line2.origin.x)/2;
-       result.y := (line1.origin.y+line2.origin.y)/2;
-  end else
-  if abs(line1.dir.y) < 1e-6 then //line1 is horizontal
-  begin
-       result.y := line1.origin.y;
-       result.x := line2.origin.x + (result.y - line2.origin.y)
-               /line2.dir.y*line2.dir.x;
-  end else
-  if abs(line2.dir.y) < 1e-6 then //line2 is horizontal
-  begin
-       result.y := line2.origin.y;
-       result.x := line1.origin.x + (result.y - line1.origin.y)
-               /line1.dir.y*line1.dir.x;
-  end else
-  begin
-       divFactor := line1.dir.x/line1.dir.y - line2.dir.x/line2.dir.y;
-       if abs(divFactor) < 1e-6 then //almost parallel
-       begin
-            parallel := true;
-            //return the center of the segment between line origins
-            result.x := (line1.origin.x+line2.origin.x)/2;
-            result.y := (line1.origin.y+line2.origin.y)/2;
-       end else
-       begin
-         result.y := (line2.origin.x - line1.origin.x +
-                  line1.origin.y*line1.dir.x/line1.dir.y -
-                  line2.origin.y*line2.dir.x/line2.dir.y)
-                  / divFactor;
-         result.x := line1.origin.x + (result.y - line1.origin.y)
-                 /line1.dir.y*line1.dir.x;
-       end;
-  end;
-end;
-{ Check if a polygon is convex, i.e. it always turns in the same direction }
-function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
-var
-  positive,negative,zero: boolean;
-  product: single;
-  i: Integer;
-begin
-  positive := false;
-  negative := false;
-  zero := false;
-  for i := 0 to high(pts) do
-  begin
-    product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) -
-               (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x);
-    if product > 0 then
-    begin
-      if negative then
-      begin
-        result := false;
-        exit;
-      end;
-      positive := true;
-    end else
-    if product < 0 then
-    begin
-      if positive then
-      begin
-        result := false;
-        exit;
-      end;
-      negative := true;
-    end else
-      zero := true;
-  end;
-  if not IgnoreAlign and zero then
-    result := false
-  else
-    result := true;
-end;
-{ Check if two segments intersect }
-function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
-var
-  seg1: TLineDef;
-  seg1len: single;
-  seg2: TLineDef;
-  seg2len: single;
-  inter: TPointF;
-  pos1,pos2: single;
-  para: boolean;
-begin
-  { Determine line definitions }
-  seg1.origin := pt1;
-  seg1.dir := pt2-pt1;
-  seg1len := sqrt(sqr(seg1.dir.X)+sqr(seg1.dir.Y));
-  if seg1len = 0 then
-  begin
-    result := false;
-    exit;
-  end;
-  seg1.dir *= 1/seg1len;
-  seg2.origin := pt3;
-  seg2.dir := pt4-pt3;
-  seg2len := sqrt(sqr(seg2.dir.X)+sqr(seg2.dir.Y));
-  if seg2len = 0 then
-  begin
-    result := false;
-    exit;
-  end;
-  seg2.dir *= 1/seg2len;
-  //obviously parallel
-  if seg1.dir = seg2.dir then
-    result := false
-  else
-  begin
-    //try to compute intersection
-    inter := IntersectLine(seg1,seg2,para);
-    if para then
-      result := false
-    else
-    begin
-      //check if intersections are inside the segments
-      pos1 := (inter-seg1.origin)*seg1.dir;
-      pos2 := (inter-seg2.origin)*seg2.dir;
-      if (pos1 >= 0) and (pos1 <= seg1len) and
-         (pos2 >= 0) and (pos2 <= seg2len) then
-        result := true
-      else
-        result := false;
-    end;
-  end;
-end;
-{ Check if a quaduadrilateral intersects itself }
-function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
-begin
-  result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1);
 end;
 …
         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
+          if (dwords[0] = 0) and (dwords[1] <= maxFileSize) and (dwords[5] <= maxFileSize) and
+             (dwords[9] <= maxFileSize) and
             (dwords[6] = 0) then inc(scores[ifLazPaint],2);
         end;
 …
     end;
+    if (copy(magicAsText,1,4) = 'oXo ') then
+    begin
+      inc(scores[ifPhoxo],1);
+      if (magic[4] = 1) and (magic[5] = 0) and (magic[6] = 0) and (magic[7] = 0) then
+        inc(scores[ifPhoxo],1);
+    end;
     DetectLazPaint;
 …
   ASuggestedExtensionUTF8:= UTF8LowerCase(ASuggestedExtensionUTF8);
   if (ASuggestedExtensionUTF8 <> '') and (UTF8Copy(ASuggestedExtensionUTF8,1,1) <> '.') then
+  if (ASuggestedExtensionUTF8 <> '') and (ASuggestedExtensionUTF8[1] <> '.') then //first UTF8 char is in first pos
     ASuggestedExtensionUTF8 := '.'+ASuggestedExtensionUTF8;
 …
 function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
 var ext: string;
+  posDot: integer;
 begin
   result := ifUnknown;
   ext := ExtractFileName(AFilenameOrExtensionUTF8);
+  if pos('.', ext) <> 0 then ext := ExtractFileExt(ext) else ext := '.'+ext;
+  posDot := LastDelimiter('.', ext);
+  if posDot <> 0 then ext := copy(ext,posDot,length(ext)-posDot+1)
+  else ext := '.'+ext;
   ext := UTF8LowerCase(ext);
 …
   if (ext = '.tif') or (ext = '.tiff') then result := ifTiff else
   if (ext = '.xwd') then result := ifXwd else
+  if (ext = '.xpm') then result := ifXPixMap;
+  if (ext = '.xpm') then result := ifXPixMap else
+  if (ext = '.oxo') then result := ifPhoxo;
+end;
+function SuggestImageExtension(AFormat: TBGRAImageFormat): string;
+begin
+  case AFormat of
+    ifJpeg: result := 'jpg';
+    ifPng: result := 'png';
+    ifGif: result := 'gif';
+    ifBmp: result := 'bmp';
+    ifIco: result := 'ico';
+    ifPcx: result := 'pcx';
+    ifPaintDotNet: result := 'pdn';
+    ifLazPaint: result := 'lzp';
+    ifOpenRaster: result := 'ora';
+    ifPsd: result := 'psd';
+    ifTarga: result := 'tga';
+    ifTiff: result := 'tif';
+    ifXwd: result := 'xwd';
+    ifXPixMap: result := 'xpm';
+    ifBmpMioMap: result := 'bmp';
+    else result := '?';
+  end;
 end;
 …
   if AFormat = ifPng then
   begin
+    result := TFPWriterPNG.Create;
+    TFPWriterPNG(result).Indexed := false;
+    TFPWriterPNG(result).WordSized := false;
+    TFPWriterPNG(result).UseAlpha := AHasTransparentPixels;
+    result := TBGRAWriterPNG.Create;
+    TBGRAWriterPNG(result).UseAlpha := AHasTransparentPixels;
   end else
   if AFormat = ifBmp then
 …
 initialization
+  InitGamma;
+  {$DEFINE INCLUDE_COLOR_LIST}
+  {$DEFINE INCLUDE_INIT}
+  {$I bgrapixel.inc}
+  {$DEFINE INCLUDE_INIT}
   {$I csscolorconst.inc}
   DefaultBGRAImageWriter[ifJpeg] := TFPWriterJPEG;
   DefaultBGRAImageWriter[ifPng] := TFPWriterPNG;
+  DefaultBGRAImageWriter[ifPng] := TBGRAWriterPNG;
   DefaultBGRAImageWriter[ifBmp] := TFPWriterBMP;
   DefaultBGRAImageWriter[ifPcx] := TFPWriterPCX;
 …
 finalization
+  CSSColors.Free;
+  VGAColors.Free;
+  {$DEFINE INCLUDE_FINAL}
+  {$I csscolorconst.inc}
+  {$DEFINE INCLUDE_FINAL}
+  {$I bgrapixel.inc}
 end.

GraphicTest/Packages/bgrabitmap/bgrablend.pas

-              r472
+              r494
 procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; calpha: byte); inline; overload;
 procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel); inline;
+procedure InterpolateBilinear(pUpLeft,pUpRight,pDownLeft,pDownRight: PBGRAPixel;
+                iFactX,iFactY: Integer; ADest: PBGRAPixel);
 procedure CopyPixelsWithOpacity(dest,src: PBGRAPixel; opacity: byte; Count: integer); inline;
 …
 procedure ScreenPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure SoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure HardLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
 procedure BlendXorPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+procedure BGRAFillClearTypeMask(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
+procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer;
+  mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner;
+  KeepRGBOrder: boolean);
+procedure BGRAFillClearTypeMaskPtr(dest: TBGRACustomBitmap; x,y: integer; xThird: integer; maskData: PByte; maskPixelSize: NativeInt; maskRowSize: NativeInt; maskWidth,maskHeight: integer; color: TBGRAPixel; texture: IBGRAScanner; RGBOrder: boolean);
 implementation
+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;
+  ClearTypePixel: array[0..2] of byte;
+  curThird: integer;
+  procedure OutputPixel; inline;
+  begin
+    if texture <> nil then
+      color := texture.ScanNextPixel;
+    if RGBOrder then
+      ClearTypeDrawPixel(pdest, ClearTypePixel[0],ClearTypePixel[1],ClearTypePixel[2], color)
+    else
+      ClearTypeDrawPixel(pdest, ClearTypePixel[2],ClearTypePixel[1],ClearTypePixel[0], color);
+  end;
+  procedure NextAlpha(alphaValue: byte); inline;
+  begin
+    ClearTypePixel[curThird] := alphaValue;
+    inc(curThird);
+    if curThird = 3 then
+    begin
+      OutputPixel;
+      curThird := 0;
+      Fillchar(ClearTypePixel, sizeof(ClearTypePixel),0);
+      inc(pdest);
+    end;
+  end;
+  procedure EndRow; inline;
+  begin
+    if curThird > 0 then OutputPixel;
+  end;
+var
+  yMask,n: integer;
+  a: byte;
+  pmask: PByte;
+  dx:integer;
+  miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer;
+  leftOnSide, rightOnSide: boolean;
+  countBetween: integer;
+  v1,v2,v3: byte;
+  procedure StartRow; inline;
+  begin
+    pdest := dest.Scanline[yMask+y]+minx;
+    if texture <> nil then
+      texture.ScanMoveTo(minx,yMask+y);
+    curThird := minxThird;
+    ClearTypePixel[0] := 0;
+    ClearTypePixel[1] := 0;
+    ClearTypePixel[2] := 0;
+  end;
+begin
+  alphaLineLen := maskWidth+2;
+  xThird -= 1; //for first subpixel
+  if xThird >= 0 then dx := xThird div 3
+   else dx := -((-xThird+2) div 3);
+  x += dx;
+  xThird -= dx*3;
+  if y >= dest.ClipRect.Top then miny := 0
+    else miny := dest.ClipRect.Top-y;
+  if y+maskHeight-1 < dest.ClipRect.Bottom then
+    maxy := maskHeight-1 else
+      maxy := dest.ClipRect.Bottom-1-y;
+  if x >= dest.ClipRect.Left then
+  begin
+    minx := x;
+    minxThird := xThird;
+    alphaMinX := 0;
+    leftOnSide := false;
+  end else
+  begin
+    minx := dest.ClipRect.Left;
+    minxThird := 0;
+    alphaMinX := (dest.ClipRect.Left-x)*3 - xThird;
+    leftOnSide := true;
+  end;
+  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;
+  end else
+  begin
+    maxx := dest.ClipRect.Right-1;
+    alphaMaxX := maxx*3+2 - (x*3+xThird);
+    rightOnSide := true;
+  end;
+  countBetween := alphaMaxX-alphaMinX-1;
+  if (alphaMinX <= alphaMaxX) then
+  begin
+    for yMask := miny to maxy do
+    begin
+      StartRow;
+      if leftOnSide then
+      begin
+        pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize;
+        a := pmask^ div 3;
+        v1 := a+a;
+        v2 := a;
+        v3 := 0;
+        inc(pmask, maskPixelSize);
+      end else
+      begin
+        pmask := maskData + (yMask*maskRowSize);
+        v1 := 0;
+        v2 := 0;
+        v3 := 0;
+      end;
+      for n := countBetween-1 downto 0 do
+      begin
+        a := pmask^ div 3;
+        v1 += a;
+        v2 += a;
+        v3 += a;
+        inc(pmask, maskPixelSize);
+        NextAlpha(v1);
+        v1 := v2;
+        v2 := v3;
+        v3 := 0;
+      end;
+      if rightOnSide then
+      begin
+        a := pmask^ div 3;
+        v1 += a;
+        v2 += a+a;
+      end;
+      NextAlpha(v1);
+      NextAlpha(v2);
+      EndRow;
+    end;
+  end;
+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;
+procedure BGRAFillClearTypeRGBMask(dest: TBGRACustomBitmap; x, y: integer;
+  mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner;
+  KeepRGBOrder: boolean);
+var
+  minx,miny,maxx,maxy,countx,n,yb: integer;
+  pdest,psrc: PBGRAPixel;
+begin
+  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
+      maxy := dest.ClipRect.Bottom-1-y;
+  if x >= dest.ClipRect.Left then minx := 0
+    else minx := dest.ClipRect.Left-x;
+  if x+mask.Width-1 < dest.ClipRect.Right then
+    maxx := mask.Width-1 else
+      maxx := dest.ClipRect.Right-1-x;
+  countx := maxx-minx+1;
+  if countx <= 0 then exit;
+  for yb := miny to maxy do
+  begin
+    pdest := dest.ScanLine[y+yb]+(x+minx);
+    psrc := mask.ScanLine[yb]+minx;
+    if texture <> nil then
+      texture.ScanMoveTo(x+minx, y+yb);
+    if KeepRGBOrder then
+    begin
+      for n := countx-1 downto 0 do
+      begin
+        if texture <> nil then color := texture.ScanNextPixel;
+        ClearTypeDrawPixel(pdest, psrc^.red, psrc^.green, psrc^.blue, color);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+    begin
+      for n := countx-1 downto 0 do
+      begin
+        if texture <> nil then color := texture.ScanNextPixel;
+        ClearTypeDrawPixel(pdest, psrc^.blue, psrc^.green, psrc^.red, color);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end;
+  end;
+end;
 procedure ClearTypeDrawPixel(pdest: PBGRAPixel; Cr, Cg, Cb: byte; Color: TBGRAPixel);
 …
     end;
     pdest^ := merge;
+  end;
+end;
+procedure InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
+  pDownRight: PBGRAPixel; iFactX,iFactY: Integer; ADest: PBGRAPixel);
+var
+  w1,w2,w3,w4,alphaW: cardinal;
+  rSum, gSum, bSum: cardinal; //rgbDiv = aSum
+  aSum, aDiv: cardinal;
+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 pUpLeft <> nil then
+  with pUpLeft^ do
+  begin
+    alphaW := alpha * w1;
+    aDiv   += w1;
+    aSum   += alphaW;
+    rSum   += red * alphaW;
+    gSum   += green * alphaW;
+    bSum   += blue * alphaW;
+  end;
+  if pUpRight <> nil then
+  with pUpRight^ do
+  begin
+    alphaW := alpha * w2;
+    aDiv   += w2;
+    aSum   += alphaW;
+    rSum   += red * alphaW;
+    gSum   += green * alphaW;
+    bSum   += blue * alphaW;
+  end;
+  if pDownLeft <> nil then
+  with pDownLeft^ do
+  begin
+    alphaW := alpha * w3;
+    aDiv   += w3;
+    aSum   += alphaW;
+    rSum   += red * alphaW;
+    gSum   += green * alphaW;
+    bSum   += blue * alphaW;
+  end;
+  if pDownRight <> nil then
+  with pDownRight^ do
+  begin
+    alphaW := alpha * w4;
+    aDiv   += w4;
+    aSum   += alphaW;
+    rSum   += red * alphaW;
+    gSum   += green * alphaW;
+    bSum   += blue * alphaW;
+  end;
+  if aSum < 128 then //if there is no alpha
+    ADest^ := BGRAPixelTransparent
+  else
+  with ADest^ do
+  begin
+    red   := (rSum + aSum shr 1) div aSum;
+    green := (gSum + aSum shr 1) div aSum;
+    blue  := (bSum + aSum shr 1) div aSum;
+    if aDiv = 256 then
+      alpha := (aSum + 128) shr 8
+    else
+      alpha := (aSum + aDiv shr 1) div aDiv;
   end;
 end;
 …
 procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel);
 var
-  p: PByte;
   a1f, a2f, a12, a12m: cardinal;
 begin
 …
   a2f := (c.alpha shl 8) - c.alpha;
+  p := PByte(dest);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f +
+    GammaExpansionTab[c.blue] * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f +
+    GammaExpansionTab[c.green] * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f +
+    GammaExpansionTab[c.red] * a2f + a12m) div a12];
+  Inc(p);
+  p^ := (a12 + a12 shr 7) shr 8;
+  PDWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f +
+                     GammaExpansionTab[c.red] * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or
+                   ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f +
+                     GammaExpansionTab[c.green] * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or
+                   ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f +
+                     GammaExpansionTab[c.blue] * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or
+                   (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift);
 end;
 …
   const ec: TExpandedPixel; calpha: byte);
 var
-  p: PByte;
   a1f, a2f, a12, a12m: cardinal;
 begin
 …
   a2f := (calpha shl 8) - calpha;
+  p := PByte(dest);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f +
+    ec.blue * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f +
+    ec.green * a2f + a12m) div a12];
+  Inc(p);
+  p^ := GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f +
+    ec.red * a2f + a12m) div a12];
+  Inc(p);
+  p^ := (a12 + a12 shr 7) shr 8;
+  PDWord(dest)^ := ((GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f +
+                     ec.red * a2f + a12m) div a12]) shl TBGRAPixel_RedShift) or
+                   ((GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f +
+                     ec.green * a2f + a12m) div a12]) shl TBGRAPixel_GreenShift) or
+                   ((GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f +
+                     ec.blue * a2f + a12m) div a12]) shl TBGRAPixel_BlueShift) or
+                   (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift);
 end;
 procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel);
 var
-  p: PByte;
   a1f, a2f, a12, a12m: cardinal;
 begin
 …
   a2f := (c.alpha shl 8) - c.alpha;
+  p := PByte(dest);
+  p^ := (dest^.blue * a1f + c.blue * a2f + a12m) div a12;
+  Inc(p);
+  p^ := (dest^.green * a1f + c.green * a2f + a12m) div a12;
+  Inc(p);
+  p^ := (dest^.red * a1f + c.red * a2f + a12m) div a12;
+  Inc(p);
+  p^ := (a12 + a12 shr 7) shr 8;
+  PDWord(dest)^ := (((dest^.red * a1f + c.red * a2f + a12m) div a12) shl TBGRAPixel_RedShift) or
+                   (((dest^.green * a1f + c.green * a2f + a12m) div a12) shl TBGRAPixel_GreenShift) or
+                   (((dest^.blue * a1f + c.blue * a2f + a12m) div a12) shl TBGRAPixel_BlueShift) or
+                   (((a12 + a12 shr 7) shr 8) shl TBGRAPixel_AlphaShift);
 end;
 …
 procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel;
   maxDiff: byte); inline;
+begin
+  DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue,
+    (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div
+    (maxDiff + 1)));
+var alpha: NativeInt;
+begin
+  alpha := (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div
+    (maxDiff + 1);
+  if alpha > 0 then
+    DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue, alpha));
 end;

GraphicTest/Packages/bgrabitmap/bgracanvas.pas

-              r472
+              r494
 uses
   Classes, SysUtils, FPCanvas, Graphics, GraphType, Types, FPImage, BGRABitmapTypes;
+  Classes, SysUtils, FPCanvas, BGRAGraphics, Types, FPImage, BGRABitmapTypes;
 type
 …
   Style: TGraphicsBevelCut);
 begin
   Frame3D(bounds,width,style,ColorToBGRA(ColorToRGB(clBtnHighlight)),ColorToBGRA(ColorToRGB(clBtnShadow)));
+  Frame3D(bounds,width,style,ColorToBGRA(clRgbBtnHighlight),ColorToBGRA(clRgbBtnShadow));
 end;
 …
     RStop,RStart: Byte;
   begin
     RedGreenBlue(ColorToRGB(AStart), RStart, GStart, BStart);
+      RedGreenBlue(ColorToRGB(AStart), RStart, GStart, BStart);
       RedGreenBlue(ColorToRGB(AStop),  RStop,  GStop,  BStop);

GraphicTest/Packages/bgrabitmap/bgracanvas2d.pas

-              r472
+              r494
 uses
+  Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATransform, BGRAGradientScanner, BGRAPath;
+  Classes, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform,
+  BGRAGradientScanner, BGRAPath, BGRAPen;
 type
 …
   TBGRACanvasState2D = class
+  private
+    FClipMask: TBGRACustomBitmap;
+    FClipMaskOwned: boolean;
+    function GetClipMaskReadWrite: TBGRACustomBitmap;
+  public
     strokeColor: TBGRAPixel;
     strokeTextureProvider: IBGRACanvasTextureProvider2D;
 …
     lineWidth: single;
+    lineCap: TPenEndCap;
+    lineJoin: TPenJoinStyle;
+    lineStyle: TBGRAPenStyle;
+    miterLimit: single;
+    penStroker: TBGRAPenStroker;
     shadowOffsetX,shadowOffsetY,shadowBlur: single;
 …
     matrix: TAffineMatrix;
+    clipMask: TBGRACustomBitmap;
+    constructor Create(AMatrix: TAffineMatrix; AClipMask: TBGRACustomBitmap);
+    constructor Create(AMatrix: TAffineMatrix; AClipMask: TBGRACustomBitmap; AClipMaskOwned: boolean);
     function Duplicate: TBGRACanvasState2D;
     destructor Destroy; override;
+    procedure SetClipMask(AClipMask: TBGRACustomBitmap; AOwned: boolean);
+    property clipMaskReadOnly: TBGRACustomBitmap read FClipMask;
+    property clipMaskReadWrite: TBGRACustomBitmap read GetClipMaskReadWrite;
   end;
 …
     FFontRenderer: TBGRACustomFontRenderer;
     FLastCoord, FStartCoord: TPointF;
     function GetCurrentPath: ArrayOfTPointF;
+    function GetCurrentPathAsPoints: ArrayOfTPointF;
     function GetFontName: string;
     function GetFontRenderer: TBGRACustomFontRenderer;
 …
     function GetShadowOffsetX: single;
     function GetShadowOffsetY: single;
+    function GetStrokeMatrix: TAffineMatrix;
     function GetTextAlign: string;
     function GetTextAlignLCL: TAlignment;
 …
     procedure SetShadowOffsetX(const AValue: single);
     procedure SetShadowOffsetY(const AValue: single);
+    procedure SetStrokeMatrix(AValue: TAffineMatrix);
     procedure SetTextAlign(AValue: string);
     procedure SetTextAlignLCL(AValue: TAlignment);
 …
     function GetDrawMode: TDrawMode;
     procedure copyTo({%H-}dest: IBGRAPath); //IBGRAPath
+    function getPoints: ArrayOfTPointF; //IBGRAPath
+    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF; //IBGRAPath
+    function getCursor: TBGRACustomPathCursor; //IBGRAPath
   public
     antialiasing, linearBlend: boolean;
 …
     procedure rotate(angleRadCW: single);
     procedure translate(x,y: single);
+    procedure transform(a,b,c,d,e,f: single); overload;
+    procedure skewx(angleRadCW: single);
+    procedure skewy(angleRadCW: single);
+    procedure transform(m11,m21, m12,m22, m13,m23: single); overload;
     procedure transform(AMatrix: TAffineMatrix); overload;
     procedure setTransform(a,b,c,d,e,f: single);
+    procedure setTransform(m11,m21, m12,m22, m13,m23: single);
     procedure resetTransform;
+    procedure strokeScale(x,y: single);
+    procedure strokeSkewx(angleRadCW: single);
+    procedure strokeSkewy(angleRadCW: single);
+    procedure strokeResetTransform;
     procedure strokeStyle(color: TBGRAPixel); overload;
     procedure strokeStyle(color: TColor); overload;
 …
     procedure roundRect(x,y,w,h,radius: single); overload;
     procedure roundRect(x,y,w,h,rx,ry: single); overload;
+    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle);
+    procedure closedSpline(const pts: array of TPointF; style: TSplineStyle);
     procedure spline(const pts: array of TPointF; style: TSplineStyle= ssOutside);
     procedure splineTo(const pts: array of TPointF; style: TSplineStyle= ssOutside);
 …
     property globalAlpha: single read GetGlobalAlpha write SetGlobalAlpha;
     property matrix: TAffineMatrix read GetMatrix write SetMatrix;
+    property strokeMatrix: TAffineMatrix read GetStrokeMatrix write SetStrokeMatrix;
     property lineWidth: single read GetLineWidth write SetLineWidth;
 …
     property textBaseline: string read GetTextBaseline write SetTextBaseine;
     property currentPath: ArrayOfTPointF read GetCurrentPath;
+    property currentPath: ArrayOfTPointF read GetCurrentPathAsPoints;
     property fontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer;
 …
 implementation
 uses Types, Math, BGRAPen, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64;
+uses Types, Math, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64;
 type
 …
 { TBGRACanvasState2D }
+function TBGRACanvasState2D.GetClipMaskReadWrite: TBGRACustomBitmap;
+begin
+  if not FClipMaskOwned then
+  begin
+    if FClipMask <> nil then
+      FClipMask := FClipMask.Duplicate;
+    FClipMaskOwned := true;
+  end;
+  result := FClipMask;
+end;
 constructor TBGRACanvasState2D.Create(AMatrix: TAffineMatrix;
   AClipMask: TBGRACustomBitmap);
+  AClipMask: TBGRACustomBitmap; AClipMaskOwned: boolean);
 begin
   strokeColor := BGRABlack;
 …
   lineWidth := 1;
+  lineCap := pecFlat;
+  lineJoin := pjsMiter;
+  lineStyle := DuplicatePenStyle(SolidPenStyle);
+  miterLimit := 10;
+  penStroker := TBGRAPenStroker.Create;
+  penStroker.LineCap := pecFlat;
+  penStroker.JoinStyle := pjsMiter;
+  penStroker.CustomPenStyle := DuplicatePenStyle(SolidPenStyle);
+  penStroker.MiterLimit := 10;
+  penStroker.StrokeMatrix := AffineMatrixIdentity;
   shadowOffsetX := 0;
 …
   matrix := AMatrix;
+  if AClipMask = nil then
+    clipMask := nil
+  else
+    clipMask := AClipMask.Duplicate;
+  FClipMask := nil;
+  FClipMaskOwned := true;
+  SetClipMask(AClipMask,AClipMaskOwned);
 end;
 function TBGRACanvasState2D.Duplicate: TBGRACanvasState2D;
 begin
   result := TBGRACanvasState2D.Create(matrix,clipMask);
+  result := TBGRACanvasState2D.Create(matrix,clipMaskReadOnly,false);
   result.strokeColor := strokeColor;
   result.strokeTextureProvider := strokeTextureProvider;
 …
   result.lineWidth := lineWidth;
+  result.lineCap := lineCap;
+  result.lineJoin := lineJoin;
+  result.lineStyle := DuplicatePenStyle(lineStyle);
+  result.miterLimit := miterLimit;
+  result.penStroker.LineCap := penStroker.LineCap;
+  result.penStroker.JoinStyle := penStroker.JoinStyle;
+  result.penStroker.CustomPenStyle := DuplicatePenStyle(penStroker.CustomPenStyle);
+  result.penStroker.MiterLimit := penStroker.MiterLimit;
+  result.penStroker.StrokeMatrix := penStroker.StrokeMatrix;
   result.shadowOffsetX := shadowOffsetX;
 …
 destructor TBGRACanvasState2D.Destroy;
 begin
+  clipMask.Free;
+  if FClipMaskOwned and Assigned(FClipMask) then
+    FClipMask.Free;
+  penStroker.Free;
   inherited Destroy;
+end;
+procedure TBGRACanvasState2D.SetClipMask(AClipMask: TBGRACustomBitmap;
+  AOwned: boolean);
+begin
+  if FClipMaskOwned and Assigned(FClipMask) then FreeAndNil(FClipMask);
+  FClipMask := AClipMask;
+  FClipMaskOwned := AOwned;
 end;
 …
 function TBGRACanvas2D.GetLineCap: string;
 begin
   case currentState.lineCap of
+  case currentState.penStroker.LineCap of
     pecRound: result := 'round';
     pecSquare: result := 'square';
 …
 function TBGRACanvas2D.GetLineCapLCL: TPenEndCap;
 begin
   result := currentState.lineCap;
+  result := currentState.penStroker.LineCap;
 end;
 function TBGRACanvas2D.GetlineJoin: string;
 begin
   case currentState.lineJoin of
+  case currentState.penStroker.JoinStyle of
     pjsBevel: result := 'bevel';
     pjsRound: result := 'round';
 …
 function TBGRACanvas2D.GetlineJoinLCL: TPenJoinStyle;
 begin
   result := currentState.lineJoin;
+  result := currentState.penStroker.JoinStyle;
 end;
 function TBGRACanvas2D.getLineStyle: TBGRAPenStyle;
 begin
   result := DuplicatePenStyle(currentState.lineStyle);
+  result := DuplicatePenStyle(currentState.penStroker.CustomPenStyle);
 end;
 …
 function TBGRACanvas2D.GetMiterLimit: single;
 begin
   result := currentState.miterLimit;
+  result := currentState.penStroker.MiterLimit;
 end;
 …
 begin
   result := currentState.shadowOffsetY;
+end;
+function TBGRACanvas2D.GetStrokeMatrix: TAffineMatrix;
+begin
+  result := currentState.penStroker.StrokeMatrix;
 end;
 …
 end;
 function TBGRACanvas2D.GetCurrentPath: ArrayOfTPointF;
+function TBGRACanvas2D.GetCurrentPathAsPoints: ArrayOfTPointF;
 var i: integer;
 begin
 …
 begin
   if CompareText(AValue,'round')=0 then
     currentState.lineCap := pecRound else
+    currentState.penStroker.LineCap := pecRound else
   if CompareText(AValue,'square')=0 then
     currentState.lineCap := pecSquare
+    currentState.penStroker.LineCap := pecSquare
   else
     currentState.lineCap := pecFlat;
+    currentState.penStroker.LineCap := pecFlat;
 end;
 procedure TBGRACanvas2D.SetLineCapLCL(AValue: TPenEndCap);
 begin
   currentState.lineCap := AValue;
+  currentState.penStroker.LineCap := AValue;
 end;
 …
 begin
   if CompareText(AValue,'round')=0 then
     currentState.lineJoin := pjsRound else
+    currentState.penStroker.JoinStyle := pjsRound else
   if CompareText(AValue,'bevel')=0 then
     currentState.lineJoin := pjsBevel
+    currentState.penStroker.JoinStyle := pjsBevel
   else
     currentState.lineJoin := pjsMiter;
+    currentState.penStroker.JoinStyle := pjsMiter;
 end;
 …
   if (length(points) = 0) or (surface = nil) then exit;
   If hasShadow then DrawShadow(points,[]);
   if currentState.clipMask <> nil then
+  if currentState.clipMaskReadOnly <> nil then
   begin
     if currentState.fillTextureProvider <> nil then
       tempScan := TBGRATextureMaskScanner.Create(currentState.clipMask,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha)
+      tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha)
     else
       tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.fillColor));
+      tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor));
     if self.antialiasing then
       BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true, linearBlend)
 …
   multi := TBGRAMultishapeFiller.Create;
   multi.FillMode := fmWinding;
   if currentState.clipMask <> nil then
+  if currentState.clipMaskReadOnly <> nil then
   begin
     if currentState.fillTextureProvider <> nil then
       tempScan := TBGRATextureMaskScanner.Create(currentState.clipMask,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha)
+      tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.fillTextureProvider.texture,currentState.globalAlpha)
     else
       tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.fillColor));
+      tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.fillColor));
     multi.AddPolygon(points, tempScan);
   end else
 …
   if currentState.lineWidth > 0 then
   begin
+    contour := ComputeWidePolylinePoints(points,currentState.lineWidth,BGRAPixelTransparent,
+        currentState.lineCap,currentState.lineJoin,currentState.lineStyle,[plAutoCycle],miterLimit);
+    if currentState.clipMask <> nil then
+    contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth);
+    if currentState.clipMaskReadOnly <> nil then
     begin
       if currentState.strokeTextureProvider <> nil then
         tempScan2 := TBGRATextureMaskScanner.Create(currentState.clipMask,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha)
+        tempScan2 := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha)
       else
         tempScan2 := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor));
+        tempScan2 := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor));
       multi.AddPolygon(contour,tempScan);
     end else
 …
 procedure TBGRACanvas2D.SetLineJoinLCL(AValue: TPenJoinStyle);
 begin
   currentState.lineJoin := AValue;
+  currentState.penStroker.JoinStyle := AValue;
 end;
 procedure TBGRACanvas2D.lineStyle(const AValue: array of single);
 begin
   currentState.lineStyle := DuplicatePenStyle(AValue);
+  currentState.penStroker.CustomPenStyle := DuplicatePenStyle(AValue);
 end;
 …
 procedure TBGRACanvas2D.SetMiterLimit(const AValue: single);
 begin
   currentState.miterLimit := AValue;
+  currentState.penStroker.MiterLimit := AValue;
 end;
 …
 begin
   currentState.shadowOffsetY := AValue;
+end;
+procedure TBGRACanvas2D.SetStrokeMatrix(AValue: TAffineMatrix);
+begin
+  currentState.penStroker.strokeMatrix := AValue;
 end;
 …
 begin
   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);
+  contour := currentState.penStroker.ComputePolylineAutocycle(points,currentState.lineWidth);
   If hasShadow then DrawShadow(contour,[]);
   if currentState.clipMask <> nil then
+  if currentState.clipMaskReadOnly <> nil then
   begin
     if currentState.strokeTextureProvider <> nil then
       tempScan := TBGRATextureMaskScanner.Create(currentState.clipMask,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha)
+      tempScan := TBGRATextureMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),currentState.strokeTextureProvider.texture,currentState.globalAlpha)
     else
       tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor));
+      tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMaskReadOnly,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor));
     if self.antialiasing then
       BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True, linearBlend)
 …
   maxRect := Types.Rect(0,0,width,height);
   if currentState.clipMask <> nil then
+  if currentState.clipMaskReadOnly <> nil then
     foundRect := maxRect
   else
   begin
     firstFound := true;
+    foundRect := EmptyRect;
     for i := 0 to high(ofsPts) do
       AddPt(ofsPts[i]);
 …
     end;
   end;
   if currentState.clipMask <> nil then
     tempBmp.ApplyMask(currentState.clipMask);
+  if currentState.clipMaskReadOnly <> nil then
+    tempBmp.ApplyMask(currentState.clipMaskReadOnly);
   surface.PutImage(foundRect.Left,foundRect.Top,tempBmp,GetDrawMode,currentState.globalAlpha);
   tempBmp.Free;
 …
 end;
+function TBGRACanvas2D.getPoints: ArrayOfTPointF;
+begin
+  result := GetCurrentPathAsPoints;
+end;
+function TBGRACanvas2D.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
+begin
+  result := GetCurrentPathAsPoints;
+  if not IsAffineMatrixIdentity(AMatrix) then
+    result := AMatrix*result;
+end;
+function TBGRACanvas2D.getCursor: TBGRACustomPathCursor;
+begin
+  result := nil;
+end;
 constructor TBGRACanvas2D.Create(ASurface: TBGRACustomBitmap);
 begin
 …
   FLastCoord := EmptyPointF;
   FStartCoord := EmptyPointF;
   currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil);
+  currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil,true);
   pixelCenteredCoordinates := false;
   antialiasing := true;
 …
 procedure TBGRACanvas2D.translate(x, y: single);
 begin
+  if (x = 0) and (y = 0) then exit;
   currentState.matrix *= AffineMatrixTranslation(x,y);
 end;
+procedure TBGRACanvas2D.transform(a, b, c, d, e, f: single);
+begin
+  currentState.matrix *= AffineMatrix(a,c,e,b,d,f);
+procedure TBGRACanvas2D.skewx(angleRadCW: single);
+begin
+  currentState.matrix *= AffineMatrixSkewXRad(-angleRadCW);
+end;
+procedure TBGRACanvas2D.skewy(angleRadCW: single);
+begin
+  currentState.matrix *= AffineMatrixSkewYRad(-angleRadCW);
+end;
+procedure TBGRACanvas2D.transform(m11,m21, m12,m22, m13,m23: single);
+begin
+  currentState.matrix *= AffineMatrix(m11,m12,m13,
+                                      m21,m22,m23);
 end;
 …
 end;
+procedure TBGRACanvas2D.setTransform(a, b, c, d, e, f: single);
+begin
+  currentState.matrix := AffineMatrix(a,c,e,b,d,f);
+procedure TBGRACanvas2D.setTransform(m11,m21, m12,m22, m13,m23: single);
+begin
+  currentState.matrix := AffineMatrix(m11,m12,m13,
+                                      m21,m22,m23);
 end;
 …
 begin
   currentState.matrix := AffineMatrixIdentity;
+end;
+procedure TBGRACanvas2D.strokeScale(x, y: single);
+begin
+  currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixScale(x,y);
+end;
+procedure TBGRACanvas2D.strokeSkewx(angleRadCW: single);
+begin
+  currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewXRad(-angleRadCW);
+end;
+procedure TBGRACanvas2D.strokeSkewy(angleRadCW: single);
+begin
+  currentState.penStroker.strokeMatrix := currentState.penStroker.strokeMatrix * AffineMatrixSkewYRad(-angleRadCW);
+end;
+procedure TBGRACanvas2D.strokeResetTransform;
+begin
+  currentState.penStroker.strokeMatrix := AffineMatrixIdentity;
 end;
 …
   arcTo(rx,ry,0,false,false,x+rx,y);
   closePath;
+end;
+procedure TBGRACanvas2D.openedSpline(const pts: array of TPointF;
+  style: TSplineStyle);
+var transf: array of TPointF;
+begin
+  if length(pts)=0 then exit;
+  transf := ApplyTransform(pts);
+  transf := BGRAPath.ComputeOpenedSpline(transf,style);
+  AddPoints(transf);
+  FLastCoord := pts[high(pts)];
+end;
+procedure TBGRACanvas2D.closedSpline(const pts: array of TPointF;
+  style: TSplineStyle);
+var transf: array of TPointF;
+begin
+  if length(pts)=0 then exit;
+  transf := ApplyTransform(pts);
+  transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style);
+  AddPoints(transf);
+  FLastCoord := pts[high(pts)];
 end;
 …
   if FPathPointCount = 0 then
   begin
     currentState.clipMask.Fill(BGRABlack);
+    currentState.clipMaskReadWrite.Fill(BGRABlack);
     exit;
   end;
   if currentState.clipMask = nil then
     currentState.clipMask := surface.NewBitmap(width,height,BGRAWhite);
+  if currentState.clipMaskReadOnly = nil then
+    currentState.SetClipMask(surface.NewBitmap(width,height,BGRAWhite),True);
   tempBmp := surface.NewBitmap(width,height,BGRABlack);
   if antialiasing then
 …
   else
     tempBmp.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet);
   currentState.clipMask.BlendImage(0,0,tempBmp,boDarken);
+  currentState.clipMaskReadWrite.BlendImage(0,0,tempBmp,boDarken);
   tempBmp.Free;
 end;
 …
 begin
   if FPathPointCount = 0 then exit;
   if currentState.clipMask = nil then exit;
+  if currentState.clipMaskReadOnly = nil then exit;
   if antialiasing then
     currentState.clipMask.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite)
+    currentState.clipMaskReadWrite.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite)
   else
     currentState.clipMask.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet);
   if currentState.clipMask.Equals(BGRAWhite) then
     FreeAndNil(currentState.clipMask);
+    currentState.clipMaskReadWrite.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet);
+  if currentState.clipMaskReadOnly.Equals(BGRAWhite) then
+    currentState.SetClipMask(nil,true);
 end;

GraphicTest/Packages/bgrabitmap/bgracolorint.pas

-              r472
+              r494
 operator *(const color1,color2: TColorInt65536): TColorInt65536;
 operator *(const color1: TColorInt65536; factor65536: integer): TColorInt65536;
 function ColorIntToBGRA(const AColor: TColorInt65536): TBGRAPixel;
 function BGRAToColorInt(const AColor: TBGRAPixel): TColorInt65536;
+function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean = false): TBGRAPixel;
+function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean = false): TColorInt65536;
 function BGRAToColorIntMultiply(const color1: TBGRAPixel; const color2: TColorInt65536): TColorInt65536;
 …
 {$endif}
+function BGRAToColorInt(const AColor: TBGRAPixel): TColorInt65536;
+begin
+  result.r := AColor.red shl 8 + AColor.red + (AColor.red shr 7);
+  result.g := AColor.green shl 8 + AColor.green + (AColor.green shr 7);
+  result.b := AColor.blue shl 8 + AColor.blue + (AColor.blue shr 7);
+function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean): TColorInt65536;
+begin
+  if AGammaExpansion then
+  begin
+    result.r := GammaExpansionTab[AColor.red] + (AColor.red shr 7);
+    result.g := GammaExpansionTab[AColor.green] + (AColor.green shr 7);
+    result.b := GammaExpansionTab[AColor.blue] + (AColor.blue shr 7);
+  end else
+  begin
+    result.r := AColor.red shl 8 + AColor.red + (AColor.red shr 7);
+    result.g := AColor.green shl 8 + AColor.green + (AColor.green shr 7);
+    result.b := AColor.blue shl 8 + AColor.blue + (AColor.blue shr 7);
+  end;
   result.a := AColor.alpha shl 8 + AColor.alpha+ (AColor.alpha shr 7);
 end;
 …
     mov ecx, [Color1]
+    movzx eax, cl //b
+    mov eax, ecx
+    shr eax, TBGRAPixel_RedShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx], edx
+    mov eax, ecx
+    shr eax, TBGRAPixel_GreenShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi+4]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx+4], edx
+    mov eax, ecx
+    shr eax, TBGRAPixel_BlueShift
+    and eax, 255
     mov edx, eax
     shr edx, 7
 …
     or edx, eax
     mov [ebx+8], edx
+    shr ecx, 8
+    movzx eax, cl //g
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi+4]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx+4], edx
+    shr ecx, 8
+    movzx eax, cl //r
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx], edx
+    shr ecx, 8
+    movzx eax, cl //a
+    mov eax, ecx
+    shr eax, TBGRAPixel_AlphaShift
+    and eax, 255
     mov edx, eax
     shr edx, 7
 …
 {$ENDIF}
 function ColorIntToBGRA(const AColor: TColorInt65536): TBGRAPixel;
+function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean): TBGRAPixel;
 var maxValue,invMaxValue,r,g,b: integer;
 begin
 …
   end;
+  if maxValue <= 65535 then
+  begin
+    if AColor.r <= 0 then result.red := 0 else
+      result.red := AColor.r shr 8 - (AColor.r shr 15);
+    if AColor.g <= 0 then result.green := 0 else
+      result.green := AColor.g shr 8 - (AColor.g shr 15);
+    if AColor.b <= 0 then result.blue := 0 else
+      result.blue := AColor.b shr 8 - (AColor.b shr 15);
+    exit;
+  end;
+  invMaxValue := (1073741824+maxValue-1) div maxValue;
+  maxValue := (maxValue-65535) shr 9;
+  if AColor.r < 0 then r := 0 else
+    r := AColor.r*invMaxValue shr 22 + maxValue;
+  if AColor.g < 0 then g := 0 else
+    g := AColor.g*invMaxValue shr 22 + maxValue;
+  if AColor.b < 0 then b := 0 else
+    b := AColor.b*invMaxValue shr 22 + maxValue;
+  if r >= 255 then result.red := 255 else
+    result.red := r;
+  if g >= 255 then result.green := 255 else
+      result.green := g;
+  if b >= 255 then result.blue := 255 else
+    result.blue := b;
+  if AGammaCompression then
+  begin
+    if maxValue <= 65535 then
+    begin
+      if AColor.r <= 0 then result.red := 0 else
+        result.red := GammaCompressionTab[AColor.r - (AColor.r shr 15)];
+      if AColor.g <= 0 then result.green := 0 else
+        result.green :=GammaCompressionTab[AColor.g - (AColor.g shr 15)];
+      if AColor.b <= 0 then result.blue := 0 else
+        result.blue := GammaCompressionTab[AColor.b - (AColor.b shr 15)];
+      exit;
+    end;
+    invMaxValue := (1073741824+maxValue-1) div maxValue;
+    maxValue := (maxValue-65535) shr 1;
+    if AColor.r < 0 then r := maxValue else
+      r := AColor.r*invMaxValue shr 14 + maxValue;
+    if AColor.g < 0 then g := maxValue else
+      g := AColor.g*invMaxValue shr 14 + maxValue;
+    if AColor.b < 0 then b := maxValue else
+      b := AColor.b*invMaxValue shr 14 + maxValue;
+    if r >= 65535 then result.red := 255 else
+      result.red := GammaCompressionTab[r];
+    if g >= 65535 then result.green := 255 else
+        result.green := GammaCompressionTab[g];
+    if b >= 65535 then result.blue := 255 else
+      result.blue := GammaCompressionTab[b];
+  end else
+  begin
+    if maxValue <= 65535 then
+    begin
+      if AColor.r <= 0 then result.red := 0 else
+        result.red := AColor.r shr 8 - (AColor.r shr 15);
+      if AColor.g <= 0 then result.green := 0 else
+        result.green := AColor.g shr 8 - (AColor.g shr 15);
+      if AColor.b <= 0 then result.blue := 0 else
+        result.blue := AColor.b shr 8 - (AColor.b shr 15);
+      exit;
+    end;
+    invMaxValue := (1073741824+maxValue-1) div maxValue;
+    maxValue := (maxValue-65535) shr 9;
+    if AColor.r < 0 then r := maxValue else
+      r := AColor.r*invMaxValue shr 22 + maxValue;
+    if AColor.g < 0 then g := maxValue else
+      g := AColor.g*invMaxValue shr 22 + maxValue;
+    if AColor.b < 0 then b := maxValue else
+      b := AColor.b*invMaxValue shr 22 + maxValue;
+    if r >= 255 then result.red := 255 else
+      result.red := r;
+    if g >= 255 then result.green := 255 else
+        result.green := g;
+    if b >= 255 then result.blue := 255 else
+      result.blue := b;
+  end;
 end;

GraphicTest/Packages/bgrabitmap/bgracolorquantization.pas

-              r472
+              r494
   { TBGRAColorQuantizer }
   TBGRAColorQuantizer = class
+  TBGRAColorQuantizer = class(TBGRACustomColorQuantizer)
   private
     FColors: ArrayOfWeightedColor;
 …
     FReductionKeepContrast: boolean;
     FSeparateAlphaChannel: boolean;
-    function GetPalette: TBGRAApproxPalette;
-    function GetSourceColor(AIndex: integer): TBGRAPixel;
-    function GetSourceColorCount: Integer;
     procedure Init(ABox: TBGRAColorBox);
-    procedure SetReductionColorCount(AValue: Integer);
     procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, AAlphaBounds: TDimensionMinMax; AUniform: boolean);
     procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax);
+  protected
+    function GetPalette: TBGRACustomApproxPalette; override;
+    function GetSourceColor(AIndex: integer): TBGRAPixel; override;
+    function GetSourceColorCount: Integer; override;
+    function GetReductionColorCount: integer; override;
+    procedure SetReductionColorCount(AValue: Integer); override;
   public
     constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); overload;
     constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload;
     constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload;
     constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); overload;
+    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); override;
+    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); override;
+    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); override;
+    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); override;
     destructor Destroy; override;
+    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect);
+    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap);
+    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
+    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
+    procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string);
+    procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string; AFormat: TBGRAImageFormat);
+    procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat);
+    property SourceColorCount: Integer read GetSourceColorCount;
+    property SourceColor[AIndex: integer]: TBGRAPixel read GetSourceColor;
+    property ReductionColorCount: Integer read FReductionColorCount write SetReductionColorCount;
+    property ReducedPalette: TBGRAApproxPalette read GetPalette;
+    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); override;
+    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; override;
+    function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm;
+      ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; override;
+    procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm;
+      ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override;
   end;
 …
   private
     FTree: TBGRAColorTree;
     FColors: ArrayOfTBGRAPixel;
+    FColors: ArrayOfWeightedColor;
   protected
     function GetCount: integer; override;
     function GetColorByIndex(AIndex: integer): TBGRAPixel; override;
+    function GetWeightByIndex(AIndex: Integer): UInt32; override;
     procedure Init(const AColors: ArrayOfTBGRAPixel);
   public
 …
     end;
     FLargerOwned: boolean;
+    FTransparentColorIndex: integer;
   protected
     function FindNearestLargerColorIndex(AValue: TBGRAPixel): integer; virtual;
 …
     function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override;
     function FindNearestColorIndex(AValue: TBGRAPixel): integer; override;
+  end;
+  TIsChannelStrictlyGreaterFunc = function (p1,p2 : PBGRAPixel): boolean;
+    function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override;
+  end;
+  TIsChannelStrictlyGreaterFunc = TBGRAPixelComparer;
   TIsChannelGreaterThanOrEqualToValueFunc = function (p : PBGRAPixel; v: UInt32): boolean;
 …
     FColors: ArrayOfWeightedColor;
     FDimensions: TColorDimensions;
     FHasPureTransparentColor: boolean;
+    FPureTransparentColorCount: integer;
     function GetApparentInterval(ADimension: TColorDimension): UInt32;
     function GetAverageColor: TBGRAPixel;
 …
     function GetBounds(ADimension: TColorDimension): TDimensionMinMax;
     function GetColorCount(ACountPureTransparent: boolean): integer;
+    function GetHasPureTransparentColor: boolean;
     function GetInferiorColor: TBGRAPixel;
     function GetLargestApparentDimension: TColorDimension;
 …
     procedure Init(AColors: ArrayOfWeightedColor; AOwner: boolean);
     procedure SortBy(ADimension: TColorDimension);
-    procedure InsertionSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex, AMaxIndex: NativeInt);
-    procedure QuickSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex, AMaxIndex: NativeInt);
     function GetMedianIndex(ADimension : TColorDimension; AMinValue, AMaxValue: UInt32): integer;
   public
     constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); overload;
     constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfTBGRAPixel); overload;
+    constructor Create(ADimensions: TColorDimensions; const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); overload;
     constructor Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); overload;
     constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload;
     constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload;
+    constructor Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); overload;
     function BoundsContain(AColor: TBGRAPixel): boolean;
     function MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32): TBGRAColorBox;
 …
     property TotalWeight: UInt32 read FTotalWeight;
     property ColorCount[ACountPureTransparent: boolean]: integer read GetColorCount;
+    property HasPureTransparentColor: boolean read FHasPureTransparentColor;
+    property HasPureTransparentColor: boolean read GetHasPureTransparentColor;
+    property PureTransparentColorCount: integer read FPureTransparentColorCount;
   end;
 …
     FAverageColor: TBGRAPixel;
     FHasPureTransparentColor: boolean;
+    FPureTransparentColorCount: integer;
     FPureTransparentColorIndex: integer;
     FDimension: TColorDimension;
 …
     FInferiorBranch, FSuperiorBranch: TBGRAColorTree;
     function GetApproximatedColorCount: integer;
+    function GetHasPureTransparentColor: boolean;
     function GetLeafCount: integer;
     procedure Init(ALeaf: TBGRAColorBox; AOwned: boolean);
 …
     function ApproximateColorIndex(AColor: TBGRAPixel): integer;
     function GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel;
+    function GetAsArrayOfWeightedColors: ArrayOfWeightedColor;
     procedure SplitIntoPalette(ACount: integer; AMethod: TBiggestLeafMethod;
       ALeafColor: TBGRALeafColorMode);
 …
     property LeafCount: integer read GetLeafCount;
     property ApproximatedColorCount: integer read GetApproximatedColorCount;
+    property HasPureTransparentColor: boolean read FHasPureTransparentColor;
+    property HasPureTransparentColor: boolean read GetHasPureTransparentColor;
+    property PureTransparentColorCount: integer read FPureTransparentColorCount;
   end;
 …
 implementation
 uses BGRADithering, lazutf8classes, FPimage, FPWriteBMP, FPWritePNG;
+uses BGRADithering, FPimage, FPWriteBMP, BGRAWritePNG;
 const MedianMinPercentage = 0.2;
 …
 const
-  InsertionSortLimit = 10;
   ApproxPaletteDimensions = [cdAlpha,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG,cdRGB];
 …
   if AValue.alpha = 0 then
   begin
     result := -1;
+    result := FTransparentColorIndex;
     exit;
   end;
   diff := BGRAWordDiff(AValue, FColors[0]);
+  diff := BGRAWordDiff(AValue, FColors[0].Color);
   result := 0;
   for i := 0 to high(FColors) do
   begin
     curDiff := BGRAWordDiff(AValue, FColors[i]);
+    curDiff := BGRAWordDiff(AValue, FColors[i].Color);
     if curDiff < diff then
     begin
 …
   const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean);
 var i: integer;
+  largeWeighted: ArrayOfWeightedColor;
 begin
   inherited Create(AColors);
+  FTransparentColorIndex:= -1;
+  for i := 0 to high(FColors) do
+  begin
+    FColors[i].Weight := 0;
+    if FColors[i].Color.alpha = 0 then FTransparentColorIndex:= i;
+  end;
   FLarger := ALarger;
   FLargerOwned := ALargerOwned;
+  setlength(FLargerColors, FLarger.Count);
+  largeWeighted := FLarger.GetAsArrayOfWeightedColor;
+  setlength(FLargerColors, length(largeWeighted));
   for i := 0 to high(FLargerColors) do
   with FLargerColors[i] do
   begin
     approxColorIndex := SlowFindNearestColorIndex(FLarger.Color[i]);
+    approxColorIndex := SlowFindNearestColorIndex(largeWeighted[i].Color);
     if approxColorIndex = -1 then
       approxColor := BGRAPixelTransparent
     else
+      approxColor := FColors[approxColorIndex];
+    begin
+      approxColor := FColors[approxColorIndex].Color;
+      inc(FColors[approxColorIndex].Weight, largeWeighted[i].Weight);
+    end;
   end;
 end;
 …
 end;
+function TBGRAApproxPaletteViaLargerPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor;
+var
+  i: Integer;
+begin
+  setlength(result, length(FColors));
+  for i := 0 to high(FColors) do
+    result[i] := FColors[i];
+end;
 { TBGRAApproxPalette }
 …
   if (AIndex < 0) or (AIndex >= length(FColors)) then
     raise ERangeError.Create('Index out of bounds');
+  result := FColors[AIndex];
+  result := FColors[AIndex].Color;
+end;
+function TBGRAApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32;
+begin
+  if (AIndex < 0) or (AIndex >= length(FColors)) then
+    raise ERangeError.Create('Index out of bounds');
+  result := FColors[AIndex].Weight;
 end;
 …
   FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage);
   FColors := FTree.GetAsArrayOfApproximatedColors;
+  FColors := FTree.GetAsArrayOfWeightedColors;
 end;
 …
   FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage);
   FColors := FTree.GetAsArrayOfApproximatedColors;
+  FColors := FTree.GetAsArrayOfWeightedColors;
 end;
 …
 begin
   FTree := AOwnedSplitTree;
   FColors := FTree.GetAsArrayOfApproximatedColors;
+  FColors := FTree.GetAsArrayOfWeightedColors;
 end;
 …
 begin
   result := FTree.ApproximateColorIndex(AValue);
   if (result <> -1) and not (DWord(FColors[result]) = DWord(AValue)) then result := -1;
+  if (result <> -1) and not (DWord(FColors[result].Color) = DWord(AValue)) then result := -1;
 end;
 …
   setlength(result, length(FColors));
   for i := 0 to high(result) do
     result[i] := FColors[i];
+    result[i] := FColors[i].Color;
 end;
 …
   i: NativeInt;
 begin
+  setlength(result, length(FColors));
+  for i := 0 to high(result) do
+  with result[i] do
+  begin
+    Color := FColors[i];
+    Weight:= 1;
+  if Assigned(FTree) then
+    result := FTree.GetAsArrayOfWeightedColors
+  else
+  begin
+    setlength(result, length(FColors));
+    for i := 0 to high(result) do
+      result[i] := FColors[i];
   end;
 end;
 …
 begin
   FColors := ABox.FColors;
   if ABox.FHasPureTransparentColor then
+  if ABox.HasPureTransparentColor then
   begin
     setlength(FColors,length(FColors)+1);
 …
     begin
       Color := BGRAPixelTransparent;
       Weight:= 1;
+      Weight:= ABox.PureTransparentColorCount;
     end;
   end;
 …
 end;
+function TBGRAColorQuantizer.GetPalette: TBGRAApproxPalette;
+function TBGRAColorQuantizer.GetReductionColorCount: integer;
+begin
+  result := FReductionColorCount;
+end;
+function TBGRAColorQuantizer.GetPalette: TBGRACustomApproxPalette;
 var
   tree: TBGRAColorTree;
   procedure MakeTreeErrorDiffusionFriendly;
   var moreColors: ArrayOfTBGRAPixel;
+  var moreColors: ArrayOfWeightedColor;
     box: TBGRAColorBox;
   begin
     moreColors := tree.GetAsArrayOfApproximatedColors;
+    moreColors := tree.GetAsArrayOfWeightedColors;
     tree.free;
     box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors);
+    box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors,True);
     tree := TBGRAColorTree.Create(box,True);
     tree.SplitIntoPalette(box.ColorCount[true], blApparentInterval, lcAverage);
 …
     bounds[cdBlue] := originalBox.Bounds[cdBlue];
     bounds[cdAlpha] := originalBox.Bounds[cdAlpha];
     if originalBox.FHasPureTransparentColor then bounds[cdAlpha].Minimum := 0;
+    if originalBox.HasPureTransparentColor then bounds[cdAlpha].Minimum := 0;
     if FReductionColorCount = 1 then
     begin
 …
 end;
-procedure TBGRAColorQuantizer.ApplyDitheringInplace(
-  AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap);
-begin
-  ApplyDitheringInplace(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height));
-end;
 function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm;
   ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
 …
 end;
+function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm;
+  ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
+var task: TDitheringTask;
+begin
+  task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel);
+  result := task.Execute;
+  task.Free;
+end;
+procedure TBGRAColorQuantizer.SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  AFilenameUTF8: string);
+begin
+  SaveBitmapToFile(AAlgorithm, ABitmap, AFilenameUTF8, SuggestImageFormat(AFilenameUTF8));
+end;
+procedure TBGRAColorQuantizer.SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  AFilenameUTF8: string; AFormat: TBGRAImageFormat);
+function TBGRAColorQuantizer.GetDitheredBitmapIndexedData(
+  ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  out AScanlineSize: PtrInt): Pointer;
 var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate);
+   try
+     SaveBitmapToStream(AAlgorithm, ABitmap, stream, AFormat);
+   finally
+     stream.Free;
+   end;
+  indexer: TDitheringToIndexedImage;
+begin
+  indexer := TDitheringToIndexedImage.Create(ReducedPalette, FSeparateAlphaChannel, ABitDepth, AByteOrder);
+  indexer.DefaultTransparentColorIndex := ReducedPalette.IndexOfColor(BGRAPixelTransparent);
+  AScanlineSize:= indexer.ComputeMinimumScanlineSize(ABitmap.Width);
+  result := indexer.DitherImage(AAlgorithm, ABitmap, AScanlineSize);
+  indexer.Free;
 end;
 …
     writer := CreateBGRAImageWriter(AFormat, hasTransp);
     try
       if writer is TFPWriterPNG then TFPWriterPNG(writer).Indexed := true else
+      if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).Indexed := true else
       if writer is TFPWriterBMP then
       begin
 …
 begin
   index := 0;
   if FHasPureTransparentColor then
+  if HasPureTransparentColor then
   begin
     FPureTransparentColorIndex:= index;
 …
   begin
     CheckColorComputed;
     setlength(result,1+byte(FHasPureTransparentColor));
+    setlength(result,1+byte(HasPureTransparentColor));
     idx := 0;
     if FHasPureTransparentColor then
+    if HasPureTransparentColor then
     begin
       result[idx] := BGRAPixelTransparent;
 …
     a := FInferiorBranch.GetAsArrayOfApproximatedColors;
     b := FSuperiorBranch.GetAsArrayOfApproximatedColors;
     setlength(result, length(a)+length(b)+byte(FHasPureTransparentColor));
+    setlength(result, length(a)+length(b)+byte(HasPureTransparentColor));
     idx := 0;
     if FHasPureTransparentColor then
+    if HasPureTransparentColor then
     begin
       result[idx] := BGRAPixelTransparent;
+      inc(idx);
+    end;
+    for i := 0 to high(a) do
+    begin
+      result[idx] := a[i];
+      inc(idx);
+    end;
+    for i := 0 to high(b) do
+    begin
+      result[idx] := b[i];
+      inc(idx);
+    end;
+  end;
+end;
+function TBGRAColorTree.GetAsArrayOfWeightedColors: ArrayOfWeightedColor;
+var a,b: ArrayOfWeightedColor;
+  idx,i: integer;
+begin
+  if IsLeaf then
+  begin
+    CheckColorComputed;
+    setlength(result,1+byte(HasPureTransparentColor));
+    idx := 0;
+    if HasPureTransparentColor then
+    begin
+      result[idx].Color := BGRAPixelTransparent;
+      result[idx].Weight := PureTransparentColorCount;
+      inc(idx);
+    end;
+    result[idx].Color := FLeafColor;
+    result[idx].Weight := Weight;
+  end else
+  begin
+    a := FInferiorBranch.GetAsArrayOfWeightedColors;
+    b := FSuperiorBranch.GetAsArrayOfWeightedColors;
+    setlength(result, length(a)+length(b)+byte(HasPureTransparentColor));
+    idx := 0;
+    if HasPureTransparentColor then
+    begin
+      result[idx].Color := BGRAPixelTransparent;
+      result[idx].Weight := PureTransparentColorCount;
       inc(idx);
     end;
 …
     if Assigned(FSuperiorBranch) then result += FSuperiorBranch.ApproximatedColorCount;
   end;
+  if FHasPureTransparentColor then inc(result);
+  if HasPureTransparentColor then inc(result);
+end;
+function TBGRAColorTree.GetHasPureTransparentColor: boolean;
+begin
+  result := FPureTransparentColorCount > 0;
 end;
 …
     FMaxBorder[c] := true;
   end;
   FHasPureTransparentColor:= FLeaf.HasPureTransparentColor;
+  FPureTransparentColorCount:= FLeaf.PureTransparentColorCount;
   FPureTransparentColorIndex:= -1;
 end;
 …
       else
         result := supLeaf;
     blMix:
+    else{blMix:}
       if (sqrt(infLeaf.Weight/FWeight)*(infLeaf.LargestApparentInterval/LargestApparentInterval) >=
           sqrt(supLeaf.Weight/FWeight)*(supLeaf.LargestApparentInterval/LargestApparentInterval) ) then
 …
 begin
   result := length(FColors);
+  if ACountPureTransparent and FHasPureTransparentColor then inc(result);
+  if ACountPureTransparent and HasPureTransparentColor then inc(result);
+end;
+function TBGRAColorBox.GetHasPureTransparentColor: boolean;
+begin
+  result := FPureTransparentColorCount > 0;
 end;
 …
   c: TColorDimension;
 begin
   FHasPureTransparentColor:= false;
+  FPureTransparentColorCount:= 0;
   FTotalWeight:= 0;
   for c := low(TColorDimension) to high(TColorDimension) do
 …
       inc(idx);
     end else
       FHasPureTransparentColor:= true;
+      inc(FPureTransparentColorCount, Weight);
   end;
   setlength(FColors,idx);
 …
   comparer := GetPixelStrictComparer(ADimension);
   if comparer = nil then exit;
+  if Length(FColors) > InsertionSortLimit then
+    QuickSort(comparer,0,high(FColors))
+  else
+    InsertionSort(comparer,0,high(FColors));
+end;
+procedure TBGRAColorBox.InsertionSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex,
+  AMaxIndex: NativeInt);
+var i,j,insertPos: NativeInt;
+  compared: TBGRAWeightedPaletteEntry;
+begin
+  for i := AMinIndex+1 to AMaxIndex do
+  begin
+    insertPos := i;
+    compared := FColors[i];
+    while (insertPos > AMinIndex) and AComparer(@FColors[insertPos-1].Color,@compared.Color) do
+      dec(insertPos);
+    if insertPos <> i then
+    begin
+      for j := i downto insertPos+1 do
+        FColors[j] := FColors[j-1];
+      FColors[insertPos] := compared;
+    end;
+  end;
+end;
+procedure TBGRAColorBox.QuickSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex,
+  AMaxIndex: NativeInt);
+var Pivot: TBGRAPixel;
+  CurMin,CurMax,i : NativeInt;
+  procedure Swap(a,b: NativeInt);
+  var Temp: TBGRAWeightedPaletteEntry;
+  begin
+    if a = b then exit;
+    Temp := FColors[a];
+    FColors[a] := FColors[b];
+    FColors[b] := Temp;
+  end;
+begin
+  if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then
+  begin
+    InsertionSort(AComparer,AMinIndex,AMaxIndex);
+    exit;
+  end;
+  Pivot := FColors[(AMinIndex+AMaxIndex) shr 1].Color;
+  CurMin := AMinIndex;
+  CurMax := AMaxIndex;
+  i := CurMin;
+  while i < CurMax do
+  begin
+    if AComparer(@FColors[i].Color, @Pivot) then
+    begin
+      Swap(i, CurMax);
+      dec(CurMax);
+    end else
+    begin
+      if AComparer(@Pivot, @FColors[i].Color) then
+      begin
+        Swap(i, CurMin);
+        inc(CurMin);
+      end;
+      inc(i);
+    end;
+  end;
+  if AComparer(@Pivot, @FColors[i].Color) then
+  begin
+    Swap(i, CurMin);
+    inc(CurMin);
+  end;
+  if CurMin > AMinIndex then QuickSort(AComparer,AMinIndex,CurMin);
+  if CurMax < AMaxIndex then QuickSort(AComparer,CurMax,AMaxIndex);
+  ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),comparer)
 end;
 …
 constructor TBGRAColorBox.Create(ADimensions: TColorDimensions;
   AColors: ArrayOfTBGRAPixel);
+  const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette);
 var weightedColors: ArrayOfWeightedColor;
   i: Integer;
 begin
+  FDimensions:= ADimensions;
+  setlength(weightedColors, length(AColors));
+  for i := 0 to high(weightedColors) do
+  with weightedColors[i] do
+  begin
+    color := AColors[i];
+    Weight:= 1;
+  end;
+  Init(weightedColors,True);
+  if AAlpha = acFullChannelInPalette then
+  begin
+    FDimensions:= ADimensions;
+    setlength(weightedColors, length(AColors));
+    for i := 0 to high(weightedColors) do
+    with weightedColors[i] do
+    begin
+      color := AColors[i];
+      Weight:= 1;
+    end;
+    Init(weightedColors,True);
+  end else
+    Create(ADimensions, @AColors[0], length(AColors), AAlpha);
 end;
 …
   FBounds := ABounds;
   FTotalWeight:= 0;
   FHasPureTransparentColor:= false;
+  FPureTransparentColorCount:= 0;
 end;
 …
 end;
+constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption);
+constructor TBGRAColorBox.Create(ADimensions: TColorDimensions;
+  ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption);
+begin
+  Create(ADimensions, ABitmap.Data, ABitmap.NbPixels, AAlpha);
+end;
+constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption);
 var i,j,prev,idx: integer;
   p: PBGRAPixel;
   skip: boolean;
   alphaMask: DWord;
   transp: boolean;
+  transpIndex: integer;
 begin
   if AAlpha <> acFullChannelInPalette then
 …
     alphaMask := 0;
   FDimensions:= ADimensions;
   transp := false;
   SetLength(FColors,ABitmap.NbPixels);
+  transpIndex := -1;
+  SetLength(FColors,ANbPixels);
   if length(FColors)>0 then
   begin
     p := ABitmap.Data;
+    p := AColors;
     idx := 0;
     for i := 0 to ABitmap.NbPixels-1 do
+    for i := 0 to ANbPixels-1 do
     begin
       if (p^.alpha = 0) or ((AAlpha = acTransparentEntry) and (p^.alpha < 128)) then
       begin
         skip := true;
         if not transp and not (AAlpha = acIgnore) then
+        if not (AAlpha = acIgnore) then
         begin
           with FColors[idx] do
+          if (transpIndex=-1) then
           begin
+            Color := BGRAPixelTransparent;
+            Weight:= 1;
+          end;
+          transp := true;
+          inc(idx);
+            transpIndex := idx;
+            with FColors[idx] do
+            begin
+              Color := BGRAPixelTransparent;
+              Weight:= 1;
+            end;
+            inc(idx);
+          end else
+            inc(FColors[transpIndex].Weight);
         end;
         if (p^.alpha = 0) then
 …
     setLength(FColors, idx);
     QuickSort(@IsDWordGreater,0,high(FColors));
+    ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),@IsDWordGreater);
     prev := 0;
     for i := 1 to high(FColors) do
 …
 var i,idx: integer;
 begin
   if AIncludePureTransparent and FHasPureTransparentColor then
+  if AIncludePureTransparent and HasPureTransparentColor then
   begin
     setlength(result, length(FColors)+1);

GraphicTest/Packages/bgrabitmap/bgracompressablebitmap.pas

-              r472
+              r494
 uses
   Classes, SysUtils, BGRABitmap, GraphType, zstream;
+  Classes, SysUtils, BGRABitmapTypes, BGRABitmap, zstream;
 type
 …
 implementation
-uses BGRABitmapTypes;
 // size of each chunk treated by Compress function
 const maxPartSize = 524288;
 …
       FUncompressedData.Read(UsedPart.Data^,UsedPart.NbPixels*Sizeof(TBGRAPixel));
       if UsedPart.LineOrder <> FLineOrder then UsedPart.VerticalFlip;
+      If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue;
       result.PutImage(FBounds.Left,FBounds.Top,UsedPart,dmSet);
       UsedPart.Free;
     end;
   end else
+  begin
     FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel));
+    If TBGRAPixel_RGBAOrder then result.SwapRedBlue;
+  end;
 end;
 …
   begin
     UsedPart := Source.GetPart(FBounds) as TBGRABitmap;
+    If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue;
     FUncompressedData.Write(UsedPart.Data^,NbUsedPixels*Sizeof(TBGRAPixel));
     FLineOrder := UsedPart.LineOrder;
 …
   end else
   begin
+    If TBGRAPixel_RGBAOrder then Source.SwapRedBlue;
     FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel));
+    If TBGRAPixel_RGBAOrder then Source.SwapRedBlue;
     FLineOrder := Source.LineOrder;
   end;

GraphicTest/Packages/bgrabitmap/bgracoordpool3d.pas

-              r472
+              r494
   P := PBGRACoordData3D(FPoolData.Data);
   {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
   {$asmmode intel}
   if UseSSE then
 …
   else
   {$ENDIF}
+  {$ENDIF}
   begin
     i := UsedCapacity;
 …
   P := PBGRANormalData3D(FPoolData.Data);
   {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
   {$asmmode intel}
   if UseSSE then
 …
   else
   {$ENDIF}
+  {$ENDIF}
   begin
     i := UsedCapacity;

GraphicTest/Packages/bgrabitmap/bgradefaultbitmap.pas

-              r472
+              r494
 uses
   Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType, FPImgCanv,
   BGRACanvas, BGRACanvas2D, FPWritePng, BGRAArrow, BGRAPen;
+  SysUtils, Classes, Types, FPImage, BGRAGraphics, BGRABitmapTypes, FPImgCanv,
+  BGRACanvas, BGRACanvas2D, BGRAArrow, BGRAPen, BGRATransform;
 type
+  TBGRAPtrBitmap = class;
+  {=== TBGRABitmap reference ===}
   { TBGRADefaultBitmap }
+  {* This class is the base for all ''TBGRABitmap'' classes. It implements most
+     function to the exception from implementations specific to the
+     widgetset }{ in the doc, it is presented as
+  TBGRABitmap = class(TBGRACustomBitmap)
+  }
   TBGRADefaultBitmap = class(TBGRACustomBitmap)
   private
 …
     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 CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean;
     function GetCanvasBGRA: TBGRACanvas;
     function GetCanvas2D: TBGRACanvas2D;
+    procedure GradientFillDithered(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
+      gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+      gammaColorCorrection: boolean = True; Sinus: Boolean=False;
+      ditherAlgo: TDitheringAlgorithm = daFloydSteinberg);
+    procedure GradientFillDithered(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
+      gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+      Sinus: Boolean=False;
+      ditherAlgo: TDitheringAlgorithm = daFloydSteinberg);
   protected
     FRefCount: integer; //reference counter (not related to interface reference counter)
 …
     FData:      PBGRAPixel;              //pointer to pixels
     FWidth, FHeight, FNbPixels: integer; //dimensions
+    FScanWidth, FScanHeight: integer;    //possibility to reduce the zone being scanned
     FDataModified: boolean;              //if data image has changed so TBitmap should be updated
     FLineOrder: TRawImageLineOrder;
 …
     FScanCurX,FScanCurY: integer;   //current scan coordinates
     //LCL bitmap object
+    //GUI bitmap object
     FBitmap:   TBitmap;
     FBitmapModified: boolean;         //if TBitmap has changed so pixel data should be updated
 …
     FFontRenderer: TBGRACustomFontRenderer;
+    { Pen style can be defined by PenStyle property of by CustomPenStyle property.
+      When PenStyle property is assigned, CustomPenStyle property is assigned the actual
+      pen pattern. }
+    FCustomPenStyle:  TBGRAPenStyle;
+    FPenStyle: TPenStyle;
+    FArrow: TBGRAArrow;
+    FLineCap: TPenEndCap;
+    FPenStroker: TBGRAPenStroker;
     //Pixel data
 …
     function GetScanLine(y: integer): PBGRAPixel; override; //don't forget to call InvalidateBitmap after modifications
     function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
       AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean;
+      AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; virtual; abstract;
     function GetDataPtr: PBGRAPixel; override;
     procedure ClearTransparentPixels; override;
     function GetScanlineFast(y: integer): PBGRAPixel; inline;
     function GetLineOrder: TRawImageLineOrder; override;
+    procedure SetLineOrder(AValue: TRawImageLineOrder); virtual;
     function GetNbPixels: integer; override;
     function GetWidth: integer; override;
     function GetHeight: integer; override;
     //LCL bitmap object
+    //GUI bitmap object
     function GetBitmap: TBitmap; override;
     function GetCanvas: TCanvas; override;
 …
     function GetCanvasAlphaCorrection: boolean; override;
     procedure SetCanvasAlphaCorrection(const AValue: boolean); override;
+    procedure DoLoadFromBitmap; virtual;
     //FreePascal drawing routines
 …
     procedure ReallocData; virtual;
     procedure FreeData; virtual;
+    procedure RebuildBitmap; virtual;
+    function CreatePtrBitmap(AWidth,AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; virtual;
+    procedure RebuildBitmap; virtual; abstract;
     procedure FreeBitmap; virtual;
 …
     function GetAverageColor: TColor; override;
     function GetAveragePixel: TBGRAPixel; override;
-    function CreateAdaptedPngWriter: TFPWriterPNG;
     //drawing
+    function GetPenJoinStyle: TPenJoinStyle; override;
+    procedure SetPenJoinStyle(const AValue: TPenJoinStyle); override;
+    function GetPenMiterLimit: single; override;
+    procedure SetPenMiterLimit(const AValue: single); override;
     function GetCustomPenStyle: TBGRAPenStyle; override;
     procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override;
 …
     function GetLineCap: TPenEndCap; override;
     procedure SetLineCap(AValue: TPenEndCap); override;
+    function GetPenStroker: TBGRACustomPenStroker; override;
     function GetArrowEndSize: TPointF; override;
     function GetArrowStartSize: TPointF; override;
 …
     function GetFontRenderer: TBGRACustomFontRenderer; override;
     procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; virtual; abstract;
+    function GetFontAnchorVerticalOffset: single;
+    function GetFontAnchorRotatedOffset: TPointF;
+    function GetFontAnchorRotatedOffset(ACustomOrientation: integer): TPointF;
     function GetClipRect: TRect; override;
 …
     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;
+    procedure InternalTextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
+    function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean;
+    procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single;
+      AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); override;
   public
+    {Reference counter functions}
+    {** Provides a canvas with opacity and antialiasing }
+    property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
+    {** Provides a canvas with 2d transformation and similar to HTML5. }
+    property Canvas2D: TBGRACanvas2D read GetCanvas2D;
+    {** For more properties, see parent class [[TBGRACustomBitmap and IBGRAScanner#TBGRACustomBitmap|TBGRACustomBitmap]] }
+    {==== Reference counting ====}
+    {** Adds a reference (this reference count is not the same as
+        the reference count of an interface, it changes only by
+        explicit calls }
     function NewReference: TBGRACustomBitmap;
+    {** Free a reference. When the resulting reference count gets
+        to zero, the image is freed. The initial reference count
+        is equal to 1 }
     procedure FreeReference;
+    {** Returns an object with a reference count equal to 1. Duplicate
+        this bitmap if necessary }
     function GetUnique: TBGRACustomBitmap;
+    {==== Constructors ====}
     {------------------------- 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.
+    {** Creates a new bitmap, initialize properties and bitmap data }
+    constructor Create(AWidth, AHeight: integer); override;
+    {** Can only be called with an existing instance of ''TBGRABitmap''.
+        Sets the dimensions of an existing ''TBGRABitmap'' instance. }
+    procedure SetSize(AWidth, AHeight: integer); override;
     {------------------------- 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
+    {** Creates an image of width and height equal to zero. In this case,
+        ''Data'' = '''nil''' }
+    constructor Create; override;
+    {** Creates an image by copying the content of a ''TFPCustomImage'' }
+    constructor Create(AFPImage: TFPCustomImage); override;
+    {** Creates an image by copying the content of a ''TBitmap'' }
+    constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); override;
+    {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with the opaque color ''Color'' }
+    constructor Create(AWidth, AHeight: integer; Color: TColor); override;
+    {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with ''Color'' }
+    constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); 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); 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(AFilename: string; AIsUtf8: boolean); override;
+    constructor Create(AFilename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions); override;
+    {** Creates an image by loading its content from the stream ''AStream'' }
+    constructor Create(AStream: TStream); override;
+    {** Free the object and all its resources }
+    destructor Destroy; override;
     {------------------------- 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(ARaster: TRasterImage); override; overload;
+    procedure Assign(MemBitmap: TBGRACustomBitmap);override; overload;
+    {** 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): 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(AWidth, AHeight: integer; Color: TBGRAPixel): 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): 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'' }
+    function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; override;
+    function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRACustomBitmap; override;
+    {** Can only be called from an existing instance of ''TBGRABitmap''.
+        Creates an image by copying the content of a ''TFPCustomImage'' }
+    function NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap; override;
+    {** Load image from a stream. The specified image reader is used }
+    procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); override;
+    {** Assign the content of the specified ''Source''. It can be a ''TBGRACustomBitmap'' or
+        a ''TFPCustomImage'' }
+    procedure Assign(Source: TPersistent); override;
+    procedure Assign(Source: TBitmap; AUseTransparent: boolean); overload;
+    {** Stores the image in the stream without compression nor header }
     procedure Serialize(AStream: TStream); override;
+    {** Reads the image in a stream that was previously serialized }
     procedure Deserialize(AStream: TStream); override;
+    {** Stores an empty image (of size zero) }
     class procedure SerializeEmpty(AStream: TStream);
+    {Pixel functions}
+    {* Example:
+       <syntaxhighlight>
+     * var bmp1, bmp2: TBGRABitmap;
+     * begin
+     *   bmp1 := TBGRABitmap.Create(100,100);
+     *   bmp2 := bmp1.NewBitmap(100,100) as TBGRABitmap;
+     *   ...
+     * end;</syntaxhighlight>
+       See tutorial 2 on [[BGRABitmap_tutorial_2|how to load and display an image]].
+     * See reference on [[TBGRACustomBitmap_and_IBGRAScanner#Load_and_save_files|loading and saving files]] }
+    {==== Pixel functions ====}
+    {** Checks if the specified point is in the clipping rectangle ''ClipRect'' }
     function PtInClipRect(x, y: int32or64): boolean; inline;
+    {** Sets the pixel by replacing the content at (''x'',''y'') with the specified color.
+        Alpha value is set to 255 (opaque) }
     procedure SetPixel(x, y: int32or64; c: TColor); override;
+    {** Sets the pixel at (''x'',''y'') with the specified content }
     procedure SetPixel(x, y: int32or64; c: TBGRAPixel); override;
+    {** Applies a logical '''xor''' to the content of the pixel with the specified value.
+        This includes the alpha channel, so if you want to preserve the opacity, provide
+        a color ''c'' with alpha channel equal to zero }
     procedure XorPixel(x, y: int32or64; c: TBGRAPixel); override;
+    {** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied
+        in sRGB colorspace }
     procedure DrawPixel(x, y: int32or64; c: TBGRAPixel); override;
+    {** Draws a pixel with the specified ''ADrawMode'' at (''x'',''y'').
+        Pixel is supplied in sRGB colorspace. Gamma correction may be applied
+        depending on the draw mode }{inherited
+    procedure DrawPixel(x, y: int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
+  }{** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied
+        in gamma expanded colorspace }
     procedure DrawPixel(x, y: int32or64; ec: TExpandedPixel); override;
+    {** Draws a pixel without gamma correction at (''x'',''y''). Pixel is supplied
+        in sRGB colorspace }
     procedure FastBlendPixel(x, y: int32or64; c: TBGRAPixel); override;
+    {** Erase the content of the pixel by reducing the value of the
+        alpha channel. ''alpha'' specifies how much to decrease.
+        If the resulting alpha reaches zero, the content
+        is replaced by ''BGRAPixelTransparent'' }
     procedure ErasePixel(x, y: int32or64; alpha: byte); override;
+    {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the
+        pixel is replaced by ''BGRAPixelTransparent'' }
     procedure AlphaPixel(x, y: int32or64; alpha: byte); override;
+    {** Returns the content of the specified pixel. If it is out of the
+        bounds of the picture, the result is ''BGRAPixelTransparent'' }
     function GetPixel(x, y: int32or64): TBGRAPixel; override;
+    {** Computes the value of the pixel at a floating point coordiante
+        by interpolating the values of the pixels around it.
+      * There is a one pixel wide margin around the pixel where the pixels are
+        still considered inside. If ''smoothBorder'' is set to true, pixel fade
+        to transparent.
+      * If it is more out of the bounds, the result is ''BGRAPixelTransparent''.
+      * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
+        values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
+    function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override;
+    {** Similar to previous ''GetPixel'' function, but the fractional part of
+        the coordinate is supplied with a number from 0 to 255. The actual
+        coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
     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;
+    {** Computes the value of the pixel at a floating point coordiante
+        by interpolating the values of the pixels around it. If the pixel
+        is out of bounds, the image is repeated.
+      * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
+        values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
+    {** Similar to previous ''GetPixel'' function, but the fractional part of
+        the coordinate is supplied with a number from 0 to 255. The actual
+        coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
+    function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
+    {** Computes the value of the pixel at a floating point coordiante
+        by interpolating the values of the pixels around it. ''repeatX'' and
+        ''repeatY'' specifies if the image is to be repeated or not.
+      * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
+        values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
     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;
+    {** Similar to previous ''GetPixel'' function, but the fractional part of
+        the coordinate is supplied with a number from 0 to 255. The actual
+        coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
     function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; override;
+    {Line primitives}
+    {==== Drawing lines and polylines (integer coordinates) ====}
+    {* These functions do not take into account current pen style/cap/join.
+       See [[BGRABitmap tutorial 13|coordinate system]]. }
+    {** Replaces the content of the pixels at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color }
     procedure SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    {** Applies xor to the pixels at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color.
+        This includes the alpha channel, so if you want to preserve the
+        opacity, provide a color ''c'' with alpha channel equal to zero }
     procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    {** Draws an horizontal line with gamma correction at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color }
     procedure DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    {** Draws an horizontal line with gamma correction at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color }
     procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override;
+    {** Draws an horizontal line with gamma correction at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified scanner
+        to get the source colors }{inherited
+    procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload;
+   }{** Draws an horizontal line without gamma correction at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color }
+    procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    {** Draws an horizontal line at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified scanner
+        and the specified ''ADrawMode'' }
     procedure HorizLine(x, y, x2: int32or64; texture: IBGRAScanner; ADrawMode : TDrawMode); override;
+    procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
+    {** Draws an horizontal line at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color
+        and the specified ''ADrawMode'' }{inherited
+    procedure HorizLine(x,y,x2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
+    }
+    {** Replaces the alpha value of the pixels at line ''y'' and
+        at columns ''x'' to ''x2'' included }
     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;
+    {** Draws an horizontal line with gamma correction at line ''y'' and
+        at columns ''x'' to ''x2'' included, using specified color,
+        and with a transparency that increases with the color difference
+        with ''compare''. If the difference is greater than ''maxDiff'',
+        pixels are not changed }
     procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel;
       maxDiff: byte); override;
+    {Shapes}
+    procedure DrawPath(APath: IBGRAPath; c: TBGRAPixel; w: single); override;
+    procedure DrawPath(APath: IBGRAPath; texture: IBGRAScanner; w: single); override;
+    {** Replaces a vertical line at column ''x'' and at row ''y'' to ''y2'' }
+    procedure SetVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    {** Xors a vertical line at column ''x'' and at row ''y'' to ''y2'' }
+    procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    {** Draws a vertical line with gamma correction at column ''x'' and at row ''y'' to ''y2'' }
+    procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    {** Draws a vertical line without gamma correction at column ''x'' and at row ''y'' to ''y2'' }
+    procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
+    {** Replace alpha values in a vertical line at column ''x'' and at row ''y'' to ''y2'' }
+    procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override;
+    {** Draws a vertical line with the specified draw mode at column ''x'' and at row ''y'' to ''y2'' }{inherited
+    procedure VertLine(x,y,y2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode);
+    }
+    {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm
+        ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn.
+        ''ADrawMode'' specifies the mode to use when drawing the pixels }
     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm
+        ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn }
     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
+    {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of lenght ''dashLen'' }
     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); override;
+    {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of lenght ''dashLen''.
+        ''DashPos'' can be used to specify the start dash position and to retrieve the dash position at the end
+        of the line, in order to draw a polyline with consistent dashes }
     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer); override;
+    {** Erases the line from (x1,y1) to (x2,y2) using Bresenham's algorithm.
+        ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing
+        is changed and if ''alpha'' = 255, all pixels become transparent.
+        ''DrawListPixel'' specifies if (x2,y2) must be changed }
+    procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); override;
+    {** Erases the line from (x1,y1) to (x2,y2) width antialiasing.
+        ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing
+        is changed and if ''alpha'' = 255, all pixels become transparent.
+        ''DrawListPixel'' specifies if (x2,y2) must be changed }
+    procedure EraseLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); override;
+    {==== Drawing lines and polylines (floating point coordinates) ====}
+    {* These functions use the current pen style/cap/join. The parameter ''w''
+       specifies the width of the line and the base unit for dashes.
+       See [[BGRABitmap tutorial 13|coordinate system]]. }
+    {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join }
     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); override;
+    {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
+        ''texture'' specifies the source color to use when filling the line }
     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); override;
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); override;
+    {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
+        ''Closed'' specifies if the end of the line is closed. If it is not closed,
+        a space is left so that the next line can fit }
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; ClosedCap: boolean); override;
+    {** Same as above with ''texture'' specifying the source color to use when filling the line }
+    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; ClosedCap: boolean); override;
+    {** Draws a polyline using current pen style/cap/join }
     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
+    {** Draws a polyline using current pen style/cap/join.
+        ''texture'' specifies the source color to use when filling the line }
     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;
+    {** Draws a polyline using current pen style/cap/join.
+        ''Closed'' specifies if the end of the line is closed. If it is not closed,
+        a space is left so that the next line can fit }
+    procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; ClosedCap: boolean); override;
+    procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single; ClosedCap: boolean); override;
+    {** Draws a polyline using current pen style/cap/join.
+        ''fillcolor'' specifies a color to fill the polygon formed by the points }
     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); override;
+    {** Draws a polyline using current pen style/cap/join.
+        The last point considered as a join with the first point if it has
+        the same coordinate }
+    procedure DrawPolyLineAntialiasAutocycle(const points: array of TPointF; c: TBGRAPixel; w: single); override;
+    procedure DrawPolyLineAntialiasAutocycle(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
+    {** Draws a polygon using current pen style/cap/join.
+        The polygon is always closed. You don't need to set the last point
+        to be the same as the first point }
     procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
+    {** Draws a polygon using current pen style/cap/join.
+        The polygon is always closed. You don't need to set the last point
+        to be the same as the first point }
     procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
+    {** Draws a filled polygon using current pen style/cap/join.
+        The polygon is always closed. You don't need to set the last point
+        to be the same as the first point. }
     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: integer; alpha: byte; DrawLastPixel: boolean); override;
+    {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join }
     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); override;
+    {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
+        ''Closed'' specifies if the end of the line is closed. If it is not closed,
+        a space is left so that the next line can fit }
     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); override;
+    {** Erases a polyline using current pen style/cap/join }
     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 FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
+    procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
+    procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True); override;
+    procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
+    procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
+    procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
+    procedure 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 FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
+    procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
+    procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; 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;
+    {==== Rectangles (integer coordinates) ====}
+    {* The integer coordinates of rectangles interpreted such that
+       that the bottom/right pixels are not drawn. The width is equal
+       to x2-x, and pixels are drawn from x to x2-1. If x = x2, then nothing
+       is drawn. See [[BGRABitmap tutorial 13|coordinate system]].
+     * These functions do not take into account current pen style/cap/join.
+       They draw a continuous 1-pixel width border }
+    {** Draw a size border of a rectangle,
+        using the specified ''mode'' }
+    procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
+    {** Draw a filled rectangle with a border of color ''BorderColor'',
+        using the specified ''mode'' }
+    procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); override;
+    {** Fills completely a rectangle, without any border, with the specified ''mode'' }
+    procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override; overload;
+    {** Fills completely a rectangle, without any border, with the specified ''texture'' and
+        with the specified ''mode'' }
+    procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint); override; overload;
+    procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); override; overload;
+    {** Sets the alpha value within the specified rectangle }
+    procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); override;
+    {** Draws a filled round rectangle, with corners having an elliptical diameter of ''DX'' and ''DY'' }
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    {** Draws a round rectangle, with corners having an elliptical diameter of ''DX'' and ''DY'' }
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    {==== Rectangles and ellipses (floating point coordinates) ====}
+    {* These functions use the current pen style/cap/join. The parameter ''w''
+       specifies the width of the line and the base unit for dashes
+     * The coordinates are pixel-centered, so that when filling a rectangle,
+       if the supplied values are integers, the border will be half transparent.
+       If you want the border to be completely filled, you can subtract/add
+.5 to the coordinates to include the remaining thin border.
+       See [[BGRABitmap tutorial 13|coordinate system]]. }
+    {** Draws a rectangle with antialiasing and fills it with color ''back''.
+        Note that the pixel (x2,y2) is included contrary to integer coordinates }
+    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    {** Draws a rectangle with antialiasing. Note that the pixel (x2,y2) is
+        included contrary to integer coordinates }
+    procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); override;
+    {** Fills a rectangle with antialiasing. For example (-0.5,-0.5,0.5,0.5)
+        fills one pixel }
+    procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel; pixelCenteredCoordinates: boolean = true); override;
+    {** Fills a rectangle with a texture }
+    procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner; pixelCenteredCoordinates: boolean = true); override;
+    {** Erases the content of a rectangle with antialiasing }
+    procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte; pixelCenteredCoordinates: boolean = true); override;
+    {** Draws a rounded rectangle border with antialiasing. The corners have an
+        elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to
+        draw the corners. See [[BGRABitmap Geometry types|geometry types]] }
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); override;
+    {** Draws a rounded rectangle border with the specified texture.
+        The corners have an elliptical radius of ''rx'' and ''ry''.
+        ''options'' specifies how to draw the corners.
+        See [[BGRABitmap Geometry types|geometry types]] }
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); override;
+    {** Draws and fills a round rectangle }
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); override;
+    {** Draws and fills a round rectangle with textures }
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
+    {** Fills a rounded rectangle with antialiasing. The corners have an
+        elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to
+        draw the corners. See [[BGRABitmap Geometry types|geometry types]] }
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); override;
+    {** Fills a rounded rectangle with a texture }
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); override;
+    {** Erases the content of a rounded rectangle with a texture }
+    procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); override;
+    {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and
+        ''ry'' the vertical radius }
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); override;
+    {** Draws an ellipse border with a ''texture'' }
+    procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); override;
+    {** Draws and fills an ellipse }
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    {** Fills an ellipse }
+    procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); override;
+    {** Fills an ellipse with a ''texture'' }
+    procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); override;
+    {** Fills an ellipse with a gradient of color. ''outercolor'' specifies
+        the end color of the gradient on the border of the ellipse and
+        ''innercolor'' the end color of the gradient at the center of the
+        ellipse }
+    procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); override;
+    {** Erases the content of an ellipse }
+    procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); override;
+    {==== Polygons and path ====}
     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 ErasePolyAntialias(const points: array of TPointF; alpha: byte); override;
+    procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
+    procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
+    procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
+    procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
+    procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
+    procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone); override;
+    procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
+    procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); override;
+    procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); 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 FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); override;
+    procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); override;
+    procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
+    procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
+    procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
+    procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; 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 FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel; drawmode: TDrawMode); override;
     procedure FillShape(shape: TBGRACustomFillInfo; texture: IBGRAScanner; drawmode: TDrawMode); override;
 …
     procedure EraseShapeAntialias(shape: TBGRACustomFillInfo; alpha: byte); override;
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); override;
+    procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); override;
+    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); override;
+    procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); override;
+    procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); override;
+    procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); override;
+    procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
+    procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); override;
+    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
+    procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); override;
+    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
+    procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override; 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 FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); override;
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); override;
+    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
+    procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); override;
+    procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); override;
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer;
+      BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer;
+      BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single); override;
+    procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single); override;
+    procedure FillPath(APath: IBGRAPath; AFillColor: TBGRAPixel); override;
+    procedure FillPath(APath: IBGRAPath; AFillTexture: IBGRAScanner); override;
+    procedure ErasePath(APath: IBGRAPath; alpha: byte); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single); override;
+    procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single); override;
+    procedure FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AFillColor: TBGRAPixel); override;
+    procedure FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AFillTexture: IBGRAScanner); override;
+    procedure ErasePath(APath: IBGRAPath; AMatrix: TAffineMatrix; alpha: byte); override;
+    procedure ArrowStartAsNone; override;
+    procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure ArrowStartAsTail; override;
+    procedure ArrowEndAsNone; override;
+    procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure ArrowEndAsTail; override;
     { Draws the UTF8 encoded string, with color c.
 …
     procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); override; overload;
+    procedure TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); override; overload;
+    procedure TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); 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.
 …
     function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; override;
     function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; override;
+    function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; override;
     function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; override;
 …
     procedure AlphaFill(alpha: byte; start, Count: integer); 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 FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte = 255); override;
     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override;
     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override;
     procedure ReplaceColor(before, after: TColor); override;
     procedure ReplaceColor(before, after: TBGRAPixel); override;
+    procedure ReplaceColor(ABounds: TRect; before, after: TColor); override;
+    procedure ReplaceColor(ABounds: TRect; before, after: TBGRAPixel); override;
     procedure ReplaceTransparent(after: TBGRAPixel); override;
+    procedure ReplaceTransparent(ABounds: TRect; after: TBGRAPixel); override;
     procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
       mode: TFloodfillMode; Tolerance: byte = 0); override;
     procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+      gammaColorCorrection: boolean = True; Sinus: Boolean=False); override;
+      gammaColorCorrection: boolean = True; Sinus: Boolean=False;
+      ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
     procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
       Sinus: Boolean=False); override;
+      Sinus: Boolean=False; ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
     function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
                 AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override;
 …
     {Canvas drawing functions}
-    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
-      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
-    procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
-      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
-    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
 …
     procedure 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 PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); override;
+    procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); override; overload;
+    function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true): TRect; override; overload;
+    function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; override;
     procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
 …
     function Equals(comp: TBGRACustomBitmap): boolean; override;
     function Equals(comp: TBGRAPixel): boolean; override;
-    function GetImageBounds(Channel: TChannel = cAlpha; ANothingValue: Byte = 0): 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(ARect: TRect); override;
     procedure HorizontalFlip(ARect: TRect); override;
+    procedure VerticalFlip(ARect: TRect); override; overload;
+    procedure HorizontalFlip(ARect: TRect); override; overload;
     function RotateCW: TBGRACustomBitmap; override;
     function RotateCCW: TBGRACustomBitmap; override;
 …
     procedure LinearNegative; override;
     procedure LinearNegativeRect(ABounds: TRect); override;
+    procedure InplaceGrayscale; override;
+    procedure InplaceGrayscale(ABounds: TRect); override;
+    procedure InplaceGrayscale(AGammaCorrection: boolean = true); override;
+    procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); override;
+    procedure InplaceNormalize(AEachChannel: boolean = True); override;
+    procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); override;
     procedure SwapRedBlue; override;
+    procedure SwapRedBlue(ARect: TRect); override;
     procedure GrayscaleToAlpha; override;
     procedure AlphaToGrayscale; override;
     procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); override;
+    procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); override; overload;
     procedure ApplyGlobalOpacity(alpha: byte); override;
+    procedure ApplyGlobalOpacity(ABounds: TRect; alpha: byte); override;
     procedure ConvertToLinearRGB; override;
     procedure ConvertFromLinearRGB; 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 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 FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterBlurRadial(ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterBlurRadial(ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; override;
+    function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; override;
+    function FilterBlurMotion(ABounds: TRect; distance: single; 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 FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; override;
+    function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; override;
     function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; override;
     function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; override;
 …
     function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; override;
     function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; override;
+    function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRACustomBitmap; override;
     function FilterSphere: TBGRACustomBitmap; override;
     function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; override;
 …
     function FilterCylinder: TBGRACustomBitmap; override;
     function FilterPlane: TBGRACustomBitmap; override;
-    property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
-    property Canvas2D: TBGRACanvas2D read GetCanvas2D;
   end;
 …
   TBGRAPtrBitmap = class(TBGRADefaultBitmap)
   protected
+    function GetLineOrder: TRawImageLineOrder; override;
+    procedure SetLineOrder(AValue: TRawImageLineOrder); override;
     procedure ReallocData; override;
     procedure FreeData; override;
+    procedure CannotResize;
+    procedure NotImplemented;
+    procedure RebuildBitmap; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; //to override
+    function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte;
+      {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
+      =True): boolean; override; //to override
   public
     constructor Create(AWidth, AHeight: integer; AData: Pointer); overload;
     function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; override;
     procedure SetDataPtr(AData: Pointer);
+    property LineOrder: TRawImageLineOrder Read FLineOrder Write FLineOrder;
+    property LineOrder: TRawImageLineOrder Read GetLineOrder Write SetLineOrder;
+    procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
+    procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
+    procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //to override
+    procedure Assign({%H-}Source: TPersistent); override;
+    procedure TakeScreenshot({%H-}ARect: TRect); override;
+    procedure TakeScreenshotOfPrimaryMonitor; override;
+    procedure LoadFromDevice({%H-}DC: System.THandle); override;
+    procedure LoadFromDevice({%H-}DC: System.THandle; {%H-}ARect: TRect); override;
   end;
 …
   gammaColorCorrection: boolean = True; Sinus: Boolean=False);
-implementation
-uses Math, LCLIntf, LCLType,
-  BGRABlend, BGRAFilters, BGRAText, BGRATextFX, BGRAGradientScanner,
-  BGRAResample, BGRATransform, BGRAPolygon, BGRAPolygonAliased,
-  BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
 type
+  { TBitmapTracker }
   TBitmapTracker = class(TBitmap)
   protected
 …
   end;
+implementation
+uses Math, BGRAUTF8, BGRABlend, BGRAFilters, BGRAGradientScanner,
+  BGRAResample, BGRAPolygon, BGRAPolygonAliased,
+  BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM,
+  BGRAReadBMP, BGRAReadJpeg,
+  BGRADithering, BGRAFilterScanner;
+{ TBitmapTracker }
 constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap);
 begin
 …
 function TBGRADefaultBitmap.CheckEmpty: boolean;
+const
+  alphaMask = $ff shl TBGRAPixel_AlphaShift;
 var
   i: integer;
 …
 begin
   p := Data;
   for i := NbPixels - 1 downto 0 do
   begin
     if p^.alpha <> 0 then
+  for i := (NbPixels shr 1) - 1 downto 0 do
+  begin
+    if PInt64(p)^ and (alphaMask or (alphaMask shl 32)) <> 0 then
     begin
       Result := False;
       exit;
     end;
+    Inc(p);
+    Inc(p,2);
+  end;
+  if Odd(NbPixels) and (p^.alpha <> 0) then
+  begin
+    Result := false;
+    exit;
   end;
   Result := True;
 …
 function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle;
 begin
   result := DuplicatePenStyle(FCustomPenStyle);
+  result := DuplicatePenStyle(FPenStroker.CustomPenStyle);
 end;
 …
   else
     FCanvasOpacity := 0;
+end;
+procedure TBGRADefaultBitmap.DoLoadFromBitmap;
+begin
+  //nothing
 end;
 …
 procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle);
 begin
   FCustomPenStyle := DuplicatePenStyle(AValue);
+  FPenStroker.CustomPenStyle := DuplicatePenStyle(AValue);
 end;
 procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle);
 begin
+  Case AValue of
+  psSolid: CustomPenStyle := SolidPenStyle;
+  psDash: CustomPenStyle := DashPenStyle;
+  psDot: CustomPenStyle := DotPenStyle;
+  psDashDot: CustomPenStyle := DashDotPenStyle;
+  psDashDotDot: CustomPenStyle := DashDotDotPenStyle;
+  else CustomPenStyle := ClearPenStyle;
+  end;
+  FPenStyle := AValue;
+  FPenStroker.Style := AValue;
 end;
 function TBGRADefaultBitmap.GetPenStyle: TPenStyle;
 begin
   Result:= FPenStyle;
+  Result:= FPenStroker.Style;
 end;
 function TBGRADefaultBitmap.GetLineCap: TPenEndCap;
 begin
   result := FLineCap;
+  result := FPenStroker.LineCap;
 end;
 procedure TBGRADefaultBitmap.SetLineCap(AValue: TPenEndCap);
 begin
+  if AValue <> FLineCap then
+  begin
+    FLineCap:= AValue;
+    if Assigned(FArrow) then FArrow.LineCap := AValue;
+  end;
+  if AValue <> FPenStroker.LineCap then
+  begin
+    FPenStroker.LineCap := AValue;
+    if Assigned(FPenStroker.Arrow) then
+      FPenStroker.Arrow.LineCap := AValue;
+  end;
+end;
+function TBGRADefaultBitmap.GetPenStroker: TBGRACustomPenStroker;
+begin
+  result := FPenStroker;
 end;
 …
 function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer;
 begin
+  if FFontRenderer = nil then FFontRenderer := TLCLFontRenderer.Create;
+  if FFontRenderer = nil then FFontRenderer := CreateDefaultFontRenderer;
+  if FFontRenderer = nil then raise exception.Create('No font renderer');
   result := FFontRenderer;
   result.FontName := FontName;
 …
 end;
+function TBGRADefaultBitmap.GetFontAnchorVerticalOffset: single;
+begin
+  case FontVerticalAnchor of
+  fvaTop: result := 0;
+  fvaCenter: result := FontFullHeight*0.5;
+  fvaCapLine: result := FontPixelMetric.CapLine;
+  fvaCapCenter: result := (FontPixelMetric.CapLine+FontPixelMetric.Baseline)*0.5;
+  fvaXLine: result := FontPixelMetric.xLine;
+  fvaXCenter: result := (FontPixelMetric.xLine+FontPixelMetric.Baseline)*0.5;
+  fvaBaseline: result := FontPixelMetric.Baseline;
+  fvaDescentLine: result := FontPixelMetric.DescentLine;
+  fvaBottom: result := FontFullHeight;
+  else
+    result := 0;
+  end;
+end;
+function TBGRADefaultBitmap.GetFontAnchorRotatedOffset: TPointF;
+begin
+  result := GetFontAnchorRotatedOffset(FontOrientation);
+end;
+function TBGRADefaultBitmap.GetFontAnchorRotatedOffset(
+  ACustomOrientation: integer): TPointF;
+begin
+  result := PointF(0, GetFontAnchorVerticalOffset);
+  if ACustomOrientation <> 0 then
+    result := AffineMatrixRotationDeg(-ACustomOrientation*0.1)*result;
+end;
 { Get scanline without checking bounds nor updated from TBitmap }
 function TBGRADefaultBitmap.GetScanlineFast(y: integer): PBGRAPixel; inline;
 …
   BGRAClass := TBGRABitmapAny(self.ClassType);
   Result    := BGRAClass.Create(Filename,AIsUtf8);
+end;
+function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean;
+  AOptions: TBGRALoadingOptions): TBGRACustomBitmap;
+var
+  BGRAClass: TBGRABitmapAny;
+begin
+  BGRAClass := TBGRABitmapAny(self.ClassType);
+  Result    := BGRAClass.Create(Filename,AIsUtf8,AOptions);
+end;
+function TBGRADefaultBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap;
+var
+  BGRAClass: TBGRABitmapAny;
+begin
+  BGRAClass := TBGRABitmapAny(self.ClassType);
+  Result    := BGRAClass.Create(AFPImage);
+end;
+procedure TBGRADefaultBitmap.LoadFromStream(Str: TStream;
+  Handler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
+var OldBmpOption: TBMPTransparencyOption;
+  OldJpegPerf: TJPEGReadPerformance;
+begin
+  if (loBmpAutoOpaque in AOptions) and (Handler is TBGRAReaderBMP) then
+  begin
+    OldBmpOption := TBGRAReaderBMP(Handler).TransparencyOption;
+    TBGRAReaderBMP(Handler).TransparencyOption := toAuto;
+    inherited LoadFromStream(Str, Handler, AOptions);
+    TBGRAReaderBMP(Handler).TransparencyOption := OldBmpOption;
+  end else
+  if (loJpegQuick in AOptions) and (Handler is TBGRAReaderJpeg) then
+  begin
+    OldJpegPerf := TBGRAReaderJpeg(Handler).Performance;
+    TBGRAReaderJpeg(Handler).Performance := jpBestSpeed;
+    inherited LoadFromStream(Str, Handler, AOptions);
+    TBGRAReaderJpeg(Handler).Performance := OldJpegPerf;
+  end else
+    inherited LoadFromStream(Str, Handler, AOptions);
 end;
 …
   FWidth    := AWidth;
   FHeight   := AHeight;
+  FScanWidth := FWidth;
+  FScanHeight:= FHeight;
   FNbPixels := AWidth * AHeight;
   if FNbPixels < 0 then // 2 Go limit
 …
 end;
+constructor TBGRADefaultBitmap.Create(AFPImage: TFPCustomImage);
+begin
+  Init;
+  inherited Create(AFPImage.Width, AFPImage.Height);
+  Assign(AFPImage);
+end;
 { Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. }
 constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap);
+constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap; AUseTransparent: boolean);
 begin
   Init;
   inherited Create(ABitmap.Width, ABitmap.Height);
   Assign(ABitmap);
+  Assign(ABitmap, AUseTransparent);
 end;
 …
 destructor TBGRADefaultBitmap.Destroy;
 begin
   FreeData;
+  FPenStroker.Free;
   FFontRenderer.Free;
-  FBitmap.Free;
   FCanvasFP.Free;
   FCanvasBGRA.Free;
   FCanvas2D.Free;
+  FArrow.Free;
+  FreeData;
+  FreeBitmap;
   inherited Destroy;
 end;
 …
 end;
+constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean;
+  AOptions: TBGRALoadingOptions);
+begin
+  Init;
+  inherited Create(0, 0);
+  if AIsUtf8 then
+    LoadFromFileUTF8(Afilename, AOptions)
+  else
+    LoadFromFile(Afilename, AOptions);
+end;
 { Creates an image by loading its content from the stream AStream. }
 constructor TBGRADefaultBitmap.Create(AStream: TStream);
 …
   inherited Create(0, 0);
   LoadFromStream(AStream);
-end;
-procedure TBGRADefaultBitmap.Assign(ARaster: TRasterImage);
-var TempBmp: TBitmap;
-    ConvertOk: boolean;
-begin
-  DiscardBitmapChange;
-  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 := 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 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
-end;
-procedure TBGRADefaultBitmap.Assign(MemBitmap: TBGRACustomBitmap);
-begin
-  DiscardBitmapChange;
-  SetSize(MemBitmap.Width, MemBitmap.Height);
-  PutImage(0, 0, MemBitmap, dmSet);
 end;
 …
   AStream.Write(lWidth,sizeof(lWidth));
   AStream.Write(lHeight,sizeof(lHeight));
+  If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
   for y := 0 to Height-1 do
     AStream.Write(ScanLine[y]^, Width*sizeof(TBGRAPixel));
 end;
+{$hints off}
+  If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
+end;
 procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
 var lWidth,lHeight,y: integer;
 begin
   AStream.Read(lWidth,sizeof(lWidth));
   AStream.Read(lHeight,sizeof(lHeight));
+  AStream.Read({%H-}lWidth,sizeof(lWidth));
+  AStream.Read({%H-}lHeight,sizeof(lHeight));
   lWidth := LEtoN(lWidth);
   lHeight := LEtoN(lHeight);
 …
   for y := 0 to Height-1 do
     AStream.Read(ScanLine[y]^, Width*sizeof(TBGRAPixel));
+end;
+{$hints on}
+  If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
+  InvalidateBitmap;
+end;
 class procedure TBGRADefaultBitmap.SerializeEmpty(AStream: TStream);
 …
 end;
+procedure TBGRADefaultBitmap.SaveToFile(const filename: string);
+var
+  ext:    string;
+  writer: TFPCustomImageWriter;
+begin
+  ext := AnsiLowerCase(ExtractFileExt(filename));
+  { When saving to PNG, define some parameters so that the
+    image be readable by most programs }
+  if ext = '.png' then
+    writer := CreateAdaptedPngWriter
+  else
+  if (ext='.xpm') and (Width*Height > 32768) then //xpm is slow so avoid big images
+    raise exception.Create('Image is too big to be saved as XPM') else
+      writer := nil;
+  if writer <> nil then //use custom writer if defined
+  begin
+    inherited SaveToFile(Filename, writer);
+    writer.Free;
+  end
+  else
+    inherited SaveToFile(Filename);
+end;
+procedure TBGRADefaultBitmap.SaveToStreamAsPng(Str: TStream);
+var writer: TFPWriterPNG;
+begin
+  writer := CreateAdaptedPngWriter;
+  SaveToStream(Str,writer);
+  writer.Free;
+procedure TBGRADefaultBitmap.Assign(Source: TPersistent);
+var pdest: PBGRAPixel;
+  x,y: NativeInt;
+begin
+  if Source is TBGRACustomBitmap then
+  begin
+    DiscardBitmapChange;
+    SetSize(TBGRACustomBitmap(Source).Width, TBGRACustomBitmap(Source).Height);
+    PutImage(0, 0, TBGRACustomBitmap(Source), dmSet);
+  end else
+  if Source is TFPCustomImage then
+  begin
+    DiscardBitmapChange;
+    SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height);
+    for y := 0 to TFPCustomImage(Source).Height-1 do
+    begin
+      pdest := ScanLine[y];
+      for x := 0 to TFPCustomImage(Source).Width-1 do
+      begin
+        pdest^ := FPColorToBGRA(TFPCustomImage(Source).Colors[x,y]);
+        inc(pdest);
+      end;
+    end;
+  end else
+    inherited Assign(Source);
+end;
+procedure TBGRADefaultBitmap.Assign(Source: TBitmap; AUseTransparent: boolean);
+var
+  transpColor: TBGRAPixel;
+begin
+  Assign(Source);
+  if AUseTransparent and TBitmap(Source).Transparent then
+  begin
+    if TBitmap(Source).TransparentMode = tmFixed then
+      transpColor := ColorToBGRA(TBitmap(Source).TransparentColor)
+    else
+      transpColor := GetPixel(0,Height-1);
+    ReplaceColor(transpColor, BGRAPixelTransparent);
+  end;
 end;
 …
   iFactY: int32or64): TBGRAPixel;
 var
+  ixMod1,ixMod2: int32or64;
+  w1,w2,w3,w4,alphaW: UInt32or64;
+  bSum, gSum, rSum: UInt32or64;
+  aSum: UInt32or64;
+  c:    TBGRAPixel;
+  ixMod2: int32or64;
+  pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
   scan: PBGRAPixel;
 begin
-  w4 := (iFactX*iFactY+127) shr 8;
-  w3 := iFactY-w4;
-  w1 := cardinal(256-iFactX)-w3;
-  w2 := iFactX-w4;
-  rSum   := 0;
-  gSum   := 0;
-  bSum   := 0;
-  aSum   := 0;
   scan := GetScanlineFast(iy);
+  ixMod1 := ix;
+  c      := (scan + ix)^;
+  alphaW := c.alpha * w1;
+  aSum   += alphaW;
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  pUpLeft := (scan + ix);
   ixMod2 := ix+1;
   if ixMod2=Width then ixMod2 := 0;
+  c      := (scan + ixMod2)^;
+  alphaW := c.alpha * w2;
+  aSum   += alphaW;
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  pUpRight := (scan + ixMod2);
   Inc(iy);
   if iy = Height then iy := 0;
   scan := GetScanlineFast(iy);
+  c      := (scan + ixMod2)^;
+  alphaW := c.alpha * w4;
+  aSum   += alphaW;
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  c      := (scan + ixMod1)^;
+  alphaW := c.alpha * w3;
+  aSum   += alphaW;
+  rSum   += c.red * alphaW;
+  gSum   += c.green * alphaW;
+  bSum   += c.blue * alphaW;
+  if (aSum < 128) then
+    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;
+  pDownLeft := (scan + ix);
+  pDownRight := (scan + ixMod2);
+  InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
+          pDownRight, iFactX, iFactY, @result);
 end;
 …
   iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
 var
+  w1,w2,w3,w4,alphaW: cardinal;
+  rSum, gSum, bSum: cardinal; //rgbDiv = aSum
+  aSum, aDiv: cardinal;
+  c:    TBGRAPixel;
+  pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
   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
 …
     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);
+      pUpLeft := scan+ix
+    else if smoothBorder then
+      pUpLeft := @BGRAPixelTransparent
+    else
+      pUpLeft := nil;
+    if (ix+1 >= 0) and (ix+1 < Width) then
+      pUpRight := scan+(ix+1)
+    else if smoothBorder then
+      pUpRight := @BGRAPixelTransparent
+    else
+      pUpRight := nil;
+  end else
+  if smoothBorder then
+  begin
+    pUpLeft := @BGRAPixelTransparent;
+    pUpRight := @BGRAPixelTransparent;
+  end else
+  begin
+    pUpLeft := nil;
+    pUpRight := nil;
+  end;
+  if (iy+1 >= 0) and (iy+1 < Height) then
+  begin
+    scan := GetScanlineFast(iy+1);
     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
+      pDownLeft := scan+ix
+    else if smoothBorder then
+      pDownLeft := @BGRAPixelTransparent
     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];
+      pDownLeft := nil;
+    if (ix+1 >= 0) and (ix+1 < Width) then
+      pDownRight := scan+(ix+1)
+    else if smoothBorder then
+      pDownRight := @BGRAPixelTransparent
+    else
+      pDownRight := nil;
+  end else
+  if smoothBorder then
+  begin
+    pDownLeft := @BGRAPixelTransparent;
+    pDownRight := @BGRAPixelTransparent;
+  end else
+  begin
+    pDownLeft := nil;
+    pDownRight := nil;
+  end;
+  InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
+          pDownRight, iFactX, iFactY, @result);
 end;
 function TBGRADefaultBitmap.GetArrow: TBGRAArrow;
 begin
+  if FArrow = nil then
+  begin
+    FArrow := TBGRAArrow.Create;
+    FArrow.LineCap := LineCap;
+  end;
+  result := FArrow;
+  if FPenStroker.Arrow = nil then
+  begin
+    FPenStroker.Arrow := TBGRAArrow.Create;
+    FPenStroker.Arrow.LineCap := LineCap;
+    FPenStroker.ArrowOwned := true;
+  end;
+  result := FPenStroker.Arrow as TBGRAArrow;
 end;
 …
 procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor);
 var
   p: PByte;
+  p: PBGRAPixel;
 begin
   if not PtInClipRect(x,y) then exit;
   LoadFromBitmapIfNeeded;
+  p  := PByte(GetScanlineFast(y) + x);
+  p^ := c shr 16;
+  Inc(p);
+  p^ := c shr 8;
+  Inc(p);
+  p^ := c;
+  Inc(p);
+  p^ := 255;
+  p  := GetScanlineFast(y) + x;
+  RedGreenBlue(c, p^.red,p^.green,p^.blue);
+  p^.alpha := 255;
   InvalidateBitmap;
 end;
 …
 end;
-{ Load raw image data. It must be 32bit or 24 bits per pixel}
-function TBGRADefaultBitmap.LoadFromRawImage(ARawImage: TRawImage;
-  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean;
-var
-  psource_byte, pdest_byte,
-  psource_first, pdest_first: PByte;
-  psource_delta, pdest_delta: integer;
-  n: integer;
-  mustSwapRedBlue, mustReverse32: boolean;
-  procedure CopyAndSwapIfNecessary(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
-  begin
-    if mustReverse32 then
-    begin
-      while count > 0 do
-      begin
-        pdest^.blue := psrc^.alpha;
-        pdest^.green := psrc^.red;
-        pdest^.red := psrc^.green;
-        pdest^.alpha := psrc^.blue;
-        dec(count);
-        inc(pdest);
-        inc(psrc);
-      end;
-    end else
-    if mustSwapRedBlue then
-    begin
-      while count > 0 do
-      begin
-        pdest^.red := psrc^.blue;
-        pdest^.green := psrc^.green;
-        pdest^.blue := psrc^.red;
-        pdest^.alpha := psrc^.alpha;
-        dec(count);
-        inc(pdest);
-        inc(psrc);
-      end;
-    end else
-      move(psrc^,pdest^,count*sizeof(TBGRAPixel));
-  end;
-  procedure CopyRGBAndSwapIfNecessary(psrc: PByte; pdest: PBGRAPixel; count: integer);
-  begin
-    if mustSwapRedBlue then
-    begin
-      while count > 0 do
-      begin
-        pdest^.blue := (psrc+2)^;
-        pdest^.green := (psrc+1)^;
-        pdest^.red := psrc^;
-        pdest^.alpha := DefaultOpacity;
-        inc(psrc,3);
-        inc(pdest);
-        dec(count);
-      end;
-    end else
-    begin
-      while count > 0 do
-      begin
-        PWord(pdest)^ := PWord(psrc)^;
-        pdest^.red := (psrc+2)^;
-        pdest^.alpha := DefaultOpacity;
-        inc(psrc,3);
-        inc(pdest);
-        dec(count);
-      end;
-    end;
-  end;
-  procedure CopyAndSwapIfNecessaryAndSetAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
-  begin
-    if mustReverse32 then
-    begin
-      while count > 0 do
-      begin
-        pdest^.blue := psrc^.alpha;
-        pdest^.green := psrc^.red;
-        pdest^.red := psrc^.green;
-        pdest^.alpha := DefaultOpacity; //use default opacity
-        inc(psrc);
-        inc(pdest);
-        dec(count);
-      end;
-    end else
-    if mustSwapRedBlue then
-    begin
-      while count > 0 do
-      begin
-        pdest^.red := psrc^.blue;
-        pdest^.green := psrc^.green;
-        pdest^.blue := psrc^.red;
-        pdest^.alpha := DefaultOpacity; //use default opacity
-        inc(psrc);
-        inc(pdest);
-        dec(count);
-      end;
-    end else
-    begin
-      while count > 0 do
-      begin
-        PWord(pdest)^ := PWord(psrc)^;
-        pdest^.red := psrc^.red;
-        pdest^.alpha := DefaultOpacity; //use default opacity
-        inc(psrc);
-        inc(pdest);
-        dec(count);
-      end;
-    end;
-  end;
-  procedure CopyAndSwapIfNecessaryAndReplaceAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
-  var OpacityOrMask, OpacityAndMask, sourceval: Longword;
-  begin
-    OpacityOrMask := NtoLE(longword(DefaultOpacity) shl 24);
-    OpacityAndMask := NtoLE($FFFFFF);
-    if mustReverse32 then
-    begin
-      OpacityAndMask := NtoBE($FFFFFF);
-      while count > 0 do
-      begin
-        sourceval := plongword(psrc)^ and OpacityAndMask;
-        if (sourceval <> 0) and (psrc^.blue{=alpha} = 0) then //if not black but transparent
-        begin
-          pdest^.blue := psrc^.alpha;
-          pdest^.green := psrc^.red;
-          pdest^.red := psrc^.green;
-          pdest^.alpha := DefaultOpacity; //use default opacity
-        end
-        else
-        begin
-          pdest^.blue := psrc^.alpha;
-          pdest^.green := psrc^.red;
-          pdest^.red := psrc^.green;
-          pdest^.alpha := psrc^.blue;
-        end;
-        dec(count);
-        inc(pdest);
-        inc(psrc);
-      end;
-    end else
-    if mustSwapRedBlue then
-    begin
-      while count > 0 do
-      begin
-        sourceval := plongword(psrc)^ and OpacityAndMask;
-        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
-        begin
-          pdest^.red := psrc^.blue;
-          pdest^.green := psrc^.green;
-          pdest^.blue := psrc^.red;
-          pdest^.alpha := DefaultOpacity; //use default opacity
-        end
-        else
-        begin
-          pdest^.red := psrc^.blue;
-          pdest^.green := psrc^.green;
-          pdest^.blue := psrc^.red;
-          pdest^.alpha := psrc^.alpha;
-        end;
-        dec(count);
-        inc(pdest);
-        inc(psrc);
-      end;
-    end else
-    begin
-      while count > 0 do
-      begin
-        sourceval := plongword(psrc)^ and OpacityAndMask;
-        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
-          plongword(pdest)^ := sourceval or OpacityOrMask //use default opacity
-        else
-          pdest^ := psrc^;
-        dec(count);
-        inc(pdest);
-        inc(psrc);
-      end;
-    end;
-  end;
-begin
-  if (ARawImage.Description.Width <> cardinal(Width)) or
-    (ARawImage.Description.Height <> cardinal(Height)) then
-    raise Exception.Create('Bitmap size is inconsistant');
-  DiscardBitmapChange;
-  if (Height=0) or (Width=0) then
-  begin
-    result := true;
-    exit;
-  end;
-  if ARawImage.Description.LineOrder = riloTopToBottom then
-  begin
-    psource_first := ARawImage.Data;
-    psource_delta := ARawImage.Description.BytesPerLine;
-  end else
-  begin
-    psource_first := ARawImage.Data + (ARawImage.Description.Height-1) * ARawImage.Description.BytesPerLine;
-    psource_delta := -ARawImage.Description.BytesPerLine;
-  end;
-  if ((ARawImage.Description.RedShift = 0) and
-    (ARawImage.Description.BlueShift = 16) and
-    (ARawImage.Description.ByteOrder = riboLSBFirst)) or
-    ((ARawImage.Description.RedShift = 24) and
-    (ARawImage.Description.BlueShift = 8) and
-    (ARawImage.Description.ByteOrder = riboMSBFirst)) then
-  begin
-    mustSwapRedBlue:= true;
-    mustReverse32 := false;
-  end
-  else
-  begin
-    mustSwapRedBlue:= false;
-    if ((ARawImage.Description.RedShift = 8) and
-      (ARawImage.Description.GreenShift = 16) and
-      (ARawImage.Description.BlueShift = 24) and
-      (ARawImage.Description.ByteOrder = riboLSBFirst)) or
-      ((ARawImage.Description.RedShift = 16) and
-      (ARawImage.Description.GreenShift = 8) and
-      (ARawImage.Description.BlueShift = 0) and
-      (ARawImage.Description.ByteOrder = riboMSBFirst)) then
-        mustReverse32 := true
-      else
-        mustReverse32 := false;
-  end;
-  if self.LineOrder = riloTopToBottom then
-  begin
-    pdest_first := PByte(self.Data);
-    pdest_delta := self.Width*sizeof(TBGRAPixel);
-  end else
-  begin
-    pdest_first := PByte(self.Data) + (self.Height-1)*self.Width*sizeof(TBGRAPixel);
-    pdest_delta := -self.Width*sizeof(TBGRAPixel);
-  end;
-  { 32 bits per pixel }
-  if (ARawImage.Description.BitsPerPixel = 32) and
-    (ARawImage.DataSize >= longword(NbPixels) * 4) then
-  begin
-    { If there is an alpha channel }
-    if (ARawImage.Description.AlphaPrec = 8) and not AlwaysReplaceAlpha then
-    begin
-      if DefaultOpacity = 0 then
-      begin
-        if ARawImage.Description.LineOrder = FLineOrder then
-          CopyAndSwapIfNecessary(PBGRAPixel(ARawImage.Data), FData, NbPixels) else
-        begin
-          psource_byte := psource_first;
-          pdest_byte := pdest_first;
-          for n := FHeight-1 downto 0 do
-          begin
-            CopyAndSwapIfNecessary(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
-            inc(psource_byte, psource_delta);
-            inc(pdest_byte, pdest_delta);
-          end;
-        end;
-      end
-      else
-      begin
-        psource_byte := psource_first;
-        pdest_byte := pdest_first;
-        for n := FHeight-1 downto 0 do
-        begin
-          CopyAndSwapIfNecessaryAndReplaceAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
-          inc(psource_byte, psource_delta);
-          inc(pdest_byte, pdest_delta);
-        end;
-      end;
-    end
-    else
-    begin { If there isn't any alpha channel }
-      psource_byte := psource_first;
-      pdest_byte := pdest_first;
-      for n := FHeight-1 downto 0 do
-      begin
-        CopyAndSwapIfNecessaryAndSetAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
-        inc(psource_byte, psource_delta);
-        inc(pdest_byte, pdest_delta);
-      end;
-    end;
-  end
-  else
-  { 24 bit per pixel }
-  if (ARawImage.Description.BitsPerPixel = 24) then
-  begin
-    psource_byte := psource_first;
-    pdest_byte := pdest_first;
-    for n := FHeight-1 downto 0 do
-    begin
-      CopyRGBAndSwapIfNecessary(psource_byte, PBGRAPixel(pdest_byte), FWidth);
-      inc(psource_byte, psource_delta);
-      inc(pdest_byte, pdest_delta);
-    end;
-  end
-  else
-  begin
-    if RaiseErrorOnInvalidPixelFormat then
-      raise Exception.Create('Invalid raw image format (' + IntToStr(
-        ARawImage.Description.Depth) + ' found)') else
-    begin
-      result := false;
-      exit;
-    end;
-  end;
-  InvalidateBitmap;
-  result := true;
-end;
 procedure TBGRADefaultBitmap.LoadFromBitmapIfNeeded;
 begin
   if FBitmapModified then
   begin
+    if FBitmap <> nil then
+      LoadFromRawImage(FBitmap.RawImage, FCanvasOpacity);
+    DoLoadFromBitmap;
     DiscardBitmapChange;
   end;
 …
   FWidth     := 0;
   FHeight    := 0;
+  FScanWidth := FWidth;
+  FScanHeight:= FHeight;
   FLineOrder := riloTopToBottom;
   FCanvasOpacity := 255;
 …
   FontStyle := [];
   FontAntialias := False;
+  FontVerticalAnchor:= fvaTop;
   FFontHeight := 20;
-  PenStyle := psSolid;
-  LineCap := pecRound;
-  JoinStyle := pjsBevel;
-  JoinMiterLimit := 2;
   ResampleFilter := rfHalfCosine;
   ScanInterpolationFilter := rfLinear;
   ScanOffset := Point(0,0);
+  FPenStroker := TBGRAPenStroker.Create;
+  FPenStroker.Arrow := TBGRAArrow.Create;
+  FPenStroker.Arrow.LineCap := LineCap;
+  FPenStroker.ArrowOwned := true;
 end;
 …
 function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
 begin
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
+  result := BGRAToFPColor((Scanline[y] + x)^);
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
+    result := colTransparent
+  else
+    result := BGRAToFPColor((Scanline[y] + x)^);
 end;
 …
   c: TFPColor;
 begin
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
+  c := BGRAToFPColor((Scanline[y] + x)^);
+  Result := palette.IndexOf(c);
+  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
+    result := 0
+  else
+  begin
+    c := BGRAToFPColor((Scanline[y] + x)^);
+    Result := palette.IndexOf(c);
+  end;
 end;
 procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
 begin
+  if self = nil then
+    exit;
+  if (self = nil) or (Width = 0) or (Height = 0) then exit;
   if Opaque then
     DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data,
 …
 procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
 begin
+  if self = nil then
+    exit;
+  if (self = nil) or (Width = 0) or (Height = 0) then exit;
   if Opaque then
     DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight)
 …
   begin
     LoadFromBitmapIfNeeded;
-    if Empty then
-      exit;
     ACanvas.StretchDraw(Rect, Bitmap);
   end;
 …
 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;
+procedure TBGRADefaultBitmap.InternalTextOutCurved(
+  ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel;
+  ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
+var
+  pstr: pchar;
+  left,charlen: integer;
+  nextchar: string;
+  charwidth, angle, textlen: single;
+begin
+  if (ATexture = nil) and (AColor.alpha = 0) then exit;
+  sUTF8 := CleanTextOutString(sUTF8);
+  if sUTF8 = '' then exit;
+  pstr := @sUTF8[1];
+  left := length(sUTF8);
+  if AALign<> taLeftJustify then
+  begin
+    textlen := TextSize(sUTF8).cx + (UTF8Length(sUTF8)-1)*ALetterSpacing;
+    case AAlign of
+      taCenter: ACursor.MoveBackward(textlen*0.5);
+      taRightJustify: ACursor.MoveBackward(textlen);
+    end;
+  end;
+  while left > 0 do
+  begin
+    charlen := UTF8CharacterLength(pstr);
+    setlength(nextchar, charlen);
+    move(pstr^, nextchar[1], charlen);
+    inc(pstr,charlen);
+    dec(left,charlen);
+    charwidth := TextSize(nextchar).cx;
+    ACursor.MoveForward(charwidth);
+    ACursor.MoveBackward(charwidth, false);
+    ACursor.MoveForward(charwidth*0.5);
+    with ACursor.CurrentTangent do angle := arctan2(y,x);
+    with ACursor.CurrentCoordinate do
+    begin
+      if ATexture = nil then
+        TextOutAngle(x,y, system.round(-angle*1800/Pi), nextchar, AColor, taCenter)
+      else
+        TextOutAngle(x,y, system.round(-angle*1800/Pi), nextchar, ATexture, taCenter);
+    end;
+    ACursor.MoveForward(charwidth*0.5 + ALetterSpacing);
+  end;
+end;
+procedure TBGRADefaultBitmap.InternalArc(cx, cy, rx, ry: single; StartAngleRad,
+  EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions;
+  ADrawChord: boolean; ATexture: IBGRAScanner);
+var
+  pts, ptsFill: array of TPointF;
+  temp: single;
+  multi: TBGRAMultishapeFiller;
+begin
+  if (rx = 0) or (ry = 0) then exit;
+  if ADrawChord then AOptions := AOptions+[aoClosePath];
+  if not (aoFillPath in AOptions) then
+    AFillColor := BGRAPixelTransparent;
+  if (ABorderColor.alpha = 0) and (AFillColor.alpha = 0) then exit;
+  if abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6 then
+  begin
+    if aoPie in AOptions then
+      EndAngleRad:= StartAngleRad+2*PI
+    else
+      EllipseAntialias(cx,cy,rx,ry,ABorderColor,w,AFillColor);
+    exit;
+  end;
+  if EndAngleRad < StartAngleRad then
+  begin
+    temp := StartAngleRad;
+    StartAngleRad:= EndAngleRad;
+    EndAngleRad:= temp;
+  end;
+  pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad);
+  if aoPie in AOptions then pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]);
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  if AFillColor.alpha <> 0 then
+  begin
+    if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts])
+     else ptsFill := pts;
+    if ATexture <> nil then
+      multi.AddPolygon(ptsFill, ATexture)
+    else
+      multi.AddPolygon(ptsFill, AFillColor);
+  end;
+  if ABorderColor.alpha <> 0 then
+  begin
+    if [aoPie,aoClosePath]*AOptions <> [] then
+      multi.AddPolygon(ComputeWidePolygon(pts,w), ABorderColor)
+    else
+      multi.AddPolygon(ComputeWidePolyline(pts,w), ABorderColor);
+  end;
+  multi.Antialiasing := true;
+  multi.Draw(self);
+  multi.Free;
+end;
+function TBGRADefaultBitmap.IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean;
+const oneOver512 = 1/512;
+var Orig,HAxis,VAxis: TPointF;
+begin
+  Orig := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Top);
+  if (abs(Orig.x-round(Orig.x)) > oneOver512) or
+     (abs(Orig.y-round(Orig.y)) > oneOver512) then
+  begin
+    result := false;
+    exit;
+  end;
+  HAxis := AMatrix*PointF(ASourceBounds.Right-1,ASourceBounds.Top);
+  if (abs(HAxis.x - (round(Orig.x)+ASourceBounds.Right-1 - ASourceBounds.Left)) > oneOver512) or
+     (abs(HAxis.y - round(Orig.y)) > oneOver512) then
+  begin
+    result := false;
+    exit;
+  end;
+  VAxis := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Bottom-1);
+  if (abs(VAxis.y - (round(Orig.y)+ASourceBounds.Bottom-1 - ASourceBounds.Top)) > oneOver512) or
+     (abs(VAxis.x - round(Orig.x)) > oneOver512) then
+  begin
+    result := false;
+    exit;
+  end;
+  result := true;
 end;
 …
   c: TBGRAPixel; w: single);
 begin
+  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);
+  FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,c), c);
 end;
 …
   texture: IBGRAScanner; w: single);
 begin
+  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);
+  FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w), texture);
 end;
 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  c: TBGRAPixel; w: single; Closed: boolean);
+var
+  options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  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)
+  c: TBGRAPixel; w: single; ClosedCap: boolean);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,c,ClosedCap), c);
 end;
 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
+  texture: IBGRAScanner; w: single; Closed: boolean);
+var
+  options: TBGRAPolyLineOptions;
+  c: TBGRAPixel;
+begin
+  if not closed then
+  begin
+    options := [plRoundCapOpen];
+    c := BGRAWhite; //needed for alpha junction
+  end else
+  begin
+    options := [];
+    c := BGRAPixelTransparent;
+  end;
+  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);
+  texture: IBGRAScanner; w: single; ClosedCap: boolean);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,ClosedCap), texture);
 end;
 …
   c: TBGRAPixel; w: single);
 begin
+  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)
+  FillPolyAntialias( FPenStroker.ComputePolyline(points,w,c), c);
 end;
 …
   const points: array of TPointF; texture: IBGRAScanner; w: single);
 begin
+  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);
+  FillPolyAntialias( FPenStroker.ComputePolyline(points,w), texture);
 end;
 procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
   c: TBGRAPixel; w: single; Closed: boolean);
+var
   options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  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);
+  c: TBGRAPixel; w: single; ClosedCap: boolean);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolyline(points,w,c,ClosedCap), c);
+end;
+procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
+  const points: array of TPointF; texture: IBGRAScanner; w: single;
+  ClosedCap: boolean);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolyline(points,w,ClosedCap), texture);
 end;
 …
 end;
+procedure TBGRADefaultBitmap.DrawPolyLineAntialiasAutocycle(
+  const points: array of TPointF; c: TBGRAPixel; w: single);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolylineAutocycle(points,w), c);
+end;
+procedure TBGRADefaultBitmap.DrawPolyLineAntialiasAutocycle(
+  const points: array of TPointF; texture: IBGRAScanner; w: single);
+begin
+  FillPolyAntialias( FPenStroker.ComputePolylineAutocycle(points,w), texture);
+end;
 procedure TBGRADefaultBitmap.DrawPolygonAntialias(const points: array of TPointF;
   c: TBGRAPixel; w: single);
 begin
   BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[plCycle],nil,JoinMiterLimit);
+  FillPolyAntialias( FPenStroker.ComputePolygon(points,w), c);
 end;
 …
   const points: array of TPointF; texture: IBGRAScanner; w: single);
 begin
   BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[plCycle],texture,JoinMiterLimit);
+  FillPolyAntialias( FPenStroker.ComputePolygon(points,w), texture);
 end;
 …
 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;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AFillColor: TBGRAPixel);
+begin
+  FillPolyAntialias(APath.getPoints,AFillColor);
+end;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AFillTexture: IBGRAScanner);
+begin
+  FillPolyAntialias(APath.getPoints,AFillTexture);
+end;
+procedure TBGRADefaultBitmap.ErasePath(APath: IBGRAPath; alpha: byte);
+begin
+  ErasePolyAntialias(APath.getPoints,alpha);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
+var tempPath: TBGRAPath;
+  multi: TBGRAMultishapeFiller;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPathFill(tempPath,AMatrix,AFillColor);
+  multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,FPenStroker);
+  multi.Draw(self);
+  multi.Free;
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
+var tempPath: TBGRAPath;
+  multi: TBGRAMultishapeFiller;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPathFill(tempPath,AMatrix,AFillColor);
+  multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,FPenStroker);
+  multi.Draw(self);
+  multi.Free;
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
+var tempPath: TBGRAPath;
+  multi: TBGRAMultishapeFiller;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPathFill(tempPath,AMatrix,AFillTexture);
+  multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,FPenStroker);
+  multi.Draw(self);
+  multi.Free;
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
+var
+  tempPath: TBGRAPath;
+  multi: TBGRAMultishapeFiller;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder := poLastOnTop;
+  multi.AddPathFill(tempPath,AMatrix,AFillTexture);
+  multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,FPenStroker);
+  multi.Draw(self);
+  multi.Free;
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeColor: TBGRAPixel; AWidth: single);
+var tempPath: TBGRAPath;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  tempPath.stroke(self, AMatrix, AStrokeColor, AWidth);
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AStrokeTexture: IBGRAScanner; AWidth: single);
+var tempPath: TBGRAPath;
+begin
+  tempPath := TBGRAPath.Create(APath);
+  tempPath.stroke(self, AMatrix, AStrokeTexture, AWidth);
+  tempPath.Free;
+end;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AFillColor: TBGRAPixel);
+begin
+  FillPolyAntialias(APath.getPoints(AMatrix),AFillColor);
+end;
+procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
+  AFillTexture: IBGRAScanner);
+begin
+  FillPolyAntialias(APath.getPoints(AMatrix),AFillTexture);
+end;
+procedure TBGRADefaultBitmap.ErasePath(APath: IBGRAPath;
+  AMatrix: TAffineMatrix; alpha: byte);
+begin
+  ErasePolyAntialias(APath.getPoints(AMatrix),alpha);
+end;
+procedure TBGRADefaultBitmap.ArrowStartAsNone;
+begin
+  GetArrow.StartAsNone;
+end;
+procedure TBGRADefaultBitmap.ArrowStartAsClassic(AFlipped: boolean;
+  ACut: boolean; ARelativePenWidth: single);
+begin
+  GetArrow.StartAsClassic(AFlipped,ACut,ARelativePenWidth);
+end;
+procedure TBGRADefaultBitmap.ArrowStartAsTriangle(ABackOffset: single;
+  ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
+begin
+  GetArrow.StartAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
+end;
+procedure TBGRADefaultBitmap.ArrowStartAsTail;
+begin
+  GetArrow.StartAsTail;
+end;
+procedure TBGRADefaultBitmap.ArrowEndAsNone;
+begin
+  GetArrow.EndAsNone;
+end;
+procedure TBGRADefaultBitmap.ArrowEndAsClassic(AFlipped: boolean;
+  ACut: boolean; ARelativePenWidth: single);
+begin
+  GetArrow.EndAsClassic(AFlipped,ACut,ARelativePenWidth);
+end;
+procedure TBGRADefaultBitmap.ArrowEndAsTriangle(ABackOffset: single;
+  ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
+begin
+  GetArrow.EndAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
+end;
+procedure TBGRADefaultBitmap.ArrowEndAsTail;
+begin
+  GetArrow.EndAsTail;
 end;
 …
 procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF;
+  texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);
+var
+  center: TPointF;
+  centerTex: TPointF;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
+  FillTriangleLinearMapping(pt1,pt2,center, texture,tex1,tex2,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt2,pt3,center, texture,tex2,tex3,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt3,pt4,center, texture,tex3,tex4,centerTex, TextureInterpolation);
+  FillTriangleLinearMapping(pt4,pt1,center, texture,tex4,tex1,centerTex, TextureInterpolation);
+  texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  TextureInterpolation: Boolean; ACulling: TFaceCulling);
+var
+  scan: TBGRAQuadLinearScanner;
+begin
+  if ((abs(pt1.y-pt2.y)<1e-6) and (abs(pt3.y-pt4.y)<1e-6)) or
+     ((abs(pt3.y-pt2.y)<1e-6) and (abs(pt1.y-pt4.y)<1e-6)) then
+     FillPolyLinearMapping([pt1,pt2,pt3,pt4], texture,
+            [tex1,tex2,tex3,tex4], TextureInterpolation)
+  else
+  begin
+    scan := TBGRAQuadLinearScanner.Create(texture,
+         [tex1,tex2,tex3,tex4],
+         [pt1,pt2,pt3,pt4],TextureInterpolation);
+    scan.Culling := ACulling;
+    FillPoly([pt1,pt2,pt3,pt4],scan,dmDrawWithTransparency);
+    scan.Free;
+  end;
 end;
 …
 procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  ACulling: TFaceCulling);
 var multi : TBGRAMultishapeFiller;
 begin
   multi := TBGRAMultishapeFiller.Create;
   multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4);
+  multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4, ACulling);
   multi.Draw(self);
   multi.free;
 …
 procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  ADrawMode: TDrawMode);
 var
   persp: TBGRAPerspectiveScannerTransform;
 begin
   persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
   FillPoly([pt1,pt2,pt3,pt4],persp,dmDrawWithTransparency);
+  FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
   persp.Free;
 end;
 …
 procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
   pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
   ACleanBorders: TRect);
+  ACleanBorders: TRect; ADrawMode: TDrawMode);
 var
   persp: TBGRAPerspectiveScannerTransform;
 …
   clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
   persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
   FillPoly([pt1,pt2,pt3,pt4],persp,dmDrawWithTransparency);
+  FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
   persp.Free;
   clean.Free;
 …
 end;
+procedure TBGRADefaultBitmap.FillQuadAffineMapping(Orig, HAxis, VAxis: TPointF;
+  AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; ADrawMode: TDrawMode; AOpacity: byte);
+var pts3: TPointF;
+  affine: TBGRAAffineBitmapTransform;
+begin
+  if not APixelCenteredCoordinates then
+  begin
+    Orig -= PointF(0.5,0.5);
+    HAxis -= PointF(0.5,0.5);
+    VAxis -= PointF(0.5,0.5);
+  end;
+  pts3 := HAxis+(VAxis-Orig);
+  affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
+  affine.GlobalOpacity:= AOpacity;
+  affine.Fit(Orig,HAxis,VAxis);
+  FillPoly([Orig,HAxis,pts3,VAxis],affine,ADrawMode);
+  affine.Free;
+end;
+procedure TBGRADefaultBitmap.FillQuadAffineMappingAntialias(Orig, HAxis,
+  VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; AOpacity: byte);
+var pts3: TPointF;
+  affine: TBGRAAffineBitmapTransform;
+begin
+  if not APixelCenteredCoordinates then
+  begin
+    Orig -= PointF(0.5,0.5);
+    HAxis -= PointF(0.5,0.5);
+    VAxis -= PointF(0.5,0.5);
+  end;
+  pts3 := HAxis+(VAxis-Orig);
+  affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
+  affine.GlobalOpacity:= AOpacity;
+  affine.Fit(Orig,HAxis,VAxis);
+  FillPolyAntialias([Orig,HAxis,pts3,VAxis],affine);
+  affine.Free;
+end;
 procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF;
   texture: IBGRAScanner; texCoords: array of TPointF;
 …
 end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
+  AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
+begin
+  DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillColor);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
+  AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
+begin
+  DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillColor);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
+  AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
+begin
+  DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillTexture);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
+  AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
+begin
+  DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillTexture);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single);
+begin
+  DrawPath(APath, AffineMatrixIdentity, AStrokeColor, AWidth);
+end;
+procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single);
+begin
+  DrawPath(APath, AffineMatrixIdentity, AStrokeTexture, AWidth);
+end;
 procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
   c: TBGRAPixel; w: single);
 begin
   if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psClear) or (c.alpha = 0) then exit;
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode, LinearAntialiasing)
   else
 …
   texture: IBGRAScanner; w: single);
 begin
   if IsClearPenStyle(FCustomPenStyle) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psClear) then exit;
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture, LinearAntialiasing)
   else
 …
   { use multishape filler for fine junction between polygons }
   multi := TBGRAMultishapeFiller.Create;
   if not IsClearPenStyle(FCustomPenStyle) and (c.alpha <> 0) then
   begin
     if IsSolidPenStyle(FCustomPenStyle) then
+  if not (PenStyle = psClear) and (c.alpha <> 0) then
+  begin
+    if (PenStyle = psSolid) then
     begin
       multi.AddEllipse(x,y,rx-hw,ry-hw,back);
 …
   hw: single;
 begin
   if IsClearPenStyle(FCustomPenStyle) or (c.alpha=0) or (w=0) then
+  if (PenStyle = psClear) or (c.alpha=0) or (w=0) then
   begin
     if back <> BGRAPixelTransparent then
 …
   multi := TBGRAMultishapeFiller.Create;
   multi.FillMode := FillMode;
   if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
+  if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then
     multi.AddRectangleBorder(x,y,x2,y2,w,c)
   else
 …
   multi: TBGRAMultishapeFiller;
 begin
   if IsClearPenStyle(FCustomPenStyle) or (w=0) then exit;
+  if (PenStyle = psClear) or (w=0) then exit;
   hw := w/2;
 …
   multi := TBGRAMultishapeFiller.Create;
   multi.FillMode := FillMode;
   if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
+  if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then
     multi.AddRectangleBorder(x,y,x2,y2,w, texture)
   else
 …
    c: TBGRAPixel; w: single; options: TRoundRectangleOptions);
 begin
   if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psClear) or (c.alpha = 0) then exit;
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing)
   else
 …
   multi: TBGRAMultishapeFiller;
 begin
   if IsClearPenStyle(FCustomPenStyle) or (pencolor.alpha = 0) then
+  if (PenStyle = psClear) or (pencolor.alpha = 0) then
   begin
     FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options);
     exit;
   end;
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False)
   else
 …
   multi: TBGRAMultishapeFiller;
 begin
   if IsClearPenStyle(FCustomPenStyle) then
+  if (PenStyle = psClear) then
   begin
     FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options);
     exit;
   end else
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False)
   else
 …
   texture: IBGRAScanner; w: single; options: TRoundRectangleOptions);
 begin
   if IsClearPenStyle(FCustomPenStyle) then exit;
   if IsSolidPenStyle(FCustomPenStyle) then
+  if (PenStyle = psClear) then exit;
+  if (PenStyle = psSolid) then
     BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing)
   else
 …
 procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
   texture: IBGRAScanner; mode: TDrawMode);
+  texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint);
 var
   yb, tx, delta: integer;
 …
   for yb := y to y2 do
   begin
     texture.ScanMoveTo(x,yb);
+    texture.ScanMoveTo(x+AScanOffset.X,yb+AScanOffset.Y);
     ScannerPutPixels(texture, p, tx, mode);
     Inc(p, delta);
 …
   InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
+  texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm);
+var dither: TDitheringTask;
+begin
+  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
+  dither := CreateDitheringTask(ditheringAlgorithm, texture, self, rect(x,y,x2,y2));
+  dither.ScanOffset := AScanOffset;
+  dither.DrawMode := mode;
+  dither.Execute;
+  dither.Free;
 end;
 …
 end;
 procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
+procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel; pixelCenteredCoordinates: boolean);
 var tx,ty: single;
 begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   tx := x2-x;
   ty := y2-y;
   if (tx=0) or (ty=0) then exit;
+  if (abs(tx)<1e-3) or (abs(ty)<1e-3) then exit;
   if (abs(tx) > 2) and (abs(ty) > 2) then
   begin
 …
 procedure TBGRADefaultBitmap.EraseRectAntialias(x, y, x2, y2: single;
+  alpha: byte);
+begin
+  alpha: byte; pixelCenteredCoordinates: boolean);
+begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   ErasePolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], alpha);
 end;
 procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single;
+  texture: IBGRAScanner);
+begin
+  texture: IBGRAScanner; pixelCenteredCoordinates: boolean);
+begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], texture);
 end;
 procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,ry: single;
+  c: TBGRAPixel; options: TRoundRectangleOptions);
+begin
+  c: TBGRAPixel; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
+begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False, LinearAntialiasing);
 end;
 procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,
+  ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions);
+begin
+  ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
+begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture, LinearAntialiasing);
 end;
 procedure TBGRADefaultBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx,
+  ry: single; alpha: byte; options: TRoundRectangleOptions);
+begin
+  ry: single; alpha: byte; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
+begin
+  if not pixelCenteredCoordinates then
+  begin
+    x -= 0.5;
+    y -= 0.5;
+    x2 -= 0.5;
+    y2 -= 0.5;
+  end;
   BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True, LinearAntialiasing);
 end;
 …
   sUTF8: string; c: TBGRAPixel; align: TAlignment);
 begin
+  FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align);
+  with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
+    FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align);
 end;
 …
   sUTF8: string; texture: IBGRAScanner; align: TAlignment);
 begin
+  FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align);
+  with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
+    FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align);
+end;
+procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single);
+begin
+  InternalTextOutCurved(ACursor, sUTF8, AColor, nil, AAlign, ALetterSpacing);
+end;
+procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
+begin
+  InternalTextOutCurved(ACursor, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing);
 end;
 …
   c: TBGRAPixel; align: TAlignment);
 begin
+  FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align);
+  with (PointF(x,y)-GetFontAnchorRotatedOffset) do
+    FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align);
 end;
 …
   sUTF8: string; style: TTextStyle; c: TBGRAPixel);
 begin
+  FontRenderer.TextRect(self,ARect,x,y,sUTF8,style,c);
+  with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
+    FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,c);
 end;
 …
   style: TTextStyle; texture: IBGRAScanner);
 begin
+  FontRenderer.TextRect(self,ARect,x,y,sUTF8,style,texture);
+  with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
+    FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,texture);
 end;
 …
   w: single): ArrayOfTPointF;
 begin
+  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)
+  result := FPenStroker.ComputePolyline(points,w);
 end;
 function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
+  w: single; Closed: boolean): ArrayOfTPointF;
+var
+  options: TBGRAPolyLineOptions;
+begin
+  if not closed then options := [plRoundCapOpen] else options := [];
+  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);
+  w: single; ClosedCap: boolean): ArrayOfTPointF;
+begin
+  result := FPenStroker.ComputePolyline(points,w,ClosedCap);
 end;
 …
   w: single): ArrayOfTPointF;
 begin
   Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,GetPolyLineOption+[plCycle],JoinMiterLimit);
+  result := FPenStroker.ComputePolygon(points,w);
 end;
 …
 procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
   texture: IBGRAScanner; ADrawMode: TDrawMode);
+  texture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte);
 var
   scan: TBGRACustomScanner;
 begin
   if AMask = nil then exit;
   scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),texture);
+  scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),texture, AOpacity);
   self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,ADrawMode);
   scan.Free;
 …
   n: integer;
   colorMask,beforeBGR, afterBGR: longword;
+begin
+  colorMask := NtoLE($00FFFFFF);
+  beforeBGR := NtoLE((before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF));
+  afterBGR  := NtoLE((after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF));
+  rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
+begin
+  colorMask := LongWord(BGRA(255,255,255,0));
+  RedGreenBlue(before, rBefore,gBefore,bBefore);
+  RedGreenBlue(after, rAfter,gAfter,bAfter);
+  beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
+  afterBGR  := LongWord(BGRA(rAfter,gAfter,bAfter,0));
   p := PLongWord(Data);
 …
   for n := NbPixels - 1 downto 0 do
   begin
     if p^ = before then
+    if PDWord(p)^ = DWord(before) then
       p^ := after;
     Inc(p);
+  end;
+  InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before, after: TColor);
+var p: PLongWord;
+  xb,yb,xcount: integer;
+  colorMask,beforeBGR, afterBGR: longword;
+  rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
+begin
+  colorMask := LongWord(BGRA(255,255,255,0));
+  RedGreenBlue(before, rBefore,gBefore,bBefore);
+  RedGreenBlue(after, rAfter,gAfter,bAfter);
+  beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
+  afterBGR  := LongWord(BGRA(rAfter,gAfter,bAfter,0));
+  if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
+  xcount := ABounds.Right-ABounds.Left;
+  for yb := ABounds.Top to ABounds.Bottom-1 do
+  begin
+    p := PLongWord(ScanLine[yb]+ABounds.Left);
+    for xb := xcount-1 downto 0 do
+    begin
+      if p^ and colorMask = beforeBGR then
+        p^ := (p^ and not ColorMask) or afterBGR;
+      Inc(p);
+    end;
+  end;
+  InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before,
+  after: TBGRAPixel);
+var p: PBGRAPixel;
+  xb,yb,xcount: integer;
+begin
+  if before.alpha = 0 then
+  begin
+    ReplaceTransparent(ABounds,after);
+    exit;
+  end;
+  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 PDWord(p)^ = DWord(before) then
+        p^ := after;
+      Inc(p);
+    end;
   end;
   InvalidateBitmap;
 …
       p^ := after;
     Inc(p);
+  end;
+  InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.ReplaceTransparent(ABounds: TRect;
+  after: TBGRAPixel);
+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
+        p^ := after;
+      Inc(p);
+    end;
   end;
   InvalidateBitmap;
 …
 procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
   c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
+  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
+begin
+  BGRAGradientFill(self, x, y, x2, y2, c1, c2, gtype, o1, o2, mode, gammaColorCorrection, Sinus);
+  gammaColorCorrection: boolean; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
+var
+  scanner: TBGRAGradientScanner;
+begin
+  if (c1.alpha = 0) and (c2.alpha = 0) then
+    FillRect(x, y, x2, y2, BGRAPixelTransparent, mode)
+  else
+  if ditherAlgo <> daNearestNeighbor then
+    GradientFillDithered(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus,ditherAlgo)
+  else
+  begin
+    scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
+    FillRect(x,y,x2,y2,scanner,mode);
+    scanner.Free;
+  end;
 end;
 procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
   gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
   mode: TDrawMode; Sinus: Boolean);
+  mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
 var
   scanner: TBGRAGradientScanner;
 begin
+  if ditherAlgo <> daNearestNeighbor then
+    GradientFillDithered(x,y,x2,y2,gradient,gtype,o1,o2,mode,sinus,ditherAlgo)
+  else
+  begin
+    scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
+    FillRect(x,y,x2,y2,scanner,mode);
+    scanner.Free;
+  end;
+end;
+procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; c1,
+  c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF;
+  mode: TDrawMode; gammaColorCorrection: boolean; Sinus: Boolean;
+  ditherAlgo: TDitheringAlgorithm);
+var
+  scanner: TBGRAGradientScanner;
+begin
+  if (c1.alpha = 0) and (c2.alpha = 0) then
+    FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet)
+  else
+  begin
+    scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
+    FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
+    scanner.Free;
+  end;
+end;
+procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer;
+  gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
+  mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
+var
+  scanner: TBGRAGradientScanner;
+begin
   scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
   FillRect(x,y,x2,y2,scanner,mode);
+  FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
   scanner.Free;
 end;
 …
 function TBGRADefaultBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel;
 begin
   if FData <> nil then
     result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FHeight))+PositiveMod(X+ScanOffset.X, FWidth))^
+  if (FScanWidth <> 0) and (FScanHeight <> 0) then
+    result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FScanHeight))+PositiveMod(X+ScanOffset.X, FScanWidth))^
   else
     result := BGRAPixelTransparent;
 …
 procedure TBGRADefaultBitmap.ScanMoveTo(X, Y: Integer);
 begin
   if FData = nil then exit;
+  if (FScanWidth = 0) or (FScanHeight = 0) then exit;
   LoadFromBitmapIfNeeded;
   FScanCurX := PositiveMod(X+ScanOffset.X, FWidth);
   FScanCurY := PositiveMod(Y+ScanOffset.Y, FHeight);
+  FScanCurX := PositiveMod(X+ScanOffset.X, FScanWidth);
+  FScanCurY := PositiveMod(Y+ScanOffset.Y, FScanHeight);
   FScanPtr := ScanLine[FScanCurY];
 end;
 …
 function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel;
 begin
   if FData <> nil then
+  if (FScanWidth <> 0) and (FScanHeight <> 0) then
   begin
     result := (FScanPtr+FScanCurX)^;
     inc(FScanCurX);
     if FScanCurX = FWidth then //cycle
+    if FScanCurX = FScanWidth then //cycle
       FScanCurX := 0;
   end
 …
   iFactX,iFactY: Int32or64;
 begin
   if FData = nil then
+  if (FScanWidth = 0) or (FScanHeight = 0) then
   begin
     result := BGRAPixelTransparent;
 …
   ix := round(x*256);
   iy := round(y*256);
+  if ScanInterpolationFilter = rfBox then
+  begin
+    ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
+    iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
+    result := (GetScanlineFast(iy)+ix)^;
+    exit;
+  end;
   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;
+  ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
+  iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
   if (iFactX = 0) and (iFactY = 0) then
   begin
 …
   c: TBGRAPixel;
 begin
+  if (FScanWidth <= 0) or (FScanHeight <= 0) then
+  begin
+    if mode = dmSet then
+      FillDWord(pdest^, count, DWord(BGRAPixelTransparent));
+    exit;
+  end;
   case mode of
     dmLinearBlend:
 …
       while count > 0 do
       begin
         nbCopy := FWidth-FScanCurX;
+        nbCopy := FScanWidth-FScanCurX;
         if count < nbCopy then nbCopy := count;
         move((FScanPtr+FScanCurX)^,pdest^,nbCopy*sizeof(TBGRAPixel));
         inc(pdest,nbCopy);
         inc(FScanCurX,nbCopy);
         if FScanCurX = FWidth then FScanCurX := 0;
+        if FScanCurX = FScanWidth then FScanCurX := 0;
         dec(count,nbCopy);
       end;
 …
   p: PBGRAPixel;
   n: integer;
+  colormask: longword;
 begin
   if CanvasAlphaCorrection then
   begin
     p := FData;
+    colormask := longword(BGRA(255,255,255,0));
     for n := NbPixels - 1 downto 0 do
     begin
       if (longword(p^) and $FFFFFF <> 0) and (p^.alpha = 0) then
+      if (longword(p^) and colormask <> 0) and (p^.alpha = 0) then
         p^.alpha := FCanvasOpacity;
       Inc(p);
 …
   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);
+procedure TBGRADefaultBitmap.PutImageAffine(AMatrix: TAffineMatrix;
+  Source: TBGRACustomBitmap; AOutputBounds: TRect;
+  AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte);
 var affine: TBGRAAffineBitmapTransform;
     SourceBounds: TRect;
 begin
   if (Source = nil) or (AOpacity = 0) then exit;
+    sourceBounds: TRect;
+begin
+  if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) 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
+    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, false, AResampleFilter);
+  affine.GlobalOpacity := AOpacity;
+  affine.Fit(Origin,HAxis,VAxis);
+  FillRect(AOutputBounds,affine,AMode);
+  affine.Free;
+  if IsAffineRoughlyTranslation(AMatrix, rect(0,0,Source.Width,Source.Height)) then
+  begin
+    sourceBounds := AOutputBounds;
+    OffsetRect(sourceBounds, -round(AMatrix[1,3]),-round(AMatrix[2,3]));
+    IntersectRect(sourceBounds,sourceBounds,rect(0,0,Source.Width,Source.Height));
+    PutImagePart(round(AMatrix[1,3])+sourceBounds.Left,round(AMatrix[2,3])+sourceBounds.Top,Source,sourceBounds,AMode,AOpacity);
+  end else
+  begin
+    affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter);
+    affine.GlobalOpacity := AOpacity;
+    affine.ViewMatrix := AMatrix;
+    FillRect(AOutputBounds,affine,AMode);
+    affine.Free;
+  end;
+end;
+function TBGRADefaultBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix;
+  ASourceBounds: TRect; AClipOutput: boolean): TRect;
+const pointMargin = 0.5 - 1/512;
+  procedure FirstPoint(pt: TPointF);
+  begin
+    result.Left := round(pt.X);
+    result.Top := round(pt.Y);
+    result.Right := round(pt.X)+1;
+    result.Bottom := round(pt.Y)+1;
+  end;
+  //include specified point in the bounds
+  procedure IncludePoint(pt: TPointF);
+  begin
+    if round(pt.X) < result.Left then result.Left := round(pt.X);
+    if round(pt.Y) < result.Top then result.Top := round(pt.Y);
+    if round(pt.X)+1 > result.Right then result.Right := round(pt.X)+1;
+    if round(pt.Y)+1 > result.Bottom then result.Bottom := round(pt.Y)+1;
+  end;
+begin
+  result := EmptyRect;
+  if IsRectEmpty(ASourceBounds) then exit;
+  if IsAffineRoughlyTranslation(AMatrix,ASourceBounds) then
+  begin
+    result := ASourceBounds;
+    OffsetRect(result,round(AMatrix[1,3]),round(AMatrix[2,3]));
+  end else
+  begin
+    FirstPoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Top-pointMargin));
+    IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Top-pointMargin));
+    IncludePoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Bottom-1+pointMargin));
+    IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Bottom-1+pointMargin));
+  end;
+  if AClipOutput then IntersectRect(result,result,ClipRect);
 end;
 …
 function TBGRADefaultBitmap.FilterSmooth: TBGRACustomBitmap;
 begin
   Result := BGRAFilters.FilterBlurRadialPrecise(self, 0.3);
+  Result := BGRAFilters.FilterBlurRadial(self, 3, rbPrecise);
 end;
 …
 end;
 function TBGRADefaultBitmap.FilterBlurRadial(radius: integer;
+function TBGRADefaultBitmap.FilterBlurRadial(radius: single;
   blurType: TRadialBlurType): TBGRACustomBitmap;
 begin
 …
 end;
 function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radius: integer;
+function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radius: single;
   blurType: TRadialBlurType): TBGRACustomBitmap;
 var task: TFilterTask;
 …
 end;
+function TBGRADefaultBitmap.FilterBlurRadial(radiusX, radiusY: single;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterBlurRadial(self, radiusX,radiusY, blurType);
+end;
+function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radiusX,
+  radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := BGRAFilters.CreateRadialBlurTask(self, ABounds, radiusX,radiusY, blurType);
+  try
+    result := task.Execute;
+  finally
+    task.Free;
+  end;
+end;
 function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
   useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
 …
 end;
 function TBGRADefaultBitmap.FilterBlurMotion(distance: integer;
+function TBGRADefaultBitmap.FilterBlurMotion(distance: single;
   angle: single; oriented: boolean): TBGRACustomBitmap;
 begin
 …
 end;
 function TBGRADefaultBitmap.FilterBlurMotion(ABounds: TRect; distance: integer;
+function TBGRADefaultBitmap.FilterBlurMotion(ABounds: TRect; distance: single;
   angle: single; oriented: boolean): TBGRACustomBitmap;
 var task: TFilterTask;
 …
 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);
+function TBGRADefaultBitmap.FilterEmboss(angle: single;
+  AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterEmboss(self, angle, AStrength, AOptions);
+end;
+function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect;
+  AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+begin
+  Result := BGRAFilters.FilterEmboss(self, angle, ABounds, AStrength, AOptions);
 end;
 …
 begin
   Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur);
+end;
+function TBGRADefaultBitmap.FilterAffine(AMatrix: TAffineMatrix;
+  correctBlur: boolean): TBGRACustomBitmap;
+begin
+  Result := NewBitmap(Width,Height);
+  Result.PutImageAffine(AMatrix,self,255,correctBlur);
 end;
 …
   if pix.alpha = 0 then
     result := clNone else
      result := pix.red + pix.green shl 8 + pix.blue shl 16;
+     result := RGBToColor(pix.red,pix.green,pix.blue);
   {$hints on}
 end;
 …
 end;
+function TBGRADefaultBitmap.CreateAdaptedPngWriter: TFPWriterPNG;
+begin
+  result := TFPWriterPNG.Create;
+  result.Indexed := False;
+  result.UseAlpha := HasTransparentPixels;
+  result.WordSized := false;
+function TBGRADefaultBitmap.GetPenJoinStyle: TPenJoinStyle;
+begin
+  result := FPenStroker.JoinStyle;
+end;
+procedure TBGRADefaultBitmap.SetPenJoinStyle(const AValue: TPenJoinStyle);
+begin
+  FPenStroker.JoinStyle := AValue;
+end;
+function TBGRADefaultBitmap.GetPenMiterLimit: single;
+begin
+  result := FPenStroker.MiterLimit;
+end;
+procedure TBGRADefaultBitmap.SetPenMiterLimit(const AValue: single);
+begin
+  FPenStroker.MiterLimit := AValue;
 end;
 …
   It is NOT EXACTLY an involution, when applied twice, some color information is lost }
 procedure TBGRADefaultBitmap.Negative;
+var
+  p: PBGRAPixel;
+  n: integer;
+begin
+  LoadFromBitmapIfNeeded;
+  p := Data;
+  for n := NbPixels - 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;
+  InvalidateBitmap;
+begin
+  TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), True);
 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;
+  TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, True);
 end;
 …
   It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.LinearNegative;
+var
+  p: PBGRAPixel;
+  n: integer;
+begin
+  LoadFromBitmapIfNeeded;
+  p := Data;
+  for n := NbPixels - 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;
+  InvalidateBitmap;
+begin
+  TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
 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;
+  TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, False);
+end;
+procedure TBGRADefaultBitmap.InplaceGrayscale(AGammaCorrection: boolean = true);
+begin
+  TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), AGammaCorrection);
+end;
+procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true);
+begin
+  if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
+  TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, ABounds, AGammaCorrection);
+end;
+procedure TBGRADefaultBitmap.InplaceNormalize(AEachChannel: boolean);
+begin
+  InplaceNormalize(rect(0,0,Width,Height),AEachChannel);
+end;
+procedure TBGRADefaultBitmap.InplaceNormalize(ABounds: TRect;
+  AEachChannel: boolean);
+var scanner: TBGRAFilterScannerNormalize;
+begin
+  if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
+  scanner := TBGRAFilterScannerNormalize.Create(self,Point(0,0),ABounds,AEachChannel);
+  FillRect(ABounds,scanner,dmSet);
+  scanner.Free;
 end;
 …
   It is an involution, i.e it does nothing when applied twice }
 procedure TBGRADefaultBitmap.SwapRedBlue;
+begin
+  TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
+end;
+procedure TBGRADefaultBitmap.SwapRedBlue(ARect: TRect);
+begin
+  if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit;
+  TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, ARect, False);
+end;
+{ Convert a grayscale image into a black image with alpha value }
+procedure TBGRADefaultBitmap.GrayscaleToAlpha;
 var
   n:    integer;
-  temp: longword;
   p:    PLongword;
 begin
 …
     exit;
   repeat
+    temp := LEtoN(p^);
+    p^   := NtoLE(((temp and $FF) shl 16) or ((temp and $FF0000) shr 16) or
+      temp and $FF00FF00);
+    p^   := (p^ shr TBGRAPixel_RedShift and $FF) shl TBGRAPixel_AlphaShift;
     Inc(p);
     Dec(n);
 …
 end;
+{ Convert a grayscale image into a black image with alpha value }
+procedure TBGRADefaultBitmap.GrayscaleToAlpha;
+procedure TBGRADefaultBitmap.AlphaToGrayscale;
 var
   n:    integer;
 …
     exit;
   repeat
+    temp := LEtoN(p^);
+    p^   := NtoLE((temp and $FF) shl 24);
+    Inc(p);
+    Dec(n);
+  until n = 0;
+  InvalidateBitmap;
+end;
+procedure TBGRADefaultBitmap.AlphaToGrayscale;
+var
+  n:    integer;
+  temp: longword;
+  p:    PLongword;
+begin
+  LoadFromBitmapIfNeeded;
+  p := PLongword(Data);
+  n := NbPixels;
+  if n = 0 then
+    exit;
+  repeat
+    temp := LEtoN(p^ shr 24);
+    p^   := NtoLE(temp or (temp shl 8) or (temp shl 16) or $FF000000);
+    temp := (p^ shr TBGRAPixel_AlphaShift) and $ff;
+    p^   := (temp shl TBGRAPixel_RedShift) or (temp shl TBGRAPixel_GreenShift)
+         or (temp shl TBGRAPixel_BlueShift) or ($ff shl TBGRAPixel_AlphaShift);
     Inc(p);
     Dec(n);
 …
     end;
   end;
+end;
+procedure TBGRADefaultBitmap.ApplyGlobalOpacity(ABounds: TRect; alpha: byte);
+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
+      p^.alpha := ApplyOpacity(p^.alpha, alpha);
+      Inc(p);
+    end;
+  end;
+  InvalidateBitmap;
 end;
 …
 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, xb2, yb: integer;
-  p:      PDWord;
-  colorMask, colorZeros: DWord;
-begin
-  maxx := -1;
-  maxy := -1;
-  minx := self.Width;
-  miny := self.Height;
-  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 := PDWord(self.ScanLine[yb]);
-    for xb := 0 to self.Width - 1 do
-    begin
-      if (p^ and colorMask) <> colorZeros then
-      begin
-        if xb < minx then
-          minx := xb;
-        if yb < miny then
-          miny := yb;
-        if xb > maxx then
-          maxx := xb;
-        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);
-    end;
-  end;
-  if minx > maxx then
-  begin
-    Result.left   := 0;
-    Result.top    := 0;
-    Result.right  := 0;
-    Result.bottom := 0;
-  end
-  else
-  begin
-    Result.left   := minx;
-    Result.top    := miny;
-    Result.right  := maxx + 1;
-    Result.bottom := maxy + 1;
-  end;
-end;
 function TBGRADefaultBitmap.GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect;
 var
 …
   begin
     if LineOrder = riloTopToBottom then
       ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Top]) else
       ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Bottom-1]);
+      ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Top]) else
+      ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Bottom-1]);
     ptrbmp.LineOrder := LineOrder;
     result := ptrbmp;
   end;
-end;
-{ Draw BGRA data to a canvas with transparency }
-procedure TBGRADefaultBitmap.DataDrawTransparent(ACanvas: TCanvas;
-  Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-var
-  Temp:     TBitmap;
-  RawImage: TRawImage;
-  BitmapHandle, MaskHandle: HBitmap;
-begin
-  RawImage.Init;
-  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
-  RawImage.Description.LineOrder := ALineOrder;
-  RawImage.Data     := PByte(AData);
-  RawImage.DataSize := AWidth * AHeight * sizeof(TBGRAPixel);
-  if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
-    raise FPImageException.Create('Failed to create bitmap handle');
-  Temp := TBitmap.Create;
-  Temp.Handle := BitmapHandle;
-  Temp.MaskHandle := MaskHandle;
-  ACanvas.StretchDraw(Rect, Temp);
-  Temp.Free;
-end;
-{ Draw BGRA data to a canvas without transparency }
-procedure TBGRADefaultBitmap.DataDrawOpaque(ACanvas: TCanvas;
-  Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-var
-  Temp:      TBitmap;
-  RawImage:  TRawImage;
-  BitmapHandle, MaskHandle: HBitmap;
-  TempData:  Pointer;
-  x, y:      integer;
-  PTempData: PByte;
-  PSource:   PByte;
-  ADataSize: integer;
-  ALineEndMargin: integer;
-  CreateResult: boolean;
-  {$IFDEF DARWIN}
-  TempShift: Byte;
-  {$ENDIF}
-begin
-  if (AHeight = 0) or (AWidth = 0) then
-    exit;
-  ALineEndMargin := (4 - ((AWidth * 3) and 3)) and 3;
-  ADataSize      := (AWidth * 3 + ALineEndMargin) * AHeight;
-     {$HINTS OFF}
-  GetMem(TempData, ADataSize);
-     {$HINTS ON}
-  PTempData := TempData;
-  PSource   := AData;
-{$IFDEF DARWIN} //swap red and blue values
-  for y := 0 to AHeight - 1 do
-  begin
-    for x := 0 to AWidth - 1 do
-    begin
-      PTempData^ := (PSource+2)^;
-      (PTempData+1)^ := (PSource+1)^;
-      (PTempData+2)^ := PSource^;
-      inc(PTempData,3);
-      inc(PSource,4);
-    end;
-    Inc(PTempData, ALineEndMargin);
-  end;
-{$ELSE}
-  for y := 0 to AHeight - 1 do
-  begin
-    for x := 0 to AWidth - 1 do
-    begin
-      PWord(PTempData)^ := PWord(PSource)^;
-      (PTempData+2)^ := (PSource+2)^;
-      Inc(PTempData,3);
-      Inc(PSource, 4);
-    end;
-    Inc(PTempData, ALineEndMargin);
-  end;
-{$ENDIF}
-  RawImage.Init;
-  RawImage.Description.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight);
-{$IFDEF DARWIN}
-  TempShift := RawImage.Description.RedShift;
-  RawImage.Description.RedShift := RawImage.Description.BlueShift;
-  RawImage.Description.BlueShift := TempShift;
-{$ENDIF}
-  RawImage.Description.LineOrder := ALineOrder;
-  RawImage.Description.LineEnd := rileDWordBoundary;
-  if integer(RawImage.Description.BytesPerLine) <> AWidth * 3 + ALineEndMargin then
-  begin
-    FreeMem(TempData);
-    raise FPImageException.Create('Line size is inconsistant');
-  end;
-  RawImage.Data     := PByte(TempData);
-  RawImage.DataSize := ADataSize;
-  CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
-  FreeMem(TempData);
-  if not CreateResult then
-    raise FPImageException.Create('Failed to create bitmap handle');
-  Temp := TBitmap.Create;
-  Temp.Handle := BitmapHandle;
-  Temp.MaskHandle := MaskHandle;
-  ACanvas.StretchDraw(Rect, Temp);
-  Temp.Free;
 end;
 …
 end;
+procedure TBGRADefaultBitmap.RebuildBitmap;
+var
+  RawImage: TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+begin
+  if FBitmap <> nil then
+    FBitmap.Free;
+  FBitmap := TBitmapTracker.Create(self);
+  if (FWidth > 0) and (FHeight > 0) then
+  begin
+    RawImage.Init;
+    RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight);
+    RawImage.Description.LineOrder := FLineOrder;
+    RawImage.Data     := PByte(FData);
+    RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel);
+    if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
+      raise FPImageException.Create('Failed to create bitmap handle');
+    FBitmap.Handle     := BitmapHandle;
+    FBitmap.MaskHandle := MaskHandle;
+  end;
+  FBitmap.Canvas.AntialiasingMode := amOff;
+  FBitmapModified := False;
+function TBGRADefaultBitmap.CreatePtrBitmap(AWidth, AHeight: integer;
+  AData: PBGRAPixel): TBGRAPtrBitmap;
+begin
+  result := TBGRAPtrBitmap.Create(AWidth,AHeight,AData);
 end;
 …
 end;
-procedure TBGRADefaultBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
-var
-  bmp: TBitmap;
-  subBmp: TBGRACustomBitmap;
-  subRect: TRect;
-  cw,ch: integer;
-begin
-  DiscardBitmapChange;
-  cw := CanvasSource.Width;
-  ch := CanvasSource.Height;
-  if (x < 0) or (y < 0) or (x+Width > cw) or
-    (y+Height > ch) then
-  begin
-    FillTransparent;
-    if (x+Width <= 0) or (y+Height <= 0) or
-      (x >= cw) or (y >= ch) then
-      exit;
-    if (x > 0) then subRect.Left := x else subRect.Left := 0;
-    if (y > 0) then subRect.Top := y else subRect.Top := 0;
-    if (x+Width > cw) then subRect.Right := cw else
-      subRect.Right := x+Width;
-    if (y+Height > ch) then subRect.Bottom := ch else
-      subRect.Bottom := y+Height;
-    subBmp := NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top);
-    subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top);
-    PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet);
-    subBmp.Free;
-    exit;
-  end;
-  bmp := TBitmap.Create;
-  bmp.PixelFormat := pf24bit;
-  bmp.Width := Width;
-  bmp.Height := Height;
-  bmp.Canvas.CopyRect(Classes.rect(0, 0, Width, Height), CanvasSource,
-    Classes.rect(x, y, x + Width, y + Height));
-  LoadFromRawImage(bmp.RawImage, 255, True);
-  bmp.Free;
-  InvalidateBitmap;
-end;
 function TBGRADefaultBitmap.GetNbPixels: integer;
 begin
 …
 end;
+procedure TBGRADefaultBitmap.SetLineOrder(AValue: TRawImageLineOrder);
+begin
+  FLineOrder := AValue;
+end;
 function TBGRADefaultBitmap.GetCanvasOpacity: byte;
 begin
 …
 { TBGRAPtrBitmap }
+function TBGRAPtrBitmap.GetLineOrder: TRawImageLineOrder;
+begin
+  result := inherited GetLineOrder;
+end;
+procedure TBGRAPtrBitmap.SetLineOrder(AValue: TRawImageLineOrder);
+begin
+  inherited SetLineOrder(AValue);
+end;
 procedure TBGRAPtrBitmap.ReallocData;
 begin
 …
 begin
   FData := nil;
+end;
+procedure TBGRAPtrBitmap.CannotResize;
+begin
+  raise exception.Create('A pointer bitmap cannot be resized');
+end;
+procedure TBGRAPtrBitmap.NotImplemented;
+begin
+  raise exception.Create('Not implemented');
+end;
+procedure TBGRAPtrBitmap.RebuildBitmap;
+begin
+  NotImplemented;
+end;
+function TBGRAPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := nil;
+  NotImplemented;
+end;
+function TBGRAPtrBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+begin
+  result := false;
+  NotImplemented;
 end;
 …
 begin
   FData := AData;
+end;
+procedure TBGRAPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  NotImplemented;
+end;
+procedure TBGRAPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  NotImplemented;
+end;
+procedure TBGRAPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer
+  );
+begin
+  NotImplemented;
+end;
+procedure TBGRAPtrBitmap.Assign(Source: TPersistent);
+begin
+  CannotResize;
+end;
+procedure TBGRAPtrBitmap.TakeScreenshot(ARect: TRect);
+begin
+  CannotResize;
+end;
+procedure TBGRAPtrBitmap.TakeScreenshotOfPrimaryMonitor;
+begin
+  CannotResize;
+end;
+procedure TBGRAPtrBitmap.LoadFromDevice(DC: System.THandle);
+begin
+  CannotResize;
+end;
+procedure TBGRAPtrBitmap.LoadFromDevice(DC: System.THandle; ARect: TRect);
+begin
+  CannotResize;
 end;
 …
   c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
   gammaColorCorrection: boolean = True; Sinus: Boolean=False);
+var
+  gradScan : TBGRAGradientScanner;
+begin
+  //handles transparency
+  if (c1.alpha = 0) and (c2.alpha = 0) then
+  begin
+    bmp.FillRect(x, y, x2, y2, BGRAPixelTransparent, mode);
+    exit;
+  end;
+  gradScan := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
+  bmp.FillRect(x,y,x2,y2,gradScan,mode);
+  gradScan.Free;
+begin
+  bmp.GradientFill(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus);
 end;
 …
   end;
-  ImageHandlers.RegisterImageWriter ('Personal Computer eXchange', 'pcx', TFPWriterPcx);
-  ImageHandlers.RegisterImageReader ('Personal Computer eXchange', 'pcx', TFPReaderPcx);
-  ImageHandlers.RegisterImageWriter ('X Pixmap', 'xpm', TFPWriterXPM);
-  ImageHandlers.RegisterImageReader ('X Pixmap', 'xpm', TFPReaderXPM);
 end.

GraphicTest/Packages/bgrabitmap/bgradithering.pas

-              r472
+              r494
 uses
   Classes, SysUtils, BGRAFilters, BGRAPalette, BGRABitmapTypes;
+  Classes, SysUtils, BGRAFilterType, BGRAPalette, BGRABitmapTypes;
 type
+  TOutputPixelProc = procedure(X,Y: NativeInt; AColorIndex: NativeInt; AColor: TBGRAPixel) of object;
   { TDitheringTask }
 …
     FIgnoreAlpha: boolean;
     FPalette: TBGRACustomApproxPalette;
+    FCurrentOutputScanline: PBGRAPixel;
+    FCurrentOutputY: NativeInt;
+    FOutputPixel : TOutputPixelProc;
+    FDrawMode: TDrawMode;
+    procedure OutputPixel(X,Y: NativeInt; {%H-}AColorIndex: NativeInt; AColor: TBGRAPixel); virtual;
+    procedure ApproximateColor(const AColor: TBGRAPixel; out AApproxColor: TBGRAPixel; out AIndex: integer);
   public
+    constructor Create(ASource: IBGRAScanner; APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; AIgnoreAlpha: boolean; ABounds: TRect); overload;
     constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; ABounds: TRect); overload;
     constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); overload;
+    property OnOutputPixel: TOutputPixelProc read FOutputPixel write FOutputPixel;
+    property DrawMode: TDrawMode read FDrawMode write FDrawMode;
   end;
 …
   protected
     procedure DoExecute; override;
+  end;
+  { TDitheringToIndexedImage }
+  TDitheringToIndexedImage = class
+  protected
+    FBitOrder: TRawImageBitOrder;
+    FByteOrder: TRawImageByteOrder;
+    FBitsPerPixel: integer;
+    FLineOrder: TRawImageLineOrder;
+    FPalette: TBGRACustomApproxPalette;
+    FIgnoreAlpha: boolean;
+    FTransparentColorIndex: NativeInt;
+    //following variables are used during dithering
+    FCurrentScanlineSize: PtrInt;
+    FCurrentData: PByte;
+    FCurrentOutputY: NativeInt;
+    FCurrentOutputScanline: PByte;
+    FCurrentBitOrderMask: NativeInt;
+    FCurrentMaxY: NativeInt;
+    procedure SetPalette(AValue: TBGRACustomApproxPalette);
+    procedure SetIgnoreAlpha(AValue: boolean);
+    procedure SetLineOrder(AValue: TRawImageLineOrder);
+    procedure SetBitOrder(AValue: TRawImageBitOrder); virtual;
+    procedure SetBitsPerPixel(AValue: integer); virtual;
+    procedure SetByteOrder(AValue: TRawImageByteOrder); virtual;
+    procedure OutputPixelSubByte(X,Y: NativeInt; AColorIndex: NativeInt; {%H-}AColor: TBGRAPixel); virtual;
+    procedure OutputPixelFullByte(X,Y: NativeInt; AColorIndex: NativeInt; {%H-}AColor: TBGRAPixel); virtual;
+    function GetScanline(Y: NativeInt): Pointer; virtual;
+    function GetTransparentColorIndex: integer;
+    procedure SetTransparentColorIndex(AValue: integer);
+  public
+    constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); //use platform byte order
+    constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; AByteOrder: TRawImageByteOrder); //maybe necessary if larger than 8 bits per pixel
+    function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap): Pointer; overload; //use minimum scanline size
+    function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; overload;
+    procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer); overload; //use minimum scanline size
+    procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); overload;
+    function ComputeMinimumScanlineSize(AWidthInPixels: integer): PtrInt;
+    function AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): pointer;
+    //optional customization of format
+    property BitsPerPixel: integer read FBitsPerPixel write SetBitsPerPixel;
+    property BitOrder: TRawImageBitOrder read FBitOrder write SetBitOrder;
+    property ByteOrder: TRawImageByteOrder read FByteOrder write SetByteOrder;
+    property LineOrder: TRawImageLineOrder read FLineOrder write SetLineOrder;
+    property Palette: TBGRACustomApproxPalette read FPalette write SetPalette;
+    property IgnoreAlpha: boolean read FIgnoreAlpha write SetIgnoreAlpha;
+    //when there is no transparent color in the palette, or that IgnoreAlpha is set to True,
+    //this allows to define the index for the fully transparent color
+    property DefaultTransparentColorIndex: integer read GetTransparentColorIndex write SetTransparentColorIndex;
   end;
 …
 function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
   AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect): TDitheringTask; overload;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+    AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
+function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
 implementation
+uses BGRABlend;
 function AbsRGBADiff(const c1, c2: TExpandedPixel): NativeInt;
 …
 end;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
+  ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect
+  ): TDitheringTask;
+begin
+  result := CreateDitheringTask(AAlgorithm, ASource, ADestination, nil, true, ABounds);
+end;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
+  ASource: IBGRAScanner; ADestination: TBGRACustomBitmap;
+  APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABounds: TRect
+  ): TDitheringTask;
+begin
+  result := nil;
+  case AAlgorithm of
+    daNearestNeighbor: result := TNearestColorTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
+    daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
+    else raise exception.Create('Unknown algorithm');
+  end;
+end;
+function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm;
+  ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  palette16bit: TBGRA16BitPalette;
+  dither: TDitheringTask;
+begin
+  palette16bit := TBGRA16BitPalette.Create;
+  dither := CreateDitheringTask(AAlgorithm, ABitmap, palette16bit, false);
+  result := dither.Execute;
+  dither.Free;
+  palette16bit.Free;
+end;
+{ TDitheringToIndexedImage }
+procedure TDitheringToIndexedImage.SetBitsPerPixel(AValue: integer);
+begin
+  if not (AValue in [1,2,4,8,16,32]) then
+    raise exception.Create('Invalid value for bits per pixel. Allowed values: 1,2,4,8,16,32.');
+  if FBitsPerPixel=AValue then Exit;
+  FBitsPerPixel:=AValue;
+end;
+procedure TDitheringToIndexedImage.SetByteOrder(AValue: TRawImageByteOrder);
+begin
+  if FByteOrder=AValue then Exit;
+  FByteOrder:=AValue;
+end;
+procedure TDitheringToIndexedImage.OutputPixelSubByte(X, Y: NativeInt;
+  AColorIndex: NativeInt; AColor: TBGRAPixel);
+var p: PByte;
+begin
+  if y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := y;
+    FCurrentOutputScanline := GetScanline(Y);
+  end;
+  if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
+  case FBitsPerPixel of
+: begin
+         p := FCurrentOutputScanline+(x shr 3);
+         p^ := p^ or ((AColorIndex and 1) shl ((x xor FCurrentBitOrderMask) and 7));
+       end;
+: begin
+         p := FCurrentOutputScanline+(x shr 2);
+         p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 3) shl 1));
+       end;
+: begin
+         p := FCurrentOutputScanline+(x shr 1);
+         p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 1) shl 2));
+       end;
+  end;
+end;
+procedure TDitheringToIndexedImage.OutputPixelFullByte(X, Y: NativeInt;
+  AColorIndex: NativeInt; AColor: TBGRAPixel);
+begin
+  if y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := y;
+    FCurrentOutputScanline := GetScanline(Y);
+  end;
+  if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
+  case FBitsPerPixel of
+: (FCurrentOutputScanline+x)^ := AColorIndex;
+: (PWord(FCurrentOutputScanline)+x)^ := AColorIndex;
+: (PDWord(FCurrentOutputScanline)+x)^ := AColorIndex;
+  end;
+end;
+function TDitheringToIndexedImage.GetScanline(Y: NativeInt): Pointer;
+begin
+  if FLineOrder = riloTopToBottom then
+    result := FCurrentData + Y*FCurrentScanlineSize
+  else
+    result := FCurrentData + (FCurrentMaxY-Y)*FCurrentScanlineSize
+end;
+procedure TDitheringToIndexedImage.SetIgnoreAlpha(AValue: boolean);
+begin
+  if FIgnoreAlpha=AValue then Exit;
+  FIgnoreAlpha:=AValue;
+end;
+procedure TDitheringToIndexedImage.SetTransparentColorIndex(AValue: integer);
+begin
+  if FTransparentColorIndex=AValue then Exit;
+  FTransparentColorIndex:=AValue;
+end;
+function TDitheringToIndexedImage.GetTransparentColorIndex: integer;
+begin
+  result := FTransparentColorIndex;
+end;
+procedure TDitheringToIndexedImage.SetPalette(AValue: TBGRACustomApproxPalette);
+begin
+  if FPalette=AValue then Exit;
+  FPalette:=AValue;
+end;
+procedure TDitheringToIndexedImage.SetLineOrder(AValue: TRawImageLineOrder);
+begin
+  if FLineOrder=AValue then Exit;
+  FLineOrder:=AValue;
+end;
+procedure TDitheringToIndexedImage.SetBitOrder(AValue: TRawImageBitOrder);
+begin
+  if FBitOrder=AValue then Exit;
+  FBitOrder:=AValue;
+end;
+constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer);
+begin
+  BitsPerPixel:= ABitsPerPixelForIndices;
+  BitOrder := riboReversedBits; //convention in BMP format
+  {$IFDEF ENDIAN_LITTLE}
+  ByteOrder:= riboLSBFirst;
+  {$ELSE}
+  ByteOrder:= riboMSBFirst;
+  {$ENDIF}
+  Palette := APalette;
+  IgnoreAlpha:= AIgnoreAlpha;
+end;
+constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer;
+  AByteOrder: TRawImageByteOrder);
+begin
+  BitsPerPixel:= ABitsPerPixelForIndices;
+  BitOrder := riboReversedBits; //convention in BMP format
+  ByteOrder:= AByteOrder;
+  Palette := APalette;
+  IgnoreAlpha:= AIgnoreAlpha;
+end;
+function TDitheringToIndexedImage.ComputeMinimumScanlineSize(
+  AWidthInPixels: integer): PtrInt;
+begin
+  result := (AWidthInPixels*FBitsPerPixel+7) shr 3;
+end;
+function TDitheringToIndexedImage.AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap;
+  AScanlineSize: PtrInt): pointer;
+var size: integer;
+begin
+  size := AScanlineSize * AImage.Height;
+  GetMem(result, size);
+  Fillchar(result^, size, 0);
+end;
+function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap): Pointer;
+begin
+  result := DitherImage(AAlgorithm, AImage, ComputeMinimumScanlineSize(AImage.Width));
+end;
+procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AData: Pointer);
+begin
+  DitherImageTo(AAlgorithm, AImage, AData, ComputeMinimumScanlineSize(AImage.Width));
+end;
+function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer;
+begin
+  result := AllocateSpaceForIndexedData(AImage, AScanlineSize);
+  DitherImageTo(AAlgorithm, AImage, result, AScanlineSize);
+end;
+procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt);
+var ditherTask: TDitheringTask;
+begin
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline := nil;
+  FCurrentData := AData;
+  FCurrentMaxY:= AImage.Height-1;
+  FCurrentScanlineSize:= AScanlineSize;
+  ditherTask := CreateDitheringTask(AAlgorithm, AImage, FPalette, FIgnoreAlpha);
+  try
+    ditherTask.Inplace := True; //do not allocate destination
+    if BitsPerPixel >= 8 then
+      ditherTask.OnOutputPixel := @OutputPixelFullByte
+    else
+    begin
+      ditherTask.OnOutputPixel:= @OutputPixelSubByte;
+      if BitOrder = riboBitsInOrder then
+        FCurrentBitOrderMask := 0
+      else
+        FCurrentBitOrderMask := $ff;
+    end;
+    ditherTask.Execute;
+  finally
+    ditherTask.Free;
+  end;
+end;
 { TDitheringTask }
+procedure TDitheringTask.OutputPixel(X, Y: NativeInt; AColorIndex: NativeInt;
+  AColor: TBGRAPixel);
+begin
+  if Y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := Y;
+    FCurrentOutputScanline := Destination.ScanLine[y];
+  end;
+  PutPixels(FCurrentOutputScanline+x, @AColor, 1, FDrawMode, 255);
+end;
+procedure TDitheringTask.ApproximateColor(const AColor: TBGRAPixel;
+  out AApproxColor: TBGRAPixel; out AIndex: integer);
+begin
+  if FPalette <> nil then
+  begin
+    AIndex := FPalette.FindNearestColorIndex(AColor, FIgnoreAlpha);
+    if AIndex = -1 then
+      AApproxColor := BGRAPixelTransparent
+    else
+      AApproxColor := FPalette.Color[AIndex];
+  end else
+  begin
+    if AColor.alpha = 0 then
+    begin
+      AApproxColor := BGRAPixelTransparent;
+      AIndex := -1;
+    end else
+    begin
+      AApproxColor := AColor;
+      AIndex := 0;
+    end;
+  end;
+end;
+constructor TDitheringTask.Create(ASource: IBGRAScanner;
+  APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap;
+  AIgnoreAlpha: boolean; ABounds: TRect);
+begin
+  FPalette := APalette;
+  SetSource(ASource);
+  FBounds := ABounds;
+  FIgnoreAlpha:= AIgnoreAlpha;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  OnOutputPixel:= @OutputPixel;
+  Destination := ADestination;
+  FDrawMode:= dmSet;
+end;
 constructor TDitheringTask.Create(bmp: TBGRACustomBitmap;
 …
 begin
   FPalette := APalette;
   FSource := bmp;
+  SetSource(bmp);
   FBounds := ABounds;
   FIgnoreAlpha:= AIgnoreAlpha;
+  if AInPlace then Destination := FSource;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  OnOutputPixel:= @OutputPixel;
+  InPlace := AInPlace;
+  FDrawMode:= dmSet;
 end;
 …
 begin
   FPalette := APalette;
   FSource := bmp;
+  SetSource(bmp);
   FBounds := rect(0,0,bmp.Width,bmp.Height);
   FIgnoreAlpha:= AIgnoreAlpha;
+  if AInPlace then Destination := FSource;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  OnOutputPixel:= @OutputPixel;
+  InPlace := AInPlace;
+  FDrawMode:= dmSet;
 end;
 …
 var
+  p,pNext,pDest: PBGRAPixel;
+  p,pNext: PExpandedPixel;
+  destX,destY: NativeInt;
   orig,cur,approxExp: TExpandedPixel;
   approx: TBGRAPixel;
+  approxIndex: integer;
   curPix,diff: TAccPixel;
   i: NativeInt;
   yWrite: NativeInt;
   tempLine, currentLine, nextLine: TLine;
+  nextScan,curScan: PExpandedPixel;
   function ClampWordDiv(AValue: NativeInt): Word; inline;
 …
   setlength(currentLine,w);
   setlength(nextLine,w);
+  curScan := nil;
+  nextScan := RequestSourceExpandedScanLine(FBounds.Left, FBounds.Top, FBounds.Right-FBounds.Left);
   for yWrite := 0 to h-1 do
   begin
     if GetShouldStop(yWrite) then break;
+    p := FSource.ScanLine[yWrite+FBounds.Top]+FBounds.Left;
+    pDest := FDestination.ScanLine[yWrite+FBounds.Top]+FBounds.Left;
+    ReleaseSourceExpandedScanLine(curScan);
+    curScan := nextScan;
+    nextScan := nil;
+    p := curScan;
+    destX := FBounds.Left;
+    destY := yWrite+FBounds.Top;
     if yWrite < h-1 then
+      pNext := FSource.ScanLine[yWrite+FBounds.Top+1]+FBounds.Left
+    else
+      pNext := nil;
+      nextScan := RequestSourceExpandedScanLine(FBounds.Left,yWrite+FBounds.Top+1, FBounds.Right-FBounds.Left);
+    pNext := nextScan;
     if odd(yWrite) then
     begin
       inc(p, w);
       inc(pDest, w);
+      inc(destX, w);
       if pNext<>nil then inc(pNext, w);
       for i := w-1 downto 0 do
       begin
         dec(p);
         dec(pDest);
+        dec(destX);
         if pNext<>nil then dec(pNext);
         if p^.alpha <> 0 then
         begin
           orig := GammaExpansion(p^);
+          orig := p^;
           with currentLine[i] do
           begin
 …
             cur.blue := ClampWordDiv(curPix.blue);
           end;
           approx := FPalette.FindNearestColor(GammaCompression(cur), FIgnoreAlpha);
+          ApproximateColor(GammaCompression(cur), approx, approxIndex);
           approxExp := GammaExpansion(approx);
           diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
 …
           if i > 0 then
           begin
             if AbsRGBADiff(GammaExpansion((p-1)^),orig) < MaxColorDiffForDiffusion then
+            if AbsRGBADiff((p-1)^,orig) < MaxColorDiffForDiffusion then
               AddError(currentLine[i-1], diff, 7);
           end;
 …
             if i > 0 then
             begin
               if AbsRGBADiff(GammaExpansion((pNext-1)^),orig) < MaxColorDiffForDiffusion then
+              if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
                 AddError(nextLine[i-1], diff, 1);
             end;
             if AbsRGBADiff(GammaExpansion(pNext^),orig) < MaxColorDiffForDiffusion then
+            if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
               AddError(nextLine[i], diff, 5);
             if i < w-1 then
             begin
               if AbsRGBADiff(GammaExpansion((pNext+1)^),orig) < MaxColorDiffForDiffusion then
+              if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
                 AddError(nextLine[i+1], diff, 3);
             end;
           end;
           pDest^ := approx;
+          OnOutputPixel(destX,destY,approxIndex,approx);
         end;
       end
 …
       if p^.alpha <> 0 then
       begin
         orig := GammaExpansion(p^);
+        orig := p^;
         with currentLine[i] do
         begin
 …
           cur.blue := ClampWordDiv(curPix.blue);
         end;
         approx := FPalette.FindNearestColor(GammaCompression(cur), FIgnoreAlpha);
+        ApproximateColor(GammaCompression(cur), approx, approxIndex);
         approxExp := GammaExpansion(approx);
         diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
 …
         if i < w-1 then
         begin
           if AbsRGBADiff(GammaExpansion((p+1)^),orig) < MaxColorDiffForDiffusion then
+          if AbsRGBADiff((p+1)^,orig) < MaxColorDiffForDiffusion then
             AddError(currentLine[i+1], diff, 7);
         end;
         if nextLine <> nil then
+        if pNext <> nil then
         begin
           if i > 0 then
           begin
             if AbsRGBADiff(GammaExpansion((pNext-1)^),orig) < MaxColorDiffForDiffusion then
+            if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
               AddError(nextLine[i-1], diff, 3);
           end;
           if AbsRGBADiff(GammaExpansion(pNext^),orig) < MaxColorDiffForDiffusion then
+          if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
             AddError(nextLine[i], diff, 5);
           if i < w-1 then
           begin
             if AbsRGBADiff(GammaExpansion((pNext+1)^),orig) < MaxColorDiffForDiffusion then
+            if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
               AddError(nextLine[i+1], diff, 1);
           end;
         end;
         pDest^ := approx;
+        OnOutputPixel(destX,destY,approxIndex,approx);
       end;
       inc(p);
       inc(pDest);
+      inc(destX);
       if pNext<>nil then inc(pNext);
     end;
 …
       end;
   end;
+  FDestination.InvalidateBitmap;
+  ReleaseSourceExpandedScanLine(curScan);
+  ReleaseSourceExpandedScanLine(nextScan);
+  Destination.InvalidateBitmap;
 end;
 …
 procedure TNearestColorTask.DoExecute;
+var yb,xb: integer;
+  psrc,pdest: PBGRAPixel;
+var yb,xb: NativeInt;
+  curScan,psrc: PBGRAPixel;
+  colorIndex: LongInt;
+  colorValue: TBGRAPixel;
 begin
   for yb := FBounds.Top to FBounds.Bottom - 1 do
   begin
     if GetShouldStop(yb) then break;
     psrc := FSource.ScanLine[yb] + FBounds.Left;
     pdest := FDestination.ScanLine[yb] + FBounds.Left;
     for xb := FBounds.Right - FBounds.Left -1 downto 0 do
+    curScan := RequestSourceScanLine(FBounds.Left,yb,FBounds.Right-FBounds.Left);
+    psrc := curScan;
+    for xb := FBounds.Left to FBounds.Right-1 do
     begin
       pdest^ := FPalette.FindNearestColor(psrc^, FIgnoreAlpha);
       inc(pdest);
+      ApproximateColor(psrc^, colorValue, colorIndex);
+      OnOutputPixel(xb,yb,colorIndex,colorValue);
       inc(psrc);
     end;
+  end;
+  FDestination.InvalidateBitmap;
+    ReleaseSourceScanLine(curScan);
+  end;
+  Destination.InvalidateBitmap;
 end;

GraphicTest/Packages/bgrabitmap/bgradnetdeserial.pas

r472	r494
184	184	implementation
185	185
186		uses ~~lazutf8classes~~;
	186	uses BGRAUTF8;
187	187
188	188	const

GraphicTest/Packages/bgrabitmap/bgrafillinfo.pas

-              r472
+              r494
       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; override;
       //check if the point is inside the filling zone
       function IsPointInside(x,y: single; windingMode: boolean): boolean; override;
 …
       procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); override;
+      //can be called after ComputeAndSort or ComputeIntersection to determine the current horizontal slice
+      //so that it can be checked if the intermediates scanlines can be skipped
+      function GetSliceIndex: integer; override;
   end;
 …
   private
     FX, FY, FRX, FRY: single;
+    FSliceIndex: integer;
     function GetCenter: TPointF;
   protected
 …
     function GetBounds: TRect; override;
     function SegmentsCurved: boolean; override;
+    function GetSliceIndex: integer; override;
     property Center: TPointF read GetCenter;
     property RadiusX: single read FRX;
 …
     function SegmentsCurved: boolean; override;
     destructor Destroy; override;
+    function GetSliceIndex: integer; override;
     property InnerBorder: TFillEllipseInfo read FInnerBorder;
     property OuterBorder: TFillEllipseInfo read FOuterBorder;
 …
     constructor Create(const points: array of TPointF);
     destructor Destroy; override;
+    function GetSliceIndex: integer; override;
   end;
 …
     FFirstWaiting, FFirstDrawing: POnePassRecord;
     FShouldInitializeDrawing: boolean;
+    FSliceIndex: integer;
     procedure ComputeIntersection(cury: single;
       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
 …
     constructor Create(const points: array of TPointF);
     function CreateIntersectionArray: ArrayOfTIntersectionInfo; override;
+    function GetSliceIndex: integer; override;
     destructor Destroy; override;
   end;
 …
 function IsPointInRectangle(x1, y1, x2, y2: single; point: TPointF): boolean;
+function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer;
+  bmpDest: TBGRACustomBitmap): boolean;
 implementation
 uses Math;
+function BGRAShapeComputeMinMax(AShape: TBGRACustomFillInfo; out minx, miny, maxx, maxy: integer;
+  bmpDest: TBGRACustomBitmap): boolean;
+var clip,bounds: TRect;
+begin
+  result := true;
+  bounds := AShape.GetBounds;
+  if (bounds.Right <= bounds.left) or (bounds.bottom <= bounds.top) then
+  begin
+    result := false;
+    exit;
+  end;
+  miny := bounds.top;
+  maxy := bounds.bottom - 1;
+  minx := bounds.left;
+  maxx := bounds.right - 1;
+  clip := bmpDest.ClipRect;
+  if minx < clip.Left then
+    minx := clip.Left;
+  if maxx < clip.Left then
+    result := false;
+  if maxx > clip.Right - 1 then
+    maxx := clip.Right- 1;
+  if minx > clip.Right - 1 then
+    result := false;
+  if miny < clip.Top then
+    miny := clip.Top;
+  if maxy < clip.Top then
+    result := false;
+  if maxy > clip.Bottom - 1 then
+    maxy := clip.Bottom - 1;
+  if miny > clip.Bottom - 1 then
+    result := false;
+end;
 procedure ComputeAliasedRowBounds(x1,x2: single; minx,maxx: integer; out ix1,ix2: integer);
 …
 end;
-function TFillShapeInfo.ComputeMinMax(out minx, miny, maxx, maxy: integer;
-  bmpDest: TBGRACustomBitmap): boolean;
-var clip,bounds: TRect;
-begin
-  result := true;
-  bounds := GetBounds;
-  if (bounds.Right <= bounds.left) or (bounds.bottom <= bounds.top) then
-  begin
-    result := false;
-    exit;
-  end;
-  miny := bounds.top;
-  maxy := bounds.bottom - 1;
-  minx := bounds.left;
-  maxx := bounds.right - 1;
-  clip := bmpDest.ClipRect;
-  if minx < clip.Left then
-    minx := clip.Left;
-  if maxx < clip.Left then
-    result := false;
-  if maxx > clip.Right - 1 then
-    maxx := clip.Right- 1;
-  if minx > clip.Right - 1 then
-    result := false;
-  if miny < clip.Top then
-    miny := clip.Top;
-  if maxy < clip.Top then
-    result := false;
-  if maxy > clip.Bottom - 1 then
-    maxy := clip.Bottom - 1;
-  if miny > clip.Bottom - 1 then
-    result := false;
-end;
 function TFillShapeInfo.IsPointInside(x, y: single; windingMode: boolean
 …
   SortIntersection(inter,nbInter);
   if windingMode then ConvertFromNonZeroWinding(inter,nbInter);
+end;
+function TFillShapeInfo.GetSliceIndex: integer;
+begin
+  result := 0;
 end;
 …
 end;
+function TFillPolyInfo.GetSliceIndex: integer;
+begin
+  Result:= FCurSlice;
+end;
 { TOnePassFillPolyInfo }
 …
         p^.nextDrawing := FFirstDrawing;
         FFirstDrawing := p;
+        inc(FSliceIndex);
       end;
     end
 …
         FFirstDrawing:= pnext;
       p := pnext;
+      Inc(FSliceIndex);
       continue;
     end;
 …
   SortByY;
+  FSliceIndex := 0;
 end;
 …
   setlength(result, NbMaxIntersection);
+  for i := 0 to high(result) do
+    result[i] := nil;
+end;
+function TOnePassFillPolyInfo.GetSliceIndex: integer;
+begin
+  Result:= FSliceIndex;
 end;
 …
   FRY := abs(ry);
   WindingFactor := 1;
+  FSliceIndex:= -1;
 end;
 …
 begin
   Result:= true;
+end;
+function TFillEllipseInfo.GetSliceIndex: integer;
+begin
+  Result:= FSliceIndex;
 end;
 …
     inter[nbinter].SetValues( FX + d, windingFactor, 1);
     Inc(nbinter);
+    FSliceIndex := 0;
+  end else
+  begin
+    if cury < FY then
+      FSliceIndex:= -1
+    else
+      FSliceIndex:= 1;
   end;
 end;
 …
     FInnerBorder.Free;
   inherited Destroy;
+end;
+function TFillBorderEllipseInfo.GetSliceIndex: integer;
+begin
+  Result:= FOuterBorder.GetSliceIndex;
 end;

GraphicTest/Packages/bgrabitmap/bgrafilters.pas

-              r472
+              r494
 uses
   Classes, BGRABitmapTypes;
+  Classes, BGRABitmapTypes, BGRAFilterType, BGRAFilterBlur;
 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
+  a square of 9x9 pixel is considered. The median allow to select the most
+  representative colors. The option parameter allow to choose to smooth the
+  result or not. }
+function FilterMedian(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+{ SmartZoom x3 is a filter that upsizes 3 times the picture and add
+  pixels that could be logically expected (horizontal, vertical, diagonal lines) }
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+{ Sharpen filter add more contrast between pixels }
+function FilterSharpen(bmp: TBGRACustomBitmap; 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
+  is merged with pixels within the specified radius. There is an exception
+  with rbFast blur, the optimization entails an hyperbolic shape. }
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer;
+  blurType: TRadialBlurType): TBGRACustomBitmap;
+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 CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TFilterTask;
+{ Motion blur merge pixels in a direction. The oriented parameter specifies
+  if the weights of the pixels are the same along the line or not. }
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
+  angle: single; oriented: boolean): TBGRACustomBitmap;
+function 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 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
+  with standard selection color (white/black and filled with blue) }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
+function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
+{ Normalize use the whole available range of values, making dark colors darkest possible
+  and light colors lightest possible }
+function FilterNormalize(bmp: TBGRACustomBitmap;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+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; 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 }
+function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Distort the image as if it were on a sphere }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Twirl distortion, i.e. a progressive rotation }
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+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 }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Compute a plane projection towards infinity (SLOW) }
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+implementation
+uses Math, GraphType, Dialogs, BGRATransform, Types, SysUtils;
+  TFilterTask = BGRAFilterType.TFilterTask;
+/////////////////////// PIXELWISE FILTERS ////////////////////////////////
 type
   { TGrayscaleTask }
+  { Grayscale converts colored pixel into grayscale with same luminosity }
   TGrayscaleTask = class(TFilterTask)
   private
 …
   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;
+{ 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;
+{ Normalize use the whole available range of values, making dark colors darkest possible
+  and light colors lightest possible }
+function FilterNormalize(bmp: TBGRACustomBitmap;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+////////////////////// 3X3 FILTERS ////////////////////////////////////////////
+{ Sharpen filter add more contrast between pixels }
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap;
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
+{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil }
+function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Emboss filter compute a color difference in the angle direction }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap;
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap;
+{ Emboss highlight computes a sort of emboss with 45 degrees angle and
+  with standard selection color (white/black and filled with blue) }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
+function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
+{ The median filter consist in calculating the median value of pixels. Here
+  a square of 9x9 pixel is considered. The median allow to select the most
+  representative colors. The option parameter allow to choose to smooth the
+  result or not. }
+function FilterMedian(bmp: TBGRACustomBitmap; Option: TMedianOption): TBGRACustomBitmap;
+//////////////////////// DEFORMATION FILTERS /////////////////////////////////
+{ Distort the image as if it were on a sphere }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Twirl distortion, i.e. a progressive rotation }
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+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 }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Compute a plane projection towards infinity (SLOW) }
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+{ Rotate filter rotate the image and clip it in the bounding rectangle }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single; correctBlur: boolean = false): TBGRACustomBitmap;
+///////////////////////// BLUR FILTERS //////////////////////////////////////
+{ A radial blur applies a blur with a circular influence, i.e, each pixel
+  is merged with pixels within the specified radius. There is an exception
+  with rbFast blur, the optimization entails an hyperbolic shape. }
+type TRadialBlurTask = BGRAFilterBlur.TRadialBlurTask;
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+{ The precise blur allow to specify the blur radius with subpixel accuracy }
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; deprecated 'Use FilterBlurRadial with blurType:=rbPrecise and radius multiplied by 10';
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; deprecated 'Use CreateRadialBlurTask with blurType:=rbPrecise and radius multiplied by 10';
+{ Motion blur merge pixels in a direction. The oriented parameter specifies
+  if the weights of the pixels are the same along the line or not. }
+type TMotionBlurTask = BGRAFilterBlur.TMotionBlurTask;
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TMotionBlurTask;
+{ General purpose blur filter, with a blur mask as parameter to describe
+  how pixels influence each other }
+function FilterBlur(bmp: TBGRACustomBitmap; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
+////////////////////////////// OTHER FILTERS /////////////////////////////////
+{ SmartZoom x3 is a filter that upsizes 3 times the picture and add
+  pixels that could be logically expected (horizontal, vertical, diagonal lines) }
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
+implementation
+uses Math, BGRATransform, Types, SysUtils, BGRAFilterScanner;
+/////////////////////// PIXELWISE FILTERS ////////////////////////////////
+{ TGrayscaleTask }
+constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect);
+begin
+  SetSource(bmp);
+  FBounds := ABounds;
+end;
+procedure TGrayscaleTask.DoExecute;
+var
+  yb: LongInt;
+begin
+  if IsRectEmpty(FBounds) then exit;
+  for yb := FBounds.Top to FBounds.bottom - 1 do
+  begin
+    if GetShouldStop(yb) then break;
+    TBGRAFilterScannerGrayscale.ComputeFilterAt(FSource.scanline[yb] + FBounds.left,
+            Destination.scanline[yb] + FBounds.left, FBounds.right-FBounds.left, true);
+  end;
+  Destination.InvalidateBitmap;
+end;
+{ Filter grayscale applies BGRAToGrayscale function to all pixels }
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+begin
+  result := FilterGrayscale(bmp,rect(0,0,bmp.width,bmp.Height));
+end;
+function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
+var scanner: TBGRAFilterScannerGrayscale;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  scanner := TBGRAFilterScannerGrayscale.Create(bmp,Point(0,0),True);
+  result.FillRect(ABounds,scanner,dmSet);
+  scanner.Free;
+end;
+function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
+begin
+  result := TGrayscaleTask.Create(bmp,ABounds);
+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; ABounds: TRect;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+var scanner: TBGRAFilterScannerNormalize;
+  remain: TRect;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  remain := EmptyRect;
+  if not IntersectRect(remain,ABounds,rect(0,0,bmp.Width,bmp.Height)) then exit;
+  scanner := TBGRAFilterScannerNormalize.Create(bmp,Point(0,0),remain,eachChannel);
+  result.FillRect(remain,scanner,dmSet);
+  scanner.Free;
+end;
+////////////////////// 3X3 FILTERS ////////////////////////////////////////////
+{ This filter compute for each pixel the mean of the eight surrounding pixels,
+  then the difference between this average pixel and the pixel at the center
+  of the square. Finally the difference is added to the new pixel, exagerating
+  its difference with its neighbours. }
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
+var scanner: TBGRAFilterScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if IsRectEmpty(ABounds) then exit;
+  scanner := TBGRASharpenScanner.Create(bmp,ABounds,AAmount);
+  result.FillRect(ABounds,scanner,dmSet);
+  scanner.Free;
+end;
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer
+  ): TBGRACustomBitmap;
+begin
+  result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount);
+end;
+{ Filter contour computes for each pixel
+  the grayscale difference with surrounding pixels (in intensity and alpha)
+  and draw black pixels when there is a difference }
+function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+var scanner: TBGRAContourScanner;
+begin
+  result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  scanner := TBGRAContourScanner.Create(bmp,rect(0,0,bmp.width,bmp.height));
+  result.Fill(scanner);
+  scanner.Free;
+end;
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+begin
+  result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height), AStrength, AOptions);
+end;
+{ Emboss filter computes the difference between each pixel and the surrounding pixels
+  in the specified direction. }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+var
+  yb, xb: NativeInt;
+  dx, dy: single;
+  idx, idy: NativeInt;
+  x256,y256: NativeInt;
+  cMiddle: TBGRAPixel;
+  hMiddle: THSLAPixel;
+  tempPixel, refPixel: TBGRAPixel;
+  pdest: PBGRAPixel;
+  bounds: TRect;
+  psrc: PBGRAPixel;
+  redDiff,greenDiff,blueDiff: NativeUInt;
+  diff: NativeInt;
+begin
+  //compute pixel position and weight
+  dx   := cos(angle * Pi / 180);
+  dy   := sin(angle * Pi / 180);
+  idx := floor(dx);
+  idy := floor(dy);
+  x256 := trunc((dx-idx)*256);
+  y256 := trunc((dy-idy)*256);
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if IsRectEmpty(ABounds) then exit;
+  bounds := bmp.GetImageBounds;
+  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);
+  if not (eoTransparent in AOptions) then
+  begin
+    if eoPreserveHue in AOptions then
+      Result.PutImagePart(ABounds.left,ABounds.top,bmp,ABounds,dmSet)
+    else
+      Result.FillRect(ABounds,BGRA(128, 128, 128, 255),dmSet);
+  end;
+  //loop through destination
+  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+idx to bounds.Right-1+idx do
+    begin
+      refPixel := bmp.GetPixel256(xb,yb+idy,x256,y256);
+      cMiddle := psrc^;
+      inc(psrc);
+      if eoPreserveHue in AOptions then
+      begin
+        {$push}{$hints off}
+        diff := ((refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha)+
+                 (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha)+
+                 (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha))* AStrength div 128;
+        {$pop}
+        if diff > 0 then
+          hMiddle := BGRAToHSLA(refPixel)
+        else
+          hMiddle := BGRAToHSLA(cMiddle);
+        hMiddle.lightness := min(65535,max(0,hMiddle.lightness+diff));
+        if eoTransparent in AOptions then
+          hMiddle.alpha := min(65535,abs(diff));
+        pdest^ := HSLAToBGRA(hMiddle);
+      end else
+      begin
+        {$push}{$hints off}
+        redDiff := NativeUInt(max(0, 65536 + (refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha) * AStrength div 64)) shr 9;
+        greenDiff := NativeUInt(max(0, 65536 + (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha) * AStrength div 64)) shr 9;
+        blueDiff := NativeUInt(max(0, 65536 + (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha) * AStrength div 64)) shr 9;
+        {$pop}
+        if (redDiff <> 128) or (greenDiff <> 128) or (blueDiff <> 128) then
+        begin
+          tempPixel.red := min(255, redDiff);
+          tempPixel.green := min(255, greenDiff);
+          tempPixel.blue := min(255, blueDiff);
+          if eoTransparent in AOptions then
+          begin
+            tempPixel.alpha := min(255,abs(NativeInt(redDiff-128))+abs(NativeInt(greenDiff-128))+abs(NativeInt(blueDiff-128)));
+            pdest^ := tempPixel;
+          end else
+          begin
+            tempPixel.alpha := 255;
+            pdest^ := tempPixel;
+          end;
+        end;
+      end;
+      Inc(pdest);
+    end;
+  end;
+  Result.InvalidateBitmap;
+end;
+{ Like general emboss, but with fixed direction and automatic color with transparency }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
+var
+  bounds: TRect;
+  borderColorOverride: boolean;
+  borderColorLevel: Int32or64;
+  scan: TBGRAEmbossHightlightScanner;
+begin
+  borderColorOverride := DefineBorderColor.alpha <> 0;
+  borderColorLevel := DefineBorderColor.red;
+  Result    := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if borderColorOverride then
+    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
+  else
+    bounds := bmp.GetImageBounds(cRed);
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) 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);
+  scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
+  scan.AllowDirectRead := true;
+  scan.FillSelection := FillSelection;
+  if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
+  Result.FillRect(bounds, scan, dmSet);
+  scan.Free;
+end;
+function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
+var
+  bounds: TRect;
+  borderColorOverride: boolean;
+  borderColorLevel: int32or64;
+  scan: TBGRAEmbossHightlightScanner;
+begin
+  borderColorOverride := DefineBorderColor.alpha <> 0;
+  borderColorLevel := DefineBorderColor.red;
+  if borderColorOverride then
+    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
+  else
+    bounds := bmp.GetImageBounds(cRed);
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+  begin
+    Result    := bmp.NewBitmap(0, 0);
+    exit;
+  end;
+  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);
+  Result    := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1);
+  inc(Offset.X, bounds.Left);
+  inc(Offset.Y, bounds.Top);
+  scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
+  scan.AllowDirectRead := true;
+  scan.FillSelection := FillSelection;
+  if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
+  Result.FillRect(rect(0,0,result.Width,result.Height), scan, dmSet, Offset);
+  scan.Free;
+end;
+{ For each component, sort values to get the median }
+function FilterMedian(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+  function ComparePixLt(p1, p2: TBGRAPixel): boolean;
+  begin
+    if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then
+      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);
+  end;
+const
+  nbpix = 9;
+var
+  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: uint32or64;
+  tempAlpha: word;
+  bounds:    TRect;
+  pdest:     PBGRAPixel;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  bounds := bmp.GetImageBounds;
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) 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);
+  for yb := bounds.Top to bounds.bottom - 1 do
+  begin
+    pdest := Result.scanline[yb] + bounds.left;
+    for xb := bounds.left to bounds.right - 1 do
+    begin
+      n := 0;
+      for dy := -1 to 1 do
+        for dx := -1 to 1 do
+        begin
+          a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
+          if a_pixels[n].alpha = 0 then
+            a_pixels[n] := BGRAPixelTransparent;
+          Inc(n);
+        end;
+      for i := 1 to n - 1 do
+      begin
+        j := i;
+        while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do
+        begin
+          tempValue := a_pixels[j].alpha;
+          a_pixels[j].alpha := a_pixels[j - 1].alpha;
+          a_pixels[j - 1].alpha := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do
+        begin
+          tempValue := a_pixels[j].red;
+          a_pixels[j].red := a_pixels[j - 1].red;
+          a_pixels[j - 1].red := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do
+        begin
+          tempValue := a_pixels[j].green;
+          a_pixels[j].green := a_pixels[j - 1].green;
+          a_pixels[j - 1].green := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do
+        begin
+          tempValue := a_pixels[j].blue;
+          a_pixels[j].blue := a_pixels[j - 1].blue;
+          a_pixels[j - 1].blue := tempValue;
+          Dec(j);
+        end;
+      end;
+      refPixel := a_pixels[n div 2];
+      if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then
+      begin
+        sumR    := 0;
+        sumG    := 0;
+        sumB    := 0;
+        sumA    := 0;
+        BGRAdiv := 0;
+        nbA     := 0;
+        case option of
+          moHighSmooth, moMediumSmooth:
+          begin
+            j := 2;
+            k := 2;
+          end;
+          else
+          begin
+            j := 1;
+            k := 1;
+          end;
+        end;
+         {$hints off}
+        for i := -k to j do
+        begin
+          tempPixel := a_pixels[n div 2 + i];
+          tempAlpha := tempPixel.alpha;
+          if (option = moMediumSmooth) and ((i = -k) or (i = j)) then
+            tempAlpha := tempAlpha div 2;
+          sumR    += tempPixel.red * tempAlpha;
+          sumG    += tempPixel.green * tempAlpha;
+          sumB    += tempPixel.blue * tempAlpha;
+          BGRAdiv += tempAlpha;
+          sumA += tempAlpha;
+          Inc(nbA);
+        end;
+         {$hints on}
+        if option = moMediumSmooth then
+          Dec(nbA);
+        if (BGRAdiv = 0) then
+          refPixel := BGRAPixelTransparent
+        else
+        begin
+          refPixel.red   := round(sumR / BGRAdiv);
+          refPixel.green := round(sumG / BGRAdiv);
+          refPixel.blue  := round(sumB / BGRAdiv);
+          refPixel.alpha := round(sumA / nbA);
+        end;
+      end;
+      pdest^ := refPixel;
+      Inc(pdest);
+    end;
+  end;
+end;
+//////////////////////// DEFORMATION FILTERS /////////////////////////////////
+{ Compute the distance for each pixel to the center of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the center in the source bitmap }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  cx, cy: single;
+  scanner: TBGRASphereDeformationScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  cx     := bmp.Width / 2 - 0.5;
+  cy     := bmp.Height / 2 - 0.5;
+  scanner := TBGRASphereDeformationScanner.Create(bmp,PointF(cx,cy),bmp.Width/2,bmp.Height/2);
+  result.FillEllipseAntialias(cx,cy,bmp.Width/2-0.5,bmp.Height/2-0.5,scanner);
+  scanner.Free;
+end;
+{ Applies twirl scanner. See TBGRATwirlScanner }
+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.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;
+{ Compute the distance for each pixel to the vertical axis of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the vertical axis in the source bitmap }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  cx: single;
+  scanner: TBGRAVerticalCylinderDeformationScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  cx     := bmp.Width / 2 - 0.5;
+  scanner := TBGRAVerticalCylinderDeformationScanner.Create(bmp,cx,bmp.Width/2);
+  result.Fill(scanner);
+  scanner.Free;
+end;
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+const resampleGap=0.6;
+var
+  cy, x1, x2, y1, y2, z1, z2, h: single;
+  yb: int32or64;
+  resampledBmp: TBGRACustomBitmap;
+  resampledBmpWidth: int32or64;
+  resampledFactor,newResampleFactor: single;
+  sub,resampledSub: TBGRACustomBitmap;
+  partRect: TRect;
+  resampleSizeY : int32or64;
+begin
+  resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch);
+  resampledBmpWidth := resampledBmp.Width;
+  resampledFactor := 2;
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height*2);
+  cy     := result.Height / 2 - 0.5;
+  h      := 1;
+  for yb := 0 to ((Result.Height-1) div 2) do
+  begin
+    y1 := (cy - (yb-0.5)) / (cy+0.5);
+    y2 := (cy - (yb+0.5)) / (cy+0.5);
+    if y2 <= 0 then continue;
+    z1 := h/y1;
+    z2 := h/y2;
+    newResampleFactor := 1/(z2-z1)*1.5;
+    x1 := (z1+1)/2;
+    x2 := (z2+1)/2;
+    if newResampleFactor <= resampledFactor*resampleGap then
+    begin
+      resampledFactor := newResampleFactor;
+      if resampledBmp <> bmp then resampledBmp.Free;
+      if (x2-x1 >= 1) then resampleSizeY := 1 else
+        resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1));
+      resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch);
+      resampledBmpWidth := resampledBmp.Width;
+    end;
+    partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height),
+       round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1);
+    if x2-x1 > 1 then
+    begin
+      partRect.Top := 0;
+      partRect.Bottom := 1;
+    end;
+    sub := resampledBmp.GetPart(partRect);
+    if sub <> nil then
+    begin
+      resampledSub := sub.Resample(bmp.Width,1,rmFineResample);
+      result.PutImage(0,yb,resampledSub,dmSet);
+      result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet);
+      resampledSub.free;
+      sub.free;
+    end;
+  end;
+  if resampledBmp <> bmp then resampledBmp.Free;
+  if result.Height <> bmp.Height then
+  begin
+    resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch);
+    result.free;
+    result := resampledBmp;
+  end;
+end;
+{ Rotates the image. To do this, loop through the destination and
+  calculates the position in the source bitmap with an affine transformation }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single; correctBlur: boolean): TBGRACustomBitmap;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  Result.PutImageAngle(0,0,bmp,angle,origin.x,origin.y,255,true,correctBlur);
+end;
+///////////////////////// BLUR FILTERS //////////////////////////////////////
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius,blurTYpe);
+  result := task.Execute;
+  task.Free;
+end;
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,blurTYpe);
+  result := task.Execute;
+  task.Free;
+end;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType);
+end;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType);
+end;
+{ Precise blur }
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap;
+var task: TRadialBlurTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius*10,rbPrecise);
+  result := task.Execute;
+  task.Free;
+end;
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadius*10,rbPrecise);
+end;
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateMotionBlurTask(bmp, rect(0,0,bmp.Width,bmp.Height), distance, angle, oriented);
+  result := task.Execute;
+  task.Free;
+end;
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ADistance, AAngle: single; AOriented: boolean): TMotionBlurTask;
+begin
+  result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented);
+end;
+function FilterBlur(bmp: TBGRACustomBitmap; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := TCustomBlurTask.Create(bmp,rect(0,0,bmp.Width,bmp.Height), AMask, AMaskIsThreadSafe);
+  result := task.Execute;
+  task.Free;
+end;
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
+begin
+  result := TCustomBlurTask.Create(ABmp, ABounds, AMask, AMaskIsThreadSafe);
+end;
+///////////////////////////////////// OTHER FILTERS ///////////////////////////
 function FilterSmartZoom3(bmp: TBGRACustomBitmap;
 …
 end;
-{ This filter compute for each pixel the mean of the eight surrounding pixels,
-  then the difference between this average pixel and the pixel at the center
-  of the square. Finally the difference is added to the new pixel, exagerating
-  its difference with its neighbours. }
-function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
-var
-  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;
-  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 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
-  for yb := bounds.Top to bounds.Bottom - 1 do
-  begin
-    pdest := Result.scanline[yb] + bounds.Left;
-    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
-      for dy := -1 to 1 do
-        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
-      sumR   := 0;
-      sumG   := 0;
-      sumB   := 0;
-      sumA   := 0;
-      //RGBdiv := 0;
-      nbA    := 0;
-       {$hints off}
-      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}sumA = 0) then
-        refPixel := BGRAPixelTransparent
-      else
-      begin
-        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
-      ptempPixel := a_pixels[0,0];
-      if refPixel <> BGRAPixelTransparent then
-      begin
-        //compute sharpened pixel by adding the difference
-        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 }
-procedure FilterBlurRadialPrecise(bmp: TBGRACustomBitmap;
-  ABounds: TRect; radius: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-var
-  blurShape: TBGRACustomBitmap;
-  intRadius: integer;
-begin
-  if radius = 0 then
-  begin
-    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
-    exit;
-  end;
-  intRadius := ceil(radius);
-  blurShape := bmp.NewBitmap(2 * intRadius + 1, 2 * intRadius + 1);
-  blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite,
-    BGRABlack, gtRadial, pointF(intRadius, intRadius), pointF(
-    intRadius - radius - 1, intRadius), dmSet);
-  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;
-{ This is a clever solution for fast computing of the blur
-  effect : it stores an array of vertical sums forming a square
-  around the pixel which moves with it. For each new pixel,
-  the vertical sums are kept except for the last column of
-  the square }
-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: 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;
-  {$I blurfast.inc}
-{ Normal radial blur compute a blur mask with a GradientFill and
-  then posterize to optimize general purpose blur }
-procedure FilterBlurRadialNormal(bmp: TBGRACustomBitmap;
-  ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-var
-  blurShape: TBGRACustomBitmap;
-  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,
-    BGRABlack, gtRadial, pointF(radius, radius), pointF(-0.5, radius), dmSet);
-  p := blurShape.Data;
-  for n := 0 to blurShape.NbPixels-1 do
-  begin
-    p^.red := p^.red and $F0;
-    p^.green := p^.red;
-    p^.blue := p^.red;
-    inc(p);
-  end;
-  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
-  blurShape.Free;
-end;
-{ Blur disk creates a disk mask with a FillEllipse }
-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);
-  FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
-  blurShape.Free;
-end;
-{ Corona blur use a circle as mask }
-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);
-  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;
-function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer;
-  blurType: TRadialBlurType): TBGRACustomBitmap;
-begin
-  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 }
-procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single;
-  angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-var
-  blurShape: TBGRACustomBitmap;
-  intRadius: integer;
-  dx, dy, d: single;
-begin
-  if distance < 1e-6 then
-  begin
-    ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
-    exit;
-  end;
-  intRadius := ceil(distance / 2);
-  blurShape := bmp.NewBitmap(2 * intRadius + 1, 2 * intRadius + 1);
-  d  := distance / 2;
-  dx := cos(angle * Pi / 180);
-  dy := sin(angle * Pi / 180);
-  blurShape.Fill(BGRABlack);
-  blurShape.DrawLineAntialias(intRadius - dx * d, intRadius - dy *
-    d, intRadius + dx * d, intRadius + dy * d, BGRAWhite, 1, True);
-  if oriented then
-    blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height,
-      BGRAPixelTransparent, BGRABlack, gtRadial, pointF(intRadius -
-      dx * d, intRadius - dy * d),
-      pointF(intRadius + dx * (d + 0.5), intRadius + dy * (d + 0.5)),
-      dmFastBlend, False);
-  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 }
-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: Int32or64): byte; inline;
-begin
-  if value < 0 then result := 0 else
-  if value > 255 then result := 255 else
-    result := value;
-end;
 function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer;
   useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
 …
 end;
-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: Int32or64;
-  p: PBGRAPixel;
-  maskShift: integer;
-begin
-  maskSum := 0;
-  p := blurMask.data;
-  for i := 0 to blurMask.NbPixels-1 do
-  begin
-    inc(maskSum,p^.red);
-    inc(p);
-  end;
-  maskShift := 0;
-  while maskSum > 32768 do
-  begin
-    inc(maskShift);
-    maskSum := maskSum shr 1;
-  end;
-  //check if sum can be stored in a 32-bit signed integer
-  if maskShift = 0 then
-    FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else
-  {$IFDEF CPU32}
-  if maskShift < 8 then
-    FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else
-  {$ENDIF}
-    FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop);
-end;
-{$ENDIF}
-//32-bit blur with shift
-procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
-  blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-  var
-    sumR, sumG, sumB, sumA, Adiv, RGBdiv : integer;
-  function ComputeAverage: TBGRAPixel; inline;
-  begin
-    result.alpha := (sumA + Adiv shr 1) div Adiv;
-    if result.alpha = 0 then
-      result := BGRAPixelTransparent
-    else
-    begin
-      result.red   := clampByte((sumR + RGBdiv shr 1) div RGBdiv);
-      result.green := clampByte((sumG + RGBdiv shr 1) div RGBdiv);
-      result.blue  := clampByte((sumB + RGBdiv shr 1) div RGBdiv);
-    end;
-  end;
-  {$define PARAM_MASKSHIFT}
-  {$I blurnormal.inc}
-//32-bit blur
-procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap;
-  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-  var
-    sumR, sumG, sumB, sumA, Adiv : integer;
-  function ComputeAverage: TBGRAPixel; inline;
-  begin
-    result.alpha := (sumA + Adiv shr 1) div Adiv;
-    if result.alpha = 0 then
-      result := BGRAPixelTransparent
-    else
-    begin
-      result.red   := clampByte((sumR + sumA shr 1) div sumA);
-      result.green := clampByte((sumG + sumA shr 1) div sumA);
-      result.blue  := clampByte((sumB + sumA shr 1) div sumA);
-    end;
-  end;
-  {$I blurnormal.inc}
-//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
-procedure FilterBlurBigMask(bmp: TBGRACustomBitmap;
-  blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-  var
-    sumR, sumG, sumB, sumA, Adiv : single;
-  function ComputeAverage: TBGRAPixel; inline;
-  begin
-    result.alpha := round(sumA/Adiv);
-    if result.alpha = 0 then
-      result := BGRAPixelTransparent
-    else
-    begin
-      result.red   := clampByte(round(sumR/sumA));
-      result.green := clampByte(round(sumG/sumA));
-      result.blue  := clampByte(round(sumB/sumA));
-    end;
-  end;
-  {$I blurnormal.inc}
-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; ABounds: TRect): TBGRACustomBitmap;
-var
-  yb, xb: Int32or64;
-  dx, dy: single;
-  idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: Int32or64;
-  w:      array[1..4] of single;
-  iw:     uint32or64;
-  c:      array[0..4] of TBGRAPixel;
-  i:     Int32or64;
-  sumR, sumG, sumB, sumA, RGBdiv, Adiv: UInt32or64;
-  tempPixel, refPixel: TBGRAPixel;
-  pdest: PBGRAPixel;
-  bounds: TRect;
-  onHorizBorder: boolean;
-  psrc: array[-1..1] of PBGRAPixel;
-begin
-  if IsRectEmpty(ABounds) then exit;
-  //compute pixel position and weight
-  dx   := cos(angle * Pi / 180);
-  dy   := sin(angle * Pi / 180);
-  idx1 := floor(dx);
-  idy1 := floor(dy);
-  idx2 := ceil(dx);
-  idy2 := ceil(dy);
-  idx3 := idx1;
-  idy3 := idy2;
-  idx4 := idx2;
-  idy4 := idy1;
-  w[1] := (1 - abs(idx1 - dx)) * (1 - abs(idy1 - dy));
-  w[2] := (1 - abs(idx2 - dx)) * (1 - abs(idy2 - dy));
-  w[3] := (1 - abs(idx3 - dx)) * (1 - abs(idy3 - dy));
-  w[4] := (1 - abs(idx4 - dx)) * (1 - abs(idy4 - dy));
-  //fill with gray
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
-  Result.Fill(BGRA(128, 128, 128, 255));
-  bounds := bmp.GetImageBounds;
-  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);
-  //loop through destination
-  for yb := bounds.Top to bounds.bottom - 1 do
-  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] := 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;
-      sumG   := 0;
-      sumB   := 0;
-      sumA   := 0;
-      Adiv   := 0;
-      RGBdiv := 0;
-      //compute sum
-       {$hints off}
-      for i := 1 to 4 do
-      begin
-        tempPixel := c[i];
-        if tempPixel.alpha = 0 then
-          tempPixel := c[0];
-        iw     := round(w[i] * tempPixel.alpha);
-        sumR   += tempPixel.red * iw;
-        sumG   += tempPixel.green * iw;
-        sumB   += tempPixel.blue * iw;
-        RGBdiv += iw;
-        sumA   += iw;
-        Adiv   += round(w[i] * 255);
-      end;
-       {$hints on}
-      //average
-      if (Adiv = 0) or (RGBdiv = 0) then
-        refPixel := c[0]
-      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;
-        refPixel.alpha := (sumA * 255 + Adiv shr 1) div Adiv;
-      end;
-      //difference with center pixel
-       {$hints off}
-      tempPixel.red := max(0, min(512 * 255, 65536 + refPixel.red *
-        refPixel.alpha - c[0].red * c[0].alpha)) shr 9;
-      tempPixel.green := max(0, min(512 * 255, 65536 + refPixel.green *
-        refPixel.alpha - c[0].green * c[0].alpha)) shr 9;
-      tempPixel.blue := max(0, min(512 * 255, 65536 + refPixel.blue *
-        refPixel.alpha - c[0].blue * c[0].alpha)) shr 9;
-       {$hints on}
-      tempPixel.alpha := 255;
-      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;
-  Result.InvalidateBitmap;
-end;
-{ Like general emboss, but with fixed direction and automatic color with transparency }
-function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
-  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
-var
-  yb, xb: Int32or64;
-  c0,c1,c2,c3,c4,c5,c6: Int32or64;
-  bmpWidth, bmpHeight: Int32or64;
-  slope, h: byte;
-  sum:      Int32or64;
-  tempPixel, highlight: TBGRAPixel;
-  pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
-  bounds: TRect;
-  borderColorOverride: boolean;
-  borderColorLevel: Int32or64;
-  currentBorderColor: Int32or64;
-begin
-  borderColorOverride := DefineBorderColor.alpha <> 0;
-  borderColorLevel := DefineBorderColor.red;
-  bmpWidth  := bmp.Width;
-  bmpHeight := bmp.Height;
-  Result    := bmp.NewBitmap(bmpWidth, bmpHeight);
-  if borderColorOverride then
-    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
-  else
-    bounds := bmp.GetImageBounds(cRed);
-  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
-    exit;
-  bounds.Left   := max(0, bounds.Left - 1);
-  bounds.Top    := max(0, bounds.Top - 1);
-  bounds.Right  := min(bmpWidth, bounds.Right + 1);
-  bounds.Bottom := min(bmpHeight, bounds.Bottom + 1);
-  currentBorderColor := borderColorLevel;
-  for yb := bounds.Top to bounds.Bottom - 1 do
-  begin
-    pdest := Result.scanline[yb] + bounds.Left;
-    if yb > 0 then
-      psrcUp := bmp.Scanline[yb - 1] + bounds.Left
-    else
-      psrcUp := nil;
-    psrc := bmp.scanline[yb] + bounds.Left;
-    if yb < bmpHeight - 1 then
-      psrcDown := bmp.scanline[yb + 1] + bounds.Left
-    else
-      psrcDown := nil;
-    for xb := bounds.Left to bounds.Right - 1 do
-    begin
-      c0 := pbyte(psrc)^;
-      if not borderColorOverride then currentBorderColor := c0;
-      if (xb = 0) then
-      begin
-        c1 := currentBorderColor;
-        c2 := currentBorderColor;
-      end
-      else
-      begin
-        if psrcUp <> nil then
-          c1 := pbyte(psrcUp - 1)^
-        else
-          c1 := currentBorderColor;
-        c2 := pbyte(psrc - 1)^;
-      end;
-      if psrcUp <> nil then
-      begin
-        c3 := pbyte(psrcUp)^;
-        Inc(psrcUp);
-      end
-      else
-       c3 := currentBorderColor;
-      if (xb = bmpWidth - 1) then
-      begin
-        c4 := currentBorderColor;
-        c5 := currentBorderColor;
-      end
-      else
-      begin
-        if psrcDown <> nil then
-          c4 := pbyte(psrcDown + 1)^
-        else
-          c4 := currentBorderColor;
-        c5 := pbyte(psrc + 1)^;
-      end;
-      if psrcDown <> nil then
-      begin
-        c6 := pbyte(psrcDown)^;
-        Inc(psrcDown);
-      end
-      else
-        c6 := currentBorderColor;
-      Inc(psrc);
-      sum := c4+c5+c6-c1-c2-c3;
-      sum := 128 + sum div 3;
-      if sum > 255 then
-        slope := 255
-      else
-      if sum < 1 then
-        slope := 1
-      else
-        slope := sum;
-      h := c0;
-      tempPixel.red   := slope;
-      tempPixel.green := slope;
-      tempPixel.blue  := slope;
-      tempPixel.alpha := abs(slope - 128) * 2;
-      if fillSelection then
-      begin
-        highlight := BGRA(h shr 2, h shr 1, h, h shr 1);
-        if tempPixel.red < highlight.red then
-          tempPixel.red := highlight.red;
-        if tempPixel.green < highlight.green then
-          tempPixel.green := highlight.green;
-        if tempPixel.blue < highlight.blue then
-          tempPixel.blue := highlight.blue;
-        if tempPixel.alpha < highlight.alpha then
-          tempPixel.alpha := highlight.alpha;
-      end;
-      pdest^ := tempPixel;
-      Inc(pdest);
-    end;
-  end;
-  Result.InvalidateBitmap;
-end;
-function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
-  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
-var
-  yb, xb: int32or64;
-  c0,c1,c2,c3,c4,c5,c6: int32or64;
-  bmpWidth, bmpHeight: int32or64;
-  slope, h: byte;
-  sum:      int32or64;
-  tempPixel, highlight: TBGRAPixel;
-  pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
-  bounds: TRect;
-  borderColorOverride: boolean;
-  borderColorLevel: int32or64;
-  currentBorderColor: int32or64;
-begin
-  borderColorOverride := DefineBorderColor.alpha <> 0;
-  borderColorLevel := DefineBorderColor.red;
-  bmpWidth  := bmp.Width;
-  bmpHeight := bmp.Height;
-  if borderColorOverride then
-    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
-  else
-    bounds := bmp.GetImageBounds(cRed);
-  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
-  begin
-    Result    := bmp.NewBitmap(0, 0);
-    exit;
-  end;
-  bounds.Left   := max(0, bounds.Left - 1);
-  bounds.Top    := max(0, bounds.Top - 1);
-  bounds.Right  := min(bmpWidth, bounds.Right + 1);
-  bounds.Bottom := min(bmpHeight, bounds.Bottom + 1);
-  Result    := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1);
-  inc(Offset.X, bounds.Left);
-  inc(Offset.Y, bounds.Top);
-  currentBorderColor := borderColorLevel;
-  for yb := bounds.Top to bounds.Bottom - 1 do
-  begin
-    pdest := Result.scanline[yb-Bounds.Top];
-    if yb > 0 then
-      psrcUp := bmp.Scanline[yb - 1] + bounds.Left
-    else
-      psrcUp := nil;
-    psrc := bmp.scanline[yb] + bounds.Left;
-    if yb < bmpHeight - 1 then
-      psrcDown := bmp.scanline[yb + 1] + bounds.Left
-    else
-      psrcDown := nil;
-    for xb := bounds.Left to bounds.Right - 1 do
-    begin
-      c0 := pbyte(psrc)^;
-      if not borderColorOverride then currentBorderColor := c0;
-      if (xb = 0) then
-      begin
-        c1 := currentBorderColor;
-        c2 := currentBorderColor;
-      end
-      else
-      begin
-        if psrcUp <> nil then
-          c1 := pbyte(psrcUp - 1)^
-        else
-          c1 := currentBorderColor;
-        c2 := pbyte(psrc - 1)^;
-      end;
-      if psrcUp <> nil then
-      begin
-        c3 := pbyte(psrcUp)^;
-        Inc(psrcUp);
-      end
-      else
-       c3 := currentBorderColor;
-      if (xb = bmpWidth - 1) then
-      begin
-        c4 := currentBorderColor;
-        c5 := currentBorderColor;
-      end
-      else
-      begin
-        if psrcDown <> nil then
-          c4 := pbyte(psrcDown + 1)^
-        else
-          c4 := currentBorderColor;
-        c5 := pbyte(psrc + 1)^;
-      end;
-      if psrcDown <> nil then
-      begin
-        c6 := pbyte(psrcDown)^;
-        Inc(psrcDown);
-      end
-      else
-        c6 := currentBorderColor;
-      Inc(psrc);
-      sum := c4+c5+c6-c1-c2-c3;
-      sum := 128 + sum div 3;
-      if sum > 255 then
-        slope := 255
-      else
-      if sum < 1 then
-        slope := 1
-      else
-        slope := sum;
-      h := c0;
-      tempPixel.red   := slope;
-      tempPixel.green := slope;
-      tempPixel.blue  := slope;
-      tempPixel.alpha := abs(slope - 128) * 2;
-      if fillSelection then
-      begin
-        highlight := BGRA(h shr 2, h shr 1, h, h shr 1);
-        if tempPixel.red < highlight.red then
-          tempPixel.red := highlight.red;
-        if tempPixel.green < highlight.green then
-          tempPixel.green := highlight.green;
-        if tempPixel.blue < highlight.blue then
-          tempPixel.blue := highlight.blue;
-        if tempPixel.alpha < highlight.alpha then
-          tempPixel.alpha := highlight.alpha;
-      end;
-      pdest^ := tempPixel;
-      Inc(pdest);
-    end;
-  end;
-  Result.InvalidateBitmap;
-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; ABounds: TRect;
-  eachChannel: boolean = True): TBGRACustomBitmap;
-var
-  psrc, pdest: PBGRAPixel;
-  c: TExpandedPixel;
-  xcount,xb,yb: int32or64;
-  minValRed, maxValRed, minValGreen, maxValGreen, minValBlue, maxValBlue,
-  minAlpha, maxAlpha, addValRed, addValGreen, addValBlue, addAlpha: word;
-  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;
-  maxValRed := 0;
-  minValRed := 65535;
-  maxValGreen := 0;
-  minValGreen := 65535;
-  maxValBlue := 0;
-  minValBlue := 65535;
-  maxAlpha  := 0;
-  minAlpha  := 65535;
-  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
-  begin
-    minValRed   := min(min(minValRed, minValGreen), minValBlue);
-    maxValRed   := max(max(maxValRed, maxValGreen), maxValBlue);
-    minValGreen := minValRed;
-    maxValGreen := maxValRed;
-    minValBlue  := minValBlue;
-    maxValBlue  := maxValBlue;
-  end;
-  if maxValRed > minValRed then
-  begin
-    factorValRed := 268431360 div (maxValRed - minValRed);
-    addValRed    := 0;
-  end
-  else
-  begin
-    factorValRed := 0;
-    if minValRed = 0 then
-      addValRed := 0
-    else
-      addValRed := 65535;
-  end;
-  if maxValGreen > minValGreen then
-  begin
-    factorValGreen := 268431360 div (maxValGreen - minValGreen);
-    addValGreen    := 0;
-  end
-  else
-  begin
-    factorValGreen := 0;
-    if minValGreen = 0 then
-      addValGreen := 0
-    else
-      addValGreen := 65535;
-  end;
-  if maxValBlue > minValBlue then
-  begin
-    factorValBlue := 268431360 div (maxValBlue - minValBlue);
-    addValBlue    := 0;
-  end
-  else
-  begin
-    factorValBlue := 0;
-    if minValBlue = 0 then
-      addValBlue := 0
-    else
-      addValBlue := 65535;
-  end;
-  if maxAlpha > minAlpha then
-  begin
-    factorAlpha := 268431360 div (maxAlpha - minAlpha);
-    addAlpha    := 0;
-  end
-  else
-  begin
-    factorAlpha := 0;
-    if minAlpha = 0 then
-      addAlpha := 0
-    else
-      addAlpha := 65535;
-  end;
-  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;
-end;
-{ Rotates the image. To do this, loop through the destination and
-  calculates the position in the source bitmap with an affine transformation }
-function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
-  angle: single; correctBlur: boolean): TBGRACustomBitmap;
-var
-  bounds:     TRect;
-  pdest:      PBGRAPixel;
-  xsrc, ysrc: single;
-  savexysrc, pt: TPointF;
-  dx, dy:     single;
-  xb, yb:     int32or64;
-  minx, miny, maxx, maxy: single;
-  rf : TResampleFilter;
-  function RotatePos(x, y: single): TPointF;
-  var
-    px, py: single;
-  begin
-    px     := x - origin.x;
-    py     := y - origin.y;
-    Result := PointF(origin.x + px * dx + py * dy, origin.y - px * dy + py * dx);
-  end;
-begin
-  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
-  dx   := cos(angle * Pi / 180);
-  dy   := -sin(angle * Pi / 180);
-  pt   := RotatePos(bounds.left, bounds.top);
-  minx := pt.x;
-  miny := pt.y;
-  maxx := pt.x;
-  maxy := pt.y;
-  pt   := RotatePos(bounds.Right - 1, bounds.top);
-  if pt.x < minx then
-    minx := pt.x
-  else
-  if pt.x > maxx then
-    maxx := pt.x;
-  if pt.y < miny then
-    miny := pt.y
-  else
-  if pt.y > maxy then
-    maxy := pt.y;
-  pt     := RotatePos(bounds.Right - 1, bounds.bottom - 1);
-  if pt.x < minx then
-    minx := pt.x
-  else
-  if pt.x > maxx then
-    maxx := pt.x;
-  if pt.y < miny then
-    miny := pt.y
-  else
-  if pt.y > maxy then
-    maxy := pt.y;
-  pt     := RotatePos(bounds.left, bounds.bottom - 1);
-  if pt.x < minx then
-    minx := pt.x
-  else
-  if pt.x > maxx then
-    maxx := pt.x;
-  if pt.y < miny then
-    miny := pt.y
-  else
-  if pt.y > maxy then
-    maxy := pt.y;
-  bounds.left   := max(0, floor(minx));
-  bounds.top    := max(0, floor(miny));
-  bounds.right  := min(bmp.Width, ceil(maxx) + 1);
-  bounds.bottom := min(bmp.Height, ceil(maxy) + 1);
-  //reciproqual
-  dy   := -dy;
-  pt   := RotatePos(bounds.left, bounds.top);
-  xsrc := pt.x;
-  ysrc := pt.y;
-  for yb := bounds.Top to bounds.bottom - 1 do
-  begin
-    pdest     := Result.scanline[yb] + bounds.left;
-    savexysrc := pointf(xsrc, ysrc);
-    for xb := bounds.left to bounds.right - 1 do
-    begin
-      pdest^ := bmp.GetPixel(xsrc, ysrc, rf);
-      Inc(pdest);
-      xsrc += dx;
-      ysrc -= dy;
-    end;
-    xsrc := savexysrc.x + dy;
-    ysrc := savexysrc.y + dx;
-  end;
-  Result.InvalidateBitmap;
-end;
-{ Filter grayscale applies BGRAToGrayscale function to all pixels }
-procedure FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
-var
-  pdest, psrc: PBGRAPixel;
-  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^);
-      Inc(pdest);
-      Inc(psrc);
-    end;
-  end;
-  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;
-{ Filter contour compute a grayscale image, then for each pixel
-  calculates the difference with surrounding pixels (in intensity and alpha)
-  and draw black pixels when there is a difference }
-function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
-var
-  yb, xb: int32or64;
-  c:      array[0..8] of TBGRAPixel;
-  i, bmpWidth, bmpHeight: int32or64;
-  slope: byte;
-  sum:   int32or64;
-  tempPixel: TBGRAPixel;
-  pdest, psrcUp, psrc, psrcDown: PBGRAPixel;
-  bounds: TRect;
-  gray:   TBGRACustomBitmap;
-begin
-  bmpWidth  := bmp.Width;
-  bmpHeight := bmp.Height;
-  Result    := bmp.NewBitmap(bmpWidth, bmpHeight);
-  gray      := bmp.FilterGrayscale;
-  bounds := rect(0, 0, bmp.Width, bmp.Height);
-  for yb := bounds.Top to bounds.Bottom - 1 do
-  begin
-    pdest := Result.scanline[yb] + bounds.Left;
-    if yb > 0 then
-      psrcUp := gray.Scanline[yb - 1] + bounds.Left
-    else
-      psrcUp := nil;
-    psrc := gray.scanline[yb] + bounds.Left;
-    if yb < bmpHeight - 1 then
-      psrcDown := gray.scanline[yb + 1] + bounds.Left
-    else
-      psrcDown := nil;
-    for xb := bounds.Left to bounds.Right - 1 do
-    begin
-      c[0] := psrc^;
-      if (xb = 0) then
-      begin
-        c[1] := c[0];
-        c[2] := c[0];
-        c[4] := c[0];
-      end
-      else
-      begin
-        if psrcUp <> nil then
-          c[1] := (psrcUp - 1)^
-        else
-          c[1] := c[0];
-        c[2] := (psrc - 1)^;
-        if psrcDown <> nil then
-          c[4] := (psrcDown - 1)^
-        else
-          c[4] := c[0];
-      end;
-      if psrcUp <> nil then
-      begin
-        c[3] := psrcUp^;
-        Inc(psrcUp);
-      end
-      else
-        c[3] := c[0];
-      if (xb = bmpWidth - 1) then
-      begin
-        c[5] := c[0];
-        c[6] := c[0];
-        c[8] := c[0];
-      end
-      else
-      begin
-        if psrcDown <> nil then
-          c[5] := (psrcDown + 1)^
-        else
-          c[5] := c[0];
-        c[6] := (psrc + 1)^;
-        if psrcUp <> nil then
-          c[8] := psrcUp^
-        else //+1 before
-          c[8] := c[0];
-      end;
-      if psrcDown <> nil then
-      begin
-        c[7] := psrcDown^;
-        Inc(psrcDown);
-      end
-      else
-        c[7] := c[0];
-      Inc(psrc);
-      sum := 0;
-      for i := 1 to 4 do
-        sum += abs(c[i].red - c[i + 4].red) + abs(c[i].alpha - c[i + 4].alpha);
-      if sum > 255 then
-        slope := 255
-      else
-      if sum < 0 then
-        slope := 0
-      else
-        slope := sum;
-      tempPixel.red := 255 - slope;
-      tempPixel.green := 255 - slope;
-      tempPixel.blue := 255 - slope;
-      tempPixel.alpha := 255;
-      pdest^ := tempPixel;
-      Inc(pdest);
-    end;
-  end;
-  Result.InvalidateBitmap;
-  gray.Free;
-end;
-{ Compute the distance for each pixel to the center of the bitmap,
-  calculate the corresponding angle with arcsin, use this angle
-  to determine a distance from the center in the source bitmap }
-function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
-var
-  cx, cy, x, y, len, fact: single;
-  xb, yb: int32or64;
-  mask:   TBGRACustomBitmap;
-begin
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
-  cx     := bmp.Width / 2 - 0.5;
-  cy     := bmp.Height / 2 - 0.5;
-  for yb := 0 to Result.Height - 1 do
-    for xb := 0 to Result.Width - 1 do
-    begin
-      x   := (xb - cx) / (cx + 0.5);
-      y   := (yb - cy) / (cy + 0.5);
-      len := sqrt(sqr(x) + sqr(y));
-      if (len <= 1) then
-      begin
-        if (len > 0) then
-        begin
-          fact := 1 / len * arcsin(len) / (Pi / 2);
-          x    *= fact;
-          y    *= fact;
-        end;
-        Result.setpixel(xb, yb, bmp.Getpixel(x * cx + cx, y * cy + cy));
-      end;
-    end;
-  mask := bmp.NewBitmap(bmp.Width, bmp.Height);
-  Mask.Fill(BGRABlack);
-  Mask.FillEllipseAntialias(cx, cy, cx, cy, BGRAWhite);
-  Result.ApplyMask(mask);
-  Mask.Free;
-end;
-{ Applies twirl scanner. See TBGRATwirlScanner }
-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.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;
-{ Compute the distance for each pixel to the vertical axis of the bitmap,
-  calculate the corresponding angle with arcsin, use this angle
-  to determine a distance from the vertical axis in the source bitmap }
-function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
-var
-  cx, cy, x, y, len, fact: single;
-  xb, yb: int32or64;
-begin
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
-  cx     := bmp.Width / 2 - 0.5;
-  cy     := bmp.Height / 2 - 0.5;
-  for yb := 0 to Result.Height - 1 do
-    for xb := 0 to Result.Width - 1 do
-    begin
-      x   := (xb - cx) / (cx + 0.5);
-      y   := (yb - cy) / (cy + 0.5);
-      len := abs(x);
-      if (len <= 1) then
-      begin
-        if (len > 0) then
-        begin
-          fact := 1 / len * arcsin(len) / (Pi / 2);
-          x    *= fact;
-        end;
-        Result.setpixel(xb, yb, bmp.Getpixel(x * cx + cx, y * cy + cy));
-      end;
-    end;
-end;
-function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
-const resampleGap=0.6;
-var
-  cy, x1, x2, y1, y2, z1, z2, h: single;
-  yb: int32or64;
-  resampledBmp: TBGRACustomBitmap;
-  resampledBmpWidth: int32or64;
-  resampledFactor,newResampleFactor: single;
-  sub,resampledSub: TBGRACustomBitmap;
-  partRect: TRect;
-  resampleSizeY : int32or64;
-begin
-  resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch);
-  resampledBmpWidth := resampledBmp.Width;
-  resampledFactor := 2;
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height*2);
-  cy     := result.Height / 2 - 0.5;
-  h      := 1;
-  for yb := 0 to ((Result.Height-1) div 2) do
-  begin
-    y1 := (cy - (yb-0.5)) / (cy+0.5);
-    y2 := (cy - (yb+0.5)) / (cy+0.5);
-    if y2 <= 0 then continue;
-    z1 := h/y1;
-    z2 := h/y2;
-    newResampleFactor := 1/(z2-z1)*1.5;
-    x1 := (z1+1)/2;
-    x2 := (z2+1)/2;
-    if newResampleFactor <= resampledFactor*resampleGap then
-    begin
-      resampledFactor := newResampleFactor;
-      if resampledBmp <> bmp then resampledBmp.Free;
-      if (x2-x1 >= 1) then resampleSizeY := 1 else
-        resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1));
-      resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch);
-      resampledBmpWidth := resampledBmp.Width;
-    end;
-    partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height),
-       round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1);
-    if x2-x1 > 1 then
-    begin
-      partRect.Top := 0;
-      partRect.Bottom := 1;
-    end;
-    sub := resampledBmp.GetPart(partRect);
-    if sub <> nil then
-    begin
-      resampledSub := sub.Resample(bmp.Width,1,rmFineResample);
-      result.PutImage(0,yb,resampledSub,dmSet);
-      result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet);
-      resampledSub.free;
-      sub.free;
-    end;
-  end;
-  if resampledBmp <> bmp then resampledBmp.Free;
-  if result.Height <> bmp.Height then
-  begin
-    resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch);
-    result.free;
-    result := resampledBmp;
-  end;
-end;
-{ For each component, sort values to get the median }
-function FilterMedian(bmp: TBGRACustomBitmap;
-  Option: TMedianOption): TBGRACustomBitmap;
-  function ComparePixLt(p1, p2: TBGRAPixel): boolean;
-  begin
-    if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then
-      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);
-  end;
-const
-  nbpix = 9;
-var
-  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: uint32or64;
-  tempAlpha: word;
-  bounds:    TRect;
-  pdest:     PBGRAPixel;
-begin
-  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
-  bounds := bmp.GetImageBounds;
-  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) 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);
-  for yb := bounds.Top to bounds.bottom - 1 do
-  begin
-    pdest := Result.scanline[yb] + bounds.left;
-    for xb := bounds.left to bounds.right - 1 do
-    begin
-      n := 0;
-      for dy := -1 to 1 do
-        for dx := -1 to 1 do
-        begin
-          a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
-          if a_pixels[n].alpha = 0 then
-            a_pixels[n] := BGRAPixelTransparent;
-          Inc(n);
-        end;
-      for i := 1 to n - 1 do
-      begin
-        j := i;
-        while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do
-        begin
-          tempValue := a_pixels[j].alpha;
-          a_pixels[j].alpha := a_pixels[j - 1].alpha;
-          a_pixels[j - 1].alpha := tempValue;
-          Dec(j);
-        end;
-        j := i;
-        while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do
-        begin
-          tempValue := a_pixels[j].red;
-          a_pixels[j].red := a_pixels[j - 1].red;
-          a_pixels[j - 1].red := tempValue;
-          Dec(j);
-        end;
-        j := i;
-        while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do
-        begin
-          tempValue := a_pixels[j].green;
-          a_pixels[j].green := a_pixels[j - 1].green;
-          a_pixels[j - 1].green := tempValue;
-          Dec(j);
-        end;
-        j := i;
-        while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do
-        begin
-          tempValue := a_pixels[j].blue;
-          a_pixels[j].blue := a_pixels[j - 1].blue;
-          a_pixels[j - 1].blue := tempValue;
-          Dec(j);
-        end;
-      end;
-      refPixel := a_pixels[n div 2];
-      if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then
-      begin
-        sumR    := 0;
-        sumG    := 0;
-        sumB    := 0;
-        sumA    := 0;
-        BGRAdiv := 0;
-        nbA     := 0;
-        case option of
-          moHighSmooth, moMediumSmooth:
-          begin
-            j := 2;
-            k := 2;
-          end;
-          else
-          begin
-            j := 1;
-            k := 1;
-          end;
-        end;
-         {$hints off}
-        for i := -k to j do
-        begin
-          tempPixel := a_pixels[n div 2 + i];
-          tempAlpha := tempPixel.alpha;
-          if (option = moMediumSmooth) and ((i = -k) or (i = j)) then
-            tempAlpha := tempAlpha div 2;
-          sumR    += tempPixel.red * tempAlpha;
-          sumG    += tempPixel.green * tempAlpha;
-          sumB    += tempPixel.blue * tempAlpha;
-          BGRAdiv += tempAlpha;
-          sumA += tempAlpha;
-          Inc(nbA);
-        end;
-         {$hints on}
-        if option = moMediumSmooth then
-          Dec(nbA);
-        if (BGRAdiv = 0) then
-          refPixel := BGRAPixelTransparent
-        else
-        begin
-          refPixel.red   := round(sumR / BGRAdiv);
-          refPixel.green := round(sumG / BGRAdiv);
-          refPixel.blue  := round(sumB / BGRAdiv);
-          refPixel.alpha := round(sumA / nbA);
-        end;
-      end;
-      pdest^ := refPixel;
-      Inc(pdest);
-    end;
-  end;
-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

-              r472
+              r494
   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.
+  >> Note that you need to define the default FreeType font collection
+  >> using EasyLazFreeType unit.
   To set the effects, keep a variable containing
 …
 interface
+{$i bgrabitmap.inc}
 uses
+  Types, Classes, SysUtils, Graphics, BGRABitmapTypes, EasyLazFreeType, FPimage, BGRAText, BGRATextFX, BGRAPhongTypes, LCLVersion;
+  Types, Classes, SysUtils, BGRAGraphics, BGRABitmapTypes, EasyLazFreeType, FPimage,
+  BGRACustomTextFX, BGRAPhongTypes;
 type
 …
     ShadowRadius: integer;
     ShadowOffset: TPoint;
+    ShadowQuality: TRadialBlurType;
     OutlineColor: TBGRAPixel;
 …
     ShadowRadius: integer;
     ShadowOffset: TPoint;
+    ShadowQuality: TRadialBlurType;
     OutlineColor: TBGRAPixel;
 …
     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;
+    { If this code does not compile, you probably have an older version of Lazarus. To fix the problem,
+      go into "bgrabitmap.inc" and comment the compiler directives }
+    {$IFDEF BGRABITMAP_USE_LCL12}
+    procedure DrawTextWordBreak(AText: string; AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
+    procedure DrawTextRect(AText: string; AFont: TFreeTypeRenderableFont; X1,Y1,X2,Y2: Single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
+    {$ENDIF}
+    {$IFDEF BGRABITMAP_USE_LCL15}
+    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TFPColor); override; overload;
+    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel); overload;
+    procedure DrawGlyph(AGlyph: integer; AFont: TFreeTypeRenderableFont; x,y: single; AColor: TBGRAPixel; AAlign: TFreeTypeAlignments); overload;
+    {$ENDIF}
+    function CreateTextEffect(AText: string; AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect;
     destructor Destroy; override;
   end;
 …
 implementation
 uses LCLType, BGRABlend, Math;
+uses BGRABlend, Math;
 { TBGRAFreeTypeFontRenderer }
 …
   result.ShadowRadius := ShadowRadius;
   result.ShadowVisible := ShadowVisible;
+  result.ShadowQuality := ShadowQuality;
   result.ClearTypeRGBOrder := FontQuality <> fqFineClearTypeBGR;
   result.Destination := ASurface;
 …
 procedure TBGRAFreeTypeFontRenderer.UpdateFont;
 var fts: TFreeTypeStyles;
+  filename: string;
 begin
   fts := [];
 …
   if fsItalic in FontStyle then fts += [ftsItalic];
   try
+    {$IF (lcl_fullversion>=1010000)}
+    FFont.SetNameAndStyle(FontName,fts);
+    filename := FontName;
+    {$IFDEF BGRABITMAP_USE_LCL12}
+    FFont.SetNameAndStyle(filename,fts);
     {$ELSE}
     FFont.Name := FontName;
+    FFont.Name := filename;
     FFont.Style := fts;
     {$ENDIF}
 …
   end;
   FFont.Hinted := FontHinted;
   {$IF (lcl_fullversion>=1010000)}
   FFont.StrikeOutDecoration := fsStrikeOut in FontStyle;
   FFont.UnderlineDecoration := fsUnderline in FontStyle;
+  {$IFDEF BGRABITMAP_USE_LCL12}
+    FFont.StrikeOutDecoration := fsStrikeOut in FontStyle;
+    FFont.UnderlineDecoration := fsUnderline in FontStyle;
   {$ENDIF}
 end;
 …
   ShadowOffset := Point(5,5);
   ShadowRadius := 5;
+  ShadowQuality:= rbFast;
 end;
 …
   end;
   case style.Layout of
   {$IF (lcl_fullversion>=1010000)}
   tlCenter: begin ARect.Top := y; align += [ftaVerticalCenter]; end;
+  {$IFDEF BGRABITMAP_USE_LCL12}
+    tlCenter: begin ARect.Top := y; align += [ftaVerticalCenter]; end;
   {$ENDIF}
   tlBottom: begin ARect.top := y; align += [ftaBottom]; end;
 …
   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
+    {$IFDEF BGRABITMAP_USE_LCL12}
+      if style.Wordbreak then
+        GetDrawer(ADest).DrawTextRect(s, FFont, ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,BGRAToFPColor(c),align)
+      else
     {$ENDIF}
     begin
 …
 function TBGRAFreeTypeFontRenderer.TextSize(s: string): TSize;
 begin
+  UpdateFont;
   result.cx := round(FFont.TextWidth(s));
   result.cy := round(FFont.LineFullHeight);
 …
   ClearTypeRGBOrder:= true;
   ShaderActive := true;
+  ShadowQuality:= rbFast;
 end;
 procedure TBGRAFreeTypeDrawer.DrawText(AText: string;
   AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
 var fx: TBGRATextEffect;
+var fx: TBGRACustomTextEffect;
   procedure DoOutline;
   begin
 …
   begin
     fx := CreateTextEffect(AText, AFont);
+    fx.ShadowQuality := ShadowQuality;
     y -= AFont.Ascent;
     if ShadowActuallyVisible then fx.DrawShadow(Destination, round(x+ShadowOffset.X),round(y+ShadowOffset.Y), ShadowRadius, ShadowColor);
 …
 end;
+{$IFDEF BGRABITMAP_USE_LCL12}
+procedure TBGRAFreeTypeDrawer.DrawTextWordBreak(AText: string;
+  AFont: TFreeTypeRenderableFont; x, y, AMaxWidth: Single; AColor: TBGRAPixel;
+  AAlign: TFreeTypeAlignments);
+begin
+  DrawTextWordBreak(AText,AFont,x,y,AMaxWidth,BGRAToFPColor(AColor),AAlign);
+end;
+procedure TBGRAFreeTypeDrawer.DrawTextRect(AText: string;
+  AFont: TFreeTypeRenderableFont; X1, Y1, X2, Y2: Single; AColor: TBGRAPixel;
+  AAlign: TFreeTypeAlignments);
+begin
+  DrawTextRect(AText,AFont,X1,Y1,X2,Y2,BGRAToFPColor(AColor),AAlign);
+end;
+{$ENDIF}
+{$IFDEF BGRABITMAP_USE_LCL15}
+procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer;
+  AFont: TFreeTypeRenderableFont; x, y: single; AColor: TFPColor);
+var f: TFreeTypeFont;
+begin
+  if not (AFont is TFreeTypeFont) then exit;
+  f := TFreeTypeFont(Afont);
+  FColor := FPColorToBGRA(AColor);
+  if AFont.ClearType then
+    f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectlyClearType)
+  else
+    f.RenderGlyph(AGlyph, x, y, Destination.ClipRect, @RenderDirectly);
+end;
+procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer;
+  AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel);
+begin
+  DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor));
+end;
+procedure TBGRAFreeTypeDrawer.DrawGlyph(AGlyph: integer;
+  AFont: TFreeTypeRenderableFont; x, y: single; AColor: TBGRAPixel;
+  AAlign: TFreeTypeAlignments);
+begin
+  DrawGlyph(AGlyph, AFont, x,y, BGRAToFPColor(AColor), AAlign);
+end;
+{$ENDIF}
 function TBGRAFreeTypeDrawer.CreateTextEffect(AText: string;
   AFont: TFreeTypeRenderableFont): TBGRATextEffect;
+  AFont: TFreeTypeRenderableFont): TBGRACustomTextEffect;
 var
   mask: TBGRACustomBitmap;
 …
     AFont.ClearType := tempClearType;
     mask.ConvertToLinearRGB;
     result := TBGRATextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert));
+    result := TBGRACustomTextEffect.Create(mask, true,tx,ty,point(-marginHoriz,-marginVert));
   finally
     FInCreateTextEffect:= false;

GraphicTest/Packages/bgrabitmap/bgragradients.pas

-              r472
+              r494
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 {$i bgrasse.inc}
 …
 uses
   Classes, Graphics, BGRABitmapTypes, BGRABitmap, BGRABlend, BGRAPhongTypes, BGRASSE;
 { Creates a bitmap with the specified text horizontally centered and with a shadow }
+  Classes, BGRAGraphics, BGRABitmapTypes, BGRABitmap, BGRABlend, BGRAPhongTypes, BGRASSE;
+{$IFDEF BGRABITMAP_USE_LCL}{ Creates a bitmap with the specified text horizontally centered and with a shadow }
 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): TBGRABitmap;
+{$ENDIF}
 {----------------------------------------------------------------------}
 …
 implementation
 uses GraphType, Types, SysUtils, BGRATextFX; {GraphType unit used by phongdraw.inc}
 function TextShadow(AWidth, AHeight: Integer; AText: String;
+uses Types, SysUtils{$IFDEF BGRABITMAP_USE_LCL}, BGRATextFX{$ENDIF}; {GraphType unit used by phongdraw.inc}
+{$IFDEF BGRABITMAP_USE_LCL}function TextShadow(AWidth, AHeight: Integer; AText: String;
   AFontHeight: Integer; ATextColor, AShadowColor: TBGRAPixel; AOffSetX,
   AOffSetY: Integer; ARadius: Integer; AFontStyle: TFontStyles;
 …
 begin
   result := BGRATextFX.TextShadow(AWidth,AHeight,AText,AFontHeight,ATextColor,AShadowColor,AOffsetX,AOffsetY,ARadius,AFontStyle,AFontName,AShowText) as TBGRABitmap;
 end;
+end;{$ENDIF}
 function nGradientInfo(StartColor, StopColor: TBGRAPixel;
 …
   //antialiased border
   mask := TBGRABitmap.Create(width,height,BGRABlack);
   mask.FillPolyAntialias([PointF(rx,-0.5),PointF(0,height-0.5),PointF(width-0.5,height-0.5)],BGRAWhite);
+  mask.FillPolyAntialias([PointF(width/2,-0.5),PointF(0,height-0.5),PointF(width-0.5,height-0.5)],BGRAWhite);
   result.ApplyMask(mask);
   mask.Free;

GraphicTest/Packages/bgrabitmap/bgragradientscanner.pas

-              r472
+              r494
   private
     FColor1,FColor2: TBGRAPixel;
+    ec1,ec2: TExpandedPixel;
   public
     constructor Create(Color1,Color2: TBGRAPixel);
     function GetColorAt(position: integer): TBGRAPixel; override;
     function GetColorAtF(position: single): TBGRAPixel; override;
+    function GetExpandedColorAt(position: integer): TExpandedPixel; override;
+    function GetExpandedColorAtF(position: single): TExpandedPixel; override;
     function GetAverageColor: TBGRAPixel; override;
     function GetMonochrome: boolean; override;
 …
     function GetColorAtF(position: single): TBGRAPixel; override;
     function GetAverageColor: TBGRAPixel; override;
+    function GetExpandedColorAt(position: integer): TExpandedPixel; override;
+    function GetExpandedColorAtF(position: single): TExpandedPixel; override;
+    function GetAverageExpandedColor: TExpandedPixel; override;
     function GetMonochrome: boolean; override;
   end;
 …
   private
     FColor1,FColor2: TBGRAPixel;
+    ec1,ec2: TExpandedPixel;
     hsla1,hsla2: THSLAPixel;
     hue1,hue2: longword;
     FOptions: THueGradientOptions;
     procedure Init(c1,c2: THSLAPixel; AOptions: THueGradientOptions);
+    function GetColorNoBoundCheck(position: integer): THSLAPixel;
   public
     constructor Create(Color1,Color2: TBGRAPixel; options: THueGradientOptions); overload;
 …
     function GetColorAtF(position: single): TBGRAPixel; override;
     function GetAverageColor: TBGRAPixel; override;
+    function GetExpandedColorAt(position: integer): TExpandedPixel; override;
+    function GetExpandedColorAtF(position: single): TExpandedPixel; override;
+    function GetAverageExpandedColor: TExpandedPixel; override;
     function GetMonochrome: boolean; override;
   end;
+  TGradientInterpolationFunction = function(t: single): single of object;
   { TBGRAMultiGradient }
 …
     FEColors: array of TExpandedPixel;
     FCycle: Boolean;
+    FInterpolationFunction: TGradientInterpolationFunction;
     procedure Init(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection, ACycle: boolean);
   public
     GammaCorrection: boolean;
+    function CosineInterpolation(t: single): single;
+    function HalfCosineInterpolation(t: single): single;
     constructor Create(Colors: array of TBGRAPixel; Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean = false);
     function GetColorAt(position: integer): TBGRAPixel; override;
+    function GetExpandedColorAt(position: integer): TExpandedPixel; override;
     function GetAverageColor: TBGRAPixel; override;
     function GetMonochrome: boolean; override;
+    property InterpolationFunction: TGradientInterpolationFunction read FInterpolationFunction write FInterpolationFunction;
   end;
 …
     len,aFactor,aFactorF: single;
     mergedColor: TBGRAPixel;
+    mergedExpandedColor: TExpandedPixel;
     FGradient: TBGRACustomGradient;
     FGradientOwner: boolean;
     FHorizColor: TBGRAPixel;
+    FHorizExpandedColor: TExpandedPixel;
     FVertical: boolean;
     FDotProduct,FDotProductPerp: Single;
 …
     procedure InitScanInline(x,y: integer);
     function ScanNextInline: TBGRAPixel; inline;
+    function ScanNextExpandedInline: TExpandedPixel; inline;
   public
     constructor Create(c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF;
 …
     procedure ScanMoveTo(X, Y: Integer); override;
     function ScanNextPixel: TBGRAPixel; override;
+    function ScanNextExpandedPixel: TExpandedPixel; override;
     function ScanAt(X, Y: Single): TBGRAPixel; override;
+    function ScanAtExpanded(X, Y: Single): TExpandedPixel; override;
     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
     function IsScanPutPixelsDefined: boolean; override;
 …
     function ScanAt(X,Y: Single): TBGRAPixel; override;
     function ScanNextPixel: TBGRAPixel; override;
+    function ScanNextExpandedPixel: TExpandedPixel; override;
   end;
 …
     FScanNext : TScanNextPixelFunction;
     FScanAt : TScanAtFunction;
+    FMemMask: packed array of TBGRAPixel;
   public
     constructor Create(AMask: TBGRACustomBitmap; AOffset: TPoint; ASolidColor: TBGRAPixel);
 …
     FMaskScanAt,FTextureScanAt : TScanAtFunction;
     FGlobalOpacity: Byte;
+    FMemMask, FMemTex: packed array of TBGRAPixel;
   public
     constructor Create(AMask: TBGRACustomBitmap; AOffset: TPoint; ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255);
 …
       FScanNext : TScanNextPixelFunction;
       FScanAt : TScanAtFunction;
+      FMemTex: packed array of TBGRAPixel;
   public
     constructor Create(ATexture: IBGRAScanner; AGlobalOpacity: Byte = 255);
 …
 implementation
 uses BGRABlend;
+uses BGRABlend, Math;
 { TBGRAConstantScanner }
 …
   FColor1 := HSLAToBGRA(c1);
   FColor2 := HSLAToBGRA(c2);
+  ec1 := GammaExpansion(FColor1);
+  ec2 := GammaExpansion(FColor2);
   FOptions:= AOptions;
   if (hgoLightnessCorrection in AOptions) then
 …
 end;
+function TBGRAHueGradient.GetColorNoBoundCheck(position: integer): THSLAPixel;
+var b,b2: LongWord;
+begin
+  b      := position shr 2;
+  b2     := 16384-b;
+  result.hue := ((hue1 * b2 + hue2 * b + 8191) shr 14) and $ffff;
+  result.saturation := (hsla1.saturation * b2 + hsla2.saturation * b + 8191) shr 14;
+  result.lightness := (hsla1.lightness * b2 + hsla2.lightness * b + 8191) shr 14;
+  result.alpha := (hsla1.alpha * b2 + hsla2.alpha * b + 8191) shr 14;
+  if hgoLightnessCorrection in FOptions then
+  begin
+    if not (hgoHueCorrection in FOptions) then
+      result.hue := HtoG(result.hue);
+  end else
+  begin
+    if hgoHueCorrection in FOptions then
+      result.hue := GtoH(result.hue);
+  end;
+end;
 constructor TBGRAHueGradient.Create(Color1, Color2: TBGRAPixel;options: THueGradientOptions);
 begin
 …
 function TBGRAHueGradient.GetColorAt(position: integer): TBGRAPixel;
+var b,b2: cardinal;
+    interm: THSLAPixel;
+var interm: THSLAPixel;
 begin
   if hgoRepeat in FOptions then
 …
     end;
   end;
+  b      := position shr 2;
+  b2     := 16384-b;
+  interm.hue := ((hue1 * b2 + hue2 * b + 8191) shr 14) and $ffff;
+  interm.saturation := (hsla1.saturation * b2 + hsla2.saturation * b + 8191) shr 14;
+  interm.lightness := (hsla1.lightness * b2 + hsla2.lightness * b + 8191) shr 14;
+  interm.alpha := (hsla1.alpha * b2 + hsla2.alpha * b + 8191) shr 14;
+  interm := GetColorNoBoundCheck(position);
   if hgoLightnessCorrection in FOptions then
+  begin
+    if not (hgoHueCorrection in FOptions) then
+      interm.hue := HtoG(interm.hue);
+    result := GSBAToBGRA(interm);
+  end else
+  begin
+    if hgoHueCorrection in FOptions then
+      interm.hue := GtoH(interm.hue);
+    result := GSBAToBGRA(interm)
+  else
     result := HSLAToBGRA(interm);
-  end;
 end;
 function TBGRAHueGradient.GetColorAtF(position: single): TBGRAPixel;
+var b,b2: cardinal;
+    interm: THSLAPixel;
+var interm: THSLAPixel;
 begin
   if hgoRepeat in FOptions then
 …
     end;
   end;
+  b      := round(position*16384);
+  b2     := 16384-b;
+  interm.hue := ((hue1 * b2 + hue2 * b + 8191) shr 14) and $ffff;
+  interm.saturation := (hsla1.saturation * b2 + hsla2.saturation * b + 8191) shr 14;
+  interm.lightness := (hsla1.lightness * b2 + hsla2.lightness * b + 8191) shr 14;
+  interm.alpha := (hsla1.alpha * b2 + hsla2.alpha * b + 8191) shr 14;
+  interm := GetColorNoBoundCheck(round(position*65536));
   if hgoLightnessCorrection in FOptions then
+  begin
+    if not (hgoHueCorrection in FOptions) then
+      interm.hue := HtoG(interm.hue);
+    result := GSBAToBGRA(interm);
+  end else
+  begin
+    if hgoHueCorrection in FOptions then
+      interm.hue := GtoH(interm.hue);
+    result := GSBAToBGRA(interm)
+  else
     result := HSLAToBGRA(interm);
-  end;
 end;
 …
 begin
   Result:= GetColorAt(32768);
+end;
+function TBGRAHueGradient.GetExpandedColorAt(position: integer): TExpandedPixel;
+var interm: THSLAPixel;
+begin
+  if hgoRepeat in FOptions then
+  begin
+    position := position and $ffff;
+    if position = 0 then
+    begin
+      result := ec1;
+      exit;
+    end;
+  end else
+  begin
+    if position <= 0 then
+    begin
+      result := ec1;
+      exit
+    end else
+    if position >= 65536 then
+    begin
+      result := ec2;
+      exit
+    end;
+  end;
+  interm := GetColorNoBoundCheck(position);
+  if hgoLightnessCorrection in FOptions then
+    result := GSBAToExpanded(interm)
+  else
+    result := HSLAToExpanded(interm);
+end;
+function TBGRAHueGradient.GetExpandedColorAtF(position: single): TExpandedPixel;
+var interm: THSLAPixel;
+begin
+  if hgoRepeat in FOptions then
+  begin
+    position := frac(position);
+    if position = 0 then
+    begin
+      result := ec1;
+      exit;
+    end;
+  end else
+  begin
+    if position <= 0 then
+    begin
+      result := ec1;
+      exit;
+    end else
+    if position >= 1 then
+    begin
+      result := ec2;
+      exit
+    end;
+  end;
+  interm := GetColorNoBoundCheck(round(position*65536));
+  if hgoLightnessCorrection in FOptions then
+    result := GSBAToExpanded(interm)
+  else
+    result := HSLAToExpanded(interm);
+end;
+function TBGRAHueGradient.GetAverageExpandedColor: TExpandedPixel;
+begin
+  Result:= GetExpandedColorAt(32768);
 end;
 …
 end;
+function TBGRAMultiGradient.CosineInterpolation(t: single): single;
+begin
+  result := (1-cos(t*Pi))*0.5;
+end;
+function TBGRAMultiGradient.HalfCosineInterpolation(t: single): single;
+begin
+  result := (1-cos(t*Pi))*0.25 + t*0.5;
+end;
 constructor TBGRAMultiGradient.Create(Colors: array of TBGRAPixel;
   Positions0To1: array of single; AGammaCorrection: boolean; ACycle: boolean);
 …
 function TBGRAMultiGradient.GetColorAt(position: integer): TBGRAPixel;
 var i: integer;
+var i: NativeInt;
     ec: TExpandedPixel;
+    curPos,posDiff: NativeInt;
 begin
   if FCycle then
 …
   begin
     i := 0;
     while (i < high(FPositions)) and (position > FPositions[i+1]) do
+    while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do
       inc(i);
     if Position = FPositions[i+1] then
       result := FColors[i+1]
+    if Position = FPositions[i] then
+      result := FColors[i]
     else
+    if GammaCorrection then
+    begin
+      ec.red := FEColors[i].red + (position-FPositions[i])*(FEColors[i+1].red-FEColors[i].red) div (FPositions[i+1]-FPositions[i]);
+      ec.green := FEColors[i].green + (position-FPositions[i])*(FEColors[i+1].green-FEColors[i].green) div (FPositions[i+1]-FPositions[i]);
+      ec.blue := FEColors[i].blue + (position-FPositions[i])*(FEColors[i+1].blue-FEColors[i].blue) div (FPositions[i+1]-FPositions[i]);
+      ec.alpha := FEColors[i].alpha + (position-FPositions[i])*(FEColors[i+1].alpha-FEColors[i].alpha) div (FPositions[i+1]-FPositions[i]);
+      result := GammaCompression(ec);
+    end else
+    begin
+      result.red := FColors[i].red + (position-FPositions[i])*(FColors[i+1].red-FColors[i].red) div (FPositions[i+1]-FPositions[i]);
+      result.green := FColors[i].green + (position-FPositions[i])*(FColors[i+1].green-FColors[i].green) div (FPositions[i+1]-FPositions[i]);
+      result.blue := FColors[i].blue + (position-FPositions[i])*(FColors[i+1].blue-FColors[i].blue) div (FPositions[i+1]-FPositions[i]);
+      result.alpha := FColors[i].alpha + (position-FPositions[i])*(FColors[i+1].alpha-FColors[i].alpha) div (FPositions[i+1]-FPositions[i]);
+    begin
+      curPos := position-FPositions[i];
+      posDiff := FPositions[i+1]-FPositions[i];
+      if FInterpolationFunction <> nil then
+      begin
+        curPos := round(FInterpolationFunction(curPos/posDiff)*65536);
+        posDiff := 65536;
+      end;
+      if GammaCorrection then
+      begin
+        if FEColors[i+1].red < FEColors[i].red then
+          ec.red := FEColors[i].red - NativeUInt(curPos)*NativeUInt(FEColors[i].red-FEColors[i+1].red) div NativeUInt(posDiff) else
+          ec.red := FEColors[i].red + NativeUInt(curPos)*NativeUInt(FEColors[i+1].red-FEColors[i].red) div NativeUInt(posDiff);
+        if FEColors[i+1].green < FEColors[i].green then
+          ec.green := FEColors[i].green - NativeUInt(curPos)*NativeUInt(FEColors[i].green-FEColors[i+1].green) div NativeUInt(posDiff) else
+          ec.green := FEColors[i].green + NativeUInt(curPos)*NativeUInt(FEColors[i+1].green-FEColors[i].green) div NativeUInt(posDiff);
+        if FEColors[i+1].blue < FEColors[i].blue then
+          ec.blue := FEColors[i].blue - NativeUInt(curPos)*NativeUInt(FEColors[i].blue-FEColors[i+1].blue) div NativeUInt(posDiff) else
+          ec.blue := FEColors[i].blue + NativeUInt(curPos)*NativeUInt(FEColors[i+1].blue-FEColors[i].blue) div NativeUInt(posDiff);
+        if FEColors[i+1].alpha < FEColors[i].alpha then
+          ec.alpha := FEColors[i].alpha - NativeUInt(curPos)*NativeUInt(FEColors[i].alpha-FEColors[i+1].alpha) div NativeUInt(posDiff) else
+          ec.alpha := FEColors[i].alpha + NativeUInt(curPos)*NativeUInt(FEColors[i+1].alpha-FEColors[i].alpha) div NativeUInt(posDiff);
+        result := GammaCompression(ec);
+      end else
+      begin
+        result.red := FColors[i].red + (curPos)*(FColors[i+1].red-FColors[i].red) div (posDiff);
+        result.green := FColors[i].green + (curPos)*(FColors[i+1].green-FColors[i].green) div (posDiff);
+        result.blue := FColors[i].blue + (curPos)*(FColors[i+1].blue-FColors[i].blue) div (posDiff);
+        result.alpha := FColors[i].alpha + (curPos)*(FColors[i+1].alpha-FColors[i].alpha) div (posDiff);
+      end;
+    end;
+  end;
+end;
+function TBGRAMultiGradient.GetExpandedColorAt(position: integer
+  ): TExpandedPixel;
+var i: NativeInt;
+    curPos,posDiff: NativeInt;
+    rw,gw,bw: NativeUInt;
+begin
+  if FCycle then
+    position := (position-FPositions[0]) mod (FPositions[high(FPositions)] - FPositions[0]) + FPositions[0];
+  if position <= FPositions[0] then
+    result := FEColors[0] else
+  if position >= FPositions[high(FPositions)] then
+    result := FEColors[high(FColors)] else
+  begin
+    i := 0;
+    while (i < high(FPositions)-1) and (position >= FPositions[i+1]) do
+      inc(i);
+    if Position = FPositions[i] then
+      result := FEColors[i]
+    else
+    begin
+      curPos := position-FPositions[i];
+      posDiff := FPositions[i+1]-FPositions[i];
+      if FInterpolationFunction <> nil then
+      begin
+        curPos := round(FInterpolationFunction(curPos/posDiff)*65536);
+        posDiff := 65536;
+      end;
+      if GammaCorrection then
+      begin
+        if FEColors[i+1].red < FEColors[i].red then
+          result.red := FEColors[i].red - NativeUInt(curPos)*NativeUInt(FEColors[i].red-FEColors[i+1].red) div NativeUInt(posDiff) else
+          result.red := FEColors[i].red + NativeUInt(curPos)*NativeUInt(FEColors[i+1].red-FEColors[i].red) div NativeUInt(posDiff);
+        if FEColors[i+1].green < FEColors[i].green then
+          result.green := FEColors[i].green - NativeUInt(curPos)*NativeUInt(FEColors[i].green-FEColors[i+1].green) div NativeUInt(posDiff) else
+          result.green := FEColors[i].green + NativeUInt(curPos)*NativeUInt(FEColors[i+1].green-FEColors[i].green) div NativeUInt(posDiff);
+        if FEColors[i+1].blue < FEColors[i].blue then
+          result.blue := FEColors[i].blue - NativeUInt(curPos)*NativeUInt(FEColors[i].blue-FEColors[i+1].blue) div NativeUInt(posDiff) else
+          result.blue := FEColors[i].blue + NativeUInt(curPos)*NativeUInt(FEColors[i+1].blue-FEColors[i].blue) div NativeUInt(posDiff);
+        if FEColors[i+1].alpha < FEColors[i].alpha then
+          result.alpha := FEColors[i].alpha - NativeUInt(curPos)*NativeUInt(FEColors[i].alpha-FEColors[i+1].alpha) div NativeUInt(posDiff) else
+          result.alpha := FEColors[i].alpha + NativeUInt(curPos)*NativeUInt(FEColors[i+1].alpha-FEColors[i].alpha) div NativeUInt(posDiff);
+      end else
+      begin
+        rw := NativeInt(FColors[i].red shl 8) + (((curPos) shl 8)*(FColors[i+1].red-FColors[i].red)) div (posDiff);
+        gw := NativeInt(FColors[i].green shl 8) + (((curPos) shl 8)*(FColors[i+1].green-FColors[i].green)) div (posDiff);
+        bw := NativeInt(FColors[i].blue shl 8) + (((curPos) shl 8)*(FColors[i+1].blue-FColors[i].blue)) div (posDiff);
+        if rw >= $ff00 then result.red := $ffff
+        else result.red := (GammaExpansionTab[rw shr 8]*NativeUInt(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*NativeUInt(rw and 255)) shr 8;
+        if gw >= $ff00 then result.green := $ffff
+        else result.green := (GammaExpansionTab[gw shr 8]*NativeUInt(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*NativeUInt(gw and 255)) shr 8;
+        if bw >= $ff00 then result.blue := $ffff
+        else result.blue := (GammaExpansionTab[bw shr 8]*NativeUInt(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*NativeUInt(bw and 255)) shr 8;
+        result.alpha := NativeInt(FColors[i].alpha shl 8) + (((curPos) shl 8)*(FColors[i+1].alpha-FColors[i].alpha)) div (posDiff);
+        result.alpha := result.alpha + (result.alpha shr 8);
+      end;
     end;
   end;
 …
 end;
+function TBGRASimpleGradientWithGammaCorrection.GetExpandedColorAt(
+  position: integer): TExpandedPixel;
+var b,b2: cardinal;
+begin
+  if position <= 0 then
+    result := ec1 else
+  if position >= 65536 then
+    result := ec2 else
+  begin
+    b      := position;
+    b2     := 65536-b;
+    result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
+    result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
+    result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
+    result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
+  end;
+end;
+function TBGRASimpleGradientWithGammaCorrection.GetExpandedColorAtF(
+  position: single): TExpandedPixel;
+var b,b2: cardinal;
+begin
+  if position <= 0 then
+    result := ec1 else
+  if position >= 1 then
+    result := ec2 else
+  begin
+    b      := round(position*65536);
+    b2     := 65536-b;
+    result.red := (ec1.red * b2 + ec2.red * b + 32767) shr 16;
+    result.green := (ec1.green * b2 + ec2.green * b + 32767) shr 16;
+    result.blue := (ec1.blue * b2 + ec2.blue * b + 32767) shr 16;
+    result.alpha := (ec1.alpha * b2 + ec2.alpha * b + 32767) shr 16;
+  end;
+end;
+function TBGRASimpleGradientWithGammaCorrection.GetAverageExpandedColor: TExpandedPixel;
+begin
+  result := MergeBGRA(ec1,ec2);
+end;
 function TBGRASimpleGradientWithGammaCorrection.GetMonochrome: boolean;
 begin
 …
   FColor1 := Color1;
   FColor2 := Color2;
+  ec1 := GammaExpansion(Color1);
+  ec2 := GammaExpansion(Color2);
 end;
 …
 function TBGRASimpleGradientWithoutGammaCorrection.GetColorAtF(position: single): TBGRAPixel;
-var b,b2: cardinal;
 begin
   if position <= 0 then
 …
   if position >= 1 then
     result := FColor2 else
+  begin
+    b      := round(position*1024);
+    result := GetColorAt(round(position*65536));
+end;
+function TBGRASimpleGradientWithoutGammaCorrection.GetExpandedColorAt(
+  position: integer): TExpandedPixel;
+var b,b2: cardinal;
+    rw,gw,bw: word;
+begin
+  if position <= 0 then
+    result := ec1 else
+  if position >= 65536 then
+    result := ec2 else
+  begin
+    b      := position shr 6;
     b2     := 1024-b;
+    result.red  := (FColor1.red * b2 + FColor2.red * b + 511) shr 10;
+    result.green := (FColor1.green * b2 + FColor2.green * b + 511) shr 10;
+    result.blue := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 10;
+    result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 10;
+  end;
+    rw  := (FColor1.red * b2 + FColor2.red * b + 511) shr 2;
+    gw := (FColor1.green * b2 + FColor2.green * b + 511) shr 2;
+    bw := (FColor1.blue * b2 + FColor2.blue * b + 511) shr 2;
+    result.red := (GammaExpansionTab[rw shr 8]*NativeUInt(255 - (rw and 255)) + GammaExpansionTab[(rw shr 8)+1]*NativeUInt(rw and 255)) shr 8;
+    result.green := (GammaExpansionTab[gw shr 8]*NativeUInt(255 - (gw and 255)) + GammaExpansionTab[(gw shr 8)+1]*NativeUInt(gw and 255)) shr 8;
+    result.blue := (GammaExpansionTab[bw shr 8]*NativeUInt(255 - (bw and 255)) + GammaExpansionTab[(bw shr 8)+1]*NativeUInt(bw and 255)) shr 8;
+    result.alpha := (FColor1.alpha * b2 + FColor2.alpha * b + 511) shr 2;
+  end;
+end;
+function TBGRASimpleGradientWithoutGammaCorrection.GetExpandedColorAtF(
+  position: single): TExpandedPixel;
+begin
+  if position <= 0 then
+    result := ec1 else
+  if position >= 1 then
+    result := ec2 else
+    result := GetExpandedColorAt(round(position*65536));
 end;
 …
 end;
+function TBGRAGradientTriangleScanner.ScanNextExpandedPixel: TExpandedPixel;
+var r,g,b,a: int64;
+begin
+  r := round(FCurColor[1]);
+  g := round(FCurColor[2]);
+  b := round(FCurColor[3]);
+  a := round(FCurColor[4]);
+  if r > 65535 then r := 65535 else
+  if r < 0 then r := 0;
+  if g > 65535 then g := 65535 else
+  if g < 0 then g := 0;
+  if b > 65535 then b := 65535 else
+  if b < 0 then b := 0;
+  if a > 65535 then a := 65535 else
+  if a < 0 then a := 0;
+  result.red := r;
+  result.green := g;
+  result.blue := b;
+  result.alpha := a;
+  FCurColor += FStep;
+end;
 { TBGRAGradientScanner }
 …
   FVertical := (((gtype =gtLinear) or (gtype=gtReflected)) and (o1.x=o2.x)) or FGradient.Monochrome;
   mergedColor := FGradient.GetAverageColor;
+  mergedExpandedColor := FGradient.GetAverageExpandedColor;
 end;
 …
 end;
+function TBGRAGradientScanner.ScanNextExpandedInline: TExpandedPixel;
+var
+  a,a2: single;
+  ai: integer;
+begin
+  if FGradientType >= gtDiamond then
+  begin
+    if FGradientType = gtRadial then
+    begin
+      a := sqrt(sqr(FDotProduct) + sqr(FDotProductPerp));
+      FDotProduct += u.x;
+      FDotProductPerp += u.y;
+    end else
+    begin
+      a   := abs(FDotProduct);
+      a2  := abs(FDotProductPerp);
+      if a2 > a then a := a2;
+      FDotProduct += u.x;
+      FDotProductPerp += u.y;
+    end;
+  end else
+  if FGradientType = gtReflected then
+  begin
+    a := abs(FDotProduct);
+    FDotProduct += u.x;
+  end else
+  begin
+    a := FDotProduct;
+    FDotProduct += u.x;
+  end;
+  if FSinus then
+  begin
+    a *= aFactor;
+    if a <= low(int64) then
+      result := FGradient.GetAverageExpandedColor
+    else
+    if a >= high(int64) then
+      result := FGradient.GetAverageExpandedColor
+    else
+    begin
+      ai := Sin65536(round(a));
+      result := FGradient.GetExpandedColorAt(ai);
+    end;
+  end else
+    result := FGradient.GetExpandedColorAtF(a*aFactorF);
+end;
 constructor TBGRAGradientScanner.Create(c1, c2: TBGRAPixel;
   gtype: TGradientType; o1, o2: TPointF; gammaColorCorrection: boolean;
 …
   InitScanInline(X,Y);
   if FVertical then
+  begin
     FHorizColor := ScanNextInline;
+    FHorizExpandedColor := ScanNextExpandedInline;
+  end;
 end;
 …
   else
     result := ScanNextInline;
+end;
+function TBGRAGradientScanner.ScanNextExpandedPixel: TExpandedPixel;
+begin
+  if FVertical then
+    result := FHorizExpandedColor
+  else
+    result := ScanNextExpandedInline;
 end;
 …
   begin
     a := a*aFactor;
+    if a <= low(int64) then
+      result := FGradient.GetAverageColor
+    else
+    if a >= high(int64) then
+      result := FGradient.GetAverageColor
+    if (a <= low(int64)) or (a >= high(int64)) then
+      result := mergedColor
     else
     begin
 …
   end else
     result := FGradient.GetColorAtF(a*aFactorF);
+end;
+function TBGRAGradientScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel;
+var p: TPointF;
+    a,a2: single;
+    ai: integer;
+begin
+  if len = 0 then
+  begin
+    result := mergedExpandedColor;
+    exit;
+  end;
+  p.x := X - FOrigin1.x;
+  p.y := Y - FOrigin1.y;
+  case FGradientType of
+    gtLinear:    a := p.x * u.x + p.y * u.y;
+    gtReflected: a := abs(p.x * u.x + p.y * u.y);
+    gtDiamond:
+        begin
+          a   := abs(p.x * u.x + p.y * u.y);
+          a2  := abs(p.x * u.y - p.y * u.x);
+          if a2 > a then a := a2;
+        end;
+    gtRadial:    a := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
+  end;
+  if FSinus then
+  begin
+    a := a*aFactor;
+    if (a <= low(int64)) or (a >= high(int64)) then
+      result := mergedExpandedColor
+    else
+    begin
+      ai := Sin65536(round(a));
+      result := FGradient.GetExpandedColorAt(ai);
+    end;
+  end else
+    result := FGradient.GetExpandedColorAtF(a*aFactorF);
 end;
 …
 var c: TBGRAPixel;
     alpha: byte;
     MemMask, pmask, MemTex, ptex: pbgrapixel;
+    pmask, ptex: pbgrapixel;
   function GetNext: TBGRAPixel; inline;
 …
 begin
   getmem(MemMask, count*sizeof(TBGRAPixel));
   ScannerPutPixels(FMask,MemMask,count,dmSet);
   getmem(MemTex, count*sizeof(TBGRAPixel));
   ScannerPutPixels(FTexture,MemTex,count,dmSet);
   pmask := MemMask;
   ptex := MemTex;
+  if count > length(FMemMask) then setlength(FMemMask, max(length(FMemMask)*2,count));
+  if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count));
+  ScannerPutPixels(FMask,@FMemMask[0],count,dmSet);
+  ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet);
+  pmask := @FMemMask[0];
+  ptex := @FMemTex[0];
   if FGlobalOpacity <> 255 then
 …
     end;
   end;
-  freemem(MemMask);
-  freemem(MemTex);
 end;
 …
 var c: TBGRAPixel;
     alpha: byte;
     MemMask, pmask: pbgrapixel;
+    pmask: pbgrapixel;
   function GetNext: TBGRAPixel; inline;
 …
 begin
   getmem(MemMask, count*sizeof(TBGRAPixel));
   ScannerPutPixels(FMask,MemMask,count,dmSet);
   pmask := MemMask;
+  if count > length(FMemMask) then setlength(FMemMask, max(length(FMemMask)*2,count));
+  ScannerPutPixels(FMask,@FMemMask[0],count,dmSet);
+  pmask := @FMemMask[0];
   case mode of
 …
       end;
   end;
-  freemem(MemMask);
 end;
 …
   mode: TDrawMode);
 var c: TBGRAPixel;
     MemTex, ptex: pbgrapixel;
+    ptex: pbgrapixel;
   function GetNext: TBGRAPixel; inline;
 …
 begin
   getmem(MemTex, count*sizeof(TBGRAPixel));
   ScannerPutPixels(FTexture,MemTex,count,dmSet);
   ptex := MemTex;
+  if count > length(FMemTex) then setlength(FMemTex, max(length(FMemTex)*2,count));
+  ScannerPutPixels(FTexture,@FMemTex[0],count,dmSet);
+  ptex := @FMemTex[0];
   case mode of
 …
       end;
   end;
-  freemem(MemTex);
 end;

GraphicTest/Packages/bgrabitmap/bgragrayscalemask.pas

-              r472
+              r494
 procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect);
+procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
+  y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
+  texture: IBGRAScanner; RGBOrder: boolean);
 implementation
+uses GraphType, BGRABlend;
+uses BGRABlend;
+procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
+  y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
+  texture: IBGRAScanner; RGBOrder: boolean);
+var delta: NativeInt;
+begin
+  delta := mask.Width;
+  BGRABlend.BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLine[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder);
+end;
 { TGrayscaleMask }
 …
     pdest := FData;
     Case AChannel of
       cAlpha: ofs := 3;
       cRed: ofs := 2;
       cGreen: ofs := 1;
+      cAlpha: ofs := TBGRAPixel_AlphaByteOffset;
+      cRed: ofs := TBGRAPixel_RedByteOffset;
+      cGreen: ofs := TBGRAPixel_GreenByteOffset;
     else
       ofs := 0;
+      ofs := TBGRAPixel_BlueByteOffset;
     end;
     for y := 0 to FHeight-1 do

GraphicTest/Packages/bgrabitmap/bgragtkbitmap.pas

-              r472
+              r494
 uses
   Classes, SysUtils, BGRADefaultBitmap, Graphics,
+  Classes, SysUtils, BGRALCLBitmap, Graphics,
   GraphType;
 …
   { TBGRAGtkBitmap }
   TBGRAGtkBitmap = class(TBGRADefaultBitmap)
+  TBGRAGtkBitmap = class(TBGRALCLBitmap)
   private
     FPixBuf: Pointer;
-{    procedure SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
-      ACanvas: TCanvas; ARect: TRect);}
     procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect);
     procedure DrawOpaque(ACanvas: TCanvas; Rect: TRect);
 …
 implementation
 uses BGRABitmapTypes, LCLType,
+uses BGRABitmapTypes, BGRADefaultBitmap, LCLType,
   LCLIntf, IntfGraphics,
   {$IFDEF LCLgtk2}
 …
 type TGtkDeviceContext = TGtk2DeviceContext;
 {$ENDIF}
-{procedure TBGRAGtkBitmap.SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
-  ACanvas: TCanvas; ARect: TRect);
-var
-  background, temp: TBGRACustomBitmap;
-  w, h: integer;
-begin
-  w := ARect.Right - ARect.Left;
-  h := ARect.Bottom - ARect.Top;
-  background := NewBitmap(w, h);
-  background.GetImageFromCanvas(ACanvas, ARect.Left, ARect.Top);
-  if (ABitmap.Width = w) and (ABitmap.Height = h) then
-    background.PutImage(0, 0, ABitmap, dmDrawWithTransparency)
-  else
-  begin
-    temp := ABitmap.Resample(w, h, rmSimpleStretch);
-    background.PutImage(0, 0, temp, dmDrawWithTransparency);
-    temp.Free;
-  end;
-  background.Draw(ACanvas, ARect.Left, ARect.Top, True);
-  background.Free;
-end;}
 procedure TBGRAGtkBitmap.ReallocData;
 …
   end;
   SwapRedBlue;
+  If not TBGRAPixel_RGBAOrder then SwapRedBlue;
   P := Rect.TopLeft;
 …
     GDK_RGB_DITHER_NORMAL,0,0);
   SwapRedBlue;
+  If not TBGRAPixel_RGBAOrder then SwapRedBlue;
 end;
 …
   LPtoDP(dest, pos, 1);
   If ALineOrder = riloBottomToTop then VerticalFlip;
   SwapRedBlue;
+  If not TBGRAPixel_RGBAOrder then SwapRedBlue;
   gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable,
     TGtkDeviceContext(Dest).GC, pos.x,pos.y,
     AWidth,AHeight, GDK_RGB_DITHER_NORMAL,
     AData, AWidth*sizeof(TBGRAPixel));
   SwapRedBlue;
+  If not TBGRAPixel_RGBAOrder then SwapRedBlue;
   If ALineOrder = riloBottomToTop then VerticalFlip;
 end;
 …
     TGtkDeviceContext(CanvasSource.Handle).Drawable,
     nil, P.X,P.Y,0,0,Width,Height);
   SwapRedBlue;
+  If not TBGRAPixel_RGBAOrder then SwapRedBlue;
   InvalidateBitmap;
 end;

GraphicTest/Packages/bgrabitmap/bgralayers.pas

-              r472
+              r494
 uses
   Graphics, Classes, SysUtils, Types, BGRABitmapTypes, BGRABitmap;
+  BGRAGraphics, Classes, SysUtils, Types, BGRABitmapTypes, BGRABitmap;
 type
 …
 implementation
 uses LCLProc;
+uses BGRAUTF8;
 var

GraphicTest/Packages/bgrabitmap/bgramatrix3d.pas

-              r472
+              r494
 {$i bgrasse.inc}
+{$ifdef BGRASSE_AVAILABLE}
+{$ifdef CPUI386}
   {$asmmode intel}
+{$endif}
+{$ENDIF}
+{$ifdef cpux86_64}
+  {$asmmode intel}
+{$ENDIF}
 interface
 uses
+  BGRABitmapTypes, BGRASSE;
+  BGRABitmapTypes, BGRASSE,
+  BGRATransform;
 type
   TMatrix3D = packed array[1..3,1..4] of single;
+  TMatrix4D = packed array[1..4,1..4] of single;
   TProjection3D = packed record
     Zoom, Center: TPointF;
   end;
+  TComputeProjectionFunc = function(AViewCoord: TPoint3D_128): TPointF of object;
 operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D;
 …
 function MatrixRotateZ(angle: single): TMatrix3D;
+operator *(const A, B: TMatrix4D): TMatrix4D;
+function MatrixIdentity4D: TMatrix4D;
+function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D;
 {$IFDEF BGRASSE_AVAILABLE}
 procedure Matrix3D_SSE_Load(const A: TMatrix3D);
 …
 implementation
 procedure multiplyVectInline(const A : TMatrix3D; const vx,vy,vz,vt: single; out outx,outy,outz: single);
+procedure multiplyVect3(const A : TMatrix3D; const vx,vy,vz,vt: single; out outx,outy,outz: single);
 begin
   outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4];
 …
 end;
+procedure multiplyVect4(const A : TMatrix4D; const vx,vy,vz,vt: single; out outx,outy,outz,outt: single);
+begin
+  outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4];
+  outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4];
+  outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4];
+  outt := vx * A[4,1] + vy * A[4,2] + vz * A[4,3] + vt * A[4,4];
+end;
 operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D;
 begin
 …
   result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4];
   result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4];
+end;
+operator*(const A, B: TMatrix4D): TMatrix4D;
+begin
+  multiplyVect4(A, B[1,1],B[2,1],B[3,1],B[4,1], result[1,1],result[2,1],result[3,1],result[4,1]);
+  multiplyVect4(A, B[1,2],B[2,2],B[3,2],B[4,2], result[1,2],result[2,2],result[3,2],result[4,2]);
+  multiplyVect4(A, B[1,3],B[2,3],B[3,3],B[4,3], result[1,3],result[2,3],result[3,3],result[4,3]);
+  multiplyVect4(A, B[1,4],B[2,4],B[3,4],B[4,4], result[1,4],result[2,4],result[3,4],result[4,4]);
+end;
+function MatrixIdentity4D: TMatrix4D;
+begin
+  result[1,1] := 1;  result[2,1] := 0;  result[3,1] := 0; result[4,1] := 0;
+  result[1,2] := 0;  result[2,2] := 1;  result[3,2] := 0; result[4,2] := 0;
+  result[1,3] := 0;  result[2,3] := 0;  result[3,3] := 1; result[4,3] := 0;
+  result[1,4] := 0;  result[2,4] := 0;  result[3,4] := 0; result[4,4] := 1;
+end;
+function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D;
+begin
+  result[1,1] := AValue[1,1];  result[2,1] := AValue[1,2];  result[3,1] := 0; result[4,1] := AValue[1,3];
+  result[1,2] := AValue[2,1];  result[2,2] := AValue[2,2];  result[3,2] := 0; result[4,2] := AValue[2,3];
+  result[1,3] := 0;            result[2,3] := 0;            result[3,3] := 1; result[4,3] := 0;
+  result[1,4] := 0;            result[2,4] := 0;            result[3,4] := 0; result[4,4] := 1;
 end;
 …
 operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
 {$IFDEF CPUI386}var oldMt: single; {$ENDIF}
 begin
   {$IFDEF CPUI386}
+{$IFDEF BGRASSE_AVAILABLE}var oldMt: single; {$ENDIF}
+begin
+  {$IFDEF BGRASSE_AVAILABLE}
   if UseSSE then
   begin
 …
 function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128;
 begin
   {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
   if UseSSE then
   begin
 …
 operator*(A,B: TMatrix3D): TMatrix3D;
 begin
   multiplyVectInline(A, B[1,1],B[2,1],B[3,1],0, result[1,1],result[2,1],result[3,1]);
   multiplyVectInline(A, B[1,2],B[2,2],B[3,2],0, result[1,2],result[2,2],result[3,2]);
   multiplyVectInline(A, B[1,3],B[2,3],B[3,3],0, result[1,3],result[2,3],result[3,3]);
   multiplyVectInline(A, B[1,4],B[2,4],B[3,4],1, result[1,4],result[2,4],result[3,4]);
+  multiplyVect3(A, B[1,1],B[2,1],B[3,1],0, result[1,1],result[2,1],result[3,1]);
+  multiplyVect3(A, B[1,2],B[2,2],B[3,2],0, result[1,2],result[2,2],result[3,2]);
+  multiplyVect3(A, B[1,3],B[2,3],B[3,3],0, result[1,3],result[2,3],result[3,3]);
+  multiplyVect3(A, B[1,4],B[2,4],B[3,4],1, result[1,4],result[2,4],result[3,4]);
 end;

GraphicTest/Packages/bgrabitmap/bgraopenraster.pas

-              r472
+              r494
 implementation
 uses Graphics, XMLRead, XMLWrite, FPReadPNG, dialogs, BGRABitmapTypes, zstream, lazutf8classes,
+uses XMLRead, XMLWrite, FPReadPNG, BGRABitmapTypes, zstream, BGRAUTF8,
   UnzipperExt;
 …
 function TFPReaderOpenRaster.InternalCheck(Stream: TStream): boolean;
 var {%h-}magic: packed array[0..3] of byte;
+var magic: packed array[0..3] of byte;
   OldPos,BytesRead: Int64;
   doc : TBGRAOpenRasterDocument;
 …
   if Stream=nil then exit;
   oldPos := stream.Position;
+  BytesRead := Stream.Read({%h-}magic,sizeof(magic));
+  {$PUSH}{$HINTS OFF}
+  BytesRead := Stream.Read(magic,sizeof(magic));
+  {$POP}
   stream.Position:= OldPos;
   if BytesRead<>sizeof(magic) then exit;
 …
               BlendOperation[idx] := boOverlay else
             if opstr = 'svg:soft-light' then
               BlendOperation[idx] := boSoftLight else
+              BlendOperation[idx] := boSvgSoftLight else
             if opstr = 'svg:hard-light' then
               BlendOperation[idx] := boHardLight else
 …
             if opstr = 'krita:divide' then
               BlendOperation[idx] := boDivide else
+            if opstr = 'bgra:soft-light' then
+              BlendOperation[idx] := boSoftLight else
             if opstr = 'bgra:nice-glow' then
               BlendOperation[idx] := boNiceGlow else
 …
               BlendOperation[idx] := boXor else
             begin
+              messagedlg('Unknown blend operation : ' + attr.NodeValue,mtInformation,[mbOk],0);
+              //messagedlg('Unknown blend operation : ' + attr.NodeValue,mtInformation,[mbOk],0);
+              BlendOperation[idx] := boTransparent;
             end;
           end;
 …
         boMultiply: strval := 'svg:multiply';
         boOverlay, boDarkOverlay: strval := 'svg:overlay';
         boSoftLight: strval := 'svg:soft-light';
+        boSoftLight: strval := 'bgra:soft-light';
         boHardLight: strval := 'svg:hard-light';
         boDifference,boLinearDifference: strval := 'svg:difference';
 …
         boLinearNegation,boNegation: strval := 'bgra:negation';
         boXor: strval := 'bgra:xor';
+        boSvgSoftLight: strval := 'svg:soft-light';
         else strval := 'svg:src-over';
       end;

GraphicTest/Packages/bgrabitmap/bgrapaintnet.pas

-              r472
+              r494
 implementation
 uses zstream, Math, graphtype, Graphics, lazutf8classes, FileUtil;
+uses zstream, Math, BGRAUTF8;
 {$hints off}
 …
   Stream.Position:= Stream.Position + XmlHeaderSize;
      {$hints off}
   stream.Read(CompressionFormat, sizeof(CompressionFormat));
+  stream.ReadBuffer(CompressionFormat, sizeof(CompressionFormat));
      {$hints on}
   CompressionFormat := LEToN(CompressionFormat);
 …
     begin
         {$hints off}
       LayerData[i].Read(b, 1);
+      LayerData[i].ReadBuffer(b, 1);
         {$hints on}
       Result += IntToHex(b, 2) + ' ';
 …
     layerData[layer].Position := 0;
     layerData[layer].Read(Result.Data^, LayerData[layer].Size);
+    if TBGRAPixel_RGBAOrder then result.SwapRedBlue;
     Result.InvalidateBitmap;
 …
 begin
   {$hints off}
   src.Read(CompressionFlag, 1);
+  src.ReadBuffer(CompressionFlag, 1);
   {$hints on}
   if CompressionFlag = 1 then

GraphicTest/Packages/bgrabitmap/bgrapalette.pas

-              r472
+              r494
 type
+  TBGRAIndexedPaletteEntry = packed record
+    Color: TBGRAPixel;
+    Index: UInt32;
+  end;
+  PBGRAIndexedPaletteEntry = ^TBGRAIndexedPaletteEntry;
   TBGRAWeightedPaletteEntry = packed record
     Color: TBGRAPixel;
 …
   ArrayOfWeightedColor = array of TBGRAWeightedPaletteEntry;
+  TBGRAPixelComparer = function (p1,p2 : PBGRAPixel): boolean;
   { TBGRACustomPalette }
   TBGRACustomPalette = class
+  private
+    function GetDominantColor: TBGRAPixel;
   protected
     function GetCount: integer; virtual; abstract;
 …
     procedure AssignTo(AImage: TFPCustomImage); overload;
     procedure AssignTo(APalette: TFPPalette); overload;
+    property DominantColor: TBGRAPixel read GetDominantColor;
     property Count: integer read GetCount;
     property Color[AIndex: integer]: TBGRAPixel read GetColorByIndex;
 …
   public
     constructor Create(ABitmap: TBGRACustomBitmap); virtual; overload;
+    constructor Create(APalette: TBGRACustomPalette); virtual; overload;
+    constructor Create(AColors: ArrayOfTBGRAPixel); virtual; overload;
+    constructor Create(AColors: ArrayOfWeightedColor); virtual; overload;
     function AddColor(AValue: TBGRAPixel): boolean; virtual;
+    procedure AddColors(ABitmap: TBGRACustomBitmap); virtual; overload;
+    procedure AddColors(APalette: TBGRACustomPalette); virtual; overload;
     function RemoveColor(AValue: TBGRAPixel): boolean; virtual;
     procedure LoadFromFile(AFilenameUTF8: string); virtual;
 …
   end;
+  { TBGRAIndexedPalette }
+  TBGRAIndexedPalette = class(TBGRAPalette)
+  private
+    FCurrentIndex: UInt32;
+  protected
+    procedure NeedArray; override;
+    function CreateEntry(AColor: TBGRAPixel): PBGRAPixel; override;
+    procedure FreeEntry(AEntry: PBGRAPixel); override;
+  public
+    function RemoveColor({%H-}AValue: TBGRAPixel): boolean; override;
+    function IndexOfColor(AValue: TBGRAPixel): integer; override;
+    procedure Clear; override;
+  end;
   { TBGRAWeightedPalette }
 …
     procedure IncludePixel(PPixel: PBGRAPixel); override;
   public
+    constructor Create(AColors: ArrayOfWeightedColor); override;
     function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override;
     function IncColor(AValue: TBGRAPixel; out NewWeight: UInt32): boolean;
 …
   TBGRACustomApproxPalette = class(TBGRACustomPalette)
   private
+    function FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel;
+    function FindNearestColorIgnoreAlpha(AValue: TBGRAPixel): TBGRAPixel; inline;
+    function FindNearestColorIndexIgnoreAlpha(AValue: TBGRAPixel): integer; inline;
+  protected
+    function GetWeightByIndex({%H-}AIndex: Integer): UInt32; virtual;
   public
     function FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel; overload;
+    function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; virtual; abstract;
+    function FindNearestColorIndex(AValue: TBGRAPixel): integer; virtual; abstract;
+  end;
+    function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; virtual; abstract; overload;
+    function FindNearestColorIndex(AValue: TBGRAPixel; AIgnoreAlpha: boolean): integer; overload;
+    function FindNearestColorIndex(AValue: TBGRAPixel): integer; virtual; abstract; overload;
+    property Weight[AIndex: Integer]: UInt32 read GetWeightByIndex;
+  end;
+  { TBGRA16BitPalette }
+  TBGRA16BitPalette = class(TBGRACustomApproxPalette)
+  protected
+    function GetCount: integer; override;
+    function GetColorByIndex(AIndex: integer): TBGRAPixel; override;
+  public
+    function ContainsColor(AValue: TBGRAPixel): boolean; override;
+    function IndexOfColor(AValue: TBGRAPixel): integer; override;
+    function GetAsArrayOfColor: ArrayOfTBGRAPixel; override;
+    function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override;
+    function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override;
+    function FindNearestColorIndex(AValue: TBGRAPixel): integer; override;
+  end;
+  { TBGRACustomColorQuantizer }
+  TBGRACustomColorQuantizer = class
+  protected
+    function GetDominantColor: TBGRAPixel; virtual;
+    function GetPalette: TBGRACustomApproxPalette; virtual; abstract;
+    function GetSourceColor(AIndex: integer): TBGRAPixel; virtual; abstract;
+    function GetSourceColorCount: Integer; virtual; abstract;
+    function GetReductionColorCount: integer; virtual; abstract;
+    procedure SetReductionColorCount(AValue: Integer); virtual; abstract;
+  public
+    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); virtual; abstract; overload;
+    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); virtual; abstract; overload;
+    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); virtual; abstract; overload;
+    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); virtual; abstract; overload;
+    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); virtual; abstract; overload;
+    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap); overload;
+    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; virtual; abstract; overload;
+    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap; overload;
+    procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string); overload;
+    procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string; AFormat: TBGRAImageFormat); overload;
+    procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); virtual; abstract;
+    function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; overload;
+    function GetDitheredBitmapIndexedData(ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): Pointer; overload;
+    function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm;
+      ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; virtual; abstract; overload;
+    property SourceColorCount: Integer read GetSourceColorCount;
+    property SourceColor[AIndex: integer]: TBGRAPixel read GetSourceColor;
+    property ReductionColorCount: Integer read GetReductionColorCount write SetReductionColorCount;
+    property ReducedPalette: TBGRACustomApproxPalette read GetPalette;
+    property DominantColor: TBGRAPixel read GetDominantColor;
+  end;
+  TBGRAColorQuantizerAny = class of TBGRACustomColorQuantizer;
+var
+  BGRAColorQuantizerFactory: TBGRAColorQuantizerAny;
 function BGRARequiredBitDepth(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption): integer; overload;
 …
 function BGRARegisteredPaletteFormatFilter(AAllSupportedDescription: string) : string;
+procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
 implementation
+uses lazutf8classes, bufstream;
+uses BGRAUTF8, bufstream;
+function IsDWordGreater(p1, p2: PBGRAPixel): boolean;
+begin
+  result := DWord(p1^) > DWord(p2^);
+end;
+const
+  InsertionSortLimit = 10;
+procedure ArrayOfWeightedColor_InsertionSort(AColors: ArrayOfWeightedColor; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+var i,j,insertPos: NativeInt;
+  compared: TBGRAWeightedPaletteEntry;
+begin
+  if AComparer = nil then AComparer := @IsDWordGreater;
+  for i := AMinIndex+1 to AMaxIndex do
+  begin
+    insertPos := i;
+    compared := AColors[i];
+    while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1].Color,@compared.Color) do
+      dec(insertPos);
+    if insertPos <> i then
+    begin
+      for j := i downto insertPos+1 do
+        AColors[j] := AColors[j-1];
+      AColors[insertPos] := compared;
+    end;
+  end;
+end;
+procedure ArrayOfWeightedColor_QuickSort(AColors: ArrayOfWeightedColor; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+var Pivot: TBGRAPixel;
+  CurMin,CurMax,i : NativeInt;
+  procedure Swap(a,b: NativeInt);
+  var Temp: TBGRAWeightedPaletteEntry;
+  begin
+    if a = b then exit;
+    Temp := AColors[a];
+    AColors[a] := AColors[b];
+    AColors[b] := Temp;
+  end;
+begin
+  if AComparer = nil then AComparer := @IsDWordGreater;
+  if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then
+  begin
+    ArrayOfWeightedColor_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer);
+    exit;
+  end;
+  Pivot := AColors[(AMinIndex+AMaxIndex) shr 1].Color;
+  CurMin := AMinIndex;
+  CurMax := AMaxIndex;
+  i := CurMin;
+  while i < CurMax do
+  begin
+    if AComparer(@AColors[i].Color, @Pivot) then
+    begin
+      Swap(i, CurMax);
+      dec(CurMax);
+    end else
+    begin
+      if AComparer(@Pivot, @AColors[i].Color) then
+      begin
+        Swap(i, CurMin);
+        inc(CurMin);
+      end;
+      inc(i);
+    end;
+  end;
+  if AComparer(@Pivot, @AColors[i].Color) then
+  begin
+    Swap(i, CurMin);
+    inc(CurMin);
+  end;
+  if CurMin > AMinIndex then ArrayOfWeightedColor_QuickSort(AColors,AMinIndex,CurMin,AComparer);
+  if CurMax < AMaxIndex then ArrayOfWeightedColor_QuickSort(AColors,CurMax,AMaxIndex,AComparer);
+end;
+procedure ArrayOfTBGRAPixel_InsertionSort(AColors: ArrayOfTBGRAPixel; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+var i,j,insertPos: NativeInt;
+  compared: TBGRAPixel;
+begin
+  if AComparer = nil then AComparer := @IsDWordGreater;
+  for i := AMinIndex+1 to AMaxIndex do
+  begin
+    insertPos := i;
+    compared := AColors[i];
+    while (insertPos > AMinIndex) and AComparer(@AColors[insertPos-1],@compared) do
+      dec(insertPos);
+    if insertPos <> i then
+    begin
+      for j := i downto insertPos+1 do
+        AColors[j] := AColors[j-1];
+      AColors[insertPos] := compared;
+    end;
+  end;
+end;
+procedure ArrayOfTBGRAPixel_QuickSort(AColors: ArrayOfTBGRAPixel; AMinIndex,
+  AMaxIndex: NativeInt; AComparer: TBGRAPixelComparer = nil);
+var Pivot: TBGRAPixel;
+  CurMin,CurMax,i : NativeInt;
+  procedure Swap(a,b: NativeInt);
+  var Temp: TBGRAPixel;
+  begin
+    if a = b then exit;
+    Temp := AColors[a];
+    AColors[a] := AColors[b];
+    AColors[b] := Temp;
+  end;
+begin
+  if AComparer = nil then AComparer := @IsDWordGreater;
+  if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then
+  begin
+    ArrayOfTBGRAPixel_InsertionSort(AColors,AMinIndex,AMaxIndex,AComparer);
+    exit;
+  end;
+  Pivot := AColors[(AMinIndex+AMaxIndex) shr 1];
+  CurMin := AMinIndex;
+  CurMax := AMaxIndex;
+  i := CurMin;
+  while i < CurMax do
+  begin
+    if AComparer(@AColors[i], @Pivot) then
+    begin
+      Swap(i, CurMax);
+      dec(CurMax);
+    end else
+    begin
+      if AComparer(@Pivot, @AColors[i]) then
+      begin
+        Swap(i, CurMin);
+        inc(CurMin);
+      end;
+      inc(i);
+    end;
+  end;
+  if AComparer(@Pivot, @AColors[i]) then
+  begin
+    Swap(i, CurMin);
+    inc(CurMin);
+  end;
+  if CurMin > AMinIndex then ArrayOfTBGRAPixel_QuickSort(AColors,AMinIndex,CurMin,AComparer);
+  if CurMax < AMaxIndex then ArrayOfTBGRAPixel_QuickSort(AColors,CurMax,AMaxIndex,AComparer);
+end;
 {$i paletteformats.inc}
 …
 end;
+{ TBGRA16BitPalette }
+function TBGRA16BitPalette.GetCount: integer;
+begin
+  result := 65537;
+end;
+function TBGRA16BitPalette.GetColorByIndex(AIndex: integer): TBGRAPixel;
+begin
+  if (AIndex >= 65536) or (AIndex < 0) then
+    result := BGRAPixelTransparent
+  else
+    result := Color16BitToBGRA(AIndex);
+end;
+function TBGRA16BitPalette.ContainsColor(AValue: TBGRAPixel): boolean;
+begin
+  if AValue.alpha = 0 then
+    result := true
+  else
+    result := (AValue.alpha = 255) and (FindNearestColor(AValue)=AValue);
+end;
+function TBGRA16BitPalette.IndexOfColor(AValue: TBGRAPixel): integer;
+var idx: integer;
+begin
+  if AValue.Alpha = 0 then
+    result := 65536
+  else
+  begin
+    idx := BGRAToColor16Bit(AValue);
+    if Color16BitToBGRA(idx)=AValue then
+      result := idx
+    else
+      result := -1;
+  end;
+end;
+function TBGRA16BitPalette.GetAsArrayOfColor: ArrayOfTBGRAPixel;
+begin
+  result := nil;
+  raise exception.Create('Palette too big');
+end;
+function TBGRA16BitPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor;
+begin
+  result := nil;
+  raise exception.Create('Palette too big');
+end;
+function TBGRA16BitPalette.FindNearestColor(AValue: TBGRAPixel): TBGRAPixel;
+begin
+  if AValue.alpha = 0 then result := BGRAPixelTransparent
+  else
+    result := GetColorByIndex(BGRAToColor16Bit(AValue));
+end;
+function TBGRA16BitPalette.FindNearestColorIndex(AValue: TBGRAPixel): integer;
+begin
+  result := BGRAToColor16Bit(AValue);
+end;
+{ TBGRAIndexedPalette }
+procedure TBGRAIndexedPalette.NeedArray;
+var Node: TAvgLvlTreeNode;
+  n: UInt32;
+begin
+  n := Count;
+  if UInt32(length(FArray)) <> n then
+  begin
+    setLength(FArray,n);
+    for Node in FTree do
+    with PBGRAIndexedPaletteEntry(Node.Data)^ do
+    begin
+      if Index < n then //index is unsigned so always >= 0
+        FArray[Index] := @Color;
+    end;
+  end;
+end;
+function TBGRAIndexedPalette.CreateEntry(AColor: TBGRAPixel): PBGRAPixel;
+begin
+  result := PBGRAPixel(GetMem(sizeOf(TBGRAIndexedPaletteEntry)));
+  result^ := AColor;
+  PBGRAIndexedPaletteEntry(result)^.Index := FCurrentIndex;
+  Inc(FCurrentIndex);
+end;
+procedure TBGRAIndexedPalette.FreeEntry(AEntry: PBGRAPixel);
+begin
+  FreeMem(AEntry);
+end;
+function TBGRAIndexedPalette.RemoveColor(AValue: TBGRAPixel): boolean;
+begin
+  Result:= false;
+  raise exception.Create('It is not possible to remove a color from an indexed palette');
+end;
+function TBGRAIndexedPalette.IndexOfColor(AValue: TBGRAPixel): integer;
+Var Node: TAvgLvlTreeNode;
+begin
+  Node := FTree.Find(@AValue);
+  if Assigned(Node) then
+    result := PBGRAIndexedPaletteEntry(Node.Data)^.Index
+  else
+    result := -1;
+end;
+procedure TBGRAIndexedPalette.Clear;
+begin
+  inherited Clear;
+  FCurrentIndex := 0;
+end;
+{ TBGRACustomColorQuantizer }
+function TBGRACustomColorQuantizer.GetDominantColor: TBGRAPixel;
+begin
+  result := ReducedPalette.DominantColor;
+end;
+procedure TBGRACustomColorQuantizer.ApplyDitheringInplace(
+  AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap);
+begin
+  ApplyDitheringInplace(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height));
+end;
+function TBGRACustomColorQuantizer.GetDitheredBitmap(
+  AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap
+  ): TBGRACustomBitmap;
+begin
+  result := GetDitheredBitmap(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height));
+end;
+procedure TBGRACustomColorQuantizer.SaveBitmapToFile(
+  AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  AFilenameUTF8: string);
+begin
+  SaveBitmapToFile(AAlgorithm, ABitmap, AFilenameUTF8, SuggestImageFormat(AFilenameUTF8));
+end;
+procedure TBGRACustomColorQuantizer.SaveBitmapToFile(
+  AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  AFilenameUTF8: string; AFormat: TBGRAImageFormat);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate);
+   try
+     SaveBitmapToStream(AAlgorithm, ABitmap, stream, AFormat);
+   finally
+     stream.Free;
+   end;
+end;
+function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData(
+  ABitDepth: integer; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
+  out AScanlineSize: PtrInt): Pointer;
+begin
+  result := GetDitheredBitmapIndexedData(ABitDepth,
+  {$IFDEF ENDIAN_LITTLE}riboLSBFirst{$ELSE}riboMSBFirst{$endif},
+  AAlgorithm, ABitmap, AScanlineSize);
+end;
+function TBGRACustomColorQuantizer.GetDitheredBitmapIndexedData(
+  ABitDepth: integer; AAlgorithm: TDitheringAlgorithm;
+  ABitmap: TBGRACustomBitmap): Pointer;
+var dummy: PtrInt;
+begin
+  result := GetDitheredBitmapIndexedData(ABitDepth, AAlgorithm, ABitmap, dummy);
+end;
 { TBGRACustomPalette }
+function TBGRACustomPalette.GetDominantColor: TBGRAPixel;
+var
+  w: ArrayOfWeightedColor;
+  i: Integer;
+  maxWeight, totalWeight: UInt32;
+begin
+  result := BGRAWhite;
+  maxWeight := 0;
+  w := GetAsArrayOfWeightedColor;
+  totalWeight:= 0;
+  for i := 0 to high(w) do
+    inc(totalWeight, w[i].Weight);
+  for i := 0 to high(w) do
+    if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).saturation > 16000) then
+    begin
+      maxWeight:= w[i].Weight;
+      result := w[i].Color;
+    end;
+  if maxWeight > totalWeight div 20 then exit;
+  for i := 0 to high(w) do
+    if (w[i].Weight > maxWeight) and (BGRAToGSBA(w[i].Color).lightness < 56000) and (BGRAToGSBA(w[i].Color).lightness > 16000) then
+    begin
+      maxWeight:= w[i].Weight;
+      result := w[i].Color;
+    end;
+  if maxWeight > 0 then exit;
+  for i := 0 to high(w) do
+    if (w[i].Weight > maxWeight) then
+    begin
+      maxWeight:= w[i].Weight;
+      result := w[i].Color;
+    end;
+end;
 procedure TBGRACustomPalette.AssignTo(AImage: TFPCustomImage);
 …
 end;
+function TBGRACustomApproxPalette.FindNearestColorIndexIgnoreAlpha(
+  AValue: TBGRAPixel): integer;
+const AlphaMask : DWord = {$IFDEF ENDIAN_LITTLE}$ff000000{$ELSE}$000000ff{$endif};
+begin
+  if AValue.alpha = 0 then
+    result := -1
+  else
+  begin
+    result := FindNearestColorIndex(TBGRAPixel(DWord(AValue) or AlphaMask));
+  end;
+end;
+function TBGRACustomApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32;
+begin
+  result := 1;
+end;
 function TBGRACustomApproxPalette.FindNearestColor(AValue: TBGRAPixel; AIgnoreAlpha: boolean): TBGRAPixel;
 begin
 …
 end;
+function TBGRACustomApproxPalette.FindNearestColorIndex(AValue: TBGRAPixel;
+  AIgnoreAlpha: boolean): integer;
+begin
+  if AIgnoreAlpha then
+    result := FindNearestColorIndexIgnoreAlpha(AValue)
+  else
+    result := FindNearestColorIndex(AValue);
+end;
 { TBGRAWeightedPalette }
 function TBGRAWeightedPalette.GetWeightByIndex(AIndex: integer): UInt32;
+function TBGRAWeightedPalette.GetWeightByIndex(AIndex: Integer): UInt32;
 begin
   NeedArray;
 …
 begin
   IncColor(PPixel^,dummy);
+end;
+constructor TBGRAWeightedPalette.Create(AColors: ArrayOfWeightedColor);
+var
+  i: Integer;
+begin
+  inherited Create;
+  for i := 0 to high(AColors) do
+    with AColors[i] do IncColor(Color,Weight);
 end;
 …
 end;
+constructor TBGRAPalette.Create(APalette: TBGRACustomPalette);
+begin
+  inherited Create;
+  AddColors(APalette);
+end;
+constructor TBGRAPalette.Create(AColors: ArrayOfTBGRAPixel);
+var
+  i: Integer;
+begin
+  inherited Create;
+  for i := 0 to high(AColors) do
+    AddColor(AColors[i]);
+end;
+constructor TBGRAPalette.Create(AColors: ArrayOfWeightedColor);
+var
+  i: Integer;
+begin
+  inherited Create;
+  for i := 0 to high(AColors) do
+    AddColor(AColors[i].Color);
+end;
 function TBGRAPalette.AddColor(AValue: TBGRAPixel): boolean;
 Var Node: TAvgLvlTreeNode;
 …
     AddLastColor(Entry);
   end;
+end;
+procedure TBGRAPalette.AddColors(ABitmap: TBGRACustomBitmap);
+var p: PBGRAPixel;
+  n: integer;
+begin
+  n := ABitmap.NbPixels;
+  p := ABitmap.Data;
+  while n > 0 do
+  begin
+    AddColor(p^);
+    inc(p);
+    dec(n);
+  end;
+end;
+procedure TBGRAPalette.AddColors(APalette: TBGRACustomPalette);
+var i: NativeInt;
+begin
+  for i := 0 to APalette.Count- 1 do
+    AddColor(APalette.Color[i]);
 end;

GraphicTest/Packages/bgrabitmap/bgrapath.pas

-              r472
+              r494
 interface
+//todo: tangent interpolation
 { There are different conventions for angles.
 …
 type
+  TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath, peQuadraticBezierTo, peCubicBezierTo, peArc);
+  PBGRAPathElementType = ^TBGRAPathElementType;
+  TBGRAPathElementType = (peNone, peMoveTo, peLineTo, peCloseSubPath,
+    peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline,
+    peClosedSpline);
+  TBGRAPathDrawProc = procedure(const APoints: array of TPointF; AClosed: boolean; AData: Pointer) of object;
+  TBGRAPathFillProc = procedure(const APoints: array of TPointF; AData: pointer) of object;
+  TBGRAPath = class;
+  { TBGRAPathCursor }
+  TBGRAPathCursor = class(TBGRACustomPathCursor)
+  protected
+    FPath: TBGRAPath;
+    FDataPos: IntPtr;
+    FAcceptedDeviation: single;
+    FPathLength: single;
+    FPathLengthComputed: boolean;
+    FBounds: TRectF;
+    FBoundsComputed: boolean;
+    FArcPos: Single;
+    FStartCoordinate: TPointF;
+    FEndCoordinate: TPointF;
+    FLoopClosedShapes,FLoopPath: boolean;
+    FCurrentElementType: TBGRAPathElementType;
+    FCurrentElement: Pointer;
+    FCurrentElementArcPos,
+    FCurrentElementArcPosScale: single;
+    FCurrentElementStartCoord,
+    FCurrentElementEndCoord: TPointF;
+    FCurrentElementLength: single;
+    FCurrentElementPoints: array of TPointF;
+    FCurrentSegment: NativeInt;
+    FCurrentSegmentPos: single;
+    function GoToNextElement(ACanJump: boolean): boolean;
+    function GoToPreviousElement(ACanJump: boolean): boolean;
+    procedure MoveToEndOfElement;
+    procedure MoveForwardInElement(ADistance: single);
+    procedure MoveBackwardInElement(ADistance: single);
+    function NeedPolygonalApprox: boolean;
+    procedure OnPathFree; virtual;
+    function GetLoopClosedShapes: boolean; override;
+    function GetLoopPath: boolean; override;
+    function GetStartCoordinate: TPointF; override;
+    procedure SetLoopClosedShapes(AValue: boolean); override;
+    procedure SetLoopPath(AValue: boolean); override;
+    function GetArcPos: single; override;
+    function GetCurrentTangent: TPointF; override;
+    procedure SetArcPos(AValue: single); override;
+    function GetBounds: TRectF; override;
+    function GetPathLength: single; override;
+    procedure PrepareCurrentElement; virtual;
+    function GetCurrentCoord: TPointF; override;
+    function GetPath: TBGRAPath; virtual;
+  public
+    constructor Create(APath: TBGRAPath; AAcceptedDeviation: single = 0.1);
+    function MoveForward(ADistance: single; ACanJump: boolean = true): single; override;
+    function MoveBackward(ADistance: single; ACanJump: boolean = true): single; override;
+    destructor Destroy; override;
+    property CurrentCoordinate: TPointF read GetCurrentCoord;
+    property CurrentTangent: TPointF read GetCurrentTangent;
+    property Position: single read GetArcPos write SetArcPos;
+    property PathLength: single read GetPathLength;
+    property Path: TBGRAPath read GetPath;
+    property Bounds: TRectF read GetBounds;
+    property StartCoordinate: TPointF read GetStartCoordinate;
+    property LoopClosedShapes: boolean read GetLoopClosedShapes write SetLoopClosedShapes;
+    property LoopPath: boolean read GetLoopPath write SetLoopPath;
+    property AcceptedDeviation: single read FAcceptedDeviation;
+  end;
   { 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;
+    FData: PByte;
+    FDataCapacity: PtrInt;
+    FDataPos: PtrInt;
+    FLastSubPathElementType, FLastStoredElementType: TBGRAPathElementType;
+    FLastMoveToDataPos: PtrInt;
+    FLastCoord,FLastTransformedCoord,
+    FSubPathStartCoord, FSubPathTransformedStartCoord: TPointF;
+    FExpectedTransformedControlPoint: 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;
+    FCursors: array of TBGRAPathCursor;
+    FInternalDrawOffset: TPointF;
+    procedure OnModify;
+    procedure OnMatrixChange;
     procedure NeedSpace(count: integer);
+    procedure StoreCoord(const pt: TPointF);
+    function ReadCoord: TPointF;
+    procedure StoreElementType(value: TBGRAPathElementType);
+    function ReadElementType: TBGRAPathElementType;
+    function ReadArcDef: TArcDef;
+    procedure RewindFloat;
+    function AllocateElement(AElementType: TBGRAPathElementType;
+  AExtraBytes: PtrInt = 0): Pointer;
     procedure Init;
+    procedure DoClear;
+    function CheckElementType(AElementType: TBGRAPathElementType): boolean;
+    function GoToNextElement(var APos: PtrInt): boolean;
+    function GoToPreviousElement(var APos: PtrInt): boolean;
+    function PeekNextElement(APos: PtrInt): TBGRAPathElementType;
+    function GetElementStartCoord(APos: PtrInt): TPointF;
+    function GetElementEndCoord(APos: PtrInt): TPointF;
+    function GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
+    procedure GetElementAt(APos: PtrInt;
+      out AElementType: TBGRAPathElementType; out AElement: pointer);
+    function GetSvgString: string; virtual;
+    procedure SetSvgString(const AValue: string); virtual;
+    procedure RegisterCursor(ACursor: TBGRAPathCursor);
+    procedure UnregisterCursor(ACursor: TBGRAPathCursor);
+    function SetLastCoord(ACoord: TPointF): TPointF; inline;
+    procedure ClearLastCoord;
+    procedure BezierCurveFromTransformed(tcp1, cp2, pt:TPointF);
+    procedure QuadraticCurveFromTransformed(tcp, pt: TPointF);
+    function LastCoordDefined: boolean; inline;
+    function GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
+    function getPoints: ArrayOfTPointF;
+    function getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
+    function getCursor: TBGRACustomPathCursor;
+    procedure InternalDraw(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
+    procedure BitmapDrawSubPathProc(const APoints: array of TPointF; AClosed: boolean; AData: pointer);
+    function CorrectAcceptedDeviation(AAcceptedDeviation: single; const AMatrix: TAffineMatrix): single;
   public
     constructor Create; overload;
     constructor Create(ASvgString: string); overload;
+    constructor Create(const APoints: ArrayOfTPointF); overload;
+    constructor Create(APath: IBGRAPath); overload;
     destructor Destroy; override;
     procedure beginPath;
+    procedure beginSubPath;
     procedure closePath;
     procedure translate(x,y: single);
 …
     procedure moveTo(const pt: TPointF); overload;
     procedure lineTo(const pt: TPointF); overload;
+    procedure polyline(const pts: array of TPointF);
     procedure polylineTo(const pts: array of TPointF);
+    procedure polygon(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 quadraticCurve(p1,cp,p2: TPointF); overload;
     procedure smoothQuadraticCurveTo(x,y: single); overload;
     procedure smoothQuadraticCurveTo(const pt: TPointF); overload;
 …
     procedure bezierCurveTo(const cp1,cp2,pt: TPointF); overload;
     procedure bezierCurve(const curve: TCubicBezierCurve); overload;
+    procedure bezierCurve(p1,cp1,cp2,p2: TPointF); overload;
     procedure smoothBezierCurveTo(cp2x,cp2y,x,y: single); overload;
     procedure smoothBezierCurveTo(const cp2,pt: TPointF); 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: single; 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 addPath(const AValue: string); overload;
     procedure addPath(source: IBGRAPath); overload;
+    procedure openedSpline(const pts: array of TPointF; style: TSplineStyle);
+    procedure closedSpline(const pts: array of TPointF; style: TSplineStyle);
     property SvgString: string read GetSvgString write SetSvgString;
+    function ComputeLength(AAcceptedDeviation: single = 0.1): single;
+    function ToPoints(AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+    function ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+    function IsEmpty: boolean;
+    function GetBounds(AAcceptedDeviation: single = 0.1): TRectF;
+    procedure SetPoints(const APoints: ArrayOfTPointF);
+    procedure stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single = 0.1);
+    procedure stroke(ADrawProc: TBGRAPathDrawProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1; AData: pointer = nil);
+    procedure fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
+    procedure fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
+    procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
+    procedure fill(ABitmap: TBGRACustomBitmap; x,y: single; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
+    procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; AColor: TBGRAPixel; AAcceptedDeviation: single = 0.1);
+    procedure fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AAcceptedDeviation: single = 0.1);
+    procedure fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix; AAcceptedDeviation: single = 0.1; AData: pointer = nil);
+    function CreateCursor(AAcceptedDeviation: single = 0.1): TBGRAPathCursor;
+    procedure Fit(ARect: TRectF; AAcceptedDeviation: single = 0.1);
+    procedure FitInto(ADest: TBGRAPath; ARect: TRectF; AAcceptedDeviation: single = 0.1);
   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 SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
+function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload;
+function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload;
+function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; overload;
+function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload;
+function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle): ArrayOfTPointF;
+function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single = 0.25): ArrayOfTPointF;
+function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
+function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single = 0.25; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
+function ClosedSplineStartPoint(const points: array of TPointF; Style: TSplineStyle): TPointF;
 { Compute points to draw an antialiased ellipse }
 …
 uses Math, BGRAResample, SysUtils;
+type
+  TStrokeData = record
+    Bitmap: TBGRACustomBitmap;
+    Texture: IBGRAScanner;
+    Color: TBGRAPixel;
+    Width: Single;
+  end;
+  PPathElementHeader = ^TPathElementHeader;
+  TPathElementHeader = record
+    ElementType: TBGRAPathElementType;
+    PreviousElementType: TBGRAPathElementType;
+  end;
+  PMoveToElement = ^TMoveToElement;
+  TMoveToElement = record
+    StartCoordinate: TPointF;
+    LoopDataPos: PtrInt; //if the path is closed
+  end;
+  PClosePathElement = ^TClosePathElement;
+  TClosePathElement = type TMoveToElement;
+  PQuadraticBezierToElement = ^TQuadraticBezierToElement;
+  TQuadraticBezierToElement = record
+    ControlPoint, Destination: TPointF;
+  end;
+  PCubicBezierToElement = ^TCubicBezierToElement;
+  TCubicBezierToElement = record
+    ControlPoint1, ControlPoint2, Destination: TPointF;
+  end;
+  PArcElement = ^TArcElement;
+  TArcElement = TArcDef;
+  PSplineElement = ^TSplineElement;
+  TSplineElement = record
+    SplineStyle: TSplineStyle;
+    NbControlPoints: integer;
+  end;
+const
+  PathElementSize : array[TBGRAPathElementType] of PtrInt =
+  (0, Sizeof(TMoveToElement), Sizeof(TClosePathElement), sizeof(TPointF),
+   sizeof(TQuadraticBezierToElement), sizeof(TCubicBezierToElement),
+   sizeof(TArcElement), sizeof(TSplineElement)+sizeof(integer),
+   sizeof(TSplineElement)+sizeof(integer));
 function SplineVertexToSide(y0, y1, y2, y3: single; t: single): single;
 var
 …
 end;
 function ComputeCurvePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
+function ComputeCurvePartPrecision(pt1, pt2, pt3, pt4: TPointF; AAcceptedDeviation: single = 0.1): integer;
 var
   len: single;
 …
   len    := max(len, sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y));
   len    := max(len, sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y));
   Result := round(sqrt(sqrt(len)) * 2);
+  Result := round(sqrt(sqrt(len)/AAcceptedDeviation) * 0.9);
   if Result<=0 then Result:=1;
 end;
+function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; overload;
+var
+  t,f1,f2,f3,f4: single;
+  i,nb: Integer;
+begin
+  nb := ComputeCurvePrecision(curve.p1,curve.c1,curve.c2,curve.p2);
+  if nb <= 1 then nb := 2;
+  setlength(result,nb);
+  result[0] := curve.p1;
+  result[nb-1] := curve.p2;
+  for i := 1 to nb-2 do
+  begin
+    t := i/(nb-1);
+    f1 := (1-t);
+    f2 := f1*f1;
+    f1 *= f2;
+    f2 *= t*3;
+    f4 := t*t;
+    f3 := f4*(1-t)*3;
+    f4 *= t;
+    result[i] := PointF(f1*curve.p1.x + f2*curve.c1.x +
+                  f3*curve.c2.x + f4*curve.p2.x,
+                  f1*curve.p1.y + f2*curve.c1.y +
+                  f3*curve.c2.y + f4*curve.p2.y);
+  end;
+end;
+function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; overload;
+var
+  t,f1,f2,f3: single;
+  i,nb: Integer;
+begin
+  nb := ComputeCurvePrecision(curve.p1,curve.c,curve.c,curve.p2);
+  if nb <= 1 then nb := 2;
+  setlength(result,nb);
+  result[0] := curve.p1;
+  result[nb-1] := curve.p2;
+  for i := 1 to nb-2 do
+  begin
+    t := i/(nb-1);
+    f1 := (1-t);
+    f3 := t;
+    f2 := f1*f3*2;
+    f1 *= f1;
+    f3 *= f3;
+    result[i] := PointF(f1*curve.p1.x + f2*curve.c.x + f3*curve.p2.x,
+                  f1*curve.p1.y + f2*curve.c.y + f3*curve.p2.y);
+  end;
+end;
+function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF;
+function ComputeBezierCurve(const curve: TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+begin
+  result := curve.ToPoints(AAcceptedDeviation);
+end;
+function ComputeBezierCurve(const curve: TQuadraticBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF; overload;
+begin
+  result := curve.ToPoints(AAcceptedDeviation);
+end;
+function ComputeBezierSpline(const spline: array of TCubicBezierCurve; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
 var
   curves: array of array of TPointF;
 …
   setlength(curves, length(spline));
   for i := 0 to high(spline) do
     curves[i] := ComputeBezierCurve(spline[i]);
+    curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
   nb := length(curves[0]);
   lastPt := curves[0][high(curves[0])];
 …
 end;
 function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve
   ): ArrayOfTPointF;
+function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve;
+  AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
 var
   curves: array of array of TPointF;
 …
   setlength(curves, length(spline));
   for i := 0 to high(spline) do
     curves[i] := ComputeBezierCurve(spline[i]);
+    curves[i] := ComputeBezierCurve(spline[i],AAcceptedDeviation);
   nb := length(curves[0]);
   lastPt := curves[0][high(curves[0])];
 …
 end;
 function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle): ArrayOfTPointF;
+function ComputeClosedSpline(const points: array of TPointF; Style: TSplineStyle; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
 var
   i, j, nb, idx, pre: integer;
 …
     ptNext  := points[(i + 1) mod length(points)];
     ptNext2 := points[(i + 2) mod length(points)];
     nb      += ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
+    nb      += ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
   end;
   kernel := CreateInterpolator(style);
   setlength(Result, nb);
+  idx := 0;
   for i := 0 to high(points) do
   begin
 …
     ptNext  := points[(i + 1) mod length(points)];
     ptNext2 := points[(i + 2) mod length(points)];
     pre     := ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
+    pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
     if i=0 then
+    begin
+      j := 0;
+      idx := 0;
+    end else j := 1;
+      j := 0
+    else
+      j := 1;
     while j <= pre do
     begin
 …
 end;
 function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single): ArrayOfTPointF;
+function ComputeOpenedSpline(const points: array of TPointF; Style: TSplineStyle; EndCoeff: single; AAcceptedDeviation: single = 0.1): ArrayOfTPointF;
 var
   i, j, nb, idx, pre: integer;
 …
     else
       ptNext2 := points[i + 2];
     nb      += ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
+    nb      += ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
   end;
 …
     else
       ptNext2 := points[i + 2];
     pre     := ComputeCurvePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
+    pre     := ComputeCurvePartPrecision(ptPrev2, ptPrev, ptNext, ptNext2, AAcceptedDeviation);
     if i=0 then
     begin
 …
   if Style in[ssInsideWithEnds,ssCrossingWithEnds] then
     result[idx] := points[high(points)];
+end;
+function ClosedSplineStartPoint(const points: array of TPointF;
+  Style: TSplineStyle): TPointF;
+var
+  kernel: TWideKernelFilter;
+  ptPrev2: TPointF;
+  ptPrev: TPointF;
+  ptNext: TPointF;
+  ptNext2: TPointF;
+begin
+  if length(points) = 0 then
+    result := EmptyPointF
+  else
+  if length(points)<=2 then
+    result := points[0]
+  else
+  begin
+    kernel := CreateInterpolator(style);
+    ptPrev2 := points[high(points)];
+    ptPrev  := points[0];
+    ptNext  := points[1];
+    ptNext2 := points[2];
+    result := ptPrev2*kernel.Interpolation(1) + ptPrev*kernel.Interpolation(0) +
+              ptNext*kernel.Interpolation(-1)  + ptNext2*kernel.Interpolation(-2);
+    kernel.free;
+  end;
 end;
 …
 end;
+{ TBGRAPathCursor }
+function TBGRAPathCursor.GetCurrentCoord: TPointF;
+begin
+  case FCurrentElementType of
+    peNone: result := EmptyPointF;
+    peMoveTo,peLineTo,peCloseSubPath:
+      if FCurrentElementLength <= 0 then
+        result := FCurrentElementStartCoord
+      else
+        result := FCurrentElementStartCoord + (FCurrentElementEndCoord-FCurrentElementStartCoord)*(FCurrentElementArcPos/FCurrentElementLength);
+    peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
+      begin
+        NeedPolygonalApprox;
+        if FCurrentSegment >= high(FCurrentElementPoints) then
+          result := FCurrentElementEndCoord
+        else
+          result := FCurrentElementPoints[FCurrentSegment]+
+          (FCurrentElementPoints[FCurrentSegment+1]-
+           FCurrentElementPoints[FCurrentSegment])*FCurrentSegmentPos;
+      end;
+    else
+      raise Exception.Create('Unknown element type');
+  end;
+end;
+function TBGRAPathCursor.GetPath: TBGRAPath;
+begin
+  if not Assigned(FPath) then
+    raise exception.Create('Path does not exist');
+  result := FPath;
+end;
+procedure TBGRAPathCursor.MoveToEndOfElement;
+begin
+  FCurrentElementArcPos := FCurrentElementLength;
+  if not NeedPolygonalApprox then exit;
+  if length(FCurrentElementPoints) > 1 then
+  begin
+    FCurrentSegment := high(FCurrentElementPoints)-1;
+    FCurrentSegmentPos := 1;
+  end else
+  begin
+    FCurrentSegment := high(FCurrentElementPoints);
+    FCurrentSegmentPos := 0;
+  end;
+end;
+procedure TBGRAPathCursor.MoveForwardInElement(ADistance: single);
+var segLen,rightSpace,remaining: single;
+begin
+  if not NeedPolygonalApprox then exit;
+  ADistance *= FCurrentElementArcPosScale;
+  remaining := ADistance;
+  while remaining > 0 do
+  begin
+    if FCurrentSegment < high(FCurrentElementPoints) then
+      segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
+    else
+      segLen := 0;
+    rightSpace := segLen*(1-FCurrentSegmentPos);
+    if (segLen > 0) and (remaining <= rightSpace) then
+    begin
+      FCurrentSegmentPos += remaining/segLen;
+      exit;
+    end else
+    begin
+      remaining -= rightSpace;
+      if FCurrentSegment < high(FCurrentElementPoints)-1 then
+      begin
+        inc(FCurrentSegment);
+        FCurrentSegmentPos := 0;
+      end else
+      begin
+        FCurrentSegmentPos := 1;
+        exit;
+      end;
+    end;
+  end;
+end;
+procedure TBGRAPathCursor.MoveBackwardInElement(ADistance: single);
+var
+  segLen,leftSpace,remaining: Single;
+begin
+  if not NeedPolygonalApprox then exit;
+  ADistance *= FCurrentElementArcPosScale;
+  remaining := ADistance;
+  while remaining > 0 do
+  begin
+    if FCurrentSegment < high(FCurrentElementPoints) then
+      segLen := VectLen(FCurrentElementPoints[FCurrentSegment+1]-FCurrentElementPoints[FCurrentSegment])
+    else
+      segLen := 0;
+    leftSpace := segLen*FCurrentSegmentPos;
+    if (segLen > 0) and (remaining <= leftSpace) then
+    begin
+      FCurrentSegmentPos -= remaining/segLen;
+      exit;
+    end else
+    begin
+      remaining -= leftSpace;
+      if FCurrentSegment > 0 then
+      begin
+        dec(FCurrentSegment);
+        FCurrentSegmentPos := 1;
+      end else
+      begin
+        FCurrentSegmentPos := 0;
+        exit;
+      end;
+    end;
+  end;
+end;
+function TBGRAPathCursor.NeedPolygonalApprox: boolean;
+begin
+  if not (FCurrentElementType in[peQuadraticBezierTo,peCubicBezierTo,peArc,
+  peOpenedSpline,peClosedSpline])
+  then
+  begin
+    result := false;
+    exit;
+  end;
+  result := true;
+  if FCurrentElementPoints = nil then
+  begin
+    FCurrentElementPoints := Path.GetPolygonalApprox(FDataPos, FAcceptedDeviation, True);
+    if FCurrentElementType = peQuadraticBezierTo then
+    begin
+      if FCurrentElementLength <> 0 then
+        FCurrentElementArcPosScale := PolylineLen(FCurrentElementPoints)/FCurrentElementLength;
+    end;
+  end;
+end;
+function TBGRAPathCursor.GetArcPos: single;
+var pos: PtrInt;
+begin
+  if FArcPos = EmptySingle then
+  begin
+    FArcPos := FCurrentElementArcPos;
+    pos := FDataPos;
+    while Path.GoToPreviousElement(pos) do
+      FArcPos += Path.GetElementLength(pos, FAcceptedDeviation);
+  end;
+  result := FArcPos;
+end;
+function TBGRAPathCursor.GetCurrentTangent: TPointF;
+var idxStart,idxEnd: integer;
+  seg: TPointF;
+begin
+  while FCurrentElementLength <= 0 do
+  begin
+    if not GoToNextElement(False) then
+    begin
+      result := EmptyPointF;
+      exit;
+    end;
+  end;
+  case FCurrentElementType of
+    peMoveTo,peLineTo,peCloseSubPath:
+      result := (FCurrentElementEndCoord-FCurrentElementStartCoord)*(1/FCurrentElementLength);
+    peCubicBezierTo,peQuadraticBezierTo,peArc,peOpenedSpline,peClosedSpline:
+      begin
+        NeedPolygonalApprox;
+        idxStart := FCurrentSegment;
+        if idxStart >= high(FCurrentElementPoints) then
+          idxStart:= high(FCurrentElementPoints)-1;
+        idxEnd := idxStart+1;
+        if idxStart < 0 then
+        begin
+          result := EmptyPointF;
+          exit;
+        end;
+        seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
+        while (seg.x = 0) and (seg.y = 0) and (idxEnd < high(FCurrentElementPoints)) do
+        begin
+          inc(idxEnd);
+          seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
+        end;
+        while (seg.x = 0) and (seg.y = 0) and (idxStart > 0) do
+        begin
+          dec(idxStart);
+          seg := FCurrentElementPoints[idxEnd] - FCurrentElementPoints[idxStart];
+        end;
+        if (seg.x = 0) and (seg.y = 0) then
+          result := EmptyPointF
+        else
+          result := seg*(1/VectLen(seg));
+      end;
+    else result := EmptyPointF;
+  end;
+end;
+procedure TBGRAPathCursor.SetArcPos(AValue: single);
+var oldLoopClosedShapes,oldLoopPath: boolean;
+begin
+  if GetArcPos=AValue then Exit;
+  if (AValue > PathLength) and (PathLength <> 0) then
+    AValue := AValue - trunc(AValue/PathLength)*PathLength
+  else if (AValue < 0) then
+    AValue := AValue + (trunc(-AValue/PathLength)+1)*PathLength;
+  oldLoopClosedShapes:= LoopClosedShapes;
+  oldLoopPath:= LoopPath;
+  LoopClosedShapes:= false;
+  LoopPath:= false;
+  MoveForward(AValue-GetArcPos, True);
+  LoopClosedShapes:= oldLoopClosedShapes;
+  LoopPath:= oldLoopPath;
+end;
+function TBGRAPathCursor.GetPathLength: single;
+begin
+  if not FPathLengthComputed then
+  begin
+    FPathLength := Path.ComputeLength(FAcceptedDeviation);
+    FPathLengthComputed := true;
+  end;
+  result := FPathLength;
+end;
+procedure TBGRAPathCursor.OnPathFree;
+begin
+  FPath := nil;
+end;
+function TBGRAPathCursor.GetLoopClosedShapes: boolean;
+begin
+  result := FLoopClosedShapes;
+end;
+function TBGRAPathCursor.GetLoopPath: boolean;
+begin
+  result := FLoopPath;
+end;
+function TBGRAPathCursor.GetStartCoordinate: TPointF;
+begin
+  result := FStartCoordinate;
+end;
+procedure TBGRAPathCursor.SetLoopClosedShapes(AValue: boolean);
+begin
+  FLoopClosedShapes := AValue;
+end;
+procedure TBGRAPathCursor.SetLoopPath(AValue: boolean);
+begin
+  FLoopPath := AValue;
+end;
+procedure TBGRAPathCursor.PrepareCurrentElement;
+begin
+  Path.GetElementAt(FDataPos, FCurrentElementType, FCurrentElement);
+  FCurrentElementLength := 0;
+  FCurrentElementArcPos := 0;
+  FCurrentElementPoints := nil;
+  FCurrentSegment := 0;
+  FCurrentSegmentPos := 0;
+  FCurrentElementArcPosScale := 1;
+  if FCurrentElementType = peNone then
+  begin
+    FCurrentElementStartCoord := EmptyPointF;
+    FCurrentElementEndCoord := EmptyPointF;
+  end
+  else
+  begin
+    FCurrentElementStartCoord := Path.GetElementStartCoord(FDataPos);
+    case FCurrentElementType of
+      peLineTo, peCloseSubPath:
+        begin
+          FCurrentElementEndCoord := PPointF(FCurrentElement)^;
+          FCurrentElementLength := VectLen(FCurrentElementEndCoord - FCurrentElementStartCoord);
+        end;
+      peQuadraticBezierTo: with PQuadraticBezierToElement(FCurrentElement)^ do
+        begin
+          FCurrentElementEndCoord := Destination;
+          FCurrentElementLength := BGRABitmapTypes.BezierCurve(FCurrentElementStartCoord,ControlPoint,Destination).ComputeLength;
+        end;
+      peCubicBezierTo,peArc,peOpenedSpline,peClosedSpline:
+        begin
+          NeedPolygonalApprox;
+          FCurrentElementEndCoord := FCurrentElementPoints[high(FCurrentElementPoints)];
+          FCurrentElementLength := PolylineLen(FCurrentElementPoints);
+        end;
+    else
+      FCurrentElementEndCoord := FCurrentElementStartCoord;
+    end;
+  end;
+end;
+function TBGRAPathCursor.GetBounds: TRectF;
+begin
+  if not FBoundsComputed then
+  begin
+    FBounds:= Path.GetBounds(FAcceptedDeviation);
+    FBoundsComputed := true;
+  end;
+  result := FBounds;
+end;
+function TBGRAPathCursor.GoToNextElement(ACanJump: boolean): boolean;
+begin
+  if (FCurrentElementType = peCloseSubPath) and
+   (PClosePathElement(FCurrentElement)^.LoopDataPos <> -1) and
+   (  FLoopClosedShapes or
+      (FLoopPath and (PClosePathElement(FCurrentElement)^.LoopDataPos = 0))
+   ) then
+  begin
+    if PClosePathElement(FCurrentElement)^.LoopDataPos <> FDataPos then
+    begin
+      result := true;
+      FDataPos := PClosePathElement(FCurrentElement)^.LoopDataPos;
+      FArcPos := EmptySingle;
+      PrepareCurrentElement;
+    end else
+      result := false;
+  end;
+  if not ACanJump and ((FCurrentElementType = peCloseSubPath)
+   or (Path.PeekNextElement(FDataPos) = peMoveTo)) then
+  begin
+    result := false;
+    exit;
+  end;
+  if Path.GoToNextElement(FDataPos) then
+  begin
+    result := true;
+    PrepareCurrentElement;
+  end
+  else
+  begin
+    if ACanJump and FLoopPath and (FDataPos > 0) then
+    begin
+      result := true;
+      FDataPos := 0;
+      FArcPos := EmptySingle;
+      PrepareCurrentElement;
+    end else
+      result := false;
+  end;
+end;
+function TBGRAPathCursor.GoToPreviousElement(ACanJump: boolean): boolean;
+var lastElemPos: IntPtr;
+begin
+  if (FCurrentElementType = peMoveTo) and (PMoveToElement(FCurrentElement)^.LoopDataPos <> -1) and
+    ( FLoopClosedShapes or
+      (FLoopPath and (FDataPos = 0))
+    ) then
+  with PMoveToElement(FCurrentElement)^ do
+  begin
+    if LoopDataPos <> -1 then
+    begin
+      result := true;
+      FDataPos := LoopDataPos;
+      FArcPos := EmptySingle;
+      PrepareCurrentElement;
+    end;
+  end;
+  if not ACanJump and (FCurrentElementType = peMoveTo) then
+  begin
+    result := false;
+    exit;
+  end;
+  if Path.GoToPreviousElement(FDataPos) then
+  begin
+    result := true;
+    PrepareCurrentElement;
+  end
+  else
+  begin
+    if FLoopPath then
+    begin
+      lastElemPos := FPath.FDataPos;
+      if (lastElemPos > 0) and FPath.GoToPreviousElement(lastElemPos) then
+      begin
+        if lastElemPos > 0 then
+        begin
+          result := true;
+          FDataPos := lastElemPos;
+          PrepareCurrentElement;
+          FArcPos := EmptySingle;
+          exit;
+        end;
+      end;
+    end;
+    result := false;
+  end;
+end;
+constructor TBGRAPathCursor.Create(APath: TBGRAPath; AAcceptedDeviation: single);
+begin
+  FPath := APath;
+  FPathLengthComputed := false;
+  FBoundsComputed:= false;
+  FDataPos := 0;
+  FArcPos:= 0;
+  FAcceptedDeviation:= AAcceptedDeviation;
+  Path.RegisterCursor(self);
+  PrepareCurrentElement;
+  FStartCoordinate := FCurrentElementStartCoord;
+  if isEmptyPointF(FStartCoordinate) then
+    raise exception.Create('Path does not has a starting coordinate');
+  FEndCoordinate := Path.FLastTransformedCoord;
+  if isEmptyPointF(FEndCoordinate) then
+    raise exception.Create('Path does not has an ending coordinate');
+end;
+function TBGRAPathCursor.MoveForward(ADistance: single; ACanJump: boolean): single;
+var newArcPos,step,remaining: single;
+begin
+  if ADistance < 0 then
+  begin
+    result := -MoveBackward(-ADistance, ACanJump);
+    exit;
+  end;
+  result := 0;
+  remaining := ADistance;
+  while remaining > 0 do
+  begin
+    newArcPos := FCurrentElementArcPos + remaining;
+    if newArcPos > FCurrentElementLength then
+    begin
+      step := FCurrentElementLength - FCurrentElementArcPos;
+      result += step;
+      remaining -= step;
+      if not GoToNextElement(ACanJump) then
+      begin
+        MoveForwardInElement(step);
+        FCurrentElementArcPos := FCurrentElementLength;
+        FArcPos := PathLength;
+        exit;
+      end;
+    end else
+    begin
+      MoveForwardInElement(remaining);
+      FCurrentElementArcPos := newArcPos;
+      result := ADistance;
+      break;
+    end;
+  end;
+  if FArcPos <> EmptySingle then
+    FArcPos += result;
+end;
+function TBGRAPathCursor.MoveBackward(ADistance: single; ACanJump: boolean = true): single;
+var
+  remaining: Single;
+  newArcPos: Single;
+  step: Single;
+begin
+  if ADistance = 0 then
+  begin
+    result := 0;
+    exit;
+  end;
+  if ADistance < 0 then
+  begin
+    result := -MoveForward(-ADistance, ACanJump);
+    exit;
+  end;
+  result := 0;
+  remaining := ADistance;
+  while remaining > 0 do
+  begin
+    newArcPos := FCurrentElementArcPos - remaining;
+    if newArcPos < 0 then
+    begin
+      step := FCurrentElementArcPos;
+      result += step;
+      remaining -= step;
+      if not GoToPreviousElement(ACanJump) then
+      begin
+        MoveBackwardInElement(step);
+        FCurrentElementArcPos := 0;
+        FArcPos := 0;
+        exit;
+      end else
+        MoveToEndOfElement;
+    end else
+    begin
+      MoveBackwardInElement(remaining);
+      FCurrentElementArcPos := newArcPos;
+      result := ADistance;
+      break;
+    end;
+  end;
+  if FArcPos <> EmptySingle then
+    FArcPos -= result;
+end;
+destructor TBGRAPathCursor.Destroy;
+begin
+  if Assigned(FPath) then
+  begin
+    FPath.UnregisterCursor(self);
+  end;
+  inherited Destroy;
+end;
 { TBGRAPath }
+function TBGRAPath.ComputeLength(AAcceptedDeviation: single): single;
+var pos: PtrInt;
+begin
+  pos := 0;
+  result := 0;
+  repeat
+    result += GetElementLength(pos, AAcceptedDeviation);
+  until not GoToNextElement(pos);
+end;
+function TBGRAPath.ToPoints(AAcceptedDeviation: single): ArrayOfTPointF;
+var sub: array of ArrayOfTPointF;
+    temp: ArrayOfTPointF;
+    nbSub,nbPts,curPt,curSub: NativeInt;
+    startPos,pos: PtrInt;
+    elemType: TBGRAPathElementType;
+    elem: pointer;
+begin
+  pos := 0;
+  nbSub := 0;
+  repeat
+    GetElementAt(pos, elemType, elem);
+    if elem = nil then break;
+    case elemType of
+      peMoveTo,peLineTo,peCloseSubPath: begin
+          inc(nbSub);
+          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+            GoToNextElement(pos);
+        end;
+      peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
+    end;
+  until not GoToNextElement(pos);
+  pos := 0;
+  setlength(sub, nbSub);
+  curSub := 0;
+  repeat
+    GetElementAt(pos, elemType, elem);
+    if elem = nil then break;
+    case elemType of
+      peMoveTo,peLineTo,peCloseSubPath: begin
+          startPos := pos;
+          if (elemType = peMoveTo) and (curSub > 0) then
+            nbPts := 2
+          else
+            nbPts := 1;
+          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+          begin
+            GoToNextElement(pos);
+            inc(nbPts);
+          end;
+          setlength(temp, nbPts);
+          pos := startPos;
+          if (elemType = peMoveTo) and (curSub > 0) then
+          begin
+            temp[0] := EmptyPointF;
+            temp[1] := PPointF(elem)^;
+            curPt := 2;
+          end else
+          begin
+            temp[0] := PPointF(elem)^;
+            curPt := 1;
+          end;
+          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+          begin
+            GoToNextElement(pos);
+            GetElementAt(pos, elemType, elem);
+            temp[curPt] := PPointF(elem)^;
+            inc(curPt);
+          end;
+          sub[curSub] := temp;
+          inc(curSub);
+          temp := nil;
+        end;
+      peQuadraticBezierTo,peCubicBezierTo,peArc,
+      peOpenedSpline, peClosedSpline:
+        begin
+          sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
+          inc(curSub);
+        end;
+    end;
+  until not GoToNextElement(pos) or (curSub = nbSub);
+  result := ConcatPointsF(sub);
+end;
+function TBGRAPath.ToPoints(AMatrix: TAffineMatrix; AAcceptedDeviation: single): ArrayOfTPointF;
+begin
+  AAcceptedDeviation:= CorrectAcceptedDeviation(AAcceptedDeviation,AMatrix);
+  result := ToPoints(AAcceptedDeviation);
+  if not IsAffineMatrixIdentity(AMatrix) then
+    result := AMatrix*result;
+end;
+function TBGRAPath.IsEmpty: boolean;
+begin
+  result := FDataPos = 0;
+end;
+function TBGRAPath.GetBounds(AAcceptedDeviation: single): TRectF;
+var empty: boolean;
+    pos: PtrInt;
+    elemType: TBGRAPathElementType;
+    elem: pointer;
+    temp: array of TPointF;
+    i: integer;
+  procedure Include(pt: TPointF);
+  begin
+    if empty then
+    begin
+      result.TopLeft := pt;
+      result.BottomRight := pt;
+      empty := false;
+    end else
+    begin
+      if pt.x < result.Left then result.Left := pt.x
+      else if pt.x > result.Right then result.Right := pt.x;
+      if pt.y < result.Top then result.Top := pt.y
+      else if pt.y > result.Bottom then result.Bottom := pt.y;
+    end;
+  end;
+  procedure IncludeRect(r: TRectF);
+  begin
+    Include(r.TopLeft);
+    Include(r.BottomRight);
+  end;
+begin
+  empty := true;
+  result := RectF(0,0,0,0);
+  pos := 0;
+  repeat
+    GetElementAt(pos, elemType, elem);
+    if elem = nil then break;
+    case elemType of
+      peMoveTo,peLineTo,peCloseSubPath: begin
+          Include(PPointF(elem)^);
+          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+          begin
+            GoToNextElement(pos);
+            GetElementAt(pos, elemType, elem);
+            Include(PPointF(elem)^);
+          end;
+        end;
+      peCubicBezierTo:
+        with PCubicBezierToElement(elem)^ do
+          IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint1,ControlPoint2,Destination).GetBounds);
+      peQuadraticBezierTo:
+        with PQuadraticBezierToElement(elem)^ do
+          IncludeRect(BGRABitmapTypes.BezierCurve(GetElementStartCoord(pos),ControlPoint,Destination).GetBounds);
+      peArc, peOpenedSpline, peClosedSpline:
+        begin
+          temp := GetPolygonalApprox(pos, AAcceptedDeviation, False);
+          for i := 0 to high(temp) do
+            Include(temp[i]);
+        end;
+    end;
+  until not GoToNextElement(pos);
+  if empty then raise exception.Create('Path is empty');
+end;
+procedure TBGRAPath.SetPoints(const APoints: ArrayOfTPointF);
+var i: integer;
+    nextIsMoveTo: boolean;
+    startPoint: TPointF;
+begin
+  beginPath;
+  if length(APoints) = 0 then exit;
+  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(APoints));
+  nextIsMoveTo:= true;
+  startPoint := EmptyPointF;
+  for i := 0 to high(APoints) do
+  begin
+    if isEmptyPointF(APoints[i]) then
+      nextIsMoveTo:= true
+    else
+    if nextIsMoveTo then
+    begin
+      startPoint := APoints[i];
+      moveTo(startPoint);
+      nextIsMoveTo:= false;
+    end
+    else
+    begin
+      with APoints[i] do
+        if (x = startPoint.x) and (y = startPoint.y) then
+          closePath
+        else
+          lineTo(APoints[i]);
+    end;
+  end;
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
+  AWidth: single; AAcceptedDeviation: single);
+begin
+  stroke(ABitmap,AffineMatrixIdentity,AColor,AWidth,AAcceptedDeviation);
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
+  AWidth: single; AAcceptedDeviation: single);
+begin
+  stroke(ABitmap,AffineMatrixIdentity,ATexture,AWidth,AAcceptedDeviation);
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
+  AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
+begin
+  stroke(ABitmap,AffineMatrixTranslation(x,y),AColor,AWidth,AAcceptedDeviation);
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; x, y: single;
+  ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
+begin
+  stroke(ABitmap,AffineMatrixTranslation(x,y),ATexture,AWidth,AAcceptedDeviation);
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
+  AColor: TBGRAPixel; AWidth: single; AAcceptedDeviation: single);
+var data: TStrokeData;
+begin
+  data.Bitmap := ABitmap;
+  data.Texture := nil;
+  data.Color := AColor;
+  data.Width := AWidth;
+  InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
+end;
+procedure TBGRAPath.stroke(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
+  ATexture: IBGRAScanner; AWidth: single; AAcceptedDeviation: single);
+var data: TStrokeData;
+begin
+  data.Bitmap := ABitmap;
+  data.Texture := ATexture;
+  data.Color := BGRAPixelTransparent;
+  data.Width := AWidth;
+  InternalDraw(@BitmapDrawSubPathProc, AMatrix, AAcceptedDeviation, @data);
+end;
+procedure TBGRAPath.stroke(ADrawProc: TBGRAPathDrawProc;
+  const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
+begin
+  InternalDraw(ADrawProc,AMatrix,AAcceptedDeviation,AData);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; AColor: TBGRAPixel;
+  AAcceptedDeviation: single);
+begin
+  fill(ABitmap,AffineMatrixIdentity,AColor,AAcceptedDeviation);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; ATexture: IBGRAScanner;
+  AAcceptedDeviation: single);
+begin
+  fill(ABitmap,AffineMatrixIdentity,ATexture,AAcceptedDeviation);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
+  AColor: TBGRAPixel; AAcceptedDeviation: single);
+begin
+  fill(ABitmap,AffineMatrixTranslation(x,y),AColor,AAcceptedDeviation);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; x, y: single;
+  ATexture: IBGRAScanner; AAcceptedDeviation: single);
+begin
+  fill(ABitmap,AffineMatrixTranslation(x,y),ATexture,AAcceptedDeviation);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
+  AColor: TBGRAPixel; AAcceptedDeviation: single);
+begin
+  ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), AColor);
+end;
+procedure TBGRAPath.fill(ABitmap: TBGRACustomBitmap; const AMatrix: TAffineMatrix;
+  ATexture: IBGRAScanner; AAcceptedDeviation: single);
+begin
+  ABitmap.FillPolyAntialias(ToPoints(AMatrix,AAcceptedDeviation), ATexture);
+end;
+procedure TBGRAPath.fill(AFillProc: TBGRAPathFillProc; const AMatrix: TAffineMatrix;
+  AAcceptedDeviation: single; AData: pointer);
+begin
+  AFillProc(ToPoints(AMatrix,AAcceptedDeviation), AData);
+end;
+function TBGRAPath.CreateCursor(AAcceptedDeviation: single): TBGRAPathCursor;
+begin
+  result := TBGRAPathCursor.Create(self, AAcceptedDeviation);
+end;
+procedure TBGRAPath.Fit(ARect: TRectF; AAcceptedDeviation: single);
+var
+  temp: TBGRAPath;
+begin
+  temp := TBGRAPath.Create;
+  copyTo(temp);
+  temp.FitInto(self, ARect, AAcceptedDeviation);
+  temp.Free;
+end;
+procedure TBGRAPath.FitInto(ADest: TBGRAPath; ARect: TRectF;
+  AAcceptedDeviation: single);
+var bounds: TRectF;
+    zoomX,zoomY: single;
+begin
+  bounds := GetBounds(AAcceptedDeviation);
+  ADest.beginPath;
+  ADest.translate((ARect.Left+ARect.Right)*0.5, (ARect.Bottom+ARect.Top)*0.5);
+  if bounds.Right-bounds.Left <> 0 then
+  begin
+    zoomX := (ARect.Right-ARect.Left)/(bounds.Right-bounds.Left);
+    if bounds.Bottom-bounds.Top > 0 then
+    begin
+      zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
+      if zoomY < zoomX then ADest.scale(zoomY) else ADest.scale(zoomX);
+    end else
+      ADest.scale(zoomX);
+  end else
+  if bounds.Bottom-bounds.Top > 0 then
+  begin
+    zoomY := (ARect.Bottom-ARect.Top)/(bounds.Bottom-bounds.Top);
+    ADest.scale(zoomY);
+  end;
+  ADest.translate(-(bounds.Left+bounds.Right)*0.5, -(bounds.Bottom+bounds.Top)*0.5);
+  copyTo(ADest);
+  ADest.resetTransform;
+end;
 function TBGRAPath.GetSvgString: string;
 const RadToDeg = 180/Pi;
+var savedPos: integer;
+    a: TArcDef;
+    formats: TFormatSettings;
+    lastPos,p1: TPointF;
+    implicitCommand: char;
+var
+  formats: TFormatSettings;
+  lastPosF: TPointF;
+  implicitCommand: char;
   function FloatToString(value: single): string;
 …
   function CoordToString(const pt: TPointF): string;
   begin
     lastPos := pt;
+    lastPosF := pt;
     result := FloatToString(pt.x)+FloatToString(pt.y);
   end;
 …
   end;
+var param: string;
+var elemType: TBGRAPathElementType;
+    elem: pointer;
+    a: PArcElement;
+    Pos: PtrInt;
+    p1: TPointF;
+    pts: array of TPointF;
+    i: integer;
 begin
   formats := DefaultFormatSettings;
 …
   result := '';
+  savedPos:= FDataPos;
+  FDataPos := 0;
+  lastPos := EmptyPointF;
+  Pos := 0;
+  lastPosF := 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;
+  repeat
+    GetElementAt(Pos, elemType, elem);
+    if elem = nil then break;
+    case elemType of
+      peMoveTo: addCommand('M',CoordToString(PPointF(elem)^));
+      peLineTo: addCommand('L',CoordToString(PPointF(elem)^));
+      peCloseSubPath: addCommand('z','');
+      peQuadraticBezierTo:
+        with PQuadraticBezierToElement(elem)^ do
+          addCommand('Q',CoordToString(ControlPoint)+CoordToString(Destination));
+      peCubicBezierTo:
+        with PCubicBezierToElement(elem)^ do
+          addCommand('C',CoordToString(ControlPoint1)+
+               CoordToString(ControlPoint2)+CoordToString(Destination));
+      peArc:
+        begin
+          a := PArcElement(elem);
+          p1 := ArcStartPoint(a^);
+          if isEmptyPointF(lastPosF) or (p1 <> lastPosF) then
+            addCommand('L',CoordToString(p1));
+          addCommand('A',CoordToString(a^.radius)+
+             FloatToString(a^.xAngleRadCW*RadToDeg)+
+             BoolToString(IsLargeArc(a^))+
+             BoolToString(not a^.anticlockwise)+
+             CoordToString(ArcEndPoint(a^)));
+        end;
+      peOpenedSpline, peClosedSpline:
+        begin
+          pts := GetPolygonalApprox(Pos, 0.1,True);
+          for i := 0 to high(pts) do
+          begin
+            if isEmptyPointF(lastPosF) then
+              addCommand('M',CoordToString(pts[i]))
+            else
+              addCommand('L',CoordToString(pts[i]));
+          end;
+        end;
+    end;
+  until not GoToNextElement(Pos);
 end;
 …
 end;
+procedure TBGRAPath.RegisterCursor(ACursor: TBGRAPathCursor);
+begin
+  setlength(FCursors, length(FCursors)+1);
+  FCursors[high(FCursors)] := ACursor;
+end;
+procedure TBGRAPath.UnregisterCursor(ACursor: TBGRAPathCursor);
+var
+  i,j: Integer;
+begin
+  for i := high(FCursors) downto 0 do
+    if FCursors[i] = ACursor then
+    begin
+      for j := i to high(FCursors)-1 do
+        FCursors[j] := FCursors[j+1];
+      setlength(FCursors, length(FCursors)-1);
+      exit;
+    end;
+end;
+function TBGRAPath.SetLastCoord(ACoord: TPointF): TPointF;
+begin
+  FLastCoord := ACoord;
+  FLastTransformedCoord := FMatrix*ACoord;
+  result := FLastTransformedCoord;
+end;
+procedure TBGRAPath.ClearLastCoord;
+begin
+  FLastCoord := EmptyPointF;
+  FLastTransformedCoord := EmptyPointF;
+end;
+procedure TBGRAPath.BezierCurveFromTransformed(tcp1, cp2, pt: TPointF);
+begin
+  with PCubicBezierToElement(AllocateElement(peCubicBezierTo))^ do
+  begin
+    ControlPoint1 := tcp1;
+    ControlPoint2 := FMatrix*cp2;
+    Destination := SetLastCoord(pt);
+    FExpectedTransformedControlPoint := Destination + (Destination-ControlPoint2);
+  end;
+end;
+procedure TBGRAPath.QuadraticCurveFromTransformed(tcp, pt: TPointF);
+begin
+  with PQuadraticBezierToElement(AllocateElement(peQuadraticBezierTo))^ do
+  begin
+    ControlPoint := tcp;
+    Destination := SetLastCoord(pt);
+    FExpectedTransformedControlPoint := Destination+(Destination-ControlPoint);
+  end;
+end;
+function TBGRAPath.LastCoordDefined: boolean;
+begin
+  result := not isEmptyPointF(FLastTransformedCoord);
+end;
+function TBGRAPath.GetPolygonalApprox(APos: IntPtr; AAcceptedDeviation: single; AIncludeFirstPoint: boolean): ArrayOfTPointF;
+var pts: ArrayOfTPointF;
+  elemType: TBGRAPathElementType;
+  elem: pointer;
+  pt : TPointF;
+  i: NativeInt;
+begin
+  GetElementAt(APos, elemType, elem);
+  case elemType of
+    peQuadraticBezierTo:
+      with PQuadraticBezierToElement(elem)^ do
+        result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
+    peCubicBezierTo:
+      with PCubicBezierToElement(elem)^ do
+        result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ToPoints(AAcceptedDeviation, AIncludeFirstPoint);
+    peArc:
+      begin
+        result := ComputeArc(PArcElement(elem)^, 0.1/AAcceptedDeviation);
+        pt := GetElementStartCoord(APos);
+        if pt <> result[0] then
+        begin
+          setlength(result, length(result)+1);
+          for i := high(result) downto 1 do
+            result[i] := result[i-1];
+          result[0] := pt;
+        end;
+      end;
+    peOpenedSpline, peClosedSpline:
+      with PSplineElement(elem)^ do
+      begin
+        setlength(pts, NbControlPoints);
+        move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
+        if elemType = peOpenedSpline then
+          result := ComputeOpenedSpline(pts, SplineStyle, 0.25, AAcceptedDeviation)
+        else
+          result := ComputeClosedSpline(pts, SplineStyle, AAcceptedDeviation);
+      end;
+  end;
+end;
+function TBGRAPath.getPoints: ArrayOfTPointF;
+begin
+  result := ToPoints;
+end;
+function TBGRAPath.getPoints(AMatrix: TAffineMatrix): ArrayOfTPointF;
+begin
+  result := ToPoints(AMatrix);
+end;
+function TBGRAPath.getCursor: TBGRACustomPathCursor;
+begin
+  result := CreateCursor;
+end;
+procedure TBGRAPath.InternalDraw(ADrawProc: TBGRAPathDrawProc;
+  const AMatrix: TAffineMatrix; AAcceptedDeviation: single; AData: pointer);
+var
+  nbSub: NativeInt;
+  procedure OutputSub(subPathStartPos, subPathEndPos: IntPtr);
+  var
+    sub: array of ArrayOfTPointF;
+    temp: ArrayOfTPointF;
+    startPos,pos,nbPts,curPt,curSub: NativeInt;
+    elemType: TBGRAPathElementType;
+    elem: pointer;
+  begin
+    pos := subPathStartPos;
+    setlength(sub, nbSub);
+    curSub := 0;
+    while (pos <= subPathEndPos) and (curSub < nbSub) do
+    begin
+      GetElementAt(pos, elemType, elem);
+      if elem = nil then break;
+      case elemType of
+        peMoveTo,peLineTo,peCloseSubPath: begin
+            startPos := pos;
+            if (elemType = peMoveTo) and (curSub > 0) then
+              nbPts := 2
+            else
+              nbPts := 1;
+            while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+            begin
+              GoToNextElement(pos);
+              inc(nbPts);
+            end;
+            setlength(temp, nbPts);
+            pos := startPos;
+            if (elemType = peMoveTo) and (curSub > 0) then
+            begin
+              temp[0] := EmptyPointF;
+              temp[1] := PPointF(elem)^;
+              curPt := 2;
+            end else
+            begin
+              temp[0] := PPointF(elem)^;
+              curPt := 1;
+            end;
+            while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+            begin
+              GoToNextElement(pos);
+              GetElementAt(pos, elemType, elem);
+              temp[curPt] := PPointF(elem)^;
+              inc(curPt);
+            end;
+            sub[curSub] := temp;
+            inc(curSub);
+            temp := nil;
+          end;
+        peQuadraticBezierTo,peCubicBezierTo,peArc,
+        peOpenedSpline, peClosedSpline:
+          begin
+            sub[curSub] := GetPolygonalApprox(pos, AAcceptedDeviation, False);
+            inc(curSub);
+          end;
+      end;
+      GoToNextElement(pos);
+    end;
+    temp := ConcatPointsF(sub);
+    if not IsAffineMatrixIdentity(AMatrix) then
+      temp := AMatrix*temp;
+    if (elemType = peCloseSubPath) or ((curSub = 2) and (elemType = peClosedSpline)) then
+      ADrawProc(temp, True, AData)
+    else
+      ADrawProc(temp, False, AData);
+  end;
+var
+  subPathStartPos: IntPtr;
+  prevPos,pos: PtrInt;
+  elemType: TBGRAPathElementType;
+  elem: pointer;
+begin
+  AAcceptedDeviation := CorrectAcceptedDeviation(AAcceptedDeviation, AMatrix);
+  pos := 0;
+  nbSub := 0;
+  subPathStartPos := pos;
+  repeat
+    prevPos := pos;
+    GetElementAt(pos, elemType, elem);
+    if elem = nil then
+    begin
+      pos := prevPos;
+      break;
+    end;
+    if (elemType = peMoveTo) and (nbSub > 0) then
+    begin
+      OutputSub(subPathStartPos,prevPos);
+      nbSub := 0;
+      subPathStartPos := pos;
+    end;
+    case elemType of
+      peMoveTo,peLineTo,peCloseSubPath: begin
+          inc(nbSub);
+          while PeekNextElement(pos) in[peLineTo,peCloseSubPath] do
+            GoToNextElement(pos);
+        end;
+      peQuadraticBezierTo, peCubicBezierTo, peArc, peOpenedSpline, peClosedSpline: inc(nbSub);
+    end;
+  until not GoToNextElement(pos);
+  if nbSub > 0 then OutputSub(subPathStartPos,pos);
+end;
 procedure TBGRAPath.addPath(const AValue: string);
 var p: integer;
     numberError: boolean;
+    startCoord,lastCoord: TPointF;
   function parseFloat: single;
 …
     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);
+    if (p <= length(AValue)) and (AValue[p] in['e','E']) then
+    begin
+      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);
+    end;
     val(copy(AValue,numberStart,p-numberStart),result,errPos);
     if errPos <> 0 then numberError := true;
 …
   function parseCoord(relative: boolean): TPointF;
   begin
+    result := PointF(parseFloat,parseFloat);
+    if relative and not isEmptyPointF(FLastCoord) then result += FLastCoord;
+    result.x := parseFloat;
+    result.y := parseFloat;
+    if relative and not isEmptyPointF(lastCoord) then result += lastCoord;
+    if isEmptyPointF(lastCoord) then startCoord := result;
   end;
 …
   largeArc: boolean;
 begin
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
+  BeginSubPath;
+  lastCoord := EmptyPointF;
+  startCoord := EmptyPointF;
   p := 1;
   implicitCommand:= #0;
 …
            closePath;
            implicitCommand:= #0;
+           lastCoord := startCoord;
          end;
     'M': begin
            p1 := parseCoord(relative);
+           if not numberError then moveTo(p1);
+           if not numberError then
+           begin
+             moveTo(p1);
+             lastCoord := p1;
+           end;
            if relative then implicitCommand:= 'l' else
              implicitCommand:= 'L';
 …
     'L': begin
            p1 := parseCoord(relative);
+           if not numberError then lineTo(p1);
+           if not numberError then
+           begin
+             lineTo(p1);
+             lastCoord := p1;
+           end;
       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);
+        if not isEmptyPointF(lastCoord) then
+        begin
+          p1 := lastCoord;
+          if relative then p1.x += parseFloat
+          else p1.x := parseFloat;
+        end else
+        begin
+          p1 := PointF(parseFloat,0);
+          lastCoord := p1;
+          startCoord := p1;
+        end;
+        if not numberError then
+        begin
+          lineTo(p1);
+          lastCoord := p1;
+        end;
       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);
+        if not isEmptyPointF(lastCoord) then
+        begin
+          p1 := lastCoord;
+          if relative then p1.y += parseFloat
+          else p1.y := parseFloat;
+        end else
+        begin
+          p1 := PointF(0,parseFloat);
+          lastCoord := p1;
+          startCoord := p1;
+        end;
+        if not numberError then
+        begin
+          lineTo(p1);
+          lastCoord := p1;
+        end;
       end;
     'C': begin
 …
         c2 := parseCoord(relative);
         p1 := parseCoord(relative);
+        if not numberError then bezierCurveTo(c1,c2,p1);
+        if not numberError then
+        begin
+          bezierCurveTo(c1,c2,p1);
+          lastCoord := p1;
+        end;
       end;
     'S': begin
         c2 := parseCoord(relative);
         p1 := parseCoord(relative);
+        if not numberError then smoothBezierCurveTo(c2,p1);
+        if not numberError then
+        begin
+          smoothBezierCurveTo(c2,p1);
+          lastCoord := p1;
+        end;
       end;
     'Q': begin
         c1 := parseCoord(relative);
         p1 := parseCoord(relative);
+        if not numberError then quadraticCurveTo(c1,p1);
+        if not numberError then
+        begin
+          quadraticCurveTo(c1,p1);
+          lastCoord := p1;
+        end;
       end;
     'T': begin
         p1 := parseCoord(relative);
+        if not numberError then smoothQuadraticCurveTo(p1);
+      end;
+    'A': begin
+        a.radius := parseCoord(false);
+        if not numberError then
+        begin
+          smoothQuadraticCurveTo(p1);
+          lastCoord := p1;
+        end;
+    end;
+    'A':
+      begin
+        a.radius.x := parseFloat;
+        a.radius.y := parseFloat;
         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);
+        if not numberError then
+        begin
+          arcTo(a.radius.x,a.radius.y,a.xAngleRadCW,largeArc,a.anticlockwise,p1.x,p1.y);
+          lastCoord := p1;
+        end;
       end;
     end;
 …
 end;
+procedure TBGRAPath.openedSpline(const pts: array of TPointF;
+  style: TSplineStyle);
+var elem: PSplineElement;
+  i: NativeInt;
+  p: PPointF;
+begin
+  if length(pts) <= 2 then
+  begin
+    polyline(pts);
+    exit;
+  end;
+  if not LastCoordDefined then moveTo(pts[0]);
+  elem := AllocateElement(peOpenedSpline, length(pts)*sizeof(TPointF));
+  elem^.NbControlPoints := length(pts);
+  elem^.SplineStyle := style;
+  p := PPointF(elem+1);
+  for i := 0 to high(pts)-1 do
+  begin
+    p^ := FMatrix*pts[i];
+    inc(p);
+  end;
+  p^ := SetLastCoord(pts[high(pts)]);
+  inc(p);
+  PInteger(p)^ := length(pts);
+end;
+procedure TBGRAPath.closedSpline(const pts: array of TPointF;
+  style: TSplineStyle);
+var elem: PSplineElement;
+  i: NativeInt;
+  p: PPointF;
+begin
+  if length(pts) = 0 then exit;
+  if not LastCoordDefined then moveTo(ClosedSplineStartPoint(pts, style));
+  if length(pts) <= 2 then exit;
+  elem := AllocateElement(peClosedSpline, length(pts)*sizeof(TPointF));
+  elem^.NbControlPoints := length(pts);
+  elem^.SplineStyle := style;
+  p := PPointF(elem+1);
+  for i := 0 to high(pts) do
+  begin
+    p^ := FMatrix*pts[i];
+    inc(p);
+  end;
+  PInteger(p)^ := length(pts);
+end;
+procedure TBGRAPath.BitmapDrawSubPathProc(const APoints: array of TPointF;
+  AClosed: boolean; AData: pointer);
+begin
+  with TStrokeData(AData^) do
+  if AClosed then
+  begin
+    if Texture <> nil then
+      Bitmap.DrawPolygonAntialias(APoints, Texture, Width)
+    else
+      Bitmap.DrawPolygonAntialias(APoints, Color, Width);
+  end else
+  begin
+    if Texture <> nil then
+      Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Texture, Width)
+    else
+      Bitmap.DrawPolyLineAntialiasAutocycle(APoints, Color, Width);
+  end;
+end;
+function TBGRAPath.CorrectAcceptedDeviation(AAcceptedDeviation: single;
+  const AMatrix: TAffineMatrix): single;
+var maxZoom: single;
+begin
+  //determine the zoom of the matrix
+  maxZoom := Max(VectLen(PointF(AMatrix[1,1],AMatrix[2,1])),
+     VectLen(PointF(AMatrix[1,2],AMatrix[2,2])));
+  //make the accepted deviation smaller if the matrix zooms to avoid that
+  // curves would look angular
+  if maxZoom = 0 then
+    result:= 1e10
+  else
+    result := AAcceptedDeviation / maxZoom;
+end;
+procedure TBGRAPath.OnModify;
+begin
+  if length(FCursors)> 0 then
+      raise Exception.Create('You cannot modify the path when there are cursors');
+end;
+procedure TBGRAPath.OnMatrixChange;
+begin
+  //transformed coord are not changed,
+  //but original coords are lost in the process.
+  //this has a consequence when using
+  //arc functions that rely on the previous
+  //coordinate
+  FLastCoord := EmptyPointF;
+  FSubPathStartCoord := EmptyPointF;
+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));
+  OnModify;
+  if FDataPos + count > FDataCapacity then
+  begin
+    FDataCapacity := (FDataCapacity shl 1)+8;
+    if FDataPos + count + 8 > FDataCapacity then
+      FDataCapacity := FDataPos + count + 8;
+    ReAllocMem(FData, FDataCapacity);
+  end;
+end;
+function TBGRAPath.AllocateElement(AElementType: TBGRAPathElementType;
+  AExtraBytes: PtrInt): Pointer;
+var t: PtrInt;
+begin
+  if not (AElementType in [succ(peNone)..high(TBGRAPathElementType)]) then
+    raise exception.Create('Invalid element type');
+  OnModify;
+  t := PathElementSize[AElementType]+AExtraBytes;
+  NeedSpace(SizeOf(TPathElementHeader)+t);
+  with PPathElementHeader(FData+FDataPos)^ do
+  begin
+    ElementType:= AElementType;
+    PreviousElementType := FLastStoredElementType;
+  end;
+  result := FData+(FDataPos+SizeOf(TPathElementHeader));
+  FLastSubPathElementType:= AElementType;
+  FLastStoredElementType:= AElementType;
+  Inc(FDataPos, sizeof(TPathElementHeader)+t);
 end;
 …
 begin
   FData := nil;
+  FDataSize := 0;
+  FDataPos := 0;
+  FLastElementType := peNone;
+  FLastCoord := EmptyPointF;
+  FStartCoord := EmptyPointF;
+  FExpectedControlPoint := EmptyPointF;
+  FDataCapacity := 0;
+  FLastMoveToDataPos := -1;
+  beginPath;
   resetTransform;
+end;
+function TBGRAPath.GoToNextElement(var APos: PtrInt): boolean;
+var newPos: PtrInt;
+  p: PSplineElement;
+  elemType: TBGRAPathElementType;
+begin
+  if APos >= FDataPos then
+    result := false
+  else
+  begin
+    elemType := PPathElementHeader(FData+APos)^.ElementType;
+    newPos := APos + sizeof(TPathElementHeader) + PathElementSize[elemType];
+    if elemType in[peOpenedSpline,peClosedSpline] then
+    begin
+      p := PSplineElement(FData+(APos+sizeof(TPathElementHeader)));
+      newPos += p^.NbControlPoints * sizeof(TPointF); //extra
+    end;
+    if newPos < FDataPos then
+    begin
+      result := true;
+      APos := newPos;
+      if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
+        not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
+          raise exception.Create('Internal structure error');
+    end
+    else
+      result := false;
+  end;
+end;
+function TBGRAPath.GoToPreviousElement(var APos: PtrInt): boolean;
+var lastElemType: TBGRAPathElementType;
+begin
+  if APos <= 0 then
+    result := false
+  else
+  begin
+    result := true;
+    if (APos = FDataPos) then
+      lastElemType := FLastStoredElementType
+    else
+      lastElemType := PPathElementHeader(FData+APos)^.PreviousElementType;
+    if lastElemType in [peOpenedSpline,peClosedSpline] then
+      dec(APos, (PInteger(FData+APos)-1)^ *sizeof(TPointF)); //extra
+    dec(APos, sizeof(TPathElementHeader) + PathElementSize[lastElemType]);
+    if not CheckElementType(PPathElementHeader(FData+APos)^.ElementType) or
+      not CheckElementType(PPathElementHeader(FData+APos)^.PreviousElementType) then
+        raise exception.Create('Internal structure error');
+  end;
+end;
+function TBGRAPath.PeekNextElement(APos: PtrInt): TBGRAPathElementType;
+begin
+  if not GoToNextElement(APos) then
+    result := peNone
+  else
+    result := PPathElementHeader(FData+APos)^.ElementType;
+end;
+function TBGRAPath.GetElementStartCoord(APos: PtrInt): TPointF;
+var
+  elemType: TBGRAPathElementType;
+  elem: pointer;
+begin
+  GetElementAt(APos, elemType, elem);
+  case elemType of
+  peNone: raise exception.Create('No element');
+  peMoveTo: result := PPointF(elem)^;
+  else
+    begin
+      if not GoToPreviousElement(APos) then
+        raise exception.Create('No previous element')
+      else
+      begin
+        result := GetElementEndCoord(APos);
+      end;
+    end;
+  end;
+end;
+function TBGRAPath.GetElementEndCoord(APos: PtrInt): TPointF;
+var elemType: TBGRAPathElementType;
+  elem: pointer;
+begin
+  GetElementAt(APos, elemType, elem);
+  case elemType of
+  peMoveTo,peLineTo,peCloseSubPath: result := PPointF(elem)^;
+  peQuadraticBezierTo: result := PQuadraticBezierToElement(elem)^.Destination;
+  peCubicBezierTo: result := PCubicBezierToElement(elem)^.Destination;
+  peArc: result := ArcEndPoint(PArcElement(elem)^);
+  peClosedSpline: result := PPointF(PSplineElement(elem)+1)^;
+  peOpenedSpline: result := (PPointF(PSplineElement(elem)+1)+(PSplineElement(elem)^.NbControlPoints-1))^;
+  else
+    result := EmptyPointF;
+  end;
+end;
+function TBGRAPath.GetElementLength(APos: PtrInt; AAcceptedDeviation: single): Single;
+var elemType: TBGRAPathElementType;
+  elem: pointer;
+  pts: array of TPointF;
+begin
+  GetElementAt(APos, elemType, elem);
+  case elemType of
+  peMoveTo: result := 0;
+  peLineTo,peCloseSubPath: result := VectLen(PPointF(elem)^ - GetElementStartCoord(APos))*FScale;
+  peQuadraticBezierTo: with PQuadraticBezierToElement(elem)^ do
+      result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint,Destination).ComputeLength;
+  peCubicBezierTo: with PCubicBezierToElement(elem)^ do
+      result := BGRABitmapTypes.BezierCurve(GetElementStartCoord(APos),ControlPoint1,ControlPoint2,Destination).ComputeLength(AAcceptedDeviation);
+  peArc: begin
+      result := VectLen(ArcStartPoint(PArcElement(elem)^) - GetElementStartCoord(APos));
+      result += PolylineLen(ComputeArc(PArcElement(elem)^, 0.1/AAcceptedDeviation));
+    end;
+  peClosedSpline,peOpenedSpline:
+    begin
+      pts := GetPolygonalApprox(APos, AAcceptedDeviation, true);
+      result := PolylineLen(pts) + VectLen(pts[0]-GetElementStartCoord(APos));
+    end
+  else
+    result := 0;
+  end;
+end;
+procedure TBGRAPath.GetElementAt(APos: PtrInt; out
+  AElementType: TBGRAPathElementType; out AElement: pointer);
+begin
+  if APos >= FDataPos then
+  begin
+    AElementType := peNone;
+    AElement := nil;
+  end else
+  begin
+    AElementType:= PPathElementHeader(FData+APos)^.ElementType;
+    AElement := FData+(APos+sizeof(TPathElementHeader));
+  end;
 end;
 …
 end;
+constructor TBGRAPath.Create(const APoints: ArrayOfTPointF);
+begin
+  Init;
+  SetPoints(APoints);
+end;
+constructor TBGRAPath.Create(APath: IBGRAPath);
+begin
+  Init;
+  APath.copyTo(self);
+end;
 destructor TBGRAPath.Destroy;
+begin
+var i: integer;
+begin
+  for I := 0 to high(FCursors) do
+    FCursors[i].OnPathFree;
   if Assigned(FData) then
   begin
 …
 procedure TBGRAPath.beginPath;
 begin
+  DoClear;
+end;
+procedure TBGRAPath.beginSubPath;
+begin
+  OnModify;
+  FLastSubPathElementType := peNone;
+  ClearLastCoord;
+  FSubPathStartCoord := EmptyPointF;
+  FExpectedTransformedControlPoint := EmptyPointF;
+end;
+procedure TBGRAPath.DoClear;
+begin
+  OnModify;
   FDataPos := 0;
+  BeginSubPath;
+end;
+function TBGRAPath.CheckElementType(AElementType: TBGRAPathElementType): boolean;
+begin
+  result := AElementType <= high(TBGRAPathElementType);
 end;
 procedure TBGRAPath.closePath;
+begin
+  if (FLastElementType <> peNone) and (FLastElementType <> peCloseSubPath) then
+  begin
+    StoreElementType(peCloseSubPath);
+    FLastCoord := FStartCoord;
+var
+  moveToType: TBGRAPathElementType;
+  moveToElem: pointer;
+begin
+  if (FLastSubPathElementType <> peNone) and (FLastSubPathElementType <> peCloseSubPath) then
+  begin
+    with PClosePathElement(AllocateElement(peCloseSubPath))^ do
+    begin
+      StartCoordinate := FSubPathTransformedStartCoord;
+      LoopDataPos := FLastMoveToDataPos;
+    end;
+    if FLastMoveToDataPos <> -1 then
+    begin
+      GetElementAt(FLastMoveToDataPos,moveToType,moveToElem);
+      PMoveToElement(moveToElem)^.LoopDataPos := FDataPos;
+      FLastMoveToDataPos:= -1;
+    end;
+    FLastCoord := FSubPathStartCoord;
+    FLastTransformedCoord := FSubPathTransformedStartCoord;
   end;
 end;
 …
 procedure TBGRAPath.translate(x, y: single);
 begin
+  OnMatrixChange;
   FMatrix *= AffineMatrixTranslation(x,y);
 end;
 …
 procedure TBGRAPath.resetTransform;
 begin
+  OnMatrixChange;
   FMatrix := AffineMatrixIdentity;
   FAngleRadCW := 0;
 …
 procedure TBGRAPath.rotate(angleRadCW: single);
 begin
+  OnMatrixChange;
   FMatrix *= AffineMatrixRotationRad(-angleRadCW);
   FAngleRadCW += angleRadCW;
 …
 procedure TBGRAPath.scale(factor: single);
 begin
+  OnMatrixChange;
   FMatrix *= AffineMatrixScale(factor,factor);
   FScale *= factor;
 …
 procedure TBGRAPath.moveTo(const pt: TPointF);
 begin
+  if FLastElementType <> peMoveTo then
+  begin
+    StoreElementType(peMoveTo);
+    StoreCoord(pt);
+  if FLastSubPathElementType <> peMoveTo then
+  begin
+    FLastMoveToDataPos:= FDataPos;
+    with PMoveToElement(AllocateElement(peMoveTo))^ do
+    begin
+      StartCoordinate := SetLastCoord(pt);
+      LoopDataPos := -1;
+    end
   end else
+  begin
+    RewindFloat;
+    RewindFloat;
+    StoreCoord(pt);
+  end;
+  FLastCoord := pt;
+  FStartCoord := FLastCoord;
+    PMoveToElement(FData+(FDataPos-Sizeof(TMoveToElement)))^.StartCoordinate := SetLastCoord(pt);
+  FSubPathStartCoord := FLastCoord;
+  FSubPathTransformedStartCoord := FLastTransformedCoord;
 end;
 procedure TBGRAPath.lineTo(const pt: TPointF);
+begin
+  if not isEmptyPointF(FLastCoord) then
+  begin
+    StoreElementType(peLineTo);
+    StoreCoord(pt);
+    FLastCoord := pt;
+var lastTransfCoord, newTransfCoord: TPointF;
+begin
+  if LastCoordDefined then
+  begin
+    lastTransfCoord := FLastTransformedCoord;
+    newTransfCoord := SetLastCoord(pt);
+    if newTransfCoord <> lastTransfCoord then
+      PPointF(AllocateElement(peLineTo))^ := newTransfCoord;
   end else
     moveTo(pt);
 end;
+procedure TBGRAPath.polyline(const pts: array of TPointF);
+var i: integer;
+begin
+  if length(pts) = 0 then exit;
+  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
+  moveTo(pts[0]);
+  for i := 1 to high(pts) do lineTo(pts[i]);
+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);
+  NeedSpace((sizeof(TPathElementHeader)+sizeof(TPointF))*length(pts));
+  for i := 0 to high(pts) do lineTo(pts[i]);
+end;
+procedure TBGRAPath.polygon(const pts: array of TPointF);
+var lastPt: integer;
+begin
+  if length(pts) = 0 then exit;
+  lastPt := high(pts);
+  while (lastPt > 1) and (pts[lastPt] = pts[0]) do dec(lastPt);
+  if lastPt <> high(pts) then
+    polyline(slice(pts,lastPt+1))
+  else
+    polyline(pts);
+  closePath;
 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
+  if LastCoordDefined then
+    QuadraticCurveFromTransformed(FMatrix*cp, pt) else
+  begin
     lineTo(pt);
+  FExpectedControlPoint := pt+(pt-cp);
+    FExpectedTransformedControlPoint := FMatrix*(pt+(pt-cp));
+  end;
 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);
+  if not LastCoordDefined then moveTo(cp1);
+  BezierCurveFromTransformed(FMatrix*cp1, cp2, pt);
 end;
 …
 end;
+procedure TBGRAPath.bezierCurve(p1, cp1, cp2, p2: TPointF);
+begin
+  moveTo(p1);
+  bezierCurveTo(cp1,cp2,p2);
+end;
 procedure TBGRAPath.smoothBezierCurveTo(cp2x, cp2y, x, y: single);
 begin
 …
 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)
+  if (FLastSubPathElementType = peCubicBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
+    BezierCurveFromTransformed(FExpectedTransformedControlPoint,cp2,pt)
+  else if LastCoordDefined then
+    BezierCurveFromTransformed(FLastTransformedCoord,cp2,pt)
   else
     bezierCurveTo(cp2,cp2,pt);
 …
 end;
+procedure TBGRAPath.quadraticCurve(p1, cp, p2: TPointF);
+begin
+  moveTo(p1);
+  quadraticCurveTo(cp,p2);
+end;
 procedure TBGRAPath.smoothQuadraticCurveTo(x, y: single);
 begin
 …
 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)
+  if (FLastSubPathElementType = peQuadraticBezierTo) and not isEmptyPointF(FExpectedTransformedControlPoint) then
+    QuadraticCurveFromTransformed(FExpectedTransformedControlPoint,pt)
+  else if LastCoordDefined then
+    QuadraticCurveFromTransformed(FLastTransformedCoord,pt)
   else
     quadraticCurveTo(pt,pt);
 …
 var p0 : TPointF;
 begin
   if isEmptyPointF(FLastCoord) then
+  if IsEmptyPointF(FLastCoord) then
     p0 := p1 else p0 := FLastCoord;
   arc(Html5ArcTo(p0,p1,p2,radius));
 …
 procedure TBGRAPath.arc(const arcDef: TArcDef);
 var transformedArc: TArcDef;
+var transformedArc: TArcElement;
 begin
   if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then
 …
   else
   begin
     if isEmptyPointF(FLastCoord) then
+    if not LastCoordDefined then
       moveTo(ArcStartPoint(arcDef));
-    StoreElementType(peArc);
-    NeedSpace(sizeof(TArcDef));
     transformedArc.anticlockwise := arcDef.anticlockwise;
     transformedArc.startAngleRadCW := arcDef.startAngleRadCW;
 …
     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,
+    PArcElement(AllocateElement(peArc))^ := transformedArc;
+        {$PUSH}{$OPTIMIZATION OFF}
+    SetLastCoord(ArcEndPoint(arcDef));
+        {$POP}
+  end;
+end;
+procedure TBGRAPath.arc(cx, cy, rx, ry: single; xAngleRadCW, startAngleRadCW,
   endAngleRadCW: single);
 begin
 …
   anticlockwise: boolean; x, y: single);
 begin
   if isEmptyPointF(FLastCoord) then
+  if IsEmptyPointF(FLastCoord) then
     moveTo(x,y)
   else
 …
 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;
+var pos: IntPtr;
+    elemType: TBGRAPathElementType;
+    elem: Pointer;
+    pts: array of TPointF;
+begin
+  pos := 0;
+  repeat
+    GetElementAt(pos, elemType, elem);
+    if elem = nil then break;
+    case elemType of
+      peMoveTo: dest.moveTo(PPointF(elem)^);
+      peLineTo: dest.lineTo(PPointF(elem)^);
+      peCloseSubPath: dest.closePath;
+      peQuadraticBezierTo:
+        with PQuadraticBezierToElement(elem)^ do
+          dest.quadraticCurveTo(ControlPoint,Destination);
+      peCubicBezierTo:
+        with PCubicBezierToElement(elem)^ do
+          dest.bezierCurveTo(ControlPoint1,ControlPoint2,Destination);
+      peArc: dest.arc(PArcElement(elem)^);
+      peOpenedSpline, peClosedSpline:
+        begin
+          with PSplineElement(elem)^ do
+          begin
+            setlength(pts, NbControlPoints);
+            move(Pointer(PSplineElement(elem)+1)^, pts[0], NbControlPoints*sizeof(TPointF));
+            if elemType = peOpenedSpline then
+              dest.openedSpline(pts, SplineStyle)
+            else
+              dest.closedSpline(pts, SplineStyle);
+            pts := nil;
+          end;
+        end;
+    end;
+  until not GoToNextElement(pos);
 end;

GraphicTest/Packages/bgrabitmap/bgrapen.pas

-              r472
+              r494
 uses
   SysUtils, Graphics, BGRABitmapTypes;
+  SysUtils, BGRAGraphics, BGRABitmapTypes, BGRATransform;
 var   //predefined pen styles
 …
 type
+  { TBGRAPenStroker }
+  TBGRAPenStroker = class(TBGRACustomPenStroker)
+    protected
+      { Pen style can be defined by PenStyle property of by CustomPenStyle property.
+      When PenStyle property is assigned, CustomPenStyle property is assigned the actual
+      pen pattern. }
+      FCustomPenStyle: TBGRAPenStyle;
+      FPenStyle: TPenStyle;
+      FArrow: TBGRACustomArrow;
+      FArrowOwned: boolean;
+      FOriginalStrokeMatrix,FStrokeMatrix,FStrokeMatrixInverse: TAffineMatrix;
+      FStrokeZoom: single;
+      FStrokeMatrixIdentity: boolean;
+      FLineCap: TPenEndCap;
+      FJoinStyle: TPenJoinStyle;
+      FMiterLimit: single;
+      function GetArrow: TBGRACustomArrow; override;
+      function GetArrowOwned: boolean; override;
+      function GetCustomPenStyle: TBGRAPenStyle; override;
+      function GetJoinStyle: TPenJoinStyle; override;
+      function GetLineCap: TPenEndCap; override;
+      function GetMiterLimit: single; override;
+      function GetPenStyle: TPenStyle; override;
+      function GetStrokeMatrix: TAffineMatrix; override;
+      procedure SetArrow(AValue: TBGRACustomArrow); override;
+      procedure SetArrowOwned(AValue: boolean); override;
+      procedure SetCustomPenStyle(AValue: TBGRAPenStyle); override;
+      procedure SetJoinStyle(AValue: TPenJoinStyle); override;
+      procedure SetLineCap(AValue: TPenEndCap); override;
+      procedure SetMiterLimit(AValue: single); override;
+      procedure SetPenStyle(AValue: TPenStyle); override;
+      procedure SetStrokeMatrix(const AValue: TAffineMatrix); override;
+    public
+      constructor Create;
+      destructor Destroy; override;
+      function ComputePolyline(const APoints: array of TPointF; AWidth: single; AClosedCap: boolean = true): ArrayOfTPointF; override;
+      function ComputePolyline(const APoints: array of TPointF; AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean = true): ArrayOfTPointF; override;
+      function ComputePolylineAutocycle(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override;
+      function ComputePolygon(const APoints: array of TPointF; AWidth: single): ArrayOfTPointF; override;
+  end;
   TBGRAPolyLineOption = (plRoundCapOpen, //specifies that the line ending is opened
                          plCycle,        //specifies that it is a polygon
 …
   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.
-  Else the pencolor parameter is used as a solid color. }
-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; 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; arrowStart: TComputeArrowHeadProc = nil; wantedStartArrowPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; WantedEndArrowPos: single = 0): ArrayOfTPointF;
+          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): 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; arrowStart: TComputeArrowHeadProc = nil; arrowStartPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; arrowEndPos: single = 0): ArrayOfTPointF;
+          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrow: TBGRACustomArrow = nil): ArrayOfTPointF;
 {--------------------- Pixel line procedures --------------------------}
 …
     end;
     dest.VertLine(X1,Y1,Y2,c, ADrawMode);
+        Exit;
   end;
 …
   styleLength := 0;
   styleIndex := -1;
+  remainingDash := 0;
+  betweenDash   := false;
   for i := 0 to high(penstyle) do
     if penstyle[i] <= 0 then
 …
 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; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single);
-var
-  widePolylinePoints: ArrayOfTPointF;
-begin
-  widePolylinePoints := ComputeWidePolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
-  if scan <> nil then
-    bmp.FillPolyAntialias(widePolylinePoints,scan)
-  else
-    bmp.FillPolyAntialias(widePolylinePoints,pencolor);
-end;
 function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single;
           pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
+          options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; wantedStartArrowPos: single; arrowEnd: TComputeArrowHeadProc; wantedEndArrowPos: single): ArrayOfTPointF;
+          options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF;
+const oneOver512 = 1/512;
 var
   startArrowPos, startArrowDir, endArrowPos, endArrowDir: TPointF;
 …
     hasStart,hasEnd: boolean;
   begin
     if assigned(arrowStart) and not isEmptyPointF(startArrowPos) then
       arrowStartData := arrowStart(startArrowPos, startArrowDir, width, startArrowLinePos)
+    if assigned(arrow) and not isEmptyPointF(startArrowPos) then
+      arrowStartData := arrow.ComputeStartAt(startArrowPos, startArrowDir, width, startArrowLinePos)
     else
       arrowStartData := nil;
     if assigned(arrowEnd) and not isEmptyPointF(endArrowPos) then
       arrowEndData := arrowEnd(endArrowPos, endArrowDir, width, endArrowLinePos)
+    if assigned(arrow) and not isEmptyPointF(endArrowPos) then
+      arrowEndData := arrow.ComputeEndAt(endArrowPos, endArrowDir, width, endArrowLinePos)
     else
       arrowEndData := nil;
 …
   linePos: single;
   startArrowDone,endArrowDone: boolean;
+  wantedStartArrowPos,wantedEndArrowPos: single;
 begin
 …
     if isEmptyPointF(linepts[i]) then
     begin
       result := ComputeWidePolyPolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit);
+      result := ComputeWidePolyPolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow);
       exit;
     end;
 …
   pjsMiter: if miterLimit < 1.001 then maxMiter := hw*1.001 else
                maxMiter := hw*miterLimit;
+  else
+    raise Exception.Create('Unknown join style');
   end;
 …
   setlength(pts, length(linepts)+2);
   for i := 0 to high(linepts) do
     if (nbPts = 0) or (linepts[i] <> pts[nbPts-1]) then
+    if (nbPts = 0) or (abs(linepts[i].x-pts[nbPts-1].x)>oneOver512) or (abs(linepts[i].y-pts[nbPts-1].y)>oneOver512) then
     begin
       pts[nbPts]:= linePts[i];
       inc(nbPts);
     end;
+  if (nbPts > 1) and
+      (pts[nbPts-1] = pts[0]) then dec(nbPts);
+  if (nbPts > 1) and (plCycle in options) and
+      (abs(pts[0].x-pts[nbPts-1].x)<=oneOver512) and
+      (abs(pts[0].y-pts[nbPts-1].y)<=oneOver512) then dec(nbPts);
   if (plCycle in options) and (nbPts > 2) then
   begin
 …
     pts[nbPts] := pts[1];
     inc(nbPts);
-    linecap := pecRound;
   end else
     options -= [plCycle];
 …
   endArrowDir := EmptyPointF;
   endArrowPos := EmptyPointF;
+  startArrowDone := @arrowStart = nil;
+  endArrowDone := @arrowEnd = nil;
+  if Assigned(arrow) then
+  begin
+    wantedStartArrowPos:= arrow.StartOffsetX;
+    wantedEndArrowPos:= arrow.EndOffsetX;
+    startArrowDone := not arrow.IsStartDefined;
+    endArrowDone := not arrow.IsEndDefined;
+  end
+  else
+  begin
+    wantedStartArrowPos:= 0;
+    wantedEndArrowPos:= 0;
+    startArrowDone := true;
+    endArrowDone := true;
+  end;
   //init computed points arrays
 …
   width: single; pencolor: TBGRAPixel; linecap: TPenEndCap;
   joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
   options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single): ArrayOfTPointF;
+  options: TBGRAPolyLineOptions; miterLimit: single; arrow: TBGRACustomArrow): ArrayOfTPointF;
 var
 …
       for j := startIndex to endIndexP1-1 do
         subPts[j-startIndex] := linepts[j];
       tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
+      tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrow);
       if length(results) = nbresults then
         setlength(results,(nbresults+1)*2);
 …
 end;
+{ TBGRAPenStroker }
+function TBGRAPenStroker.GetArrow: TBGRACustomArrow;
+begin
+  result := FArrow;
+end;
+function TBGRAPenStroker.GetArrowOwned: boolean;
+begin
+  result := FArrowOwned;
+end;
+function TBGRAPenStroker.GetCustomPenStyle: TBGRAPenStyle;
+begin
+  result := FCustomPenStyle;
+end;
+function TBGRAPenStroker.GetJoinStyle: TPenJoinStyle;
+begin
+  result := FJoinStyle;
+end;
+function TBGRAPenStroker.GetLineCap: TPenEndCap;
+begin
+  result := FLineCap;
+end;
+function TBGRAPenStroker.GetMiterLimit: single;
+begin
+  result := FMiterLimit;
+end;
+function TBGRAPenStroker.GetPenStyle: TPenStyle;
+begin
+  result := FPenStyle;
+end;
+function TBGRAPenStroker.GetStrokeMatrix: TAffineMatrix;
+begin
+  result := FOriginalStrokeMatrix;
+end;
+procedure TBGRAPenStroker.SetArrow(AValue: TBGRACustomArrow);
+begin
+  FArrow := AValue;
+end;
+procedure TBGRAPenStroker.SetArrowOwned(AValue: boolean);
+begin
+  FArrowOwned := AValue;
+end;
+procedure TBGRAPenStroker.SetCustomPenStyle(AValue: TBGRAPenStyle);
+begin
+  if FCustomPenStyle=AValue then Exit;
+  FCustomPenStyle:=AValue;
+  if AValue = SolidPenStyle then FPenStyle := psSolid
+  else if AValue = ClearPenStyle then FPenStyle:= psClear
+  else if AValue = DashPenStyle then FPenStyle:= psDash
+  else if AValue = DotPenStyle then FPenStyle := psDot
+  else if AValue = DashDotPenStyle then FPenStyle:= psDashDot
+  else if AValue = DashDotDotPenStyle then FPenStyle:= psDashDotDot
+  else
+  begin
+    FPenStyle := psPattern;
+    FCustomPenStyle:= DuplicatePenStyle(AValue);
+  end;
+end;
+procedure TBGRAPenStroker.SetJoinStyle(AValue: TPenJoinStyle);
+begin
+  FJoinStyle:= AValue;
+end;
+procedure TBGRAPenStroker.SetLineCap(AValue: TPenEndCap);
+begin
+  FLineCap:= AValue;
+end;
+procedure TBGRAPenStroker.SetMiterLimit(AValue: single);
+begin
+  FMiterLimit := AValue;
+end;
+procedure TBGRAPenStroker.SetStrokeMatrix(const AValue: TAffineMatrix);
+begin
+  if FOriginalStrokeMatrix=AValue then Exit;
+  FOriginalStrokeMatrix:=AValue;
+  FStrokeMatrix := AValue;
+  FStrokeMatrix[1,3] := 0;
+  FStrokeMatrix[2,3] := 0;
+  FStrokeZoom := max(VectLen(PointF(FStrokeMatrix[1,1],FStrokeMatrix[2,1])),
+          VectLen(PointF(FStrokeMatrix[1,2],FStrokeMatrix[2,2])));
+  if FStrokeZoom > 0 then
+    FStrokeMatrix *= AffineMatrixScale(1/FStrokeZoom,1/FStrokeZoom);
+  FStrokeMatrixIdentity := IsAffineMatrixIdentity(FStrokeMatrix);
+  FStrokeMatrixInverse := AffineMatrixInverse(FStrokeMatrix);
+end;
+procedure TBGRAPenStroker.SetPenStyle(AValue: TPenStyle);
+begin
+  if FPenStyle=AValue then Exit;
+  Case AValue of
+  psSolid: FCustomPenStyle := SolidPenStyle;
+  psDash: FCustomPenStyle := DashPenStyle;
+  psDot: FCustomPenStyle := DotPenStyle;
+  psDashDot: FCustomPenStyle := DashDotPenStyle;
+  psDashDotDot: FCustomPenStyle := DashDotDotPenStyle;
+  else FCustomPenStyle := ClearPenStyle;
+  end;
+  FPenStyle := AValue;
+end;
+constructor TBGRAPenStroker.Create;
+begin
+  Style := psSolid;
+  LineCap := pecRound;
+  JoinStyle := pjsBevel;
+  MiterLimit := 2;
+  fillchar(FOriginalStrokeMatrix,sizeof(FOriginalStrokeMatrix),0);
+  StrokeMatrix := AffineMatrixIdentity;
+end;
+destructor TBGRAPenStroker.Destroy;
+begin
+  if ArrowOwned then FreeAndNil(FArrow);
+  inherited Destroy;
+end;
+function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF;
+  AWidth: single; AClosedCap: boolean): ArrayOfTPointF;
+var
+  c: TBGRAPixel;
+begin
+  if not AClosedCap then
+    c := BGRAWhite //needed for alpha junction
+  else
+    c := BGRAPixelTransparent;
+  if FStrokeMatrixIdentity then
+    result := ComputePolyline(APoints,AWidth*FStrokeZoom,c,AClosedCap)
+  else
+    result := FStrokeMatrix*ComputePolyline(FStrokeMatrixInverse*APoints,AWidth*FStrokeZoom,c,AClosedCap);
+end;
+function TBGRAPenStroker.ComputePolyline(const APoints: array of TPointF;
+  AWidth: single; APenColor: TBGRAPixel; AClosedCap: boolean): ArrayOfTPointF;
+var options: TBGRAPolyLineOptions;
+begin
+  options := [];
+  if Assigned(Arrow) and Arrow.IsStartDefined then options += [plNoStartCap];
+  if Assigned(Arrow) and Arrow.IsEndDefined then options += [plNoEndCap];
+  if not AClosedCap then options += [plRoundCapOpen];
+  if FStrokeMatrixIdentity then
+    result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow)
+  else
+    result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, APenColor, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow);
+end;
+function TBGRAPenStroker.ComputePolylineAutocycle(
+  const APoints: array of TPointF; AWidth: single): ArrayOfTPointF;
+var options: TBGRAPolyLineOptions;
+begin
+  options := [plAutoCycle];
+  if Assigned(Arrow) and Arrow.IsStartDefined then options += [plNoStartCap];
+  if Assigned(Arrow) and Arrow.IsEndDefined then options += [plNoEndCap];
+  if FStrokeMatrixIdentity then
+    result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow)
+  else
+    result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, options, MiterLimit, Arrow)
+end;
+function TBGRAPenStroker.ComputePolygon(const APoints: array of TPointF;
+  AWidth: single): ArrayOfTPointF;
+begin
+  if FStrokeMatrixIdentity then
+    result := BGRAPen.ComputeWidePolylinePoints(APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit)
+  else
+    result := FStrokeMatrix*BGRAPen.ComputeWidePolylinePoints(FStrokeMatrixInverse*APoints, AWidth*FStrokeZoom, BGRAPixelTransparent, LineCap, JoinStyle, CustomPenStyle, [plCycle], MiterLimit);
+end;
 initialization

GraphicTest/Packages/bgrabitmap/bgrapolygon.pas

-              r472
+              r494
 uses
   Classes, SysUtils, Graphics, BGRABitmapTypes, BGRAFillInfo;
+  Classes, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAFillInfo, BGRAPath;
 procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
 …
     procedure AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel);
     function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean;
+    procedure InternalAddStroke(const APoints: array of TPointF; AClosed: boolean; AData: Pointer);
   public
     FillMode : TFillMode;
 …
     procedure AddPolygon(const points: array of TPointF; AColor: TBGRAPixel);
     procedure AddPolygon(const points: array of TPointF; ATexture: IBGRAScanner);
+    procedure AddPathStroke(APath: TBGRAPath; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPathStroke(APath: TBGRAPath; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel);
+    procedure AddPathFill(APath: TBGRAPath; ATexture: IBGRAScanner);
+    procedure AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel);
+    procedure AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner);
+    procedure AddPolylineStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPolylineStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPolygonStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
+    procedure AddPolygonStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
     procedure AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2, c3: TBGRAPixel);
     procedure AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
     procedure AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
+    procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+    procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, {%H-}tex3, tex4: TPointF;
+       ACulling: TFaceCulling = fcNone);
     procedure AddQuadPerspectiveMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
     procedure AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel);
 …
 uses Math, BGRABlend, BGRAGradientScanner, BGRATransform;
+type
+  TPathStrokeData = record
+    Stroker: TBGRACustomPenStroker;
+    Texture: IBGRAScanner;
+    Color: TBGRAPixel;
+    Width: Single;
+  end;
 procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
   c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
+const oneOver512 = 1/512;
 var
   inter:   array of TIntersectionInfo;
 …
     inter:   array of TIntersectionInfo;
     nbInter: integer;
+    sliceIndex: integer;
   end;
 …
 begin
   if (scan=nil) and (c.alpha=0) then exit;
   If not shapeInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := shapeInfo.CreateIntersectionArray;
 …
     begin
       with firstScan do
+      begin
         shapeInfo.ComputeAndSort(yb+1/256,inter,nbInter,NonZeroWinding);
+        sliceIndex:= shapeInfo.GetSliceIndex;
+      end;
       with lastScan do
+      begin
         shapeInfo.ComputeAndSort(yb+255/256,inter,nbInter,NonZeroWinding);
+      if (firstScan.nbInter = lastScan.nbInter) and (firstScan.nbInter >= 2) then
+        sliceIndex:= shapeInfo.GetSliceIndex;
+      end;
+      if (firstScan.sliceIndex = lastScan.sliceIndex) and (firstScan.nbInter = lastScan.nbInter) then
       begin
         optimised := true;
 …
           x1 := firstScan.inter[i+i].interX;
           x1b := lastScan.inter[i+i].interX;
-          if (x1 > x1b) then
-          begin
-            temp := x1;
-            x1 := x1b;
-            x1b := temp;
-          end;
           x2 := firstScan.inter[i+i+1].interX;
           x2b := lastScan.inter[i+i+1].interX;
+          if (x2 < x2b) then
+          if (abs(x1-x1b)<oneOver512) and (abs(x2-x2b)<oneOver512) and
+             ((i+i+2 >= firstScan.nbInter) or
+              ((firstScan.inter[i+i+2].interX >= x2+1) and
+               (lastScan.inter[i+i+2].interX >= x2b+1))) then
           begin
+            temp := x2;
+            x2 := x2b;
+            x2b := temp;
+            x1 := (x1+x1b)*0.5;
+            x2 := (x2+x2b)*0.5;
+            ix1 := floor(x1);
+            ix2 := floor(x2);
+            if ix1 < minx then ix1 := minx;
+            if ix2 > maxx then ix2 := maxx;
+            if ix1>ix2 then continue;
+            if ix1=ix2 then
+            begin
+              tempDensity:= round((x2-x1)*256);
+              if scan <> nil then //with texture scan
+              begin
+                scan.ScanMoveTo(ix1,yb);
+                c := scan.ScanNextPixel;
+                c.alpha := c.alpha*tempDensity shr 8;
+                if linearBlend then
+                  bmp.DrawPixel(ix1, yb, c, dmLinearBlend)
+                else
+                  bmp.DrawPixel(ix1, yb, c, dmDrawWithTransparency);
+              end else
+              if EraseMode then //erase with alpha
+                bmp.ErasePixel(ix1,yb,c.alpha*tempDensity shr 8)
+              else
+              begin  //solid color
+                c2.alpha := c.alpha*tempDensity shr 8;
+                if linearBlend then
+                  bmp.DrawPixel(ix1, yb, c2, dmLinearBlend)
+                else
+                  bmp.DrawPixel(ix1, yb, c2, dmDrawWithTransparency);
+              end;
+            end else
+            begin
+              tempDensity:= round((ix1+1-x1)*256);
+              if scan <> nil then scan.ScanMoveTo(ix1,yb);
+              if tempDensity < 256 then
+              begin
+                if scan <> nil then //with texture scan
+                begin
+                  c := scan.ScanNextPixel;
+                  c.alpha := c.alpha*tempDensity shr 8;
+                  if linearBlend then
+                    bmp.DrawPixel(ix1, yb, c, dmLinearBlend)
+                  else
+                    bmp.DrawPixel(ix1, yb, c, dmDrawWithTransparency);
+                end else
+                if EraseMode then //erase with alpha
+                  bmp.ErasePixel(ix1,yb, c.alpha*tempDensity shr 8)
+                else
+                begin  //solid color
+                  c2.alpha := c.alpha*tempDensity shr 8;
+                  if linearBlend then
+                    bmp.DrawPixel(ix1, yb, c2, dmLinearBlend)
+                  else
+                    bmp.DrawPixel(ix1, yb, c2, dmDrawWithTransparency);
+                end;
+                inc(ix1);
+              end;
+              tempDensity:= round((x2-ix2)*256);
+              if tempDensity < 256 then dec(ix2);
+              if ix2 >= ix1 then
+              begin
+                if scan <> nil then //with texture scan
+                begin
+                  if linearBlend then
+                    ScannerPutPixels(scan, bmp.ScanLine[yb] + ix1, ix2-ix1+1, dmLinearBlend)
+                  else
+                    ScannerPutPixels(scan, bmp.ScanLine[yb] + ix1, ix2-ix1+1, dmDrawWithTransparency);
+                end else
+                if EraseMode then //erase with alpha
+                  bmp.EraseLine(ix1,yb,ix2,yb,c.alpha,True)
+                else
+                begin  //solid color
+                  if LinearBlend then
+                    bmp.HorizLine(ix1,yb,ix2,c,dmLinearBlend)
+                  else
+                    bmp.HorizLine(ix1,yb,ix2,c,dmDrawWithTransparency);
+                end;
+              end;
+              if tempDensity < 256 then
+              begin
+                inc(ix2);
+                if scan <> nil then //with texture scan
+                begin
+                  c := scan.ScanNextPixel;
+                  c.alpha := c.alpha*tempDensity shr 8;
+                  if linearBlend then
+                    bmp.DrawPixel(ix2, yb, c, dmLinearBlend)
+                  else
+                    bmp.DrawPixel(ix2, yb, c, dmDrawWithTransparency);
+                end else
+                if EraseMode then //erase with alpha
+                  bmp.ErasePixel(ix2,yb,c.alpha*tempDensity shr 8)
+                else
+                begin  //solid color
+                  c2.alpha := c.alpha*tempDensity shr 8;
+                  if linearBlend then
+                    bmp.DrawPixel(ix2, yb, c2, dmLinearBlend)
+                  else
+                    bmp.DrawPixel(ix2, yb, c2, dmDrawWithTransparency);
+                end;
+              end;
+            end;
+            continue;
+          end else
+          begin
+            if (x1 > x1b) then
+            begin
+              temp := x1;
+              x1 := x1b;
+              x1b := temp;
+            end;
+            if (x2 < x2b) then
+            begin
+              temp := x2;
+              x2 := x2b;
+              x2b := temp;
+            end;
+            {$DEFINE INCLUDE_FILLDENSITY}
+            {$DEFINE PARAM_SINGLESEGMENT}
+            {$i density256.inc}
+            SubTriangleDensity(x1,256,x1b,0);
+            SubTriangleDensity(x2b,0,x2,256);
           end;
-          {$i filldensitysegment256.inc}
-          SubTriangleDensity(x1,256,x1b,0);
-          SubTriangleDensity(x2b,0,x2,256);
         end;
       end else
 …
           shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
+          {$i filldensity256.inc}
+          {$DEFINE INCLUDE_FILLDENSITY}
+          {$i density256.inc}
         end;
       end;
 …
         shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
+        {$i filldensity256.inc}
+        {$DEFINE INCLUDE_FILLDENSITY}
+        {$i density256.inc}
       end;
     end;
 …
     begin
       if optimised then
+        {$DEFINE INCLUDE_RENDERDENSITY}
         {$define PARAM_LINEARANTIALIASING}
         {$i renderdensity256.inc}
+        {$i density256.inc}
       else
+        {$DEFINE INCLUDE_RENDERDENSITY}
         {$define PARAM_LINEARANTIALIASING}
         {$define PARAM_ANTIALIASINGFACTOR}
         {$i renderdensity256.inc}
+        {$i density256.inc}
     end else
     begin
       if optimised then
+        {$i renderdensity256.inc}
+        {$DEFINE INCLUDE_RENDERDENSITY}
+        {$i density256.inc}
       else
+        {$DEFINE INCLUDE_RENDERDENSITY}
         {$define PARAM_ANTIALIASINGFACTOR}
         {$i renderdensity256.inc}
+        {$i density256.inc}
     end;
   end;
 …
 begin
   if (scan=nil) and (c.alpha=0) then exit;
   If not shapeInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := shapeInfo.CreateIntersectionArray;
 …
   info: TFillBorderEllipseInfo;
 begin
   if (rx = 0) or (ry = 0) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
+  if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
     exit;
   info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
 …
   info: TFillBorderEllipseInfo;
 begin
   if (rx = 0) or (ry = 0) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
+  if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
     exit;
   info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
 …
 end;
+procedure TBGRAMultishapeFiller.InternalAddStroke(
+  const APoints: array of TPointF; AClosed: boolean; AData: Pointer);
+var pts: ArrayOfTPointF;
+begin
+  with TPathStrokeData(AData^) do
+  begin
+    if AClosed then
+      pts := Stroker.ComputePolygon(APoints, Width)
+    else
+      pts := Stroker.ComputePolylineAutoCycle(APoints, Width);
+    if Texture <> nil then
+      AddPolygon(pts, Texture)
+    else
+      AddPolygon(pts, Color);
+  end;
+end;
 constructor TBGRAMultishapeFiller.Create;
 begin
 …
 end;
+procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
+  AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
+begin
+  AddPathStroke(APath,AffineMatrixIdentity,AColor,AWidth,AStroker);
+end;
+procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
+  ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
+begin
+  AddPathStroke(APath,AffineMatrixIdentity,ATexture,AWidth,AStroker);
+end;
+procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
+  AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+var data: TPathStrokeData;
+begin
+  data.Stroker := AStroker;
+  data.Color := AColor;
+  data.Texture := nil;
+  data.Width := AWidth;
+  APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data);
+end;
+procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
+  AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+var data: TPathStrokeData;
+begin
+  data.Stroker := AStroker;
+  data.Color := BGRAPixelTransparent;
+  data.Texture := ATexture;
+  data.Width := AWidth;
+  APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data);
+end;
+procedure TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel);
+begin
+  AddPolygon(APath.ToPoints, AColor);
+end;
+procedure TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
+  ATexture: IBGRAScanner);
+begin
+  AddPolygon(APath.ToPoints, ATexture);
+end;
+procedure TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
+  AMatrix: TAffineMatrix; AColor: TBGRAPixel);
+begin
+  AddPolygon(APath.ToPoints(AMatrix), AColor);
+end;
+procedure TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
+  AMatrix: TAffineMatrix; ATexture: IBGRAScanner);
+begin
+  AddPolygon(APath.ToPoints(AMatrix), ATexture);
+end;
+procedure TBGRAMultishapeFiller.AddPolylineStroke(
+  const points: array of TPointF; AColor: TBGRAPixel; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+begin
+  AddPolygon(AStroker.ComputePolyline(points,AWidth,AColor), AColor);
+end;
+procedure TBGRAMultishapeFiller.AddPolylineStroke(
+  const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+begin
+  AddPolygon(AStroker.ComputePolyline(points,AWidth), ATexture);
+end;
+procedure TBGRAMultishapeFiller.AddPolygonStroke(
+  const points: array of TPointF; AColor: TBGRAPixel; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+begin
+  AddPolygon(AStroker.ComputePolygon(points,AWidth), AColor);
+end;
+procedure TBGRAMultishapeFiller.AddPolygonStroke(
+  const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single;
+  AStroker: TBGRACustomPenStroker);
+begin
+  AddPolygon(AStroker.ComputePolygon(points,AWidth), ATexture);
+end;
 procedure TBGRAMultishapeFiller.AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2,
   c3: TBGRAPixel);
+var
+  grad: TBGRAGradientTriangleScanner;
+begin
+  grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
+  AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
+var grad: TBGRAGradientTriangleScanner;
+begin
+  if (c1 = c2) and (c2 = c3) then
+    AddPolygon([pt1,pt2,pt3],c1)
+  else
+  begin
+    grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
+    AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
+  end;
 end;
 …
   centerColor: TBGRAPixel;
 begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
+                    MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
+  AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
+  AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
+  AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
+  AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
+  if (c1 = c2) and (c2 = c3) and (c3 = c4) then
+    AddPolygon([pt1,pt2,pt3,pt4],c1)
+  else
+  begin
+    center := (pt1+pt2+pt3+pt4)*(1/4);
+    centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
+                      MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
+    AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
+    AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
+    AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
+    AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
+  end;
 end;
 procedure TBGRAMultishapeFiller.AddQuadLinearMapping(pt1, pt2, pt3,
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
+var
+  center: TPointF;
+  centerTex: TPointF;
+begin
+  center := (pt1+pt2+pt3+pt4)*(1/4);
+  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
+  AddTriangleLinearMapping(pt1,pt2,center, texture,tex1,tex2,centerTex);
+  AddTriangleLinearMapping(pt2,pt3,center, texture,tex2,tex3,centerTex);
+  AddTriangleLinearMapping(pt3,pt4,center, texture,tex3,tex4,centerTex);
+  AddTriangleLinearMapping(pt4,pt1,center, texture,tex4,tex1,centerTex);
+  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
+  ACulling: TFaceCulling);
+var
+  mapping: TBGRAQuadLinearScanner;
+begin
+  mapping := TBGRAQuadLinearScanner.Create(texture,
+    [tex1,tex2,tex3,tex4],
+    [pt1,pt2,pt3,pt4]);
+  mapping.Culling := ACulling;
+  AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,mapping,mapping,BGRAPixelTransparent);
 end;
 …
           end;
         end else
+          {$I filldensity256.inc}
+                  {$DEFINE INCLUDE_FILLDENSITY}
+          {$i density256.inc}
       end;
 …
   for k := 0 to nbShapes-1 do
   begin
     If shapes[k].info.ComputeMinMax(minx,miny,maxx,maxy,dest) then
+    If BGRAShapeComputeMinMax(shapes[k].info,minx,miny,maxx,maxy,dest) then
     begin
       shapes[k].bounds := rect(minx,miny,maxx+1,maxy+1);
 …
   EraseMode: boolean; LinearBlend: boolean);
 var
+  info: TFillBorderRoundRectInfo;
+begin
+  if (rx = 0) or (ry = 0) or (w=0) then exit;
+  info: TFillShapeInfo;
+  oldLinear: boolean;
+begin
+  if w=0 then exit;
+  if ((rx=0) or (ry=0)) and not EraseMode then
+  begin
+    oldLinear := bmp.LinearAntialiasing;
+    bmp.LinearAntialiasing := LinearBlend;
+    bmp.RectangleAntialias(x1,y1,x2,y2,c,w);
+    bmp.LinearAntialiasing := oldLinear;
+    exit;
+  end;
   info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options);
   FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
 …
 var
   info: TFillBorderRoundRectInfo;
+begin
+  if (rx = 0) or (ry = 0) or (w=0) then exit;
+  oldLinear: Boolean;
+begin
+  if w=0 then exit;
+  if (rx=0) or (ry=0) then
+  begin
+    oldLinear := bmp.LinearAntialiasing;
+    bmp.LinearAntialiasing := LinearBlend;
+    bmp.RectangleAntialias(x1,y1,x2,y2,scan,w);
+    bmp.LinearAntialiasing := oldLinear;
+    exit;
+  end;
   info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options);
   FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);

GraphicTest/Packages/bgrabitmap/bgrapolygonaliased.pas

-              r472
+              r494
 begin
   If not polyInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := polyInfo.CreateIntersectionArray;
 …
 begin
   If not polyInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := polyInfo.CreateIntersectionArray;
 …
 begin
   If not polyInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
   scanAtFunc := @texture.ScanAt;

GraphicTest/Packages/bgrabitmap/bgraqtbitmap.pas

-              r452
+              r494
 uses
   Classes, SysUtils, BGRADefaultBitmap, Graphics,
   GraphType;
+  Classes, SysUtils, BGRALCLBitmap, Graphics,
+  GraphType, BGRABitmapTypes;
 type
   { TBGRAQtBitmap }
   TBGRAQtBitmap = class(TBGRADefaultBitmap)
+  TBGRAQtBitmap = class(TBGRALCLBitmap)
   private
     procedure SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
+    procedure SlowDrawTransparent(ABitmap: TBGRACustomBitmap;
       ACanvas: TCanvas; ARect: TRect);
   public
 …
     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
-    procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
-      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-      override;
     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
   end;
 …
 implementation
 uses BGRABitmapTypes, LCLType,
+uses LCLType,
   LCLIntf, IntfGraphics,
   qtobjects, qt4,
   FPImage;
 procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRADefaultBitmap;
+procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRACustomBitmap;
   ACanvas: TCanvas; ARect: TRect);
 begin
 …
   AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
 var
   Temp: TBGRAPtrBitmap;
+  Temp: TBGRALCLPtrBitmap;
 begin
   Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData);
+  Temp := TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData);
   Temp.LineOrder := ALineOrder;
   SlowDrawTransparent(Temp, ACanvas, Rect);
 …
 end;
-procedure TBGRAQtBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
-  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
-var
-  Temp:     TBitmap;
-  RawImage: TRawImage;
-  BitmapHandle, MaskHandle: HBitmap;
-  CreateSuccess: boolean;
-begin
-  if (AHeight = 0) or (AWidth = 0) then
-    exit;
-  RawImage.Init;
-  RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight);
-  RawImage.Description.LineOrder := ALineOrder;
-  RawImage.Description.LineEnd := rileDWordBoundary;
-  RawImage.Data     := PByte(AData);
-  RawImage.DataSize := AWidth * AHeight * Sizeof(TBGRAPixel);
-  CreateSuccess     := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
-  if not CreateSuccess then
-    raise FPImageException.Create('Failed to create bitmap handle');
-  Temp := TBitmap.Create;
-  Temp.Handle := BitmapHandle;
-  Temp.MaskHandle := MaskHandle;
-  ACanvas.StretchDraw(Rect, Temp);
-  Temp.Free;
-end;
 procedure TBGRAQtBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
 var
 …
   SrcY     := y + Ofs.Y;
-  {$warning QT: recheck this}
   if (dcSource.vImage <> nil) and (dcSource.vImage.Handle <> nil) then
   begin
 …
   end;
-  (*
-  gdk_window_copy_area(dcDest.Drawable, dcDest.GC, 0, 0, dcSource.Drawable,
-    SrcX, SrcY, Width, Height);
-  *)
   LoadFromRawImage(bmp.RawImage, 255, True);
   bmp.Free;

GraphicTest/Packages/bgrabitmap/bgrareadbmp.pas

-              r472
+              r494
 type
+  TBMPTransparencyOption = (toAuto, toTransparent, toOpaque);
   { TBGRAReaderBMP }
 …
       FOutputHeight: integer;
       FOriginalHeight: Integer;
+      FTransparencyOption: TBMPTransparencyOption;
       FBuffer: packed array of byte;
       FBufferPos, FBufferSize: integer;
       FBufferStream: TStream;
+      FHasAlphaValues: boolean;
       // SetupRead will allocate the needed buffers, and read the colormap if needed.
       procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual;
 …
       procedure CloseReadBuffer;
       function GetNextBufferByte: byte;
+      procedure MakeOpaque(Img: TFPCustomImage);
     public
       MinifyHeight,WantedHeight: integer;
 …
       property OriginalHeight: integer read FOriginalHeight;
       property OutputHeight: integer read FOutputHeight;
+      property TransparencyOption: TBMPTransparencyOption read FTransparencyOption write FTransparencyOption;
   end;
 implementation
-uses dialogs;
 type
 …
 end;
 Constructor TBGRAReaderBMP.create;
+constructor TBGRAReaderBMP.Create;
 begin
   inherited create;
+end;
+Destructor TBGRAReaderBMP.Destroy;
+  FTransparencyOption := toTransparent;
+end;
+destructor TBGRAReaderBMP.Destroy;
 begin
 …
 end;
 Procedure TBGRAReaderBMP.FreeBufs;
+procedure TBGRAReaderBMP.FreeBufs;
 begin
 …
     PrevSourceRow := SourceRow-SourceRowDelta;
     if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048);
+    FHasAlphaValues:= false;
     while SourceRow <> SourceLastRow+SourceRowDelta do
     begin
 …
       if percent<>prevPercent then Progress(psRunning,percent,false,Rect,'',continue);
     end;
+    if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then
+      MakeOpaque(Img);
     Progress(psEnding,100,false,Rect,'',continue);
   except
     on ex:exception do
       ShowMessage(ex.Message);
+  finally
+    if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
+    FreeBufs;
   end;
-  if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
-  FreeBufs;
 end;
 …
 Var
   Column : Integer;
+  c: TFPColor;
 begin
   Case BFI.BitCount of
 …
           img.colors[Column,Row]:=ExpandColor(PLongWord(LineBuf)[Column])
         else
+          img.colors[Column,Row]:=RGBAToFPColor(PColorRGBA(LineBuf)[Column]);
+        begin
+          if FTransparencyOption = toOpaque then
+            img.colors[Column,Row]:=RGBToFPColor(PColorRGB(PColorRGBA(LineBuf)+Column)^)
+          else
+          begin
+            c := RGBAToFPColor(PColorRGBA(LineBuf)[Column]);
+            if c.alpha <> 0 then FHasAlphaValues:= true;
+            img.colors[Column,Row]:= c;
+          end;
+        end;
     end;
 end;
 …
       for Column:=0 to img.Width-1 do
       begin
+        {$IFDEF ENDIAN_BIG}
+        PDWord(PDest)^ := (PWord(PSrc)^ shl 16) or ((Psrc+2)^ shl 8) or $000000ff;
+        {$ELSE}
+        PDWord(PDest)^ := PWord(PSrc)^ or ((Psrc+2)^ shl 16) or $ff000000;
+        {$ENDIF}
+        PDest^ := BGRA((Psrc+2)^,(Psrc+1)^,(Psrc)^);
         inc(PDest);
         inc(PSrc,3);
 …
         inc(PDest);
       end;
+     end else Move(LineBuf^, PDest^, img.Width*SizeOf(TBGRAPixel));
+     end else
+     if FTransparencyOption = toOpaque then
+     begin
+       if TBGRAPixel_RGBAOrder then
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^);
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end
+       else
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc+1)^);
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end;
+     end else
+     begin
+       if TBGRAPixel_RGBAOrder then
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^,(PSrc+3)^);
+          if PDest^.alpha <> 0 then FHasAlphaValues:= true;
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end
+       else
+       begin
+         PSrc := LineBuf;
+         for Column:=0 to img.Width-1 do
+         begin
+           PDest^ := PBGRAPixel(PSrc)^;
+           if PDest^.alpha <> 0 then FHasAlphaValues:= true;
+           inc(PDest);
+           Inc(PSrc,4);
+         end;
+       end;
+     end;
     end;
 end;
 …
 end;
+procedure TBGRAReaderBMP.MakeOpaque(Img: TFPCustomImage);
+var c: TFPColor;
+  x,y: NativeInt;
+begin
+  if Img is TBGRACustomBitmap then
+    TBGRACustomBitmap(Img).AlphaFill(255)
+  else
+    for y := 0 to Img.Height-1 do
+      for x := 0 to Img.Width-1 do
+      begin
+        c := Img.Colors[x,y];
+        c.alpha := alphaOpaque;
+        Img.Colors[x,y] := c;
+      end;
+end;
 initialization

GraphicTest/Packages/bgrabitmap/bgrareadbmpmiomap.pas

-              r472
+              r494
 uses
   Classes, SysUtils, FPimage, BGRABitmapTypes;
+const
+  MioMapMagicValue = 'RL';
+  MioMapTransparentColor = $F81F;
 type
 …
   end;
+function MioMapToBGRA(AColor: Word): TBGRAPixel;
+function BGRAToMioMap(const AColor: TBGRAPixel): Word;
+function MioMapToAlpha(AValue: Byte): Byte;
+function AlphaToMioMap(AValue: Byte): Byte;
 implementation
 uses bufstream;
+function MioMapToBGRA(AColor: Word): TBGRAPixel;
+begin
+  if AColor = MioMapTransparentColor then
+    result := BGRAPixelTransparent
+  else
+    result := Color16BitToBGRA(AColor);
+end;
+function BGRAToMioMap(const AColor: TBGRAPixel): Word;
+begin
+  if AColor.alpha < 7 then
+    result := MioMapTransparentColor
+  else
+  begin
+    result := BGRAToColor16Bit(AColor);
+    if result = MioMapTransparentColor then dec(result);
+  end;
+end;
+function MioMapToAlpha(AValue: Byte): Byte;
+begin
+  result := AValue*255 div 32;
+end;
+function AlphaToMioMap(AValue: Byte): Byte;
+begin
+  result := (AValue*32 + 64) div 255;
+end;
 { TBGRAReaderBmpMioMap }
 …
   fillchar({%H-}header,sizeof(header),0);
   if stream.Read(header, sizeof(header))<> sizeof(header) then exit;
   if header.magic <> 'RL' then exit;
+  if header.magic <> MioMapMagicValue then exit;
   header.format:= LEtoN(header.format);
   header.width:= LEtoN(header.width);
 …
   begin
     colorValue := LEtoN(mioPalette[i]);
+    if colorValue = $F81F then
+      result[i] := BGRAPixelTransparent
+    else
+      result[i] := BGRA(   ((colorValue and $F800) shr 11)*255 div 31,
+                           ((colorValue and $07e0) shr 5)*255 div 63,
+                           (colorValue and $001f)*255 div 31);
+    result[i] := MioMapToBGRA(colorValue);
   end;
   for i := nbColorsRead to nbColors-1 do
 …
     Stream.Read(alphaPalette[0],nbColors);
     for i := 0 to nbColors-1 do
       if mioPalette[i] <> $F81F then
         result[i].alpha := alphaPalette[i]*255 div 32;
+      if mioPalette[i] <> MioMapTransparentColor then
+        result[i].alpha := MioMapToAlpha(alphaPalette[i]);
   end;
 end;

GraphicTest/Packages/bgrabitmap/bgrareadgif.pas

-              r472
+              r494
                Every := 4;
              end;
+: begin
+         else{4}
+             begin
                Row := 1;
                Every := 2;

GraphicTest/Packages/bgrabitmap/bgrareadico.pas

-              r472
+              r494
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 interface
 …
   TBGRAReaderIco = class(TFPCustomImageReader)
   protected
     procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
+    procedure InternalRead({%H-}Str: TStream; {%H-}Img: TFPCustomImage); override;
     function InternalCheck(Str: TStream): boolean; override;
   public
 …
 implementation
 uses BGRABitmapTypes, Graphics;
+uses BGRABitmapTypes{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF};
 { TBGRAReaderIco }
 procedure TBGRAReaderIco.InternalRead(Str: TStream; Img: TFPCustomImage);
+{$IFDEF BGRABITMAP_USE_LCL}
 var ico: TIcon; i,bestIdx: integer;
     height,width: word; format:TPixelFormat;
 …
     begin
       ico.Current := bestIdx;
+      with Img as TBGRACustomBitmap do
+      begin
+        SetSize(bestWidth,bestHeight);
+        GetImageFromCanvas(ico.Canvas,0,0);
+      end;
+      (Img as TBGRACustomBitmap).Assign(ico);
     end;
   finally
 …
   end;
 end;
+{$ELSE}
+begin
+  raise exception.create('Not implemented');
+end;
+{$ENDIF}
 function TBGRAReaderIco.InternalCheck(Str: TStream): boolean;

GraphicTest/Packages/bgrabitmap/bgrareadjpeg.pas

-              r472
+              r494
 unit bgrareadjpeg;
+unit BGRAReadJpeg;
 {$mode objfpc}{$H+}
 …
 type
+  TJPEGScale = FPReadJPEG.TJPEGScale;
+  TJPEGReadPerformance = FPReadJPEG.TJPEGReadPerformance;
+const
+  jsFullSize = FPReadJPEG.jsFullSize;
+  jsHalf = FPReadJPEG.jsHalf;
+  jsQuarter = FPReadJPEG.jsQuarter;
+  jsEighth = FPReadJPEG.jsEighth;
+  jpBestQuality = FPReadJPEG.jpBestQuality;
+  jpBestSpeed = FPReadJPEG.jpBestSpeed;
+type
   { TBGRAReaderJpeg }

GraphicTest/Packages/bgrabitmap/bgrareadlzp.pas

-              r472
+              r494
                 for x := w-1 downto 0 do
                 begin
+                  {$IFDEF ENDIAN_LITTLE}
+                  PDWord(PDest)^ := PCurBlue^ or (PCurGreen^ shl 8) or (PCurRed^ shl 16) or $ff000000;
+                  {$ELSE}
+                  PDWord(PDest)^ := (PCurBlue^ shl 24) or (PCurGreen^ shl 16) or (PCurRed^ shl 8) or $ff;
+                  {$ENDIF}
+                  PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^);
                   inc(PCurBlue);
                   inc(PCurGreen);
 …
               else
               begin
+                {$IFDEF ENDIAN_LITTLE}
+                PDWord(PDest)^ := PCurBlue^ or (PCurGreen^ shl 8) or (PCurRed^ shl 16) or (PCurAlpha^ shl 24);
+                {$ELSE}
+                PDWord(PDest)^ := (PCurBlue^ shl 24) or (PCurGreen^ shl 16) or (PCurRed^ shl 8) or PCurAlpha^;
+                {$ENDIF}
+                PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^,PCurAlpha^);
                 inc(PCurBlue);
                 inc(PCurGreen);

GraphicTest/Packages/bgrabitmap/bgrareadpng.pas

-              r472
+              r494
       //CFmt : TColorFormat; // format of the colors to convert from
       StartX,StartY, DeltaX,DeltaY, StartPass,EndPass : integer;  // number and format of passes
-      FSwitchLine, FCurrentLine, FPreviousLine : pByteArray;
       FPalette : TFPPalette;
       FSetPixel : TSetPixelProc;
 …
       DataIndex : longword;
       DataBytes : TColorData;
-      function CurrentLine(x:longword) : byte;
-      function PrevSample (x:longword): byte;
-      function PreviousLine (x:longword) : byte;
-      function PrevLinePrevSample (x:longword): byte;
       procedure HandleChunk; virtual;
       procedure HandlePalette; virtual;
 …
       function CalcX (relX:integer) : integer;
       function CalcY (relY:integer) : integer;
       function CalcColor: TColorData;
+      function CalcColor(const ScanLine : PByteArray): TColorData;
       procedure HandleScanLine (const y : integer; const ScanLine : PByteArray); virtual;
       procedure BGRAHandleScanLine(const y: integer; const ScanLine: PByteArray);
       procedure BGRAHandleScanLineTr(const y: integer; const ScanLine: PByteArray);
       procedure DoDecompress; virtual;
-      function  DoFilter(LineFilter:byte;index:longword; b:byte) : byte; virtual;
       procedure SetPalettePixel (x,y:integer; const CD : TColordata);
       procedure SetPalColPixel (x,y:integer; const CD : TColordata);
 …
 end;
-function TBGRAReaderPNG.CurrentLine(x:longword):byte;
-begin
-  result := FCurrentLine^[x];
-end;
-function TBGRAReaderPNG.PrevSample (x:longword): byte;
-begin
-  if x < byteWidth then
-    result := 0
-  else
-    result := FCurrentLine^[x - bytewidth];
-end;
-function TBGRAReaderPNG.PreviousLine (x:longword) : byte;
-begin
-  result := FPreviousline^[x];
-end;
-function TBGRAReaderPNG.PrevLinePrevSample (x:longword): byte;
-begin
-  if x < byteWidth then
-    result := 0
-  else
-    result := FPreviousLine^[x - bytewidth];
-end;
-function TBGRAReaderPNG.DoFilter(LineFilter:byte;index:longword; b:byte) : byte;
-var diff : byte;
-  procedure FilterSub;
-  begin
-    diff := PrevSample(index);
-  end;
-  procedure FilterUp;
-  begin
-    diff := PreviousLine(index);
-  end;
-  procedure FilterAverage;
-  var l, p : word;
-  begin
-    l := PrevSample(index);
-    p := PreviousLine(index);
-    diff := (l + p) div 2;
-  end;
-  procedure FilterPaeth;
-  var dl, dp, dlp : word; // index for previous and distances for:
-      l, p, lp : byte;  // r:predictor, Left, Previous, LeftPrevious
-      r : integer;
-  begin
-    l := PrevSample(index);
-    lp := PrevLinePrevSample(index);
-    p := PreviousLine(index);
-    r := integer(l) + integer(p) - integer(lp);
-    dl := abs (r - l);
-    dlp := abs (r - lp);
-    dp := abs (r - p);
-    if (dl <= dp) and (dl <= dlp) then
-      diff := l
-    else if dp <= dlp then
-      diff := p
-    else
-      diff := lp;
-  end;
-begin
-  case LineFilter of
-: diff := 0;
-: FilterSub;
-: FilterUp;
-: FilterAverage;
-: FilterPaeth;
-  end;
-  result := (b + diff) mod $100;
-end;
 function TBGRAReaderPNG.DecideSetPixel : TSetPixelProc;
 begin
 …
 end;
 function TBGRAReaderPNG.CalcColor: TColorData;
+function TBGRAReaderPNG.CalcColor(const ScanLine : PByteArray): TColorData;
 var cd : longword;
     r : word;
 …
       begin
        p := @Databytes;
+       p^ := 0;
+       for r:=0 to bytewidth-2 do
+       for r:=0 to bytewidth shr 1 - 1 do
        begin
+        inc(p);
+        p^:=FCurrentLine^[Dataindex+r];
+        p^ := ScanLine^[Dataindex+(r shl 1)+1];
+        (p+1)^ := ScanLine^[Dataindex+(r shl 1)];
+        inc(p,2);
        end;
       end
     else move (FCurrentLine^[DataIndex], Databytes, bytewidth);
+    else move (ScanLine^[DataIndex], Databytes, bytewidth);
     {$IFDEF ENDIAN_BIG}
     Databytes:=swap(Databytes);
 …
   for rx := 0 to ScanlineLength[CurrentPass]-1 do
     begin
     c := CalcColor;
+    c := CalcColor(ScanLine);
     FSetPixel (x,y,c);
     Inc(X, deltaX);
 …
   for rx := 0 to ScanlineLength[CurrentPass]-1 do
     begin
     c := CalcColor;
+    c := CalcColor(ScanLine);
     FSetPixel (x,y,c);
     Inc(X, deltaX);
 …
   for rx := 0 to ScanlineLength[CurrentPass]-1 do
     begin
     c := CalcColor;
+    c := CalcColor(ScanLine);
     FSetPixel (x,y,c);
     Inc(X, deltaX);
 …
   c := c + (c shl 2);
   c := c + (c shl 4);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := 255;
+    end;
+  result := BGRA(c,c,c);
 end;
 …
   c := CD and $F;
   c := c + (c shl 4);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := 255;
+    end;
+  result := BGRA(c,c,c);
 end;
 …
 begin
   c := CD and $FF;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := 255;
+    end;
+  result := BGRA(c,c,c);
 end;
 …
 begin
   c := (CD shr 8) and $FF;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := 255;
+    end;
+  result := BGRA(c,c,c);
 end;
 …
 begin
   c := CD and $00FF;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := (CD shr 8) and $FF;
+    end;
+  result := BGRA(c,c,c,(CD shr 8) and $FF);
 end;
 …
 begin
   c := (CD shr 8) and $FF;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := (CD shr 24) and $FF;
+    end;
+  result := BGRA(c,c,c,(CD shr 24) and $FF);
 end;
 …
 begin
   temp := CD;
+  temp := ((temp and $ff) shl 16) or
+    (temp and $ff00) or ((temp shr 16) and $ff) or
+    $ff000000;
+  {$IFDEF ENDIAN_BIG}
+  DWord(result) := swap(temp);
+  {$ELSE}
+  DWord(result) := temp;
+  {$ENDIF}
+  result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff);
 end;
 function TBGRAReaderPNG.BGRAColorColor16(const CD: TColorData): TBGRAPixel;
 begin
+  with result do
+    begin
+    red := CD shr 8 and $FF;
+    green := (CD shr 24) and $FF;
+    blue := (CD shr 40) and $FF;
+    alpha := 255;
+    end;
+  result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF);
 end;
 …
 begin
   temp := CD;
+  temp := ((temp and $ff) shl 16) or
+    (temp and $ff00) or ((temp shr 16) and $ff) or
+    (temp and $ff000000);
+  {$IFDEF ENDIAN_BIG}
+  DWord(result) := swap(temp);
+  {$ELSE}
+  DWord(result) := temp;
+  {$ENDIF}
+  result := BGRA(temp and $ff, (temp shr 8) and $ff, (temp shr 16) and $ff, temp shr 24);
 end;
 function TBGRAReaderPNG.BGRAColorColorAlpha16(const CD: TColorData): TBGRAPixel;
 begin
+  with result do
+    begin
+    red := (CD shr 8) and $FF;
+    green := (CD shr 24) and $FF;
+    blue := (CD shr 40) and $FF;
+    alpha := (CD shr 56) and $FF;
+    end;
+  result := BGRA(CD shr 8 and $FF,(CD shr 24) and $FF,(CD shr 40) and $FF, CD shr 56);
 end;
 …
   end;
+  procedure FilterSub(p: PByte; Count: NativeInt; bw: NativeInt);
+  begin
+    inc(p,bw);
+    dec(Count,bw);
+    while Count > 0 do
+    begin
+      {$push}{$r-}
+      p^ += (p-bw)^;
+      {$pop}
+      inc(p);
+      dec(Count);
+    end;
+  end;
+  procedure FilterUp(p,pPrev: PByte; Count: NativeUInt);
+  var Count4: NativeInt;
+  begin
+    Count4 := Count shr 2;
+    dec(Count, Count4 shl 2);
+    while Count4 > 0 do
+    begin
+      {$push}{$r-}
+      PDWord(p)^ := (((PDWord(pPrev)^ and $00FF00FF) + (PDWord(p)^ and $00FF00FF)) and $00FF00FF)
+        or (((PDWord(pPrev)^ and $FF00FF00) + (PDWord(p)^ and $FF00FF00)) and $FF00FF00);
+      {$pop}
+      inc(p,4);
+      inc(pPrev,4);
+      dec(Count4);
+    end;
+    while Count > 0 do
+    begin
+      {$push}{$r-}
+      p^ += pPrev^;
+      {$pop}
+      inc(p);
+      inc(pPrev);
+      dec(Count);
+    end;
+  end;
+  procedure FilterAverage(p,pPrev: PByte; Count: NativeUInt; bw: NativeInt);
+  var CountBW: NativeInt;
+  begin
+    CountBW := bw;
+    dec(Count,CountBW);
+    while CountBW > 0 do
+    begin
+      {$push}{$r-}
+      p^ += pPrev^ shr 1;
+      {$pop}
+      inc(p);
+      inc(pPrev);
+      dec(CountBW);
+    end;
+    while Count > 0 do
+    begin
+      {$push}{$r-}
+      p^ += (pPrev^+(p-bw)^) shr 1;
+      {$pop}
+      inc(p);
+      inc(pPrev);
+      dec(Count);
+    end;
+  end;
+  procedure FilterPaeth(p,pPrev: PByte; Count: NativeUInt; bw: NativeInt);
+  var
+    rx, dl, dp, dlp : NativeInt;
+    diag,left: NativeUInt;
+  begin
+    for rx := 0 to bw-1 do
+    begin
+      {$push}{$r-}
+      p^ += pPrev^;
+      {$pop}
+      inc(p);
+      inc(pPrev);
+    end;
+    dec(Count,bw);
+    while Count > 0 do
+    begin
+      diag := (pPrev-bw)^;
+      left := (p - bw)^;
+      dl := pPrev^ - NativeInt(diag);
+      dp := NativeInt(left) - NativeInt(diag);
+      dlp := abs(dl+dp);
+      if dl < 0 then dl := -dl;
+      if dp < 0 then dp := -dp;
+      {$push}{$r-}
+      if dp <= dlp then
+      begin
+        if dl <= dp then
+          p^ += left
+        else
+          p^ += pPrev^
+      end
+      else
+      if dl <= dlp then
+        p^ += left
+      else
+        p^ += diag;
+      {$pop}
+      inc(p);
+      inc(pPrev);
+      dec(Count);
+     end;
+  end;
   procedure Decode;
   var y, rp, ry, rx, l : integer;
+  var y, rp, ry, l : NativeInt;
       lf : byte;
+      switchLine, currentLine, previousLine : pByteArray;
   begin
     FSetPixel := DecideSetPixel;
 …
       if (l>0) then
         begin
         GetMem (FPreviousLine, l);
         GetMem (FCurrentLine, l);
         fillchar (FCurrentLine^,l,0);
+        GetMem (previousLine, l);
+        GetMem (currentLine, l);
+        fillchar (currentLine^,l,0);
         try
           for ry := 0 to CountScanlines[rp]-1 do
             begin
             FSwitchLine := FCurrentLine;
             FCurrentLine := FPreviousLine;
             FPreviousLine := FSwitchLine;
             Y := CalcY(ry);
+            switchLine := currentLine;
+            currentLine := previousLine;
+            previousLine := switchLine;
+            Y := StartY + (ry * deltaY);
             lf := 0;
             Decompress.Read (lf, sizeof(lf));
+            Decompress.Read (FCurrentLine^, l);
+            if lf <> 0 then  // Do nothing when there is no filter used
+              for rx := 0 to l-1 do
+                FCurrentLine^[rx] := DoFilter (lf, rx, FCurrentLine^[rx]);
+            Decompress.Read (currentLine^, l);
+            case lf of
+: FilterSub(PByte(currentLine), l, ByteWidth);
+: FilterUp(PByte(currentLine), PByte(previousLine), l);
+: FilterAverage(PByte(currentLine), PByte(previousLine), l, ByteWidth);
+: FilterPaeth(PByte(currentLine), PByte(previousLine), l, ByteWidth);
+            end;
             if FVerticalShrinkShr <> 0 then
               begin
                 if (y and FVerticalShrinkMask) = 0 then
                   FHandleScanLine (y shr FVerticalShrinkShr, FCurrentLine);
+                  FHandleScanLine (y shr FVerticalShrinkShr, currentLine);
               end else
                 FHandleScanLine (y, FCurrentLine);
+                FHandleScanLine (y, currentLine);
             end;
         finally
           freemem (FPreviousLine);
           freemem (FCurrentLine);
+          freemem (previousLine);
+          freemem (currentLine);
         end;
         end;

GraphicTest/Packages/bgrabitmap/bgrareadtga.pas

-              r472
+              r494
           for Col:=Img.Width-1 downto 0 do
           begin
+            PWord(PDest)^ := PWord(P)^;
+            (PByte(PDest)+2)^ := (PByte(P)+2)^;
+            (PByte(PDest)+3)^ := 255;
+            PDest^ := BGRA((P+2)^,(P+1)^,P^);
             inc(Pdest);
             Inc(p,3);
 …
             inc(P);
             Value:=value or (P[0] shl 8);
+            With PDest^ do
+               begin
+               Red:=((value)shr 10) shl 3;
+               Green:=((value)shr 5) shl 3;
+               Blue:=((value)) shl 3;
+               end;
+            PDest^ := BGRA(((value)shr 10) shl 3,((value)shr 5) shl 3,((value)) shl 3);
             Inc(PDest);
             Inc(P);

GraphicTest/Packages/bgrabitmap/bgrareadxpm.pas

r472	r494
22	22	implementation
23	23
24		uses BGRABitmapTypes~~, Dialogs~~;
	24	uses BGRABitmapTypes;
25	25
26	26	{ TBGRAReaderXPM }

GraphicTest/Packages/bgrabitmap/bgraresample.pas

r472	r494
97	97	implementation
98	98
99		uses ~~GraphType,~~ Math, BGRABlend;
	99	uses Math, BGRABlend;
100	100
101	101	function SimpleStretch(bmp: TBGRACustomBitmap;

GraphicTest/Packages/bgrabitmap/bgrascene3d.pas

-              r472
+              r494
 uses
+  Classes, SysUtils, BGRABitmapTypes, BGRAColorInt, BGRASSE, BGRAMatrix3D;
+  Classes, SysUtils, BGRABitmapTypes, BGRAColorInt,
+  BGRASSE, BGRAMatrix3D,
+  BGRASceneTypes, BGRARenderer3D;
 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
+    basic: TBasicLightingContext;
+    {128} diffuseColor, {144} specularColor: TColorInt65536;
+    {160} vL, {176} dummy: TPoint3D_128;
+    {192} vH: TPoint3D_128;
+    {208} lightness: integer;
+    {212} material : TObject;
+    LightThroughFactor: single;
+    LightThrough: LongBool;
+    SaturationLow: integer;
+    SaturationLowF: single;
+    SaturationHigh: integer;
+    SaturationHighF: single;
+  end;
+  TBGRAScene3D = class;
+{$i bgrascene3Dinterface.inc}
+  TLightingNormal3D = BGRASceneTypes.TLightingNormal3D;
+  TLightingInterpolation3D = BGRASceneTypes.TLightingInterpolation3D;
+  TAntialiasingMode3D = BGRASceneTypes.TAntialiasingMode3D;
+  TPerspectiveMode3D = BGRASceneTypes.TPerspectiveMode3D;
+  TRenderingOptions = BGRASceneTypes.TRenderingOptions;
+  IBGRAVertex3D = BGRASceneTypes.IBGRAVertex3D;
+  IBGRANormal3D = BGRASceneTypes.IBGRANormal3D;
+  IBGRALight3D = BGRASceneTypes.IBGRALight3D;
+  IBGRADirectionalLight3D = BGRASceneTypes.IBGRADirectionalLight3D;
+  IBGRAPointLight3D = BGRASceneTypes.IBGRAPointLight3D;
+  IBGRAMaterial3D = BGRASceneTypes.IBGRAMaterial3D;
+  IBGRAFace3D = BGRASceneTypes.IBGRAFace3D;
+  IBGRAPart3D = BGRASceneTypes.IBGRAPart3D;
+  IBGRAObject3D = BGRASceneTypes.IBGRAObject3D;
+  arrayOfIBGRAVertex3D = BGRASceneTypes.arrayOfIBGRAVertex3D;
+const
+  lnNone = BGRASceneTypes.lnNone;
+  lnFace = BGRASceneTypes.lnFace;
+  lnVertex = BGRASceneTypes.lnVertex;
+  lnFaceVertexMix = BGRASceneTypes.lnFaceVertexMix;
+  liLowQuality = BGRASceneTypes.liLowQuality;
+  liSpecularHighQuality = BGRASceneTypes.liSpecularHighQuality;
+  liAlwaysHighQuality = BGRASceneTypes.liAlwaysHighQuality;
+  am3dNone = BGRASceneTypes.am3dNone;
+  am3dMultishape = BGRASceneTypes.am3dMultishape;
+  am3dResample = BGRASceneTypes.am3dResample;
+  pmLinearMapping = BGRASceneTypes.pmLinearMapping;
+  pmPerspectiveMapping = BGRASceneTypes.pmPerspectiveMapping;
+  pmZBuffer = BGRASceneTypes.pmZBuffer;
 type
+  { TCamera3D }
+  TCamera3D = class
+  private
+    procedure ComputeMatrix;
+    function GetLookWhere: TPoint3D;
+    function GetMatrix: TMatrix3D;
+    function GetViewPoint: TPoint3D;
+    procedure SetMatrix(AValue: TMatrix3D);
+    procedure SetViewPoint(AValue: TPoint3D);
+  protected
+    FMatrix: TMatrix3D;
+    FMatrixComputed: boolean;
+    FViewPoint: TPoint3D_128;
+    FLookWhere, FTopDir: TPoint3D_128;
+  public
+    procedure LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
+    procedure LookDown(angleDeg: single);
+    procedure LookLeft(angleDeg: single);
+    procedure LookRight(angleDeg: single);
+    procedure LookUp(angleDeg: single);
+    property ViewPoint: TPoint3D read GetViewPoint write SetViewPoint;
+    property LookWhere: TPoint3D read GetLookWhere;
+    property Matrix: TMatrix3D read GetMatrix write SetMatrix;
+  end;
   { TBGRAScene3D }
   TBGRAScene3D = class
   private
+    FSurface: TBGRACustomBitmap;
+    FViewCenter: TPointF;
+    FAutoViewCenter: boolean;
+    FSurface: TBGRACustomBitmap; //destination of software renderer
+    FViewCenter: TPointF;        //where origin is drawn
+    FAutoViewCenter: boolean;    //use middle of the screen
+    FZoom: TPointF;              //how much the drawing is zoomed
+    FAutoZoom: Boolean;          //display 1 as 80% of surface size
+    FProjection: TProjection3D;  //current projection
+    FRenderedFaceCount: integer; //current counter of rendered faces
+    FCamera: TCamera3D;
     FObjects: array of IBGRAObject3D;
     FObjectCount: integer;
     FMaterials: array of IBGRAMaterial3D;
     FMaterialCount: integer;
+    FMatrix: TMatrix3D;
+    FViewPoint: TPoint3D_128;
+    FLookWhere, FTopDir: TPoint3D_128;
+    FZoom: TPointF;
+    FAutoZoom: Boolean;
+    FLights: TList;
+    FAmbiantLightness: integer;
+    FAmbiantLightColor: TColorInt65536;
+    FRenderedFaceCount: integer;
+    FProjection: TProjection3D;
+    FDefaultMaterial : IBGRAMaterial3D;
+    FAmbiantLightColorF: TColorF;        //lightness without light sources
+    FLights: TList;                      //individual light sources
     function GetAmbiantLightColorF: TColorF;
     function GetAmbiantLightness: single;
 …
     procedure SetViewPoint(const AValue: TPoint3D);
     procedure ComputeView(ScaleX,ScaleY: single);
+    function ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF; overload;
+    function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF; overload;
+    procedure ComputeLight;
+    procedure ComputeMatrix;
+    function ComputeCoordinate(AViewCoord: TPoint3D_128): TPointF;
     procedure AddObject(AObj: IBGRAObject3D);
     procedure AddLight(ALight: TObject);
     procedure AddMaterial(AMaterial: IBGRAMaterial3D);
     procedure Init;
-    procedure InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single); virtual;
   protected
+    function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
+    function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
+    function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
+    function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
+    function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel; virtual;
+    FRenderer: TCustomRenderer3D;
+    FMaterialLibrariesFetched: array of string;
+    FTexturesFetched: array of record
+        Name: string;
+        Bitmap: TBGRACustomBitmap;
+      end;
     procedure UseMaterial(AMaterialName: string; AFace: IBGRAFace3D); virtual;
+    function FetchTexture({%H-}AName: string; out texSize: TPointF): IBGRAScanner; virtual;
+    function LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap; virtual;
+    function FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner; virtual;
+    procedure HandleFetchException(AException: Exception); virtual;
+    procedure DoRender; virtual;
+    procedure DoClear; virtual;
+    function GetRenderWidth: integer;
+    function GetRenderHeight: integer;
+    procedure OnMaterialTextureChanged({%H-}ASender: TObject); virtual;
+    procedure SetDefaultMaterial(AValue: IBGRAMaterial3D);
+    procedure InvalidateMaterial;
   public
     DefaultLightingNormal: TLightingNormal3D;
-    DefaultMaterial : IBGRAMaterial3D;
     RenderingOptions: TRenderingOptions;
     UnknownColor: TBGRAPixel;
+    FetchDirectory: string;
+    FetchThrowsException: boolean;
     constructor Create;
 …
     destructor Destroy; override;
     procedure Clear; virtual;
+    function FetchObject(AName: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
+    procedure FetchMaterials(ALibraryName: string); virtual;
     function LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
     function LoadObjectFromFileUTF8(AFilename: string; SwapFacesOrientation: boolean = true): IBGRAObject3D;
 …
     procedure LookDown(angleDeg: single);
     procedure Render; virtual;
+    procedure Render(ARenderer: TCustomRenderer3D);
     function CreateObject: IBGRAObject3D; overload;
     function CreateObject(ATexture: IBGRAScanner): IBGRAObject3D; overload;
 …
     procedure ForEachVertex(ACallback: TVertex3DCallback);
     procedure ForEachFace(ACallback: TFace3DCallback);
+    function MakeLightList: TList;
     property ViewCenter: TPointF read GetViewCenter write SetViewCenter;
     property AutoViewCenter: boolean read FAutoViewCenter write SetAutoViewCenter;
 …
     property Material[AIndex: integer] : IBGRAMaterial3D read GetMaterial;
     property MaterialCount: integer read FMaterialCount;
+    property Camera: TCamera3D read FCamera;
+    property DefaultMaterial: IBGRAMaterial3D read FDefaultMaterial write SetDefaultMaterial;
   end;
 implementation
+uses BGRAPolygon, BGRAPolygonAliased, BGRACoordPool3D, BGRAResample,
+  lazutf8classes;
+uses BGRACoordPool3D, BGRAUTF8;
 {$i lightingclasses3d.inc}
 {$i vertex3d.inc}
 {$i face3d.inc}
-type
-  { TBGRAObject3D }
-  TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D)
-  private
-    FColor: TBGRAPixel;
-    FLight: Single;
-    FTexture: IBGRAScanner;
-    FMainPart: IBGRAPart3D;
-    FFaces: array of IBGRAFace3D;
-    FFaceCount: integer;
-    FLightingNormal : TLightingNormal3D;
-    FParentLighting: boolean;
-    FMaterial: IBGRAMaterial3D;
-    FScene: TBGRAScene3D;
-    procedure AddFace(AFace: IBGRAFace3D);
-  public
-    constructor Create(AScene: TBGRAScene3D);
-    destructor Destroy; override;
-    procedure Clear;
-    function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
-    function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D;
-    function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
-    function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D;
-    function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
-    function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
-    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
-    function GetColor: TBGRAPixel;
-    function GetLight: Single;
-    function GetTexture: IBGRAScanner;
-    function GetMainPart: IBGRAPart3D;
-    function GetLightingNormal: TLightingNormal3D;
-    function GetParentLighting: boolean;
-    function GetFace(AIndex: integer): IBGRAFace3D;
-    function GetFaceCount: integer;
-    function GetTotalVertexCount: integer;
-    function GetTotalNormalCount: integer;
-    function GetMaterial: IBGRAMaterial3D;
-    procedure SetLightingNormal(const AValue: TLightingNormal3D);
-    procedure SetParentLighting(const AValue: boolean);
-    procedure SetColor(const AValue: TBGRAPixel);
-    procedure SetLight(const AValue: Single);
-    procedure SetTexture(const AValue: IBGRAScanner);
-    procedure SetMaterial(const AValue: IBGRAMaterial3D);
-    procedure RemoveUnusedVertices;
-    procedure SeparatePart(APart: IBGRAPart3D);
-    function GetScene: TBGRAScene3D;
-    function GetRefCount: integer;
-    procedure SetBiface(AValue : boolean);
-    procedure ForEachVertex(ACallback: TVertex3DCallback);
-    procedure ForEachFace(ACallback: TFace3DCallback);
-  end;
 {$i part3d.inc}
 {$i object3d.inc}
 {$i shapes3d.inc}
+{ TCamera3D }
+function TCamera3D.GetLookWhere: TPoint3D;
+begin
+  result := Point3D(FLookWhere);
+end;
+function TCamera3D.GetMatrix: TMatrix3D;
+begin
+  if not FMatrixComputed then
+  begin
+    ComputeMatrix;
+    FMatrixComputed := true;
+  end;
+  result := FMatrix;
+end;
+function TCamera3D.GetViewPoint: TPoint3D;
+begin
+  result := Point3D(FViewPoint);
+end;
+procedure TCamera3D.SetMatrix(AValue: TMatrix3D);
+begin
+  FMatrix := AValue;
+  FMatrixComputed:= true;
+  FViewPoint := Point3D_128(FMatrix[1,4],FMatrix[2,4],FMatrix[3,4]);
+end;
+procedure TCamera3D.SetViewPoint(AValue: TPoint3D);
+begin
+  FViewPoint := Point3D_128(AValue);
+  FMatrix[1,4] := FViewPoint.x;
+  FMatrix[2,4] := FViewPoint.y;
+  FMatrix[3,4] := FViewPoint.z;
+  FMatrixComputed := false;
+end;
+procedure TCamera3D.ComputeMatrix;
+var ZDir, XDir, YDir: TPoint3D_128;
+begin
+  if IsPoint3D_128_Zero(FTopDir) then exit;
+  YDir := -FTopDir;
+  Normalize3D_128(YDir);
+  ZDir := FLookWhere-FViewPoint;
+  if IsPoint3D_128_Zero(ZDir) then exit;
+  Normalize3D_128(ZDir);
+  VectProduct3D_128(YDir,ZDir,XDir);
+  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
+  Normalize3D_128(XDir);
+  Normalize3D_128(YDir);
+  FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint);
+  FMatrix := MatrixInverse3D(FMatrix);
+end;
+procedure TCamera3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
+begin
+  FLookWhere := Point3D_128(AWhere);
+  FTopDir := Point3D_128(ATopDir);
+  FMatrixComputed := false;
+end;
+procedure TCamera3D.LookLeft(angleDeg: single);
+var m,inv: TMatrix3D;
+begin
+  inv := MatrixInverse3D(Matrix);
+  m := MatrixRotateY(angleDeg*Pi/180);
+  FLookWhere := inv*m*Matrix*FLookWhere;
+  FMatrixComputed := false;
+end;
+procedure TCamera3D.LookRight(angleDeg: single);
+begin
+  LookLeft(-angleDeg);
+end;
+procedure TCamera3D.LookUp(angleDeg: single);
+var m,inv: TMatrix3D;
+begin
+  inv := MatrixInverse3D(Matrix);
+  m := MatrixRotateX(-angleDeg*Pi/180);
+  FLookWhere := inv*m*Matrix*FLookWhere;
+  FMatrixComputed := false;
+end;
+procedure TCamera3D.LookDown(angleDeg: single);
+begin
+  LookUp(-angleDeg);
+end;
 { TBGRAScene3D }
 …
   if FAutoViewCenter then
   begin
+    if Surface = nil then
+      result := PointF(0,0)
+    else
+      result := PointF((Surface.Width-1)/2,(Surface.Height-1)/2)
+    result := PointF((GetRenderWidth-1)/2,(GetRenderHeight-1)/2)
   end
   else
 …
 function TBGRAScene3D.GetViewPoint: TPoint3D;
 begin
   result := Point3D(FViewPoint);
+  result := Camera.ViewPoint;
 end;
 …
   if FAutoZoom then
   begin
+    if FSurface = nil then
+    Size := sqrt(GetRenderWidth*GetRenderHeight)*0.8;
+    if Size = 0 then
       result := PointF(1,1)
     else
-    begin
-      Size := sqrt(FSurface.Width*FSurface.Height)*0.8;
       result := PointF(size,size);
-    end;
   end else
     result := FZoom;
 …
 procedure TBGRAScene3D.SetAmbiantLightColorF(const AValue: TColorF);
 begin
+  FAmbiantLightColor := ColorFToColorInt65536(AValue);
+  FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
+  FAmbiantLightColorF := AValue;
 end;
 procedure TBGRAScene3D.SetAmbiantLightness(const AValue: single);
 begin
+  FAmbiantLightness:= round(AValue*32768);
+  FAmbiantLightColor := ColorInt65536(FAmbiantLightness*2, FAmbiantLightness*2, FAmbiantLightness*2);
+  FAmbiantLightColorF := ColorF(AValue, AValue, AValue, 1);
 end;
 procedure TBGRAScene3D.SetAmbiantLightColor(const AValue: TBGRAPixel);
 begin
+  FAmbiantLightColor := BGRAToColorInt(AValue);
+  FAmbiantLightness := (FAmbiantLightColor.r + FAmbiantLightColor.g + FAmbiantLightColor.b) div 6;
+  FAmbiantLightColorF := ColorInt65536ToColorF(BGRAToColorInt(AValue,True));
 end;
 …
 function TBGRAScene3D.GetAmbiantLightColor: TBGRAPixel;
 begin
   result := ColorIntToBGRA(FAmbiantLightColor);
+  result := ColorIntToBGRA(ColorFToColorInt65536(FAmbiantLightColorF),True);
 end;
 …
 function TBGRAScene3D.GetAmbiantLightness: single;
 begin
   result := FAmbiantLightness/32768;
+  result := (FAmbiantLightColorF[1]+FAmbiantLightColorF[2]+FAmbiantLightColorF[3])/3;
 end;
 function TBGRAScene3D.GetAmbiantLightColorF: TColorF;
 begin
   result := ColorInt65536ToColorF(FAmbiantLightColor);
+  result := FAmbiantLightColorF;
 end;
 …
 end;
+procedure TBGRAScene3D.SetDefaultMaterial(AValue: IBGRAMaterial3D);
+begin
+  if FDefaultMaterial=AValue then Exit;
+  FDefaultMaterial:=AValue;
+  InvalidateMaterial;
+end;
 procedure TBGRAScene3D.SetViewCenter(const AValue: TPointF);
 begin
 …
 end;
+procedure TBGRAScene3D.ComputeMatrix;
+var ZDir, XDir, YDir: TPoint3D_128;
+begin
+  if IsPoint3D_128_Zero(FTopDir) then exit;
+  YDir := -FTopDir;
+  Normalize3D_128(YDir);
+  ZDir := FLookWhere-FViewPoint;
+  if IsPoint3D_128_Zero(ZDir) then exit;
+  Normalize3D_128(ZDir);
+  VectProduct3D_128(YDir,ZDir,XDir);
+  VectProduct3D_128(ZDir,XDir,YDir); //correct Y dir
+  Normalize3D_128(XDir);
+  Normalize3D_128(YDir);
+  FMatrix := Matrix3D(XDir,YDir,ZDir,FViewPoint);
+  FMatrix := MatrixInverse3D(FMatrix);
+procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);
+begin
+  Camera.ViewPoint := AValue;
 end;
 …
   FAutoZoom := True;
   FAutoViewCenter := True;
+  ViewPoint := Point3D(0,0,-100);
+  LookAt(Point3D(0,0,0), Point3D(0,-1,0));
+  FCamera := TCamera3D.Create;
+  Camera.ViewPoint := Point3D(0,0,-100);
+  Camera.LookAt(Point3D(0,0,0), Point3D(0,-1,0));
   with RenderingOptions do
   begin
 …
 destructor TBGRAScene3D.Destroy;
+begin
+  Clear;
+  FLights.Free;
+var
+  i: Integer;
+begin
+  DoClear;
+  FreeAndNil(FLights);
+  FreeAndNil(FCamera);
+  for i := 0 to high(FTexturesFetched) do
+    FTexturesFetched[i].Bitmap.Free;
   inherited Destroy;
 end;
 procedure TBGRAScene3D.Clear;
+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;
+  FMaterials := nil;
+  FMaterialCount := 0;
+begin
+  DoClear;
   DefaultMaterial := CreateMaterial;
+end;
+function TBGRAScene3D.FetchObject(AName: string; SwapFacesOrientation: boolean
+  ): IBGRAObject3D;
+begin
+  if FetchDirectory = '' then raise exception.Create('Please define first the FetchDirectory');
+  try
+    result := LoadObjectFromFileUTF8(ConcatPaths([FetchDirectory,AName]), SwapFacesOrientation);
+  except
+    on ex:Exception do
+      HandleFetchException(ex);
+  end;
 end;
 …
 end;
+function TBGRAScene3D.LoadBitmapFromFileUTF8(AFilenameUTF8: string): TBGRACustomBitmap;
+begin
+  result := BGRABitmapFactory.Create(AfileNameUTF8,True);
+end;
 function TBGRAScene3D.FetchTexture(AName: string; out texSize: TPointF): IBGRAScanner;
+begin
+  result := nil;
+  texSize := PointF(1,1);
+var
+  i: Integer;
+  bmp: TBGRACustomBitmap;
+begin
+  bmp := nil;
+  for i := 0 to high(FTexturesFetched) do
+    if FTexturesFetched[i].Name = AName then
+    begin
+      bmp := FTexturesFetched[i].Bitmap;
+      result := bmp;
+      texSize := PointF(bmp.Width,bmp.Height);
+      exit;
+    end;
+  if FetchDirectory <> '' then
+  begin
+    try
+      bmp := LoadBitmapFromFileUTF8(ConcatPaths([FetchDirectory,AName]));
+    except
+      on ex:Exception do
+        HandleFetchException(ex);
+    end;
+  end;
+  if bmp = nil then
+  begin
+    result := nil;
+    texSize := PointF(1,1);
+  end else
+  begin
+    setlength(FTexturesFetched, length(FTexturesFetched)+1);
+    FTexturesFetched[high(FTexturesFetched)].Name := AName;
+    FTexturesFetched[high(FTexturesFetched)].Bitmap := bmp;
+    result := bmp;
+    texSize := PointF(bmp.Width,bmp.Height);
+  end;
+end;
+procedure TBGRAScene3D.FetchMaterials(ALibraryName: string);
+var
+  i: Integer;
+begin
+  if FetchDirectory <> '' then
+  begin
+    for i := 0 to high(FMaterialLibrariesFetched) do
+      if FMaterialLibrariesFetched[i]=ALibraryName then exit;
+    setlength(FMaterialLibrariesFetched,length(FMaterialLibrariesFetched)+1);
+    FMaterialLibrariesFetched[high(FMaterialLibrariesFetched)] := ALibraryName;
+    try
+      LoadMaterialsFromFile(ConcatPaths([FetchDirectory,ALibraryName]));
+    except
+      on ex:Exception do
+        HandleFetchException(ex);
+    end;
+  end;
+end;
+procedure TBGRAScene3D.HandleFetchException(AException: Exception);
+begin
+  if FetchThrowsException then
+    raise AException;
+end;
+procedure TBGRAScene3D.DoClear;
+var i: integer;
+begin
+  for i := 0 to FLights.Count-1 do
+    TBGRALight3D(FLights[i]).ReleaseInterface;
+  FLights.Clear;
+  for i := 0 to FObjectCount-1 do
+  begin
+    FObjects[i].Clear;
+    FObjects[i] := nil;
+  end;
+  FObjects := nil;
+  FObjectCount := 0;
+  FMaterials := nil;
+  FMaterialCount := 0;
+  DefaultMaterial := nil;
+end;
+function TBGRAScene3D.GetRenderWidth: integer;
+begin
+  if Assigned(FRenderer) then
+    result := FRenderer.SurfaceWidth
+  else
+  if Assigned(FSurface) then
+    result := FSurface.Width
+  else
+    result := 0;
+end;
+function TBGRAScene3D.GetRenderHeight: integer;
+begin
+  if Assigned(FRenderer) then
+    result := FRenderer.SurfaceHeight
+  else
+  if Assigned(FSurface) then
+    result := FSurface.Height
+  else
+    result := 0;
+end;
+procedure TBGRAScene3D.OnMaterialTextureChanged(ASender: TObject);
+begin
+  InvalidateMaterial;
+end;
+procedure TBGRAScene3D.InvalidateMaterial;
+var
+  i: Integer;
+begin
+  for i := 0 to FObjectCount-1 do
+    FObjects[i].InvalidateMaterial;
 end;
 function TBGRAScene3D.LoadObjectFromFile(AFilename: string; SwapFacesOrientation: boolean): IBGRAObject3D;
+var source: TFileStream;
+begin
+  source := TFileStream.Create(AFilename,fmOpenRead,fmShareDenyWrite);
+  try
+    result := LoadObjectFromStream(source,SwapFacesOrientation);
+  finally
+    source.free;
+  end;
+begin
+  result := LoadObjectFromFileUTF8(SysToUTF8(AFilename), SwapFacesOrientation);
 end;
 …
       result.LightingNormal := lnVertex;
     end else
+    if lineType = 'mtllib' then
+      FetchMaterials(trim(s))
+    else
     if lineType = 'usemtl' then
       materialname := trim(s)
 …
 procedure TBGRAScene3D.LookAt(AWhere: TPoint3D; ATopDir: TPoint3D);
 begin
+  FLookWhere := Point3D_128(AWhere);
+  FTopDir := Point3D_128(ATopDir);
+  Camera.LookAt(AWhere,ATopDir);
 end;
 procedure TBGRAScene3D.LookLeft(angleDeg: single);
+var m,inv: TMatrix3D;
+begin
+  inv := MatrixInverse3D(FMatrix);
+  m := MatrixRotateY(angleDeg*Pi/180);
+  FLookWhere := inv*m*FMatrix*FLookWhere;
+begin
+  Camera.LookLeft(angleDeg);
 end;
 procedure TBGRAScene3D.LookRight(angleDeg: single);
 begin
   LookLeft(-angleDeg);
+  Camera.LookRight(angleDeg);
 end;
 procedure TBGRAScene3D.LookUp(angleDeg: single);
+var m,inv: TMatrix3D;
+begin
+  inv := MatrixInverse3D(FMatrix);
+  m := MatrixRotateX(-angleDeg*Pi/180);
+  FLookWhere := inv*m*FMatrix*FLookWhere;
+begin
+  Camera.LookUp(angleDeg);
 end;
 procedure TBGRAScene3D.LookDown(angleDeg: single);
 begin
   LookUp(-angleDeg);
+  Camera.LookDown(angleDeg);
 end;
 procedure TBGRAScene3D.Render;
 begin
+  InternalRender(FSurface, RenderingOptions.AntialiasingMode, 1);
+  FRenderer := TBGRARenderer3D.Create(FSurface, RenderingOptions,
+    FAmbiantLightColorF,
+    FLights);
+  DoRender;
+  FRenderer.Free;
+end;
+procedure TBGRAScene3D.Render(ARenderer: TCustomRenderer3D);
+begin
+  FRenderer := ARenderer;
+  DoRender;
+  FRenderer := nil;
 end;
 …
   i: Integer;
 begin
-  ComputeMatrix;
   FProjection.Zoom := Zoom;
   FProjection.Zoom.X *= ScaleX;
 …
   FProjection.Center.Y *= ScaleY;
   for i := 0 to FObjectCount-1 do
+    FObjects[i].ComputeWithMatrix(FMatrix, FProjection);
+end;
+function TBGRAScene3D.ComputeCoordinate(ASceneCoord: TPoint3D_128; APart: IBGRAPart3D): TPointF;
+begin
+  result := APart.ComputeCoordinate(ASceneCoord, FProjection);
+    FObjects[i].ComputeWithMatrix(Camera.Matrix, FProjection);
 end;
 …
   end else
     result := PointF(0,0);
-end;
-procedure TBGRAScene3D.ComputeLight;
-begin
 end;
 …
 end;
 procedure TBGRAScene3D.InternalRender(ASurface: TBGRACustomBitmap; AAntialiasingMode: TAntialiasingMode3D; GlobalScale: single);
+procedure TBGRAScene3D.DoRender;
 var
   LFaces: array of TBGRAFace3D;
 …
       obj := FObjects[i];
       inc(LFaceCount, obj.GetFaceCount);
+      if obj.GetParentLighting then
+      begin
+        obj.SetLightingNormal(Self.DefaultLightingNormal);
+        obj.SetParentLighting(True);
+      end;
+      obj.Update;
     end;
     setlength(LFaces, LFaceCount);
 …
 var
+  multi: TBGRAMultishapeFiller;
+  ColorGradientTempBmp: TBGRACustomBitmap;
+  zbuffer: psingle;
+  faceDesc: TFaceRenderingDescription;
   LVertices: array of TBGRAVertex3D;
-  LColors: array of TBGRAPixel;
-  LTexCoord: array of TPointF;
-  LZ: array of single;
-  LProj: array of TPointF;
-  LPos3D, LNormal3D: array of TPoint3D_128;
-  LLighting: array of word;
-  shaderContext: TMemoryBlockAlign128;
-  lightingProc: TShaderFunction3D;
-  UseAmbiantColor: boolean;
   procedure DrawFace(numFace: integer);
-    procedure DrawAliasedColoredFace(shader: TShaderFunction3D; VCount: integer; context: PBasicLightingContext);
-    var j,k: integer;
-        SameColor: boolean;
-        center: record
-          proj: TPointF;
-          pos3D,normal3D: TPoint3D_128;
-          color: TBGRAPixel;
-        end;
-    begin
-      SameColor := True;
-      for j := 1 to VCount-1 do
-        if (LColors[j]<>LColors[j-1]) then SameColor := False;
-      if shader <> nil then
-      begin
-        if SameColor then
-        begin
-          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
-            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),nil,
-              slice(LTexCoord,VCount),False,shader,True,LColors[0],zbuffer,context);
-        end else
-        if VCount = 3 then
-        begin
-          ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
-          ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
-          ColorGradientTempBmp.SetPixel(0,1,LColors[2]);
-          ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[1],LColors[2]));
-          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
-            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
-              [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
-        end else
-        if VCount = 4 then
-        begin
-          ColorGradientTempBmp.SetPixel(0,0,LColors[0]);
-          ColorGradientTempBmp.SetPixel(1,0,LColors[1]);
-          ColorGradientTempBmp.SetPixel(1,1,LColors[2]);
-          ColorGradientTempBmp.SetPixel(0,1,LColors[3]);
-          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
-            slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),ColorGradientTempBmp,
-              [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
-        end else
-        if VCount >= 3 then
-        begin //split into triangles
-          with center do
-          begin
-            ClearPoint3D_128(pos3D);
-            ClearPoint3D_128(normal3D);
-            color := MergeBGRA(slice(LColors,VCount));
-          end;
-          for j := 0 to VCount-1 do
-          begin
-            center.pos3D += LPos3D[j];
-            center.normal3D += LNormal3D[j];
-          end;
-          with center do
-          begin
-            pos3D *= (1/VCount);
-            Normalize3D_128(normal3D);
-          end;
-          center.proj := ComputeCoordinate(center.pos3D);
-          k := VCount-1;
-          for j := 0 to VCount-1 do
-          begin
-            ColorGradientTempBmp.SetPixel(0,0,LColors[k]);
-            ColorGradientTempBmp.SetPixel(1,0,LColors[j]);
-            ColorGradientTempBmp.SetPixel(0,1,center.color);
-            ColorGradientTempBmp.SetPixel(1,1,MergeBGRA(LColors[j],center.color));
-            BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
-              [LProj[k],LProj[j],center.proj], [LPos3D[k],LPos3D[j],center.pos3D],
-              [LNormal3D[k],LNormal3D[j],center.normal3D], ColorGradientTempBmp,
-                [PointF(0,0),PointF(1,0),PointF(0,1)],True,shader,True, BGRAPixelTransparent,zbuffer,context);
-            k := j;
-          end;
-        end;
-      end else
-      begin
-        if SameColor then
-        begin
-          if RenderingOptions.PerspectiveMode = pmZBuffer then
-            BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
-            slice(LZ,VCount), slice(LColors,VCount),True,zbuffer)
-          else
-            ASurface.FillPoly(slice(LProj,VCount),LColors[0],dmDrawWithTransparency);
-        end
-        else
-        begin
-          if VCount > 4 then
-          begin //split into triangles
-            with center do
-            begin
-              ClearPoint3D_128(pos3D);
-              color := MergeBGRA(slice(LColors,VCount));
-            end;
-            for j := 0 to VCount-1 do
-              center.pos3D += LPos3D[j];
-            with center do
-              pos3D *= (1/VCount);
-            center.proj := ComputeCoordinate(center.pos3D);
-            k := VCount-1;
-            if RenderingOptions.PerspectiveMode = pmLinearMapping then
-            begin
-              for j := 0 to VCount-1 do
-              begin
-                ASurface.FillPolyLinearColor([LProj[k],LProj[j],center.proj],[LColors[k],LColors[j],center.color]);
-                k := j;
-              end;
-            end else
-            begin
-              for j := 0 to VCount-1 do
-              begin
-                BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, [LProj[k],LProj[j],center.proj],
-                 [LZ[k],LZ[j],center.pos3D.z], [LColors[k],LColors[j],center.color],True,zbuffer);
-                k := j;
-              end;
-            end;
-          end else
-          begin
-            if RenderingOptions.PerspectiveMode = pmLinearMapping then
-              ASurface.FillPolyLinearColor(slice(LProj,VCount),slice(LColors,VCount))
-            else
-              BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(ASurface, slice(LProj,VCount),
-               slice(LZ,VCount), slice(LColors,VCount),True,zbuffer);
-          end;
-        end;
-      end;
-    end;
   var
     j,k: Integer;
-    LTexture: IBGRAScanner;
-    LMaterial: TBGRAMaterial3D;
-    SameColor: boolean;
-    LLightNormal : TLightingNormal3D;
-    LNoLighting: boolean;
-    PtCenter: TPointF;
-    PtCenter3D: TPoint3D_128;
-    ColorCenter: TBGRAPixel;
     VCount,NewVCount: integer;
+    ctx: PSceneLightingContext;
+    NegNormals, UseDiffuseColor,
+    UseDiffuseLightness{, OnlyDirectionalLight}: boolean;
+    NegNormals: boolean;
     LastVisibleVertex: integer;
 …
        LVertices[NewVCount] := nil; //computed
+       LColors[NewVCount] := MergeBGRA(LColors[n1],round((1-t)*65536),LColors[n2],round(t*65536));
+       LTexCoord[NewVCount] := LTexCoord[n1]*(1-t) + LTexCoord[n2]*t;
+       LPos3D[NewVCount] := LPos3D[n1]*(1-t) + LPos3D[n2]*t;
+       LNormal3D[NewVCount] := LNormal3D[n1]*(1-t) + LNormal3D[n2]*t;
+       LZ[NewVCount] := LZ[n1]*(1-t) + LZ[n2]*t;
+       LProj[NewVCount] := ComputeCoordinate(LPos3D[NewVCount]);
+       faceDesc.Colors[NewVCount] := MergeBGRA(faceDesc.Colors[n1],round((1-t)*65536),faceDesc.Colors[n2],round(t*65536));
+       faceDesc.TexCoords[NewVCount] := faceDesc.TexCoords[n1]*(1-t) + faceDesc.TexCoords[n2]*t;
+       faceDesc.Positions3D[NewVCount] := faceDesc.Positions3D[n1]*(1-t) + faceDesc.Positions3D[n2]*t;
+       faceDesc.Normals3D[NewVCount] := faceDesc.Normals3D[n1]*(1-t) + faceDesc.Normals3D[n2]*t;
+       faceDesc.Projections[NewVCount] := ComputeCoordinate(faceDesc.Positions3D[NewVCount]);
        NewVCount += 1;
     end;
     procedure LoadVertex(idxL: integer; idxV: integer);
     var desc: PBGRAFaceVertexDescription;
+    var vertexDesc: PBGRAFaceVertexDescription;
         tempV: TBGRAVertex3D;
     begin
       with LFaces[numFace] do
       begin
         desc := VertexDescription[idxV];
         with desc^ do
+        vertexDesc := VertexDescription[idxV];
+        with vertexDesc^ do
         begin
           tempV := TBGRAVertex3D(vertex.GetAsObject);
           LVertices[idxL] := tempV;
+          if LTexture <> nil then
+            LColors[idxL] := BGRA(128,128,128)
+          else
+          begin
+            if ColorOverride then
+              LColors[idxL] := Color
+            else
+            begin
+              if tempV.ParentColor then
+                LColors[idxL] := Object3D.Color
+              else
+                LColors[idxL] := tempV.Color;
+            end;
+          end;
+          if TexCoordOverride then
+            LTexCoord[idxL] := TexCoord
+          else
+            LTexCoord[idxL] := tempV.TexCoord;
+          with LMaterial.GetTextureZoom do
+          begin
+            LTexCoord[idxL].x *= x;
+            LTexCoord[idxL].y *= y;
+          end;
+          faceDesc.Colors[idxL] := ActualColor;
+          faceDesc.TexCoords[idxL] := ActualTexCoord;
           with tempV.CoordData^ do
           begin
+            LPos3D[idxL] := viewCoord;
+            LNormal3D[idxL] := viewNormal;
+            LProj[idxL] := projectedCoord;
+            LZ[idxL] := viewCoord.Z;
+            faceDesc.Positions3D[idxL] := viewCoord;
+            facedesc.Normals3D[idxL] := viewNormal;
+            faceDesc.Projections[idxL] := projectedCoord;
           end;
           if Normal <> nil then
+            LNormal3D[idxL] := Normal.ViewNormal_128;
+            facedesc.Normals3D[idxL] := Normal.ViewNormal_128;
+          Normalize3D_128(facedesc.Normals3D[idxL]);
         end;
       end;
 …
        if VCount < 3 then exit;
+       if Material <> nil then
+         LMaterial := TBGRAMaterial3D(Material.GetAsObject)
+       else if Object3D.Material <> nil then
+         LMaterial := TBGRAMaterial3D(Object3D.Material.GetAsObject)
+       else if self.DefaultMaterial <> nil then
+         LMaterial := TBGRAMaterial3D(self.DefaultMaterial.GetAsObject)
+       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;
+       faceDesc.NormalsMode := Object3D.LightingNormal;
+       faceDesc.Material := ActualMaterial;
+       if faceDesc.Material = nil then exit;
+       faceDesc.Texture := ActualTexture;
        if length(LVertices) < VCount+3 then  //keep margin for z-clip
        begin
          setlength(LVertices, (VCount+3)*2);
+         setlength(LColors, length(LVertices));
+         setlength(LTexCoord, length(LVertices));
+         setlength(LZ, length(LVertices));
+         setlength(LProj, length(LVertices));
+         setlength(LPos3D, length(LVertices));
+         setlength(LNormal3D, length(LVertices));
+         setlength(LLighting, length(LVertices));
+         setlength(faceDesc.Colors, length(LVertices));
+         setlength(faceDesc.TexCoords, length(LVertices));
+         setlength(faceDesc.Projections, length(LVertices));
+         setlength(faceDesc.Positions3D, length(LVertices));
+         setlength(faceDesc.Normals3D, length(LVertices));
        end;
+       NewVCount := 0;
+       LastVisibleVertex := -1;
+       for k := VCount-1 downto 0 do
+         if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then
+         begin
+           LastVisibleVertex := k;
+           break;
+         end;
+       if LastVisibleVertex = -1 then exit;
+       k := VCount-1;
+       for j := 0 to VCount-1 do
+       if FRenderer.HandlesNearClipping then
        begin
+         if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then
+         begin
+           if k <> LastVisibleVertex then   //one or more vertices is out
+           begin
+             LoadVertex(NewVCount+1, LastVisibleVertex);
+             LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount);
+             AddZIntermediate(NewVCount+1,NewVCount+2);
+             LoadVertex(NewVCount+1, j);
+             LoadVertex(NewVCount+2, k);
+             AddZIntermediate(NewVCount+1,NewVCount+2);
+             inc(NewVCount);
+           end else
+           begin
+             LoadVertex(NewVCount, j);
+             NewVCount += 1;
+           end;
+           LastVisibleVertex := j;
+         end;
+         k := j;
+       end;
+       VCount := NewVCount;
+       if VCount < 3 then exit; //after z-clipping
+       if not IsPolyVisible(slice(LProj,VCount)) then
+       begin
+         if not Biface then exit;
+         NegNormals := True;
+         for j := 0 to VCount-1 do
+           LoadVertex(j,j);
        end else
        begin
+         NegNormals := False;
+         NewVCount := 0;
+         LastVisibleVertex := -1;
+         for k := VCount-1 downto 0 do
+           if Vertex[k].ViewCoordZ >= RenderingOptions.MinZ then
+           begin
+             LastVisibleVertex := k;
+             break;
+           end;
+         if LastVisibleVertex = -1 then exit;
+         k := VCount-1;
+         for j := 0 to VCount-1 do
+         begin
+           if Vertex[j].ViewCoordZ >= RenderingOptions.MinZ then
+           begin
+             if k <> LastVisibleVertex then   //one or more vertices is out
+             begin
+               LoadVertex(NewVCount+1, LastVisibleVertex);
+               LoadVertex(NewVCount+2, (LastVisibleVertex+1) mod VertexCount);
+               AddZIntermediate(NewVCount+1,NewVCount+2);
+               LoadVertex(NewVCount+1, j);
+               LoadVertex(NewVCount+2, k);
+               AddZIntermediate(NewVCount+1,NewVCount+2);
+               inc(NewVCount);
+             end else
+             begin
+               LoadVertex(NewVCount, j);
+               NewVCount += 1;
+             end;
+             LastVisibleVertex := j;
+           end;
+           k := j;
+         end;
+         VCount := NewVCount;
+         if VCount < 3 then exit; //after z-clipping
        end;
+       //from here we assume the face will be drawn
+       inc(FRenderedFaceCount);
+       if not FRenderer.HandlesFaceCulling then
+       begin
+         if not IsPolyVisible(slice(faceDesc.Projections,VCount)) then
+         begin
+           if not Biface then exit;
+           NegNormals := True;
+         end else
+         begin
+           NegNormals := False;
+         end;
+       end else
+         NegNormals := false;
        //compute normals
        case LLightNormal of
+       case faceDesc.NormalsMode of
          lnFace: for j := 0 to VCount-1 do
                    LNormal3D[j] := ViewNormal_128;
+                   faceDesc.Normals3D[j] := ViewNormal_128;
          lnFaceVertexMix:
              for j := 0 to VCount-1 do
              begin
                LNormal3D[j] += ViewNormal_128;
                Normalize3D_128(LNormal3D[j]);
+               faceDesc.Normals3D[j] += ViewNormal_128;
+               Normalize3D_128(faceDesc.Normals3D[j]);
              end;
        end;
        if NegNormals then
          for j := 0 to VCount-1 do
+           LNormal3D[j] := -LNormal3D[j];
+       //prepare lighting
+       {OnlyDirectionalLight := true;
+       for j := 0 to LightCount-1 do
+         if not Light[j].IsDirectional then OnlyDirectionalLight := false; }
+       if LMaterial.GetSpecularOn then
+        lightingProc:= TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor) else
+       begin
+         UseDiffuseColor := UseAmbiantColor;
+         if not UseDiffuseColor then
+         begin
+           with LMaterial.GetDiffuseColorInt do
+            UseDiffuseColor := (r <> g) or (g <> b);
+           if not UseDiffuseColor and LMaterial.GetAutoDiffuseColor then
+           begin
+             for j := 0 to LightCount-1 do
+               if Light[j].ColoredLight then
+               begin
+                 UseDiffuseColor := true;
+                 break;
+               end;
+           end;
+         end;
+         if UseDiffuseColor then
+           lightingProc := TShaderFunction3D(@ApplyLightingWithDiffuseColor) else
+         begin
+           UseDiffuseLightness := FAmbiantLightness <> 32768;
+           if not UseDiffuseLightness then
+           begin
+             if LightCount <> 0 then
+               UseDiffuseLightness := true;
+           end;
+           if UseDiffuseLightness then
+             lightingProc := TShaderFunction3D(@ApplyLightingWithLightness) else
+           if FAmbiantLightness <> 32768 then
+            lightingProc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly) else
+              lightingProc := TShaderFunction3D(@ApplyNoLighting);
+         end;
+       end;
+       ctx := PSceneLightingContext( shaderContext.Data );
+       ctx^.material := LMaterial;
+           faceDesc.Normals3D[j] := -faceDesc.Normals3D[j];
        if LightThroughFactorOverride then
          ctx^.LightThroughFactor := LightThroughFactor
+         faceDesc.LightThroughFactor := LightThroughFactor
        else
+         ctx^.LightThroughFactor := LMaterial.GetLightThroughFactor;
+       ctx^.LightThrough := ctx^.LightThroughFactor > 0;
+       ctx^.SaturationHighF := LMaterial.GetSaturationHigh;
+       ctx^.SaturationLowF := LMaterial.GetSaturationLow;
+       ctx^.SaturationHigh := round(LMaterial.GetSaturationHigh*32768);
+       ctx^.SaturationLow := round(LMaterial.GetSaturationLow*32768);
+       //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud
+       if (
+           (RenderingOptions.LightingInterpolation = liAlwaysHighQuality) or
+           ((RenderingOptions.LightingInterpolation = liSpecularHighQuality) and LMaterial.GetSpecularOn)
+       ) and (LLightNormal <> lnNone) {and (not (LLightNormal = lnFace) and OnlyDirectionalLight) }then
+       begin
+         if LTexture = nil then
+           DrawAliasedColoredFace(lightingProc,VCount,PBasicLightingContext(ctx)) //use shader
+         else
+           BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(ASurface,
+               slice(LProj,VCount),slice(LPos3D,VCount),slice(LNormal3D,VCount),LTexture,
+                 slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation,lightingProc,True, BGRAPixelTransparent,zbuffer,PBasicLightingContext(ctx));
+         exit;
+       end;
+       //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong)
+       LNoLighting := True;
+       for j := 0 to VCount-1 do
+       begin
+         with ctx^ do
+         begin
+           basic.Position := LPos3D[j];
+           basic.Normal := LNormal3D[j];
+         end;
+         LColors[j] := lightingProc(PBasicLightingContext(ctx),LColors[j]);
+         if LColors[j] <> BGRA(128,128,128) then
+           LNoLighting := false;
+       end;
+       if (AAntialiasingMode = am3dMultishape) and not (RenderingOptions.PerspectiveMode = pmZBuffer) then //high-quality antialiasing
+       begin
+         if LTexture <> nil then
+         begin
+           if (RenderingOptions.PerspectiveMode <> pmLinearMapping) and (VCount=4) then
+             multi.AddQuadPerspectiveMapping(LProj[0],LProj[1],LProj[2],LProj[3],LTexture,LTexCoord[0],LTexCoord[1],LTexCoord[2],LTexCoord[3])
+           else
+           if VCount>=3 then
+           begin
+             for j := 0 to VCount-3 do
+               multi.AddTriangleLinearMapping(LProj[j],LProj[j+1],LProj[j+2],LTexture,LTexCoord[j],LTexCoord[j+1],LTexCoord[j+2]);
+           end;
+         end
+         else
+         begin
+           SameColor := True;
+           for j := 1 to VCount-1 do
+             if (LColors[j]<>LColors[j-1]) then SameColor := False;
+           if SameColor then
+             multi.AddPolygon(slice(LProj,VCount),LColors[0])
+           else
+           if VCount=3 then
+             multi.AddTriangleLinearColor(LProj[0],LProj[1],LProj[2],LColors[0],LColors[1],LColors[2])
+           else
+           if VCount>=3 then
+           begin  //split into triangles
+             PtCenter3D := Point3D_128_Zero;
+             for j := 0 to VCount-1 do
+               PtCenter3D += LPos3D[j];
+             PtCenter3D *= (1/VCount);
+             PtCenter := ComputeCoordinate(PtCenter3D);
+             ColorCenter := MergeBGRA(slice(LColors,VCount));
+             k := VCount-1;
+             for j := 0 to VCount-1 do
+             begin
+               multi.AddTriangleLinearColor(LProj[k],LProj[j],PtCenter,LColors[k],LColors[j],ColorCenter);
+               k := j;
+             end;
+           end;
+         end;
+       end else
+       begin
+         if LTexture <> nil then
+         begin
+           if LNoLighting then
+           begin
+             if RenderingOptions.PerspectiveMode <> pmLinearMapping then
+               ASurface.FillPolyPerspectiveMapping(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation, zbuffer)
+             else
+               ASurface.FillPolyLinearMapping(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),RenderingOptions.TextureInterpolation);
+           end else
+           begin
+             for j := 0 to VCount-1 do
+               LLighting[j] := LColors[j].green shl 8;
+             if RenderingOptions.PerspectiveMode <> pmLinearMapping then
+               ASurface.FillPolyPerspectiveMappingLightness(slice(LProj,VCount),slice(LZ,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation, zbuffer)
+             else
+               ASurface.FillPolyLinearMappingLightness(slice(LProj,VCount),LTexture,slice(LTexCoord,VCount),slice(LLighting,VCount),RenderingOptions.TextureInterpolation);
+           end;
+         end
+         else
+           DrawAliasedColoredFace(nil,VCount,PBasicLightingContext(ctx));  //already low-quality shaded
+       end;
+         faceDesc.LightThroughFactor := faceDesc.Material.GetLightThroughFactor;
+       faceDesc.NbVertices:= VCount;
+       faceDesc.Biface := Biface;
+       if FRenderer.RenderFace(faceDesc, @ComputeCoordinate) then
+         inc(FRenderedFaceCount);
      end;
   end;
-  procedure DrawWithResample;
-  var
-    tempSurface: TBGRACustomBitmap;
-  begin
-    tempSurface := ASurface.NewBitmap(ASurface.Width*RenderingOptions.AntialiasingResampleLevel,ASurface.Height*RenderingOptions.AntialiasingResampleLevel);
-    InternalRender(tempSurface, am3dNone, RenderingOptions.AntialiasingResampleLevel);
-    BGRAResample.DownSamplePutImage(tempSurface,RenderingOptions.AntialiasingResampleLevel,RenderingOptions.AntialiasingResampleLevel,
-                 ASurface, 0,0, dmDrawWithTransparency);
-    tempSurface.Free;
-  end;
 var i,j: integer;
 …
   FRenderedFaceCount:= 0;
-  if ASurface = nil then
-    raise exception.Create('No surface specified');
-  if (AAntialiasingMode = am3dResample) and (RenderingOptions.AntialiasingResampleLevel > 1) then
-  begin
-    DrawWithResample;
-    exit;
-  end;
   PrepareFaces;
+  ComputeView(GlobalScale,GlobalScale);
+  ComputeLight;
+  UseAmbiantColor := (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b);
+  ComputeView(FRenderer.GlobalScale,FRenderer.GlobalScale);
+  FRenderer.Projection := FProjection;
   SortFaces(LFaces);
   LVertices := nil;
+  if AAntialiasingMode = am3dMultishape then
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.PolygonOrder := poLastOnTop;
+  end
+  else
+    multi := nil;
+  ColorGradientTempBmp := ASurface.NewBitmap(2,2);
+  ColorGradientTempBmp.ScanInterpolationFilter := rfLinear;
+  if RenderingOptions.PerspectiveMode = pmZBuffer then
+  begin
+    getmem(zbuffer, ASurface.NbPixels*sizeof(single));
+    FillDWord(zbuffer^, ASurface.NbPixels, dword(single(0)));
+  end
+  else
+    zbuffer := nil;
+  shaderContext := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext));
+  if zbuffer <> nil then
+  //if there is a Z-Buffer, it is possible to avoid drawing things that
+  //are hidden by opaque faces by drawing first all opaque faces
+  if FRenderer.HasZBuffer then
   begin
     setlength(LFaceOpaque, length(LFaces));
 …
       DrawFace(i);
   end;
-  shaderContext.Free;
-  if zbuffer <> nil then freemem(zbuffer);
-  ColorGradientTempBmp.Free;
-  if multi <> nil then
-  begin
-    multi.Draw(ASurface);
-    multi.Free;
-  end;
-end;
-procedure TBGRAScene3D.SetViewPoint(const AValue: TPoint3D);
-begin
-  FViewPoint := Point3D_128(AValue);
-end;
-function TBGRAScene3D.ApplyLightingWithLightness(Context: PSceneLightingContext;
-  Color: TBGRAPixel): TBGRAPixel;
-var i: Integer;
-  m: TBGRAMaterial3D;
-begin
-  m := TBGRAMaterial3D(Context^.material);
-  if not m.GetAutoSimpleColor then Color := ColorIntToBGRA(BGRAToColorIntMultiply(Color, m.GetSimpleColorInt));
-  Context^.lightness := FAmbiantLightness;
-  i := FLights.Count-1;
-  while i >= 0 do
-  begin
-    TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context);
-    dec(i);
-  end;
-  with Context^ do
-    if Lightness <= 0 then
-      result := BGRA(0,0,0,color.alpha)
-    else
-    begin
-      if Lightness <= SaturationLow then
-        result := ApplyIntensityFast(Color, Lightness)
-      else if Lightness >= SaturationHigh then
-        result := BGRA(255,255,255,color.alpha)
-      else
-        result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow),
-                              (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 );
-    end;
-end;
-function TBGRAScene3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext;
-  Color: TBGRAPixel): TBGRAPixel;
-var i: Integer;
-  m: TBGRAMaterial3D;
-begin
-  m := TBGRAMaterial3D(Context^.material);
-  if m.GetAutoAmbiantColor then
-    Context^.diffuseColor := FAmbiantLightColor
-  else
-    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
-  i := FLights.Count-1;
-  while i >= 0 do
-  begin
-    TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context);
-    dec(i);
-  end;
-  result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,Context^.diffuseColor));
-  result.alpha := Color.alpha;
-end;
-function TBGRAScene3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext;
-  Color: TBGRAPixel): TBGRAPixel;
-var i: Integer;
-  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);
-  i := FLights.Count-1;
-  while i >= 0 do
-  begin
-    TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context);
-    dec(i);
-  end;
-  with Context^ do
-  begin
-    diffuseColor.a := 65536;
-    result := ColorIntToBGRA(BGRAToColorIntMultiply(Color,diffuseColor) + specularColor);
-  end;
-end;
-function TBGRAScene3D.ApplyNoLighting(Context: PSceneLightingContext;
-  Color: TBGRAPixel): TBGRAPixel;
-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;
-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)
-  else
-    result := ApplyIntensityFast(Color, FAmbiantLightness);
 end;
 …
 function TBGRAScene3D.CreateMaterial: IBGRAMaterial3D;
+begin
+  result := TBGRAMaterial3D.Create;
+var m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D.Create;
+  m.OnTextureChanged := @OnMaterialTextureChanged;
+  result := m;
   AddMaterial(result);
 end;
 function TBGRAScene3D.CreateMaterial(ASpecularIndex: integer): IBGRAMaterial3D;
+begin
+  result := TBGRAMaterial3D.Create;
+  result.SpecularIndex := ASpecularIndex;
+  result.SpecularColor := BGRAWhite;
+var m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D.Create;
+  m.SetSpecularIndex(ASpecularIndex);
+  m.SetSpecularColor(BGRAWhite);
+  m.OnTextureChanged := @OnMaterialTextureChanged;
+  result := m;
   AddMaterial(result);
 end;
 …
 end;
+function TBGRAScene3D.MakeLightList: TList;
+var i: integer;
+begin
+  result := TList.Create;
+  for i := 0 to FLights.Count-1 do
+    result.Add(FLights[i]);
+end;
 initialization

GraphicTest/Packages/bgrabitmap/bgraslicescaling.pas

-              r472
+              r494
 uses
   Classes, SysUtils, Graphics, BGRABitmap, BGRABitmapTypes, IniFiles, FileUtil;
+  Classes, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, IniFiles;
 type
 …
 implementation
 uses types;
+uses BGRAUTF8, Types;
 function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins;
 …
         break;
       end;
-      Inc(p);
     end;
     if not isRepeating then

GraphicTest/Packages/bgrabitmap/bgrasse.inc

-              r472
+              r494
+{$IFDEF CPUI386}
+  {$DEFINE BGRASSE_AVAILABLE}
+{$IFDEF SSE_LOADV}
+  {$UNDEF SSE_LOADV}
+  {$ifdef cpux86_64}
+  mov rax,v
+  movups xmm1,[rax]
+  {$else}
+  mov eax,v
+  movups xmm1,[eax]
+  {$endif}
+{$ELSE}
+  {$IFDEF SSE_SAVEV}
+    {$UNDEF SSE_SAVEV}
+    {$ifdef cpux86_64}
+    mov rax,v
+    movups [rax],xmm1
+    {$else}
+    mov eax,v
+    movups [eax],xmm1
+    {$endif}
+  {$ELSE}
+    {$IFDEF CPUI386}
+      {$DEFINE BGRASSE_AVAILABLE}
+    {$ENDIF}
+    {$IFDEF cpux86_64}
+      {$DEFINE BGRASSE_AVAILABLE}
+    {$ENDIF}
+  {$ENDIF}
 {$ENDIF}
-{$IFDEF cpux86_64}
-  {$DEFINE BGRASSE_AVAILABLE}
-{$ENDIF}

GraphicTest/Packages/bgrabitmap/bgrasse.pas

-              r472
+              r494
 var UseSSE, UseSSE2, UseSSE3 : boolean;
+{$ifdef CPUI386}
+  {$asmmode intel}
+{$ENDIF}
+{$ifdef cpux86_64}
+  {$asmmode intel}
+{$ENDIF}
 {$ifdef BGRASSE_AVAILABLE}
-  {$asmmode intel}
   //SSE rotate singles
   const Shift231 = 1 + 8;
 …
 begin
   asm
     {$i sseloadv.inc}
+    {$DEFINE SSE_LOADV}{$i bgrasse.inc}
     movaps xmm2, xmm1
     mulps xmm2, xmm2
 …
     rsqrtps xmm2, xmm2
     mulps xmm1, xmm2  //apply
     {$i ssesavev.inc}
+    {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
   end;
 end;
 …
 begin
   asm
     {$i sseloadv.inc}
+    {$DEFINE SSE_LOADV}{$i bgrasse.inc}
     movaps xmm2, xmm1
     mulps xmm2, xmm2
 …
     rsqrtps xmm2, xmm2
     mulps xmm1, xmm2  //apply
     {$i ssesavev.inc}
+    {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
   end;
 end;
 …
     begin
       asm
         {$i sseloadv.inc}
+        {$DEFINE SSE_LOADV}{$i bgrasse.inc}
         movaps xmm2, xmm1
         mulps xmm2, xmm2
 …
         rsqrtps xmm2, xmm2
         mulps xmm1, xmm2  //apply
         {$i ssesavev.inc}
+        {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
       end;
     end

GraphicTest/Packages/bgrabitmap/bgrastreamlayers.pas

-              r472
+              r494
 implementation
+uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp;
+uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp,
+     BGRAUTF8;
 procedure SaveLayeredBitmapToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
 …
   StreamMaxLayerCount = 4096;
   StreamMaxHeaderSize = 256;
-{$i winstream.inc}
 function CheckStreamForLayers(AStream: TStream): boolean;
 …
     //header size
     HeaderSize:= WinReadLongint(AStream);
+    HeaderSize:= LEReadLongint(AStream);
     if (HeaderSize < 12) or (HeaderSize > StreamMaxHeaderSize) then
       raise exception.Create('Invalid header size');
     LayerStackStartPosition := AStream.Position + HeaderSize;
     NbLayers:= WinReadLongint(AStream);
+    NbLayers:= LEReadLongint(AStream);
     if (NbLayers < 0) or (NbLayers > StreamMaxLayerCount) then
       raise exception.Create('Invalid layer count');
     ASelectedLayerIndex:= WinReadLongint(AStream);
+    ASelectedLayerIndex:= LEReadLongint(AStream);
     if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= NbLayers) then
       raise exception.Create('Selected layer out of bounds');
     StackOption := WinReadLongint(AStream);
+    StackOption := LEReadLongint(AStream);
     result.LinearBlend := (StackOption and 1) = 1;
     if (StackOption and 2) = 2 then Compression := lzpRLE else Compression:= lzpZStream;
 …
     for i := 0 to NbLayers-1 do
     begin
       LayerHeaderSize:= WinReadLongint(AStream);
+      LayerHeaderSize:= LEReadLongint(AStream);
       LayerHeaderPosition := AStream.Position;
       LayerBitmapPosition := LayerHeaderPosition + LayerHeaderSize;
 …
       if AStream.Position <= LayerBitmapPosition-4 then
       begin
         LayerOption := WinReadLongint(AStream);
+        LayerOption := LEReadLongint(AStream);
         LayerVisible := (LayerOption and 1) = 1;
       end;
       if AStream.Position <= LayerBitmapPosition-4 then
         LayerBlendOp := TBlendOperation(WinReadLongint(AStream));
+        LayerBlendOp := TBlendOperation(LEReadLongint(AStream));
       if AStream.Position <= LayerBitmapPosition-8 then
       begin
         LayerOffset := Point(WinReadLongint(AStream),WinReadLongint(AStream));
+        LayerOffset := Point(LEReadLongint(AStream),LEReadLongint(AStream));
         if AStream.Position <= LayerBitmapPosition-4 then
         begin
           LayerId := WinReadLongint(AStream);
+          LayerId := LEReadLongint(AStream);
           LayerIdFound := true;
         end;
         if AStream.Position <= LayerBitmapPosition-4 then
           LayerOpacity := WinReadLongint(AStream) shr 8;
+          LayerOpacity := LEReadLongint(AStream) shr 8;
       end;
       if AStream.Position <= LayerBitmapPosition-4 then
       begin
         LayerBitmapSize := WinReadLongint(AStream);
+        LayerBitmapSize := LEReadLongint(AStream);
         LayerEndPosition:= LayerBitmapPosition+LayerBitmapSize;
       end;
 …
     raise exception.Create('Selected layer out of bounds');
   AStream.Write(StreamHeader[1], length(StreamHeader));
   WinWriteLongint(AStream, 12); //header size
   WinWriteLongint(AStream, ALayers.NbLayers);
   WinWriteLongint(AStream, ASelectedLayerIndex);
+  LEWriteLongint(AStream, 12); //header size
+  LEWriteLongint(AStream, ALayers.NbLayers);
+  LEWriteLongint(AStream, ASelectedLayerIndex);
   StackOption := 0;
   if ALayers.LinearBlend then StackOption := StackOption or 1;
   if ACompression = lzpRLE then StackOption:= StackOption or 2;
   WinWriteLongint(AStream, StackOption);
+  LEWriteLongint(AStream, StackOption);
   //end of header
 …
   begin
     LayerHeaderSizePosition:= AStream.Position;
     WinWriteLongint(AStream, 0); //header size not computed yet
+    LEWriteLongint(AStream, 0); //header size not computed yet
     LayerHeaderPosition := AStream.Position;
     LayerOption := 0;
     if ALayers.LayerVisible[i] then LayerOption:= LayerOption or 1;
     WinWriteLongint(AStream, LayerOption);
     WinWriteLongint(AStream, Longint(ALayers.BlendOperation[i]));
     WinWriteLongint(AStream, ALayers.LayerOffset[i].x);
     WinWriteLongint(AStream, ALayers.LayerOffset[i].y);
     WinWriteLongint(AStream, ALayers.LayerUniqueId[i]);
     WinWriteLongint(AStream, integer(ALayers.LayerOpacity[i])*$101);
+    LEWriteLongint(AStream, LayerOption);
+    LEWriteLongint(AStream, Longint(ALayers.BlendOperation[i]));
+    LEWriteLongint(AStream, ALayers.LayerOffset[i].x);
+    LEWriteLongint(AStream, ALayers.LayerOffset[i].y);
+    LEWriteLongint(AStream, ALayers.LayerUniqueId[i]);
+    LEWriteLongint(AStream, integer(ALayers.LayerOpacity[i])*$101);
     LayerBitmapSizePosition:=AStream.Position;
     WinWriteLongint(AStream, 0);
+    LEWriteLongint(AStream, 0);
     LayerBitmapPosition:=AStream.Position;
     LayerHeaderSize := LayerBitmapPosition - LayerHeaderPosition;
     AStream.Position:= LayerHeaderSizePosition;
     WinWriteLongint(AStream, LayerHeaderSize);
+    LEWriteLongint(AStream, LayerHeaderSize);
     //end of layer header
 …
       raise exception.Create('Image too big');
     AStream.Position:= LayerBitmapSizePosition;
     WinWriteLongint(AStream, BitmapSize);
+    LEWriteLongint(AStream, BitmapSize);
     AStream.Position:= LayerBitmapPosition+BitmapSize;
   end;

GraphicTest/Packages/bgrabitmap/bgrasvg.pas

-              r472
+              r494
 uses
+  Classes, SysUtils, BGRABitmapTypes, laz2_DOM, BGRAUnits, BGRASVGShapes, BGRACanvas2D;
+  Classes, SysUtils, BGRABitmapTypes, laz2_DOM, BGRAUnits, BGRASVGShapes,
+  BGRACanvas2D;
 type
 …
     function GetPreserveAspectRatio: string;
     function GetViewBox: TSVGViewBox;
+    function GetViewBox(AUnit: TCSSUnit): TSVGViewBox;
+    procedure GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox);
     function GetWidth: TFloatWithCSSUnit;
     function GetWidthAsCm: single;
 …
     FContent: TSVGContent;
     procedure Init(ACreateEmpty: boolean);
+    procedure InternalDraw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit; destDpi: TPointF); overload;
+    procedure InternalDraw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit; destDpi: single); overload;
+    function GetViewBoxAlignment(AHorizAlign: TAlignment; AVertAlign: TTextLayout): TPointF;
   public
     constructor Create; overload;
 …
     procedure SaveToFile(AFilenameUTF8: string);
     procedure SaveToStream(AStream: TStream);
+    procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; AUnit: TCSSUnit = cuPixel); overload;
+    procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: single); overload;
+    procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: TPointF); overload;
+    procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit = cuPixel); overload;
     procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: single); overload;
     procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: TPointF); overload;
+    procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit); overload;
+    procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x,y,w,h: single); overload;
+    procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y,w,h: single); overload;
     property Units: TSVGUnits read FUnits;
     property Width: TFloatWithCSSUnit read GetWidth write SetWidth;
 …
     property Zoomable: boolean read GetZoomable write SetZoomable;
     property ViewBox: TSVGViewBox read GetViewBox write SetViewBox;
+    property ViewBoxInUnit[AUnit: TCSSUnit]: TSVGViewBox read GetViewBox;
     property Attribute[AName: string]: string read GetAttribute write SetAttribute;
     property DefaultDpi: single read FDefaultDpi write SetDefaultDpi; //this is not saved in the SVG file
 …
 implementation
 uses laz2_XMLRead, laz2_XMLWrite, lazutf8classes, BGRATransform;
+uses laz2_XMLRead, laz2_XMLWrite, BGRAUTF8;
 const SvgNamespace = 'http://www.w3.org/2000/svg';
 …
   function parseNextFloat: single;
   var
     idxSpace,errPos: integer;
+    idxSpace,{%H-}errPos: integer;
   begin
     idxSpace:= pos(' ',viewBoxStr);
 …
 end;
+function TBGRASVG.GetViewBox(AUnit: TCSSUnit): TSVGViewBox;
+begin
+  GetViewBoxIndirect(AUnit,result);
+end;
+procedure TBGRASVG.GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox);
+begin
+  with FUnits.ViewBox do
+  begin
+    AViewBox.min := FUnits.ConvertCoord(min,cuCustom,AUnit);
+    AViewBox.size := FUnits.ConvertCoord(size,cuCustom,AUnit);
+  end;
+end;
 function TBGRASVG.GetWidth: TFloatWithCSSUnit;
 begin
 …
 end;
+function TBGRASVG.GetViewBoxAlignment(AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): TPointF;
+var vb: TSVGViewBox;
+begin
+  GetViewBoxIndirect(cuPixel, vb);
+  with vb do
+  begin
+    case AHorizAlign of
+      taCenter: result.x := -(min.x+size.x*0.5);
+      taRightJustify: result.x := -(min.x+size.x);
+    else
+      {taLeftJustify:} result.x := -min.x;
+    end;
+    case AVertAlign of
+      tlCenter: result.y := -(min.y+size.y*0.5);
+      tlBottom: result.y := -(min.y+size.y);
+    else
+      {tlTop:} result.y := -min.y;
+    end;
+  end;
+end;
 constructor TBGRASVG.Create;
 begin
 …
 end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit);
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout; x, y: single; AUnit: TCSSUnit);
 var prevMatrix: TAffineMatrix;
 begin
-  if (x<>0) or (y<>0) then
-  begin
-    prevMatrix := ACanvas2d.matrix;
-    ACanvas2d.translate(x,y);
-    Content.Draw(ACanvas2d,AUnit);
-    ACanvas2d.matrix := prevMatrix;
-  end else
-    Content.Draw(ACanvas2d,AUnit);
-end;
-procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: TPointF);
-begin
-  InternalDraw(ACanvas2d,x,y,cuPixel,destDpi);
-end;
-procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: single);
-begin
-  InternalDraw(ACanvas2d,x,y,cuPixel,destDpi);
-end;
-procedure TBGRASVG.InternalDraw(ACanvas2d: TBGRACanvas2D; x, y: single;
-  AUnit: TCSSUnit; destDpi: TPointF);
-var prevMatrix: TAffineMatrix;
-begin
-  if (Units.DpiX = 0) or (Units.DpiY = 0) then exit;
   prevMatrix := ACanvas2d.matrix;
   ACanvas2d.translate(x,y);
+  if AUnit = cuPixel then
+    ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
+  with GetViewBoxAlignment(AHorizAlign,AVertAlign) do ACanvas2d.translate(x,y);
+  Draw(ACanvas2d, 0,0, AUnit);
+  ACanvas2d.matrix := prevMatrix;
+end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout; x, y: single; destDpi: single);
+begin
+  Draw(ACanvas2d, AHorizAlign,AVertAlign, x,y, PointF(destDpi,destDpi));
+end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout; x, y: single; destDpi: TPointF);
+begin
+  ACanvas2d.save;
+  ACanvas2d.translate(x,y);
+  ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
+  ACanvas2d.strokeResetTransform;
+  ACanvas2d.strokeScale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
+  with GetViewBoxAlignment(AHorizAlign,AVertAlign) do ACanvas2d.translate(x,y);
+  Draw(ACanvas2d, 0,0, cuPixel);
+  ACanvas2d.restore;
+end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit);
+var prevLinearBlend: boolean;
+begin
+  prevLinearBlend:= ACanvas2d.linearBlend;
+  acanvas2d.linearBlend := true;
+  ACanvas2d.save;
+  ACanvas2d.translate(x,y);
   Content.Draw(ACanvas2d,AUnit);
+  ACanvas2d.matrix := prevMatrix;
+end;
+procedure TBGRASVG.InternalDraw(ACanvas2d: TBGRACanvas2D; x, y: single;
+  AUnit: TCSSUnit; destDpi: single);
+begin
+  InternalDraw(ACanvas2d,x,y,AUnit,PointF(destDpi,destDpi));
+  ACanvas2d.restore;
+  ACanvas2d.linearBlend := prevLinearBlend;
+end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: single);
+begin
+  Draw(ACanvas2d, x,y, PointF(destDpi,destDpi));
+end;
+procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: TPointF);
+begin
+  ACanvas2d.save;
+  ACanvas2d.translate(x,y);
+  ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
+  ACanvas2d.strokeResetTransform;
+  ACanvas2d.strokeScale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
+  Draw(ACanvas2d, 0,0, cuPixel);
+  ACanvas2d.restore;
+end;
+procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single);
+var vb: TSVGViewBox;
+begin
+  ACanvas2d.save;
+  ACanvas2d.translate(x,y);
+  ACanvas2d.strokeResetTransform;
+  GetViewBoxIndirect(cuPixel,vb);
+  with vb do
+  begin
+    ACanvas2d.translate(-min.x,-min.y);
+    if size.x <> 0 then
+    begin
+      ACanvas2d.scale(w/size.x,1);
+      ACanvas2d.strokeScale(w/size.x,1);
+    end;
+    if size.y <> 0 then
+    begin
+      ACanvas2d.scale(1,h/size.y);
+      ACanvas2d.strokeScale(1,h/size.y);
+    end;
+  end;
+  Draw(ACanvas2d, 0,0);
+  ACanvas2d.restore;
+end;
+procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout; x, y, w, h: single);
+var ratio,stretchRatio,zoom: single;
+  vb: TSVGViewBox;
+  sx,sy,sw,sh: single;
+begin
+  GetViewBoxIndirect(cuPixel,vb);
+  if (h = 0) or (w = 0) or (vb.size.x = 0) or (vb.size.y = 0) then exit;
+  ratio := vb.size.x/vb.size.y;
+  stretchRatio := w/h;
+  if ratio > stretchRatio then
+    zoom := w / vb.size.x
+  else
+    zoom := h / vb.size.y;
+  sx := x;
+  sy := y;
+  sw := vb.size.x*zoom;
+  sh := vb.size.y*zoom;
+  case AHorizAlign of
+    taCenter: sx += (w - sw)/2;
+    taRightJustify: sx += w - sw;
+  end;
+  case AVertAlign of
+    tlCenter: sy += (h - sh)/2;
+    tlBottom: sy += h - sh;
+  end;
+  StretchDraw(ACanvas2d, sx,sy,sw,sh);
 end;

GraphicTest/Packages/bgrabitmap/bgrasvgshapes.pas

-              r472
+              r494
 implementation
 uses BGRATransform, Graphics;
+uses BGRATransform, BGRAGraphics;
 function GetSVGFactory(ATagName: string): TSVGFactory;
 …
   if not isStrokeNone then
   begin
     ACanvas2d.strokeStyle(strokeColor);
+    ApplyStrokeStyle(ACanvas2D,AUnit);
     ACanvas2d.stroke;
   end;
 …
     if not isStrokeNone then
     begin
       ACanvas2d.strokeStyle(strokeColor);
+      ApplyStrokeStyle(ACanvas2D,AUnit);
       ACanvas2d.stroke;
     end;
 …
     if not isStrokeNone then
     begin
       ACanvas2d.strokeStyle(strokeColor);
+      ApplyStrokeStyle(ACanvas2D,AUnit);
       ACanvas2d.stroke;
     end;
 …
     if not isStrokeNone then
     begin
       ACanvas2d.strokeStyle(strokeColor);
+      ApplyStrokeStyle(ACanvas2D,AUnit);
       ACanvas2d.stroke;
     end;
 …
     if not isStrokeNone then
     begin
       ACanvas2d.strokeStyle(strokeColor);
+      ApplyStrokeStyle(ACanvas2D,AUnit);
       ACanvas2d.stroke;
     end;
 …
     if not isStrokeNone then
     begin
       ACanvas2d.strokeStyle(strokeColor);
+      ApplyStrokeStyle(ACanvas2D,AUnit);
       ACanvas2d.stroke;
     end;
 …
   if not isStrokeNone then
   begin
     ACanvas2d.strokeStyle(strokeColor);
+    ApplyStrokeStyle(ACanvas2D,AUnit);
     ACanvas2d.beginPath;
     ACanvas2d.moveTo(Units.ConvertWidth(x1,AUnit).value,Units.ConvertWidth(y1,AUnit).value);

GraphicTest/Packages/bgrabitmap/bgrasvgtype.pas

-              r472
+              r494
       function GetIsStrokeNone: boolean;
       function GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
+      function GetOpacity: single;
       function GetOrthoAttributeOrStyleWithUnit(AName: string
         ): TFloatWithCSSUnit;
       function GetStroke: string;
       function GetStrokeColor: TBGRAPixel;
+      function GetStrokeLineCap: string;
+      function GetStrokeLineJoin: string;
+      function GetStrokeMiterLimit: single;
       function GetStrokeOpacity: single;
       function GetStrokeWidth: TFloatWithCSSUnit;
 …
       procedure SetHorizAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
       procedure SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix);
+      procedure SetOpacity(AValue: single);
       procedure SetStroke(AValue: string);
       procedure SetStrokeColor(AValue: TBGRAPixel);
+      procedure SetStrokeLineCap(AValue: string);
+      procedure SetStrokeLineJoin(AValue: string);
+      procedure SetStrokeMiterLimit(AValue: single);
       procedure SetStrokeOpacity(AValue: single);
       procedure SetStrokeWidth(AValue: TFloatWithCSSUnit);
 …
       procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual;
       procedure LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos,AColonPos,AValueLength: integer);
+      procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
     public
       constructor Create({%H-}ADocument: TXMLDocument; AElement: TDOMElement; AUnits: TCSSUnitConverter); virtual;
 …
       property strokeColor: TBGRAPixel read GetStrokeColor write SetStrokeColor;
       property strokeOpacity: single read GetStrokeOpacity write SetStrokeOpacity;
+      property strokeMiterLimit: single read GetStrokeMiterLimit write SetStrokeMiterLimit;
+      property strokeLineJoin: string read GetStrokeLineJoin write SetStrokeLineJoin;
+      property strokeLineCap: string read GetStrokeLineCap write SetStrokeLineCap;
       property fill: string read GetFill write SetFill;
       property fillColor: TBGRAPixel read GetFillColor write SetFillColor;
       property fillOpacity: single read GetFillOpacity write SetFillOpacity;
+      property opacity: single read GetOpacity write SetOpacity;
   end;
 …
 implementation
-uses Math;
 { TSVGParser }
 …
 begin
   result := StrToBGRA(fill,BGRABlack);
   result.alpha := round(result.alpha*fillOpacity);
+  result.alpha := round(result.alpha*fillOpacity*opacity);
   if result.alpha = 0 then result := BGRAPixelTransparent;
 end;
 …
     begin
       angle := parser.ParseFloat;
+      result *= AffineMatrix(1,tan(angle*Pi/180),0,
+,        1,        0);
+      result *= AffineMatrixSkewXDeg(angle);
     end else
     if compareText(kind,'skewy')=0 then
     begin
       angle := parser.ParseFloat;
+      result *= AffineMatrix(1,         0        ,0,
+                     tan(angle*Pi/180), 1,        0);
+      result *= AffineMatrixSkewYDeg(angle);
     end;
     parser.SkipUpToSymbol(')');
 …
 end;
+function TSVGElement.GetOpacity: single;
+var errPos: integer;
+begin
+  val(AttributeOrStyle['opacity'], result, errPos);
+  if errPos <> 0 then result := 1 else
+    if result < 0 then result := 0 else
+      if result > 1 then result := 1;
+end;
 function TSVGElement.GetOrthoAttributeOrStyleWithUnit(AName: string
   ): TFloatWithCSSUnit;
 …
 begin
   result := StrToBGRA(stroke);
   result.alpha := round(result.alpha*strokeOpacity);
+  result.alpha := round(result.alpha*strokeOpacity*opacity);
   if result.alpha = 0 then result := BGRAPixelTransparent;
+end;
+function TSVGElement.GetStrokeLineCap: string;
+begin
+  result := AttributeOrStyle['stroke-linecap'];
+  if result = '' then result := 'butt';
+end;
+function TSVGElement.GetStrokeLineJoin: string;
+begin
+  result := AttributeOrStyle['stroke-linejoin'];
+  if result = '' then result := 'miter';
+end;
+function TSVGElement.GetStrokeMiterLimit: single;
+var errPos: integer;
+begin
+  val(AttributeOrStyle['stroke-miterlimit'], result, errPos);
+  if errPos <> 0 then result := 4 else
+    if result < 1 then result := 1;
 end;
 …
 function TSVGElement.GetStrokeWidth: TFloatWithCSSUnit;
 begin
   result := HorizAttributeOrStyleWithUnit['stroke-width'];
+  result := OrthoAttributeOrStyleWithUnit['stroke-width'];
 end;
 …
 end;
+procedure TSVGElement.SetOpacity(AValue: single);
+begin
+  Attribute['opacity'] := Units.formatValue(AValue);
+  RemoveStyle('opacity');
+end;
 procedure TSVGElement.SetStroke(AValue: string);
 begin
 …
   AValue.alpha:= 255;
   stroke := BGRAToStr(AValue, CSSColors);
+end;
+procedure TSVGElement.SetStrokeLineCap(AValue: string);
+begin
+  Attribute['stroke-linecap'] := AValue;
+  RemoveStyle('stroke-linecap');
+end;
+procedure TSVGElement.SetStrokeLineJoin(AValue: string);
+begin
+  Attribute['stroke-linejoin'] := AValue;
+  RemoveStyle('stroke-linejoin');
+end;
+procedure TSVGElement.SetStrokeMiterLimit(AValue: single);
+begin
+  if AValue < 1 then AValue := 1;
+  Attribute['stroke-miterlimit'] := Units.formatValue(AValue);
+  RemoveStyle('stroke-miterlimit');
 end;
 …
     if AText[i] = ';' then
     begin
       curValueLength := i-curColon;
+      curValueLength := i-(curColon+1);
       if CheckShouldReturnResult then exit;
       curStart := -1;
 …
   if curColon <> -1 then
   begin
     curValueLength:= length(AText)-curColon;
+    curValueLength:= length(AText)-(curColon+1)+1;
     if CheckShouldReturnResult then exit;
   end;
+end;
+procedure TSVGElement.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
+begin
+  ACanvas2d.strokeStyle(strokeColor);
+  ACanvas2d.lineWidth := Units.ConvertWidth(strokeWidth,AUnit).value;
+  ACanvas2d.lineCap := strokeLineCap;
+  ACanvas2d.lineJoin := strokeLineJoin;
+  ACanvas2d.miterLimit := strokeMiterLimit;
 end;

GraphicTest/Packages/bgrabitmap/bgratext.pas

-              r472
+              r494
 interface
+{$IFDEF LINUX}
+  {$DEFINE LCL_RENDERER_IS_FINE}
+  {$DEFINE LCL_CLEARTYPE_RENDERER_IS_FINE}
+{$ENDIF}
+{$IFDEF FREEBSD}
+  {$DEFINE LCL_RENDERER_IS_FINE}
+  {$DEFINE LCL_CLEARTYPE_RENDERER_IS_FINE}
+{$ENDIF}
+{$IFDEF DARWIN}
+  {$DEFINE LCL_RENDERER_IS_FINE}
+  {$DEFINE RENDER_TEXT_ON_TBITMAP}
+{$ENDIF}
+{
   Font rendering units : BGRAText, BGRATextFX, BGRAVectorize, BGRAFreeType
+  This unit provides basic text rendering functions using LCL, and general
+  text definitions.
+  This unit provides basic text rendering functions using LCL.
   Text functions use a temporary bitmap where the operating system text drawing is used.
 …
 uses
   Classes, Types, SysUtils, Graphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask;
+  Classes, Types, SysUtils, BGRAGraphics, BGRABitmapTypes, InterfaceBase, BGRAPen, BGRAGrayscaleMask;
 type
   TWordBreakHandler = procedure(var ABeforeUTF8, AAfterUTF8: string) of object;
+  TWordBreakHandler = BGRABitmapTypes.TWordBreakHandler;
   { TCustomLCLFontRenderer }
 …
 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 FontFullHeightSign: integer;
 function LCLFontAvailable: boolean;
+function GetFineClearTypeAuto: TBGRAFontQuality;
 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);
+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 FontAntialiasingLevel = {$IFDEF LCL_RENDERER_IS_FINE}3{$ELSE}6{$ENDIF};
 const FontDefaultQuality = fqAntialiased;
+function GetFontPixelMetric(AFont: TFont): TFontPixelMetric;
+function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric;
+var
+  BGRATextOutImproveReadabilityProc : procedure (bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
 implementation
 uses GraphType, Math, BGRABlend, LCLProc;
+uses GraphType, Math, BGRABlend, BGRAUTF8;
 const MaxPixelMetricCount = 100;
 …
   LCLFontDisabledValue: boolean;
   TempBmp: TBitmap;
+  fqFineClearTypeComputed: boolean;
+  fqFineClearTypeValue: TBGRAFontQuality;
   FontHeightSignComputed: boolean;
   FontHeightSignValue: integer;
 …
 end;
 function GetFontPixelMetric(AFont: TFont): TFontPixelMetric;
+function GetLCLFontPixelMetric(AFont: TFont): TFontPixelMetric;
 var i,startPos,endPos: integer;
 begin
 …
 end;
+function GetFineClearTypeAuto: TBGRAFontQuality;
+var
+  lclBmp: TBitmap;
+  bgra: TBGRACustomBitmap;
+  x,y: integer;
+begin
+  if fqFineClearTypeComputed then
+  begin
+    result:= fqFineClearTypeValue;
+    exit;
+  end;
+  result := fqFineAntialiasing;
+  if not LCLFontDisabledValue and not (WidgetSet.LCLPlatform = lpNoGUI) then
+  begin
+    lclBmp := TBitmap.Create;
+    lclBmp.Canvas.FillRect(0,0,lclBmp.Width,lclBmp.Height);
+    lclBmp.Canvas.Font.Height := -50;
+    lclBmp.Canvas.Font.Quality := fqCleartype;
+    with lclBmp.Canvas.TextExtent('/') do
+    begin
+      lclBmp.Width := cx;
+      lclBmp.Height := cy;
+    end;
+    lclBmp.Canvas.TextOut(0,0,'/');
+    bgra:= BGRABitmapFactory.Create(lclBmp);
+    x:= bgra.Width div 2;
+    for y := 0 to bgra.Height-1 do
+      with bgra.GetPixel(x,y) do
+        if (red<>blue) then
+        begin
+          if blue < red then
+            result:= fqFineClearTypeRGB
+          else
+            result:= fqFineClearTypeBGR;
+          break;
+        end else
+        if (green = 0) then break;
+    lclBmp.Free;
+  end;
+  fqFineClearTypeValue := result;
+  fqFineClearTypeComputed:= true;
+end;
 function FontEmHeightSign: integer;
 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;
-  ClearTypePixel: array[0..2] of byte;
-  curThird: integer;
-  procedure OutputPixel; inline;
-  begin
-    if texture <> nil then
-      color := texture.ScanNextPixel;
-    if RGBOrder then
-      ClearTypeDrawPixel(pdest, ClearTypePixel[0],ClearTypePixel[1],ClearTypePixel[2], color)
-    else
-      ClearTypeDrawPixel(pdest, ClearTypePixel[2],ClearTypePixel[1],ClearTypePixel[0], color);
-  end;
-  procedure NextAlpha(alphaValue: byte); inline;
-  begin
-    ClearTypePixel[curThird] := alphaValue;
-    inc(curThird);
-    if curThird = 3 then
-    begin
-      OutputPixel;
-      curThird := 0;
-      Fillchar(ClearTypePixel, sizeof(ClearTypePixel),0);
-      inc(pdest);
-    end;
-  end;
-  procedure EndRow; inline;
-  begin
-    if curThird > 0 then OutputPixel;
-  end;
-var
-  yMask,n: integer;
-  a: byte;
-  pmask: PByte;
-  dx:integer;
-  miny,maxy,minx,minxThird,maxx,alphaMinX,alphaMaxX,alphaLineLen: integer;
-  leftOnSide, rightOnSide: boolean;
-  countBetween: integer;
-  v1,v2,v3: byte;
-  procedure StartRow; inline;
-  begin
-    pdest := dest.Scanline[yMask+y]+minx;
-    if texture <> nil then
-      texture.ScanMoveTo(minx,yMask+y);
-    curThird := minxThird;
-    ClearTypePixel[0] := 0;
-    ClearTypePixel[1] := 0;
-    ClearTypePixel[2] := 0;
-  end;
-begin
-  alphaLineLen := maskWidth+2;
-  xThird -= 1; //for first subpixel
-  if xThird >= 0 then dx := xThird div 3
-   else dx := -((-xThird+2) div 3);
-  x += dx;
-  xThird -= dx*3;
-  if y >= dest.ClipRect.Top then miny := 0
-    else miny := dest.ClipRect.Top-y;
-  if y+maskHeight-1 < dest.ClipRect.Bottom then
-    maxy := maskHeight-1 else
-      maxy := dest.ClipRect.Bottom-1-y;
-  if x >= dest.ClipRect.Left then
-  begin
-    minx := x;
-    minxThird := xThird;
-    alphaMinX := 0;
-    leftOnSide := false;
-  end else
-  begin
-    minx := dest.ClipRect.Left;
-    minxThird := 0;
-    alphaMinX := (dest.ClipRect.Left-x)*3 - xThird;
-    leftOnSide := true;
-  end;
-  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;
-  end else
-  begin
-    maxx := dest.ClipRect.Right-1;
-    alphaMaxX := maxx*3+2 - (x*3+xThird);
-    rightOnSide := true;
-  end;
-  countBetween := alphaMaxX-alphaMinX-1;
-  if (alphaMinX <= alphaMaxX) then
-  begin
-    for yMask := miny to maxy do
-    begin
-      StartRow;
-      if leftOnSide then
-      begin
-        pmask := maskData + (yMask*maskRowSize)+ (alphaMinX-1)*maskPixelSize;
-        a := pmask^ div 3;
-        v1 := a+a;
-        v2 := a;
-        v3 := 0;
-        inc(pmask, maskPixelSize);
-      end else
-      begin
-        pmask := maskData + (yMask*maskRowSize);
-        v1 := 0;
-        v2 := 0;
-        v3 := 0;
-      end;
-      for n := countBetween-1 downto 0 do
-      begin
-        a := pmask^ div 3;
-        v1 += a;
-        v2 += a;
-        v3 += a;
-        inc(pmask, maskPixelSize);
-        NextAlpha(v1);
-        v1 := v2;
-        v2 := v3;
-        v3 := 0;
-      end;
-      if rightOnSide then
-      begin
-        a := pmask^ div 3;
-        v1 += a;
-        v2 += a+a;
-      end;
-      NextAlpha(v1);
-      NextAlpha(v2);
-      EndRow;
-    end;
-  end;
 end;
 …
   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);
+begin
+  BGRAGrayscaleMask.BGRAFillClearTypeGrayscaleMask(dest,x,y,xThird,mask,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);
+begin
+  BGRABlend.BGRAFillClearTypeMask(dest,x,y,xThird,mask,color,texture,RGBOrder);
 end;
 …
   mask: TBGRACustomBitmap; color: TBGRAPixel; texture: IBGRAScanner;
   KeepRGBOrder: boolean);
+var
+  minx,miny,maxx,maxy,countx,n,yb: integer;
+  pdest,psrc: PBGRAPixel;
+begin
+  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
+      maxy := dest.ClipRect.Bottom-1-y;
+  if x >= dest.ClipRect.Left then minx := 0
+    else minx := dest.ClipRect.Left-x;
+  if x+mask.Width-1 < dest.ClipRect.Right then
+    maxx := mask.Width-1 else
+      maxx := dest.ClipRect.Right-1-x;
+  countx := maxx-minx+1;
+  if countx <= 0 then exit;
+  for yb := miny to maxy do
+  begin
+    pdest := dest.ScanLine[y+yb]+(x+minx);
+    psrc := mask.ScanLine[yb]+minx;
+    if texture <> nil then
+      texture.ScanMoveTo(x+minx, y+yb);
+    if KeepRGBOrder then
+    begin
+      for n := countx-1 downto 0 do
+      begin
+        if texture <> nil then color := texture.ScanNextPixel;
+        ClearTypeDrawPixel(pdest, psrc^.red, psrc^.green, psrc^.blue, color);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end else
+    begin
+      for n := countx-1 downto 0 do
+      begin
+        if texture <> nil then color := texture.ScanNextPixel;
+        ClearTypeDrawPixel(pdest, psrc^.blue, psrc^.green, psrc^.red, color);
+        inc(pdest);
+        inc(psrc);
+      end;
+    end;
+  end;
+begin
+  BGRABlend.BGRAFillClearTypeRGBMask(dest,x,y,mask,color,texture,KeepRGBOrder);
 end;
 …
 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
 …
 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);
+begin
+  result := BGRABitmapTypes.CleanTextOutString(s);
 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
+          delete(s,indexByte,1);
+      end
+        else
+          delete(s,indexByte,1);
+    end;
+  end;
+begin
+  result := BGRABitmapTypes.RemoveLineEnding(s, indexByte);
 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);
+begin
+  result := BGRABitmapTypes.RemoveLineEndingUTF8(sUTF8,indexUTF8);
 end;
 …
   size: TSize;
   temp: TBGRACustomBitmap;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL: TBitmap;
+  {$ENDIF}
   xMargin,xThird: integer;
   tempSize: TSize;
 …
   end;
+  {$IFDEF LCL_RENDERER_IS_FINE}
+  if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and
+     (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then
+  begin
+    if Quality = fqFineAntialiasing then Quality := fqSystem;
+    {$IFDEF LCL_CLEARTYPE_RENDERER_IS_FINE}
+    if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType;
+    {$ENDIF}
+  end;
+  {$ENDIF}
   size := BGRAOriginalTextSizeEx(Font,Quality,sUTF8,CustomAntialiasingLevel,sizeFactor);
   if (size.cx = 0) or (size.cy = 0) then
 …
   tempSize.cx += xMargin*2;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL := TBitmap.Create;
+  tempLCL.Width := tempSize.cx;
+  tempLCL.Height := tempSize.cy;
+  tempLCL.Canvas.Brush.Color := clBlack;
+  tempLCL.Canvas.FillRect(0,0,tempLCL.Width,tempLCL.Height);
+  with tempLCL do begin
+  {$ELSE}
   temp := bmp.NewBitmap(tempSize.cx, tempSize.cy, BGRABlack);
+  temp.Canvas.Font := Font;
+  temp.Canvas.Font.Height := Font.Height*sizeFactor;
+  temp.Canvas.Font.Color := clWhite;
+  temp.Canvas.Brush.Style := bsClear;
+  temp.Canvas.TextOut(xMargin+subX, subY, sUTF8);
+  with temp do begin
+  {$ENDIF}
+    Canvas.Font := Font;
+    Canvas.Font.Height := Font.Height*sizeFactor;
+    Canvas.Font.Color := clWhite;
+    Canvas.Brush.Style := bsClear;
+    Canvas.TextOut(xMargin+subX, subY, sUTF8);
+  end;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  temp := BGRABitmapFactory.create(tempLCL,False);
+  tempLCL.Free;
+  {$ENDIF}
   FilterOriginalText(Quality,CustomAntialiasingLevel, temp, grayscale);
 …
   oldOrientation: integer;
   grayscale:TGrayscaleMask;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL: TBitmap;
+  {$ENDIF}
   procedure rotBoundsAdd(pt: TPointF);
 …
   if deltaY <> 0 then rotBounds.Bottom += sizeFactor;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL := TBitmap.Create;
+  tempLCL.Width := rotBounds.Right-rotBounds.Left;
+  tempLCL.Height := rotBounds.Bottom-rotBounds.Top;
+  tempLCL.Canvas.Brush.Color := clBlack;
+  tempLCL.Canvas.FillRect(0,0,tempLCL.Width,tempLCL.Height);
+  with tempLCL do begin
+  {$ELSE}
   temp := bmp.NewBitmap(rotBounds.Right-rotBounds.Left,rotBounds.Bottom-rotBounds.Top, BGRABlack);
+  temp.Canvas.Font := Font;
+  temp.Canvas.Font.Color := clWhite;
+  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, sUTF8);
+  with temp do begin
+  {$ENDIF}
+    Canvas.Font := Font;
+    Canvas.Font.Color := clWhite;
+    Canvas.Font.Orientation := orientationTenthDegCCW;
+    Canvas.Font.Height := round(Font.Height*sizeFactor);
+    Canvas.Brush.Style := bsClear;
+    Canvas.TextOut(-rotBounds.Left+deltaX, -rotBounds.Top+deltaY, sUTF8);
+  end;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  temp := BGRABitmapFactory.create(tempLCL,False);
+  tempLCL.Free;
+  {$ENDIF}
   FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
 …
   cr: TRect;
   grayscale:TGrayscaleMask;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL: TBitmap;
+  {$ENDIF}
 begin
   if not LCLFontAvailable then exit;
 …
     exit;
+  {$IFDEF LCL_RENDERER_IS_FINE}
+  if (Quality in [fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR]) and
+     (BGRATextSize(Font, fqSystem, 'Hg', 1).cy >= 13) then
+  begin
+    if Quality = fqFineAntialiasing then Quality := fqSystem;
+    {$IFDEF LCL_CLEARTYPE_RENDERER_IS_FINE}
+    if Quality = GetFineClearTypeAuto then Quality := fqSystemClearType;
+    {$ENDIF}
+  end;
+  {$ENDIF}
   if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then
     sizeFactor := CustomAntialiasingLevel
 …
     sizeFactor := 1;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  tempLCL := TBitmap.Create;
+  tempLCL.Width := tx*sizeFactor;
+  tempLCL.Height := ty*sizeFactor;
+  tempLCL.Canvas.Brush.Color := clBlack;
+  tempLCL.Canvas.FillRect(0,0,tempLCL.Width,tempLCL.Height);
+  with tempLCL do begin
+  {$ELSE}
   temp := bmp.NewBitmap(tx*sizeFactor, ty*sizeFactor, BGRABlack);
+  temp.Canvas.Font := Font;
+  temp.Canvas.Font.Orientation := 0;
+  if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then temp.Canvas.Font.Height := Font.Height*CustomAntialiasingLevel
+     else temp.Canvas.Font.Height := Font.Height;
+  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, sUTF8, style);
+  with temp do begin
+  {$ENDIF}
+    Canvas.Font := Font;
+    Canvas.Font.Orientation := 0;
+    if Quality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB] then Canvas.Font.Height := Font.Height*CustomAntialiasingLevel
+       else Canvas.Font.Height := Font.Height;
+    Canvas.Font.Color := clWhite;
+    Canvas.Brush.Style := bsClear;
+    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);
+  end;
+  {$IFDEF RENDER_TEXT_ON_TBITMAP}
+  temp := BGRABitmapFactory.create(tempLCL,False);
+  tempLCL.Free;
+  {$ENDIF}
   FilterOriginalText(Quality,CustomAntialiasingLevel,temp,grayscale);
 …
   UpdateFont;
   if FontQuality in[fqSystem,fqSystemClearType] then
     result := BGRAText.GetFontPixelMetric(FFont)
+    result := GetLCLFontPixelMetric(FFont)
   else
   begin
 …
     FxFont.Assign(FFont);
     FxFont.Height := fxFont.Height*FontAntialiasingLevel;
     Result:= BGRAText.GetFontPixelMetric(FxFont);
+    Result:= GetLCLFontPixelMetric(FxFont);
     if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel);
     if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel);
 …
 function TCustomLCLFontRenderer.TextSize(sUTF8: string): TSize;
+begin
+var oldOrientation: integer;
+begin
+  oldOrientation:= FontOrientation;
+  FontOrientation:= 0;
   UpdateFont;
   result := TextSizeNoUpdateFont(sUTF8);
+  FontOrientation:= oldOrientation;
 end;

GraphicTest/Packages/bgrabitmap/bgratextfx.pas

-              r472
+              r494
 uses
+  Classes, SysUtils, Graphics, Types, BGRABitmapTypes, BGRAPhongTypes, BGRAText, BGRAVectorize;
+  Classes, SysUtils, Graphics, Types, BGRABitmapTypes, BGRAPhongTypes, BGRAText,
+  BGRACustomTextFX, BGRAVectorize;
 type
 …
   { TBGRATextEffect }
+  TBGRATextEffect = class
+  private
+    FShadowQuality: TRadialBlurType;
+    function GetBounds: TRect;
+    function GetMaskHeight: integer;
+    class function GetOutlineWidth: integer; static;
+    function GetShadowBounds(ARadius: integer): TRect;
+    function GetMaskWidth: integer;
+    function GetTextHeight: integer;
+    function GetTextWidth: integer;
+    procedure SetShadowQuality(AValue: TRadialBlurType);
+  TBGRATextEffect = class(TBGRACustomTextEffect)
   protected
-    FTextMask: TBGRACustomBitmap;
-    FShadowRadius: integer;
-    FOutlineMask, FShadowMask, FShadingMask : TBGRACustomBitmap;
-    FShadingAltitude: integer;
-    FShadingRounded: boolean;
-    FTextSize: TSize;
-    FOffset: TPoint;
-    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);
 …
     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;
-    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; ARounded: Boolean = true): TRect;
-    function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; AAlign: TAlignment; ARounded: Boolean = true): TRect;
-    function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; AAlign: TAlignment; ARounded: Boolean = true): TRect;
-    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 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;
 …
 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);
 …
   FxFont.Assign(AFont);
   FxFont.Height := fxFont.Height*FontAntialiasingLevel;
   metric := GetFontPixelMetric(FxFont);
+  metric := GetLCLFontPixelMetric(FxFont);
   if not metric.Defined or (metric.Lineheight < 8*FontAntialiasingLevel) or (metric.Lineheight >= 24*FontAntialiasingLevel) then
   begin
 …
 { TBGRATextEffect }
-function TBGRATextEffect.GetBounds: TRect;
-begin
-  if TextMask = nil then
-    result := EmptyRect else
-  with TextMaskOffset do
-    result := rect(X,Y,X+TextMask.Width,Y+TextMask.Height);
-end;
-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;
-function TBGRATextEffect.GetShadowBounds(ARadius: integer): TRect;
-begin
-  result := Bounds;
-  if (ARadius > 0) and not IsRectEmpty(result) then
-  begin
-    result.left -= ARadius;
-    result.top -= ARadius;
-    result.right += ARadius;
-    result.bottom += ARadius;
-  end;
-end;
-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;
-  xb,yb,startX,numColor: integer;
-  p0,p: PBGRAPixel;
-  emptyCol, nextCol: boolean;
-begin
-  if (AMask = nil) or (length(AColors)=0) then
-  begin
-    result := EmptyRect;
-    exit;
-  end;
-  if (length(AColors)=0) then
-  begin
-    result := DrawMask(ADest,AMask,X,Y,AColors[0]);
-    exit;
-  end;
-  scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColors[0]);
-  numColor := 0;
-  startX := -1;
-  p0 := AMask.data;
-  for xb := 0 to AMask.Width-1 do
-  begin
-    p := p0;
-    if startX=-1 then
-    begin
-      emptyCol := true;
-      for yb := AMask.Height-1 downto 0 do
-      begin
-        if (p^<>BGRABlack) then
-        begin
-          emptyCol := false;
-          break;
-        end;
-        inc(p, AMask.Width);
-      end;
-      if not emptyCol then
-      begin
-        if startX=-1 then
-          startX := xb;
-      end else
-      begin
-        if startX<>-1 then
-        begin
-          ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency);
-          inc(numColor);
-          if numColor = length(AColors) then
-            numColor := 0;
-          scan.Color := AColors[numColor];
-          startX := -1;
-        end;
-      end;
-    end else
-    begin
-      emptyCol := true;
-      nextCol := true;
-      for yb := AMask.Height-1 downto 0 do
-      begin
-        if (p^<>BGRABlack) then
-        begin
-          emptyCol := false;
-          if ((p-1)^<>BGRABlack) then
-          begin
-            nextCol := false;
-            break;
-          end;
-        end;
-        inc(p, AMask.Width);
-      end;
-      if nextCol or emptyCol then
-      begin
-        ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency);
-        inc(numColor);
-        if numColor = length(AColors) then
-          numColor := 0;
-        scan.Color := AColors[numColor];
-        if emptyCol then startX := -1
-         else startX := xb;
-      end;
-    end;
-    inc(p0);
-  end;
-  if startX<>-1 then
-    ADest.FillRect(X+startX,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
-  scan.Free;
-  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
-  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;
-  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
-  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;
-function TBGRATextEffect.InternalDrawShaded(ADest: TBGRACustomBitmap; X,
-  Y: integer; Shader: TCustomPhongShading; Altitude: integer;
-  AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect;
-var
-  WithMargin,Map: TBGRACustomBitmap;
-  p: PBGRAPixel;
-  n,maxv: integer;
-  v,blurRadius: single;
-  iBlurRadius: integer;
-begin
-  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
-  begin
-    result := EmptyRect;
-    exit;
-  end;
-  if (FShadingMask <> nil) and ((FShadingAltitude <> Altitude) or (FShadingRounded <> ARounded)) then
-    FreeAndNil(FShadingMask);
-  if FShadingMask = nil then
-  begin
-    FShadingRounded := ARounded;
-    FShadingAltitude := Altitude;
-    if ARounded then blurRadius := Altitude
-      else blurRadius := Altitude*0.5;
-    iBlurRadius := ceil(blurRadius);
-    WithMargin := BGRABitmapFactory.Create(FTextMask.Width+iBlurRadius*2, FTextMask.Height+iBlurRadius*2,BGRABlack);
-    WithMargin.PutImage(iBlurRadius,iBlurRadius,FTextMask,dmSet);
-    if (iBlurRadius <> blurRadius) and (blurRadius < 3) then
-      Map := WithMargin.FilterBlurRadial(round(blurRadius*10),rbPrecise)
-    else
-      Map := WithMargin.FilterBlurRadial(iBlurRadius,rbFast);
-    p := Map.Data;
-    maxv := 0;
-    for n := Map.NbPixels-1 downto 0 do
-    begin
-      if p^.green > maxv then
-        maxv := p^.green;
-      inc(p);
-    end;
-    if maxv > 0 then
-    begin
-      p := Map.Data;
-      for n := Map.NbPixels-1 downto 0 do
-      begin
-        v := p^.green/maxv;
-        if ARounded then
-        begin
-          if v <= 0.5 then
-            v := v*v*2 else
-            v := 1-(1-v)*(1-v)*2;
-        end;
-        p^ := MapHeightToBGRA( v, p^.alpha);
-        inc(p);
-      end;
-    end;
-    Map.ApplyMask(WithMargin);
-    WithMargin.Free;
-    BGRAReplace(Map, Map.GetPart(rect(iBlurRadius,iBlurRadius,Map.Width-iBlurRadius,Map.Height-iBlurRadius)));
-    FShadingMask := Map;
-  end;
-  inc(X, FOffset.X);
-  Inc(Y, FOffset.Y);
-  if ATexture <> nil then
-    Shader.DrawScan(ADest,FShadingMask,Altitude,X,Y, ATexture)
-  else
-    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);
 …
 end;
-function TBGRATextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
-  AColor: TBGRAPixel; AAlign: TAlignment): TRect;
-begin
-  Case AAlign of
-  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
-  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;
-function TBGRATextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
-  Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel;
-  ARounded: Boolean): TRect;
-begin
-  result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,AColor,nil,ARounded);
-end;
-function TBGRATextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
-  Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner;
-  ARounded: Boolean): TRect;
-begin
-  result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,BGRAPixelTransparent,ATexture,ARounded);
-end;
-function TBGRATextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
-  Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel;
-  AAlign: TAlignment; ARounded: Boolean): TRect;
-begin
-  Case AAlign of
-  taLeftJustify: result := DrawShaded(ADest,X,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;
-  end;
-end;
-function TBGRATextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
-  Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner;
-  AAlign: TAlignment; ARounded: Boolean): TRect;
-begin
-  Case AAlign of
-  taLeftJustify: result := DrawShaded(ADest,X,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;
-end;
 constructor TBGRATextEffect.Create(AText: string; Font: TFont;
   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;
 …
 end;
-procedure TBGRATextEffect.ApplySphere;
-var sphere: TBGRACustomBitmap;
-begin
-  if FTextMask = nil then exit;
-  FreeAndNil(FOutlineMask);
-  FreeAndNil(FShadowMask);
-  FShadowRadius := 0;
-  sphere := FTextMask.FilterSphere;
-  FTextMask.Fill(BGRABlack);
-  FTextMask.PutImage(0,0,sphere,dmDrawWithTransparency);
-  sphere.Free;
-end;
-procedure TBGRATextEffect.ApplyVerticalCylinder;
-begin
-  if FTextMask = nil then exit;
-  FreeAndNil(FOutlineMask);
-  FreeAndNil(FShadowMask);
-  FShadowRadius := 0;
-  BGRAReplace(FTextMask,FTextMask.FilterCylinder);
-end;
-procedure TBGRATextEffect.ApplyHorizontalCylinder;
-begin
-  if FTextMask = nil then exit;
-  FreeAndNil(FOutlineMask);
-  FreeAndNil(FShadowMask);
-  FShadowRadius := 0;
-  BGRAReplace(FTextMask,FTextMask.RotateCW);
-  BGRAReplace(FTextMask,FTextMask.FilterCylinder);
-  BGRAReplace(FTextMask,FTextMask.RotateCCW);
-end;
-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
-  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 := FTextMask.FilterContour;
-    FOutlineMask.LinearNegative;
-  end;
-  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 := FTextMask.FilterContour;
-    FOutlineMask.LinearNegative;
-  end;
-  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
-  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
-  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 (FShadowRadius <> Radius) or (FShadowMask = nil) then
-  begin
-    FShadowRadius := Radius;
-    FreeAndNil(FShadowMask);
-    FShadowMask := BGRABitmapFactory.Create(FTextMask.Width+Radius*2,FTextMask.Height+Radius*2,BGRABlack);
-    FShadowMask.PutImage(Radius,Radius,FTextMask,dmSet);
-    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
-  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;
-destructor TBGRATextEffect.Destroy;
-begin
-  FShadowMask.free;
-  textMask.Free;
-  FOutlineMask.Free;
-  FShadingMask.Free;
-  inherited Destroy;
-end;
 initialization

GraphicTest/Packages/bgrabitmap/bgrathumbnail.pas

-              r472
+              r494
 {$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
 interface
 …
 function GetOpenRasterThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 function GetLazPaintThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
+function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 function GetJpegThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 function GetPsdThumbnail(AStream: TStream; AWidth,AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 …
 function GetPaintDotNetThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 function GetBmpThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
+{$IFDEF BGRABITMAP_USE_LCL}
 function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
+{$ENDIF}
 function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
 …
 implementation
 uses Types, GraphType, Graphics, base64, lazutf8classes, LCLProc,
      DOM, XMLRead, FPReadJPEG, BGRAReadPng, BGRAReadGif, BGRAReadBMP,
+uses Types, base64, BGRAUTF8, {$IFDEF BGRABITMAP_USE_LCL}Graphics, GraphType,{$ENDIF}
+     DOM, XMLRead, BGRAReadJPEG, BGRAReadPng, BGRAReadGif, BGRAReadBMP,
      BGRAReadPSD, BGRAReadIco, UnzipperExt, BGRAReadLzp;
 …
     ifGif: result := GetGifThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifBmp: result := GetBmpThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
+    {$IFDEF BGRABITMAP_USE_LCL}
     ifIco: result := GetIcoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
+    {$ENDIF}
     ifPcx: result := GetPcxThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifPaintDotNet: result := GetPaintDotNetThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifLazPaint: result := GetLazPaintThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifOpenRaster: result := GetOpenRasterThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
+    ifPhoxo: result := GetPhoxoThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifPsd: result := GetPsdThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
     ifTarga: result := GetTargaThumbnail(AStream, AWidth,AHeight, ABackColor, ACheckers, ADest);
 …
 end;
+function GetPhoxoThumbnail(AStream: TStream; AWidth, AHeight: integer;
+  ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
+var
+  reader: TFPCustomImageReader;
+begin
+  if DefaultBGRAImageReader[ifPhoxo] = nil then
+    result := nil
+  else
+  begin
+    reader := CreateBGRAImageReader(ifPhoxo);
+    result := GetStreamThumbnail(AStream, reader, AWidth,AHeight,ABackColor,ACheckers,ADest);
+    reader.Free;
+  end;
+end;
 function GetJpegThumbnail(AStream: TStream; AWidth, AHeight: integer
   ; ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
 var
   jpeg: TFPReaderJPEG;
 begin
   jpeg := TFPReaderJPEG.Create;
+  jpeg: TBGRAReaderJpeg;
+begin
+  jpeg := TBGRAReaderJpeg.Create;
   jpeg.Performance := jpBestSpeed;
   jpeg.MinWidth := AWidth;
 …
 end;
+{$IFDEF BGRABITMAP_USE_LCL}
 function GetIcoThumbnail(AStream: TStream; AWidth, AHeight: integer;
   ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
 …
   ico.Free;
 end;
+{$ENDIF}
 function GetPcxThumbnail(AStream: TStream; AWidth, AHeight: integer;

GraphicTest/Packages/bgrabitmap/bgratransform.pas

-              r472
+              r494
 type
   { Contains an affine matrix, i.e. a matrix to transform linearly and translate TPointF coordinates }
   TAffineMatrix = array[1..2,1..3] of single;
+  TAffineMatrix = BGRABitmapTypes.TAffineMatrix;
   { TAffineBox }
 …
     procedure SetMatrix(AMatrix: TAffineMatrix);
     function InternalScanCurrentPixel: TBGRAPixel; virtual;
+    function GetViewMatrix: TAffineMatrix;
+    procedure SetViewMatrix(AValue: TAffineMatrix);
   public
     GlobalOpacity: Byte;
 …
     function ScanAt(X, Y: Single): TBGRAPixel; override;
     property Matrix: TAffineMatrix read FMatrix write SetMatrix;
+    property ViewMatrix: TAffineMatrix read GetViewMatrix write SetViewMatrix;
   end;
 …
     FBuffer: PBGRAPixel;
     FBufferSize: Int32or64;
+    procedure Init(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean= false; ARepeatImageY: Boolean= false; AResampleFilter: TResampleFilter = rfLinear);
+    FIncludeEdges: boolean;
+    procedure Init(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean= false; ARepeatImageY: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false);
   public
     constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImage: Boolean= false; AResampleFilter: TResampleFilter = rfLinear);
     constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean; ARepeatImageY: Boolean; AResampleFilter: TResampleFilter = rfLinear);
+    constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImage: Boolean= false; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false);
+    constructor Create(ABitmap: TBGRACustomBitmap; ARepeatImageX: Boolean; ARepeatImageY: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false);
     destructor Destroy; override;
     function InternalScanCurrentPixel: TBGRAPixel; override;
 …
     function IsScanPutPixelsDefined: boolean; override;
     procedure Fit(Origin, HAxis, VAxis: TPointF); override;
+  end;
+  { TBGRAQuadLinearScanner }
+  TBGRAQuadLinearScanner = class(TBGRACustomScanner)
+  private
+    FPoints,FVectors: array[0..3] of TPointF;
+    FInvLengths,FDets: array[0..3] of single;
+    FCoeffs: array[0..3] of TPointF;
+    aa,bb0,cc0,inv2aa: double;
+    FSource: IBGRAScanner;
+    FSourceMatrix: TAffineMatrix;
+    FUVVector: TPointF;
+    ScanParaBB, ScanParaCC, ScanParaBBInv: double;
+    ScanVertV0,ScanVertVStep0,ScanVertDenom0,ScanVertDenomStep0: double;
+    FShowC1, FShowC2: boolean;
+    FScanFunc: TScanNextPixelFunction;
+    FCurXF,FCurYF: single;
+    FBuffer: PBGRAPixel;
+    FBufferSize: Int32or64;
+    FTextureInterpolation: Boolean;
+    function GetCulling: TFaceCulling;
+    function ScanGeneral: TBGRAPixel;
+    procedure PrepareScanVert0;
+    function ScanVert0: TBGRAPixel;
+    procedure PrepareScanPara;
+    function ScanPara: TBGRAPixel;
+    function GetTexColorAt(u,v: Single; detNeg: boolean): TBGRAPixel; inline;
+    procedure ScanMoveToF(X,Y: single); inline;
+    procedure SetCulling(AValue: TFaceCulling);
+    procedure Init(ASource: IBGRAScanner; const APoints: array of TPointF;
+         ATextureInterpolation: boolean);
+  public
+    function ScanAt(X, Y: Single): TBGRAPixel; override;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
+    function IsScanPutPixelsDefined: boolean; override;
+    procedure ScanMoveTo(X, Y: Integer); override;
+    function ScanNextPixel: TBGRAPixel; override;
+    constructor Create(ASource: IBGRAScanner;
+      ASourceMatrix: TAffineMatrix; const APoints: array of TPointF;
+      ATextureInterpolation: boolean = true);
+    constructor Create(ASource: IBGRAScanner;
+      const ATexCoords: array of TPointF; const APoints: array of TPointF;
+      ATextureInterpolation: boolean = true);
+    destructor Destroy; override;
+    property Culling: TFaceCulling read GetCulling write SetCulling;
   end;
 …
 //matrix multiplication
 operator *(M,N: TAffineMatrix): TAffineMatrix;
+operator =(M,N: TAffineMatrix): boolean;
 //matrix multiplication by a vector (apply transformation to that vector)
 operator *(M: TAffineMatrix; V: TPointF): TPointF;
+operator *(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF;
 //check if matrix is inversible
 …
 //define a scaling matrix
 function AffineMatrixScale(sx,sy: single): TAffineMatrix;
+function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix;
+function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix;
+function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix;
+function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix;
 //define a linear matrix
 …
   end;
+  { TBGRASphereDeformationScanner }
+  TBGRASphereDeformationScanner = Class(TBGRACustomScanner)
+  protected
+    FScanner: IBGRAScanner;
+    FScanAtFunc: TScanAtFunction;
+    FCenter: TPointF;
+    FRadiusX, FRadiusY: Single;
+  public
+    constructor Create(AScanner: IBGRAScanner; ACenter: TPointF; ARadiusX,ARadiusY: single);
+    function ScanAt(X, Y: Single): TBGRAPixel; override;
+    property RadiusX: Single read FRadiusX;
+    property RadiusY: Single read FRadiusY;
+  end;
+  { TBGRAVerticalCylinderDeformationScanner }
+  TBGRAVerticalCylinderDeformationScanner = Class(TBGRACustomScanner)
+  protected
+    FScanner: IBGRAScanner;
+    FScanAtFunc: TScanAtFunction;
+    FCenterX: single;
+    FRadiusX: Single;
+  public
+    constructor Create(AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single);
+    function ScanAt(X, Y: Single): TBGRAPixel; override;
+    property RadiusX: Single read FRadiusX;
+  end;
 implementation
 uses BGRABlend, GraphType;
+uses BGRABlend, Math;
 function AffineMatrix(m11, m12, m13, m21, m22, m23: single): TAffineMatrix;
 …
 end;
+operator=(M, N: TAffineMatrix): boolean;
+begin
+  result := CompareMem(@M,@N,SizeOf(TAffineMatrix));
+end;
 operator*(M: TAffineMatrix; V: TPointF): TPointF;
 begin
+  result.X := V.X*M[1,1]+V.Y*M[1,2]+M[1,3];
+  result.Y := V.X*M[2,1]+V.Y*M[2,2]+M[2,3];
+  if isEmptyPointF(V) then
+    result := EmptyPointF
+  else
+  begin
+    result.X := V.X*M[1,1]+V.Y*M[1,2]+M[1,3];
+    result.Y := V.X*M[2,1]+V.Y*M[2,2]+M[2,3];
+  end;
+end;
+operator*(M: TAffineMatrix; A: array of TPointF): ArrayOfTPointF;
+var
+  i: NativeInt;
+  ofs: TPointF;
+begin
+  setlength(result, length(A));
+  if IsAffineMatrixTranslation(M) then
+  begin
+    ofs := PointF(M[1,3],M[2,3]);
+    for i := 0 to high(A) do
+      result[i] := A[i]+ofs;
+  end else
+    for i := 0 to high(A) do
+      result[i] := M*A[i];
 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);
+  result := (m[1,1]=1) and (m[1,2]=0) and (m[2,1] = 0) and (m[2,2]=1);
 end;
 …
 function AffineMatrixScale(sx, sy: single): TAffineMatrix;
 begin
+  result := AffineMatrix(sx, 0,    0,
+,  sy, 0);
+  result := AffineMatrix(sx, 0,   0,
+,  sy,  0);
+end;
+function AffineMatrixSkewXDeg(AngleCW: single): TAffineMatrix;
+begin
+  result := AffineMatrix(1,tan(AngleCW*Pi/180),0,
+,        1,          0);
+end;
+function AffineMatrixSkewYDeg(AngleCW: single): TAffineMatrix;
+begin
+  result := AffineMatrix(1,           0, 0,
+                 tan(AngleCW*Pi/180), 1, 0)
+end;
+function AffineMatrixSkewXRad(AngleCCW: single): TAffineMatrix;
+begin
+  result := AffineMatrix(1,tan(-AngleCCW),0,
+,      1,       0);
+end;
+function AffineMatrixSkewYRad(AngleCCW: single): TAffineMatrix;
+begin
+  result := AffineMatrix(1,          0, 0,
+                    tan(-angleCCW),  1, 0)
 end;
 …
 begin
   result := PointF(M[1,1],M[2,1])*PointF(M[1,2],M[2,2]) = 0;
+end;
+{ TBGRAVerticalCylinderDeformationScanner }
+constructor TBGRAVerticalCylinderDeformationScanner.Create(
+  AScanner: IBGRAScanner; ACenterX: single; ARadiusX: single);
+begin
+  FScanner := AScanner;
+  FScanAtFunc := @FScanner.ScanAt;
+  FCenterX := ACenterX;
+  FRadiusX := ARadiusX;
+end;
+function TBGRAVerticalCylinderDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel;
+var
+  xn,len,fact: Single;
+begin
+  xn   := (x - FCenterX) / FRadiusX;
+  len := abs(xn);
+  if (len <= 1) then
+  begin
+    if (len > 0) then
+    begin
+      fact := 1 / len * arcsin(len) / (Pi / 2);
+      xn    *= fact;
+    end;
+    result := FScanAtFunc(xn * FRadiusX + FCenterX, y);
+  end
+  else
+    result := BGRAPixelTransparent;
+end;
+{ TBGRASphereDeformationScanner }
+constructor TBGRASphereDeformationScanner.Create(AScanner: IBGRAScanner;
+  ACenter: TPointF; ARadiusX, ARadiusY: single);
+begin
+  FScanner := AScanner;
+  FScanAtFunc := @FScanner.ScanAt;
+  FCenter := ACenter;
+  FRadiusX := ARadiusX;
+  FRadiusY := ARadiusY;
+end;
+function TBGRASphereDeformationScanner.ScanAt(X, Y: Single): TBGRAPixel;
+var
+  xn, yn, len,fact: Single;
+begin
+  xn   := (x - FCenter.X) / FRadiusX;
+  yn   := (y - FCenter.Y) / FRadiusY;
+  len := sqrt(sqr(xn) + sqr(yn));
+  if (len <= 1) then
+  begin
+    if (len > 0) then
+    begin
+      fact := 1 / len * arcsin(len) / (Pi / 2);
+      xn    *= fact;
+      yn    *= fact;
+    end;
+    result := FScanAtFunc(xn * FRadiusX + FCenter.X, yn * FRadiusY + FCenter.Y);
+  end
+  else
+    result := BGRAPixelTransparent;
 end;
 …
 function TBGRAScannerOffset.ScanAt(X, Y: Single): TBGRAPixel;
 begin
   Result:=FSource.ScanAt(X, Y);
+  Result:=FSource.ScanAt(X - FOffset.X, Y - FOffset.Y);
 end;
 …
 end;
+function TBGRAAffineScannerTransform.GetViewMatrix: TAffineMatrix;
+begin
+  if FEmptyMatrix then
+    result := AffineMatrixIdentity
+  else
+    result := AffineMatrixInverse(FMatrix);
+end;
+procedure TBGRAAffineScannerTransform.SetViewMatrix(AValue: TAffineMatrix);
+begin
+  Matrix := AValue;
+  Invert;
+end;
 procedure TBGRAAffineScannerTransform.SetMatrix(AMatrix: TAffineMatrix);
 begin
 …
 end;
+{ TBGRAQuadLinearScanner }
+function TBGRAQuadLinearScanner.GetTexColorAt(u, v: Single; detNeg: boolean
+  ): TBGRAPixel;
+begin
+  if detNeg then
+  begin
+    if not FShowC2 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+  end else
+    if not FShowC1 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+  with (FSourceMatrix * PointF(u,v) + FUVVector*(u*v)) do
+    if FTextureInterpolation then
+      result := FSource.ScanAt(x,y)
+    else
+      result := FSource.ScanAtInteger(System.round(x),System.round(y));
+end;
+procedure TBGRAQuadLinearScanner.ScanMoveToF(X, Y: single);
+begin
+  FCurXF := X;
+  FCurYF := Y;
+  if (FVectors[0].x = 0) and (FVectors[2].x = 0) then
+  begin
+    PrepareScanVert0;
+    FScanFunc := @ScanVert0;
+  end else
+  if aa = 0 then
+  begin
+    PrepareScanPara;
+    FScanFunc := @ScanPara
+  end
+  else
+    FScanFunc := @ScanGeneral;
+end;
+procedure TBGRAQuadLinearScanner.SetCulling(AValue: TFaceCulling);
+begin
+  FShowC1 := AValue in [fcKeepCW,fcNone];
+  FShowC2 := AValue in [fcKeepCCW,fcNone];
+end;
+procedure TBGRAQuadLinearScanner.Init(ASource: IBGRAScanner;
+  const APoints: array of TPointF; ATextureInterpolation: boolean);
+var
+  i: NativeInt;
+  v: TPointF;
+  len: single;
+begin
+  if length(APoints)<>4 then
+    raise exception.Create('Expecting 4 points');
+  FTextureInterpolation:= ATextureInterpolation;
+  FSource := ASource;
+  FSourceMatrix := AffineMatrixIdentity;
+  FUVVector := PointF(0,0);
+  for i := 0 to 3 do
+  begin
+    FPoints[i] := APoints[i];
+    v := APoints[(i+1) mod 4] - APoints[i];
+    len := sqrt(v*v);
+    if len > 0 then FInvLengths[i] := 1/len
+      else FInvLengths[i] := 0;
+    FVectors[i] := v*FInvLengths[i];
+  end;
+  FCoeffs[0] := FPoints[0];
+  FCoeffs[1] := FPoints[1]-FPoints[0];
+  FCoeffs[2] := FPoints[3]-FPoints[0];
+  FCoeffs[3] := FPoints[0]+FPoints[2]-FPoints[1]-FPoints[3];
+  aa := VectDet(FCoeffs[3],FCoeffs[2]);
+  bb0 := VectDet(FCoeffs[3],FCoeffs[0]) + VectDet(FCoeffs[1],FCoeffs[2]);
+  cc0 := VectDet(FCoeffs[1],FCoeffs[0]);
+  for i := 0 to 3 do
+    FDets[i] := VectDet(FVectors[i],FVectors[(i+1) mod 4]);
+  if aa <> 0 then inv2aa := 1/(2*aa) else inv2aa := 1;
+  FShowC1 := true;
+  FShowC2 := true;
+  FBuffer := nil;
+  FBufferSize := 0;
+  ScanMoveToF(0,0);
+end;
+function TBGRAQuadLinearScanner.ScanAt(X, Y: Single): TBGRAPixel;
+begin
+  ScanMoveToF(X,Y);
+  Result:= FScanFunc();
+end;
+procedure TBGRAQuadLinearScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+var
+  n: NativeInt;
+  p: PBGRAPixel;
+begin
+  if mode = dmSet then
+    p := pdest
+  else
+  begin
+    if count > FBufferSize then
+    begin
+      FBufferSize := count;
+      ReAllocMem(FBuffer, FBufferSize*sizeof(TBGRAPixel));
+    end;
+    p := FBuffer;
+  end;
+  for n := count-1 downto 0 do
+  begin
+    p^ := FScanFunc();
+    inc(p);
+  end;
+  if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255);
+end;
+function TBGRAQuadLinearScanner.IsScanPutPixelsDefined: boolean;
+begin
+  result := true;
+end;
+procedure TBGRAQuadLinearScanner.ScanMoveTo(X, Y: Integer);
+begin
+  ScanMoveToF(X,Y);
+end;
+function TBGRAQuadLinearScanner.ScanNextPixel: TBGRAPixel;
+begin
+  Result:= FScanFunc();
+end;
+function TBGRAQuadLinearScanner.ScanGeneral: TBGRAPixel;
+var u1,u2,v1,v2,x,y: double;
+  bb,cc,det,delta,denom: double;
+  procedure ReturnC1C2; inline;
+  var c1,c2: TBGRAPixel;
+  begin
+    with (FSourceMatrix * PointF(u1,v1) + FUVVector*(u1*v1)) do
+      if FTextureInterpolation then
+        c1 := FSource.ScanAt(x,y)
+      else
+        c1 := FSource.ScanAtInteger(System.round(x),System.round(y));
+    with (FSourceMatrix * PointF(u2,v2) + FUVVector*(u2*v2)) do
+      if FTextureInterpolation then
+        c2 := FSource.ScanAt(x,y)
+      else
+        c2 := FSource.ScanAtInteger(System.round(x),System.round(y));
+    result := MergeBGRA(c1,c2);
+  end;
+begin
+  x := FCurXF;
+  y := FCurYF;
+  FCurXF += 1;
+  if (Y = FPoints[0].y) and (FVectors[0].y = 0) then
+  begin
+    if FVectors[0].x = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    u1 := (X - FPoints[0].x)/(FPoints[1].x-FPoints[0].x);
+    if (u1 >= 0) and (u1 <= 1) then
+    begin
+      result := GetTexColorAt(u1,0,FDets[0]<0);
+      exit;
+    end;
+  end;
+  if (X = FPoints[1].x) and (FVectors[1].x = 0) then
+  begin
+    if FVectors[1].y = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    v1 := (Y - FPoints[1].y)/(FPoints[2].y-FPoints[1].y);
+    if (v1 >= 0) and (v1 <= 1) then
+    begin
+      result := GetTexColorAt(0,v1,FDets[1]<0);
+      exit;
+    end;
+  end;
+  if (Y = FPoints[2].y) and (FVectors[2].y = 0) then
+  begin
+    if FVectors[2].x = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    u1 := (X - FPoints[3].x)/(FPoints[2].x-FPoints[3].x);
+    if (u1 >= 0) and (u1 <= 1) then
+    begin
+      result := GetTexColorAt(u1,1,FDets[2]<0);
+      exit;
+    end;
+  end;
+  if (X = FPoints[3].x) and (FVectors[3].x = 0) then
+  begin
+    if FVectors[3].y = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    v1 := (Y - FPoints[0].y)/(FPoints[3].y-FPoints[0].y);
+    if (v1 >= 0) and (v1 <= 1) then
+    begin
+      result := GetTexColorAt(0,v1,FDets[3]<0);
+      exit;
+    end;
+  end;
+  bb := bb0 + x*FCoeffs[3].y - y*FCoeffs[3].x;
+  cc := cc0 + x*FCoeffs[1].y - y*FCoeffs[1].x;
+  if cc = 0 then
+  begin
+    v1 := -bb*2*inv2aa;
+    denom := FCoeffs[1].x+FCoeffs[3].x*v1;
+    if denom = 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end
+    else
+      u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom;
+    if (u1>=0) and (u1<=1) and (v1 >= 0) and (v1 <= 1) then
+      result := GetTexColorAt(u1,v1,bb<0)
+    else
+      result := BGRAPixelTransparent;
+  end else
+  begin
+    delta := bb*bb - 4*aa*cc;
+    if delta < 0 then
+    begin
+      result := BGRAPixelTransparent;
+      exit;
+    end;
+    det := sqrt(delta);
+    v1 := (-bb+det)*inv2aa;
+    if v1 = 0 then
+      u1 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0])
+    else if v1 = 1 then
+      u1 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2])
+    else
+    begin
+      denom := FCoeffs[1].x+FCoeffs[3].x*v1;
+      if abs(denom)<1e-6 then
+      begin
+        u1 := (bb+det)*inv2aa;
+        denom := FCoeffs[1].y+FCoeffs[3].y*u1;
+        if denom = 0 then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end
+        else v1 := (y-FCoeffs[0].y-FCoeffs[2].y*u1)/denom;
+      end
+      else u1 := (x-FCoeffs[0].x-FCoeffs[2].x*v1)/denom;
+    end;
+    v2 := (-bb-det)*inv2aa;
+    if v2 = 0 then
+      u2 := (FVectors[0]*FInvLengths[0])*(PointF(x,y)-FPoints[0])
+    else if v2 = 1 then
+      u2 := 1 - (FVectors[2]*FInvLengths[2])*(PointF(x,y)-FPoints[2])
+    else
+    begin
+      denom := FCoeffs[1].x+FCoeffs[3].x*v2;
+      if abs(denom)<1e-6 then
+      begin
+        u2 := (bb-det)*inv2aa;
+        denom := FCoeffs[1].y+FCoeffs[3].y*u2;
+        if denom = 0 then
+        begin
+          result := BGRAPixelTransparent;
+          exit;
+        end
+        else v2 := (y-FCoeffs[0].y-FCoeffs[2].y*u2)/denom;
+      end
+      else u2 := (x-FCoeffs[0].x-FCoeffs[2].x*v2)/denom;
+    end;
+    if (u1 >= 0) and (u1 <= 1) and (v1 >= 0) and (v1 <= 1) and FShowC1 then
+    begin
+      if (u2 >= 0) and (u2 <= 1) and (v2 >= 0) and (v2 <= 1) and FShowC2 then
+        ReturnC1C2
+      else
+        with (FSourceMatrix * PointF(u1,v1) + FUVVector*(u1*v1)) do
+          if FTextureInterpolation then
+            result := FSource.ScanAt(x,y)
+          else
+            result := FSource.ScanAtInteger(System.round(x),System.round(y));
+    end
+    else
+    if (u2 >= 0) and (u2 <= 1) and (v2 >= 0) and (v2 <= 1) and FShowC2 then
+    begin
+      with (FSourceMatrix * PointF(u2,v2) + FUVVector*(u2*v2)) do
+        if FTextureInterpolation then
+          result := FSource.ScanAt(x,y)
+        else
+          result := FSource.ScanAtInteger(System.round(x),System.round(y));
+    end
+    else
+      result := BGRAPixelTransparent;
+  end;
+end;
+function TBGRAQuadLinearScanner.GetCulling: TFaceCulling;
+begin
+  if FShowC1 and FShowC2 then
+    result := fcNone
+  else if FShowC1 then
+    result := fcKeepCW
+  else
+    result := fcKeepCCW;
+end;
+procedure TBGRAQuadLinearScanner.PrepareScanVert0;
+begin
+  if (FVectors[1].x <> 0) then
+  begin
+    ScanVertVStep0 := 1/(FPoints[2].x-FPoints[1].x);
+    ScanVertV0 := (FCurXF-FPoints[1].x)*ScanVertVStep0;
+    ScanVertDenom0 := (FPoints[1].y-FPoints[0].y)*(1-ScanVertV0) + (FPoints[2].y-FPoints[3].y)*ScanVertV0;
+    ScanVertDenomStep0 := (FPoints[2].y-FPoints[3].y-FPoints[1].y+FPoints[0].y)*ScanVertVStep0;
+  end
+  else
+  begin
+    ScanVertV0 := 0;
+    ScanVertVStep0 := EmptySingle;
+  end;
+end;
+function TBGRAQuadLinearScanner.ScanVert0: TBGRAPixel;
+var u: single;
+begin
+  FCurXF += 1;
+  if ScanVertVStep0 = EmptySingle then
+  begin
+    result := BGRAPixelTransparent;
+    exit;
+  end;
+  if (ScanVertV0 >= 0) and (ScanVertV0 <= 1) then
+  begin
+    if ScanVertDenom0 = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      u := (FCurYF-(FPoints[0].y*(1-ScanVertV0) + FPoints[3].y*ScanVertV0))/ScanVertDenom0;
+      if (u >= 0) and (u <= 1) then
+        result := GetTexColorAt(u,ScanVertV0,FDets[0]<0)
+      else
+        result := BGRAPixelTransparent;
+    end;
+  end else
+    result := BGRAPixelTransparent;
+  ScanVertV0 += ScanVertVStep0;
+  ScanVertDenom0 += ScanVertDenomStep0;
+end;
+procedure TBGRAQuadLinearScanner.PrepareScanPara;
+begin
+  ScanParaBB := bb0 + FCurXF*FCoeffs[3].y - FCurYF*FCoeffs[3].x;
+  ScanParaCC := cc0 + FCurXF*FCoeffs[1].y - FCurYF*FCoeffs[1].x;
+  if ScanParaBB <> 0 then
+    ScanParaBBInv := 1/ScanParaBB
+  else
+    ScanParaBBInv := 1;
+end;
+function TBGRAQuadLinearScanner.ScanPara: TBGRAPixel;
+var
+  u,v,denom: Single;
+begin
+  FCurXF += 1;
+  if ScanParaBB = 0 then
+    result := BGRAPixelTransparent
+  else
+  begin
+    v := -ScanParaCC*ScanParaBBInv;
+    denom := FCoeffs[1].x+FCoeffs[3].x*v;
+    if denom = 0 then
+      result := BGRAPixelTransparent
+    else
+    begin
+      u := (FCurXF-1-FCoeffs[0].x-FCoeffs[2].x*v)/denom;
+      if (u>=0) and (u<=1) and (v >= 0) and (v <= 1) then
+        result := GetTexColorAt(u,v,FDets[0]<0)
+      else
+        result := BGRAPixelTransparent;
+    end;
+  end;
+  if FCoeffs[3].y <> 0 then
+  begin
+    ScanParaBB += FCoeffs[3].y;
+    if ScanParaBB <> 0 then
+      ScanParaBBInv := 1/ScanParaBB
+    else
+      ScanParaBBInv := 1;
+  end;
+  ScanParaCC += FCoeffs[1].y;
+end;
+constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner;
+  ASourceMatrix: TAffineMatrix; const APoints: array of TPointF;
+  ATextureInterpolation: boolean);
+begin
+  Init(ASource, APoints, ATextureInterpolation);
+  FSourceMatrix := ASourceMatrix;
+end;
+constructor TBGRAQuadLinearScanner.Create(ASource: IBGRAScanner;
+  const ATexCoords: array of TPointF; const APoints: array of TPointF;
+  ATextureInterpolation: boolean);
+begin
+  Init(ASource, APoints, ATextureInterpolation);
+  FSourceMatrix := AffineMatrixTranslation(ATexCoords[0].x,ATexCoords[0].y)*
+                AffineMatrixLinear(ATexCoords[1]-ATexCoords[0],ATexCoords[3]-ATexCoords[0]);
+  FUVVector := ATexCoords[2] - (ATexCoords[1]+ATexCoords[3]-ATexCoords[0]);
+end;
+destructor TBGRAQuadLinearScanner.Destroy;
+begin
+  freemem(FBuffer);
+  inherited Destroy;
+end;
 { TBGRAAffineBitmapTransform }
 procedure TBGRAAffineBitmapTransform.Init(ABitmap: TBGRACustomBitmap;
   ARepeatImageX: Boolean; ARepeatImageY: Boolean;
   AResampleFilter: TResampleFilter);
+  AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false);
 begin
   if (ABitmap.Width = 0) or (ABitmap.Height = 0) then
 …
   FRepeatImageY := ARepeatImageY;
   FResampleFilter:= AResampleFilter;
+  FBuffer := nil;
   FBufferSize:= 0;
+  FIncludeEdges := AIncludeEdges;
 end;
 constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap;
   ARepeatImage: Boolean; AResampleFilter: TResampleFilter = rfLinear);
 begin
   Init(ABitmap,ARepeatImage,ARepeatImage,AResampleFilter);
+  ARepeatImage: Boolean; AResampleFilter: TResampleFilter = rfLinear; AIncludeEdges: boolean = false);
+begin
+  Init(ABitmap,ARepeatImage,ARepeatImage,AResampleFilter,AIncludeEdges);
 end;
 constructor TBGRAAffineBitmapTransform.Create(ABitmap: TBGRACustomBitmap;
   ARepeatImageX: Boolean; ARepeatImageY: Boolean;
   AResampleFilter: TResampleFilter);
 begin
   Init(ABitmap,ARepeatImageX,ARepeatImageY,AResampleFilter);
+  AResampleFilter: TResampleFilter; AIncludeEdges: boolean = false);
+begin
+  Init(ABitmap,ARepeatImageX,ARepeatImageY,AResampleFilter,AIncludeEdges);
 end;
 …
 procedure TBGRAAffineBitmapTransform.ScanPutPixels(pdest: PBGRAPixel;
   count: integer; mode: TDrawMode);
+const PrecisionShift = {$IFDEF CPU64}24{$ELSE}12{$ENDIF};
+      Precision = 1 shl PrecisionShift;
 var p: PBGRAPixel;
   n: integer;
   posX4096, posY4096: Int32or64;
   deltaX4096,deltaY4096: Int32or64;
   ix,iy,shrMask,w,h: Int32or64;
+  posXPrecision, posYPrecision: NativeInt;
+  deltaXPrecision,deltaYPrecision: NativeInt;
+  ix,iy,shrMask,w,h: NativeInt;
   py0: PByte;
   deltaRow: Int32or64;
+  deltaRow: NativeInt;
 begin
   w := FBitmap.Width;
 …
   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);
+  if GlobalOpacity = 0 then
+  begin
+    if mode = dmSet then
+      FillDWord(pdest^, count, DWord(BGRAPixelTransparent));
+    exit;
+  end;
+  posXPrecision := round(FCurX*Precision);
+  deltaXPrecision:= round(FMatrix[1,1]*Precision);
+  posYPrecision := round(FCurY*Precision);
+  deltaYPrecision:= round(FMatrix[2,1]*Precision);
   shrMask := -1;
   shrMask := shrMask shr 12;
+  shrMask := shrMask shr PrecisionShift;
   shrMask := not shrMask;
 …
   if FResampleFilter = rfBox then
   begin
     posX4096 += 2048;
     posY4096 += 2048;
+    posXPrecision += Precision shr 1;
+    posYPrecision += Precision shr 1;
     py0 := PByte(FBitmap.ScanLine[0]);
     if FBitmap.LineOrder = riloTopToBottom then
 …
       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 posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift;
+        if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift;
         if FRepeatImageX then ix := PositiveMod(ix,w);
         if FRepeatImageY then iy := PositiveMod(iy,h);
 …
           p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^;
         inc(p);
         posX4096 += deltaX4096;
         posY4096 += deltaY4096;
+        posXPrecision += deltaXPrecision;
+        posYPrecision += deltaYPrecision;
       end;
     end else
 …
      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 posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift;
+       if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift;
        if (ix < 0) or (iy < 0) or (ix >= w) or (iy >= h) then
          p^ := BGRAPixelTransparent
 …
          p^ := (PBGRAPixel(py0 + iy*deltaRow)+ix)^;
        inc(p);
        posX4096 += deltaX4096;
        posY4096 += deltaY4096;
+       posXPrecision += deltaXPrecision;
+       posYPrecision += deltaYPrecision;
      end;
     end;
 …
      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);
+       if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift;
+       if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift;
+       p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter);
        inc(p);
        posX4096 += deltaX4096;
        posY4096 += deltaY4096;
+       posXPrecision += deltaXPrecision;
+       posYPrecision += deltaYPrecision;
      end;
    end else
 …
      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);
+       if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift;
+       if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift;
+       p^ := FBitmap.GetPixelCycle256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter, FRepeatImageX,FRepeatImageY);
        inc(p);
        posX4096 += deltaX4096;
        posY4096 += deltaY4096;
+       posXPrecision += deltaXPrecision;
+       posYPrecision += deltaYPrecision;
      end;
    end else
 …
     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);
+      if posXPrecision < 0 then ix := (posXPrecision shr PrecisionShift) or shrMask else ix := posXPrecision shr PrecisionShift;
+      if posYPrecision < 0 then iy := (posYPrecision shr PrecisionShift) or shrMask else iy := posYPrecision shr PrecisionShift;
+      p^ := FBitmap.GetPixel256(ix,iy, (posXPrecision shr (PrecisionShift-8)) and 255, (posYPrecision shr (PrecisionShift-8)) and 255,FResampleFilter);
       inc(p);
       posX4096 += deltaX4096;
       posY4096 += deltaY4096;
+      posXPrecision += deltaXPrecision;
+      posYPrecision += deltaYPrecision;
     end;
    end;
   end;
+  if GlobalOpacity < 255 then
+  begin
+    if mode = dmSet then
+      p := pdest
+    else
+      p := FBuffer;
+    for n := count-1 downto 0 do
+    begin
+      p^.alpha := ApplyOpacity(p^.alpha,GlobalOpacity);
+      if p^.alpha = 0 then p^ := BGRAPixelTransparent;
+      inc(p);
+    end;
+  end;
   if mode <> dmSet then PutPixels(pdest,FBuffer,count,mode,255);
 end;
 …
 procedure TBGRAAffineBitmapTransform.Fit(Origin, HAxis, VAxis: TPointF);
 begin
+  SetMatrix(AffineMatrix((HAxis.X-Origin.X)/FBitmap.Width, (VAxis.X-Origin.X)/FBitmap.Height, 0,
+                         (HAxis.Y-Origin.Y)/FBitmap.Width, (VAxis.Y-Origin.Y)/FBitmap.Height, 0));
+  if (FBitmap.Width = 0) or (FBitmap.Height = 0) then exit;
+  Matrix := AffineMatrix(HAxis.X-Origin.X, VAxis.X-Origin.X, Origin.X,
+                         HAxis.Y-Origin.Y, VAxis.Y-Origin.Y, Origin.Y);
   Invert;
+  Translate(Origin.X,Origin.Y);
+  if FIncludeEdges then
+  begin
+    Matrix := AffineMatrixTranslation(-0.5,-0.5)*AffineMatrixScale(FBitmap.Width,FBitmap.Height)*Matrix;
+  end else
+    Matrix := AffineMatrixScale(FBitmap.Width-1,FBitmap.Height-1)*Matrix;
 end;

GraphicTest/Packages/bgrabitmap/bgratypewriter.pas

-              r472
+              r494
 implementation
+uses LCLProc, lazutf8classes;
+{$i winstream.inc}
+uses BGRAUTF8;
+procedure LEWritePointF(Stream: TStream; AValue: TPointF);
+begin
+  LEWriteSingle(Stream,AValue.x);
+  LEWriteSingle(Stream,AValue.y);
+end;
+function LEReadPointF(Stream: TStream): TPointF;
+begin
+  result.x := LEReadSingle(Stream);
+  result.y := LEReadSingle(Stream);
+end;
 function ComputeEasyBezier(APoints: array of TPointF; AClosed: boolean; AMinimumDotProduct: single = 0.707): ArrayOfTPointF;
 …
 begin
   inherited WriteContent(AStream);
   WinWritePointF(AStream, Offset);
   WinWriteLongint(AStream,length(Points));
+  LEWritePointF(AStream, Offset);
+  LEWriteLongint(AStream,length(Points));
   for i := 0 to high(Points) do
     WinWritePointF(AStream, Points[i]);
+    LEWritePointF(AStream, Points[i]);
 end;
 …
 begin
   inherited ReadContent(AStream);
   Offset := WinReadPointF(AStream);
   SetLength(tempPts, WinReadLongint(AStream));
+  Offset := LEReadPointF(AStream);
+  SetLength(tempPts, LEReadLongint(AStream));
   for i := 0 to high(tempPts) do
     tempPts[i] := WinReadPointF(AStream);
+    tempPts[i] := LEReadPointF(AStream);
   SetPoints(tempPts);
 end;
 …
   AContentSize: longint);
 begin
   WinWriteByte(AStream, length(AName));
+  LEWriteByte(AStream, length(AName));
   AStream.Write(AName[1],length(AName));
   WinWriteLongint(AStream, AContentSize);
+  LEWriteLongint(AStream, AContentSize);
 end;
 …
 var NameLength: integer;
 begin
   NameLength := WinReadByte(AStream);
+  NameLength := LEReadByte(AStream);
   setlength(AName,NameLength);
   AStream.Read(AName[1],length(AName));
   AContentSize := WinReadLongint(AStream);
+  AContentSize := LEReadLongint(AStream);
 end;
 …
 procedure TBGRAGlyph.WriteContent(AStream: TStream);
 begin
   WinWriteLongint(AStream,length(FIdentifier));
+  LEWriteLongint(AStream,length(FIdentifier));
   AStream.Write(FIdentifier[1],length(FIdentifier));
   WinWriteSingle(AStream,Width);
   WinWriteSingle(AStream,Height);
+  LEWriteSingle(AStream,Width);
+  LEWriteSingle(AStream,Height);
 end;
 …
 var lIdentifierLength: integer;
 begin
   lIdentifierLength:= WinReadLongint(AStream);
+  lIdentifierLength:= LEReadLongint(AStream);
   setlength(FIdentifier, lIdentifierLength);
   AStream.Read(FIdentifier[1],length(FIdentifier));
   Width := WinReadSingle(AStream);
   Height := WinReadSingle(AStream);
+  Width := LEReadSingle(AStream);
+  Height := LEReadSingle(AStream);
 end;
 …
 begin
   for c := AUnicodeFrom to AUnicodeTo do
     GetGlyph(UnicodeToUTF8(c));
+    GetGlyph(UnicodeCharToUTF8(c));
 end;
 …
 var Enumerator: TAvgLvlTreeNodeEnumerator;
 begin
   WinWriteLongint(AStream,CustomHeaderSize);
+  LEWriteLongint(AStream,CustomHeaderSize);
   WriteCustomHeader(AStream);
 …
   GlyphStartPosition: Int64;
 begin
   HeaderSize := WinReadLongint(AStream);
+  HeaderSize := LEReadLongint(AStream);
   GlyphStartPosition:= AStream.Position+HeaderSize;
   Header := ReadCustomTypeWriterHeader(AStream);
 …
 begin
   lHeaderName:= HeaderName;
   WinWriteByte(AStream,length(lHeaderName));
+  LEWriteByte(AStream,length(lHeaderName));
   AStream.Write(lHeaderName[1],length(lHeaderName));
   WinWriteLongint(AStream,FGlyphs.Count);
+  LEWriteLongint(AStream,FGlyphs.Count);
 end;
 …
   ): TBGRACustomTypeWriterHeader;
 begin
   setlength(result.HeaderName, WinReadByte(AStream));
+  setlength(result.HeaderName, LEReadByte(AStream));
   AStream.Read(result.HeaderName[1],length(result.HeaderName));
   result.NbGlyphs:= WinReadLongint(AStream);
+  result.NbGlyphs:= LEReadLongint(AStream);
 end;

GraphicTest/Packages/bgrabitmap/bgravectorize.pas

-              r472
+              r494
 implementation
+uses LCLProc, FileUtil, lazutf8classes;
+{$i winstream.inc}
+uses BGRAUTF8;
 function VectorizeMonochrome(ASource: TBGRACustomBitmap; zoom: single; PixelCenteredCoordinates: boolean): ArrayOfTPointF;
 const unitShift = 6;
 …
   if not FFontPixelMetricComputed and (FFont <> nil) then
   begin
     FFontPixelMetric := BGRAText.GetFontPixelMetric(FFont);
+    FFontPixelMetric := BGRAText.GetLCLFontPixelMetric(FFont);
     FFontPixelMetricComputed := true;
   end;
 …
     end;
   until FindNext(SearchRec) <> 0;
+  FindClose(SearchRec);
   SetLength(FDirectoryContent,NbFiles);
 end;
 …
 begin
   inherited WriteCustomHeader(AStream);
   WinWriteLongint(AStream, length(FName));
+  LEWriteLongint(AStream, length(FName));
   AStream.Write(FName[1],length(FName));
   WinWriteLongint(AStream, integer(FStyle));
   WinWriteSingle(AStream, FontEmHeightRatio);
   WinWriteLongint(AStream, Resolution);
+  LEWriteLongint(AStream, integer(FStyle));
+  LEWriteSingle(AStream, FontEmHeightRatio);
+  LEWriteLongint(AStream, Resolution);
   metric := FontPixelMetric;
   WinWriteLongint(AStream, metric.Baseline);
   WinWriteLongint(AStream, metric.xLine);
   WinWriteLongint(AStream, metric.CapLine);
   WinWriteLongint(AStream, metric.DescentLine);
   WinWriteLongint(AStream, metric.Lineheight);
+  LEWriteLongint(AStream, metric.Baseline);
+  LEWriteLongint(AStream, metric.xLine);
+  LEWriteLongint(AStream, metric.CapLine);
+  LEWriteLongint(AStream, metric.DescentLine);
+  LEWriteLongint(AStream, metric.Lineheight);
 end;
 …
 var lNameLength: integer;
 begin
   lNameLength := WinReadLongint(AStream);
+  lNameLength := LEReadLongint(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.Style := TFontStyles(LEReadLongint(AStream));
+  result.EmHeightRatio:= LEReadSingle(AStream);
+  result.Resolution := LEReadLongint(AStream);
+  result.PixelMetric.Baseline := LEReadLongint(AStream);
+  result.PixelMetric.xLine := LEReadLongint(AStream);
+  result.PixelMetric.CapLine := LEReadLongint(AStream);
+  result.PixelMetric.DescentLine := LEReadLongint(AStream);
+  result.PixelMetric.Lineheight := LEReadLongint(AStream);
   result.PixelMetric.Defined := result.PixelMetric.Lineheight > 0;
 end;

GraphicTest/Packages/bgrabitmap/bgrawinbitmap.pas

-              r472
+              r494
 uses
   Classes, SysUtils, BGRADefaultBitmap, Windows, Graphics, GraphType;
+  Classes, SysUtils, BGRALCLBitmap, Windows, Graphics, GraphType;
 type
   { TBGRAWinBitmap }
   TBGRAWinBitmap = class(TBGRADefaultBitmap)
+  TBGRAWinBitmap = class(TBGRALCLBitmap)
   private
     procedure AlphaCorrectionNeeded;
   protected
     DIB_SectionHandle: HBITMAP;
+    FReversed: boolean;
     function DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo;
 …
     procedure Init; override;
+    function GetBitmap: TBitmap; override;
   public
+    procedure LoadFromBitmapIfNeeded; override;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean=True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
 …
 implementation
+uses BGRADefaultBitmap, BGRABitmapTypes;
 type
 …
 end;
+function TBGRAWinBitmap.GetBitmap: TBitmap;
+begin
+  Result:=inherited GetBitmap;
+  if (LineOrder = riloTopToBottom) and not FReversed then
+  begin
+    VerticalFlip;
+    FReversed:= true;
+  end;
+end;
+procedure TBGRAWinBitmap.LoadFromBitmapIfNeeded;
+begin
+  if FReversed then
+  begin
+    FReversed := false;
+    VerticalFlip;
+  end;
+  if FAlphaCorrectionNeeded then
+  begin
+    DoAlphaCorrection;
+  end;
+end;
+procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
+begin
+  if self = nil then exit;
+  Draw(ACanvas, Classes.Rect(x,y,x+Width,y+Height), Opaque);
+end;
+procedure TBGRAWinBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
+var
+  info:      TBITMAPINFO;
+begin
+  if (self = nil) or (Width = 0) or (Height = 0) then exit;
+  if TBGRAPixel_RGBAOrder then SwapRedBlue;
+  if Opaque then
+  begin
+    info := DIBitmapInfo(Width, Height);
+    if LineOrder = riloTopToBottom then
+      StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Bottom, Rect.Right -
+        Rect.Left, Rect.Top - Rect.Bottom,
+, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY)
+    else
+      StretchDIBits(ACanvas.Handle, Rect.Left, Rect.Top, Rect.Right -
+        Rect.Left, Rect.Bottom - Rect.Top,
+, 0, Width, Height, Data, info, DIB_RGB_COLORS, SRCCOPY);
+  end
+  else
+  begin
+    if Empty then exit;
+    if LineOrder = riloTopToBottom then VerticalFlip;
+    LoadFromBitmapIfNeeded;
+    ACanvas.StretchDraw(Rect, Bitmap);
+    if LineOrder = riloTopToBottom then VerticalFlip;
+  end;
+  if TBGRAPixel_RGBAOrder then SwapRedBlue;
+end;
 procedure TBGRAWinBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
   AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
 …
     IsFlipped := True;
   end;
+  if TBGRAPixel_RGBAOrder then
+  begin
+    if Temp = nil then
+      Temp := TBGRAPtrBitmap.Create(AWidth, AHeight, AData);
+    Temp.SwapRedBlue;
+  end;
   info := DIBitmapInfo(AWidth, AHeight);
 …
   if Temp <> nil then
   begin
+    if TBGRAPixel_RGBAOrder then Temp.SwapRedBlue;
     if IsFlipped then
       Temp.VerticalFlip;
 …
 function TBGRAWinBitmap.DIBitmapInfo(AWidth, AHeight: integer): TBitmapInfo;
 begin
   with Result.bmiHeader do
+  with {%H-}Result.bmiHeader do
   begin
     biSize      := sizeof(Result.bmiHeader);

GraphicTest/Packages/bgrabitmap/bgrawritelzp.pas

-              r472
+              r494
 implementation
 uses BGRACompressableBitmap, FPWritePNG;
+uses BGRACompressableBitmap;
 { TBGRAWriterLazPaint }
 …
   OldResampleFilter: TResampleFilter;
   thumbnail: TBGRACustomBitmap;
-  p: PBGRAPixel;
-  n: integer;
 begin
   result := false;
 …
     thumbnail := TBGRACustomBitmap(Img).Resample(w,h,rmFineResample);
     TBGRACustomBitmap(Img).ResampleFilter := OldResampleFilter;
-    p := thumbnail.data; //avoid PNG bug with black color transformed into transparent
-    for n := thumbnail.NbPixels-1 downto 0 do
-    begin
-      if (p^.alpha <> 0) and (p^.red = 0) and (p^.green = 0) and (p^.blue = 0) then
-        p^.blue := 1;
-      inc(p);
-    end;
     try
 …
     finally
       thumbnail.Free;
+    end;
+  end else
+  begin
+    thumbStream := TMemoryStream.Create;
+    try
+      TBGRACustomBitmap(Img).SaveToStreamAsPng(thumbStream);
+      thumbStream.Position:= 0;
+      Str.CopyFrom(thumbStream, thumbStream.Size);
+      result := true;
+    finally
+      thumbStream.Free;
     end;
   end;

GraphicTest/Packages/bgrabitmap/blendpixelinline.inc

-              r472
+              r494
 begin
   result := ((not a)*b shr 7 + a)*a div 255;
-{ SVG specification would be :
-  if b <= 128 then
-    result := a - (((256 - b-b)*a shr 8)*(not a) shr 8)
-  else if a <= 64 then
-    result := a + ((b+b - 256)*((((a shl 2)*(a shl 2 + 256) shr 8)*integer(a - 256) shr 8) + a*7) shr 8)
-  else
-    result := a + ((b+b - 255)*(ByteSqrt(a)-a) shr 8);}
 end;
 …
       c.green * (not destalpha)) shr 8;
     dest^.blue  := (ByteSoftLightInline(dest^.blue, c.blue) * destalpha +
+      c.blue * (not destalpha)) shr 8;
+    dest^.alpha := c.alpha;
+  end;
+end;
+function ByteSvgSoftLightInline(a,b: byte): byte; inline;
+begin
+  if b <= 128 then
+    result := a - (((256 - b-b)*a shr 8)*(not a) shr 8)
+  else
+  begin
+    dec(b, 128);
+    if a <= 64 then
+      result := a + ((b+b)   * NativeUInt(a*7 - ((a shl 2)*(a shl 2 + 256)*NativeUInt(256 - a) shr 16)) shr 8)
+    else
+      result := a + ((b+b+1) * NativeUInt(ByteSqrt(a)-a) shr 8);
+  end;
+end;
+procedure SvgSoftLightPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;
+var
+  destalpha: byte;
+begin
+  destalpha   := dest^.alpha;
+  if destalpha = 0 then
+  begin
+    dest^ := c
+  end else
+  if destalpha = 255 then
+  begin
+    dest^.red := ByteSvgSoftLightInline(dest^.red, c.red);
+    dest^.green := ByteSvgSoftLightInline(dest^.green, c.green);
+    dest^.blue  := ByteSvgSoftLightInline(dest^.blue, c.blue);
+    dest^.alpha := c.alpha;
+  end else
+  begin
+    dest^.red   := (ByteSvgSoftLightInline(dest^.red, c.red) * destalpha +
+      c.red * (not destalpha)) shr 8;
+    dest^.green := (ByteSvgSoftLightInline(dest^.green, c.green) * destalpha +
+      c.green * (not destalpha)) shr 8;
+    dest^.blue  := (ByteSvgSoftLightInline(dest^.blue, c.blue) * destalpha +
       c.blue * (not destalpha)) shr 8;
     dest^.alpha := c.alpha;

GraphicTest/Packages/bgrabitmap/blendpixels.inc

-              r452
+              r494
         begin
           SoftLightPixelInline(pdest, psrc^);
+          Inc(pdest);
+          Inc(psrc);
+          Dec(Count);
+        end;
+end;
+procedure SvgSoftLightPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer);
+begin
+  while Count > 0 do
+        begin
+          SvgSoftLightPixelInline(pdest, psrc^);
           Inc(pdest);
           Inc(psrc);
 …
       @GlowPixels, @ReflectPixels, @LinearOverlayPixels, @OverlayPixels, @DarkenPixels, @LinearMultiplyPixels, @ColorBurnPixels,
       @DifferencePixels, @LinearDifferencePixels, @ExclusionPixels, @LinearExclusionPixels, @SubtractPixels, @LinearSubtractPixels,
       @SubtractInversePixels, @LinearSubtractInversePixels, @NegationPixels, @LinearNegationPixels, @BlendXorPixels);
+      @SubtractInversePixels, @LinearSubtractInversePixels, @NegationPixels, @LinearNegationPixels, @BlendXorPixels, @SvgSoftLightPixels);
 procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel;

GraphicTest/Packages/bgrabitmap/blendpixelsover.inc

-              r452
+              r494
 end;
+procedure SvgSoftLightPixelsLinearOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte);
+var temp: TBGRAPixel;
+begin
+  while Count > 0 do
+        begin
+          temp := pdest^;
+          SvgSoftLightPixelInline(@temp, psrc^);
+          FastBlendPixelInline(pdest, temp, opacity);
+          Inc(pdest);
+          Inc(psrc);
+          Dec(Count);
+        end;
+end;
 procedure SoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte);
 var temp: TBGRAPixel;
 …
           temp := pdest^;
           SoftLightPixelInline(@temp, psrc^);
+          DrawPixelInlineWithAlphaCheck(pdest, temp, opacity);
+          Inc(pdest);
+          Inc(psrc);
+          Dec(Count);
+        end;
+end;
+procedure SvgSoftLightPixelsDrawOver(pdest: PBGRAPixel; psrc: PBGRAPixel; Count: integer; Opacity: byte);
+var temp: TBGRAPixel;
+begin
+  while Count > 0 do
+        begin
+          temp := pdest^;
+          SvgSoftLightPixelInline(@temp, psrc^);
           DrawPixelInlineWithAlphaCheck(pdest, temp, opacity);
           Inc(pdest);
 …
       @GlowPixelsDrawOver, @ReflectPixelsDrawOver, @LinearOverlayPixelsDrawOver, @OverlayPixelsDrawOver, @DarkenPixelsDrawOver, @LinearMultiplyPixelsDrawOver, @ColorBurnPixelsDrawOver,
       @DifferencePixelsDrawOver, @LinearDifferencePixelsDrawOver, @ExclusionPixelsDrawOver, @LinearExclusionPixelsDrawOver, @SubtractPixelsDrawOver, @LinearSubtractPixelsDrawOver,
       @SubtractInversePixelsDrawOver, @LinearSubtractInversePixelsDrawOver, @NegationPixelsDrawOver, @LinearNegationPixelsDrawOver, @BlendXorPixelsDrawOver),
+      @SubtractInversePixelsDrawOver, @LinearSubtractInversePixelsDrawOver, @NegationPixelsDrawOver, @LinearNegationPixelsDrawOver, @BlendXorPixelsDrawOver, @SvgSoftLightPixelsDrawOver),
       (@FastBlendPixelsWithOpacity, @FastBlendPixelsWithOpacity,
       @LightenPixelsLinearOver, @ScreenPixelsLinearOver, @AddPixelsLinearOver, @LinearAddPixelsLinearOver, @ColorDodgePixelsLinearOver, @DividePixelsLinearOver, @NiceGlowPixelsLinearOver, @SoftLightPixelsLinearOver, @HardLightPixelsLinearOver,
       @GlowPixelsLinearOver, @ReflectPixelsLinearOver, @LinearOverlayPixelsLinearOver, @OverlayPixelsLinearOver, @DarkenPixelsLinearOver, @LinearMultiplyPixelsLinearOver, @ColorBurnPixelsLinearOver,
       @DifferencePixelsLinearOver, @LinearDifferencePixelsLinearOver, @ExclusionPixelsLinearOver, @LinearExclusionPixelsLinearOver, @SubtractPixelsLinearOver, @LinearSubtractPixelsLinearOver,
       @SubtractInversePixelsLinearOver, @LinearSubtractInversePixelsLinearOver, @NegationPixelsLinearOver, @LinearNegationPixelsLinearOver, @BlendXorPixelsLinearOver));
+      @SubtractInversePixelsLinearOver, @LinearSubtractInversePixelsLinearOver, @NegationPixelsLinearOver, @LinearNegationPixelsLinearOver, @BlendXorPixelsLinearOver, @SvgSoftLightPixelsLinearOver));
 {************************* calling procedure ***************************}

GraphicTest/Packages/bgrabitmap/blurfast.inc

-              r472
+              r494
 var
+  blurRow: array of UInt32or64;
+  blurRowY,blurRowX: packed array of NativeUInt;
+  iRadiusX,iRadiusY: NativeInt;
+  weightFactor: NativeUInt;
   { Compute weights of pixels in a row }
   procedure ComputeBlurRow;
   var
+    i: Integer;
+  begin
+    SetLength(blurRow, 2*radius+1);
+    for i := 0 to radius do
+    begin
+      blurRow[i] := i+1;
+      blurRow[high(blurRow)-i] := blurRow[i];
+    i: NativeInt;
+    ofs: single;
+  begin
+    SetLength(blurRowX, 2*iRadiusX+1);
+    if frac(radiusX)=0 then ofs := 1 else ofs := frac(radiusX);
+    for i := 0 to iRadiusX do
+    begin
+      blurRowX[i] := round((i+ofs)*weightFactor);
+      blurRowX[high(blurRowX)-i] := blurRowX[i];
+    end;
+    SetLength(blurRowY, 2*iRadiusY+1);
+    if frac(radiusY)=0 then ofs := 1 else ofs := frac(radiusY);
+    for i := 0 to iRadiusY do
+    begin
+      blurRowY[i] := round((i+ofs)*weightFactor);
+      blurRowY[high(blurRowY)-i] := blurRowY[i];
     end;
   end;
 …
 var
   srcDelta,
+  verticalWeightShift, horizontalWeightShift: integer;
+  verticalWeightShift, horizontalWeightShift: NativeInt;
+  ys1,ys2: NativeInt;
   { Compute blur result in a vertical direction }
+  procedure ComputeVerticalRow(psrc: PBGRAPixel; var sums: TRowSum; ys1,ys2: integer); inline;
+  var ys: integer;
+      c: TBGRAPixel;
+      w,aw: cardinal;
+  begin
+    for ys := ys1 to ys2 do
+  procedure ComputeVerticalRow(psrc: PBGRAPixel; var sums: TRowSum; pw: PNativeUInt; count: NativeInt);
+  var w: NativeUInt;
+      c: DWord;
+  begin
+    while count > 0 do
     with sums do
     begin
+      c := psrc^;
+      w := blurRow[ys]; //apply pixel weight
+      aw := c.alpha*w;
+      sumA += aw;
+      dec(count);
+      w := pw^; //apply pixel weight
+      inc(pw);
+      c := PDWord(psrc)^;
+      inc(PByte(psrc),srcDelta);
       aDiv += w;
+      aw := aw shr verticalWeightShift;
+      w *= ((c shr TBGRAPixel_AlphaShift) and $ff);
+      sumA += w;
+      w := w shr verticalWeightShift;
+      rgbDiv += w;
       {$hints off}
+      sumR += c.red*aw;
+      sumG += c.green*aw;
+      sumB += c.blue*aw;
+      rgbDiv += aw;
+      sumR += ((c shr TBGRAPixel_RedShift) and $ff)*w;
+      sumG += ((c shr TBGRAPixel_GreenShift) and $ff)*w;
+      sumB += ((c shr TBGRAPixel_BlueShift) and $ff)*w;
       {$hints on}
-      inc(psrc,srcDelta);
     end;
   end;
 var
+  sums: array of TRowSum;
+  sumStartIndex,curIndex: integer;
+  psum, psumEnd: PRowSum;
+  sums: packed array of TRowSum;
+  sumStartIndex: NativeInt;
   total: TRowSum;
   extendedTotal: TExtendedRowSum;
+  yb,xb,xs,ys1,ys2,x: integer;
+  w: cardinal;
+  pdest: PBGRAPixel;
+  bmpWidth,bmpHeight : integer;
+  yb,xb,xs,x,xEnd: NativeInt;
+  w: NativeUInt;
+  pw: PNativeUInt;
+  psrc,pdest: PBGRAPixel;
+  bmpWidth,bmpHeight : NativeInt;
   accumulationFactor: double;
   bounds: TRect;
+  highSum: NativeInt;
+  tempDest: TBGRACustomBitmap;
 begin
+  if radius = 0 then
+  radiusX := round(radiusX*10)*0.1;
+  radiusY := round(radiusY*10)*0.1;
+  if (radiusX <= 0) and (radiusY <= 0) then
   begin
     ADestination.PutImage(0,0,bmp,dmSet);
     exit;
   end;
+  iRadiusX := ceil(radiusX);
+  iRadiusY := ceil(radiusY);
+  if (frac(radiusX)=0) and (frac(radiusY)=0) then
+    weightFactor:= 1
+  else
+    weightFactor:= 10;
   bmpWidth := bmp.Width;
   bmpHeight := bmp.Height;
 …
   bounds := bmp.GetImageBounds;
   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);
+  bounds.Left   := max(0, bounds.Left - iRadiusX);
+  bounds.Top    := max(0, bounds.Top - iRadiusY);
+  bounds.Right  := min(bmp.Width, bounds.Right + iRadiusX);
+  bounds.Bottom := min(bmp.Height, bounds.Bottom + iRadiusY);
   if not IntersectRect(bounds,bounds,ABounds) then exit;
+  accumulationFactor := (radius+2)*(radius+1) div 2 + (radius+1)*radius div 2;
+  if radiusX*radiusY >= 100 then
+  begin
+    tempDest := ADestination.NewBitmap(ADestination.Width,ADestination.Height);
+    FilterBlurBox(bmp,bounds,radiusX/3.2,radiusY/3.2,tempDest);
+    FilterBlurBox(tempDest,bounds,radiusX/2.9,radiusY/2.9,ADestination);
+    FilterBlurBox(ADestination,bounds,radiusX/3.2,radiusY/3.2,tempDest);
+    FilterBlurBox(tempDest,bounds,radiusX/2.3,radiusY/2.3,ADestination, ACheckShouldStop);
+    tempDest.Free;
+    exit;
+  end;
+  accumulationFactor := (iRadiusY+2)*(iRadiusY+1) div 2 + (iRadiusY+1)*iRadiusY div 2;
+  accumulationFactor *= sqr(weightFactor);
   verticalWeightShift := 0;
   while accumulationFactor > (high(UInt32or64) shr 16) + 1 do
+  while accumulationFactor > (high(NativeUInt) shr 16) + 1 do
   begin
     inc(verticalWeightShift);
 …
   end;
   horizontalWeightShift:= 0;
+  accumulationFactor *= ((radius+2)*(radius+1) div 2 + (radius+1)*radius div 2);
+  while accumulationFactor > (high(UInt32or64) shr 16) + 1 do
+  accumulationFactor *= ((iRadiusX+2)*(iRadiusX+1) div 2 + (iRadiusX+1)*iRadiusX div 2);
+  accumulationFactor *= sqr(weightFactor);
+  while accumulationFactor > (high(NativeUInt) shr 16) + 1 do
   begin
     inc(horizontalWeightShift);
 …
   ComputeBlurRow;
   //current vertical sums
+  setlength(sums, 2*radius+1);
+  setlength(sums, 2*iRadiusX+1);
+  highSum := high(Sums);
+  psumEnd := @sums[highSum];
+  inc(psumEnd);
   if bmp.LineOrder = riloTopToBottom then
+    srcDelta := bmpWidth else
+      srcDelta := -bmpWidth;
+    srcDelta := bmpWidth*sizeof(TBGRAPixel) else
+      srcDelta := -bmpWidth*sizeof(TBGRAPixel);
+  xEnd := bounds.left-iRadiusX+highSum;
+  if xEnd >= bmpWidth then xEnd := bmpWidth-1;
   //loop through destination bitmap
   for yb := bounds.top to bounds.bottom-1 do
 …
     if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break;
     //evalute available vertical range
     if yb - radius < 0 then
       ys1 := radius - yb
+    if yb - iRadiusY < 0 then
+      ys1 := iRadiusY - yb
     else
       ys1 := 0;
     if yb + radius >= bmpHeight then
       ys2 := bmpHeight - yb + radius - 1
+    if yb + iRadiusY >= bmpHeight then
+      ys2 := bmpHeight-1 - yb + iRadiusY
     else
       ys2 := high(sums);
+      ys2 := 2*iRadiusY;
     { initial vertical rows are computed here. Later,
       for each pixel, vertical sums are shifted, so there
       is only one vertical sum to calculate }
+    for xs := 0 to high(sums) do
+    begin
+      fillchar(sums[xs],sizeof(TRowSum),0);
+      x := bounds.left-radius+xs;
+      if (x >= 0) and (x < bmpWidth) then
+        ComputeVerticalRow(bmp.ScanLine[yb-radius+ys1]+x,sums[xs],ys1,ys2);
+    fillchar(sums[0],sizeof(TRowSum)*length(sums),0);
+    x := bounds.left-iRadiusX;
+    if x < 0 then
+    begin
+      xs := -x;
+      x := 0;
+    end else
+      xs := 0;
+    psrc := bmp.ScanLine[yb-iRadiusY+ys1]+x;
+    psum := @sums[xs];
+    pw := @blurRowY[ys1];
+    while true do
+    begin
+      ComputeVerticalRow(psrc,psum^,pw,ys2-ys1+1);
+      inc(x);
+      inc(psrc);
+      if x > xEnd then break;
+      inc(psum);
     end;
     sumStartIndex := 0;
 …
     begin
       //add vertical rows
+      curIndex:= sumStartIndex;
+      pw := @blurRowX[0];
+      psum := @sums[sumStartIndex];
       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
+        fillchar({%H-}extendedTotal,sizeof(extendedTotal),0);
+        for xs := highSum downto 0 do
+        with psum^ do
         begin
+          w := blurRow[xs];
+          w := pw^;
+          inc(pw);
           extendedTotal.sumA += TExtendedRowValue(sumA)*w;
           extendedTotal.aDiv += TExtendedRowValue(aDiv)*w;
 …
           extendedTotal.sumB += TExtendedRowValue(sumB)*w;
           extendedTotal.rgbDiv += TExtendedRowValue(rgbDiv)*w;
           inc(curIndex);
           if curIndex = length(sums) then curIndex := 0;
+          inc(psum);
+          if psum >= psumEnd then pSum := @sums[0];
         end;
         if (extendedTotal.aDiv > 0) and (extendedTotal.rgbDiv > 0) then
 …
       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
+        fillchar({%H-}total,sizeof(total),0);
+        for xs := highSum downto 0 do
+        with psum^ do
         begin
+          w := blurRow[xs];
+          w := pw^;
+          inc(pw);
           total.sumA += sumA*w shr horizontalWeightShift;
           total.aDiv += aDiv*w shr horizontalWeightShift;
 …
           total.sumB += sumB*w shr horizontalWeightShift;
           total.rgbDiv += rgbDiv*w shr horizontalWeightShift;
           inc(curIndex);
           if curIndex = length(sums) then curIndex := 0;
+          inc(psum);
+          if psum >= psumEnd then pSum := @sums[0];
         end;
         if (total.aDiv > 0) and (total.rgbDiv > 0) then
 …
         fillchar(total,sizeof(total),0);
         {$hints on}
         for xs := 0 to high(sums) do
         with sums[curIndex] do
+        for xs := highSum downto 0 do
+        with psum^ do
         begin
+          w := blurRow[xs];
+          w := pw^;
+          inc(pw);
           total.sumA += sumA*w;
           total.aDiv += aDiv*w;
 …
           total.sumB += sumB*w;
           total.rgbDiv += rgbDiv*w;
           inc(curIndex);
           if curIndex = length(sums) then curIndex := 0;
+          inc(psum);
+          if psum >= psumEnd then pSum := @sums[0];
         end;
         if (total.aDiv > 0) and (total.rgbDiv > 0) then
           pdest^:= ComputeAverage(total)
+          pdest^ := ComputeAverage(total)
         else
           pdest^:= BGRAPixelTransparent;
 …
       inc(pdest);
       //shift vertical rows
+      fillchar(sums[sumStartIndex],sizeof(TRowSum),0);
+      x := xb+1-radius+high(sums);
+      if (x >= 0) and (x < bmpWidth) then
+        ComputeVerticalRow(bmp.ScanLine[yb-radius+ys1]+x,sums[sumStartIndex],ys1,ys2);
+      psum := @sums[sumStartIndex];
+      fillchar(psum^,sizeof(TRowSum),0);
+      if x < bmpWidth then
+      begin
+        ComputeVerticalRow(psrc,psum^,@blurRowY[ys1],ys2-ys1+1);
+        inc(x);
+        inc(psrc);
+      end;
       inc(sumStartIndex);
       if sumStartIndex = length(sums) then sumStartIndex := 0;
+      if sumStartIndex > highSum then sumStartIndex := 0;
     end;
   end;

GraphicTest/Packages/bgrabitmap/blurnormal.inc

-              r472
+              r494
+type
+  PWeightedPixel = ^TWeightedPixel;
+  TWeightedPixel = packed record
+    Coord: TPoint;
+    Weight: NativeInt;
+    PtrOfs: NativeInt;
+  end;
 var
   maskWidth,maskHeight: integer;
   blurOfs:      TPoint;
   PixelWeight:  array of integer;
   PixelOfs:     array of TPoint;
+  blurOfs: TPoint;
+  ppixel: PWeightedPixel;
+  Pixel: array of TWeightedPixel;
   PixelArrayLineStart: array of integer;
+  DiffPixelWeight:  array of integer;
+  DiffPixelOfs:     array of TPoint;
+  DiffPixel: array of TWeightedPixel;
   DiffPixelArrayLineStart: array of integer;
+  procedure LoadMask;
+  var x,y,n: integer;
+      tempWeight: integer;
+      diffMask: array of array of integer;
+  bmpWidth,bmpHeight,lineDelta: NativeInt;
+  procedure LoadMask(out ABlurOfs: TPoint);
+  var x,y,n,i: NativeInt;
+      tempWeight: NativeInt;
+      diffMask: array of packed array of NativeInt;
+      p: PBGRAPixel;
   begin
     blurOfs := point(blurMask.Width shr 1, blurMask.Height shr 1);
+    ABlurOfs := point(blurMask.Width shr 1, blurMask.Height shr 1);
     //count number of non empty pixels
 …
     maskHeight := blurMask.Height;
     n := 0;
+    for y := 0 to maskHeight - 1 do
+      for x := 0 to maskWidth - 1 do
+        if blurMask.GetPixel(x, y).red <> 0 then Inc(n);
+    p := blurMask.Data;
+    for i := blurMask.NbPixels-1 downto 0 do
+    begin
+      if p^.red <> 0 then inc(n);
+      inc(p);
+    end;
     //initialize arrays
     setlength(diffMask, maskHeight, maskWidth+1);
     for y := 0 to maskHeight - 1 do
+      for x := 0 to maskWidth do
+        diffMask[y,x] := 0;
+    setlength(PixelWeight, n);
+    setlength(PixelOfs, n);
+      fillchar(diffMask[y,0], (maskWidth+1)*sizeof(NativeInt), 0);
+    setlength(Pixel, n);
     setlength(PixelArrayLineStart, maskHeight+1);  //stores the first pixel of each line
     n := 0;
 …
     begin
       PixelArrayLineStart[y] := n;
+      p := blurMask.ScanLine[y];
       for x := 0 to maskWidth - 1 do
       begin
+        tempWeight := blurMask.GetPixel(x, y).red;
+        tempWeight := p^.red;
+        inc(p);
         diffMask[y,x] -= tempWeight;
         diffMask[y,x+1] += tempWeight;
 …
         if tempWeight <> 0 then
         begin
+          PixelWeight[n] := tempWeight;
+          PixelOfs[n] := Point(x,y);
+          Pixel[n].Weight := tempWeight;
+          Pixel[n].Coord := Point(x,y);
+          Pixel[n].PtrOfs := (y-ABlurOfs.Y)*lineDelta + (x-ABlurOfs.X)*sizeof(TBGRAPixel);
           Inc(n);
         end;
 …
     //initialize arrays
+    setlength(DiffPixelWeight, n);
+    setlength(DiffPixelOfs, n);
+    setlength(DiffPixel, n);
     setlength(DiffPixelArrayLineStart, maskHeight+1);  //stores the first pixel of each diff line
     n := 0;
 …
         if tempWeight <> 0 then
         begin
+          DiffPixelWeight[n] := tempWeight;
+          DiffPixelOfs[n] := Point(x-1,y);
+          DiffPixel[n].Weight := tempWeight;
+          DiffPixel[n].Coord := Point(x-1,y);
+          DiffPixel[n].PtrOfs := (y-ABlurOfs.Y)*lineDelta + (x-ABlurOfs.X-1)*sizeof(TBGRAPixel);
           Inc(n);
         end;
 …
   end;
+var
+  curScans: array of PBGRAPixel;
+  bounds: TRect;
+  {procedure ShowCurScans;
+  var str: string;
+    i: Integer;
+  begin
+    str := '';
+    for i := 0 to high(curScans) do
+    begin
+      if i <> 0 then str += ', ';
+      if curScans[i]=nil then str += 'nil' else
+        str += 'bmp['+inttostr(curScans[i]-bmp.Data)+']';
+    end;
+    ShowMessage(str);
+  end;}
+  function PrepareScan: boolean;
+  var
+    bmpY: integer;
+    y   : Integer;
+  function PrepareScan(AWantedBounds: TRect; out AClippedBounds: TRect): boolean;
   begin
     //evaluate required bounds taking blur radius into acount
     bounds := bmp.GetImageBounds;
     if IsRectEmpty(bounds) then
+    AClippedBounds := bmp.GetImageBounds;
+    if IsRectEmpty(AClippedBounds) then
     begin
       result := false;
       exit;
     end;
     bounds.Left   := max(0, bounds.Left - blurOfs.X);
     bounds.Top    := max(0, bounds.Top - blurOfs.Y);
     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
+    AClippedBounds.Left   := max(0, AClippedBounds.Left - blurOfs.X);
+    AClippedBounds.Top    := max(0, AClippedBounds.Top - blurOfs.Y);
+    AClippedBounds.Right  := min(bmpWidth, AClippedBounds.Right + maskWidth - 1 - blurOfs.X);
+    AClippedBounds.Bottom := min(bmpHeight, AClippedBounds.Bottom + maskHeight - 1 - blurOfs.Y);
+    if not IntersectRect(AClippedBounds, AClippedBounds, AWantedBounds) then
     begin
       result := false;
 …
     end;
-    //init scanlines
-    setlength(curScans, maskHeight);
-    for y := 0 to maskHeight-1 do
-    begin
-      bmpY := y+bounds.Top-blurOfs.Y;
-      if (bmpY < 0) or (bmpY >= bmp.Height) then
-        curScans[y] := nil else
-          curScans[y] := bmp.ScanLine[bmpY];
-    end;
-    //ShowCurScans;
     result := true;
   end;
-  procedure ShiftScan(NewY: integer); inline;
-  var y: integer;
-  begin
-    for y := 0 to maskHeight-2 do
-     curScans[y] := curScans[y+1];
-    //get next scanline
-    if newY >= bmp.Height then
-      curScans[maskHeight-1] := nil
-    else
-      curScans[maskHeight-1] := bmp.ScanLine[newY];
-    //ShowCurScans;
-  end;
 var
+  yb, xb: integer;
+  mindy, maxdy, n: integer;
+  bmpWidth,bmpX: integer;
+  pixMaskAlpha, maskAlpha: integer;
+  bounds: TRect;
+  yb, xb: NativeInt;
+  mindy, maxdy, n, nStart, nCount, nDiffStart, nDiffCount: NativeInt;
+  bmpX,bmpXBase,bmpYBase: NativeInt;
+  pixMaskAlpha, maskAlpha: NativeInt;
   tempPixel: TBGRAPixel;
   pdest : PBGRAPixel;
   pt: TPoint;
+  psrc : PByte;
 begin
+  LoadMask;
+  if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then
+  bmpWidth := bmp.Width;
+  bmpHeight:= bmp.Height;
+  if bmp.LineOrder = riloTopToBottom then
+    lineDelta := bmpWidth*sizeof(TBGRAPixel) else
+    lineDelta := -bmpWidth*sizeof(TBGRAPixel);
+  if (ADestination.Width <> bmpWidth) or (ADestination.Height <> bmpHeight) then
     raise exception.Create('Dimension mismatch');
+  if not PrepareScan then exit; //nothing to do
+  bmpWidth := bmp.Width;
+  LoadMask(blurOfs);
+  if not PrepareScan(ABounds, bounds) then exit; //nothing to do
+  bmpYBase := bounds.Top - blurOfs.Y;
   //loop through destination
   for yb := bounds.Top to bounds.Bottom - 1 do
   begin
     if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break;
+    psrc := PByte(bmp.ScanLine[yb]+bounds.Left);
     pdest := ADestination.ScanLine[yb] + bounds.Left;
     //compute vertical range
     mindy := max(-blurOfs.Y, -yb);
     maxdy := min(blurMask.Height - 1 - blurOfs.Y, bmp.Height - 1 - yb);
+    maxdy := min(blurMask.Height - 1 - blurOfs.Y, bmpHeight - 1 - yb);
     sumR   := 0;
 …
     {$endif}
+    bmpXBase := bounds.Left-blurOfs.X;
+    nStart := PixelArrayLineStart[mindy+blurOfs.Y];
+    nCount  := PixelArrayLineStart[maxdy+blurOfs.Y+1]-nStart;
+    ppixel:= @Pixel[nStart];
     //go through pixel list of the current vertical range
+    for n := PixelArrayLineStart[mindy+blurOfs.Y] to PixelArrayLineStart[maxdy+blurOfs.Y+1]-1 do
+    begin
+      pt := PixelOfs[n];
+      bmpX := bounds.Left-blurOfs.X+pt.x;
+    for n := nCount-1 downto 0 do
+    begin
+      bmpX := bmpXBase+ppixel^.Coord.x;
       //check horizontal range
       if (bmpX >= 0) and (bmpX < bmpWidth) then
       begin
         tempPixel := (curScans[pt.y]+bmpX)^;
         maskAlpha := PixelWeight[n];
+        tempPixel := PBGRAPixel(psrc + ppixel^.PtrOfs)^;
+        maskAlpha := ppixel^.Weight;
         pixMaskAlpha := maskAlpha * tempPixel.alpha;
         sumA    += pixMaskAlpha;
 …
         {$hints on}
       end;
+    end;
+    for xb := bounds.Left to Bounds.Right - 1 do
+    begin
+      if xb > bounds.left then
+      begin
+        for n := DiffPixelArrayLineStart[mindy+blurOfs.Y] to DiffPixelArrayLineStart[maxdy+blurOfs.Y+1]-1 do
+        begin
+          pt := DiffPixelOfs[n];
+          bmpX := xb-blurOfs.X+pt.x;
+      inc(ppixel);
+    end;
+    //compute average
+    if (Adiv <= 0) {$ifdef PARAM_MASKSHIFT} or (RGBdiv <= 0) {$endif} then
+      pdest^ := BGRAPixelTransparent
+    else
+      pdest^ := computeAverage;
+    nDiffStart := DiffPixelArrayLineStart[mindy+blurOfs.Y];
+    nDiffCount := DiffPixelArrayLineStart[maxdy+blurOfs.Y+1]-nDiffStart;
+    if nDiffCount < nCount then
+    begin
+      for xb := bounds.Left+1 to Bounds.Right - 1 do
+      begin
+        Inc(pdest);
+        inc(bmpXBase);
+        inc(psrc,sizeof(TBGRAPixel));
+        ppixel:= @DiffPixel[nDiffStart];
+        for n := nDiffCount-1 downto 0 do
+        begin
+          bmpX := bmpXBase+ppixel^.Coord.x;
           if (bmpX >= 0) and (bmpX < bmpWidth) then
           begin
             tempPixel := (curScans[pt.y]+bmpX)^;
             maskAlpha := DiffPixelWeight[n];
+            tempPixel := PBGRAPixel(psrc + ppixel^.PtrOfs)^;
+            maskAlpha := ppixel^.Weight;
             pixMaskAlpha := maskAlpha * tempPixel.alpha;
             sumA    += pixMaskAlpha;
 …
             {$hints on}
           end;
+        end;
+      end;
+      //compute average
+      if (Adiv <= 0) {$ifdef PARAM_MASKSHIFT} or (RGBdiv <= 0) {$endif} then
+        pdest^ := BGRAPixelTransparent
+      else
+        pdest^ := computeAverage;
+      Inc(pdest);
+    end;
+    ShiftScan(yb-blurOfs.Y+maskHeight);
+          inc(ppixel);
+        end;
+        //compute average
+        if (Adiv <= 0) {$ifdef PARAM_MASKSHIFT} or (RGBdiv <= 0) {$endif} then
+          pdest^ := BGRAPixelTransparent
+        else
+          pdest^ := ComputeAverage;
+      end;
+    end else
+    begin
+      for xb := bounds.Left+1 to Bounds.Right - 1 do
+      begin
+        Inc(pdest);
+        inc(bmpXBase);
+        inc(psrc,sizeof(TBGRAPixel));
+        sumR   := 0;
+        sumG   := 0;
+        sumB   := 0;
+        sumA   := 0;
+        Adiv   := 0;
+        {$ifdef PARAM_MASKSHIFT}
+        RGBdiv := 0;
+        {$endif}
+        ppixel:= @Pixel[nStart];
+        for n := nCount-1 downto 0 do
+        begin
+          bmpX := bmpXBase+ppixel^.Coord.x;
+          //check horizontal range
+          if (bmpX >= 0) and (bmpX < bmpWidth) then
+          begin
+            tempPixel := PBGRAPixel(psrc + ppixel^.PtrOfs)^;
+            maskAlpha := ppixel^.Weight;
+            pixMaskAlpha := maskAlpha * tempPixel.alpha;
+            sumA    += pixMaskAlpha;
+            Adiv    += maskAlpha;
+            {$ifdef PARAM_MASKSHIFT}
+            pixMaskAlpha := pixMaskAlpha shr maskShift;
+            RGBdiv  += pixMaskAlpha;
+            {$endif}
+            {$hints off}
+            sumR    += tempPixel.red * pixMaskAlpha;
+            sumG    += tempPixel.green * pixMaskAlpha;
+            sumB    += tempPixel.blue * pixMaskAlpha;
+            {$hints on}
+          end;
+          inc(ppixel);
+        end;
+        //compute average
+        if (Adiv <= 0) {$ifdef PARAM_MASKSHIFT} or (RGBdiv <= 0) {$endif} then
+          pdest^ := BGRAPixelTransparent
+        else
+          pdest^ := computeAverage;
+      end;
+    end;
+    inc(bmpYBase);
   end;
   ADestination.InvalidateBitmap;

GraphicTest/Packages/bgrabitmap/csscolorconst.inc

-              r472
+              r494
+{$IFDEF INCLUDE_COLOR_CONST}
+{$UNDEF INCLUDE_COLOR_CONST}
+{=== Color definitions ===}
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+var
+  {* This is the value used for transparent pixels. In theory, any
+     color with alpha = 0 is transparent, however it is recommended to
+     use all other channels to zero as well. }
+  BGRAPixelTransparent: TBGRAPixel;
+  {* [#FFFFFF] White opaque }
+  BGRAWhite: TBGRAPixel;
+  {* [#000000] Black opaque }
+  BGRABlack: TBGRAPixel;
 const
+  {* This color [#000001] looks just like black. It is needed for drawing black
+     shapes using the ''Canvas'' property of ''TBGRABitmap''. This is a standard
+     ''TCanvas'' and when drawing with pure black (''clBlack''), there is no way to know if
+     something has been drawn or if it is transparent }
+  clBlackOpaque = TColor($010000);
+var
   //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);
+  VGABlack,VGAGray,VGASilver,VGAWhite,
+  VGAMaroon,VGARed,VGAPurple,VGAFuchsia,
+  VGAGreen,VGALime,VGAOlive,VGAYellow,
+  VGANavy,VGABlue,VGATeal,VGAAqua: TBGRAPixel;
   //Red colors
+  CSSIndianRed: TBGRAPixel = (blue: 92; green: 92; red: 205; alpha: 255);
+  CSSLightCoral: TBGRAPixel = (blue: 128; green: 128; red: 240; alpha: 255);
+  CSSSalmon: TBGRAPixel = (blue: 114; green: 128; red: 250; alpha: 255);
+  CSSDarkSalmon: TBGRAPixel = (blue: 122; green: 150; red: 233; alpha: 255);
+  CSSRed: TBGRAPixel = (blue: 0; green: 0; red: 255; alpha: 255);
+  CSSCrimson: TBGRAPixel = (blue: 60; green: 20; red: 220; alpha: 255);
+  CSSFireBrick: TBGRAPixel = (blue: 34; green: 34; red: 178; alpha: 255);
+  CSSDarkRed: TBGRAPixel = (blue: 0; green: 0; red: 139; alpha: 255);
+  CSSIndianRed,CSSLightCoral,CSSSalmon,CSSDarkSalmon,
+  CSSRed,CSSCrimson,CSSFireBrick,CSSDarkRed: TBGRAPixel;
   //Pink colors
+  CSSPink: TBGRAPixel = (blue: 203; green: 192; red: 255; alpha: 255);
+  CSSLightPink: TBGRAPixel = (blue: 193; green: 182; red: 255; alpha: 255);
+  CSSHotPink: TBGRAPixel = (blue: 180; green: 105; red: 255; alpha: 255);
+  CSSDeepPink: TBGRAPixel = (blue: 147; green: 20; red: 255; alpha: 255);
+  CSSMediumVioletRed: TBGRAPixel = (blue: 133; green: 21; red: 199; alpha: 255);
+  CSSPaleVioletRed: TBGRAPixel = (blue: 147; green: 112; red: 219; alpha: 255);
+  CSSPink,CSSLightPink,CSSHotPink,CSSDeepPink,
+  CSSMediumVioletRed,CSSPaleVioletRed: TBGRAPixel;
   //Orange colors
+  CSSLightSalmon: TBGRAPixel = (blue: 122; green: 160; red: 255; alpha: 255);
+  CSSCoral: TBGRAPixel = (blue: 80; green: 127; red: 255; alpha: 255);
+  CSSTomato: TBGRAPixel = (blue: 71; green: 99; red: 255; alpha: 255);
+  CSSOrangeRed: TBGRAPixel = (blue: 0; green: 69; red: 255; alpha: 255);
+  CSSDarkOrange: TBGRAPixel = (blue: 0; green: 140; red: 255; alpha: 255);
+  CSSOrange: TBGRAPixel = (blue: 0; green: 165; red: 255; alpha: 255);
+  CSSLightSalmon,CSSCoral,CSSTomato,CSSOrangeRed,
+  CSSDarkOrange,CSSOrange: TBGRAPixel;
   //Yellow colors
+  CSSGold: TBGRAPixel = (blue: 0; green: 215; red: 255; alpha: 255);
+  CSSYellow: TBGRAPixel = (blue: 0; green: 255; red: 255; alpha: 255);
+  CSSLightYellow: TBGRAPixel = (blue: 224; green: 255; red: 255; alpha: 255);
+  CSSLemonChiffon: TBGRAPixel = (blue: 205; green: 250; red: 255; alpha: 255);
+  CSSLightGoldenrodYellow: TBGRAPixel = (blue: 210; green: 250; red: 250; alpha: 255);
+  CSSPapayaWhip: TBGRAPixel = (blue: 213; green: 239; red: 255; alpha: 255);
+  CSSMoccasin: TBGRAPixel = (blue: 181; green: 228; red: 255; alpha: 255);
+  CSSPeachPuff: TBGRAPixel = (blue: 185; green: 218; red: 255; alpha: 255);
+  CSSPaleGoldenrod: TBGRAPixel = (blue: 170; green: 232; red: 238; alpha: 255);
+  CSSKhaki: TBGRAPixel = (blue: 140; green: 230; red: 240; alpha: 255);
+  CSSDarkKhaki: TBGRAPixel = (blue: 107; green: 183; red: 189; alpha: 255);
+  CSSGold,CSSYellow,CSSLightYellow,CSSLemonChiffon,
+  CSSLightGoldenrodYellow,CSSPapayaWhip,CSSMoccasin,CSSPeachPuff,
+  CSSPaleGoldenrod,CSSKhaki,CSSDarkKhaki: TBGRAPixel;
   //Purple colors
+  CSSLavender: TBGRAPixel = (blue: 250; green: 230; red: 230; alpha: 255);
+  CSSThistle: TBGRAPixel = (blue: 216; green: 191; red: 216; alpha: 255);
+  CSSPlum: TBGRAPixel = (blue: 221; green: 160; red: 221; alpha: 255);
+  CSSViolet: TBGRAPixel = (blue: 238; green: 130; red: 238; alpha: 255);
+  CSSOrchid: TBGRAPixel = (blue: 214; green: 112; red: 218; alpha: 255);
+  CSSFuchsia: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
+  CSSMagenta: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
+  CSSMediumOrchid: TBGRAPixel = (blue: 211; green: 85; red: 186; alpha: 255);
+  CSSMediumPurple: TBGRAPixel = (blue: 219; green: 112; red: 147; alpha: 255);
+  CSSBlueViolet: TBGRAPixel = (blue: 226; green: 43; red: 138; alpha: 255);
+  CSSDarkViolet: TBGRAPixel = (blue: 211; green: 0; red: 148; alpha: 255);
+  CSSDarkOrchid: TBGRAPixel = (blue: 204; green: 50; red: 153; alpha: 255);
+  CSSDarkMagenta: TBGRAPixel = (blue: 139; green: 0; red: 139; alpha: 255);
+  CSSPurple: TBGRAPixel = (blue: 128; green: 0; red: 128; alpha: 255);
+  CSSIndigo: TBGRAPixel = (blue: 130; green: 0; red: 75; alpha: 255);
+  CSSDarkSlateBlue: TBGRAPixel = (blue: 139; green: 61; red: 72; alpha: 255);
+  CSSSlateBlue: TBGRAPixel = (blue: 205; green: 90; red: 106; alpha: 255);
+  CSSMediumSlateBlue: TBGRAPixel = (blue: 238; green: 104; red: 123; alpha: 255);
+  CSSLavender,CSSThistle,CSSPlum,CSSViolet,
+  CSSOrchid,CSSFuchsia,CSSMagenta,CSSMediumOrchid,
+  CSSMediumPurple,CSSBlueViolet,CSSDarkViolet,CSSDarkOrchid,
+  CSSDarkMagenta,CSSPurple,CSSIndigo,CSSDarkSlateBlue,
+  CSSSlateBlue,CSSMediumSlateBlue: TBGRAPixel;
   //Green colors
+  CSSGreenYellow: TBGRAPixel = (blue: 47; green: 255; red: 173; alpha: 255);
+  CSSChartreuse: TBGRAPixel = (blue: 0; green: 255; red: 127; alpha: 255);
+  CSSLawnGreen: TBGRAPixel = (blue: 0; green: 252; red: 124; alpha: 255);
+  CSSLime: TBGRAPixel = (blue: 0; green: 255; red: 0; alpha: 255);
+  CSSLimeGreen: TBGRAPixel = (blue: 50; green: 205; red: 50; alpha: 255);
+  CSSPaleGreen: TBGRAPixel = (blue: 152; green: 251; red: 152; alpha: 255);
+  CSSLightGreen: TBGRAPixel = (blue: 144; green: 238; red: 144; alpha: 255);
+  CSSMediumSpringGreen: TBGRAPixel = (blue: 154; green: 250; red: 0; alpha: 255);
+  CSSSpringGreen: TBGRAPixel = (blue: 127; green: 255; red: 0; alpha: 255);
+  CSSMediumSeaGreen: TBGRAPixel = (blue: 113; green: 179; red: 60; alpha: 255);
+  CSSSeaGreen: TBGRAPixel = (blue: 87; green: 139; red: 46; alpha: 255);
+  CSSForestGreen: TBGRAPixel = (blue: 34; green: 139; red: 34; alpha: 255);
+  CSSGreen: TBGRAPixel = (blue: 0; green: 128; red: 0; alpha: 255);
+  CSSDarkGreen: TBGRAPixel = (blue: 0; green: 100; red: 0; alpha: 255);
+  CSSYellowGreen: TBGRAPixel = (blue: 50; green: 205; red: 154; alpha: 255);
+  CSSOliveDrab: TBGRAPixel = (blue: 35; green: 142; red: 107; alpha: 255);
+  CSSOlive: TBGRAPixel = (blue: 0; green: 128; red: 128; alpha: 255);
+  CSSDarkOliveGreen: TBGRAPixel = (blue: 47; green: 107; red: 85; alpha: 255);
+  CSSMediumAquamarine: TBGRAPixel = (blue: 170; green: 205; red: 102; alpha: 255);
+  CSSDarkSeaGreen: TBGRAPixel = (blue: 143; green: 188; red: 143; alpha: 255);
+  CSSLightSeaGreen: TBGRAPixel = (blue: 170; green: 178; red: 32; alpha: 255);
+  CSSDarkCyan: TBGRAPixel = (blue: 139; green: 139; red: 0; alpha: 255);
+  CSSTeal: TBGRAPixel = (blue: 128; green: 128; red: 0; alpha: 255);
+  CSSGreenYellow,CSSChartreuse,CSSLawnGreen,CSSLime,
+  CSSLimeGreen,CSSPaleGreen,CSSLightGreen,CSSMediumSpringGreen,
+  CSSSpringGreen,CSSMediumSeaGreen,CSSSeaGreen,CSSForestGreen,
+  CSSGreen,CSSDarkGreen,CSSYellowGreen,CSSOliveDrab,
+  CSSOlive,CSSDarkOliveGreen,CSSMediumAquamarine,CSSDarkSeaGreen,
+  CSSLightSeaGreen,CSSDarkCyan,CSSTeal: TBGRAPixel;
   //Blue/Cyan colors
+  CSSAqua: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
+  CSSCyan: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
+  CSSLightCyan: TBGRAPixel = (blue: 255; green: 255; red: 224; alpha: 255);
+  CSSPaleTurquoise: TBGRAPixel = (blue: 238; green: 238; red: 175; alpha: 255);
+  CSSAquamarine: TBGRAPixel = (blue: 212; green: 255; red: 127; alpha: 255);
+  CSSTurquoise: TBGRAPixel = (blue: 208; green: 224; red: 64; alpha: 255);
+  CSSMediumTurquoise: TBGRAPixel = (blue: 204; green: 209; red: 72; alpha: 255);
+  CSSDarkTurquoise: TBGRAPixel = (blue: 209; green: 206; red: 0; alpha: 255);
+  CSSCadetBlue: TBGRAPixel = (blue: 160; green: 158; red: 95; alpha: 255);
+  CSSSteelBlue: TBGRAPixel = (blue: 180; green: 130; red: 70; alpha: 255);
+  CSSLightSteelBlue: TBGRAPixel = (blue: 222; green: 196; red: 176; alpha: 255);
+  CSSPowderBlue: TBGRAPixel = (blue: 230; green: 224; red: 176; alpha: 255);
+  CSSLightBlue: TBGRAPixel = (blue: 230; green: 216; red: 173; alpha: 255);
+  CSSSkyBlue: TBGRAPixel = (blue: 235; green: 206; red: 135; alpha: 255);
+  CSSLightSkyBlue: TBGRAPixel = (blue: 250; green: 206; red: 135; alpha: 255);
+  CSSDeepSkyBlue: TBGRAPixel = (blue: 255; green: 191; red: 0; alpha: 255);
+  CSSDodgerBlue: TBGRAPixel = (blue: 255; green: 144; red: 30; alpha: 255);
+  CSSCornflowerBlue: TBGRAPixel = (blue: 237; green: 149; red: 100; alpha: 255);
+  CSSRoyalBlue: TBGRAPixel = (blue: 255; green: 105; red: 65; alpha: 255);
+  CSSBlue: TBGRAPixel = (blue: 255; green: 0; red: 0; alpha: 255);
+  CSSMediumBlue: TBGRAPixel = (blue: 205; green: 0; red: 0; alpha: 255);
+  CSSDarkBlue: TBGRAPixel = (blue: 139; green: 0; red: 0; alpha: 255);
+  CSSNavy: TBGRAPixel = (blue: 128; green: 0; red: 0; alpha: 255);
+  CSSMidnightBlue: TBGRAPixel = (blue: 112; green: 25; red: 25; alpha: 255);
+  CSSAqua,CSSCyan,CSSLightCyan,CSSPaleTurquoise,
+  CSSAquamarine,CSSTurquoise,CSSMediumTurquoise,CSSDarkTurquoise,
+  CSSCadetBlue,CSSSteelBlue,CSSLightSteelBlue,CSSPowderBlue,
+  CSSLightBlue,CSSSkyBlue,CSSLightSkyBlue,CSSDeepSkyBlue,
+  CSSDodgerBlue,CSSCornflowerBlue,CSSRoyalBlue,CSSBlue,
+  CSSMediumBlue,CSSDarkBlue,CSSNavy,CSSMidnightBlue: TBGRAPixel;
   //Brown colors
+  CSSCornsilk: TBGRAPixel = (blue: 220; green: 248; red: 255; alpha: 255);
+  CSSBlanchedAlmond: TBGRAPixel = (blue: 205; green: 235; red: 255; alpha: 255);
+  CSSBisque: TBGRAPixel = (blue: 196; green: 228; red: 255; alpha: 255);
+  CSSNavajoWhite: TBGRAPixel = (blue: 173; green: 222; red: 255; alpha: 255);
+  CSSWheat: TBGRAPixel = (blue: 179; green: 222; red: 245; alpha: 255);
+  CSSBurlyWood: TBGRAPixel = (blue: 135; green: 184; red: 222; alpha: 255);
+  CSSTan: TBGRAPixel = (blue: 140; green: 180; red: 210; alpha: 255);
+  CSSRosyBrown: TBGRAPixel = (blue: 143; green: 143; red: 188; alpha: 255);
+  CSSSandyBrown: TBGRAPixel = (blue: 96; green: 164; red: 244; alpha: 255);
+  CSSGoldenrod: TBGRAPixel = (blue: 32; green: 165; red: 218; alpha: 255);
+  CSSDarkGoldenrod: TBGRAPixel = (blue: 11; green: 134; red: 184; alpha: 255);
+  CSSPeru: TBGRAPixel = (blue: 63; green: 133; red: 205; alpha: 255);
+  CSSChocolate: TBGRAPixel = (blue: 30; green: 105; red: 210; alpha: 255);
+  CSSSaddleBrown: TBGRAPixel = (blue: 19; green: 69; red: 139; alpha: 255);
+  CSSSienna: TBGRAPixel = (blue: 45; green: 82; red: 160; alpha: 255);
+  CSSBrown: TBGRAPixel = (blue: 42; green: 42; red: 165; alpha: 255);
+  CSSMaroon: TBGRAPixel = (blue: 0; green: 0; red: 128; alpha: 255);
+  CSSCornsilk, CSSBlanchedAlmond, CSSBisque, CSSNavajoWhite,
+  CSSWheat, CSSBurlyWood, CSSTan, CSSRosyBrown,
+  CSSSandyBrown, CSSGoldenrod, CSSDarkGoldenrod, CSSPeru,
+  CSSChocolate, CSSSaddleBrown, CSSSienna, CSSBrown,
+  CSSMaroon: TBGRAPixel;
   //White colors
+  CSSWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
+  CSSSnow: TBGRAPixel = (blue: 250; green: 250; red: 255; alpha: 255);
+  CSSHoneydew: TBGRAPixel = (blue: 240; green: 255; red: 250; alpha: 255);
+  CSSMintCream: TBGRAPixel = (blue: 250; green: 255; red: 245; alpha: 255);
+  CSSAzure: TBGRAPixel = (blue: 255; green: 255; red: 240; alpha: 255);
+  CSSAliceBlue: TBGRAPixel = (blue: 255; green: 248; red: 240; alpha: 255);
+  CSSGhostWhite: TBGRAPixel = (blue: 255; green: 248; red: 248; alpha: 255);
+  CSSWhiteSmoke: TBGRAPixel = (blue: 245; green: 245; red: 245; alpha: 255);
+  CSSSeashell: TBGRAPixel = (blue: 255; green: 245; red: 238; alpha: 255);
+  CSSBeige: TBGRAPixel = (blue: 220; green: 245; red: 245; alpha: 255);
+  CSSOldLace: TBGRAPixel = (blue: 230; green: 245; red: 253; alpha: 255);
+  CSSFloralWhite: TBGRAPixel = (blue: 240; green: 250; red: 255; alpha: 255);
+  CSSIvory: TBGRAPixel = (blue: 240; green: 255; red: 255; alpha: 255);
+  CSSAntiqueWhite: TBGRAPixel = (blue: 215; green: 235; red: 250; alpha: 255);
+  CSSLinen: TBGRAPixel = (blue: 230; green: 240; red: 250; alpha: 255);
+  CSSLavenderBlush: TBGRAPixel = (blue: 245; green: 240; red: 255; alpha: 255);
+  CSSMistyRose: TBGRAPixel = (blue: 255; green: 228; red: 255; alpha: 255);
+  CSSWhite, CSSSnow, CSSHoneydew, CSSMintCream,
+  CSSAzure, CSSAliceBlue, CSSGhostWhite, CSSWhiteSmoke,
+  CSSSeashell, CSSBeige, CSSOldLace, CSSFloralWhite,
+  CSSIvory, CSSAntiqueWhite, CSSLinen, CSSLavenderBlush,
+  CSSMistyRose: TBGRAPixel;
   //Gray colors
+  CSSGainsboro: TBGRAPixel = (blue: 220; green: 220; red: 220; alpha: 255);
+  CSSLightGray: TBGRAPixel = (blue: 211; green: 211; red: 211; alpha: 255);
+  CSSSilver: TBGRAPixel = (blue: 192; green: 192; red: 192; alpha: 255);
+  CSSDarkGray: TBGRAPixel = (blue: 169; green: 169; red: 169; alpha: 255);
+  CSSGray: TBGRAPixel = (blue: 128; green: 128; red: 128; alpha: 255);
+  CSSDimGray: TBGRAPixel = (blue: 105; green: 105; red: 105; alpha: 255);
+  CSSLightSlateGray: TBGRAPixel = (blue: 153; green: 136; red: 119; alpha: 255);
+  CSSSlateGray: TBGRAPixel = (blue: 144; green: 128; red: 112; alpha: 255);
+  CSSDarkSlateGray: TBGRAPixel = (blue: 79; green: 79; red: 47; alpha: 255);
+  CSSBlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
+  CSSGainsboro, CSSLightGray, CSSSilver, CSSDarkGray,
+  CSSGray, CSSDimGray, CSSLightSlateGray, CSSSlateGray,
+  CSSDarkSlateGray, CSSBlack: TBGRAPixel;
+type
+  TBGRAColorDefinition = record
+    Name: string;
+    Color: TBGRAPixel;
+  end;
+  { TBGRAColorList }
+  {* Contains a fixed list of colors }
+  TBGRAColorList = class
+  protected
+    FFinished: boolean;
+    FNbColors: integer;
+    FColors: array of TBGRAColorDefinition;
+    function GetByIndex(Index: integer): TBGRAPixel;
+    function GetByName(Name: string): TBGRAPixel;
+    function GetName(Index: integer): string;
+    procedure Add(Name: string; out Color: TBGRAPixel; red,green,blue: byte); overload;
+  public
+    {** Creates an empty color list }
+    constructor Create;
+    {** Add a color to the list }
+    procedure Add(Name: string; const Color: TBGRAPixel);
+    {** Ends the color list and prevents further modifications }
+    procedure Finished;
+    {** Returns the index of a color with a given name }
+    function IndexOf(Name: string): integer;
+    {** Returns the index of a color. Colors are considered to match if
+        the difference is less than or equal to ''AMaxDiff'' }
+    function IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer;
+    {** Gets the color associated with a color name }
+    property ByName[Name: string]: TBGRAPixel read GetByName;
+    {** Gets the color at the specified index }
+    property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default;
+    {** Gets the name of the color at the specified index }
+    property Name[Index: integer]: string read GetName;
+    {** Gets the number of colors }
+    property Count: integer read FNbColors;
+  end;
+var
+  {* List of VGA colors:
+   * [#000000] Black, [#808080] Gray, [#C0C0C0] Silver, [#FFFFFF] White,
+   * [#800000] Maroon, [#FF0000] Red,  [#800080] Purple, [#FF00FF] Fuchsia,
+   * [#008000] Green,  [#00FF00] Lime, [#808000] Olive,  [#FFFF00] Yellow,
+   * [#000080] Navy,   [#0000FF] Blue, [#008080] Teal,   [#00FFFF] Aqua.
+   * Shortcut constants are provided: [#000000] ''VGABlack'', [#808080] ''VGAGray''... }
+  VGAColors: TBGRAColorList;
+  {* List of [http://www.w3schools.com/cssref/css_colornames.asp web colors].
+  Shortcut constants are provided: [#000000] ''CSSBlack'', [#FF0000] ''CSSRed''... }
+  CSSColors: TBGRAColorList;
+{------------------- string conversion ------------------------}
+{* Converts a ''TBGRAPixel'' value into a string, using color names provided in ''AColorList'', and
+   considering that a color matches in the color list if its difference is within ''AMaxDiff'' }
+function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; AMaxDiff: Word= 0): string;
+{* Converts a fully defined string into a ''TBGRAPixel'' value. Color names from ''VGAColors'' and ''CSSColors''
+   are used if there is an exact match }
+function StrToBGRA(str: string): TBGRAPixel;
+{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined or that
+   there is an error, ''DefaultColor'' is returned.
+   Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. }
+function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel;
+{* Converts a string into a ''TBGRAPixel'' value. If the value is not fully defined, missing channels (expressed with '?')
+   are filled with fallbackValues. You can check if there was an error with the provided boolean.
+   Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. }
+function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out error: boolean): TBGRAPixel;
+{* Converts a string into a ''TBGRAPixel'' value into ''parsedValue''. ''parsedValue'' is not changed if
+   some channels are missing (expressed with '?'). You can check if there was an error with the provided boolean.
+   Color names from ''VGAColors'' and ''CSSColors'' are used if there is an exact match. }
+procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean);
 {$ENDIF}
+{$IFDEF INCLUDE_COLOR_LIST}
+{$UNDEF INCLUDE_COLOR_LIST}
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+{ TBGRAColorList }
+function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[Index].Color;
+end;
+function TBGRAColorList.GetByName(Name: string): TBGRAPixel;
+var i: integer;
+begin
+  i := IndexOf(Name);
+  if i = -1 then
+    result := BGRAPixelTransparent
+  else
+    result := FColors[i].Color;
+end;
+function TBGRAColorList.GetName(Index: integer): string;
+begin
+  if (Index < 0) or (Index >= FNbColors) then
+    result := ''
+  else
+    result := FColors[Index].Name;
+end;
+procedure TBGRAColorList.Add(Name: string; out Color: TBGRAPixel; red, green,
+  blue: byte);
+begin
+  Color := BGRA(red,green,blue);
+  Add(Name,Color);
+end;
+constructor TBGRAColorList.Create;
+begin
+  FNbColors:= 0;
+  FColors := nil;
+  FFinished:= false;
+end;
+procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel);
+begin
+  if FFinished then
+    raise Exception.Create('This list is already finished');
+  if length(FColors) = FNbColors then
+    SetLength(FColors, FNbColors*2+1);
+  FColors[FNbColors].Name := Name;
+  FColors[FNbColors].Color := Color;
+  inc(FNbColors);
+end;
+procedure TBGRAColorList.Finished;
+begin
+  if FFinished then exit;
+  FFinished := true;
+  SetLength(FColors, FNbColors);
+end;
+function TBGRAColorList.IndexOf(Name: string): integer;
+var i: integer;
+begin
+  for i := 0 to FNbColors-1 do
+    if CompareText(Name, FColors[i].Name) = 0 then
+    begin
+      result := i;
+      exit;
+    end;
+  result := -1;
+end;
+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;
+{------------------- string conversion ---------------------------------}
+{ 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;
+type
+    arrayOfString = array of string;
+function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString;
+var idxOpen,start,cur: integer;
+begin
+    result := nil;
+    idxOpen := pos('(',str);
+    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
+       if str[cur] in[',',')'] then
+       begin
+         setlength(result,length(result)+1);
+         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
+      setlength(result,length(result)+1);
+      result[high(result)] := copy(str,start,length(str)-start+1);
+    end;
+end;
+function ParseColorValue(str: string; var flagError: boolean): byte;
+var pourcent,unclipped,{%H-}errPos: integer;
+begin
+  if str = '' then result := 0 else
+  begin
+    if str[length(str)]='%' then
+    begin
+      val(copy(str,1,length(str)-1),pourcent,errPos);
+      if errPos <> 0 then flagError := true;
+      if pourcent < 0 then result := 0 else
+      if pourcent > 100 then result := 255 else
+        result := pourcent*255 div 100;
+    end else
+    begin
+      val(str,unclipped,errPos);
+      if errPos <> 0 then flagError := true;
+      if unclipped < 0 then result := 0 else
+      if unclipped > 255 then result := 255 else
+        result := unclipped;
+    end;
+  end;
+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;
+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;
+    alphaF: single;
+    idx: integer;
+begin
+  str := Trim(str);
+  error := false;
+  if (str = '') or (str = '?') then
+  begin
+    missingValues := true;
+    exit;
+  end else
+    missingValues := false;
+  str := StringReplace(lowerCase(str),'grey','gray',[]);
+  //VGA color names
+  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
+    idx := CSSColors.IndexOf(str);
+    if idx <> -1 then
+    begin
+      parsedValue := CSSColors[idx];
+      exit;
+    end;
+    //CSS RGB notation
+    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,error);
+      if (length(values)=3) or (length(values)=4) then
+      begin
+        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
+          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
+          parsedValue.alpha := 255;
+      end else
+        error := true;
+      exit;
+    end;
+    //remove HTML notation header
+    if str[1]='#' then delete(str,1,1);
+    //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';
+    //hex notation
+    if length(str)=8 then
+    begin
+      if copy(str,1,2) <> '??' then
+      begin
+        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
+        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
+        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
+        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
+      if str[1] <> '?' then
+      begin
+        val('$'+str[1],parsedValue.red,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.red *= $11;
+      end else missingValues := true;
+      if str[2] <> '?' then
+      begin
+        val('$'+str[2],parsedValue.green,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.green *= $11;
+      end else missingValues := true;
+      if str[3] <> '?' then
+      begin
+        val('$'+str[3],parsedValue.blue,errPos);
+        if errPos <> 0 then error := true;
+        parsedValue.blue *= $11;
+      end else missingValues := true;
+      if str[4] <> '?' then
+      begin
+        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
+      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;
+function BlueGreenRedToBGRA(blue,green,red: byte): TBGRAPixel;
+begin
+  result := BGRA(red,green,blue);
+end;
+{$ENDIF}
+{$IFDEF INCLUDE_INIT}
+{$UNDEF INCLUDE_INIT}
+  BGRAPixelTransparent := BGRA(0,0,0,0);
+  BGRAWhite := BGRA(255,255,255);
+  BGRABlack := BGRA(0,0,0);
   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.Add('Black',VGABlack,0,0,0);
+  VGAColors.Add('Gray',VGAGray,128,128,128);
+  VGAColors.Add('Silver',VGASilver,192,192,192);
+  VGAColors.Add('White',VGAWhite,255,255,255);
+  VGAColors.Add('Maroon',VGAMaroon,128,0,0);
+  VGAColors.Add('Red',VGARed,255,0,0);
+  VGAColors.Add('Purple',VGAPurple,128,0,128);
+  VGAColors.Add('Fuchsia',VGAFuchsia,255,0,255);
+  VGAColors.Add('Green',VGAGreen,0,128,0);
+  VGAColors.Add('Lime',VGALime,0,255,0);
+  VGAColors.Add('Olive',VGAOlive,128,128,0);
+  VGAColors.Add('Yellow',VGAYellow,255,255,0);
+  VGAColors.Add('Navy',VGANavy,0,0,128);
+  VGAColors.Add('Blue',VGABlue,0,0,255);
+  VGAColors.Add('Teal',VGATeal,0,128,128);
+  VGAColors.Add('Aqua',VGAAqua,0,255,255);
   VGAColors.Finished;
+  //Red colors
+  CSSIndianRed:= BlueGreenRedToBGRA(92, 92, 205);
+  CSSLightCoral:= BlueGreenRedToBGRA(128, 128, 240);
+  CSSSalmon:= BlueGreenRedToBGRA(114, 128, 250);
+  CSSDarkSalmon:= BlueGreenRedToBGRA(122, 150, 233);
+  CSSRed:= BlueGreenRedToBGRA(0, 0, 255);
+  CSSCrimson:= BlueGreenRedToBGRA(60, 20, 220);
+  CSSFireBrick:= BlueGreenRedToBGRA(34, 34, 178);
+  CSSDarkRed:= BlueGreenRedToBGRA(0, 0, 139);
+  //Pink colors
+  CSSPink:= BlueGreenRedToBGRA(203, 192, 255);
+  CSSLightPink:= BlueGreenRedToBGRA(193, 182, 255);
+  CSSHotPink:= BlueGreenRedToBGRA(180, 105, 255);
+  CSSDeepPink:= BlueGreenRedToBGRA(147, 20, 255);
+  CSSMediumVioletRed:= BlueGreenRedToBGRA(133, 21, 199);
+  CSSPaleVioletRed:= BlueGreenRedToBGRA(147, 112, 219);
+  //Orange colors
+  CSSLightSalmon:= BlueGreenRedToBGRA(122, 160, 255);
+  CSSCoral:= BlueGreenRedToBGRA(80, 127, 255);
+  CSSTomato:= BlueGreenRedToBGRA(71, 99, 255);
+  CSSOrangeRed:= BlueGreenRedToBGRA(0, 69, 255);
+  CSSDarkOrange:= BlueGreenRedToBGRA(0, 140, 255);
+  CSSOrange:= BlueGreenRedToBGRA(0, 165, 255);
+  //Yellow colors
+  CSSGold:= BlueGreenRedToBGRA(0, 215, 255);
+  CSSYellow:= BlueGreenRedToBGRA(0, 255, 255);
+  CSSLightYellow:= BlueGreenRedToBGRA(224, 255, 255);
+  CSSLemonChiffon:= BlueGreenRedToBGRA(205, 250, 255);
+  CSSLightGoldenrodYellow:= BlueGreenRedToBGRA(210, 250, 250);
+  CSSPapayaWhip:= BlueGreenRedToBGRA(213, 239, 255);
+  CSSMoccasin:= BlueGreenRedToBGRA(181, 228, 255);
+  CSSPeachPuff:= BlueGreenRedToBGRA(185, 218, 255);
+  CSSPaleGoldenrod:= BlueGreenRedToBGRA(170, 232, 238);
+  CSSKhaki:= BlueGreenRedToBGRA(140, 230, 240);
+  CSSDarkKhaki:= BlueGreenRedToBGRA(107, 183, 189);
+  //Purple colors
+  CSSLavender:= BlueGreenRedToBGRA(250, 230, 230);
+  CSSThistle:= BlueGreenRedToBGRA(216, 191, 216);
+  CSSPlum:= BlueGreenRedToBGRA(221, 160, 221);
+  CSSViolet:= BlueGreenRedToBGRA(238, 130, 238);
+  CSSOrchid:= BlueGreenRedToBGRA(214, 112, 218);
+  CSSFuchsia:= BlueGreenRedToBGRA(255, 0, 255);
+  CSSMagenta:= BlueGreenRedToBGRA(255, 0, 255);
+  CSSMediumOrchid:= BlueGreenRedToBGRA(211, 85, 186);
+  CSSMediumPurple:= BlueGreenRedToBGRA(219, 112, 147);
+  CSSBlueViolet:= BlueGreenRedToBGRA(226, 43, 138);
+  CSSDarkViolet:= BlueGreenRedToBGRA(211, 0, 148);
+  CSSDarkOrchid:= BlueGreenRedToBGRA(204, 50, 153);
+  CSSDarkMagenta:= BlueGreenRedToBGRA(139, 0, 139);
+  CSSPurple:= BlueGreenRedToBGRA(128, 0, 128);
+  CSSIndigo:= BlueGreenRedToBGRA(130, 0, 75);
+  CSSDarkSlateBlue:= BlueGreenRedToBGRA(139, 61, 72);
+  CSSSlateBlue:= BlueGreenRedToBGRA(205, 90, 106);
+  CSSMediumSlateBlue:= BlueGreenRedToBGRA(238, 104, 123);
+  //Green colors
+  CSSGreenYellow:= BlueGreenRedToBGRA(47, 255, 173);
+  CSSChartreuse:= BlueGreenRedToBGRA(0, 255, 127);
+  CSSLawnGreen:= BlueGreenRedToBGRA(0, 252, 124);
+  CSSLime:= BlueGreenRedToBGRA(0, 255, 0);
+  CSSLimeGreen:= BlueGreenRedToBGRA(50, 205, 50);
+  CSSPaleGreen:= BlueGreenRedToBGRA(152, 251, 152);
+  CSSLightGreen:= BlueGreenRedToBGRA(144, 238, 144);
+  CSSMediumSpringGreen:= BlueGreenRedToBGRA(154, 250, 0);
+  CSSSpringGreen:= BlueGreenRedToBGRA(127, 255, 0);
+  CSSMediumSeaGreen:= BlueGreenRedToBGRA(113, 179, 60);
+  CSSSeaGreen:= BlueGreenRedToBGRA(87, 139, 46);
+  CSSForestGreen:= BlueGreenRedToBGRA(34, 139, 34);
+  CSSGreen:= BlueGreenRedToBGRA(0, 128, 0);
+  CSSDarkGreen:= BlueGreenRedToBGRA(0, 100, 0);
+  CSSYellowGreen:= BlueGreenRedToBGRA(50, 205, 154);
+  CSSOliveDrab:= BlueGreenRedToBGRA(35, 142, 107);
+  CSSOlive:= BlueGreenRedToBGRA(0, 128, 128);
+  CSSDarkOliveGreen:= BlueGreenRedToBGRA(47, 107, 85);
+  CSSMediumAquamarine:= BlueGreenRedToBGRA(170, 205, 102);
+  CSSDarkSeaGreen:= BlueGreenRedToBGRA(143, 188, 143);
+  CSSLightSeaGreen:= BlueGreenRedToBGRA(170, 178, 32);
+  CSSDarkCyan:= BlueGreenRedToBGRA(139, 139, 0);
+  CSSTeal:= BlueGreenRedToBGRA(128, 128, 0);
+  //Blue/Cyan colors
+  CSSAqua:= BlueGreenRedToBGRA(255, 255, 0);
+  CSSCyan:= BlueGreenRedToBGRA(255, 255, 0);
+  CSSLightCyan:= BlueGreenRedToBGRA(255, 255, 224);
+  CSSPaleTurquoise:= BlueGreenRedToBGRA(238, 238, 175);
+  CSSAquamarine:= BlueGreenRedToBGRA(212, 255, 127);
+  CSSTurquoise:= BlueGreenRedToBGRA(208, 224, 64);
+  CSSMediumTurquoise:= BlueGreenRedToBGRA(204, 209, 72);
+  CSSDarkTurquoise:= BlueGreenRedToBGRA(209, 206, 0);
+  CSSCadetBlue:= BlueGreenRedToBGRA(160, 158, 95);
+  CSSSteelBlue:= BlueGreenRedToBGRA(180, 130, 70);
+  CSSLightSteelBlue:= BlueGreenRedToBGRA(222, 196, 176);
+  CSSPowderBlue:= BlueGreenRedToBGRA(230, 224, 176);
+  CSSLightBlue:= BlueGreenRedToBGRA(230, 216, 173);
+  CSSSkyBlue:= BlueGreenRedToBGRA(235, 206, 135);
+  CSSLightSkyBlue:= BlueGreenRedToBGRA(250, 206, 135);
+  CSSDeepSkyBlue:= BlueGreenRedToBGRA(255, 191, 0);
+  CSSDodgerBlue:= BlueGreenRedToBGRA(255, 144, 30);
+  CSSCornflowerBlue:= BlueGreenRedToBGRA(237, 149, 100);
+  CSSRoyalBlue:= BlueGreenRedToBGRA(255, 105, 65);
+  CSSBlue:= BlueGreenRedToBGRA(255, 0, 0);
+  CSSMediumBlue:= BlueGreenRedToBGRA(205, 0, 0);
+  CSSDarkBlue:= BlueGreenRedToBGRA(139, 0, 0);
+  CSSNavy:= BlueGreenRedToBGRA(128, 0, 0);
+  CSSMidnightBlue:= BlueGreenRedToBGRA(112, 25, 25);
+  //Brown colors
+  CSSCornsilk:= BlueGreenRedToBGRA(220, 248, 255);
+  CSSBlanchedAlmond:= BlueGreenRedToBGRA(205, 235, 255);
+  CSSBisque:= BlueGreenRedToBGRA(196, 228, 255);
+  CSSNavajoWhite:= BlueGreenRedToBGRA(173, 222, 255);
+  CSSWheat:= BlueGreenRedToBGRA(179, 222, 245);
+  CSSBurlyWood:= BlueGreenRedToBGRA(135, 184, 222);
+  CSSTan:= BlueGreenRedToBGRA(140, 180, 210);
+  CSSRosyBrown:= BlueGreenRedToBGRA(143, 143, 188);
+  CSSSandyBrown:= BlueGreenRedToBGRA(96, 164, 244);
+  CSSGoldenrod:= BlueGreenRedToBGRA(32, 165, 218);
+  CSSDarkGoldenrod:= BlueGreenRedToBGRA(11, 134, 184);
+  CSSPeru:= BlueGreenRedToBGRA(63, 133, 205);
+  CSSChocolate:= BlueGreenRedToBGRA(30, 105, 210);
+  CSSSaddleBrown:= BlueGreenRedToBGRA(19, 69, 139);
+  CSSSienna:= BlueGreenRedToBGRA(45, 82, 160);
+  CSSBrown:= BlueGreenRedToBGRA(42, 42, 165);
+  CSSMaroon:= BlueGreenRedToBGRA(0, 0, 128);
+  //White colors
+  CSSWhite:= BlueGreenRedToBGRA(255, 255, 255);
+  CSSSnow:= BlueGreenRedToBGRA(250, 250, 255);
+  CSSHoneydew:= BlueGreenRedToBGRA(240, 255, 250);
+  CSSMintCream:= BlueGreenRedToBGRA(250, 255, 245);
+  CSSAzure:= BlueGreenRedToBGRA(255, 255, 240);
+  CSSAliceBlue:= BlueGreenRedToBGRA(255, 248, 240);
+  CSSGhostWhite:= BlueGreenRedToBGRA(255, 248, 248);
+  CSSWhiteSmoke:= BlueGreenRedToBGRA(245, 245, 245);
+  CSSSeashell:= BlueGreenRedToBGRA(255, 245, 238);
+  CSSBeige:= BlueGreenRedToBGRA(220, 245, 245);
+  CSSOldLace:= BlueGreenRedToBGRA(230, 245, 253);
+  CSSFloralWhite:= BlueGreenRedToBGRA(240, 250, 255);
+  CSSIvory:= BlueGreenRedToBGRA(240, 255, 255);
+  CSSAntiqueWhite:= BlueGreenRedToBGRA(215, 235, 250);
+  CSSLinen:= BlueGreenRedToBGRA(230, 240, 250);
+  CSSLavenderBlush:= BlueGreenRedToBGRA(245, 240, 255);
+  CSSMistyRose:= BlueGreenRedToBGRA(255, 228, 255);
+  //Gray colors
+  CSSGainsboro:= BlueGreenRedToBGRA(220, 220, 220);
+  CSSLightGray:= BlueGreenRedToBGRA(211, 211, 211);
+  CSSSilver:= BlueGreenRedToBGRA(192, 192, 192);
+  CSSDarkGray:= BlueGreenRedToBGRA(169, 169, 169);
+  CSSGray:= BlueGreenRedToBGRA(128, 128, 128);
+  CSSDimGray:= BlueGreenRedToBGRA(105, 105, 105);
+  CSSLightSlateGray:= BlueGreenRedToBGRA(153, 136, 119);
+  CSSSlateGray:= BlueGreenRedToBGRA(144, 128, 112);
+  CSSDarkSlateGray:= BlueGreenRedToBGRA(79, 79, 47);
+  CSSBlack:= BlueGreenRedToBGRA(0, 0, 0);
   CSSColors := TBGRAColorList.Create;
 …
 {$ENDIF}
+{$IFDEF INCLUDE_FINAL}
+{$UNDEF INCLUDE_FINAL}
+  CSSColors.Free;
+  VGAColors.Free;
+{$ENDIF}

GraphicTest/Packages/bgrabitmap/face3d.inc

-              r472
+              r494
        ColorOverride: boolean;
        TexCoordOverride: boolean;
+       ActualColor: TBGRAPixel;
+       ActualTexCoord: TPointF;
      end;
 …
     FVertices: packed array of TBGRAFaceVertexDescription;
     FVertexCount: integer;
     FTexture: IBGRAScanner;
+    FTexture, FActualTexture: IBGRAScanner;
     FMaterial: IBGRAMaterial3D;
+    FActualMaterial: TBGRAMaterial3D;
     FMaterialName: string;
     FParentTexture: boolean;
 …
     function GetVertexDescription(AIndex : integer): PBGRAFaceVertexDescription;
     procedure SetCustomFlags(AValue: DWord);
+    procedure ComputeActualVertexColor(AIndex: integer);
+    procedure ComputeActualTexCoord(AMinIndex, AMaxIndex: integer);
+    procedure UpdateTexture;
   public
     function GetObject3D: IBGRAObject3D;
     constructor Create(AObject3D: IBGRAObject3D; AVertices: array of IBGRAVertex3D);
     destructor Destroy; override;
+    procedure ComputeVertexColors;
+    procedure UpdateMaterial;
+    procedure FlipFace;
     function AddVertex(AVertex: IBGRAVertex3D): integer;
     function GetParentTexture: boolean;
 …
     property LightThroughFactorOverride: boolean read GetLightThroughFactorOverride write SetLightThroughFactorOverride;
     property Material: IBGRAMaterial3D read GetMaterial write SetMaterial;
+    property ActualMaterial: TBGRAMaterial3D read FActualMaterial;
+    property ActualTexture: IBGRAScanner read FActualTexture;
     property VertexDescription[AIndex : integer]: PBGRAFaceVertexDescription read GetVertexDescription;
     property CustomFlags: DWord read GetCustomFlags write SetCustomFlags;
 …
 begin
   FCustomFlags:= AValue;
+end;
+procedure TBGRAFace3D.ComputeActualVertexColor(AIndex: integer);
+begin
+  with FVertices[AIndex] do
+  begin
+    if ColorOverride then
+      ActualColor := Color
+    else
+    if Vertex.ParentColor then
+      ActualColor := FObject3D.Color
+    else
+      ActualColor := Vertex.Color;
+  end;
+end;
+procedure TBGRAFace3D.ComputeActualTexCoord(AMinIndex, AMaxIndex: integer);
+var
+  i: Integer;
+  zoom: TPointF;
+  m: IBGRAMaterial3D;
+begin
+  m := ActualMaterial;
+  if m <> nil then zoom := m.TextureZoom
+  else zoom := PointF(1,1);
+  for i := AMinIndex to AMaxIndex do
+    with FVertices[i] do
+    begin
+      if TexCoordOverride then
+        ActualTexCoord := TexCoord
+      else
+        ActualTexCoord := Vertex.TexCoord;
+      ActualTexCoord.x *= zoom.x;
+      ActualTexCoord.y *= zoom.y;
+    end;
+end;
+procedure TBGRAFace3D.UpdateTexture;
+begin
+  if FParentTexture then
+  begin
+    FActualTexture := nil;
+    if FActualMaterial <> nil then
+      FActualTexture := FActualMaterial.GetTexture;
+    if FActualTexture = nil then
+      FActualTexture := FObject3D.Texture
+  end
+  else
+    FActualTexture := FTexture;
 end;
 …
   i: Integer;
 begin
-  SetLength(FVertices, length(AVertices));
-  for i:= 0 to high(AVertices) do
-    AddVertex(AVertices[i]);
   FObject3D := AObject3D;
   FBiface := false;
 …
   FLightThroughFactor:= 0;
   FLightThroughFactorOverride:= false;
+  UpdateMaterial;
+  SetLength(FVertices, length(AVertices));
+  for i:= 0 to high(AVertices) do
+    AddVertex(AVertices[i]);
 end;
 destructor TBGRAFace3D.Destroy;
 begin
+  FMaterial := nil;
   fillchar(FTexture,sizeof(FTexture),0);
+  fillchar(FActualTexture,sizeof(FActualTexture),0);
   inherited Destroy;
+end;
+procedure TBGRAFace3D.ComputeVertexColors;
+var
+  i: Integer;
+begin
+  for i := 0 to FVertexCount-1 do
+    ComputeActualVertexColor(i);
+end;
+procedure TBGRAFace3D.UpdateMaterial;
+begin
+  if Material <> nil then
+    FActualMaterial := TBGRAMaterial3D(Material.GetAsObject)
+  else if FObject3D.Material <> nil then
+    FActualMaterial := TBGRAMaterial3D(FObject3D.Material.GetAsObject)
+  else if TBGRAScene3D(FObject3D.Scene).DefaultMaterial <> nil then
+    FActualMaterial := TBGRAMaterial3D(TBGRAScene3D(FObject3D.Scene).DefaultMaterial.GetAsObject);
+  UpdateTexture;
+  ComputeActualTexCoord(0,FVertexCount-1);
+end;
+procedure TBGRAFace3D.FlipFace;
+var i: integer;
+  temp: TBGRAFaceVertexDescription;
+begin
+  for i := 0 to (VertexCount div 2)-1 do
+  begin
+    temp := FVertices[i];
+    FVertices[i] := FVertices[VertexCount-1-i];
+    FVertices[VertexCount-1-i] := temp;
+  end;
 end;
 …
     Normal := nil;
   end;
+  ComputeActualVertexColor(result);
+  ComputeActualTexCoord(result,result);
   inc(FVertexCount);
 end;
 …
     raise Exception.Create('Index out of bounds');
   FVertices[AIndex].Vertex := AValue;
+  ComputeActualVertexColor(AIndex);
 end;
 …
   if (AIndex < 0) or (AIndex >= FVertexCount) then
     raise Exception.Create('Index out of bounds');
   result := FVertices[AIndex].Color;
+  result := FVertices[AIndex].ActualColor;
 end;
 …
 begin
   FParentTexture := AValue;
+  UpdateTexture;
 end;
 …
   FTexture := AValue;
   FParentTexture := false;
+  UpdateTexture;
 end;
 …
     ColorOverride := true;
   end;
+  ComputeActualVertexColor(AIndex);
 end;
 …
     raise Exception.Create('Index out of bounds');
   FVertices[AIndex].ColorOverride := AValue;
+  ComputeActualVertexColor(AIndex);
 end;
 …
   FVertices[AIndex].TexCoord := AValue;
   FVertices[AIndex].TexCoordOverride := true;
+  ComputeActualTexCoord(AIndex, AIndex);
 end;
 …
 procedure TBGRAFace3D.SetMaterial(const AValue: IBGRAMaterial3D);
 begin
+  FMaterial := AValue;
+  if AValue <> FMaterial then
+  begin
+    FMaterial := AValue;
+    UpdateMaterial;
+  end;
 end;
 …
   begin
     FMaterialName := AValue;
     FObject3D.Scene.UseMaterial(FMaterialName, self);
+    TBGRAScene3D(FObject3D.Scene).UseMaterial(FMaterialName, self);
   end;
 end;

GraphicTest/Packages/bgrabitmap/lightingclasses3d.inc

-              r472
+              r494
 type
-  { TBGRAMaterial3D }
-  TBGRAMaterial3D = class(TInterfacedObject, IBGRAMaterial3D)
-  private
-    FName: string;
-    FTexture: IBGRAScanner;
-    FAutoSimpleColor,FAutoAmbiantColor,FAutoDiffuseColor,FAutoSpecularColor: boolean;
-    FSimpleColorInt, FAmbiantColorInt, FDiffuseColorInt: TColorInt65536;
-    FDiffuseLightness: integer;
-    FTextureZoom: TPointF;
-    FSpecularColorInt: TColorInt65536;
-    FSpecularIndex: integer;
-    FSpecularOn: boolean;
-    FSaturationLowF: single;
-    FSaturationHighF: single;
-    FLightThroughFactor: single;
-    //phong precalc
-    FPowerTable: array of single;
-    FPowerTableSize, FPowerTableExp2: integer;
-    FPowerTableSizeF: single;
-    procedure UpdateSpecular;
-    procedure UpdateSimpleColor;
-    procedure ComputePowerTable;
-  public
-    constructor Create;
-    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 GetDiffuseColorInt: TColorInt65536;
-    function GetLightThroughFactor: single;
-    function GetSpecularColor: TBGRAPixel;
-    function GetSpecularColorF: TColorF;
-    function GetSpecularColorInt: TColorInt65536;
-    function GetSpecularIndex: integer;
-    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 SetDiffuseColorInt(const AValue: TColorInt65536);
-    procedure SetLightThroughFactor(const AValue: single);
-    procedure SetSpecularColor(const AValue: TBGRAPixel);
-    procedure SetSpecularColorF(const AValue: TColorF);
-    procedure SetSpecularColorInt(const AValue: TColorInt65536);
-    procedure SetSpecularIndex(const AValue: integer);
-    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;
-    function GetAsObject: TObject;
-    procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
-    procedure ComputeDiffuseColor(Context: PSceneLightingContext; const DiffuseIntensity: single; const ALightColor: TColorInt65536);
-    procedure ComputeDiffuseLightness(Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
-  end;
-{ TBGRAMaterial3D }
-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;
-procedure TBGRAMaterial3D.ComputePowerTable;
-var i: integer;
-    Exponent: single;
-begin
-  //exponent computed by squares
-  Exponent := 1;
-  FPowerTableExp2 := 0;
-  While Exponent*FPowerTableSize/16 < FSpecularIndex do
-  begin
-    Exponent *= 2;
-    Inc(FPowerTableExp2);
-  end;
-  //remaining exponent
-  setlength(FPowerTable,FPowerTableSize+3);
-  FPowerTable[0] := 0; //out of bound
-  FPowerTable[1] := 0; //image of zero
-  for i := 1 to FPowerTableSize do // ]0;1]
-    FPowerTable[i+1] := Exp(ln(i/(FPowerTableSize-1))*FSpecularIndex/Exponent);
-  FPowerTable[FPowerTableSize+2] := 1; //out of bound
-end;
-constructor TBGRAMaterial3D.Create;
-begin
-  SetAmbiantColorInt(ColorInt65536(65536,65536,65536));
-  SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
-  FSpecularIndex := 10;
-  SetSpecularColorInt(ColorInt65536(0,0,0));
-  FLightThroughFactor:= 0;
-  SetSaturationLow(2);
-  SetSaturationHigh(3);
-  FTexture := nil;
-  FTextureZoom := PointF(1,1);
-  FPowerTableSize := 128;
-  FPowerTableSizeF := FPowerTableSize;
-  FPowerTable := nil;
-end;
-destructor TBGRAMaterial3D.Destroy;
-begin
-  inherited Destroy;
-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
-  result := FAutoDiffuseColor;
-end;
-function TBGRAMaterial3D.GetAutoSpecularColor: boolean;
-begin
-  result := FAutoSpecularColor;
-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
-  result := ColorIntToBGRA(FDiffuseColorInt);
-end;
-function TBGRAMaterial3D.GetDiffuseColorF: TColorF;
-begin
-  result := ColorInt65536ToColorF(FDiffuseColorInt);
-end;
-function TBGRAMaterial3D.GetDiffuseColorInt: TColorInt65536;
-begin
-  result := FDiffuseColorInt;
-end;
-function TBGRAMaterial3D.GetLightThroughFactor: single;
-begin
-  result := FLightThroughFactor;
-end;
-function TBGRAMaterial3D.GetSpecularColor: TBGRAPixel;
-begin
-  result := ColorIntToBGRA(FSpecularColorInt);
-end;
-function TBGRAMaterial3D.GetSpecularColorF: TColorF;
-begin
-  result := ColorInt65536ToColorF(FSpecularColorInt);
-end;
-function TBGRAMaterial3D.GetSpecularColorInt: TColorInt65536;
-begin
-  result := FSpecularColorInt;
-end;
-function TBGRAMaterial3D.GetSpecularIndex: integer;
-begin
-  result := FSpecularIndex;
-end;
-function TBGRAMaterial3D.GetSaturationHigh: single;
-begin
-  result := FSaturationHighF;
-end;
-function TBGRAMaterial3D.GetSaturationLow: single;
-begin
-  result := FSaturationLowF;
-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
-  If AValue then
-    SetDiffuseColorInt(ColorInt65536(65536,65536,65536));
-end;
-procedure TBGRAMaterial3D.SetAutoSpecularColor(const AValue: boolean);
-begin
-  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;
-procedure TBGRAMaterial3D.SetDiffuseColor(const AValue: TBGRAPixel);
-begin
-  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;
-procedure TBGRAMaterial3D.SetDiffuseColorF(const AValue: TColorF);
-begin
-  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;
-procedure TBGRAMaterial3D.SetDiffuseColorInt(const AValue: TColorInt65536);
-begin
-  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;
-procedure TBGRAMaterial3D.SetLightThroughFactor(const AValue: single);
-begin
-  FLightThroughFactor:= AValue;
-end;
-procedure TBGRAMaterial3D.SetSpecularColor(const AValue: TBGRAPixel);
-begin
-  FSpecularColorInt := BGRAToColorInt(AValue);
-  UpdateSpecular;
-end;
-procedure TBGRAMaterial3D.SetSpecularColorF(const AValue: TColorF);
-begin
-  FSpecularColorInt := ColorFToColorInt65536(AValue);
-  UpdateSpecular;
-end;
-procedure TBGRAMaterial3D.SetSpecularColorInt(const AValue: TColorInt65536);
-begin
-  FSpecularColorInt := AValue;
-  UpdateSpecular;
-end;
-procedure TBGRAMaterial3D.SetSpecularIndex(const AValue: integer);
-begin
-  FSpecularIndex := AValue;
-  FPowerTable := nil;
-  UpdateSpecular;
-end;
-procedure TBGRAMaterial3D.SetSaturationHigh(const AValue: single);
-begin
-  FSaturationHighF:= AValue;
-end;
-procedure TBGRAMaterial3D.SetSaturationLow(const AValue: single);
-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;
-function TBGRAMaterial3D.GetSpecularOn: boolean;
-begin
-  result := FSpecularOn;
-end;
-function TBGRAMaterial3D.GetAsObject: TObject;
-begin
-  result := self;
-end;
-procedure TBGRAMaterial3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext; DiffuseIntensity, SpecularIntensity, SpecularCosine: single; const ALightColor: TColorInt65536);
-var
-  NH,PowerTablePos: single; //keep first for asm
-  NnH: single;
-  PowerTableFPos: single;
-  PowerTableIPos,i: integer;
-begin
-  if SpecularCosine <= 0 then
-    NnH := 0
-  else
-  if SpecularCosine >= 1 then
-    NnH := 1 else
-  begin
-    NH := SpecularCosine;
-    if FPowerTable = nil then ComputePowerTable;
-    {$IFDEF CPUI386} {$asmmode intel}
-    i := FPowerTableExp2;
-    if i > 0 then
-    begin
-      PowerTablePos := FPowerTableSize;
-      asm
-        db $d9,$45,$f0  //flds NH
-        mov ecx,i
-      @loop:
-        db $dc,$c8      //fmul st,st(0)
-        dec ecx
-        jnz @loop
-        db $d8,$4d,$ec  //fmuls PowerTablePos
-        db $d9,$5d,$ec  //fstps PowerTablePos
-      end;
-    end
-    else
-      PowerTablePos := NH*FPowerTableSize;
-    {$ELSE}
-    PowerTablePos := NH;
-    for i := FPowerTableExp2-1 downto 0 do
-      PowerTablePos := PowerTablePos*PowerTablePos;
-    PowerTablePos *= FPowerTableSize;
-    {$ENDIF}
-    PowerTableIPos := round(PowerTablePos+0.5);
-    PowerTableFPos := PowerTablePos-PowerTableIPos;
-    NnH := FPowerTable[PowerTableIPos]*(1-PowerTableFPos)+FPowerTable[PowerTableIPos+1]*PowerTableFPos;
-  end; //faster than NnH := exp(FSpecularIndex*ln(NH)); !
-  if FAutoDiffuseColor then
-    Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
-  else
-    Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
-  if FAutoSpecularColor then
-    Context^.specularColor += ALightColor*round(SpecularIntensity* NnH*65536)
-  else
-    Context^.specularColor += ALightColor*FSpecularColorInt*round(SpecularIntensity* NnH*65536);
-end;
-procedure TBGRAMaterial3D.ComputeDiffuseColor(Context: PSceneLightingContext;
-  const DiffuseIntensity: single; const ALightColor: TColorInt65536);
-begin
-  if FAutoDiffuseColor then
-    Context^.diffuseColor += ALightColor*round(DiffuseIntensity*65536)
-  else
-    Context^.diffuseColor += ALightColor*FDiffuseColorInt*round(DiffuseIntensity*65536);
-end;
-procedure TBGRAMaterial3D.ComputeDiffuseLightness(
-  Context: PSceneLightingContext; DiffuseLightnessTerm32768: integer; ALightLightness: integer);
-begin
-  if FAutoDiffuseColor then
-  begin
-    if ALightLightness <> 32768 then
-      Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness)
-    else
-      Context^.lightness += DiffuseLightnessTerm32768;
-  end else
-  begin
-    if FDiffuseLightness <> 32768 then
-      Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,CombineLightness(FDiffuseLightness,ALightLightness))
-    else
-      Context^.lightness += CombineLightness(DiffuseLightnessTerm32768,ALightLightness);
-  end;
-end;
-type
-  { TBGRALight3D }
-  TBGRALight3D = class(TInterfacedObject,IBGRALight3D)
-  protected
-    FMinIntensity: single;
-    FColorInt: TColorInt65536;
-    FViewVector : TPoint3D_128;
-    FLightness: integer;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure ComputeDiffuseLightness(Context: PSceneLightingContext); virtual; abstract;
-    procedure ComputeDiffuseColor(Context: PSceneLightingContext); virtual; abstract;
-    procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); virtual; abstract;
-    function GetLightnessF: single;
-    function GetColor: TBGRAPixel;
-    function GetColorF: TColorF;
-    function GetColorInt: TColorInt65536;
-    function GetAsObject: TObject;
-    procedure SetColor(const AValue: TBGRAPixel);
-    procedure SetColorF(const AValue: TColorF);
-    procedure SetColorInt(const AValue: TColorInt65536);
-    function GetColoredLight: boolean;
-    function GetMinIntensity: single;
-    procedure SetMinIntensity(const AValue: single);
-    function IsDirectional: boolean; virtual; abstract;
-  end;
   { TBGRADirectionalLight3D }
 …
   public
     constructor Create(ADirection: TPoint3D);
     function GetDirection: TPoint3D;
+    function GetDirection: TPoint3D; override;
     procedure SetDirection(const AValue: TPoint3D);
 …
   public
     constructor Create(AVertex: IBGRAVertex3D; AIntensity: single);
     function GetIntensity: single;
+    function GetIntensity: single; override;
     procedure SetIntensity(const AValue: single);
     function GetVertex: IBGRAVertex3D;
     procedure SetVertex(const AValue: IBGRAVertex3D);
+    function GetPosition: TPoint3D; override;
     procedure ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext); override;
 …
     function IsDirectional: boolean; override;
   end;
-{ TBGRALight3D }
-constructor TBGRALight3D.Create;
-begin
-  SetColorF(ColorF(1,1,1,1));
-  FViewVector := Point3D_128(0,0,-1);
-  FMinIntensity:= 0;
-end;
-destructor TBGRALight3D.Destroy;
-begin
-  inherited Destroy;
-end;
-function TBGRALight3D.GetLightnessF: single;
-begin
-  result := FLightness/32768;
-end;
-function TBGRALight3D.GetColor: TBGRAPixel;
-begin
-  result := ColorIntToBGRA(FColorInt);
-end;
-function TBGRALight3D.GetColorF: TColorF;
-begin
-  result := ColorInt65536ToColorF(FColorInt);
-end;
-function TBGRALight3D.GetColorInt: TColorInt65536;
-begin
-  result := FColorInt;
-end;
-function TBGRALight3D.GetAsObject: TObject;
-begin
-  result := self;
-end;
-procedure TBGRALight3D.SetColor(const AValue: TBGRAPixel);
-begin
-  SetColorInt(BGRAToColorInt(AValue));
-end;
-procedure TBGRALight3D.SetColorF(const AValue: TColorF);
-begin
-  SetColorInt(ColorFToColorInt65536(AValue));
-end;
-procedure TBGRALight3D.SetColorInt(const AValue: TColorInt65536);
-begin
-  FColorInt := AValue;
-  FLightness:= (AValue.r+AValue.g+AValue.b) div 6;
-end;
-function TBGRALight3D.GetColoredLight: boolean;
-begin
-  result := (FColorInt.r <> FColorInt.g) or (FColorInt.g <> FColorInt.b);
-end;
-function TBGRALight3D.GetMinIntensity: single;
-begin
-  result := FMinIntensity;
-end;
-procedure TBGRALight3D.SetMinIntensity(const AValue: single);
-begin
-  FMinIntensity := AValue;
-end;
 { TBGRAPointLight3D }
 …
 end;
+function TBGRAPointLight3D.GetPosition: TPoint3D;
+begin
+  Result:= FVertex.GetViewCoord;
+end;
 procedure TBGRAPointLight3D.ComputeDiffuseAndSpecularColor(Context: PSceneLightingContext);
   {$DEFINE PARAM_POINTLIGHT}
 …
   else
   begin
     intensity := (DotProduct3D_128(vect, Context^.basic.Normal))/(dist2*sqrt(dist2))*FIntensity;
+    intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity;
     if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor;
     if intensity > 100 then intensity := 100;
 …
 end;
+procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext
+  );
+procedure TBGRAPointLight3D.ComputeDiffuseColor(Context: PSceneLightingContext);
 var
   vect: TPoint3D_128;
 …
   else
   begin
     intensity := (DotProduct3D_128(vect, Context^.basic.Normal))/(dist2*sqrt(dist2))*FIntensity;
+    intensity := DotProduct3D_128(vect, Context^.basic.Normal)/(dist2*sqrt(dist2))*FIntensity;
     if Context^.LightThrough and (intensity < 0) then intensity := -intensity*Context^.LightThroughFactor;
     if intensity > 100 then intensity := 100;

GraphicTest/Packages/bgrabitmap/object3d.inc

-              r472
+              r494
 { TBGRAObject3D }
 …
   FLight := 1;
   FTexture := nil;
   FMainPart := TBGRAPart3D.Create(nil);
+  FMainPart := TBGRAPart3D.Create(self,nil);
   FLightingNormal:= AScene.DefaultLightingNormal;
   FParentLighting:= True;
   FScene := AScene;
+  FFaceColorsInvalidated := true;
+  FMaterialInvalidated := false;
 end;
 destructor TBGRAObject3D.Destroy;
 begin
+  FMaterial := nil;
   fillchar(FTexture,sizeof(FTexture),0);
   inherited Destroy;
 …
 end;
+procedure TBGRAObject3D.InvalidateColor;
+begin
+  FFaceColorsInvalidated := true;
+end;
+procedure TBGRAObject3D.InvalidateMaterial;
+begin
+  FMaterialInvalidated := true;
+end;
 function TBGRAObject3D.GetColor: TBGRAPixel;
 begin
 …
   FColor := AValue;
   FTexture := nil;
+  InvalidateColor;
 end;
 …
 begin
   FTexture := AValue;
+  InvalidateMaterial;
 end;
 …
 begin
   FMaterial := AValue;
+  InvalidateMaterial;
 end;
 …
 end;
 function TBGRAObject3D.GetScene: TBGRAScene3D;
+function TBGRAObject3D.GetScene: TObject;
 begin
   result := FScene;
 …
   for i := 0 to GetFaceCount-1 do
     ACallback(GetFace(i));
+end;
+procedure TBGRAObject3D.Update;
+var
+  i: Integer;
+begin
+  if FParentLighting and (FLightingNormal <> FScene.DefaultLightingNormal) then
+    FLightingNormal := FScene.DefaultLightingNormal;
+  if FFaceColorsInvalidated then
+  begin
+    for i := 0 to FFaceCount-1 do
+      FFaces[i].ComputeVertexColors;
+    FFaceColorsInvalidated := false;
+  end;
+  if FMaterialInvalidated then
+  begin
+    for i := 0 to FFaceCount-1 do
+      FFaces[i].UpdateMaterial;
+    FMaterialInvalidated := false;
+  end;
 end;

GraphicTest/Packages/bgrabitmap/paletteformats.inc

-              r472
+              r494
   function ReadInt16: int16;
   begin
+    AStream.Read({%H-}result, sizeof(result));
+    {$PUSH}{$HINTS OFF}
+    AStream.Read(result, sizeof(result));
+    {$POP}
     result := BEtoN(result);
   end;
   function ReadInt32: int32;
   begin
+    AStream.Read({%H-}result, sizeof(result));
+    {$PUSH}{$HINTS OFF}
+    AStream.Read(result, sizeof(result));
+    {$POP}
     result := BEtoN(result);
   end;
 …
   function ReadSingle: single;
   begin
+    AStream.Read({%H-}Result, sizeof(result));
+    {$PUSH}{$HINTS OFF}
+    AStream.Read(Result, sizeof(result));
+    {$POP}
     DWord(Result) := BEtoN(DWord(Result));
   end;

GraphicTest/Packages/bgrabitmap/part3d.inc

-              r472
+              r494
     FCoordPool: TBGRACoordPool3D;
     FNormalPool: TBGRANormalPool3D;
+    FObject3D: TBGRAObject3D;
   public
     constructor Create(AContainer: IBGRAPart3D);
+    constructor Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D);
     destructor Destroy; override;
     procedure Clear(ARecursive: boolean);
 …
 end;
+constructor TBGRAPart3D.Create(AContainer: IBGRAPart3D);
+begin
+constructor TBGRAPart3D.Create(AObject3D: TBGRAObject3D; AContainer: IBGRAPart3D);
+begin
+  FObject3D := AObject3D;
   FContainer := AContainer;
   FMatrix := MatrixIdentity3D;
 …
   FVertexCount := 0;
   if FCoordPool.UsedCapacity > 0 then
     raise Exception.Create('Coordinate pool still used');
+    raise Exception.Create('Coordinate pool still used. Please set vertex references to nil before destroying the scene.');
   FreeAndNil(FCoordPool);
   if Assigned(FNormalPool) then
 …
 function TBGRAPart3D.Add(x, y, z: single): IBGRAVertex3D;
 begin
   result := TBGRAVertex3D.Create(FCoordPool,Point3D(x,y,z));
+  result := TBGRAVertex3D.Create(FObject3D,FCoordPool,Point3D(x,y,z));
   Add(result);
 end;
 …
 function TBGRAPart3D.Add(pt: TPoint3D): IBGRAVertex3D;
 begin
   result := TBGRAVertex3D.Create(FCoordPool,pt);
+  result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt);
   Add(result);
 end;
 …
 function TBGRAPart3D.Add(pt: TPoint3D; normal: TPoint3D): IBGRAVertex3D;
 begin
   result := TBGRAVertex3D.Create(FCoordPool,pt);
+  result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt);
   result.CustomNormal := normal;
   Add(result);
 …
 function TBGRAPart3D.Add(pt: TPoint3D_128): IBGRAVertex3D;
 begin
   result := TBGRAVertex3D.Create(FCoordPool,pt);
+  result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt);
   Add(result);
 end;
 …
 function TBGRAPart3D.Add(pt: TPoint3D_128; normal: TPoint3D_128): IBGRAVertex3D;
 begin
   result := TBGRAVertex3D.Create(FCoordPool,pt);
+  result := TBGRAVertex3D.Create(FObject3D,FCoordPool,pt);
   result.CustomNormal := Point3D(normal);
   Add(result);
 …
   setlength(result, length(pts));
   for i := 0 to high(pts) do
     result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
+    result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]);
   Add(result);
 end;
 …
   setlength(result, length(pts));
   for i := 0 to high(pts) do
     result[i] := TBGRAVertex3D.Create(FCoordPool,pts[i]);
+    result[i] := TBGRAVertex3D.Create(FObject3D,FCoordPool,pts[i]);
   Add(result);
 end;
 …
 end;
+{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607
 procedure TBGRAPart3D.ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
 var
 …
     FParts[i].ComputeWithMatrix(Composed,AProjection);
 end;
+{$POP}
 function TBGRAPart3D.ComputeCoordinate(var ASceneCoord: TPoint3D_128; const AProjection: TProjection3D): TPointF;
 …
   if FPartCount = length(FParts) then
     setlength(FParts, FPartCount*2+1);
   result := TBGRAPart3D.Create(self);
+  result := TBGRAPart3D.Create(FObject3D,self);
   FParts[FPartCount] := result;
   inc(FPartCount);

GraphicTest/Packages/bgrabitmap/phonglight.inc

-              r472
+              r494
 var
   {%H-}dist2,LdotN,NdotH,lightEnergy,diffuse : single;
-const
-  minus_05 = -0.5;
 begin
   {$IFDEF BGRASSE_AVAILABLE}If UseSSE then
 …
   end;
-  if LdotN < minus_05 then NdotH := 0 else
-  if LdotN < 0 then
-  begin
-    NdotH := NdotH*(LdotN-minus_05);
-    NdotH += NdotH;
-  end;
   {$IFDEF PARAM_POINTLIGHT}
   if dist2 = 0 then
 …
   diffuse := LdotN;
   {$ENDIF}
+  if diffuse < FMinIntensity then diffuse:= FMinIntensity;
   if Context^.LightThrough and (diffuse < 0) then diffuse := -diffuse*Context^.LightThroughFactor;

GraphicTest/Packages/bgrabitmap/polyaliaspersp.inc

-              r472
+              r494
 begin
   If not polyInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := polyInfo.CreateIntersectionArray;
 …
 begin
   If not polyInfo.ComputeMinMax(minx,miny,maxx,maxy,bmp) then exit;
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
   inter := polyInfo.CreateIntersectionArray;

GraphicTest/Packages/bgrabitmap/readme.txt

-              r472
+              r494
 BGRABitmap - Drawing routines with alpha blending and antialiasing with Lazarus.
+BGRABitmap - Drawing routines with transparency and antialiasing with Lazarus. Offers also various transforms.
 These routines allow to manipulate 32bit images in BGRA format.
+These routines allow to manipulate 32bit images in BGRA format or RGBA format (depending on the platform).
 This code is under modified LGPL (see COPYING.modifiedLGPL.txt). This means that you can link this library inside your programs for any purpose. Only the included part of the code must remain LGPL.

GraphicTest/Packages/bgrabitmap/unzipperext.pas

r472	r494
31	31	implementation
32	32
33		uses ~~lazutf8classes~~;
	33	uses BGRAUTF8;
34	34
35	35	{ TUnzipperStreamUtf8 }

GraphicTest/Packages/bgrabitmap/vertex3d.inc

-              r472
+              r494
 type
+  { TBGRAObject3D }
+  TBGRAObject3D = class(TInterfacedObject,IBGRAObject3D)
+  private
+    FColor: TBGRAPixel;
+    FLight: Single;
+    FTexture: IBGRAScanner;
+    FMainPart: IBGRAPart3D;
+    FFaces: array of IBGRAFace3D;
+    FFaceCount: integer;
+    FLightingNormal : TLightingNormal3D;
+    FParentLighting: boolean;
+    FMaterial: IBGRAMaterial3D;
+    FScene: TBGRAScene3D;
+    FFaceColorsInvalidated,
+    FMaterialInvalidated: boolean;
+    procedure AddFace(AFace: IBGRAFace3D);
+  public
+    constructor Create(AScene: TBGRAScene3D);
+    destructor Destroy; override;
+    procedure Clear;
+    procedure InvalidateColor;
+    procedure InvalidateMaterial;
+    function AddFace(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
+    function AddFace(const AVertices: array of IBGRAVertex3D; ABiface: boolean): IBGRAFace3D;
+    function AddFace(const AVertices: array of IBGRAVertex3D; ATexture: IBGRAScanner): IBGRAFace3D;
+    function AddFace(const AVertices: array of IBGRAVertex3D; AColor: TBGRAPixel): IBGRAFace3D;
+    function AddFace(const AVertices: array of IBGRAVertex3D; AColors: array of TBGRAPixel): IBGRAFace3D;
+    function AddFaceReversed(const AVertices: array of IBGRAVertex3D): IBGRAFace3D;
+    procedure ComputeWithMatrix(constref AMatrix: TMatrix3D; constref AProjection: TProjection3D);
+    function GetColor: TBGRAPixel;
+    function GetLight: Single;
+    function GetTexture: IBGRAScanner;
+    function GetMainPart: IBGRAPart3D;
+    function GetLightingNormal: TLightingNormal3D;
+    function GetParentLighting: boolean;
+    function GetFace(AIndex: integer): IBGRAFace3D;
+    function GetFaceCount: integer;
+    function GetTotalVertexCount: integer;
+    function GetTotalNormalCount: integer;
+    function GetMaterial: IBGRAMaterial3D;
+    procedure SetLightingNormal(const AValue: TLightingNormal3D);
+    procedure SetParentLighting(const AValue: boolean);
+    procedure SetColor(const AValue: TBGRAPixel);
+    procedure SetLight(const AValue: Single);
+    procedure SetTexture(const AValue: IBGRAScanner);
+    procedure SetMaterial(const AValue: IBGRAMaterial3D);
+    procedure RemoveUnusedVertices;
+    procedure SeparatePart(APart: IBGRAPart3D);
+    function GetScene: TObject;
+    function GetRefCount: integer;
+    procedure SetBiface(AValue : boolean);
+    procedure ForEachVertex(ACallback: TVertex3DCallback);
+    procedure ForEachFace(ACallback: TFace3DCallback);
+    procedure Update;
+  end;
   { TBGRAVertex3D }
 …
     FCoordPoolIndex: integer;
     FCustomFlags: DWord;
+    FObject3D: TBGRAObject3D;
     function GetCoordData: PBGRACoordData3D;
     procedure Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+    procedure Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
   public
     constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload;
     constructor Create(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload;
+    constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D); overload;
+    constructor Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128); overload;
     destructor Destroy; override;
     function GetColor: TBGRAPixel;
 …
 { TBGRAVertex3D }
+procedure TBGRAVertex3D.Init(ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+begin
+procedure TBGRAVertex3D.Init(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+begin
+  FObject3D := AObject3D;
   FCoordPool := ACoordPool;
   FCoordPoolIndex := FCoordPool.Add;
 …
 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);
+constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D);
+begin
+  Init(AObject3D, ACoordPool, Point3D_128(ASceneCoord));
+end;
+constructor TBGRAVertex3D.Create(AObject3D: TBGRAObject3D; ACoordPool: TBGRACoordPool3D; ASceneCoord: TPoint3D_128);
+begin
+  Init(AObject3D, ACoordPool, ASceneCoord);
 end;
 …
   FColor := AValue;
   FParentColor := false;
+  FObject3D.InvalidateColor;
 end;
 …
 begin
   FParentColor := AValue;
+  FObject3D.InvalidateColor;
 end;

Context Navigation

Legend:

Download in other formats: