Ignore:
Timestamp:
Feb 1, 2012, 3:02:33 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package to version 5.5.
  • Modified: Removed draw method ComboBox and reorganized method list to single listview with using ownerdraw facility.
  • Added: New draw method TBitmap.RawImage.Data Move which use fast Move operation. It requires same pixel format.
  • Added: New draw method Dummy for comparion of empty method and to determine possibily max frame rate limit.
Location:
GraphicTest/BGRABitmap
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/BGRABitmap

    • Property svn:ignore set to
      lib

  • GraphicTest/BGRABitmap/bgradefaultbitmap.pas

    r210 r317  
    2929interface
    3030
     31{ This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines,
     32  and call functions from other units to perform advanced drawing functions. }
     33
    3134uses
    32   Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType;
     35  Classes, SysUtils, Types, FPImage, Graphics, BGRABitmapTypes, GraphType, FPImgCanv, BGRACanvas, BGRACanvas2D, FPWritePng;
    3336
    3437type
    35   TBGRADefaultBitmap = class;
    36   TBGRABitmapAny     = class of TBGRADefaultBitmap;
    37 
    3838  { TBGRADefaultBitmap }
    3939
    40   TBGRADefaultBitmap = class(TFPCustomImage)
     40  TBGRADefaultBitmap = class(TBGRACustomBitmap)
    4141  private
    42     FEraseMode: boolean;
    43     FBitmapModified: boolean; //if TBitmap has changed
    44     FFontHeightSign: integer;
    45     FFont: TFont;
     42    { Bounds checking which are shared by drawing functions. These functions check
     43      if the coordinates are visible and return true if it is the case, swap
     44      coordinates if necessary and make them fit into the clipping rectangle }
     45    function CheckHorizLineBounds(var x, y, x2: integer): boolean; inline;
     46    function CheckVertLineBounds(var x, y, y2: integer; out delta: integer): boolean; inline;
     47    function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline;
     48    function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean; inline;
     49    function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer): boolean; inline;
     50    function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean;
     51    function GetCanvasBGRA: TBGRACanvas;
     52    function GetCanvas2D: TBGRACanvas2D;
     53  protected
     54    FRefCount: integer; //reference counter (not related to interface reference counter)
     55
     56    //Pixel data
     57    FData:      PBGRAPixel;              //pointer to pixels
     58    FWidth, FHeight, FNbPixels: integer; //dimensions
     59    FDataModified: boolean;              //if data image has changed so TBitmap should be updated
     60    FLineOrder: TRawImageLineOrder;
     61    FClipRect:  TRect;                   //clipping (can be the whole image if there is no clipping)
     62
     63    //Scan
     64    FScanPtr : PBGRAPixel;          //current scan address
     65    FScanCurX,FScanCurY: integer;   //current scan coordinates
     66
     67    //LCL bitmap object
     68    FBitmap:   TBitmap;
     69    FBitmapModified: boolean;         //if TBitmap has changed so pixel data should be updated
     70    FCanvasOpacity: byte;             //opacity used with standard canvas functions
     71    FAlphaCorrectionNeeded: boolean;  //the alpha channel is not correct because standard functions do not
     72                                      //take it into account
     73
     74    //FreePascal drawing routines
     75    FCanvasFP: TFPImageCanvas;
     76    FCanvasDrawModeFP: TDrawMode;
     77    FCanvasPixelProcFP: procedure(x, y: integer; col: TBGRAPixel) of object;
     78
     79    //canvas-like with antialiasing and texturing
     80    FCanvasBGRA: TBGRACanvas;
     81    FCanvas2D: TBGRACanvas2D;
     82
     83    //drawing options
     84    FEraseMode: boolean;      //when polygons are erased instead of drawn
     85    FFont: TFont;             //font parameters
    4686    FFontHeight: integer;
    47     function GetCanvasAlphaCorrection: boolean;
    48     procedure SetCanvasAlphaCorrection(const AValue: boolean);
    49     procedure UpdateFont;
    50     procedure SetFontHeight(AHeight: integer);
     87    FFontHeightSign: integer; //sign correction
     88
     89    { Pen style can be defined by PenStyle property of by CustomPenStyle property.
     90      When PenStyle property is assigned, CustomPenStyle property is assigned the actual
     91      pen pattern. }
     92    FCustomPenStyle:  TBGRAPenStyle;
     93    FPenStyle: TPenStyle;
     94
     95    //Pixel data
     96    function GetRefCount: integer; override;
     97    function GetScanLine(y: integer): PBGRAPixel; override; //don't forget to call InvalidateBitmap after modifications
     98    function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
     99      AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean;
     100    function GetDataPtr: PBGRAPixel; override;
     101    procedure ClearTransparentPixels;
    51102    function GetScanlineFast(y: integer): PBGRAPixel; inline;
    52   protected
    53     FBitmap:   TBitmap; //LCL bitmap object
    54     FRefCount: integer; //reference counter
    55 
    56     {Pixel data}
    57     FData:      PBGRAPixel;
    58     FWidth, FHeight, FNbPixels: integer;
    59     FDataModified: boolean; //if data image has changed
    60     FLineOrder: TRawImageLineOrder;
    61     FCanvasOpacity: byte;
    62     FAlphaCorrectionNeeded: boolean;
    63 
    64     function GetScanLine(y: integer): PBGRAPixel;
    65     //don't forget to call InvalidateBitmap after modifications
    66     function GetBitmap: TBitmap;
    67     function GetCanvas: TCanvas;
     103    function GetLineOrder: TRawImageLineOrder; override;
     104    function GetNbPixels: integer; override;
     105    function GetWidth: integer; override;
     106    function GetHeight: integer; override;
     107
     108    //LCL bitmap object
     109    function GetBitmap: TBitmap; override;
     110    function GetCanvas: TCanvas; override;
    68111    procedure DiscardBitmapChange; inline;
    69     procedure LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
    70       AlwaysReplaceAlpha: boolean = False);
     112    procedure DoAlphaCorrection;
     113    procedure SetCanvasOpacity(AValue: byte); override;
     114    function GetCanvasOpacity: byte; override;
     115    function GetCanvasAlphaCorrection: boolean; override;
     116    procedure SetCanvasAlphaCorrection(const AValue: boolean); override;
     117
     118    //FreePascal drawing routines
     119    function GetCanvasFP: TFPImageCanvas; override;
     120    procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override;
     121    function GetCanvasDrawModeFP: TDrawMode; override;
    71122
    72123    {Allocation routines}
    … …  
    78129
    79130    procedure Init; virtual;
     131
    80132    {TFPCustomImage}
    81133    procedure SetInternalColor(x, y: integer; const Value: TFPColor); override;
    … …  
    84136    function GetInternalPixel(x, y: integer): integer; override;
    85137
    86     {resample}
    87     function FineResample(NewWidth, NewHeight: integer): TBGRADefaultBitmap;
    88     function SimpleStretch(NewWidth, NewHeight: integer): TBGRADefaultBitmap;
    89 
    90     function CheckEmpty: boolean;
    91     function GetHasTransparentPixels: boolean;
    92     function GetAverageColor: TColor;
    93     function GetAveragePixel: TBGRAPixel;
    94     procedure SetCanvasOpacity(AValue: byte);
    95     function GetDataPtr: PBGRAPixel;
    96     procedure DoAlphaCorrection;
    97     procedure ClearTransparentPixels;
    98 
    99     {Spline}
    100     function Spline(y0, y1, y2, y3: single; t: single): single;
     138    {Image functions}
     139    function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap;
     140    function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap;
     141    function CheckEmpty: boolean; override;
     142    function GetHasTransparentPixels: boolean; override;
     143    function GetAverageColor: TColor; override;
     144    function GetAveragePixel: TBGRAPixel; override;
     145    function CreateAdaptedPngWriter: TFPWriterPNG;
     146    function LoadAsBmp32(Str: TStream): boolean; override;
     147
     148    //drawing
     149    function GetCustomPenStyle: TBGRAPenStyle; override;
     150    procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override;
     151    procedure SetPenStyle(const AValue: TPenStyle); override;
     152    function GetPenStyle: TPenStyle; override;
     153
     154    procedure UpdateFont;
     155    function GetFontHeight: integer; override;
     156    procedure SetFontHeight(AHeight: integer); override;
     157    function GetFontFullHeight: integer; override;
     158    procedure SetFontFullHeight(AHeight: integer); override;
     159    function GetFontPixelMetric: TFontPixelMetric; override;
     160
     161    function GetClipRect: TRect; override;
     162    procedure SetClipRect(const AValue: TRect); override;
    101163
    102164  public
    103     Caption:   string;
    104     FontName:  string;
    105     FontStyle: TFontStyles;
    106 
    107165    {Reference counter functions}
    108     function NewReference: TBGRADefaultBitmap;
     166    function NewReference: TBGRACustomBitmap;
    109167    procedure FreeReference;
    110     function GetUnique: TBGRADefaultBitmap;
    111     function NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap;
    112     function NewBitmap(Filename: string): TBGRADefaultBitmap;
     168    function GetUnique: TBGRACustomBitmap;
    113169
    114170    {TFPCustomImage override}
    … …  
    117173
    118174    {Constructors}
    119     constructor Create;
    120     constructor Create(ABitmap: TBitmap);
    121     constructor Create(AWidth, AHeight: integer; Color: TColor);
    122     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel);
     175    constructor Create; override;
     176    constructor Create(ABitmap: TBitmap); override;
     177    constructor Create(AWidth, AHeight: integer; Color: TColor); override;
     178    constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); override;
     179    constructor Create(AFilename: string); override;
     180    constructor Create(AStream: TStream); override;
    123181    destructor Destroy; override;
    124182
    125183    {Loading functions}
    126     procedure LoadFromFile(const filename: string);
    127     procedure SaveToFile(const filename: string);
    128     constructor Create(AFilename: string);
    129     constructor Create(AStream: TStream);
    130     procedure Assign(Bitmap: TBitmap); overload;
    131     procedure Assign(MemBitmap: TBGRADefaultBitmap); overload;
     184    function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; override;
     185    function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; override;
     186    function NewBitmap(Filename: string): TBGRACustomBitmap; override;
     187
     188    procedure LoadFromFile(const filename: string); override;
     189    procedure SaveToFile(const filename: string); override;
     190    procedure SaveToStreamAsPng(Str: TStream); override;
     191    procedure Assign(ABitmap: TBitmap); override; overload;
     192    procedure Assign(MemBitmap: TBGRACustomBitmap);override; overload;
     193    procedure Serialize(AStream: TStream); override;
     194    procedure Deserialize(AStream: TStream); override;
     195    class procedure SerializeEmpty(AStream: TStream);
    132196
    133197    {Pixel functions}
    134     procedure SetPixel(x, y: integer; c: TColor); overload;
    135     procedure SetPixel(x, y: integer; c: TBGRAPixel); overload;
    136     procedure DrawPixel(x, y: integer; c: TBGRAPixel);
    137     procedure FastBlendPixel(x, y: integer; c: TBGRAPixel);
    138     procedure ErasePixel(x, y: integer; alpha: byte);
    139     procedure AlphaPixel(x, y: integer; alpha: byte);
    140     function GetPixel(x, y: integer): TBGRAPixel; overload;
    141     function GetPixel(x, y: single): TBGRAPixel; overload;
    142     function GetPixelCycle(x, y: integer): TBGRAPixel;
     198    function PtInClipRect(x, y: integer): boolean; inline;
     199    procedure SetPixel(x, y: integer; c: TColor); override;
     200    procedure SetPixel(x, y: integer; c: TBGRAPixel); override;
     201    procedure XorPixel(x, y: integer; c: TBGRAPixel); override;
     202    procedure DrawPixel(x, y: integer; c: TBGRAPixel); override;
     203    procedure DrawPixel(x, y: integer; ec: TExpandedPixel); override;
     204    procedure FastBlendPixel(x, y: integer; c: TBGRAPixel); override;
     205    procedure ErasePixel(x, y: integer; alpha: byte); override;
     206    procedure AlphaPixel(x, y: integer; alpha: byte); override;
     207    function GetPixel(x, y: integer): TBGRAPixel; override;
     208    function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
     209    function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; override;
     210    function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter;
     211      repeatX: boolean; repeatY: boolean): TBGRAPixel; override; overload;
    143212
    144213    {Line primitives}
    145     procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
    146     procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel);
    147     procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel);
    148     procedure AlphaHorizLine(x, y, x2: integer; alpha: byte);
    149     procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel);
    150     procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
    151     procedure AlphaVertLine(x, y, y2: integer; alpha: byte);
    152     procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
     214    procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
     215    procedure XorHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
     216    procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
     217    procedure DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel); override;
     218    procedure DrawHorizLine(x, y, x2: integer; texture: IBGRAScanner); override;
     219    procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel); override;
     220    procedure AlphaHorizLine(x, y, x2: integer; alpha: byte); override;
     221    procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel); override;
     222    procedure XorVertLine(x, y, y2: integer; c: TBGRAPixel); override;
     223    procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel); override;
     224    procedure AlphaVertLine(x, y, y2: integer; alpha: byte); override;
     225    procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel); override;
    153226    procedure DrawHorizLineDiff(x, y, x2: integer; c, compare: TBGRAPixel;
    154       maxDiff: byte);
     227      maxDiff: byte); override;
    155228
    156229    {Shapes}
    157     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean);
    158     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel;
    159       DrawLastPixel: boolean); overload;
    160     procedure DrawPolyLineAntialias(points: array of TPoint; c: TBGRAPixel;
    161       DrawLastPixel: boolean); overload;
    162     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel;
    163       dashLen: integer; DrawLastPixel: boolean); overload;
    164     procedure DrawPolyLineAntialias(points: array of TPoint; c1, c2: TBGRAPixel;
    165       dashLen: integer; DrawLastPixel: boolean); overload;
    166     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel;
    167       w: single; Closed: boolean); overload;
    168     procedure DrawPolyLineAntialias(points: array of TPointF; c: TBGRAPixel;
    169       w: single; Closed: boolean); overload;
    170     procedure DrawPolygonAntialias(points: array of TPointF; c: TBGRAPixel;
    171       w: single); overload;
    172     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte;
    173       w: single; Closed: boolean); overload;
    174     procedure FillPolyAntialias(points: array of TPointF; c: TBGRAPixel);
    175     procedure ErasePolyAntialias(points: array of TPointF; alpha: byte);
    176     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single);
    177     procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
    178     procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
    179     procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode);
    180     procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel;
    181       mode: TDrawMode);
    182     procedure Rectangle(x, y, x2, y2: integer; c: TColor);
    183     procedure Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode);
    184     procedure Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel;
    185       mode: TDrawMode);
    186     procedure Rectangle(r: TRect; c: TColor);
    187     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel;
    188       w: single); overload;
    189     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel;
    190       w: single; back: TBGRAPixel); overload;
    191     procedure FillRect(r: TRect; c: TColor);
    192     procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
    193     procedure FillRect(x, y, x2, y2: integer; c: TColor);
    194     procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode);
    195     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
    196     procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte);
    197     procedure RoundRect(X1, Y1, X2, Y2: integer; RX, RY: integer;
    198       BorderColor, FillColor: TBGRAPixel);
    199     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel;
    200       align: TAlignment); overload;
    201     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel); overload;
    202     procedure TextOut(x, y: integer; s: string; c: TColor); overload;
    203     procedure TextRect(ARect: TRect; x, y: integer; s: string;
    204       style: TTextStyle; c: TBGRAPixel); overload;
    205     function TextSize(s: string): TSize;
     230    procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
     231    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); override;
     232    procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); override;
     233    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); override;
     234    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); override;
     235    procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); override;
     236    procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); override;
     237
     238    procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
     239    procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
     240    procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); override;
     241    procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); override;
     242    procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
     243
     244    procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); override;
     245    procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); override;
     246    procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); override;
     247
     248    procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
     249    procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
     250    procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
     251    procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
     252    procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
     253
     254    procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
     255    procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
     256    procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True); override;
     257    procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
     258    procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
     259    procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
     260    procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
     261
     262    procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
     263    procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
     264    procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
     265    procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
     266    procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
     267    procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode); override;
     268    procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode); override;
     269    procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel); override;
     270    procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner); override;
     271    procedure ErasePoly(const points: array of TPointF; alpha: byte); override;
     272    procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); override;
     273
     274    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); override;
     275    procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); override;
     276    procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
     277    procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); override;
     278    procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); override;
     279    procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); override;
     280    procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); override;
     281
     282    procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
     283    procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); override;
     284    procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
     285    procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); override;
     286
     287    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); override;
     288    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); override;
     289    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); override;
     290    procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
     291
     292    procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
     293    procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); override;
     294    procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); override;
     295    procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); override;
     296    procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); override;
     297    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); override;
     298    procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); override;
     299    procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); override;
     300    procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); override;
     301    procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer;
     302      BorderColor, FillColor: TBGRAPixel); override;
     303
     304    procedure TextOutAngle(x, y, orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
     305    procedure TextOutAngle(x, y, orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
     306    procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner; align: TAlignment); override;
     307    procedure TextOut(x, y: integer; s: string; c: TBGRAPixel; align: TAlignment); override;
     308    procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); override;
     309    procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); override;
     310    function TextSize(s: string): TSize; override;
    206311
    207312    {Spline}
    208     function ComputeClosedSpline(points: array of TPointF): ArrayOfTPointF;
    209     function ComputeOpenedSpline(points: array of TPointF): ArrayOfTPointF;
     313    function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
     314    function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
     315
     316    function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; override;
     317    function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; override;
     318    function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; override;
     319    function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; override;
     320
     321    function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; override;
     322    function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; override;
     323    function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; override;
     324
     325    function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; override;
     326    function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; override;
     327    function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; override;
     328    function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; override;
     329    function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single): ArrayOfTPointF; override;
     330    function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions): ArrayOfTPointF; override;
     331    function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; override;
     332    function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; override;
    210333
    211334    {Filling}
    212     procedure FillTransparent;
    213     procedure ApplyGlobalOpacity(alpha: byte);
    214     procedure Fill(c: TColor); overload;
    215     procedure Fill(c: TBGRAPixel); overload;
    216     procedure Fill(c: TBGRAPixel; start, Count: integer); overload;
    217     procedure DrawPixels(c: TBGRAPixel; start, Count: integer);
    218     procedure AlphaFill(alpha: byte); overload;
    219     procedure AlphaFill(alpha: byte; start, Count: integer); overload;
    220     procedure ReplaceColor(before, after: TColor); overload;
    221     procedure ReplaceColor(before, after: TBGRAPixel); overload;
    222     procedure ReplaceTransparent(after: TBGRAPixel); overload;
    223     procedure FloodFill(X, Y: integer; Color: TBGRAPixel;
    224       mode: TFloodfillMode; Tolerance: byte = 0);
    225     procedure ParallelFloodFill(X, Y: integer; Dest: TBGRADefaultBitmap; Color: TBGRAPixel;
    226       mode: TFloodfillMode; Tolerance: byte = 0);
     335    procedure NoClip; override;
     336    procedure Fill(texture: IBGRAScanner; mode: TDrawMode); override;
     337    procedure Fill(texture: IBGRAScanner); override;
     338    procedure Fill(c: TBGRAPixel; start, Count: integer); override;
     339    procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override;
     340    procedure AlphaFill(alpha: byte; start, Count: integer); override;
     341    procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); override;
     342    procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); override;
     343    procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override;
     344    procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override;
     345    procedure ReplaceColor(before, after: TColor); override;
     346    procedure ReplaceColor(before, after: TBGRAPixel); override;
     347    procedure ReplaceTransparent(after: TBGRAPixel); override;
     348    procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
     349      mode: TFloodfillMode; Tolerance: byte = 0); override;
    227350    procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
    228351      gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
    229       gammaColorCorrection: boolean = True; Sinus: Boolean=False);
     352      gammaColorCorrection: boolean = True; Sinus: Boolean=False); override;
     353    procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
     354      gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
     355      Sinus: Boolean=False); override;
     356    function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
     357                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override;
     358    procedure ScanMoveTo(X,Y: Integer); override;
     359    function ScanNextPixel: TBGRAPixel; override;
     360    function ScanAt(X,Y: Single): TBGRAPixel; override;
     361    function IsScanPutPixelsDefined: boolean; override;
     362    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
    230363
    231364    {Canvas drawing functions}
    232365    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
    233       AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual;
     366      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
    234367    procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
    235       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual;
    236     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual;
    237     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); virtual;
    238     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); virtual;
    239     procedure DrawPart(ARect: TRect; Canvas: TCanvas; x, y: integer; Opaque: boolean);
    240     function GetPart(ARect: TRect): TBGRADefaultBitmap;
    241     procedure InvalidateBitmap; inline; //call if you modify with Scanline
    242     procedure LoadFromBitmapIfNeeded;   //call to ensure that bitmap data is up to date
     368      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
     369    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
     370    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
     371    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
     372    procedure InvalidateBitmap; override;         //call if you modify with Scanline
     373    procedure LoadFromBitmapIfNeeded; override;   //call to ensure that bitmap data is up to date
    243374
    244375    {BGRA bitmap functions}
    245     procedure PutImage(x, y: integer; Source: TBGRADefaultBitmap; mode: TDrawMode);
    246     procedure BlendImage(x, y: integer; Source: TBGRADefaultBitmap;
    247       operation: TBlendOperation);
    248     function Duplicate: TBGRADefaultBitmap; virtual;
    249     function Equals(comp: TBGRADefaultBitmap): boolean;
    250     function Equals(comp: TBGRAPixel): boolean;
     376    procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
     377    procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255); override;
     378    procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); override;
     379    procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); override;
     380
     381    function GetPart(ARect: TRect): TBGRACustomBitmap; override;
     382    function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override;
     383    function Duplicate(DuplicateProperties: Boolean = False) : TBGRACustomBitmap; override;
     384    procedure CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
     385    function Equals(comp: TBGRACustomBitmap): boolean; override;
     386    function Equals(comp: TBGRAPixel): boolean; override;
     387    function GetImageBounds(Channel: TChannel = cAlpha): TRect; override;
     388    function GetImageBounds(Channels: TChannels): TRect; override;
     389    function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override;
     390
    251391    function Resample(newWidth, newHeight: integer;
    252       mode: TResampleMode = rmFineResample): TBGRADefaultBitmap;
    253     procedure VerticalFlip;
    254     procedure HorizontalFlip;
    255     function RotateCW: TBGRADefaultBitmap;
    256     function RotateCCW: TBGRADefaultBitmap;
    257     procedure Negative;
    258     procedure LinearNegative;
    259     procedure SwapRedBlue;
    260     procedure GrayscaleToAlpha;
    261     procedure AlphaToGrayscale;
    262     procedure ApplyMask(mask: TBGRADefaultBitmap);
    263     function GetImageBounds(Channel: TChannel = cAlpha): TRect;
    264     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
     392      mode: TResampleMode = rmFineResample): TBGRACustomBitmap; override;
     393    procedure VerticalFlip; override;
     394    procedure HorizontalFlip; override;
     395    function RotateCW: TBGRACustomBitmap; override;
     396    function RotateCCW: TBGRACustomBitmap; override;
     397    procedure Negative; override;
     398    procedure LinearNegative; override;
     399    procedure SwapRedBlue; override;
     400    procedure GrayscaleToAlpha; override;
     401    procedure AlphaToGrayscale; override;
     402    procedure ApplyMask(mask: TBGRACustomBitmap); override;
     403    procedure ApplyGlobalOpacity(alpha: byte); override;
    265404
    266405    {Filters}
    267     function FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap;
    268     function FilterMedian(Option: TMedianOption): TBGRADefaultBitmap;
    269     function FilterSmooth: TBGRADefaultBitmap;
    270     function FilterSharpen: TBGRADefaultBitmap;
    271     function FilterContour: TBGRADefaultBitmap;
     406    function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; override;
     407    function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; override;
     408    function FilterSmooth: TBGRACustomBitmap; override;
     409    function FilterSharpen: TBGRACustomBitmap; override;
     410    function FilterContour: TBGRACustomBitmap; override;
    272411    function FilterBlurRadial(radius: integer;
    273       blurType: TRadialBlurType): TBGRADefaultBitmap;
     412      blurType: TRadialBlurType): TBGRACustomBitmap; override;
     413    function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; override;
    274414    function FilterBlurMotion(distance: integer; angle: single;
    275       oriented: boolean): TBGRADefaultBitmap;
    276     function FilterCustomBlur(mask: TBGRADefaultBitmap): TBGRADefaultBitmap;
    277     function FilterEmboss(angle: single): TBGRADefaultBitmap;
    278     function FilterEmbossHighlight(FillSelection: boolean): TBGRADefaultBitmap;
    279     function FilterGrayscale: TBGRADefaultBitmap;
    280     function FilterNormalize(eachChannel: boolean = True): TBGRADefaultBitmap;
    281     function FilterRotate(origin: TPointF; angle: single): TBGRADefaultBitmap;
    282     function FilterSphere: TBGRADefaultBitmap;
    283     function FilterCylinder: TBGRADefaultBitmap;
    284     function FilterPlane: TBGRADefaultBitmap;
    285 
    286     property Data: PBGRAPixel Read GetDataPtr;
    287     property Width: integer Read FWidth;
    288     property Height: integer Read FHeight;
    289     property NbPixels: integer Read FNbPixels;
    290     property Empty: boolean Read CheckEmpty;
    291 
    292     property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;
    293     property RefCount: integer Read FRefCount;
    294     property Bitmap: TBitmap Read GetBitmap;
    295     //don't forget to call InvalidateBitmap before if you changed something with Scanline
    296     property HasTransparentPixels: boolean Read GetHasTransparentPixels;
    297     property AverageColor: TColor Read GetAverageColor;
    298     property AveragePixel: TBGRAPixel Read GetAveragePixel;
    299     property LineOrder: TRawImageLineOrder Read FLineOrder;
    300     property Canvas: TCanvas Read GetCanvas;
    301     property CanvasOpacity: byte Read FCanvasOpacity Write SetCanvasOpacity;
    302     property CanvasAlphaCorrection: boolean
    303       Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
    304 
    305     property FontHeight: integer Read FFontHeight Write SetFontHeight;
    306   end;
    307 
    308 type
     415      oriented: boolean): TBGRACustomBitmap; override;
     416    function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; override;
     417    function FilterEmboss(angle: single): TBGRACustomBitmap; override;
     418    function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; override;
     419    function FilterGrayscale: TBGRACustomBitmap; override;
     420    function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; override;
     421    function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; override;
     422    function FilterSphere: TBGRACustomBitmap; override;
     423    function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; override;
     424    function FilterCylinder: TBGRACustomBitmap; override;
     425    function FilterPlane: TBGRACustomBitmap; override;
     426
     427    property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
     428    property Canvas2D: TBGRACanvas2D read GetCanvas2D;
     429  end;
     430
    309431  { TBGRAPtrBitmap }
    310432
    … …  
    315437  public
    316438    constructor Create(AWidth, AHeight: integer; AData: Pointer); overload;
    317     function Duplicate: TBGRADefaultBitmap; override;
     439    function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; override;
    318440    procedure SetDataPtr(AData: Pointer);
    319441    property LineOrder: TRawImageLineOrder Read FLineOrder Write FLineOrder;
    … …  
    323445  DefaultTextStyle: TTextStyle;
    324446
     447procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
     448  c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
     449  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
     450
    325451implementation
    326452
    327 uses FPWritePng, Math, LCLIntf, LCLType, BGRAPolygon, BGRAResample,
    328   BGRAFilters, BGRABlend, BGRAPaintNet,
    329   FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
     453uses Math, LCLIntf, LCLType,
     454  BGRABlend, BGRAFilters, BGRAPen, BGRAText, BGRATextFX, BGRAGradientScanner,
     455  BGRAResample, BGRATransform, BGRAPolygon, BGRAPolygonAliased,
     456  BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM;
    330457
    331458type
    … …  
    375502end;
    376503
     504function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle;
     505begin
     506  result := DuplicatePenStyle(FCustomPenStyle);
     507end;
     508
    377509procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean);
    378510begin
    … …  
    386518end;
    387519
     520procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode);
     521begin
     522  FCanvasDrawModeFP := AValue;
     523  Case AValue of
     524  dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel;
     525  dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel;
     526  dmXor: FCanvasPixelProcFP:= @XorPixel;
     527  else FCanvasPixelProcFP := @SetPixel;
     528  end;
     529end;
     530
     531function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode;
     532begin
     533  Result:= FCanvasDrawModeFP;
     534end;
     535
     536procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle);
     537begin
     538  FCustomPenStyle := DuplicatePenStyle(AValue);
     539end;
     540
     541procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle);
     542begin
     543  Case AValue of
     544  psSolid: CustomPenStyle := SolidPenStyle;
     545  psDash: CustomPenStyle := DashPenStyle;
     546  psDot: CustomPenStyle := DotPenStyle;
     547  psDashDot: CustomPenStyle := DashDotPenStyle;
     548  psDashDotDot: CustomPenStyle := DashDotDotPenStyle;
     549  else CustomPenStyle := ClearPenStyle;
     550  end;
     551  FPenStyle := AValue;
     552end;
     553
     554function TBGRADefaultBitmap.GetPenStyle: TPenStyle;
     555begin
     556  Result:= FPenStyle;
     557end;
     558
     559{ Update font properties to internal TFont object }
    388560procedure TBGRADefaultBitmap.UpdateFont;
    389561begin
    … …  
    394566  if FFont.Height <> FFontHeight * FFontHeightSign then
    395567    FFont.Height := FFontHeight * FFontHeightSign;
     568  if FFont.Orientation <> FontOrientation then
     569    FFont.Orientation := FontOrientation;
     570  if FontQuality = fqSystemClearType then
     571    FFont.Quality := fqCleartype
     572  else
     573    FFont.Quality := FontDefaultQuality;
    396574end;
    397575
    398576procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer);
    399577begin
    400   if AHeight < 0 then
    401     raise ERangeError.Create('Font height must be positive');
    402578  FFontHeight := AHeight;
    403579end;
    404580
     581function TBGRADefaultBitmap.GetFontFullHeight: integer;
     582begin
     583  if FontHeight < 0 then
     584    result := -FontHeight
     585  else
     586    result := TextSize('Hg').cy;
     587end;
     588
     589procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer);
     590begin
     591  if AHeight > 0 then
     592    FontHeight := -AHeight
     593  else
     594    FontHeight := 1;
     595end;
     596
     597function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric;
     598var fxFont: TFont;
     599begin
     600  UpdateFont;
     601  if FontQuality = fqSystem then
     602    result := BGRAText.GetFontPixelMetric(FFont)
     603  else
     604  begin
     605    FxFont := TFont.Create;
     606    FxFont.Assign(FFont);
     607    FxFont.Height := fxFont.Height*FontAntialiasingLevel;
     608    Result:= BGRAText.GetFontPixelMetric(FxFont);
     609    if Result.Baseline <> -1 then Result.Baseline:= round((Result.Baseline-1)/FontAntialiasingLevel);
     610    if Result.CapLine <> -1 then Result.CapLine:= round(Result.CapLine/FontAntialiasingLevel);
     611    if Result.DescentLine <> -1 then Result.DescentLine:= round((Result.DescentLine-1)/FontAntialiasingLevel);
     612    if Result.Lineheight <> -1 then Result.Lineheight:= round(Result.Lineheight/FontAntialiasingLevel);
     613    if Result.xLine <> -1 then Result.xLine:= round(Result.xLine/FontAntialiasingLevel);
     614  end;
     615end;
     616
     617{ Get scanline without checking bounds nor updated from TBitmap }
    405618function TBGRADefaultBitmap.GetScanlineFast(y: integer): PBGRAPixel; inline;
    406619begin
    … …  
    423636
    424637{------------------------- Reference counter functions ------------------------}
    425 
    426 function TBGRADefaultBitmap.NewReference: TBGRADefaultBitmap;
     638{ These functions are not related to reference counting for interfaces :
     639  a reference must be explicitely freed with FreeReference }
     640
     641{ Add a new reference and gives a pointer to it }
     642function TBGRADefaultBitmap.NewReference: TBGRACustomBitmap;
    427643begin
    428644  Inc(FRefCount);
    … …  
    430646end;
    431647
     648{ Free the current reference, and free the bitmap if necessary }
    432649procedure TBGRADefaultBitmap.FreeReference;
    433650begin
    … …  
    445662end;
    446663
    447 function TBGRADefaultBitmap.GetUnique: TBGRADefaultBitmap;
     664{ Make sure there is only one copy of the bitmap and return
     665  the new pointer for it. If the bitmap is already unique,
     666  then it does nothing }
     667function TBGRADefaultBitmap.GetUnique: TBGRACustomBitmap;
    448668begin
    449669  if FRefCount > 1 then
    … …  
    456676end;
    457677
    458 function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap;
     678{ Creates a new bitmap. Internally, it uses the same type so that if you
     679  use an optimized version, you get a new bitmap with the same optimizations }
     680function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap;
    459681var
    460682  BGRAClass: TBGRABitmapAny;
    … …  
    466688end;
    467689
    468 function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRADefaultBitmap;
     690function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer;
     691  Color: TBGRAPixel): TBGRACustomBitmap;
     692var
     693  BGRAClass: TBGRABitmapAny;
     694begin
     695  BGRAClass := TBGRABitmapAny(self.ClassType);
     696  if BGRAClass = TBGRAPtrBitmap then
     697    BGRAClass := TBGRADefaultBitmap;
     698  Result      := BGRAClass.Create(AWidth, AHeight, Color);
     699end;
     700
     701{ Creates a new bitmap and loads it contents from a file }
     702function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRACustomBitmap;
    469703var
    470704  BGRAClass: TBGRABitmapAny;
    … …  
    476710{----------------------- TFPCustomImage override ------------------------------}
    477711
     712{ Creates a new bitmap, initialize properties and bitmap data }
    478713constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer);
    479714begin
    … …  
    484719end;
    485720
    486 
     721{ Set the size of the current bitmap. All data is lost during the process }
    487722procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer);
    488723begin
    … …  
    497732  FHeight   := AHeight;
    498733  FNbPixels := AWidth * AHeight;
    499   if FNbPixels < 0 then
     734  if FNbPixels < 0 then // 2 Go limit
    500735    raise EOutOfMemory.Create('Image too big');
    501736  FreeBitmap;
    502737  ReallocData;
     738  NoClip;
    503739end;
    504740
    … …  
    515751  Init;
    516752  inherited Create(ABitmap.Width, ABitmap.Height);
    517   LoadFromRawImage(ABitmap.RawImage,0);
     753  Assign(ABitmap);
    518754end;
    519755
    … …  
    535771begin
    536772  FreeData;
     773  FFont.Free;
    537774  FBitmap.Free;
     775  FCanvasFP.Free;
     776  FCanvasBGRA.Free;
     777  FCanvas2D.Free;
    538778  inherited Destroy;
    539779end;
    … …  
    553793end;
    554794
    555 procedure TBGRADefaultBitmap.Assign(Bitmap: TBitmap);
     795procedure TBGRADefaultBitmap.Assign(ABitmap: TBitmap);
     796var TempBmp: TBitmap;
     797    ConvertOk: boolean;
    556798begin
    557799  DiscardBitmapChange;
    558   SetSize(Bitmap.Width, bitmap.Height);
    559   GetImageFromCanvas(Bitmap.Canvas, 0, 0);
    560 end;
    561 
    562 procedure TBGRADefaultBitmap.Assign(MemBitmap: TBGRADefaultBitmap);
     800  SetSize(ABitmap.Width, ABitmap.Height);
     801  if not LoadFromRawImage(ABitmap.RawImage,0,False,False) then
     802  begin //try to convert
     803    TempBmp := TBitmap.Create;
     804    TempBmp.Width := ABitmap.Width;
     805    TempBmp.Height := ABitmap.Height;
     806    TempBmp.Canvas.Draw(0,0,ABitmap);
     807    ConvertOk := LoadFromRawImage(TempBmp.RawImage,0,False,False);
     808    TempBmp.Free;
     809    if not ConvertOk then
     810      raise Exception.Create('Unable to convert image to 24 bit');
     811  end;
     812  If Empty then AlphaFill(255); // if bitmap seems to be empty, assume
     813                                // it is an opaque bitmap without alpha channel
     814end;
     815
     816procedure TBGRADefaultBitmap.Assign(MemBitmap: TBGRACustomBitmap);
    563817begin
    564818  DiscardBitmapChange;
    … …  
    567821end;
    568822
     823procedure TBGRADefaultBitmap.Serialize(AStream: TStream);
     824var lWidth,lHeight: integer;
     825begin
     826  lWidth := NtoLE(Width);
     827  lHeight := NtoLE(Height);
     828  AStream.Write(lWidth,sizeof(lWidth));
     829  AStream.Write(lHeight,sizeof(lHeight));
     830  AStream.Write(Data^, NbPixels*sizeof(TBGRAPixel));
     831end;
     832
     833{$hints off}
     834procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
     835var lWidth,lHeight: integer;
     836begin
     837  AStream.Read(lWidth,sizeof(lWidth));
     838  AStream.Read(lHeight,sizeof(lHeight));
     839  lWidth := LEtoN(lWidth);
     840  lHeight := LEtoN(lHeight);
     841  SetSize(lWidth,lHeight);
     842  AStream.Read(Data^, NbPixels*sizeof(TBGRAPixel));
     843end;
     844{$hints on}
     845
     846class procedure TBGRADefaultBitmap.SerializeEmpty(AStream: TStream);
     847var zero: integer;
     848begin
     849  zero := 0;
     850  AStream.Write(zero,sizeof(zero));
     851  AStream.Write(zero,sizeof(zero));
     852end;
     853
    569854procedure TBGRADefaultBitmap.LoadFromFile(const filename: string);
    570855var
    571   tempBitmap: TBGRADefaultBitmap;
    572 begin
    573   if IsPaintDotNetFile(filename) then
    574   begin
    575     tempBitmap := LoadPaintDotNetFile(filename);
    576     Assign(tempBitmap);
    577     tempBitmap.Free;
    578   end
    579   else
    580   begin
     856  OldDrawMode: TDrawMode;
     857begin
     858  OldDrawMode := CanvasDrawModeFP;
     859  CanvasDrawModeFP := dmSet;
     860  ClipRect := rect(0,0,Width,Height);
     861  try
    581862    inherited LoadFromfile(filename);
     863  finally
     864    CanvasDrawModeFP := OldDrawMode;
    582865    ClearTransparentPixels;
    583866  end;
    … …  
    588871  ext:    string;
    589872  writer: TFPCustomImageWriter;
    590   pngWriter: TFPWriterPNG;
    591873begin
    592874  ext := AnsiLowerCase(ExtractFileExt(filename));
    593875
     876  { When saving to PNG, define some parameters so that the
     877    image be readable by most programs }
    594878  if ext = '.png' then
    595   begin
    596     pngWriter := TFPWriterPNG.Create;
    597     pngWriter.Indexed := False;
    598     pngWriter.UseAlpha := HasTransparentPixels;
    599     pngWriter.WordSized := false;
    600     writer    := pngWriter;
    601   end else
    602   if (ext='.xpm') and (Width*Height > 32768) then
     879    writer := CreateAdaptedPngWriter
     880  else
     881  if (ext='.xpm') and (Width*Height > 32768) then //xpm is slow so avoid big images
    603882    raise exception.Create('Image is too big to be saved as XPM') else
    604883      writer := nil;
    605884
    606   if writer <> nil then
     885  if writer <> nil then //use custom writer if defined
    607886  begin
    608887    inherited SaveToFile(Filename, writer);
    … …  
    613892end;
    614893
     894procedure TBGRADefaultBitmap.SaveToStreamAsPng(Str: TStream);
     895var writer: TFPWriterPNG;
     896begin
     897  writer := CreateAdaptedPngWriter;
     898  SaveToStream(Str,writer);
     899  writer.Free;
     900end;
     901
     902{------------------------- Clipping -------------------------------}
     903
     904{ Check if a point is in the clipping rectangle }
     905function TBGRADefaultBitmap.PtInClipRect(x, y: integer): boolean;
     906begin
     907  result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom);
     908end;
     909
     910procedure TBGRADefaultBitmap.NoClip;
     911begin
     912  FClipRect := rect(0,0,FWidth,FHeight);
     913end;
     914
     915procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner; mode: TDrawMode);
     916begin
     917  FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,mode);
     918end;
     919
     920function TBGRADefaultBitmap.GetClipRect: TRect;
     921begin
     922  Result:= FClipRect;
     923end;
     924
     925procedure TBGRADefaultBitmap.SetClipRect(const AValue: TRect);
     926begin
     927  IntersectRect(FClipRect,AValue,Rect(0,0,FWidth,FHeight));
     928end;
     929
    615930{-------------------------- Pixel functions -----------------------------------}
    616931
    617932procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TBGRAPixel);
    618933begin
    619   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    620     exit;
    621   (Scanline[y] +x)^ := c;
     934  if not PtInClipRect(x,y) then exit;
     935  LoadFromBitmapIfNeeded;
     936  (GetScanlineFast(y) +x)^ := c;
    622937  InvalidateBitmap;
    623938end;
    624939
     940procedure TBGRADefaultBitmap.XorPixel(x, y: integer; c: TBGRAPixel);
     941var
     942  p : PDWord;
     943begin
     944  if not PtInClipRect(x,y) then exit;
     945  LoadFromBitmapIfNeeded;
     946  p := PDWord(GetScanlineFast(y) +x);
     947  p^ := p^ xor DWord(c);
     948  InvalidateBitmap;
     949end;
     950
    625951procedure TBGRADefaultBitmap.SetPixel(x, y: integer; c: TColor);
    626952var
    627953  p: PByte;
    628954begin
    629   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    630     exit;
    631   p  := PByte(Scanline[y] + x);
     955  if not PtInClipRect(x,y) then exit;
     956  LoadFromBitmapIfNeeded;
     957  p  := PByte(GetScanlineFast(y) + x);
    632958  p^ := c shr 16;
    633959  Inc(p);
    … …  
    642968procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; c: TBGRAPixel);
    643969begin
    644   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    645     exit;
    646   DrawPixelInline(Scanline[y] + x, c);
     970  if not PtInClipRect(x,y) then exit;
     971  LoadFromBitmapIfNeeded;
     972  DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c);
    647973  InvalidateBitmap;
    648974end;
    649975
     976procedure TBGRADefaultBitmap.DrawPixel(x, y: integer; ec: TExpandedPixel);
     977begin
     978  if not PtInClipRect(x,y) then exit;
     979  LoadFromBitmapIfNeeded;
     980  DrawExpandedPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, ec);
     981  InvalidateBitmap;
     982end;
     983
    650984procedure TBGRADefaultBitmap.FastBlendPixel(x, y: integer; c: TBGRAPixel);
    651985begin
    652   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    653     exit;
    654   FastBlendPixelInline(Scanline[y] + x, c);
     986  if not PtInClipRect(x,y) then exit;
     987  LoadFromBitmapIfNeeded;
     988  FastBlendPixelInline(GetScanlineFast(y) + x, c);
    655989  InvalidateBitmap;
    656990end;
    … …  
    658992procedure TBGRADefaultBitmap.ErasePixel(x, y: integer; alpha: byte);
    659993begin
    660   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    661     exit;
    662   ErasePixelInline(Scanline[y] + x, alpha);
     994  if not PtInClipRect(x,y) then exit;
     995  LoadFromBitmapIfNeeded;
     996  ErasePixelInline(GetScanlineFast(y) + x, alpha);
    663997  InvalidateBitmap;
    664998end;
    … …  
    6661000procedure TBGRADefaultBitmap.AlphaPixel(x, y: integer; alpha: byte);
    6671001begin
    668   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    669     exit;
     1002  if not PtInClipRect(x,y) then exit;
     1003  LoadFromBitmapIfNeeded;
    6701004  if alpha = 0 then
    671     (Scanline[y] +x)^ := BGRAPixelTransparent
     1005    (GetScanlineFast(y) +x)^ := BGRAPixelTransparent
    6721006  else
    673     (Scanline[y] +x)^.alpha := alpha;
     1007    (GetScanlineFast(y) +x)^.alpha := alpha;
    6741008  InvalidateBitmap;
    6751009end;
    … …  
    6771011function TBGRADefaultBitmap.GetPixel(x, y: integer): TBGRAPixel;
    6781012begin
    679   if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
     1013  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then //it is possible to read pixels outside of the cliprect
    6801014    Result := BGRAPixelTransparent
    6811015  else
    682     Result := (Scanline[y] + x)^;
     1016  begin
     1017    LoadFromBitmapIfNeeded;
     1018    Result := (GetScanlineFast(y) + x)^;
     1019  end;
    6831020end;
    6841021
    6851022{$hints off}
    686 function TBGRADefaultBitmap.GetPixel(x, y: single): TBGRAPixel;
    687 var
    688   ix, iy, w: integer;
    689   rSum, gSum, bSum, rgbDiv: cardinal;
    690   aSum, aDiv: cardinal;
     1023{ This function compute an interpolated pixel at floating point coordinates }
     1024function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
     1025var
     1026  ix, iy: integer;
     1027  w1,w2,w3,w4,alphaW: cardinal;
     1028  rSum, gSum, bSum: cardinal; //rgbDiv = aSum
     1029  aSum: cardinal;
    6911030  c:    TBGRAPixel;
    6921031  scan: PBGRAPixel;
    693 begin
    694   if (frac(x) = 0) and (frac(y) = 0) then
    695   begin
    696     Result := GetPixel(round(x), round(y));
     1032  factX,factY: single;
     1033  iFactX,iFactY: integer;
     1034begin
     1035  ix := floor(x);
     1036  iy := floor(y);
     1037  factX := x-ix; //distance from integer coordinate
     1038  factY := y-iy;
     1039
     1040  //if the coordinate is integer, then call standard GetPixel function
     1041  if (factX = 0) and (factY = 0) then
     1042  begin
     1043    Result := GetPixel(ix, iy);
    6971044    exit;
    6981045  end;
    6991046  LoadFromBitmapIfNeeded;
     1047
     1048  rSum   := 0;
     1049  gSum   := 0;
     1050  bSum   := 0;
     1051  aSum   := 0;
     1052
     1053  //apply interpolation filter
     1054  factX := FineInterpolation( factX, AResampleFilter );
     1055  factY := FineInterpolation( factY, AResampleFilter );
     1056
     1057  iFactX := round(factX*256); //integer values for fractionnal part
     1058  iFactY := round(factY*256);
     1059
     1060  w4 := (iFactX*iFactY+127) shr 8;
     1061  w3 := iFactY-w4;
     1062  w1 := (256-iFactX)-w3;
     1063  w2 := iFactX-w4;
     1064
     1065  { For each pixel around the coordinate, compute
     1066    the weight for it and multiply values by it before
     1067    adding to the sum }
     1068  if (iy >= 0) and (iy < Height) then
     1069  begin
     1070    scan := GetScanlineFast(iy);
     1071
     1072    if (ix >= 0) and (ix < Width) then
     1073    begin
     1074      c      := (scan + ix)^;
     1075      alphaW := c.alpha * w1;
     1076      aSum   += alphaW;
     1077      rSum   += c.red * alphaW;
     1078      gSum   += c.green * alphaW;
     1079      bSum   += c.blue * alphaW;
     1080    end;
     1081
     1082    Inc(ix);
     1083    if (ix >= 0) and (ix < Width) then
     1084    begin
     1085      c      := (scan + ix)^;
     1086      alphaW := c.alpha * w2;
     1087      aSum   += alphaW;
     1088      rSum   += c.red * alphaW;
     1089      gSum   += c.green * alphaW;
     1090      bSum   += c.blue * alphaW;
     1091    end;
     1092  end
     1093  else
     1094  begin
     1095    Inc(ix);
     1096  end;
     1097
     1098  Inc(iy);
     1099  if (iy >= 0) and (iy < Height) then
     1100  begin
     1101    scan := GetScanlineFast(iy);
     1102
     1103    if (ix >= 0) and (ix < Width) then
     1104    begin
     1105      c      := (scan + ix)^;
     1106      alphaW := c.alpha * w4;
     1107      aSum   += alphaW;
     1108      rSum   += c.red * alphaW;
     1109      gSum   += c.green * alphaW;
     1110      bSum   += c.blue * alphaW;
     1111    end;
     1112
     1113    Dec(ix);
     1114    if (ix >= 0) and (ix < Width) then
     1115    begin
     1116      c      := (scan + ix)^;
     1117      alphaW := c.alpha * w3;
     1118      aSum   += alphaW;
     1119      rSum   += c.red * alphaW;
     1120      gSum   += c.green * alphaW;
     1121      bSum   += c.blue * alphaW;
     1122    end;
     1123  end;
     1124
     1125  if aSum = 0 then //if there is no alpha
     1126    Result := BGRAPixelTransparent
     1127  else
     1128  begin
     1129    Result.red   := (rSum + aSum shr 1) div aSum;
     1130    Result.green := (gSum + aSum shr 1) div aSum;
     1131    Result.blue  := (bSum + aSum shr 1) div aSum;
     1132    Result.alpha := (aSum + 128) shr 8;
     1133  end;
     1134end;
     1135
     1136{ Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions }
     1137function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
     1138var
     1139  ix, iy, ixMod1,ixMod2: integer;
     1140  w1,w2,w3,w4,alphaW: cardinal;
     1141  bSum, gSum, rSum, rgbDiv: cardinal;
     1142  aSum: cardinal;
     1143
     1144  c:    TBGRAPixel;
     1145  scan: PBGRAPixel;
     1146  factX,factY: single;
     1147  iFactX,iFactY: integer;
     1148begin
     1149  ix := floor(x);
     1150  iy := floor(y);
     1151  factX := x-ix;
     1152  factY := y-iy;
     1153
     1154  if (factX = 0) and (factY = 0) then
     1155  begin
     1156    Result := GetPixelCycle(ix, iy);
     1157    exit;
     1158  end;
     1159  LoadFromBitmapIfNeeded;
     1160
     1161  factX := FineInterpolation( factX, AResampleFilter );
     1162  factY := FineInterpolation( factY, AResampleFilter );
     1163
     1164  iFactX := round(factX*256);
     1165  iFactY := round(factY*256);
     1166
     1167
     1168  w4 := (iFactX*iFactY+127) shr 8;
     1169  w3 := iFactY-w4;
     1170  w1 := (256-iFactX)-w3;
     1171  w2 := iFactX-w4;
    7001172
    7011173  rSum   := 0;
    … …  
    7031175  bSum   := 0;
    7041176  rgbDiv := 0;
     1177
    7051178  aSum   := 0;
    706   aDiv   := 0;
    707 
    708   ix := floor(x);
    709   iy := floor(y);
    710 
    711   if (iy >= 0) and (iy < Height) then
    712   begin
    713     scan := GetScanlineFast(iy);
    714 
    715     if (ix >= 0) and (ix < Width) then
    716     begin
    717       c      := (scan + ix)^;
    718       w      := round((1 - (x - ix)) * (1 - (y - iy)) * 255);
    719       aDiv   += w;
    720       aSum   += c.alpha * w;
    721       c.alpha := c.alpha * w div 255;
    722       rSum   += c.red * c.alpha;
    723       gSum   += c.green * c.alpha;
    724       bSum   += c.blue * c.alpha;
    725       rgbDiv += c.alpha;
    726     end;
    727 
    728     Inc(ix);
    729     if (ix >= 0) and (ix < Width) then
    730     begin
    731       c      := (scan + ix)^;
    732       w      := round((1 - (ix - x)) * (1 - (y - iy)) * 255);
    733       aDiv   += w;
    734       aSum   += c.alpha * w;
    735       c.alpha := c.alpha * w div 255;
    736       rSum   += c.red * c.alpha;
    737       gSum   += c.green * c.alpha;
    738       bSum   += c.blue * c.alpha;
    739       rgbDiv += c.alpha;
    740     end;
    741   end
    742   else
    743     Inc(ix);
     1179
     1180  scan := GetScanlineFast(PositiveMod(iy,Height));
     1181
     1182  ixMod1 := PositiveMod(ix,Width); //apply cycle
     1183  c      := (scan + ixMod1)^;
     1184  alphaW := c.alpha * w1;
     1185  aSum   += alphaW;
     1186
     1187  rSum   += c.red * alphaW;
     1188  gSum   += c.green * alphaW;
     1189  bSum   += c.blue * alphaW;
     1190  rgbDiv += alphaW;
     1191
     1192  Inc(ix);
     1193  ixMod2 := PositiveMod(ix,Width); //apply cycle
     1194  c      := (scan + ixMod2)^;
     1195  alphaW := c.alpha * w2;
     1196  aSum   += alphaW;
     1197
     1198  rSum   += c.red * alphaW;
     1199  gSum   += c.green * alphaW;
     1200  bSum   += c.blue * alphaW;
     1201  rgbDiv += alphaW;
    7441202
    7451203  Inc(iy);
    746   if (iy >= 0) and (iy < Height) then
    747   begin
    748     scan := GetScanlineFast(iy);
    749 
    750     if (ix >= 0) and (ix < Width) then
    751     begin
    752       c      := (scan + ix)^;
    753       w      := round((1 - (ix - x)) * (1 - (iy - y)) * 255);
    754       aDiv   += w;
    755       aSum   += c.alpha * w;
    756       c.alpha := c.alpha * w div 255;
    757       rSum   += c.red * c.alpha;
    758       gSum   += c.green * c.alpha;
    759       bSum   += c.blue * c.alpha;
    760       rgbDiv += c.alpha;
    761     end;
    762 
    763     Dec(ix);
    764     if (ix >= 0) and (ix < Width) then
    765     begin
    766       c      := (scan + ix)^;
    767       w      := round((1 - (x - ix)) * (1 - (iy - y)) * 255);
    768       aDiv   += w;
    769       aSum   += c.alpha * w;
    770       c.alpha := c.alpha * w div 255;
    771       rSum   += c.red * c.alpha;
    772       gSum   += c.green * c.alpha;
    773       bSum   += c.blue * c.alpha;
    774       rgbDiv += c.alpha;
    775     end;
    776   end;
    777 
    778   if (rgbDiv = 0) or (aDiv = 0) then
     1204  scan := GetScanlineFast(PositiveMod(iy,Height));
     1205
     1206  c      := (scan + ixMod2)^;
     1207  alphaW := c.alpha * w4;
     1208  aSum   += alphaW;
     1209
     1210  rSum   += c.red * alphaW;
     1211  gSum   += c.green * alphaW;
     1212  bSum   += c.blue * alphaW;
     1213  rgbDiv += alphaW;
     1214
     1215  c      := (scan + ixMod1)^;
     1216  alphaW := c.alpha * w3;
     1217  aSum   += alphaW;
     1218
     1219  rSum   += c.red * alphaW;
     1220  gSum   += c.green * alphaW;
     1221  bSum   += c.blue * alphaW;
     1222  rgbDiv += alphaW;
     1223
     1224  if (rgbDiv = 0) then
    7791225    Result := BGRAPixelTransparent
    7801226  else
    … …  
    7831229    Result.green := (gSum + rgbDiv shr 1) div rgbDiv;
    7841230    Result.blue  := (bSum + rgbDiv shr 1) div rgbDiv;
    785     Result.alpha := (aSum + aDiv shr 1) div aDiv;
    786   end;
     1231    Result.alpha := (aSum + 128) shr 8;
     1232  end;
     1233end;
     1234
     1235function TBGRADefaultBitmap.GetPixelCycle(x, y: single;
     1236  AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean
     1237  ): TBGRAPixel;
     1238var
     1239  alpha: byte;
     1240begin
     1241  alpha := 255;
     1242  if not repeatX then
     1243  begin
     1244    if (x < -0.5) or (x > Width-0.5) then
     1245    begin
     1246      result := BGRAPixelTransparent;
     1247      exit;
     1248    end;
     1249    if x < 0 then
     1250      alpha := round((0.5+x)*510)
     1251    else
     1252    if x > Width-1 then
     1253      alpha := round((Width-0.5-x)*510);
     1254  end;
     1255  if not repeatY then
     1256  begin
     1257    if (y < -0.5) or (y > Height-0.5) then
     1258    begin
     1259      result := BGRAPixelTransparent;
     1260      exit;
     1261    end;
     1262    if y < 0 then
     1263      alpha := round((0.5+y)*2*alpha)
     1264    else
     1265    if y > Height-1 then
     1266      alpha := round((Height-0.5-y)*2*alpha);
     1267  end;
     1268  result := GetPixelCycle(x,y,AResampleFilter);
     1269  if alpha<>255 then
     1270    result.alpha := ApplyOpacity(result.alpha,alpha);
    7871271end;
    7881272
    7891273{$hints on}
    790 
    791 function TBGRADefaultBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
    792 begin
    793   if (Width = 0) or (Height = 0) then
    794     Result := BGRAPixelTransparent
    795   else
    796   begin
    797     x := x mod Width;
    798     if x < 0 then
    799       Inc(x, Width);
    800     y := y mod Height;
    801     if y < 0 then
    802       Inc(y, Height);
    803     Result := (Scanline[y] + x)^;
    804   end;
    805 end;
    8061274
    8071275procedure TBGRADefaultBitmap.InvalidateBitmap;
    … …  
    8271295end;
    8281296
    829 procedure TBGRADefaultBitmap.LoadFromRawImage(ARawImage: TRawImage;
    830   DefaultOpacity: byte; AlwaysReplaceAlpha: boolean);
    831 var
    832   psource_byte, pdest_byte: PByte;
    833   n, x, y, delta: integer;
    834   psource_pix, pdest_pix: PBGRAPixel;
    835   sourceval:      longword;
    836   OpacityOrMask:  longword;
     1297function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas;
     1298begin
     1299  {$warnings off}
     1300  if FCanvasFP = nil then
     1301    FCanvasFP := TFPImageCanvas.Create(self);
     1302  {$warnings on}
     1303  result := FCanvasFP;
     1304end;
     1305
     1306{ Load raw image data. It must be 32bit or 24 bits per pixel}
     1307function TBGRADefaultBitmap.LoadFromRawImage(ARawImage: TRawImage;
     1308  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean;
     1309var
     1310  psource_byte, pdest_byte,
     1311  psource_first, pdest_first: PByte;
     1312  psource_delta, pdest_delta: integer;
     1313
     1314  n: integer;
     1315  mustSwapRedBlue, mustReverse32: boolean;
     1316
     1317  procedure CopyAndSwapIfNecessary(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
     1318  begin
     1319    if mustReverse32 then
     1320    begin
     1321      while count > 0 do
     1322      begin
     1323        pdest^.blue := psrc^.alpha;
     1324        pdest^.green := psrc^.red;
     1325        pdest^.red := psrc^.green;
     1326        pdest^.alpha := psrc^.blue;
     1327        dec(count);
     1328        inc(pdest);
     1329        inc(psrc);
     1330      end;
     1331    end else
     1332    if mustSwapRedBlue then
     1333    begin
     1334      while count > 0 do
     1335      begin
     1336        pdest^.red := psrc^.blue;
     1337        pdest^.green := psrc^.green;
     1338        pdest^.blue := psrc^.red;
     1339        pdest^.alpha := psrc^.alpha;
     1340        dec(count);
     1341        inc(pdest);
     1342        inc(psrc);
     1343      end;
     1344    end else
     1345      move(psrc^,pdest^,count*sizeof(TBGRAPixel));
     1346  end;
     1347
     1348  procedure CopyRGBAndSwapIfNecessary(psrc: PByte; pdest: PBGRAPixel; count: integer);
     1349  begin
     1350    if mustSwapRedBlue then
     1351    begin
     1352      while count > 0 do
     1353      begin
     1354        pdest^.blue := (psource_byte+2)^;
     1355        pdest^.green := (psource_byte+1)^;
     1356        pdest^.red := psource_byte^;
     1357        pdest^.alpha := DefaultOpacity;
     1358        inc(psrc,3);
     1359        inc(pdest);
     1360        dec(count);
     1361      end;
     1362    end else
     1363    begin
     1364      while count > 0 do
     1365      begin
     1366        PWord(pdest)^ := PWord(psource_byte)^;
     1367        pdest^.red := (psource_byte+2)^;
     1368        pdest^.alpha := DefaultOpacity;
     1369        inc(psrc,3);
     1370        inc(pdest);
     1371        dec(count);
     1372      end;
     1373    end;
     1374  end;
     1375
     1376  procedure CopyAndSwapIfNecessaryAndSetAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
     1377  begin
     1378    if mustReverse32 then
     1379    begin
     1380      while count > 0 do
     1381      begin
     1382        pdest^.blue := psrc^.alpha;
     1383        pdest^.green := psrc^.red;
     1384        pdest^.red := psrc^.green;
     1385        pdest^.alpha := DefaultOpacity; //use default opacity
     1386        inc(psrc);
     1387        inc(pdest);
     1388        dec(count);
     1389      end;
     1390    end else
     1391    if mustSwapRedBlue then
     1392    begin
     1393      while count > 0 do
     1394      begin
     1395        pdest^.red := psrc^.blue;
     1396        pdest^.green := psrc^.green;
     1397        pdest^.blue := psrc^.red;
     1398        pdest^.alpha := DefaultOpacity; //use default opacity
     1399        inc(psrc);
     1400        inc(pdest);
     1401        dec(count);
     1402      end;
     1403    end else
     1404    begin
     1405      while count > 0 do
     1406      begin
     1407        PWord(pdest)^ := PWord(psource_byte)^;
     1408        pdest^.red := psrc^.red;
     1409        pdest^.alpha := DefaultOpacity; //use default opacity
     1410        inc(psrc);
     1411        inc(pdest);
     1412        dec(count);
     1413      end;
     1414    end;
     1415  end;
     1416
     1417  procedure CopyAndSwapIfNecessaryAndReplaceAlpha(psrc: PBGRAPixel; pdest: PBGRAPixel; count: integer);
     1418  var OpacityOrMask, OpacityAndMask, sourceval: Longword;
     1419  begin
     1420    OpacityOrMask := NtoLE(longword(DefaultOpacity) shl 24);
     1421    OpacityAndMask := NtoLE($FFFFFF);
     1422    if mustReverse32 then
     1423    begin
     1424      OpacityAndMask := NtoBE($FFFFFF);
     1425      while count > 0 do
     1426      begin
     1427        sourceval := plongword(psrc)^ and OpacityAndMask;
     1428        if (sourceval <> 0) and (psrc^.blue{=alpha} = 0) then //if not black but transparent
     1429        begin
     1430          pdest^.blue := psrc^.alpha;
     1431          pdest^.green := psrc^.red;
     1432          pdest^.red := psrc^.green;
     1433          pdest^.alpha := DefaultOpacity; //use default opacity
     1434        end
     1435        else
     1436        begin
     1437          pdest^.blue := psrc^.alpha;
     1438          pdest^.green := psrc^.red;
     1439          pdest^.red := psrc^.green;
     1440          pdest^.alpha := psrc^.blue;
     1441        end;
     1442        dec(count);
     1443        inc(pdest);
     1444        inc(psrc);
     1445      end;
     1446    end else
     1447    if mustSwapRedBlue then
     1448    begin
     1449      while count > 0 do
     1450      begin
     1451        sourceval := plongword(psrc)^ and OpacityAndMask;
     1452        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
     1453        begin
     1454          pdest^.red := psrc^.blue;
     1455          pdest^.green := psrc^.green;
     1456          pdest^.blue := psrc^.red;
     1457          pdest^.alpha := DefaultOpacity; //use default opacity
     1458        end
     1459        else
     1460        begin
     1461          pdest^.red := psrc^.blue;
     1462          pdest^.green := psrc^.green;
     1463          pdest^.blue := psrc^.red;
     1464          pdest^.alpha := psrc^.alpha;
     1465        end;
     1466        dec(count);
     1467        inc(pdest);
     1468        inc(psrc);
     1469      end;
     1470    end else
     1471    begin
     1472      while count > 0 do
     1473      begin
     1474        sourceval := plongword(psrc)^ and OpacityAndMask;
     1475        if (sourceval <> 0) and (psrc^.alpha = 0) then //if not black but transparent
     1476          plongword(pdest)^ := sourceval or OpacityOrMask //use default opacity
     1477        else
     1478          pdest^ := psrc^;
     1479        dec(count);
     1480        inc(pdest);
     1481        inc(psrc);
     1482      end;
     1483    end;
     1484  end;
     1485
    8371486begin
    8381487  if (ARawImage.Description.Width <> cardinal(Width)) or
    8391488    (ARawImage.Description.Height <> cardinal(Height)) then
    840   begin
    8411489    raise Exception.Create('Bitmap size is inconsistant');
    842   end
     1490
     1491  DiscardBitmapChange;
     1492  if (Height=0) or (Width=0) then
     1493  begin
     1494    result := true;
     1495    exit;
     1496  end;
     1497
     1498  if ARawImage.Description.LineOrder = riloTopToBottom then
     1499  begin
     1500    psource_first := ARawImage.Data;
     1501    psource_delta := ARawImage.Description.BytesPerLine;
     1502  end else
     1503  begin
     1504    psource_first := ARawImage.Data + (ARawImage.Description.Height-1) * ARawImage.Description.BytesPerLine;
     1505    psource_delta := -ARawImage.Description.BytesPerLine;
     1506  end;
     1507
     1508  if ((ARawImage.Description.RedShift = 0) and
     1509    (ARawImage.Description.BlueShift = 16) and
     1510    (ARawImage.Description.ByteOrder = riboLSBFirst)) or
     1511    ((ARawImage.Description.RedShift = 24) and
     1512    (ARawImage.Description.BlueShift = 8) and
     1513    (ARawImage.Description.ByteOrder = riboMSBFirst)) then
     1514    mustSwapRedBlue:= true
    8431515  else
     1516  begin
     1517    mustSwapRedBlue:= false;
     1518    if ((ARawImage.Description.RedShift = 8) and
     1519      (ARawImage.Description.GreenShift = 16) and
     1520      (ARawImage.Description.BlueShift = 24) and
     1521      (ARawImage.Description.ByteOrder = riboLSBFirst)) or
     1522      ((ARawImage.Description.RedShift = 16) and
     1523      (ARawImage.Description.GreenShift = 8) and
     1524      (ARawImage.Description.BlueShift = 0) and
     1525      (ARawImage.Description.ByteOrder = riboMSBFirst)) then
     1526        mustReverse32 := true
     1527      else
     1528        mustReverse32 := false;
     1529  end;
     1530
     1531  if self.LineOrder = riloTopToBottom then
     1532  begin
     1533    pdest_first := PByte(self.Data);
     1534    pdest_delta := self.Width*sizeof(TBGRAPixel);
     1535  end else
     1536  begin
     1537    pdest_first := PByte(self.Data) + (self.Height-1)*self.Width*sizeof(TBGRAPixel);
     1538    pdest_delta := -self.Width*sizeof(TBGRAPixel);
     1539  end;
     1540
     1541  { 32 bits per pixel }
    8441542  if (ARawImage.Description.BitsPerPixel = 32) and
    845     (ARawImage.DataSize = longword(NbPixels) * sizeof(TBGRAPixel)) then
    846   begin
     1543    (ARawImage.DataSize >= longword(NbPixels) * 4) then
     1544  begin
     1545    { If there is an alpha channel }
    8471546    if (ARawImage.Description.AlphaPrec = 8) and not AlwaysReplaceAlpha then
    8481547    begin
    849       psource_pix := PBGRAPixel(ARawImage.Data);
    850       pdest_pix   := FData;
    8511548      if DefaultOpacity = 0 then
    852         move(psource_pix^, pdest_pix^, NbPixels * sizeof(TBGRAPixel))
     1549      begin
     1550        if ARawImage.Description.LineOrder = FLineOrder then
     1551          CopyAndSwapIfNecessary(PBGRAPixel(ARawImage.Data), FData, NbPixels) else
     1552        begin
     1553          psource_byte := psource_first;
     1554          pdest_byte := pdest_first;
     1555          for n := FHeight-1 downto 0 do
     1556          begin
     1557            CopyAndSwapIfNecessary(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
     1558            inc(psource_byte, psource_delta);
     1559            inc(pdest_byte, pdest_delta);
     1560          end;
     1561        end;
     1562      end
    8531563      else
    8541564      begin
    855         OpacityOrMask := longword(DefaultOpacity) shl 24;
    856         for n := NbPixels - 1 downto 0 do
     1565        psource_byte := psource_first;
     1566        pdest_byte := pdest_first;
     1567        for n := FHeight-1 downto 0 do
    8571568        begin
    858           sourceval := plongword(psource_pix)^ and $FFFFFF;
    859           if (sourceval <> 0) and (psource_pix^.alpha = 0) then
    860           begin
    861             plongword(pdest_pix)^ := sourceval or OpacityOrMask;
    862             InvalidateBitmap;
    863           end
    864           else
    865             pdest_pix^ := psource_pix^;
    866           Inc(pdest_pix);
    867           Inc(psource_pix);
     1569          CopyAndSwapIfNecessaryAndReplaceAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
     1570          inc(psource_byte, psource_delta);
     1571          inc(pdest_byte, pdest_delta);
    8681572        end;
    8691573      end;
    8701574    end
    8711575    else
    872     begin
    873       psource_byte := ARawImage.Data;
    874       pdest_byte   := PByte(FData);
    875       for n := NbPixels - 1 downto 0 do
     1576    begin { If there isn't any alpha channel }
     1577      psource_byte := psource_first;
     1578      pdest_byte := pdest_first;
     1579      for n := FHeight-1 downto 0 do
    8761580      begin
    877         PWord(pdest_byte)^ := PWord(psource_byte)^;
    878         Inc(pdest_byte, 2);
    879         Inc(psource_byte, 2);
    880         pdest_byte^ := psource_byte^;
    881         Inc(pdest_byte);
    882         Inc(psource_byte, 2);
    883         pdest_byte^ := DefaultOpacity;
    884         Inc(pdest_byte);
     1581        CopyAndSwapIfNecessaryAndSetAlpha(PBGRAPixel(psource_byte), PBGRAPixel(pdest_byte), FWidth);
     1582        inc(psource_byte, psource_delta);
     1583        inc(pdest_byte, pdest_delta);
    8851584      end;
    8861585    end;
    8871586  end
    8881587  else
     1588  { 24 bit per pixel }
    8891589  if (ARawImage.Description.BitsPerPixel = 24) then
    8901590  begin
    891     psource_byte := ARawImage.Data;
    892     pdest_byte := PByte(FData);
    893     delta := integer(ARawImage.Description.BytesPerLine) - FWidth * 3;
    894     for y := 0 to FHeight - 1 do
    895     begin
    896       for x := 0 to FWidth - 1 do
    897       begin
    898         PWord(pdest_byte)^ := PWord(psource_byte)^;
    899         Inc(pdest_byte, 2);
    900         Inc(psource_byte, 2);
    901         pdest_byte^ := psource_byte^;
    902         Inc(pdest_byte);
    903         Inc(psource_byte);
    904         pdest_byte^ := DefaultOpacity;
    905         Inc(pdest_byte);
    906       end;
    907       Inc(psource_byte, delta);
     1591    psource_byte := psource_first;
     1592    pdest_byte := pdest_first;
     1593    for n := FHeight-1 downto 0 do
     1594    begin
     1595      CopyRGBAndSwapIfNecessary(psource_byte, PBGRAPixel(pdest_byte), FWidth);
     1596      inc(psource_byte, psource_delta);
     1597      inc(pdest_byte, pdest_delta);
    9081598    end;
    9091599  end
    9101600  else
    911     raise Exception.Create('Invalid raw image format (' + IntToStr(
    912       ARawImage.Description.Depth) + ' found)');
    913   DiscardBitmapChange;
    914   if (ARawImage.Description.RedShift = 0) and
    915     (ARawImage.Description.BlueShift = 16) then
    916     SwapRedBlue;
    917   if ARawImage.Description.LineOrder <> FLineOrder then
    918     VerticalFlip;
     1601  begin
     1602    if RaiseErrorOnInvalidPixelFormat then
     1603      raise Exception.Create('Invalid raw image format (' + IntToStr(
     1604        ARawImage.Description.Depth) + ' found)') else
     1605    begin
     1606      result := false;
     1607      exit;
     1608    end;
     1609  end;
     1610
     1611  InvalidateBitmap;
     1612  result := true;
    9191613end;
    9201614
    … …  
    9381632end;
    9391633
     1634{ Initialize properties }
    9401635procedure TBGRADefaultBitmap.Init;
    941 var
    942   HeightP1, HeightM1: integer;
    9431636begin
    9441637  FRefCount  := 1;
    9451638  FBitmap    := nil;
     1639  FCanvasFP  := nil;
     1640  FCanvasBGRA := nil;
     1641  CanvasDrawModeFP := dmDrawWithTransparency;
    9461642  FData      := nil;
    9471643  FWidth     := 0;
    … …  
    9511647  FAlphaCorrectionNeeded := False;
    9521648  FEraseMode := False;
     1649  FillMode := fmWinding;
    9531650
    9541651  FFont     := TFont.Create;
    9551652  FontName  := 'Arial';
    9561653  FontStyle := [];
     1654  FontAntialias := False;
    9571655  FFontHeight := 20;
    958   FFontHeightSign := 1;
    959   HeightP1  := TextSize('Hg').cy;
    960   FFontHeightSign := -1;
    961   HeightM1  := TextSize('Hg').cy;
    962 
    963   if HeightP1 > HeightM1 then
    964     FFontHeightSign := 1
    965   else
    966     FFontHeightSign := -1;
     1656  FFontHeightSign := GetFontHeightSign(FFont);
     1657
     1658  PenStyle := psSolid;
     1659  LineCap := pecRound;
     1660  JoinStyle := pjsBevel;
     1661  JoinMiterLimit := 2;
     1662  ResampleFilter := rfHalfCosine;
     1663  ScanInterpolationFilter := rfLinear;
     1664  ScanOffset := Point(0,0);
    9671665end;
    9681666
    9691667procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor);
    970 var
    971   p: PByte;
    972 begin
    973   if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
    974     exit;
    975   p  := PByte(Scanline[y] + x);
    976   p^ := Value.blue shr 8;
    977   Inc(p);
    978   p^ := Value.green shr 8;
    979   Inc(p);
    980   p^ := Value.red shr 8;
    981   Inc(p);
    982   p^ := Value.alpha shr 8;
     1668begin
     1669  FCanvasPixelProcFP(x,y, FPColorToBGRA(Value));
     1670end;
     1671
     1672function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
     1673begin
     1674  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
     1675  result := BGRAToFPColor((Scanline[y] + x)^);
     1676end;
     1677
     1678procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
     1679var
     1680  c: TFPColor;
     1681begin
     1682  if not PtInClipRect(x,y) then exit;
     1683  c  := Palette.Color[Value];
     1684  (Scanline[y] + x)^ := FPColorToBGRA(c);
    9831685  InvalidateBitmap;
    9841686end;
    9851687
    986 {$hints off}
    987 function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
    988 var
    989   p: PByte;
    990   v: byte;
    991 begin
    992   if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
    993     exit;
    994   p := PByte(Scanline[y] + x);
    995   v := p^;
    996   Result.blue := v shl 8 + v;
    997   Inc(p);
    998   v := p^;
    999   Result.green := v shl 8 + v;
    1000   Inc(p);
    1001   v := p^;
    1002   Result.red := v shl 8 + v;
    1003   Inc(p);
    1004   v := p^;
    1005   Result.alpha := v shl 8 + v;
    1006 end;
    1007 
    1008 {$hints on}
    1009 
    1010 procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
    1011 var
    1012   p: PByte;
     1688function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
     1689var
    10131690  c: TFPColor;
    10141691begin
    1015   if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
    1016     exit;
    1017   c  := Palette.Color[Value];
    1018   p  := PByte(Scanline[y] + x);
    1019   p^ := c.blue shr 8;
    1020   Inc(p);
    1021   p^ := c.green shr 8;
    1022   Inc(p);
    1023   p^ := c.red shr 8;
    1024   Inc(p);
    1025   p^ := c.alpha shr 8;
    1026   InvalidateBitmap;
    1027 end;
    1028 
    1029 {$hints off}
    1030 function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
    1031 var
    1032   p: PByte;
    1033   v: byte;
    1034   c: TFPColor;
    1035 begin
    1036   if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
    1037     exit;
    1038   p      := PByte(Scanline[y] + x);
    1039   v      := p^;
    1040   c.blue := v shl 8 + v;
    1041   Inc(p);
    1042   v := p^;
    1043   c.green := v shl 8 + v;
    1044   Inc(p);
    1045   v     := p^;
    1046   c.red := v shl 8 + v;
    1047   Inc(p);
    1048   v      := p^;
    1049   c.alpha := v shl 8 + v;
     1692  if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then exit;
     1693  c := BGRAToFPColor((Scanline[y] + x)^);
    10501694  Result := palette.IndexOf(c);
    10511695end;
    1052 
    1053 {$hints on}
    10541696
    10551697procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
    … …  
    10861728{---------------------------- Line primitives ---------------------------------}
    10871729
    1088 procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
     1730function TBGRADefaultBitmap.CheckHorizLineBounds(var x,y,x2: integer): boolean; inline;
    10891731var
    10901732  temp: integer;
    … …  
    10961738    x2   := temp;
    10971739  end;
    1098   if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
     1740  if (x >= FClipRect.Right) or (x2 < FClipRect.Left) or (y < FClipRect.Top) or (y >= FClipRect.Bottom) then
     1741  begin
     1742    result := false;
    10991743    exit;
    1100   if x < 0 then
    1101     x := 0;
    1102   if x2 >= Width then
    1103     x2 := Width - 1;
     1744  end;
     1745  if x < FClipRect.Left then
     1746    x := FClipRect.Left;
     1747  if x2 >= FClipRect.Right then
     1748    x2 := FClipRect.Right - 1;
     1749  result := true;
     1750end;
     1751
     1752procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: integer; c: TBGRAPixel);
     1753begin
     1754  if not CheckHorizLineBounds(x,y,x2) then exit;
    11041755  FillInline(scanline[y] + x, c, x2 - x + 1);
    11051756  InvalidateBitmap;
    11061757end;
    11071758
     1759procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: integer; c: TBGRAPixel);
     1760begin
     1761  if not CheckHorizLineBounds(x,y,x2) then exit;
     1762  XorInline(scanline[y] + x, c, x2 - x + 1);
     1763  InvalidateBitmap;
     1764end;
     1765
    11081766procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; c: TBGRAPixel);
    1109 var
    1110   temp: integer;
    1111 begin
    1112   if (x2 < x) then
    1113   begin
    1114     temp := x;
    1115     x    := x2;
    1116     x2   := temp;
    1117   end;
    1118   if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
    1119     exit;
    1120   if x < 0 then
    1121     x := 0;
    1122   if x2 >= Width then
    1123     x2 := Width - 1;
     1767begin
     1768  if not CheckHorizLineBounds(x,y,x2) then exit;
    11241769  DrawPixelsInline(scanline[y] + x, c, x2 - x + 1);
    11251770  InvalidateBitmap;
    11261771end;
    11271772
     1773procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel
     1774  );
     1775begin
     1776  if not CheckHorizLineBounds(x,y,x2) then exit;
     1777  DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1);
     1778  InvalidateBitmap;
     1779end;
     1780
     1781procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: integer;
     1782  texture: IBGRAScanner);
     1783begin
     1784  if not CheckHorizLineBounds(x,y,x2) then exit;
     1785  texture.ScanMoveTo(x,y);
     1786  ScannerPutPixels(texture,scanline[y] + x, x2 - x + 1,dmDrawWithTransparency);
     1787  InvalidateBitmap;
     1788end;
     1789
    11281790procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel);
    1129 var
    1130   temp: integer;
    1131 begin
    1132   if (x2 < x) then
    1133   begin
    1134     temp := x;
    1135     x    := x2;
    1136     x2   := temp;
    1137   end;
    1138   if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
    1139     exit;
    1140   if x < 0 then
    1141     x := 0;
    1142   if x2 >= Width then
    1143     x2 := Width - 1;
     1791begin
     1792  if not CheckHorizLineBounds(x,y,x2) then exit;
    11441793  FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1);
    11451794  InvalidateBitmap;
    … …  
    11471796
    11481797procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: integer; alpha: byte);
    1149 var
    1150   temp: integer;
    11511798begin
    11521799  if alpha = 0 then
    … …  
    11551802    exit;
    11561803  end;
    1157   if (x2 < x) then
    1158   begin
    1159     temp := x;
    1160     x    := x2;
    1161     x2   := temp;
    1162   end;
    1163   if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
    1164     exit;
    1165   if x < 0 then
    1166     x := 0;
    1167   if x2 >= Width then
    1168     x2 := Width - 1;
     1804  if not CheckHorizLineBounds(x,y,x2) then exit;
    11691805  AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1);
    11701806  InvalidateBitmap;
    11711807end;
    11721808
    1173 procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: integer; c: TBGRAPixel);
    1174 var
    1175   temp, n, delta: integer;
    1176   p: PBGRAPixel;
    1177 begin
    1178   if (y2 < y) then
    1179   begin
    1180     temp := y;
    1181     y    := y2;
    1182     y2   := temp;
    1183   end;
    1184   if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
    1185     exit;
    1186   if y < 0 then
    1187     y := 0;
    1188   if y2 >= Height then
    1189     y2 := Height - 1;
    1190   p    := scanline[y] + x;
     1809function TBGRADefaultBitmap.CheckVertLineBounds(var x,y,y2: integer; out delta: integer): boolean; inline;
     1810var
     1811  temp: integer;
     1812begin
    11911813  if FLineOrder = riloBottomToTop then
    11921814    delta := -Width
    11931815  else
    11941816    delta := Width;
    1195   for n := y2 - y downto 0 do
    1196   begin
    1197     p^ := c;
    1198     Inc(p, delta);
    1199   end;
    1200   InvalidateBitmap;
    1201 end;
    1202 
    1203 procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
    1204 var
    1205   temp, n, delta: integer;
    1206   p: PBGRAPixel;
    1207 begin
     1817
    12081818  if (y2 < y) then
    12091819  begin
    … …  
    12121822    y2   := temp;
    12131823  end;
    1214   if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
     1824
     1825  if y < FClipRect.Top then
     1826    y := FClipRect.Top;
     1827  if y2 >= FClipRect.Bottom then
     1828    y2 := FClipRect.Bottom - 1;
     1829
     1830  if (y >= FClipRect.Bottom) or (y2 < FClipRect.Top) or (x < FClipRect.Left) or (x >= FClipRect.Right) then
     1831  begin
     1832    result := false;
    12151833    exit;
    1216   if y < 0 then
    1217     y := 0;
    1218   if y2 >= Height then
    1219     y2 := Height - 1;
     1834  end;
     1835
     1836  result := true;
     1837end;
     1838
     1839procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: integer; c: TBGRAPixel);
     1840var
     1841  n, delta: integer;
     1842  p: PBGRAPixel;
     1843begin
     1844  if not CheckVertLineBounds(x,y,y2,delta) then exit;
    12201845  p    := scanline[y] + x;
    1221   if FLineOrder = riloBottomToTop then
    1222     delta := -Width
    1223   else
    1224     delta := Width;
    12251846  for n := y2 - y downto 0 do
    12261847  begin
    1227     DrawPixelInline(p, c);
     1848    p^ := c;
    12281849    Inc(p, delta);
    12291850  end;
    … …  
    12311852end;
    12321853
     1854procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: integer; c: TBGRAPixel);
     1855var
     1856  n, delta: integer;
     1857  p: PBGRAPixel;
     1858begin
     1859  if not CheckVertLineBounds(x,y,y2,delta) then exit;
     1860  p    := scanline[y] + x;
     1861  for n := y2 - y downto 0 do
     1862  begin
     1863    PDword(p)^ := PDword(p)^ xor DWord(c);
     1864    Inc(p, delta);
     1865  end;
     1866  InvalidateBitmap;
     1867end;
     1868
     1869procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: integer; c: TBGRAPixel);
     1870var
     1871  n, delta: integer;
     1872  p: PBGRAPixel;
     1873begin
     1874  if c.alpha = 255 then
     1875  begin
     1876    SetVertLine(x,y,y2,c);
     1877    exit;
     1878  end;
     1879  if not CheckVertLineBounds(x,y,y2,delta) or (c.alpha=0) then exit;
     1880  p    := scanline[y] + x;
     1881  for n := y2 - y downto 0 do
     1882  begin
     1883    DrawPixelInlineNoAlphaCheck(p, c);
     1884    Inc(p, delta);
     1885  end;
     1886  InvalidateBitmap;
     1887end;
     1888
    12331889procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: integer; alpha: byte);
    12341890var
    1235   temp, n, delta: integer;
     1891  n, delta: integer;
    12361892  p: PBGRAPixel;
    12371893begin
    … …  
    12411897    exit;
    12421898  end;
    1243   if (y2 < y) then
     1899  if not CheckVertLineBounds(x,y,y2,delta) then exit;
     1900  p    := scanline[y] + x;
     1901  for n := y2 - y downto 0 do
     1902  begin
     1903    p^.alpha := alpha;
     1904    Inc(p, delta);
     1905  end;
     1906  InvalidateBitmap;
     1907end;
     1908
     1909procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
     1910var
     1911  n, delta: integer;
     1912  p: PBGRAPixel;
     1913begin
     1914  if not CheckVertLineBounds(x,y,y2,delta) then exit;
     1915  p    := scanline[y] + x;
     1916  for n := y2 - y downto 0 do
     1917  begin
     1918    FastBlendPixelInline(p, c);
     1919    Inc(p, delta);
     1920  end;
     1921  InvalidateBitmap;
     1922end;
     1923
     1924procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: integer;
     1925  c, compare: TBGRAPixel; maxDiff: byte);
     1926begin
     1927  if not CheckHorizLineBounds(x,y,x2) then exit;
     1928  DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
     1929  InvalidateBitmap;
     1930end;
     1931
     1932{---------------------------- Lines ---------------------------------}
     1933{ Call appropriate functions }
     1934
     1935procedure TBGRADefaultBitmap.DrawLine(x1, y1, x2, y2: integer;
     1936  c: TBGRAPixel; DrawLastPixel: boolean);
     1937begin
     1938  BGRADrawLineAliased(self,x1,y1,x2,y2,c,DrawLastPixel);
     1939end;
     1940
     1941procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
     1942  c: TBGRAPixel; DrawLastPixel: boolean);
     1943begin
     1944  BGRADrawLineAntialias(self,x1,y1,x2,y2,c,DrawLastPixel);
     1945end;
     1946
     1947procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
     1948  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
     1949begin
     1950  BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel);
     1951end;
     1952
     1953procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
     1954  c: TBGRAPixel; w: single);
     1955begin
     1956  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
     1957end;
     1958
     1959procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
     1960  texture: IBGRAScanner; w: single);
     1961begin
     1962  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
     1963end;
     1964
     1965procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
     1966  c: TBGRAPixel; w: single; closed: boolean);
     1967var
     1968  options: TBGRAPolyLineOptions;
     1969begin
     1970  if not closed then options := [plRoundCapOpen] else options := [];
     1971  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,nil,JoinMiterLimit);
     1972end;
     1973
     1974procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
     1975  texture: IBGRAScanner; w: single; Closed: boolean);
     1976var
     1977  options: TBGRAPolyLineOptions;
     1978  c: TBGRAPixel;
     1979begin
     1980  if not closed then
     1981  begin
     1982    options := [plRoundCapOpen];
     1983    c := BGRAWhite; //needed for alpha junction
     1984  end else
     1985  begin
     1986    options := [];
     1987    c := BGRAPixelTransparent;
     1988  end;
     1989  BGRAPolyLine(self,[PointF(x1,y1),PointF(x2,y2)],w,c,pecRound,pjsRound,FCustomPenStyle,options,texture,JoinMiterLimit);
     1990end;
     1991
     1992procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
     1993  c: TBGRAPixel; w: single);
     1994begin
     1995  BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[],nil,JoinMiterLimit);
     1996end;
     1997
     1998procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
     1999  const points: array of TPointF; texture: IBGRAScanner; w: single);
     2000begin
     2001  BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[],texture,JoinMiterLimit);
     2002end;
     2003
     2004procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
     2005  c: TBGRAPixel; w: single; Closed: boolean);
     2006var
     2007  options: TBGRAPolyLineOptions;
     2008begin
     2009  if not closed then options := [plRoundCapOpen] else options := [];
     2010  BGRAPolyLine(self,points,w,c,pecRound,JoinStyle,FCustomPenStyle,options,nil,JoinMiterLimit);
     2011end;
     2012
     2013procedure TBGRADefaultBitmap.DrawPolygonAntialias(const points: array of TPointF;
     2014  c: TBGRAPixel; w: single);
     2015begin
     2016   BGRAPolyLine(self,points,w,c,LineCap,JoinStyle,FCustomPenStyle,[plCycle],nil,JoinMiterLimit);
     2017end;
     2018
     2019procedure TBGRADefaultBitmap.DrawPolygonAntialias(
     2020  const points: array of TPointF; texture: IBGRAScanner; w: single);
     2021begin
     2022  BGRAPolyLine(self,points,w,BGRAPixelTransparent,LineCap,JoinStyle,FCustomPenStyle,[plCycle],texture,JoinMiterLimit);
     2023end;
     2024
     2025procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
     2026  alpha: byte; w: single; Closed: boolean);
     2027begin
     2028  FEraseMode := True;
     2029  DrawLineAntialias(x1, y1, x2, y2, BGRA(0, 0, 0, alpha), w, Closed);
     2030  FEraseMode := False;
     2031end;
     2032
     2033procedure TBGRADefaultBitmap.ErasePolyLineAntialias(const points: array of TPointF;
     2034  alpha: byte; w: single);
     2035begin
     2036  FEraseMode := True;
     2037  DrawPolyLineAntialias(points, BGRA(0,0,0,alpha),w);
     2038  FEraseMode := False;
     2039end;
     2040
     2041{------------------------ Shapes ----------------------------------------------}
     2042{ Call appropriate functions }
     2043
     2044procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF;
     2045  c1, c2, c3: TBGRAPixel);
     2046begin
     2047  FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]);
     2048end;
     2049
     2050procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2,
     2051  pt3: TPointF; c1, c2, c3: TBGRAPixel);
     2052var
     2053  grad: TBGRAGradientTriangleScanner;
     2054begin
     2055  grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
     2056  FillPolyAntialias([pt1,pt2,pt3],grad);
     2057  grad.Free;
     2058end;
     2059
     2060procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF;
     2061  texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True);
     2062begin
     2063  FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation);
     2064end;
     2065
     2066procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2,
     2067  pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,
     2068  light2, light3: word; TextureInterpolation: Boolean);
     2069begin
     2070  FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation);
     2071end;
     2072
     2073procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2,
     2074  pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
     2075var
     2076  mapping: TBGRATriangleLinearMapping;
     2077begin
     2078  mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
     2079  FillPolyAntialias([pt1,pt2,pt3],mapping);
     2080  mapping.Free;
     2081end;
     2082
     2083procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
     2084  c1, c2, c3, c4: TBGRAPixel);
     2085var
     2086  center: TPointF;
     2087  centerColor: TBGRAPixel;
     2088  multi: TBGRAMultishapeFiller;
     2089begin
     2090  if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors
     2091  begin
     2092    multi := TBGRAMultishapeFiller.Create;
     2093    multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4);
     2094    multi.Antialiasing:= false;
     2095    multi.Draw(self);
     2096    multi.Free;
     2097    exit;
     2098  end;
     2099  center := (pt1+pt2+pt3+pt4)*(1/4);
     2100  centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
     2101                    MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
     2102  FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
     2103  FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
     2104  FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
     2105  FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
     2106end;
     2107
     2108procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3,
     2109  pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
     2110var multi : TBGRAMultishapeFiller;
     2111begin
     2112  multi := TBGRAMultishapeFiller.Create;
     2113  multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4);
     2114  multi.Draw(self);
     2115  multi.free;
     2116end;
     2117
     2118procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF;
     2119  texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);
     2120var
     2121  center: TPointF;
     2122  centerTex: TPointF;
     2123begin
     2124  center := (pt1+pt2+pt3+pt4)*(1/4);
     2125  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
     2126  FillTriangleLinearMapping(pt1,pt2,center, texture,tex1,tex2,centerTex, TextureInterpolation);
     2127  FillTriangleLinearMapping(pt2,pt3,center, texture,tex2,tex3,centerTex, TextureInterpolation);
     2128  FillTriangleLinearMapping(pt3,pt4,center, texture,tex3,tex4,centerTex, TextureInterpolation);
     2129  FillTriangleLinearMapping(pt4,pt1,center, texture,tex4,tex1,centerTex, TextureInterpolation);
     2130end;
     2131
     2132procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3,
     2133  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,
     2134  light2, light3, light4: word; TextureInterpolation: Boolean);
     2135var
     2136  center: TPointF;
     2137  centerTex: TPointF;
     2138  centerLight: word;
     2139begin
     2140  center := (pt1+pt2+pt3+pt4)*(1/4);
     2141  centerTex := (tex1+tex2+tex3+tex4)*(1/4);
     2142  centerLight := (light1+light2+light3+light4) div 4;
     2143  FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation);
     2144  FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation);
     2145  FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation);
     2146  FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation);
     2147end;
     2148
     2149procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3,
     2150  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
     2151var multi : TBGRAMultishapeFiller;
     2152begin
     2153  multi := TBGRAMultishapeFiller.Create;
     2154  multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4);
     2155  multi.Draw(self);
     2156  multi.free;
     2157end;
     2158
     2159procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
     2160  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
     2161var
     2162  persp: TBGRAPerspectiveScannerTransform;
     2163begin
     2164  persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
     2165  FillPoly([pt1,pt2,pt3,pt4],persp,dmDrawWithTransparency);
     2166  persp.Free;
     2167end;
     2168
     2169procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
     2170  pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
     2171var
     2172  persp: TBGRAPerspectiveScannerTransform;
     2173begin
     2174  persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
     2175  FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
     2176  persp.Free;
     2177end;
     2178
     2179procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF;
     2180  texture: IBGRAScanner; texCoords: array of TPointF;
     2181  TextureInterpolation: Boolean);
     2182begin
     2183  PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
     2184end;
     2185
     2186procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness(
     2187  const points: array of TPointF; texture: IBGRAScanner;
     2188  texCoords: array of TPointF; lightnesses: array of word;
     2189  TextureInterpolation: Boolean);
     2190begin
     2191  PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding);
     2192end;
     2193
     2194procedure TBGRADefaultBitmap.FillPolyLinearColor(
     2195  const points: array of TPointF; AColors: array of TBGRAPixel);
     2196begin
     2197  PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding);
     2198end;
     2199
     2200procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping(
     2201  const points: array of TPointF; const pointsZ: array of single;
     2202  texture: IBGRAScanner; texCoords: array of TPointF;
     2203  TextureInterpolation: Boolean);
     2204begin
     2205  PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
     2206end;
     2207
     2208procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness(
     2209  const points: array of TPointF; const pointsZ: array of single;
     2210  texture: IBGRAScanner; texCoords: array of TPointF;
     2211  lightnesses: array of word; TextureInterpolation: Boolean);
     2212begin
     2213  PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding);
     2214end;
     2215
     2216procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
     2217  c: TBGRAPixel; drawmode: TDrawMode);
     2218begin
     2219  BGRAPolygon.FillPolyAliased(self, points, c, FEraseMode, FillMode = fmWinding, drawmode);
     2220end;
     2221
     2222procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
     2223  texture: IBGRAScanner; drawmode: TDrawMode);
     2224begin
     2225  BGRAPolygon.FillPolyAliasedWithTexture(self, points, texture, FillMode = fmWinding, drawmode);
     2226end;
     2227
     2228procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
     2229  alpha: byte; w: single);
     2230begin
     2231  FEraseMode := True;
     2232  DrawLineAntialias(x1,y1,x2,y2, BGRA(0,0,0,alpha),w);
     2233  FEraseMode := False;
     2234end;
     2235
     2236procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel);
     2237begin
     2238  BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode, FillMode = fmWinding);
     2239end;
     2240
     2241procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF;
     2242  texture: IBGRAScanner);
     2243begin
     2244  BGRAPolygon.FillPolyAntialiasWithTexture(self, points, texture, FillMode = fmWinding);
     2245end;
     2246
     2247procedure TBGRADefaultBitmap.ErasePoly(const points: array of TPointF;
     2248  alpha: byte);
     2249begin
     2250  BGRAPolygon.FillPolyAliased(self, points, BGRA(0, 0, 0, alpha), True, FillMode = fmWinding, dmDrawWithTransparency);
     2251end;
     2252
     2253procedure TBGRADefaultBitmap.ErasePolyAntialias(const points: array of TPointF; alpha: byte);
     2254begin
     2255  FEraseMode := True;
     2256  FillPolyAntialias(points, BGRA(0, 0, 0, alpha));
     2257  FEraseMode := False;
     2258end;
     2259
     2260procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
     2261  c: TBGRAPixel; w: single);
     2262begin
     2263  if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
     2264  if IsSolidPenStyle(FCustomPenStyle) then
     2265    BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode)
     2266  else
     2267    DrawPolygonAntialias(ComputeEllipse(x,y,rx,ry),c,w);
     2268end;
     2269
     2270procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
     2271  texture: IBGRAScanner; w: single);
     2272begin
     2273  if IsClearPenStyle(FCustomPenStyle) then exit;
     2274  if IsSolidPenStyle(FCustomPenStyle) then
     2275    BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture)
     2276  else
     2277    DrawPolygonAntialias(ComputeEllipse(x,y,rx,ry),texture,w);
     2278end;
     2279
     2280procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
     2281  c: TBGRAPixel; w: single; back: TBGRAPixel);
     2282var multi: TBGRAMultishapeFiller;
     2283    hw: single;
     2284begin
     2285  if w=0 then exit;
     2286  rx := abs(rx);
     2287  ry := abs(ry);
     2288  hw := w/2;
     2289  if (rx <= hw) or (ry <= hw) then
     2290  begin
     2291    FillEllipseAntialias(x,y,rx+hw,ry+hw,c);
     2292    exit;
     2293  end;
     2294  { use multishape filler for fine junction between polygons }
     2295  multi := TBGRAMultishapeFiller.Create;
     2296  if not IsClearPenStyle(FCustomPenStyle) and (c.alpha <> 0) then
     2297  begin
     2298    if IsSolidPenStyle(FCustomPenStyle) then
     2299    begin
     2300      multi.AddEllipse(x,y,rx-hw,ry-hw,back);
     2301      multi.AddEllipseBorder(x,y,rx,ry,w,c)
     2302    end
     2303    else
     2304    begin
     2305      multi.AddEllipse(x,y,rx,ry,back);
     2306      multi.AddPolygon(ComputeWidePolygon(ComputeEllipse(x,y,rx,ry),w),c);
     2307      multi.PolygonOrder := poLastOnTop;
     2308    end;
     2309  end;
     2310  multi.Draw(self);
     2311  multi.Free;
     2312end;
     2313
     2314procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
     2315begin
     2316  BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode);
     2317end;
     2318
     2319procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single;
     2320  texture: IBGRAScanner);
     2321begin
     2322  BGRAPolygon.FillEllipseAntialiasWithTexture(self, x, y, rx, ry, texture);
     2323end;
     2324
     2325procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx,
     2326  ry: single; outercolor, innercolor: TBGRAPixel);
     2327var
     2328    grad: TBGRAGradientScanner;
     2329    affine: TBGRAAffineScannerTransform;
     2330begin
     2331  if (rx=0) or (ry=0) then exit;
     2332  if rx=ry then
     2333  begin
     2334    grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True);
     2335    FillEllipseAntialias(x,y,rx,ry,grad);
     2336    grad.Free;
     2337  end else
     2338  begin
     2339    grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
     2340    affine := TBGRAAffineScannerTransform.Create(grad);
     2341    affine.Scale(rx,ry);
     2342    affine.Translate(x,y);
     2343    FillEllipseAntialias(x,y,rx,ry,affine);
     2344    affine.Free;
     2345    grad.Free;
     2346  end;
     2347end;
     2348
     2349procedure TBGRADefaultBitmap.EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
     2350begin
     2351  FEraseMode := True;
     2352  FillEllipseAntialias(x, y, rx, ry, BGRA(0, 0, 0, alpha));
     2353  FEraseMode := False;
     2354end;
     2355
     2356procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
     2357  c: TBGRAPixel; w: single; back: TBGRAPixel);
     2358var
     2359  bevel: single;
     2360  multi: TBGRAMultishapeFiller;
     2361  hw: single;
     2362begin
     2363  if IsClearPenStyle(FCustomPenStyle) or (c.alpha=0) or (w=0) then
     2364  begin
     2365    if back <> BGRAPixelTransparent then
     2366      FillRectAntialias(x,y,x2,y2,back);
     2367    exit;
     2368  end;
     2369
     2370  hw := w/2;
     2371  if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
     2372  begin
     2373    if JoinStyle = pjsBevel then
     2374    begin
     2375      bevel := (2-sqrt(2))*hw;
     2376      FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
     2377    end else
     2378    if JoinStyle = pjsRound then
     2379     FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c)
     2380    else
     2381     FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c);
     2382    exit;
     2383  end;
     2384
     2385  { use multishape filler for fine junction between polygons }
     2386  multi := TBGRAMultishapeFiller.Create;
     2387  multi.FillMode := FillMode;
     2388  if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
     2389    multi.AddRectangleBorder(x,y,x2,y2,w,c)
     2390  else
     2391    multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c);
     2392
     2393  if (frac(x + hw) = 0.5) and (frac(y + hw)=0.5) and (frac(x2 - hw)=0.5) and (frac(y2 - hw)=0.5) then
     2394    FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency)
     2395  else
     2396    multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back);
     2397  multi.Draw(self);
     2398  multi.Free;
     2399end;
     2400
     2401procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
     2402  texture: IBGRAScanner; w: single);
     2403var
     2404  bevel,hw: single;
     2405  multi: TBGRAMultishapeFiller;
     2406begin
     2407  if IsClearPenStyle(FCustomPenStyle) or (w=0) then exit;
     2408
     2409  hw := w/2;
     2410  if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
     2411  begin
     2412    if JoinStyle = pjsBevel then
     2413    begin
     2414      bevel := (2-sqrt(2))*hw;
     2415      FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, texture, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
     2416    end else
     2417    if JoinStyle = pjsRound then
     2418     FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, texture)
     2419    else
     2420     FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, texture);
     2421    exit;
     2422  end;
     2423
     2424  { use multishape filler for fine junction between polygons }
     2425  multi := TBGRAMultishapeFiller.Create;
     2426  multi.FillMode := FillMode;
     2427  if (JoinStyle = pjsMiter) and IsSolidPenStyle(FCustomPenStyle) then
     2428    multi.AddRectangleBorder(x,y,x2,y2,w, texture)
     2429  else
     2430    multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w), texture);
     2431  multi.Draw(self);
     2432  multi.Free;
     2433end;
     2434
     2435procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
     2436   c: TBGRAPixel; w: single; options: TRoundRectangleOptions);
     2437begin
     2438  if IsClearPenStyle(FCustomPenStyle) or (c.alpha = 0) then exit;
     2439  if IsSolidPenStyle(FCustomPenStyle) then
     2440    BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False)
     2441  else
     2442    DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w);
     2443end;
     2444
     2445procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
     2446  pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel;
     2447  options: TRoundRectangleOptions);
     2448var
     2449  multi: TBGRAMultishapeFiller;
     2450begin
     2451  if IsClearPenStyle(FCustomPenStyle) or (pencolor.alpha = 0) then
     2452  begin
     2453    FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options);
     2454    exit;
     2455  end;
     2456  if IsSolidPenStyle(FCustomPenStyle) then
     2457    BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False)
     2458  else
     2459  begin
     2460    multi := TBGRAMultishapeFiller.Create;
     2461    multi.PolygonOrder := poLastOnTop;
     2462    multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options);
     2463    multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor);
     2464    multi.Draw(self);
     2465    multi.Free;
     2466  end;
     2467end;
     2468
     2469procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
     2470  penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner;
     2471  options: TRoundRectangleOptions);
     2472var
     2473  multi: TBGRAMultishapeFiller;
     2474begin
     2475  if IsClearPenStyle(FCustomPenStyle) then
     2476  begin
     2477    FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options);
     2478    exit;
     2479  end else
     2480  if IsSolidPenStyle(FCustomPenStyle) then
     2481    BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False)
     2482  else
     2483  begin
     2484    multi := TBGRAMultishapeFiller.Create;
     2485    multi.PolygonOrder := poLastOnTop;
     2486    multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options);
     2487    multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture);
     2488    multi.Draw(self);
     2489    multi.Free;
     2490  end;
     2491end;
     2492
     2493procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
     2494  texture: IBGRAScanner; w: single; options: TRoundRectangleOptions);
     2495begin
     2496  if IsClearPenStyle(FCustomPenStyle) then exit;
     2497  if IsSolidPenStyle(FCustomPenStyle) then
     2498    BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture)
     2499  else
     2500    DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w);
     2501end;
     2502
     2503function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline;
     2504var
     2505  temp: integer;
     2506begin
     2507  //swap coordinates if needed
     2508  if (x > x2) then
     2509  begin
     2510    temp := x;
     2511    x    := x2;
     2512    x2   := temp;
     2513  end;
     2514  if (y > y2) then
    12442515  begin
    12452516    temp := y;
    … …  
    12472518    y2   := temp;
    12482519  end;
    1249   if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
     2520  if (x2 - x <= minsize) or (y2 - y <= minsize) then
     2521  begin
     2522    result := false;
    12502523    exit;
    1251   if y < 0 then
    1252     y := 0;
    1253   if y2 >= Height then
    1254     y2 := Height - 1;
    1255   p    := scanline[y] + x;
    1256   if FLineOrder = riloBottomToTop then
    1257     delta := -Width
    1258   else
    1259     delta := Width;
    1260   for n := y2 - y downto 0 do
    1261   begin
    1262     p^.alpha := alpha;
    1263     Inc(p, delta);
    1264   end;
    1265   InvalidateBitmap;
    1266 end;
    1267 
    1268 procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel);
    1269 var
    1270   temp, n, delta: integer;
    1271   p: PBGRAPixel;
    1272 begin
    1273   if (y2 < y) then
    1274   begin
    1275     temp := y;
    1276     y    := y2;
    1277     y2   := temp;
    1278   end;
    1279   if (y >= Height) or (y2 < 0) or (x < 0) or (x >= Width) then
    1280     exit;
    1281   if y < 0 then
    1282     y := 0;
    1283   if y2 >= Height then
    1284     y2 := Height - 1;
    1285   p    := scanline[y] + x;
    1286   if FLineOrder = riloBottomToTop then
    1287     delta := -Width
    1288   else
    1289     delta := Width;
    1290   for n := y2 - y downto 0 do
    1291   begin
    1292     FastBlendPixelInline(p, c);
    1293     Inc(p, delta);
    1294   end;
    1295   InvalidateBitmap;
    1296 end;
    1297 
    1298 procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: integer;
    1299   c, compare: TBGRAPixel; maxDiff: byte);
    1300 var
    1301   temp: integer;
    1302 begin
    1303   if (x2 < x) then
    1304   begin
    1305     temp := x;
    1306     x    := x2;
    1307     x2   := temp;
    1308   end;
    1309   if (x >= Width) or (x2 < 0) or (y < 0) or (y >= Height) then
    1310     exit;
    1311   if x < 0 then
    1312     x := 0;
    1313   if x2 >= Width then
    1314     x2 := Width - 1;
    1315   DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
    1316   InvalidateBitmap;
    1317 end;
    1318 
    1319 {---------------------------- Shapes ---------------------------------}
    1320 
    1321 procedure TBGRADefaultBitmap.DrawLine(x1, y1, x2, y2: integer;
    1322   c: TBGRAPixel; DrawLastPixel: boolean);
    1323 var
    1324   Y, X: integer;
    1325   DX, DY, SX, SY, E: integer;
    1326 begin
    1327 
    1328   if (Y1 = Y2) and (X1 = X2) then
    1329   begin
    1330     if DrawLastPixel then
    1331       DrawPixel(X1, Y1, c);
    1332     Exit;
    1333   end;
    1334 
    1335   DX := X2 - X1;
    1336   DY := Y2 - Y1;
    1337 
    1338   if DX < 0 then
    1339   begin
    1340     SX := -1;
    1341     DX := -DX;
    1342   end
    1343   else
    1344     SX := 1;
    1345 
    1346   if DY < 0 then
    1347   begin
    1348     SY := -1;
    1349     DY := -DY;
    1350   end
    1351   else
    1352     SY := 1;
    1353 
    1354   DX := DX shl 1;
    1355   DY := DY shl 1;
    1356 
    1357   X := X1;
    1358   Y := Y1;
    1359   if DX > DY then
    1360   begin
    1361     E := DY - DX shr 1;
    1362 
    1363     while X <> X2 do
    1364     begin
    1365       DrawPixel(X, Y, c);
    1366       if E >= 0 then
    1367       begin
    1368         Inc(Y, SY);
    1369         Dec(E, DX);
    1370       end;
    1371       Inc(X, SX);
    1372       Inc(E, DY);
    1373     end;
    1374   end
    1375   else
    1376   begin
    1377     E := DX - DY shr 1;
    1378 
    1379     while Y <> Y2 do
    1380     begin
    1381       DrawPixel(X, Y, c);
    1382       if E >= 0 then
    1383       begin
    1384         Inc(X, SX);
    1385         Dec(E, DY);
    1386       end;
    1387       Inc(Y, SY);
    1388       Inc(E, DX);
    1389     end;
    1390   end;
    1391 
    1392   if DrawLastPixel then
    1393     DrawPixel(X2, Y2, c);
    1394 end;
    1395 
    1396 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
    1397   c: TBGRAPixel; DrawLastPixel: boolean);
    1398 var
    1399   Y, X:  integer;
    1400   DX, DY, SX, SY, E: integer;
    1401   alpha: single;
    1402 begin
    1403 
    1404   if (Y1 = Y2) and (X1 = X2) then
    1405   begin
    1406     if DrawLastPixel then
    1407       DrawPixel(X1, Y1, c);
    1408     Exit;
    1409   end;
    1410 
    1411   DX := X2 - X1;
    1412   DY := Y2 - Y1;
    1413 
    1414   if DX < 0 then
    1415   begin
    1416     SX := -1;
    1417     DX := -DX;
    1418   end
    1419   else
    1420     SX := 1;
    1421 
    1422   if DY < 0 then
    1423   begin
    1424     SY := -1;
    1425     DY := -DY;
    1426   end
    1427   else
    1428     SY := 1;
    1429 
    1430   DX := DX shl 1;
    1431   DY := DY shl 1;
    1432 
    1433   X := X1;
    1434   Y := Y1;
    1435 
    1436   if DX > DY then
    1437   begin
    1438     E := 0;
    1439 
    1440     while X <> X2 do
    1441     begin
    1442       alpha := 1 - E / DX;
    1443       DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    1444       DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
    1445         round(c.alpha * sqrt(1 - alpha))));
    1446       Inc(E, DY);
    1447       if E >= DX then
    1448       begin
    1449         Inc(Y, SY);
    1450         Dec(E, DX);
    1451       end;
    1452       Inc(X, SX);
    1453     end;
    1454   end
    1455   else
    1456   begin
    1457     E := 0;
    1458 
    1459     while Y <> Y2 do
    1460     begin
    1461       alpha := 1 - E / DY;
    1462       DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    1463       DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
    1464         round(c.alpha * sqrt(1 - alpha))));
    1465       Inc(E, DX);
    1466       if E >= DY then
    1467       begin
    1468         Inc(X, SX);
    1469         Dec(E, DY);
    1470       end;
    1471       Inc(Y, SY);
    1472     end;
    1473   end;
    1474   if DrawLastPixel then
    1475     DrawPixel(X2, Y2, c);
    1476 end;
    1477 
    1478 procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPoint;
    1479   c: TBGRAPixel; DrawLastPixel: boolean);
    1480 var i: integer;
    1481 begin
    1482    if length(points) = 1 then
    1483    begin
    1484      if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
    1485    end
    1486    else
    1487      for i := 0 to high(points)-1 do
    1488        DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1));
    1489 end;
    1490 
    1491 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
    1492   c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
    1493 var
    1494   Y, X:  integer;
    1495   DX, DY, SX, SY, E: integer;
    1496   alpha: single;
    1497   c:     TBGRAPixel;
    1498   DashPos: integer;
    1499 begin
    1500 
    1501   c := c1;
    1502   DashPos := 0;
    1503 
    1504   if (Y1 = Y2) and (X1 = X2) then
    1505   begin
    1506     if DrawLastPixel then
    1507       DrawPixel(X1, Y1, c);
    1508     Exit;
    1509   end;
    1510 
    1511   DX := X2 - X1;
    1512   DY := Y2 - Y1;
    1513 
    1514   if DX < 0 then
    1515   begin
    1516     SX := -1;
    1517     DX := -DX;
    1518   end
    1519   else
    1520     SX := 1;
    1521 
    1522   if DY < 0 then
    1523   begin
    1524     SY := -1;
    1525     DY := -DY;
    1526   end
    1527   else
    1528     SY := 1;
    1529 
    1530   DX := DX shl 1;
    1531   DY := DY shl 1;
    1532 
    1533   X := X1;
    1534   Y := Y1;
    1535 
    1536   if DX > DY then
    1537   begin
    1538     E := 0;
    1539 
    1540     while X <> X2 do
    1541     begin
    1542       alpha := 1 - E / DX;
    1543       DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    1544       DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
    1545         round(c.alpha * sqrt(1 - alpha))));
    1546       Inc(E, DY);
    1547       if E >= DX then
    1548       begin
    1549         Inc(Y, SY);
    1550         Dec(E, DX);
    1551       end;
    1552       Inc(X, SX);
    1553 
    1554       Inc(DashPos);
    1555       if DashPos = DashLen then
    1556         c := c2
    1557       else
    1558       if DashPos = DashLen + DashLen then
    1559       begin
    1560         c := c1;
    1561         DashPos := 0;
    1562       end;
    1563     end;
    1564   end
    1565   else
    1566   begin
    1567     E := 0;
    1568 
    1569     while Y <> Y2 do
    1570     begin
    1571       alpha := 1 - E / DY;
    1572       DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    1573       DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
    1574         round(c.alpha * sqrt(1 - alpha))));
    1575       Inc(E, DX);
    1576       if E >= DY then
    1577       begin
    1578         Inc(X, SX);
    1579         Dec(E, DY);
    1580       end;
    1581       Inc(Y, SY);
    1582 
    1583       Inc(DashPos);
    1584       if DashPos = DashLen then
    1585         c := c2
    1586       else
    1587       if DashPos = DashLen + DashLen then
    1588       begin
    1589         c := c1;
    1590         DashPos := 0;
    1591       end;
    1592     end;
    1593   end;
    1594   if DrawLastPixel then
    1595     DrawPixel(X2, Y2, c);
    1596 end;
    1597 
    1598 procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPoint; c1,
    1599   c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
    1600 var i: integer;
    1601 begin
    1602    if length(points) = 1 then
    1603    begin
    1604      if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c1);
    1605    end
    1606    else
    1607      for i := 0 to high(points)-1 do
    1608        DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c1,c2,dashLen,DrawLastPixel and (i=high(points)-1));
    1609 end;
    1610 
    1611 procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
    1612   c: TBGRAPixel; w: single; closed: boolean);
    1613 var
    1614   dx, dy, d, hx, hy, wx, wy, t, t2, t3: single;
    1615   nbInter, i: integer;
    1616 
    1617   poly: array of tpointf;
    1618   alphaFactor: single;
    1619 begin
    1620   if (w <= 0) then
    1621     exit;
    1622   if (w = 1) and (frac(x1) = 0) and (frac(y1) = 0) and (frac(x2) = 0) and
    1623     (frac(y2) = 0) then
    1624   begin
    1625     DrawLineAntialias(round(x1), round(y1), round(x2), round(y2), c, closed);
    1626     exit;
    1627   end;
    1628 
    1629   dx := x2 - x1;
    1630   dy := y2 - y1;
    1631   if (dx = 0) and (dy = 0) then
    1632   begin
    1633     if closed then
    1634       FillEllipseAntialias(x1, y1, w / 2, w / 2, c);
    1635     exit;
    1636   end;
    1637 
    1638   d  := sqrt(sqr(dx) + sqr(dy));
    1639   dx /= d;
    1640   dy /= d;
    1641   hx := dy * w / 2;
    1642   hy := -dx * w / 2;
    1643   wx := dx * w / 2;
    1644   wy := dy * w / 2;
    1645 
    1646   nbInter := (ceil(w) + 1) * 2;
    1647   setlength(poly, 4 + nbInter * 2);
    1648   poly[0] := pointf(x1 + hx, y1 + hy);
    1649   poly[1] := pointf(x2 + hx, y2 + hy);
    1650 
    1651   if closed then
    1652   begin
    1653     for i := 0 to nbInter - 1 do
    1654     begin
    1655       t  := 1 - (i + 1) / (nbInter + 1) * 2;
    1656       t2 := sqrt(1 - sqr(t));
    1657       poly[2 + i] := pointf(x2 + t * hx + t2 * wx, y2 + t * hy + t2 * wy);
    1658     end;
    1659   end
    1660   else
    1661   begin
    1662     if c.alpha=255 then alphaFactor := 1 else
    1663     begin
    1664       alphaFactor := sqr(c.alpha / 255) / 2.5;
    1665       if (c.alpha > 220) then
    1666       begin
    1667         t := sqr(sqr((c.alpha-220)/(255-220)));
    1668         alphaFactor := alphaFactor*(1-t)+0.8*t;
    1669       end;
    1670     end;
    1671     for i := 0 to nbInter - 1 do
    1672     begin
    1673       t  := 1 - (i + 1) / (nbInter + 1) * 2;
    1674       t2 := sqrt(1 - sqr(t));
    1675       t3 := (1 - t2) * 0.7;
    1676       poly[2 + i] := pointf(x2 + t * hx - t2 * wx + dx * (alphaFactor + t3),
    1677         y2 + t * hy - t2 * wy + dy * (alphaFactor + t3));
    1678     end;
    1679   end;
    1680 
    1681   poly[2 + nbinter] := pointf(x2 - hx, y2 - hy);
    1682   poly[3 + nbinter] := pointf(x1 - hx, y1 - hy);
    1683 
    1684   for i := 0 to nbInter - 1 do
    1685   begin
    1686     t  := (i + 1) / (nbInter + 1) * 2 - 1;
    1687     t2 := sqrt(1 - sqr(t));
    1688     poly[4 + nbinter + i] := pointf(x1 + t * hx - t2 * wx, y1 + t * hy - t2 * wy);
    1689   end;
    1690 
    1691   FillPolyAntialias(poly, c);
    1692 end;
    1693 
    1694 procedure TBGRADefaultBitmap.DrawPolyLineAntialias(points: array of TPointF;
    1695   c: TBGRAPixel; w: single; Closed: boolean);
    1696 var i: integer;
    1697 begin
    1698    if length(points) = 1 then
    1699    begin
    1700      if Closed then DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,w,true);
    1701    end
    1702    else
    1703      for i := 0 to high(points)-1 do
    1704        DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,w,Closed and (i=high(points)-1));
    1705 end;
    1706 
    1707 procedure TBGRADefaultBitmap.DrawPolygonAntialias(points: array of TPointF;
    1708   c: TBGRAPixel; w: single);
    1709 var i: integer;
    1710 begin
    1711    if length(points) = 1 then
    1712    begin
    1713      DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,w,true);
    1714    end
    1715    else
    1716    if length(points) > 1 then
    1717    begin
    1718      for i := 0 to high(points)-1 do
    1719        DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,w,False);
    1720      DrawLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,w,False);
    1721    end;
    1722 end;
    1723 
    1724 procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
    1725   alpha: byte; w: single; Closed: boolean);
    1726 begin
    1727   FEraseMode := True;
    1728   DrawLineAntialias(x1, y1, x2, y2, BGRA(0, 0, 0, alpha), w, Closed);
    1729   FEraseMode := False;
    1730 end;
    1731 
    1732 procedure TBGRADefaultBitmap.FillPolyAntialias(points: array of TPointF; c: TBGRAPixel);
    1733 begin
    1734   BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode);
    1735 end;
    1736 
    1737 procedure TBGRADefaultBitmap.ErasePolyAntialias(points: array of TPointF; alpha: byte);
    1738 begin
    1739   FEraseMode := True;
    1740   FillPolyAntialias(points, BGRA(0, 0, 0, alpha));
    1741   FEraseMode := False;
    1742 end;
    1743 
    1744 procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
    1745   c: TBGRAPixel; w: single);
    1746 begin
    1747   BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode);
    1748 end;
    1749 
    1750 procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
    1751 begin
    1752   BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode);
    1753 end;
    1754 
    1755 procedure TBGRADefaultBitmap.EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
    1756 begin
    1757   FEraseMode := True;
    1758   FillEllipseAntialias(x, y, rx, ry, BGRA(0, 0, 0, alpha));
    1759   FEraseMode := False;
    1760 end;
    1761 
    1762 {------------------------ Shapes ----------------------------------------------}
    1763 
    1764 procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
    1765 begin
    1766   Rectangle(x, y, x2, y2, ColorToBGRA(c), dmSet);
    1767 end;
    1768 
    1769 procedure TBGRADefaultBitmap.Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode);
    1770 begin
    1771   Rectangle(r.left, r.top, r.right, r.bottom, c, mode);
    1772 end;
    1773 
    1774 procedure TBGRADefaultBitmap.Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel;
    1775   mode: TDrawMode);
    1776 begin
    1777   Rectangle(r.left, r.top, r.right, r.bottom, BorderColor, FillColor, mode);
    1778 end;
    1779 
    1780 procedure TBGRADefaultBitmap.Rectangle(r: TRect; c: TColor);
    1781 begin
    1782   Rectangle(r.left, r.top, r.right, r.bottom, c);
    1783 end;
    1784 
    1785 procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
    1786   c: TBGRAPixel; w: single);
    1787 begin
    1788   RectangleAntialias(x, y, x2, y2, c, w, BGRAPixelTransparent);
    1789 end;
    1790 
    1791 procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
    1792   c: TBGRAPixel; w: single; back: TBGRAPixel);
    1793 var
    1794   poly: array of TPointF;
    1795   temp: single;
    1796 begin
    1797   if (x > x2) then
    1798   begin
    1799     temp := x;
    1800     x    := x2;
    1801     x2   := temp;
    1802   end;
    1803   if (y > y2) then
    1804   begin
    1805     temp := y;
    1806     y    := y2;
    1807     y2   := temp;
    1808   end;
    1809 
    1810   if (x2 - x <= w) or (y2 - y <= w) then
    1811   begin
    1812     FillRectAntialias(x - w / 2, y - w / 2, x2 + w / 2, y2 + w / 2, c);
    1813     exit;
    1814   end;
    1815   w /= 2;
    1816 
    1817   setlength(poly, 9);
    1818   poly[0] := pointf(x - w, y - w);
    1819   poly[1] := pointf(x2 + w, y - w);
    1820   poly[2] := pointf(x2 + w, y2 + w);
    1821   poly[3] := pointf(x - w, y2 + w);
    1822   poly[4] := EmptyPointF;
    1823   poly[5] := pointf(x + w, y + w);
    1824   poly[6] := pointf(x2 - w, y + w);
    1825   poly[7] := pointf(x2 - w, y2 - w);
    1826   poly[8] := pointf(x + w, y2 - w);
    1827   FillPolyAntialias(poly, c);
    1828 
    1829   if back.alpha <> 0 then
    1830     FillRectAntialias(x + w, y + w, x2 - w, y2 - w, back);
    1831 end;
    1832 
    1833 procedure TBGRADefaultBitmap.FillRect(r: TRect; c: TColor);
    1834 begin
    1835   FillRect(r.Left, r.top, r.right, r.bottom, c);
    1836 end;
    1837 
    1838 procedure TBGRADefaultBitmap.FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
    1839 begin
    1840   FillRect(r.Left, r.top, r.right, r.bottom, c, mode);
     2524  end else
     2525    result := true;
    18412526end;
    18422527
    18432528procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
    18442529  c: TBGRAPixel; mode: TDrawMode);
    1845 var
    1846   temp: integer;
    1847 begin
    1848   if (x > x2) then
    1849   begin
    1850     temp := x;
    1851     x    := x2;
    1852     x2   := temp;
    1853   end;
    1854   if (y > y2) then
    1855   begin
    1856     temp := y;
    1857     y    := y2;
    1858     y2   := temp;
    1859   end;
    1860   if (x2 - x <= 1) or (y2 - y <= 1) then
    1861     exit;
     2530begin
     2531  if not CheckRectBounds(x,y,x2,y2,1) then exit;
    18622532  case mode of
    18632533    dmFastBlend:
    … …  
    18912561      end;
    18922562    end;
     2563    dmXor:
     2564    begin
     2565      XorHorizLine(x, y, x2 - 1, c);
     2566      XorHorizLine(x, y2 - 1, x2 - 1, c);
     2567      if y2 - y > 2 then
     2568      begin
     2569        XorVertLine(x, y + 1, y2 - 2, c);
     2570        XorVertLine(x2 - 1, y + 1, y2 - 2, c);
     2571      end;
     2572    end;
    18932573    dmSetExceptTransparent: if (c.alpha = 255) then
    18942574        Rectangle(x, y, x2, y2, c, dmSet);
    … …  
    18982578procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
    18992579  BorderColor, FillColor: TBGRAPixel; mode: TDrawMode);
     2580begin
     2581  if not CheckRectBounds(x,y,x2,y2,1) then exit;
     2582  Rectangle(x, y, x2, y2, BorderColor, mode);
     2583  FillRect(x + 1, y + 1, x2 - 1, y2 - 1, FillColor, mode);
     2584end;
     2585
     2586function TBGRADefaultBitmap.CheckClippedRectBounds(var x, y, x2, y2: integer): boolean; inline;
    19002587var
    19012588  temp: integer;
    … …  
    19132600    y2   := temp;
    19142601  end;
    1915   if (x2 - x <= 1) or (y2 - y <= 1) then
     2602  if (x >= FClipRect.Right) or (x2 <= FClipRect.Left) or (y >= FClipRect.Bottom) or (y2 <= FClipRect.Top) then
     2603  begin
     2604    result := false;
    19162605    exit;
    1917 
    1918   Rectangle(x, y, x2, y2, BorderColor, mode);
    1919   FillRect(x + 1, y + 1, x2 - 1, y2 - 1, FillColor, mode);
    1920 end;
    1921 
    1922 procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
    1923 begin
    1924   FillRect(x, y, x2, y2, ColorToBGRA(c), dmSet);
     2606  end;
     2607  if x < FClipRect.Left then
     2608    x := FClipRect.Left;
     2609  if x2 > FClipRect.Right then
     2610    x2 := FClipRect.Right;
     2611  if y < FClipRect.Top then
     2612    y := FClipRect.Top;
     2613  if y2 > FClipRect.Bottom then
     2614    y2 := FClipRect.Bottom;
     2615  if (x2 - x <= 0) or (y2 - y <= 0) then
     2616  begin
     2617    result := false;
     2618    exit;
     2619  end else
     2620    result := true;
    19252621end;
    19262622
    … …  
    19282624  mode: TDrawMode);
    19292625var
    1930   temp, yb, tx, delta: integer;
     2626  yb, tx, delta: integer;
    19312627  p: PBGRAPixel;
    19322628begin
    1933   if (x > x2) then
    1934   begin
    1935     temp := x;
    1936     x    := x2;
    1937     x2   := temp;
    1938   end;
    1939   if (y > y2) then
    1940   begin
    1941     temp := y;
    1942     y    := y2;
    1943     y2   := temp;
    1944   end;
    1945   if (x >= Width) or (x2 <= 0) or (y >= Height) or (y2 <= 0) then
    1946     exit;
    1947   if x < 0 then
    1948     x := 0;
    1949   if x2 > Width then
    1950     x2 := Width;
    1951   if y < 0 then
    1952     y := 0;
    1953   if y2 > Height then
    1954     y2 := Height;
    1955   if (x2 - x <= 0) or (y2 - y <= 0) then
    1956     exit;
     2629  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
    19572630  tx := x2 - x;
    19582631  Dec(x2);
    19592632  Dec(y2);
    19602633
    1961   case mode of
    1962     dmFastBlend:
    1963     begin
    1964       p := Scanline[y] + x;
    1965       if FLineOrder = riloBottomToTop then
    1966         delta := -Width
    1967       else
    1968         delta := Width;
    1969       for yb := y2 - y downto 0 do
    1970       begin
    1971         FastBlendPixelsInline(p, c, tx);
    1972         Inc(p, delta);
    1973       end;
    1974       InvalidateBitmap;
     2634  if mode = dmSetExceptTransparent then
     2635  begin
     2636    if (c.alpha = 255) then
     2637      FillRect(x, y, x2, y2, c, dmSet);
     2638  end else
     2639  begin
     2640    if (mode <> dmSet) and (c.alpha = 0) then exit;
     2641
     2642    p := Scanline[y] + x;
     2643    if FLineOrder = riloBottomToTop then
     2644      delta := -Width
     2645    else
     2646      delta := Width;
     2647
     2648    case mode of
     2649      dmFastBlend:
     2650        for yb := y2 - y downto 0 do
     2651        begin
     2652          FastBlendPixelsInline(p, c, tx);
     2653          Inc(p, delta);
     2654        end;
     2655      dmDrawWithTransparency:
     2656        for yb := y2 - y downto 0 do
     2657        begin
     2658          DrawPixelsInline(p, c, tx);
     2659          Inc(p, delta);
     2660        end;
     2661      dmSet:
     2662        for yb := y2 - y downto 0 do
     2663        begin
     2664          FillInline(p, c, tx);
     2665          Inc(p, delta);
     2666        end;
     2667      dmXor:
     2668        for yb := y2 - y downto 0 do
     2669        begin
     2670          XorInline(p, c, tx);
     2671          Inc(p, delta);
     2672        end;
    19752673    end;
    1976     dmDrawWithTransparency:
    1977     begin
    1978       p := Scanline[y] + x;
    1979       if FLineOrder = riloBottomToTop then
    1980         delta := -Width
    1981       else
    1982         delta := Width;
    1983       for yb := y2 - y downto 0 do
    1984       begin
    1985         DrawPixelsInline(p, c, tx);
    1986         Inc(p, delta);
    1987       end;
    1988       InvalidateBitmap;
    1989     end;
    1990     dmSet:
    1991     begin
    1992       p := Scanline[y] + x;
    1993       if FLineOrder = riloBottomToTop then
    1994         delta := -Width
    1995       else
    1996         delta := Width;
    1997       for yb := y2 - y downto 0 do
    1998       begin
    1999         FillInline(p, c, tx);
    2000         Inc(p, delta);
    2001       end;
    2002       InvalidateBitmap;
    2003     end;
    2004     dmSetExceptTransparent: if (c.alpha = 255) then
    2005         FillRect(x, y, x2, y2, c, dmSet);
    2006   end;
    2007 end;
    2008 
    2009 procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
    2010 var
    2011   poly: array of TPointF;
    2012 begin
    2013   setlength(poly, 4);
    2014   poly[0] := pointf(x, y);
    2015   poly[1] := pointf(x2, y);
    2016   poly[2] := pointf(x2, y2);
    2017   poly[3] := pointf(x, y2);
    2018   FillPolyAntialias(poly, c);
     2674
     2675    InvalidateBitmap;
     2676  end;
     2677end;
     2678
     2679procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
     2680  texture: IBGRAScanner; mode: TDrawMode);
     2681var
     2682  yb, tx, delta: integer;
     2683  p: PBGRAPixel;
     2684begin
     2685  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
     2686  tx := x2 - x;
     2687  Dec(x2);
     2688  Dec(y2);
     2689
     2690  p := Scanline[y] + x;
     2691  if FLineOrder = riloBottomToTop then
     2692    delta := -Width
     2693  else
     2694    delta := Width;
     2695
     2696  for yb := y to y2 do
     2697  begin
     2698    texture.ScanMoveTo(x,yb);
     2699    ScannerPutPixels(texture, p, tx, mode);
     2700    Inc(p, delta);
     2701  end;
     2702
     2703  InvalidateBitmap;
    20192704end;
    20202705
    20212706procedure TBGRADefaultBitmap.AlphaFillRect(x, y, x2, y2: integer; alpha: byte);
    20222707var
    2023   temp, yb, tx, delta: integer;
     2708  yb, tx, delta: integer;
    20242709  p: PBGRAPixel;
    20252710begin
    … …  
    20302715  end;
    20312716
    2032   if (x > x2) then
    2033   begin
    2034     temp := x;
    2035     x    := x2;
    2036     x2   := temp;
    2037   end;
    2038   if (y > y2) then
    2039   begin
    2040     temp := y;
    2041     y    := y2;
    2042     y2   := temp;
    2043   end;
    2044   if (x >= Width) or (x2 <= 0) or (y >= Height) or (y2 <= 0) then
    2045     exit;
    2046   if x < 0 then
    2047     x := 0;
    2048   if x2 > Width then
    2049     x2 := Width;
    2050   if y < 0 then
    2051     y := 0;
    2052   if y2 > Height then
    2053     y2 := Height;
    2054   if (x2 - x <= 0) or (y2 - y <= 0) then
    2055     exit;
     2717  if not CheckClippedRectBounds(x,y,x2,y2) then exit;
    20562718  tx := x2 - x;
    20572719  Dec(x2);
    … …  
    20712733end;
    20722734
     2735procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel);
     2736var tx,ty: single;
     2737begin
     2738  tx := x2-x;
     2739  ty := y2-y;
     2740  if (tx=0) or (ty=0) then exit;
     2741  if (abs(tx) > 2) and (abs(ty) > 2) then
     2742  begin
     2743    if (tx < 0) then
     2744    begin
     2745      tx := -tx;
     2746      x := x2;
     2747      x2 := x+tx;
     2748    end;
     2749    if (ty < 0) then
     2750    begin
     2751      ty := -ty;
     2752      y := y2;
     2753      y2 := y+ty;
     2754    end;
     2755    FillRectAntialias(x,y,x2,ceil(y)+0.5,c);
     2756    FillRectAntialias(x,ceil(y)+0.5,ceil(x)+0.5,floor(y2)-0.5,c);
     2757    FillRectAntialias(floor(x2)-0.5,ceil(y)+0.5,x2,floor(y2)-0.5,c);
     2758    FillRectAntialias(x,floor(y2)-0.5,x2,y2,c);
     2759    FillRect(ceil(x)+1,ceil(y)+1,floor(x2),floor(y2),c,dmDrawWithTransparency);
     2760  end else
     2761    FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], c);
     2762end;
     2763
     2764procedure TBGRADefaultBitmap.EraseRectAntialias(x, y, x2, y2: single;
     2765  alpha: byte);
     2766begin
     2767  ErasePolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], alpha);
     2768end;
     2769
     2770procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single;
     2771  texture: IBGRAScanner);
     2772begin
     2773  FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], texture);
     2774end;
     2775
     2776procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,ry: single;
     2777  c: TBGRAPixel; options: TRoundRectangleOptions);
     2778begin
     2779  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False);
     2780end;
     2781
     2782procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,
     2783  ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions);
     2784begin
     2785  BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture);
     2786end;
     2787
     2788procedure TBGRADefaultBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx,
     2789  ry: single; alpha: byte; options: TRoundRectangleOptions);
     2790begin
     2791  BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True);
     2792end;
     2793
    20732794procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer;
    2074   RX, RY: integer; BorderColor, FillColor: TBGRAPixel);
    2075 var
    2076   CX, CY, CX1, CY1, A, B, NX, NY: single;
    2077   X, Y, EX, EY: integer;
    2078   LX1, LY1: integer;
    2079   LX2, LY2: integer;
    2080   DivSqrA, DivSqrB: single;
    2081   I, J, S: integer;
    2082   EdgeList: array of TPoint;
    2083   temp:   integer;
    2084   LX, LY: integer;
    2085 
    2086   procedure AddEdge(X, Y: integer);
    2087   begin
    2088     if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then
    2089       EdgeList[Y].X := X;
    2090     if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then
    2091       EdgeList[Y].Y := X;
    2092   end;
    2093 
    2094 begin
    2095   if (x1 > x2) then
    2096   begin
    2097     temp := x1;
    2098     x1   := x2;
    2099     x2   := temp;
    2100   end;
    2101   if (y1 > y2) then
    2102   begin
    2103     temp := y1;
    2104     y1   := y2;
    2105     y2   := temp;
    2106   end;
    2107   if (x2 - x1 <= 0) or (y2 - y1 <= 0) then
    2108     exit;
    2109   LX := x2 - x1 - RX;
    2110   LY := y2 - y1 - RY;
    2111   Dec(x2);
    2112   Dec(y2);
    2113 
    2114   if (X1 = X2) and (Y1 = Y2) then
    2115   begin
    2116     DrawPixel(X1, Y1, BorderColor);
    2117     Exit;
    2118   end;
    2119 
    2120   if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
    2121   begin
    2122     FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
    2123     Exit;
    2124   end;
    2125 
    2126   if (LX > X2 - X1) or (LY > Y2 - Y1) then
    2127   begin
    2128     Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
    2129     FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, dmDrawWithTransparency);
    2130     Exit;
    2131   end;
    2132 
    2133   SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2));
    2134   for I := 0 to Pred(High(EdgeList)) do
    2135     EdgeList[I] := Point(-1, -1);
    2136   EdgeList[High(EdgeList)] := Point(0, 0);
    2137 
    2138   A  := (X2 - X1 + 1 - LX) / 2;
    2139   B  := (Y2 - Y1 + 1 - LY) / 2;
    2140   CX := (X2 + X1 + 1) / 2;
    2141   CY := (Y2 + Y1 + 1) / 2;
    2142 
    2143   CX1 := X2 + 1 - A - Floor(CX);
    2144   CY1 := Y2 + 1 - B - Floor(CY);
    2145 
    2146   EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A));
    2147   EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B));
    2148 
    2149   DivSqrA := 1 / Sqr(A);
    2150   DivSqrB := 1 / Sqr(B);
    2151 
    2152   NY := B;
    2153   AddEdge(Floor(CX1), Round(CY1 + B) - 1);
    2154   for X := 1 to Pred(EX) do
    2155   begin
    2156     NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA);
    2157 
    2158     AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1);
    2159   end;
    2160 
    2161   LX1 := Floor(CX1) + Pred(EX);
    2162   LY1 := Round(CY1 + NY) - 1;
    2163 
    2164   NX := A;
    2165   AddEdge(Round(CX1 + A) - 1, Floor(CY1));
    2166   for Y := 1 to Pred(EY) do
    2167   begin
    2168     NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB);
    2169 
    2170     AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y);
    2171   end;
    2172 
    2173   LX2 := Round(CX1 + NX) - 1;
    2174   LY2 := Floor(CY1) + Pred(EY);
    2175 
    2176   if Abs(LX1 - LX2) > 1 then
    2177   begin
    2178     if Abs(LY1 - LY2) > 1 then
    2179       AddEdge(LX1 + 1, LY1 - 1)
    2180     else
    2181       AddEdge(LX1 + 1, LY1);
    2182   end
    2183   else
    2184   if Abs(LY1 - LY2) > 1 then
    2185     AddEdge(LX2, LY1 - 1);
    2186 
    2187   for I := 0 to High(EdgeList) do
    2188   begin
    2189     if EdgeList[I].X = -1 then
    2190       EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1)
    2191     else
    2192       Break;
    2193   end;
    2194 
    2195   for J := 0 to High(EdgeList) do
    2196   begin
    2197     if (J = 0) and (Frac(CY) > 0) then
    2198     begin
    2199       for I := EdgeList[J].X to EdgeList[J].Y do
    2200       begin
    2201         DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
    2202         DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
    2203       end;
    2204 
    2205       DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
    2206         Pred(EdgeList[J].X), FillColor);
    2207     end
    2208     else
    2209     if (J = High(EdgeList)) then
    2210     begin
    2211       if Frac(CX) > 0 then
    2212         S := -EdgeList[J].Y
    2213       else
    2214         S := -Succ(EdgeList[J].Y);
    2215 
    2216       for I := S to EdgeList[J].Y do
    2217       begin
    2218         DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
    2219         DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
    2220       end;
    2221     end
    2222     else
    2223     begin
    2224       for I := EdgeList[J].X to EdgeList[J].Y do
    2225       begin
    2226         DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor);
    2227         DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
    2228         if Floor(CX) + I <> Ceil(CX) - Succ(I) then
    2229         begin
    2230           DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
    2231           DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor);
    2232         end;
    2233       end;
    2234 
    2235       DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J,
    2236         Floor(CX) + Pred(EdgeList[J].X), FillColor);
    2237       DrawHorizLine(Ceil(CX) - EdgeList[J].X, Ceil(CY) - Succ(J),
    2238         Floor(CX) + Pred(EdgeList[J].X), FillColor);
    2239     end;
    2240   end;
    2241 end;
    2242 
    2243 procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string; c: TBGRAPixel);
    2244 begin
    2245   TextOut(x, y, s, c, taLeftJustify);
    2246 end;
    2247 
    2248 
    2249 {$HINTS OFF}
     2795  DX, DY: integer; BorderColor, FillColor: TBGRAPixel);
     2796begin
     2797  BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,FillColor);
     2798end;
     2799
     2800{------------------------- Text functions ---------------------------------------}
     2801
     2802procedure TBGRADefaultBitmap.TextOutAngle(x, y, orientation: integer;
     2803  s: string; c: TBGRAPixel; align: TAlignment);
     2804begin
     2805  UpdateFont;
     2806  BGRAText.BGRATextOutAngle(self,FFont,FontQuality,x,y,orientation,s,c,nil,align);
     2807end;
     2808
     2809procedure TBGRADefaultBitmap.TextOutAngle(x, y, orientation: integer;
     2810  s: string; texture: IBGRAScanner; align: TAlignment);
     2811begin
     2812  UpdateFont;
     2813  BGRAText.BGRATextOutAngle(self,FFont,FontQuality,x,y,orientation,s,BGRAPixelTransparent,texture,align);
     2814end;
     2815
     2816procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string;
     2817  texture: IBGRAScanner; align: TAlignment);
     2818begin
     2819  UpdateFont;
     2820
     2821  if (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
     2822    BGRATextFX.BGRATextOutImproveReadability(self,FFont,x,y,s,BGRAPixelTransparent,texture,align,
     2823     FontQuality in[fqFineClearTypeRGB,fqFineClearTypeBGR], FontQuality = fqFineClearTypeRGB) else
     2824
     2825    BGRAText.BGRATextOut(self,FFont,FontQuality,x,y,s,BGRAPixelTransparent,texture,align);
     2826end;
     2827
    22502828procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string;
    22512829  c: TBGRAPixel; align: TAlignment);
    2252 var
    2253   size:  TSize;
    2254   temp:  TBGRADefaultBitmap;
    2255   P:     PBGRAPixel;
    2256   n:     integer;
    2257   alpha: integer;
    22582830begin
    22592831  UpdateFont;
    22602832
    2261   size := TextSize(s);
    2262   if (size.cx = 0) or (size.cy = 0) then
    2263     exit;
    2264 
    2265   case align of
    2266     taLeftJustify: ;
    2267     taCenter: Dec(x, size.cx div 2);
    2268     taRightJustify: Dec(x, size.cx);
    2269   end;
    2270 
    2271   temp := NewBitmap(size.cx, size.cy);
    2272   temp.Fill(clBlack);
    2273   temp.Canvas.Font := FFont;
    2274   temp.Canvas.Font.Color := clWhite;
    2275   temp.Canvas.Brush.Style := bsClear;
    2276   temp.Canvas.TextOut(0, 0, s);
    2277   p := temp.Data;
    2278   for n := temp.NbPixels - 1 downto 0 do
    2279   begin
    2280     alpha    := P^.green;
    2281     p^.red   := c.red;
    2282     p^.green := c.green;
    2283     p^.blue  := c.blue;
    2284     p^.alpha := (c.alpha * alpha) div 255;
    2285     Inc(p);
    2286   end;
    2287   PutImage(x, y, temp, dmDrawWithTransparency);
    2288   temp.Free;
    2289 end;
    2290 
    2291 {$HINTS ON}
    2292 
    2293 procedure TBGRADefaultBitmap.TextOut(x, y: integer; s: string; c: TColor);
    2294 begin
    2295   TextOut(x, y, s, ColorToBGRA(c));
     2833  if (FontQuality in[fqFineAntialiasing,fqFineClearTypeBGR,fqFineClearTypeRGB]) and (FFont.Orientation mod 3600 = 0) then
     2834    BGRATextFX.BGRATextOutImproveReadability(self,FFont,x,y,s,c,nil,align,
     2835    FontQuality in[fqFineClearTypeRGB,fqFineClearTypeBGR], FontQuality = fqFineClearTypeRGB) else
     2836
     2837    BGRAText.BGRATextOut(self,FFont,FontQuality,x,y,s,c,nil,align);
    22962838end;
    22972839
    22982840procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer;
    22992841  s: string; style: TTextStyle; c: TBGRAPixel);
    2300 var
    2301   tx, ty: integer;
    2302   temp:   TBGRADefaultBitmap;
    2303   P:      PBGRAPixel;
    2304   n:      integer;
    2305   alpha:  integer;
    23062842begin
    23072843  UpdateFont;
    2308 
    2309   if ARect.Left < 0 then
    2310     ARect.Left := 0;
    2311   if ARect.Top < 0 then
    2312     ARect.Top := 0;
    2313   if ARect.Right > Width then
    2314     ARect.Right := Width;
    2315   if ARect.Bottom > Height then
    2316     ARect.Bottom := Height;
    2317 
    2318   tx := ARect.Right - ARect.Left;
    2319   ty := ARect.Bottom - ARect.Top;
    2320   if (tx <= 0) or (ty <= 0) then
    2321     exit;
    2322   temp := NewBitmap(tx, ty);
    2323   temp.Fill(clBlack);
    2324   temp.Canvas.Font := FFont;
    2325   temp.Canvas.Font.Color := clWhite;
    2326   temp.Canvas.Brush.Style := bsClear;
    2327   temp.Canvas.TextRect(rect(0, 0, tx, ty), x - ARect.Left, y - ARect.Top, s, style);
    2328   p := temp.Data;
    2329   for n := tx * ty - 1 downto 0 do
    2330   begin
    2331     alpha    := P^.green;
    2332     p^.red   := c.red;
    2333     p^.green := c.green;
    2334     p^.blue  := c.blue;
    2335     p^.alpha := (c.alpha * alpha) div 255;
    2336     Inc(p);
    2337   end;
    2338   PutImage(ARect.Left, ARect.Top, temp, dmDrawWithTransparency);
    2339   temp.Free;
    2340 end;
    2341 
    2342 {$hints off}
     2844  BGRAText.BGRATextRect(self,FFont,FontQuality,ARect,x,y,s,style,c,nil);
     2845end;
     2846
     2847procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; s: string;
     2848  style: TTextStyle; texture: IBGRAScanner);
     2849begin
     2850  UpdateFont;
     2851  BGRAText.BGRATextRect(self,FFont,FontQuality,ARect,x,y,s,style,BGRAPixelTransparent,texture);
     2852end;
     2853
    23432854function TBGRADefaultBitmap.TextSize(s: string): TSize;
    2344 var
    2345   temp: TBitmap;
    23462855begin
    23472856  UpdateFont;
    2348 
    2349   temp := TBitmap.Create;
    2350   temp.Canvas.Font := FFont;
    2351   temp.Canvas.Font.GetTextSize(s, Result.cx, Result.cy);
    2352   temp.Free;
    2353 end;
    2354 
    2355 {$hints on}
    2356 
    2357 {----------------------- Spline ------------------}
    2358 
    2359 function TBGRADefaultBitmap.Spline(y0, y1, y2, y3: single; t: single): single;
    2360 var
    2361   a0, a1, a2, a3: single;
    2362   t2: single;
    2363 begin
    2364   t2     := t * t;
    2365   a0     := y3 - y2 - y0 + y1;
    2366   a1     := y0 - y1 - a0;
    2367   a2     := y2 - y0;
    2368   a3     := y1;
    2369   Result := a0 * t * t2 + a1 * t2 + a2 * t + a3;
    2370 end;
    2371 
    2372 function TBGRADefaultBitmap.ComputeClosedSpline(points: array of TPointF):
    2373 ArrayOfTPointF;
    2374 
    2375   function computePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
    2376   var
    2377     len: single;
    2378   begin
    2379     len    := sqrt(sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y));
    2380     len    := max(len, sqrt(sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)));
    2381     len    := max(len, sqrt(sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)));
    2382     Result := round(sqrt(len) * 2);
    2383   end;
    2384 
    2385 var
    2386   i, j, nb, idx, pre: integer;
    2387   ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
    2388 
    2389 begin
    2390   if length(points) = 2 then
    2391   begin
    2392     setlength(Result, 2);
    2393     Result[0] := points[0];
    2394     Result[1] := points[1];
    2395     exit;
    2396   end;
    2397 
    2398   nb := 1;
    2399   for i := 0 to high(points) do
    2400   begin
    2401     ptPrev2 := points[(i + length(points) - 1) mod length(points)];
    2402     ptPrev  := points[i];
    2403     ptNext  := points[(i + 1) mod length(points)];
    2404     ptNext2 := points[(i + 2) mod length(points)];
    2405     nb      += computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
    2406   end;
    2407 
    2408   setlength(Result, nb);
    2409   Result[0] := points[0];
    2410   idx := 1;
    2411   for i := 0 to high(points) do
    2412   begin
    2413     ptPrev2 := points[(i + length(points) - 1) mod length(points)];
    2414     ptPrev  := points[i];
    2415     ptNext  := points[(i + 1) mod length(points)];
    2416     ptNext2 := points[(i + 2) mod length(points)];
    2417     pre     := computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
    2418     for j := 1 to pre - 1 do
    2419     begin
    2420       Result[idx] := pointF(spline(ptPrev2.x, ptPrev.X, ptNext.X, ptNext2.X, j / pre),
    2421         spline(ptPrev2.y, ptPrev.y, ptNext.y, ptNext2.y, j / pre));
    2422       Inc(idx);
    2423     end;
    2424     if pre <> 0 then
    2425     begin
    2426       Result[idx] := ptNext;
    2427       Inc(idx);
    2428     end;
    2429   end;
    2430 end;
    2431 
    2432 function TBGRADefaultBitmap.ComputeOpenedSpline(points: array of TPointF):
    2433 ArrayOfTPointF;
    2434 
    2435   function computePrecision(pt1, pt2, pt3, pt4: TPointF): integer;
    2436   var
    2437     len: single;
    2438   begin
    2439     len    := sqrt(sqr(pt1.x - pt2.x) + sqr(pt1.y - pt2.y));
    2440     len    := max(len, sqrt(sqr(pt3.x - pt2.x) + sqr(pt3.y - pt2.y)));
    2441     len    := max(len, sqrt(sqr(pt3.x - pt4.x) + sqr(pt3.y - pt4.y)));
    2442     Result := round(sqrt(len) * 2);
    2443   end;
    2444 
    2445 var
    2446   i, j, nb, idx, pre: integer;
    2447   ptPrev, ptPrev2, ptNext, ptNext2: TPointF;
    2448 
    2449 begin
    2450   if length(points) = 2 then
    2451   begin
    2452     setlength(Result, 2);
    2453     Result[0] := points[0];
    2454     Result[1] := points[1];
    2455     exit;
    2456   end;
    2457 
    2458   nb := 1;
    2459   for i := 0 to high(points) - 1 do
    2460   begin
    2461     ptPrev2 := points[max(0, i - 1)];
    2462     ptPrev  := points[i];
    2463     ptNext  := points[i + 1];
    2464     ptNext2 := points[min(high(points), i + 2)];
    2465     nb      += computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
    2466   end;
    2467 
    2468   setlength(Result, nb);
    2469   Result[0] := points[0];
    2470   idx := 1;
    2471   for i := 0 to high(points) - 1 do
    2472   begin
    2473     ptPrev2 := points[max(0, i - 1)];
    2474     ptPrev  := points[i];
    2475     ptNext  := points[i + 1];
    2476     ptNext2 := points[min(high(points), i + 2)];
    2477     pre     := computePrecision(ptPrev2, ptPrev, ptNext, ptNext2);
    2478     for j := 1 to pre - 1 do
    2479     begin
    2480       Result[idx] := pointF(spline(ptPrev2.x, ptPrev.X, ptNext.X, ptNext2.X, j / pre),
    2481         spline(ptPrev2.y, ptPrev.y, ptNext.y, ptNext2.y, j / pre));
    2482       Inc(idx);
    2483     end;
    2484     if pre <> 0 then
    2485     begin
    2486       Result[idx] := ptNext;
    2487       Inc(idx);
    2488     end;
    2489   end;
     2857  result := BGRAText.BGRATextSize(FFont,FontQuality,s,FontAntialiasingLevel);
     2858  if (result.cy >= 24) and FontAntialias then
     2859    result := BGRAText.BGRATextSize(FFont,FontQuality,s,4);
     2860end;
     2861
     2862{---------------------------- Curves ----------------------------------------}
     2863
     2864function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
     2865begin
     2866  result := BGRAPath.ComputeClosedSpline(APoints, AStyle);
     2867end;
     2868
     2869function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
     2870begin
     2871  result := BGRAPath.ComputeOpenedSpline(APoints, AStyle);
     2872end;
     2873
     2874function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve
     2875  ): ArrayOfTPointF;
     2876begin
     2877  Result:= BGRAPath.ComputeBezierCurve(ACurve);
     2878end;
     2879
     2880function TBGRADefaultBitmap.ComputeBezierCurve(
     2881  const ACurve: TQuadraticBezierCurve): ArrayOfTPointF;
     2882begin
     2883  Result:= BGRAPath.ComputeBezierCurve(ACurve);
     2884end;
     2885
     2886function TBGRADefaultBitmap.ComputeBezierSpline(
     2887  const ASpline: array of TCubicBezierCurve): ArrayOfTPointF;
     2888begin
     2889  Result:= BGRAPath.ComputeBezierSpline(ASpline);
     2890end;
     2891
     2892function TBGRADefaultBitmap.ComputeBezierSpline(
     2893  const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF;
     2894begin
     2895  Result:= BGRAPath.ComputeBezierSpline(ASpline);
     2896end;
     2897
     2898function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
     2899  w: single): ArrayOfTPointF;
     2900begin
     2901  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[],JoinMiterLimit);
     2902end;
     2903
     2904function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
     2905  w: single; Closed: boolean): ArrayOfTPointF;
     2906var
     2907  options: TBGRAPolyLineOptions;
     2908begin
     2909  if not closed then options := [plRoundCapOpen] else options := [];
     2910  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,pecRound,pjsRound,FCustomPenStyle,options,JoinMiterLimit);
     2911end;
     2912
     2913function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF;
     2914  w: single): ArrayOfTPointF;
     2915begin
     2916  Result:= BGRAPen.ComputeWidePolylinePoints(points,w,BGRAWhite,LineCap,JoinStyle,FCustomPenStyle,[plCycle],JoinMiterLimit);
     2917end;
     2918
     2919function TBGRADefaultBitmap.ComputeEllipse(x, y, rx, ry: single
     2920  ): ArrayOfTPointF;
     2921begin
     2922  result := BGRAPath.ComputeEllipse(x,y,rx,ry);
     2923end;
     2924
     2925function TBGRADefaultBitmap.ComputeEllipse(x, y, rx, ry, w: single
     2926  ): ArrayOfTPointF;
     2927begin
     2928  result := ComputeWidePolygon(ComputeEllipse(x,y,rx,ry),w);
     2929end;
     2930
     2931function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536,
     2932  end65536: word): ArrayOfTPointF;
     2933begin
     2934  result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536);
     2935end;
     2936
     2937function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad,
     2938  endRad: single): ArrayOfTPointF;
     2939begin
     2940  result := BGRAPath.ComputeArc65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi));
     2941end;
     2942
     2943function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single
     2944  ): ArrayOfTPointF;
     2945begin
     2946  result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry);
     2947end;
     2948
     2949function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single;
     2950  options: TRoundRectangleOptions): ArrayOfTPointF;
     2951begin
     2952  Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options);
     2953end;
     2954
     2955function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536,
     2956  end65536: word): ArrayOfTPointF;
     2957begin
     2958  result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536);
     2959  if (start65536 <> end65536) then
     2960  begin
     2961    setlength(result,length(result)+1);
     2962    result[high(result)] := PointF(x,y);
     2963  end;
     2964end;
     2965
     2966function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad,
     2967  endRad: single): ArrayOfTPointF;
     2968begin
     2969  result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi));
    24902970end;
    24912971
    24922972{---------------------------------- Fill ---------------------------------}
    24932973
    2494 procedure TBGRADefaultBitmap.FillTransparent;
    2495 begin
    2496   Fill(BGRAPixelTransparent);
    2497 end;
    2498 
    2499 procedure TBGRADefaultBitmap.ApplyGlobalOpacity(alpha: byte);
    2500 var
    2501   p: PBGRAPixel;
    2502   i: integer;
    2503 begin
    2504   if alpha = 0 then
    2505     FillTransparent
    2506   else
    2507   if alpha <> 255 then
    2508   begin
    2509     p := Data;
    2510     for i := NbPixels - 1 downto 0 do
    2511     begin
    2512       p^.alpha := (p^.alpha * alpha + 128) shr 8;
    2513       Inc(p);
    2514     end;
    2515   end;
    2516 end;
    2517 
    2518 procedure TBGRADefaultBitmap.Fill(c: TColor);
    2519 begin
    2520   Fill(ColorToBGRA(c));
    2521 end;
    2522 
    2523 procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel);
    2524 begin
    2525   Fill(c, 0, Width * Height);
     2974procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner);
     2975begin
     2976  FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,dmSet);
    25262977end;
    25272978
    … …  
    25422993end;
    25432994
    2544 procedure TBGRADefaultBitmap.AlphaFill(alpha: byte);
    2545 begin
    2546   AlphaFill(alpha, 0, NbPixels);
    2547 end;
    2548 
    25492995procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer);
    25502996begin
    … …  
    25653011end;
    25663012
     3013procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
     3014  color: TBGRAPixel);
     3015var
     3016  scan: TBGRACustomScanner;
     3017begin
     3018  if (AMask = nil) or (color.alpha = 0) then exit;
     3019  scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),color);
     3020  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
     3021  scan.Free;
     3022end;
     3023
     3024procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
     3025  texture: IBGRAScanner);
     3026var
     3027  scan: TBGRACustomScanner;
     3028begin
     3029  if AMask = nil then exit;
     3030  scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),texture);
     3031  self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
     3032  scan.Free;
     3033end;
     3034
     3035procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
     3036  AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean);
     3037begin
     3038  BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder);
     3039end;
     3040
     3041procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
     3042  AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean);
     3043begin
     3044  BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder);
     3045end;
     3046
     3047{ Replace color without taking alpha channel into account }
    25673048procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor);
    25683049const
    … …  
    25733054  beforeBGR, afterBGR: longword;
    25743055begin
    2575   beforeBGR := (before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF);
    2576   afterBGR  := (after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF);
     3056  beforeBGR := NtoLE((before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF));
     3057  afterBGR  := NtoLE((after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF));
    25773058
    25783059  p := PLongWord(Data);
    … …  
    26063087end;
    26073088
     3089{ Replace transparent pixels by the specified color }
    26083090procedure TBGRADefaultBitmap.ReplaceTransparent(after: TBGRAPixel);
    26093091var
    … …  
    26213103end;
    26223104
    2623 procedure TBGRADefaultBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel;
    2624   mode: TFloodfillMode; Tolerance: byte = 0);
    2625 begin
    2626   ParallelFloodFill(X,Y,Self,Color,mode,Tolerance);
    2627 end;
    2628 
     3105{ General purpose FloodFill. It can be used to fill inplace or to
     3106  fill a destination bitmap according to the content of the current bitmap.
     3107
     3108  The first pixel encountered is taken as a reference, further pixels
     3109  are compared to this pixel. If the distance between next colors and
     3110  the first color is lower than the tolerance, then the floodfill continues.
     3111
     3112  It uses an array of bits to store visited places to avoid filling twice
     3113  the same area. It also uses a stack of positions to remember where
     3114  to continue after a place is completely filled.
     3115
     3116  The first direction to be checked is horizontal, then
     3117  it checks pixels on the line above and on the line below. }
    26293118procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer;
    2630   Dest: TBGRADefaultBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
     3119  Dest: TBGRACustomBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
    26313120  Tolerance: byte);
    26323121var
    … …  
    26993188
    27003189begin
    2701   if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
     3190  if PtInClipRect(X,Y) then
    27023191  begin
    27033192    S := GetPixel(X, Y);
    … …  
    27173206
    27183207      SX := X;
    2719       while (SX > 0) and CheckPixel(Pred(SX), Y) do
     3208      while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do
    27203209        Dec(SX);
    27213210      EX := X;
    2722       while (EX < Pred(Width)) and CheckPixel(Succ(EX), Y) do
     3211      while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do
    27233212        Inc(EX);
    27243213
    … …  
    27333222
    27343223      Added := False;
    2735       if Y > 0 then
     3224      if Y > FClipRect.Top then
    27363225        for I := SX to EX do
    27373226          if CheckPixel(I, Pred(Y)) then
    27383227          begin
    2739             if Added then
     3228            if Added then //do not add twice the same segment
    27403229              Continue;
    27413230            Push(I, Pred(Y));
    … …  
    27463235
    27473236      Added := False;
    2748       if Y < Pred(Height) then
     3237      if Y < Pred(FClipRect.Bottom) then
    27493238        for I := SX to EX do
    27503239          if CheckPixel(I, Succ(Y)) then
    27513240          begin
    2752             if Added then
     3241            if Added then //do not add twice the same segment
    27533242              Continue;
    27543243            Push(I, Succ(Y));
    … …  
    27643253  c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
    27653254  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
    2766 var
    2767   u, p:   TPointF;
    2768   len, a: single;
    2769   xb, yb, temp: integer;
    2770   b:      integer;
    2771   c:      TBGRAPixel;
    2772   ec, ec1, ec2: TExpandedPixel;
    2773   pixelProc: procedure(x, y: integer; col: TBGRAPixel) of object;
    2774 begin
    2775   if (x > x2) then
    2776   begin
    2777     temp := x;
    2778     x    := x2;
    2779     x2   := temp;
    2780   end;
    2781   if (y > y2) then
    2782   begin
    2783     temp := y;
    2784     y    := y2;
    2785     y2   := temp;
    2786   end;
    2787   if x < 0 then x := 0;
    2788   if x2 > width then x2 := width;
    2789   if y < 0 then y := 0;
    2790   if y2 > height then y2 := height;
    2791   if (x2 <= x) or (y2 <= y) then exit;
    2792 
     3255begin
     3256  BGRAGradientFill(self, x, y, x2, y2, c1, c2, gtype, o1, o2, mode, gammaColorCorrection, Sinus);
     3257end;
     3258
     3259procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
     3260  gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
     3261  mode: TDrawMode; Sinus: Boolean);
     3262var
     3263  scanner: TBGRAGradientScanner;
     3264begin
     3265  scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
     3266  FillRect(x,y,x2,y2,scanner,mode);
     3267  scanner.Free;
     3268end;
     3269
     3270function TBGRADefaultBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
     3271                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap;
     3272begin
     3273  result := BGRAPen.CreateBrushTexture(self,ABrushStyle,APatternColor,ABackgroundColor,AWidth,AHeight,APenWidth);
     3274end;
     3275
     3276{ Scanning procedures for IBGRAScanner interface }
     3277procedure TBGRADefaultBitmap.ScanMoveTo(X, Y: Integer);
     3278begin
     3279  LoadFromBitmapIfNeeded;
     3280  FScanCurX := PositiveMod(X+ScanOffset.X, FWidth);
     3281  FScanCurY := PositiveMod(Y+ScanOffset.Y, FHeight);
     3282  FScanPtr := ScanLine[FScanCurY];
     3283end;
     3284
     3285function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel;
     3286begin
     3287  result := (FScanPtr+FScanCurX)^;
     3288  inc(FScanCurX);
     3289  if FScanCurX = FWidth then //cycle
     3290    FScanCurX := 0;
     3291end;
     3292
     3293function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel;
     3294begin
     3295  Result:= GetPixelCycle(x+ScanOffset.X,y+ScanOffset.Y,ScanInterpolationFilter);
     3296end;
     3297
     3298function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean;
     3299begin
     3300  Result:= true;
     3301end;
     3302
     3303procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
     3304  mode: TDrawMode);
     3305var
     3306  i,nbCopy: Integer;
     3307  c: TBGRAPixel;
     3308begin
    27933309  case mode of
    2794     dmSet, dmSetExceptTransparent: pixelProc := @SetPixel;
    2795     dmDrawWithTransparency: pixelProc := @DrawPixel;
    2796     dmFastBlend: pixelProc := @FastBlendPixel;
    2797   end;
    2798   //handles transparency
    2799   if (c1.alpha = 0) and (c2.alpha = 0) then
    2800   begin
    2801     FillRect(x, y, x2, y2, BGRAPixelTransparent, mode);
    2802     exit;
    2803   end;
    2804   if c1.alpha = 0 then
    2805   begin
    2806     c1.red   := c2.red;
    2807     c1.green := c2.green;
    2808     c1.blue  := c2.blue;
    2809   end
    2810   else
    2811   if c2.alpha = 0 then
    2812   begin
    2813     c2.red   := c1.red;
    2814     c2.green := c1.green;
    2815     c2.blue  := c1.blue;
    2816   end;
    2817 
    2818   //compute vector
    2819   u.x := o2.x - o1.x;
    2820   u.y := o2.y - o1.y;
    2821   len := sqrt(sqr(u.x) + sqr(u.y));
    2822   if len = 0 then
    2823   begin
    2824     FillRect(x, y, x2, y2, MergeBGRA(c1, c2), mode);
    2825     exit;
    2826   end;
    2827   u.x /= len;
    2828   u.y /= len;
    2829 
    2830   ec1 := GammaExpansion(c1);
    2831   ec2 := GammaExpansion(c2);
    2832   if gammaColorCorrection then
    2833   begin
    2834     //render with gamma correction
    2835     case gtype of
    2836       gtLinear:
    2837         for yb := y to y2 - 1 do
    2838           for xb := x to x2 - 1 do
    2839           begin
    2840             p.x := xb - o1.x;
    2841             p.y := yb - o1.y;
    2842             a   := p.x * u.x + p.y * u.y;
    2843             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2844             if a < 0 then
    2845               c := c1
    2846             else
    2847             if a > len then
    2848               c := c2
    2849             else
    2850             begin
    2851               b      := round(a / len * 256);
    2852               ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
    2853               ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
    2854               ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
    2855               ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
    2856               c      := GammaCompression(ec);
    2857             end;
    2858             pixelProc(xb, yb, c);
    2859           end;
    2860 
    2861       gtReflected:
    2862         for yb := y to y2 - 1 do
    2863           for xb := x to x2 - 1 do
    2864           begin
    2865             p.x := xb - o1.x;
    2866             p.y := yb - o1.y;
    2867             a   := abs(p.x * u.x + p.y * u.y);
    2868             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2869             if a < 0 then
    2870               c := c1
    2871             else
    2872             if a > len then
    2873               c := c2
    2874             else
    2875             begin
    2876               b      := round(a / len * 256);
    2877               ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
    2878               ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
    2879               ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
    2880               ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
    2881               c      := GammaCompression(ec);
    2882             end;
    2883             pixelProc(xb, yb, c);
    2884           end;
    2885 
    2886       gtDiamond:
    2887         for yb := y to y2 - 1 do
    2888           for xb := x to x2 - 1 do
    2889           begin
    2890             p.x := xb - o1.x;
    2891             p.y := yb - o1.y;
    2892             a   := max(abs(p.x * u.x + p.y * u.y), abs(p.x * u.y - p.y * u.x));
    2893             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2894             if a < 0 then
    2895               c := c1
    2896             else
    2897             if a > len then
    2898               c := c2
    2899             else
    2900             begin
    2901               b      := round(a / len * 256);
    2902               ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
    2903               ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
    2904               ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
    2905               ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
    2906               c      := GammaCompression(ec);
    2907             end;
    2908             pixelProc(xb, yb, c);
    2909           end;
    2910 
    2911       gtRadial:
    2912         for yb := y to y2 - 1 do
    2913           for xb := x to x2 - 1 do
    2914           begin
    2915             p.x := xb - o1.x;
    2916             p.y := yb - o1.y;
    2917             a   := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
    2918             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2919             if a < 0 then
    2920               c := c1
    2921             else
    2922             if a > len then
    2923               c := c2
    2924             else
    2925             begin
    2926               b      := round(a / len * 256);
    2927               ec.red := (ec1.red * (256 - b) + ec2.red * b + 127) shr 8;
    2928               ec.green := (ec1.green * (256 - b) + ec2.green * b + 127) shr 8;
    2929               ec.blue := (ec1.blue * (256 - b) + ec2.blue * b + 127) shr 8;
    2930               ec.alpha := (ec1.alpha * (256 - b) + ec2.alpha * b + 127) shr 8;
    2931               c      := GammaCompression(ec);
    2932             end;
    2933             pixelProc(xb, yb, c);
    2934           end;
    2935     end;
    2936   end
    2937   else
    2938   begin
    2939     //render without gamma correction
    2940     case gtype of
    2941       gtLinear:
    2942         for yb := y to y2 - 1 do
    2943           for xb := x to x2 - 1 do
    2944           begin
    2945             p.x := xb - o1.x;
    2946             p.y := yb - o1.y;
    2947             a   := p.x * u.x + p.y * u.y;
    2948             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2949             if a < 0 then
    2950               c := c1
    2951             else
    2952             if a > len then
    2953               c := c2
    2954             else
    2955             begin
    2956               b      := round(a / len * 256);
    2957               c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
    2958               c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
    2959               c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
    2960               c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
    2961             end;
    2962             pixelProc(xb, yb, c);
    2963           end;
    2964 
    2965       gtReflected:
    2966         for yb := y to y2 - 1 do
    2967           for xb := x to x2 - 1 do
    2968           begin
    2969             p.x := xb - o1.x;
    2970             p.y := yb - o1.y;
    2971             a   := abs(p.x * u.x + p.y * u.y);
    2972             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2973             if a < 0 then
    2974               c := c1
    2975             else
    2976             if a > len then
    2977               c := c2
    2978             else
    2979             begin
    2980               b      := round(a / len * 256);
    2981               c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
    2982               c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
    2983               c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
    2984               c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
    2985             end;
    2986             pixelProc(xb, yb, c);
    2987           end;
    2988 
    2989       gtDiamond:
    2990         for yb := y to y2 - 1 do
    2991           for xb := x to x2 - 1 do
    2992           begin
    2993             p.x := xb - o1.x;
    2994             p.y := yb - o1.y;
    2995             a   := max(abs(p.x * u.x + p.y * u.y), abs(p.x * u.y - p.y * u.x));
    2996             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    2997             if a < 0 then
    2998               c := c1
    2999             else
    3000             if a > len then
    3001               c := c2
    3002             else
    3003             begin
    3004               b      := round(a / len * 256);
    3005               c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
    3006               c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
    3007               c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
    3008               c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
    3009             end;
    3010             pixelProc(xb, yb, c);
    3011           end;
    3012 
    3013       gtRadial:
    3014         for yb := y to y2 - 1 do
    3015           for xb := x to x2 - 1 do
    3016           begin
    3017             p.x := xb - o1.x;
    3018             p.y := yb - o1.y;
    3019             a   := sqrt(sqr(p.x * u.x + p.y * u.y) + sqr(p.x * u.y - p.y * u.x));
    3020             if Sinus then a := (sin(a*2*Pi/len)+1)*len/2;
    3021             if a < 0 then
    3022               c := c1
    3023             else
    3024             if a > len then
    3025               c := c2
    3026             else
    3027             begin
    3028               b      := round(a / len * 256);
    3029               c.red  := (c1.red * (256 - b) + c2.red * b + 127) shr 8;
    3030               c.green := (c1.green * (256 - b) + c2.green * b + 127) shr 8;
    3031               c.blue := (c1.blue * (256 - b) + c2.blue * b + 127) shr 8;
    3032               c.alpha := (c1.alpha * (256 - b) + c2.alpha * b + 127) shr 8;
    3033             end;
    3034             pixelProc(xb, yb, c);
    3035           end;
    3036     end;
    3037   end;
    3038 end;
    3039 
     3310    dmLinearBlend:
     3311      for i := 0 to count-1 do
     3312      begin
     3313        FastBlendPixelInline(pdest, ScanNextPixel);
     3314        inc(pdest);
     3315      end;
     3316    dmDrawWithTransparency:
     3317      for i := 0 to count-1 do
     3318      begin
     3319        DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel);
     3320        inc(pdest);
     3321      end;
     3322    dmSet:
     3323      while count > 0 do
     3324      begin
     3325        nbCopy := FWidth-FScanCurX;
     3326        if count < nbCopy then nbCopy := count;
     3327        move((FScanPtr+FScanCurX)^,pdest^,nbCopy*sizeof(TBGRAPixel));
     3328        inc(pdest,nbCopy);
     3329        inc(FScanCurX,nbCopy);
     3330        if FScanCurX = FWidth then FScanCurX := 0;
     3331        dec(count,nbCopy);
     3332      end;
     3333    dmSetExceptTransparent:
     3334      for i := 0 to count-1 do
     3335      begin
     3336        c := ScanNextPixel;
     3337        if c.alpha = 255 then pdest^ := c;
     3338        inc(pdest);
     3339      end;
     3340    dmXor:
     3341      for i := 0 to count-1 do
     3342      begin
     3343        PDWord(pdest)^ := PDWord(pdest)^ xor DWord(ScanNextPixel);
     3344        inc(pdest);
     3345      end;
     3346  end;
     3347end;
     3348
     3349{ General purpose pixel drawing function }
    30403350procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer);
    30413351var
    … …  
    30443354  if c.alpha = 0 then
    30453355    exit;
     3356  if c.alpha = 255 then
     3357  begin
     3358    Fill(c,start,Count);
     3359    exit;
     3360  end;
    30463361
    30473362  if start < 0 then
    … …  
    30563371
    30573372  p := Data + start;
    3058   while Count > 0 do
    3059   begin
    3060     DrawPixelInline(p, c);
    3061     Inc(p);
    3062     Dec(Count);
    3063   end;
     3373  DrawPixelsInline(p,c,Count);
    30643374  InvalidateBitmap;
    30653375end;
    … …  
    30863396end;
    30873397
     3398{ Ensure that transparent pixels have all channels to zero }
    30883399procedure TBGRADefaultBitmap.ClearTransparentPixels;
    30893400var
    … …  
    31013412end;
    31023413
    3103 procedure TBGRADefaultBitmap.PutImage(x, y: integer; Source: TBGRADefaultBitmap;
    3104   mode: TDrawMode);
    3105 var
    3106   x2, y2, yb, minxb, minyb, maxxb, ignoreleft, copycount, sourcewidth,
     3414function TBGRADefaultBitmap.CheckPutImageBounds(x,y,tx,ty: integer; out minxb,minyb,maxxb,maxyb,ignoreleft: integer): boolean inline;
     3415var x2,y2: integer;
     3416begin
     3417  if (x >= FClipRect.Right) or (y >= FClipRect.Bottom) or (x <= FClipRect.Left-tx) or
     3418    (y <= FClipRect.Top-ty) or (Height = 0) or (ty = 0) or (tx = 0) then
     3419  begin
     3420    result := false;
     3421    exit;
     3422  end;
     3423
     3424  x2 := x + tx - 1;
     3425  y2 := y + ty - 1;
     3426
     3427  if y < FClipRect.Top then
     3428    minyb := FClipRect.Top
     3429  else
     3430    minyb := y;
     3431  if y2 >= FClipRect.Bottom then
     3432    maxyb := FClipRect.Bottom - 1
     3433  else
     3434    maxyb := y2;
     3435
     3436  if x < FClipRect.Left then
     3437  begin
     3438    ignoreleft := FClipRect.Left-x;
     3439    minxb      := FClipRect.Left;
     3440  end
     3441  else
     3442  begin
     3443    ignoreleft := 0;
     3444    minxb      := x;
     3445  end;
     3446  if x2 >= FClipRect.Right then
     3447    maxxb := FClipRect.Right - 1
     3448  else
     3449    maxxb := x2;
     3450
     3451  result := true;
     3452end;
     3453
     3454function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single;
     3455  w: single): boolean;
     3456var
     3457  temp: Single;
     3458begin
     3459  if (x > x2) then
     3460  begin
     3461    temp := x;
     3462    x    := x2;
     3463    x2   := temp;
     3464  end;
     3465  if (y > y2) then
     3466  begin
     3467    temp := y;
     3468    y    := y2;
     3469    y2   := temp;
     3470  end;
     3471
     3472  result := (x2 - x > w) and (y2 - y > w);
     3473end;
     3474
     3475function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas;
     3476begin
     3477  if FCanvasBGRA = nil then
     3478    FCanvasBGRA := TBGRACanvas.Create(self);
     3479  result := FCanvasBGRA;
     3480end;
     3481
     3482function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D;
     3483begin
     3484  if FCanvas2D = nil then
     3485    FCanvas2D := TBGRACanvas2D.Create(self);
     3486  result := FCanvas2D;
     3487end;
     3488
     3489procedure TBGRADefaultBitmap.PutImage(x, y: integer; Source: TBGRACustomBitmap;
     3490  mode: TDrawMode; AOpacity: byte);
     3491var
     3492  yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
    31073493  i, delta_source, delta_dest: integer;
    31083494  psource, pdest: PBGRAPixel;
    3109 begin
     3495  tempPixel: TBGRAPixel;
     3496
     3497begin
     3498  if (source = nil) or (AOpacity = 0) then exit;
    31103499  sourcewidth := Source.Width;
    31113500
    3112   if (x >= Width) or (y >= Height) or (x <= -sourcewidth) or
    3113     (y <= -Source.Height) or (Height = 0) or (Source.Height = 0) then
    3114     exit;
    3115 
    3116   x2 := x + sourcewidth - 1;
    3117   y2 := y + Source.Height - 1;
    3118 
    3119   if y < 0 then
    3120     minyb := 0
    3121   else
    3122     minyb := y;
    3123   if y2 >= Height then
    3124     y2 := Height - 1;
    3125 
    3126   if x < 0 then
    3127   begin
    3128     ignoreleft := -x;
    3129     minxb      := 0;
    3130   end
    3131   else
    3132   begin
    3133     ignoreleft := 0;
    3134     minxb      := x;
    3135   end;
    3136   if x2 >= Width then
    3137     maxxb := Width - 1
    3138   else
    3139     maxxb := x2;
     3501  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
    31403502
    31413503  copycount := maxxb - minxb + 1;
    31423504
    31433505  psource := Source.ScanLine[minyb - y] + ignoreleft;
    3144   if Source.FLineOrder = riloBottomToTop then
     3506  if Source.LineOrder = riloBottomToTop then
    31453507    delta_source := -sourcewidth
    31463508  else
    … …  
    31563518    dmSet:
    31573519    begin
    3158       copycount *= sizeof(TBGRAPixel);
    3159       for yb := minyb to y2 do
     3520      if AOpacity <> 255 then
    31603521      begin
    3161         move(psource^, pdest^, copycount);
    3162         Inc(psource, delta_source);
    3163         Inc(pdest, delta_dest);
     3522        for yb := minyb to maxyb do
     3523        begin
     3524          CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount);
     3525          Inc(psource, delta_source);
     3526          Inc(pdest, delta_dest);
     3527        end;
     3528      end
     3529      else
     3530      begin
     3531        copycount *= sizeof(TBGRAPixel);
     3532        for yb := minyb to maxyb do
     3533        begin
     3534          move(psource^, pdest^, copycount);
     3535          Inc(psource, delta_source);
     3536          Inc(pdest, delta_dest);
     3537        end;
    31643538      end;
    31653539      InvalidateBitmap;
    … …  
    31693543      Dec(delta_source, copycount);
    31703544      Dec(delta_dest, copycount);
    3171       for yb := minyb to y2 do
     3545      for yb := minyb to maxyb do
    31723546      begin
    3173         for i := copycount - 1 downto 0 do
     3547        if AOpacity <> 255 then
    31743548        begin
    3175           if psource^.alpha = 255 then
    3176             pdest^ := psource^;
    3177           Inc(pdest);
    3178           Inc(psource);
    3179         end;
     3549          for i := copycount - 1 downto 0 do
     3550          begin
     3551            if psource^.alpha = 255 then
     3552            begin
     3553              tempPixel := psource^;
     3554              tempPixel.alpha := ApplyOpacity(tempPixel.alpha,AOpacity);
     3555              FastBlendPixelInline(pdest,tempPixel);
     3556            end;
     3557            Inc(pdest);
     3558            Inc(psource);
     3559          end;
     3560        end else
     3561          for i := copycount - 1 downto 0 do
     3562          begin
     3563            if psource^.alpha = 255 then
     3564              pdest^ := psource^;
     3565            Inc(pdest);
     3566            Inc(psource);
     3567          end;
    31803568        Inc(psource, delta_source);
    31813569        Inc(pdest, delta_dest);
    … …  
    31873575      Dec(delta_source, copycount);
    31883576      Dec(delta_dest, copycount);
    3189       for yb := minyb to y2 do
     3577      for yb := minyb to maxyb do
    31903578      begin
    3191         for i := copycount - 1 downto 0 do
     3579        if AOpacity <> 255 then
    31923580        begin
    3193           DrawPixelInline(pdest, psource^);
    3194           Inc(pdest);
    3195           Inc(psource);
    3196         end;
     3581          for i := copycount - 1 downto 0 do
     3582          begin
     3583            DrawPixelInlineWithAlphaCheck(pdest, psource^, AOpacity);
     3584            Inc(pdest);
     3585            Inc(psource);
     3586          end;
     3587        end
     3588        else
     3589          for i := copycount - 1 downto 0 do
     3590          begin
     3591            DrawPixelInlineWithAlphaCheck(pdest, psource^);
     3592            Inc(pdest);
     3593            Inc(psource);
     3594          end;
    31973595        Inc(psource, delta_source);
    31983596        Inc(pdest, delta_dest);
    … …  
    32043602      Dec(delta_source, copycount);
    32053603      Dec(delta_dest, copycount);
    3206       for yb := minyb to y2 do
     3604      for yb := minyb to maxyb do
    32073605      begin
    3208         for i := copycount - 1 downto 0 do
     3606        if AOpacity <> 255 then
    32093607        begin
    3210           FastBlendPixelInline(pdest, psource^);
    3211           Inc(pdest);
    3212           Inc(psource);
    3213         end;
     3608          for i := copycount - 1 downto 0 do
     3609          begin
     3610            FastBlendPixelInline(pdest, psource^, AOpacity);
     3611            Inc(pdest);
     3612            Inc(psource);
     3613          end;
     3614        end else
     3615          for i := copycount - 1 downto 0 do
     3616          begin
     3617            FastBlendPixelInline(pdest, psource^);
     3618            Inc(pdest);
     3619            Inc(psource);
     3620          end;
    32143621        Inc(psource, delta_source);
    32153622        Inc(pdest, delta_dest);
    … …  
    32173624      InvalidateBitmap;
    32183625    end;
    3219   end;
    3220 end;
    3221 
    3222 procedure TBGRADefaultBitmap.BlendImage(x, y: integer; Source: TBGRADefaultBitmap;
     3626    dmXor:
     3627    begin
     3628      if AOpacity <> 255 then
     3629      begin
     3630        Dec(delta_source, copycount);
     3631        Dec(delta_dest, copycount);
     3632        for yb := minyb to maxyb do
     3633        begin
     3634          for i := copycount - 1 downto 0 do
     3635          begin
     3636            FastBlendPixelInline(pdest, TBGRAPixel(PDWord(pdest)^ xor PDword(psource)^), AOpacity);
     3637            Inc(pdest);
     3638            Inc(psource);
     3639          end;
     3640          Inc(psource, delta_source);
     3641          Inc(pdest, delta_dest);
     3642        end;
     3643      end else
     3644      begin
     3645        for yb := minyb to maxyb do
     3646        begin
     3647          XorPixels(pdest, psource, copycount);
     3648          Inc(psource, delta_source);
     3649          Inc(pdest, delta_dest);
     3650        end;
     3651      end;
     3652      InvalidateBitmap;
     3653    end;
     3654  end;
     3655end;
     3656
     3657procedure TBGRADefaultBitmap.BlendImage(x, y: integer; Source: TBGRACustomBitmap;
    32233658  operation: TBlendOperation);
    32243659var
    3225   x2, y2, yb, minxb, minyb, maxxb, ignoreleft, copycount, sourcewidth,
     3660  yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
    32263661  delta_source, delta_dest: integer;
    32273662  psource, pdest: PBGRAPixel;
    … …  
    32293664  sourcewidth := Source.Width;
    32303665
    3231   if (x >= Width) or (y >= Height) or (x <= -sourcewidth) or
    3232     (y <= -Source.Height) or (Height = 0) or (Source.Height = 0) then
    3233     exit;
    3234 
    3235   x2 := x + sourcewidth - 1;
    3236   y2 := y + Source.Height - 1;
    3237 
    3238   if y < 0 then
    3239     minyb := 0
    3240   else
    3241     minyb := y;
    3242   if y2 >= Height then
    3243     y2 := Height - 1;
    3244 
    3245   if x < 0 then
    3246   begin
    3247     ignoreleft := -x;
    3248     minxb      := 0;
    3249   end
    3250   else
    3251   begin
    3252     ignoreleft := 0;
    3253     minxb      := x;
    3254   end;
    3255   if x2 >= Width then
    3256     maxxb := Width - 1
    3257   else
    3258     maxxb := x2;
     3666  if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft) then exit;
    32593667
    32603668  copycount := maxxb - minxb + 1;
    32613669
    32623670  psource := Source.ScanLine[minyb - y] + ignoreleft;
    3263   if Source.FLineOrder = riloBottomToTop then
     3671  if Source.LineOrder = riloBottomToTop then
    32643672    delta_source := -sourcewidth
    32653673  else
    … …  
    32723680    delta_dest := Width;
    32733681
    3274   for yb := minyb to y2 do
     3682  for yb := minyb to maxyb do
    32753683  begin
    32763684    BlendPixels(pdest, psource, operation, copycount);
    … …  
    32813689end;
    32823690
    3283 function TBGRADefaultBitmap.Duplicate: TBGRADefaultBitmap;
     3691{ Draw an image wih an angle. Use an affine transformation to do this. }
     3692procedure TBGRADefaultBitmap.PutImageAngle(x, y: single;
     3693  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
     3694  imageCenterY: single; AOpacity: Byte);
     3695var
     3696  cosa,sina: single;
     3697
     3698  { Compute rotated coordinates }
     3699  function Coord(relX,relY: single): TPointF;
     3700  begin
     3701    relX -= imageCenterX;
     3702    relY -= imageCenterY;
     3703    result.x := relX*cosa-relY*sina+x;
     3704    result.y := relY*cosa+relX*sina+y;
     3705  end;
     3706
     3707begin
     3708  cosa := cos(-angle*Pi/180);
     3709  sina := -sin(-angle*Pi/180);
     3710  PutImageAffine(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source,AOpacity);
     3711end;
     3712
     3713{ Draw an image with an affine transformation (rotation, scale, translate).
     3714  Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis. }
     3715procedure TBGRADefaultBitmap.PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte);
     3716var affine: TBGRAAffineBitmapTransform;
     3717    minx,miny,maxx,maxy: integer;
     3718    pt4: TPointF;
     3719
     3720  //include specified point in the bounds
     3721  procedure Include(pt: TPointF);
     3722  begin
     3723    if floor(pt.X) < minx then minx := floor(pt.X);
     3724    if floor(pt.Y) < miny then miny := floor(pt.Y);
     3725    if ceil(pt.X) > maxx then maxx := ceil(pt.X);
     3726    if ceil(pt.Y) > maxy then maxy := ceil(pt.Y);
     3727  end;
     3728
     3729begin
     3730  if (abs(Origin.x-round(Origin.x))<1e-6) and (abs(Origin.y-round(Origin.Y))<1e-6) and
     3731     (abs(HAxis.x-(Origin.x+Source.Width))<1e-6) and (abs(HAxis.y-origin.y)<1e-6) and
     3732     (abs(VAxis.x-Origin.x)<1e-6) and (abs(VAxis.y-(Origin.y+Source.Height))<1e-6) then
     3733  begin
     3734    PutImage(round(origin.x),round(origin.y),Source,dmDrawWithTransparency,AOpacity);
     3735    exit;
     3736  end;
     3737
     3738  { Create affine transformation }
     3739  affine := TBGRAAffineBitmapTransform.Create(Source);
     3740  affine.GlobalOpacity := AOpacity;
     3741  affine.Fit(Origin,HAxis,VAxis);
     3742
     3743  { Compute bounds }
     3744  pt4.x := VAxis.x+HAxis.x-Origin.x;
     3745  pt4.y := VAxis.y+HAxis.y-Origin.y;
     3746  minx := floor(Origin.X);
     3747  miny := floor(Origin.Y);
     3748  maxx := ceil(Origin.X);
     3749  maxy := ceil(Origin.Y);
     3750  Include(HAxis);
     3751  Include(VAxis);
     3752  Include(pt4);
     3753
     3754  { Use the affine transformation as a scanner }
     3755  FillRect(minx,miny,maxx+1,maxy+1,affine,dmDrawWithTransparency);
     3756  affine.Free;
     3757end;
     3758
     3759{ Duplicate bitmap content. Optionally, bitmap properties can be also duplicated }
     3760function TBGRADefaultBitmap.Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap;
     3761var Temp: TBGRADefaultBitmap;
    32843762begin
    32853763  LoadFromBitmapIfNeeded;
    3286   Result := NewBitmap(Width, Height);
    3287   Result.PutImage(0, 0, self, dmSet);
    3288   Result.Caption := self.Caption;
    3289 end;
    3290 
    3291 function TBGRADefaultBitmap.Equals(comp: TBGRADefaultBitmap): boolean;
     3764  Temp := NewBitmap(Width, Height) as TBGRADefaultBitmap;
     3765  Temp.PutImage(0, 0, self, dmSet);
     3766  Temp.Caption := self.Caption;
     3767  if DuplicateProperties then
     3768    CopyPropertiesTo(Temp);
     3769  Result := Temp;
     3770end;
     3771
     3772{ Copy properties only }
     3773procedure TBGRADefaultBitmap.CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
     3774begin
     3775  ABitmap.CanvasOpacity := CanvasOpacity;
     3776  ABitmap.CanvasDrawModeFP := CanvasDrawModeFP;
     3777  ABitmap.PenStyle := PenStyle;
     3778  ABitmap.CustomPenStyle := CustomPenStyle;
     3779  ABitmap.FontHeight := FontHeight;
     3780  ABitmap.FontName := FontName;
     3781  ABitmap.FontStyle := FontStyle;
     3782  ABitmap.FontAntialias := FontAntialias;
     3783  ABitmap.FontOrientation := FontOrientation;
     3784  ABitmap.LineCap := LineCap;
     3785  ABitmap.JoinStyle := JoinStyle;
     3786  ABitmap.FillMode := FillMode;
     3787  ABitmap.ClipRect := ClipRect;
     3788end;
     3789
     3790{ Check if two bitmaps have the same content }
     3791function TBGRADefaultBitmap.Equals(comp: TBGRACustomBitmap): boolean;
    32923792var
    32933793  yb, xb: integer;
    … …  
    33203820end;
    33213821
     3822{ Check if a bitmap is filled wih the specified color }
    33223823function TBGRADefaultBitmap.Equals(comp: TBGRAPixel): boolean;
    33233824var
    … …  
    33383839end;
    33393840
    3340 function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap;
     3841{----------------------------- Filters -----------------------------------------}
     3842{ Call the appropriate function }
     3843
     3844function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap;
    33413845begin
    33423846  Result := BGRAFilters.FilterSmartZoom3(self, Option);
    33433847end;
    33443848
    3345 function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRADefaultBitmap;
     3849function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRACustomBitmap;
    33463850begin
    33473851  Result := BGRAFilters.FilterMedian(self, option);
    33483852end;
    33493853
    3350 function TBGRADefaultBitmap.FilterSmooth: TBGRADefaultBitmap;
     3854function TBGRADefaultBitmap.FilterSmooth: TBGRACustomBitmap;
    33513855begin
    33523856  Result := BGRAFilters.FilterBlurRadialPrecise(self, 0.3);
    33533857end;
    33543858
    3355 function TBGRADefaultBitmap.FilterSphere: TBGRADefaultBitmap;
     3859function TBGRADefaultBitmap.FilterSphere: TBGRACustomBitmap;
    33563860begin
    33573861  Result := BGRAFilters.FilterSphere(self);
    33583862end;
    33593863
    3360 function TBGRADefaultBitmap.FilterCylinder: TBGRADefaultBitmap;
     3864function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
     3865begin
     3866  Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent);
     3867end;
     3868
     3869function TBGRADefaultBitmap.FilterCylinder: TBGRACustomBitmap;
    33613870begin
    33623871  Result := BGRAFilters.FilterCylinder(self);
    33633872end;
    33643873
    3365 function TBGRADefaultBitmap.FilterPlane: TBGRADefaultBitmap;
     3874function TBGRADefaultBitmap.FilterPlane: TBGRACustomBitmap;
    33663875begin
    33673876  Result := BGRAFilters.FilterPlane(self);
    33683877end;
    33693878
    3370 function TBGRADefaultBitmap.FilterSharpen: TBGRADefaultBitmap;
     3879function TBGRADefaultBitmap.FilterSharpen: TBGRACustomBitmap;
    33713880begin
    33723881  Result := BGRAFilters.FilterSharpen(self);
    33733882end;
    33743883
    3375 function TBGRADefaultBitmap.FilterContour: TBGRADefaultBitmap;
     3884function TBGRADefaultBitmap.FilterContour: TBGRACustomBitmap;
    33763885begin
    33773886  Result := BGRAFilters.FilterContour(self);
    … …  
    33793888
    33803889function TBGRADefaultBitmap.FilterBlurRadial(radius: integer;
    3381   blurType: TRadialBlurType): TBGRADefaultBitmap;
     3890  blurType: TRadialBlurType): TBGRACustomBitmap;
    33823891begin
    33833892  Result := BGRAFilters.FilterBlurRadial(self, radius, blurType);
    33843893end;
    33853894
     3895function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
     3896  useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
     3897begin
     3898  Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter);
     3899end;
     3900
    33863901function TBGRADefaultBitmap.FilterBlurMotion(distance: integer;
    3387   angle: single; oriented: boolean): TBGRADefaultBitmap;
     3902  angle: single; oriented: boolean): TBGRACustomBitmap;
    33883903begin
    33893904  Result := BGRAFilters.FilterBlurMotion(self, distance, angle, oriented);
    33903905end;
    33913906
    3392 function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRADefaultBitmap):
    3393 TBGRADefaultBitmap;
     3907function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRACustomBitmap):
     3908TBGRACustomBitmap;
    33943909begin
    33953910  Result := BGRAFilters.FilterBlur(self, mask);
    33963911end;
    33973912
    3398 function TBGRADefaultBitmap.FilterEmboss(angle: single): TBGRADefaultBitmap;
     3913function TBGRADefaultBitmap.FilterEmboss(angle: single): TBGRACustomBitmap;
    33993914begin
    34003915  Result := BGRAFilters.FilterEmboss(self, angle);
    … …  
    34023917
    34033918function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean):
    3404 TBGRADefaultBitmap;
     3919TBGRACustomBitmap;
    34053920begin
    34063921  Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection);
    34073922end;
    34083923
    3409 function TBGRADefaultBitmap.FilterGrayscale: TBGRADefaultBitmap;
     3924function TBGRADefaultBitmap.FilterGrayscale: TBGRACustomBitmap;
    34103925begin
    34113926  Result := BGRAFilters.FilterGrayscale(self);
    … …  
    34133928
    34143929function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True):
    3415 TBGRADefaultBitmap;
     3930TBGRACustomBitmap;
    34163931begin
    34173932  Result := BGRAFilters.FilterNormalize(self, eachChannel);
    … …  
    34193934
    34203935function TBGRADefaultBitmap.FilterRotate(origin: TPointF;
    3421   angle: single): TBGRADefaultBitmap;
     3936  angle: single): TBGRACustomBitmap;
    34223937begin
    34233938  Result := BGRAFilters.FilterRotate(self, origin, angle);
    … …  
    34813996end;
    34823997
     3998function TBGRADefaultBitmap.CreateAdaptedPngWriter: TFPWriterPNG;
     3999begin
     4000  result := TFPWriterPNG.Create;
     4001  result.Indexed := False;
     4002  result.UseAlpha := HasTransparentPixels;
     4003  result.WordSized := false;
     4004end;
     4005
     4006{$hints off}
     4007function TBGRADefaultBitmap.LoadAsBmp32(Str: TStream): boolean;
     4008var OldPos: int64;
     4009    fileHeader: TBitmapFileHeader;
     4010    infoHeader: TBitmapInfoHeader;
     4011    dataSize: integer;
     4012begin
     4013  OldPos := Str.Position;
     4014  result := false;
     4015  try
     4016    if Str.Read(fileHeader,sizeof(fileHeader)) <> sizeof(fileHeader) then
     4017      raise exception.Create('Inuable to read file header');
     4018    if fileHeader.bfType = $4D42 then
     4019    begin
     4020      if Str.Read(infoHeader,sizeof(infoHeader)) <> sizeof(infoHeader) then
     4021        raise exception.Create('Inuable to read info header');
     4022
     4023      if (infoHeader.biPlanes = 1) and (infoHeader.biBitCount = 32) and (infoHeader.biCompression = 0) then
     4024      begin
     4025        SetSize(infoHeader.biWidth,infoHeader.biHeight);
     4026        Str.Position := OldPos+fileHeader.bfOffBits;
     4027        dataSize := NbPixels*sizeof(TBGRAPixel);
     4028        if Str.Read(Data^, dataSize) <> dataSize then
     4029        Begin
     4030          SetSize(0,0);
     4031          raise exception.Create('Unable to read data');
     4032        end;
     4033        result := true;
     4034      end;
     4035    end;
     4036
     4037  except
     4038    on ex:exception do
     4039    begin
     4040
     4041    end;
     4042  end;
     4043  Str.Position := OldPos;
     4044
     4045end;
     4046{$hints on}
     4047
    34834048procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte);
    34844049begin
    … …  
    34964061
    34974062function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer):
    3498 TBGRADefaultBitmap;
    3499 begin
    3500   Result := BGRAResample.FineResample(self, NewWidth, NewHeight);
     4063TBGRACustomBitmap;
     4064begin
     4065  Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter);
    35014066end;
    35024067
    35034068function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer):
    3504 TBGRADefaultBitmap;
     4069TBGRACustomBitmap;
    35054070begin
    35064071  Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight);
    … …  
    35084073
    35094074function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer;
    3510   mode: TResampleMode): TBGRADefaultBitmap;
     4075  mode: TResampleMode): TBGRACustomBitmap;
    35114076begin
    35124077  case mode of
    … …  
    35204085{-------------------------------- Data functions ------------------------}
    35214086
     4087{ Flip vertically the bitmap. Use a temporary line to store top line,
     4088  assign bottom line to top line, then assign temporary line to bottom line.
     4089
     4090  It is an involution, i.e it does nothing when applied twice }
    35224091procedure TBGRADefaultBitmap.VerticalFlip;
    35234092var
    … …  
    35314100    exit;
    35324101
     4102  LoadFromBitmapIfNeeded;
    35334103  linesize := Width * sizeof(TBGRAPixel);
    35344104  line     := nil;
    … …  
    35484118end;
    35494119
     4120{ Flip horizontally. Swap left pixels with right pixels on each line.
     4121
     4122  It is an involution, i.e it does nothing when applied twice}
    35504123procedure TBGRADefaultBitmap.HorizontalFlip;
    35514124var
    … …  
    35584131    exit;
    35594132
     4133  LoadFromBitmapIfNeeded;
    35604134  for yb := 0 to Height - 1 do
    35614135  begin
    … …  
    35744148end;
    35754149
    3576 function TBGRADefaultBitmap.RotateCW: TBGRADefaultBitmap;
     4150{ Return a new bitmap rotated in a clock wise direction. }
     4151function TBGRADefaultBitmap.RotateCW: TBGRACustomBitmap;
    35774152var
    35784153  psrc, pdest: PBGRAPixel;
    … …  
    35804155  delta: integer;
    35814156begin
     4157  LoadFromBitmapIfNeeded;
    35824158  Result := NewBitmap(Height, Width);
    35834159  if Result.LineOrder = riloTopToBottom then
    … …  
    35984174end;
    35994175
    3600 function TBGRADefaultBitmap.RotateCCW: TBGRADefaultBitmap;
     4176{ Return a new bitmap rotated in a counter clock wise direction. }
     4177function TBGRADefaultBitmap.RotateCCW: TBGRACustomBitmap;
    36014178var
    36024179  psrc, pdest: PBGRAPixel;
    … …  
    36044181  delta: integer;
    36054182begin
     4183  LoadFromBitmapIfNeeded;
    36064184  Result := NewBitmap(Height, Width);
    36074185  if Result.LineOrder = riloTopToBottom then
    … …  
    36224200end;
    36234201
     4202{ Compute negative with gamma correction. A negative contains
     4203  complentary colors (black becomes white etc.).
     4204
     4205  It is an involution, i.e it does nothing when applied twice }
    36244206procedure TBGRADefaultBitmap.Negative;
    36254207var
    … …  
    36274209  n: integer;
    36284210begin
     4211  LoadFromBitmapIfNeeded;
    36294212  p := Data;
    36304213  for n := NbPixels - 1 downto 0 do
    … …  
    36414224end;
    36424225
     4226{ Compute negative without gamma correction.
     4227
     4228  It is an involution, i.e it does nothing when applied twice }
    36434229procedure TBGRADefaultBitmap.LinearNegative;
    36444230var
    … …  
    36464232  n: integer;
    36474233begin
     4234  LoadFromBitmapIfNeeded;
    36484235  p := Data;
    36494236  for n := NbPixels - 1 downto 0 do
    … …  
    36604247end;
    36614248
     4249{ Swap red and blue channels. Useful when RGB order is swapped.
     4250
     4251  It is an involution, i.e it does nothing when applied twice }
    36624252procedure TBGRADefaultBitmap.SwapRedBlue;
    36634253var
    … …  
    36664256  p:    PLongword;
    36674257begin
     4258  LoadFromBitmapIfNeeded;
    36684259  p := PLongword(Data);
    36694260  n := NbPixels;
    … …  
    36714262    exit;
    36724263  repeat
    3673     temp := p^;
    3674     p^   := ((temp and $FF) shl 16) or ((temp and $FF0000) shr 16) or
    3675       temp and $FF00FF00;
     4264    temp := LEtoN(p^);
     4265    p^   := NtoLE(((temp and $FF) shl 16) or ((temp and $FF0000) shr 16) or
     4266      temp and $FF00FF00);
    36764267    Inc(p);
    36774268    Dec(n);
    … …  
    36804271end;
    36814272
     4273{ Convert a grayscale image into a black image with alpha value }
    36824274procedure TBGRADefaultBitmap.GrayscaleToAlpha;
    36834275var
    … …  
    36864278  p:    PLongword;
    36874279begin
     4280  LoadFromBitmapIfNeeded;
    36884281  p := PLongword(Data);
    36894282  n := NbPixels;
    … …  
    36914284    exit;
    36924285  repeat
    3693     temp := p^;
    3694     p^   := (temp and $FF) shl 24;
     4286    temp := LEtoN(p^);
     4287    p^   := NtoLE((temp and $FF) shl 24);
    36954288    Inc(p);
    36964289    Dec(n);
    … …  
    37054298  p:    PLongword;
    37064299begin
     4300  LoadFromBitmapIfNeeded;
    37074301  p := PLongword(Data);
    37084302  n := NbPixels;
    … …  
    37104304    exit;
    37114305  repeat
    3712     temp := p^ shr 24;
    3713     p^   := temp or (temp shl 8) or (temp shl 16) or $FF000000;
     4306    temp := LEtoN(p^ shr 24);
     4307    p^   := NtoLE(temp or (temp shl 8) or (temp shl 16) or $FF000000);
    37144308    Inc(p);
    37154309    Dec(n);
    … …  
    37184312end;
    37194313
    3720 procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRADefaultBitmap);
     4314{ Apply a mask to the bitmap. It means that alpha channel is
     4315  changed according to grayscale values of the mask.
     4316
     4317  See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 }
     4318procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRACustomBitmap);
    37214319var
    37224320  p, pmask: PBGRAPixel;
    … …  
    37264324    exit;
    37274325
     4326  LoadFromBitmapIfNeeded;
    37284327  for yb := 0 to Height - 1 do
    37294328  begin
    … …  
    37324331    for xb := Width - 1 downto 0 do
    37334332    begin
    3734       p^.alpha := (p^.alpha * pmask^.red + 128) div 255;
     4333      p^.alpha := ApplyOpacity(p^.alpha, pmask^.red);
    37354334      Inc(p);
    37364335      Inc(pmask);
    … …  
    37404339end;
    37414340
     4341procedure TBGRADefaultBitmap.ApplyGlobalOpacity(alpha: byte);
     4342var
     4343  p: PBGRAPixel;
     4344  i: integer;
     4345begin
     4346  if alpha = 0 then
     4347    FillTransparent
     4348  else
     4349  if alpha <> 255 then
     4350  begin
     4351    p := Data;
     4352    for i := NbPixels - 1 downto 0 do
     4353    begin
     4354      p^.alpha := ApplyOpacity(p^.alpha, alpha);
     4355      Inc(p);
     4356    end;
     4357  end;
     4358end;
     4359
     4360{ Get bounds of non zero values of specified channel }
    37424361function TBGRADefaultBitmap.GetImageBounds(Channel: TChannel = cAlpha): TRect;
    37434362var
    … …  
    37934412end;
    37944413
     4414function TBGRADefaultBitmap.GetImageBounds(Channels: TChannels): TRect;
     4415var c: TChannel;
     4416begin
     4417  result := rect(0,0,0,0);
     4418  for c := low(TChannel) to high(TChannel) do
     4419    if c in Channels then
     4420      UnionRect(result,result,GetImageBounds(c));
     4421end;
     4422
     4423{ Make a copy of the transparent bitmap to a TBitmap with a background color
     4424  instead of transparency }
    37954425function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
    37964426var
    3797   opaqueCopy: TBGRADefaultBitmap;
     4427  opaqueCopy: TBGRACustomBitmap;
    37984428begin
    37994429  Result     := TBitmap.Create;
    … …  
    38074437end;
    38084438
    3809 procedure TBGRADefaultBitmap.DrawPart(Arect: TRect; Canvas: TCanvas;
    3810   x, y: integer; Opaque: boolean);
    3811 var
    3812   partial: TBGRADefaultBitmap;
    3813 begin
    3814   partial := GetPart(ARect);
    3815   if partial <> nil then
    3816   begin
    3817     partial.Draw(Canvas, x, y, Opaque);
    3818     partial.Free;
    3819   end;
    3820 end;
    3821 
    3822 function TBGRADefaultBitmap.GetPart(ARect: TRect): TBGRADefaultBitmap;
     4439{ Get a part of the image with repetition in both directions. It means
     4440  that if the bounds are within the image, the result is just that part
     4441  of the image, but if the bounds are bigger than the image, the image
     4442  is tiled. }
     4443function TBGRADefaultBitmap.GetPart(ARect: TRect): TBGRACustomBitmap;
    38234444var
    38244445  copywidth, copyheight, widthleft, heightleft, curxin, curyin, xdest,
    … …  
    38904511end;
    38914512
     4513function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer
     4514  ): TBGRACustomBitmap;
     4515var temp: integer;
     4516    ptrbmp: TBGRAPtrBitmap;
     4517begin
     4518  if Top > Bottom then
     4519  begin
     4520    temp := Top;
     4521    Top := Bottom;
     4522    Bottom := Temp;
     4523  end;
     4524  if Top < 0 then Top := 0;
     4525  if Bottom > Height then Bottom := Height;
     4526  if Top >= Bottom then
     4527    result := nil
     4528  else
     4529  begin
     4530    if LineOrder = riloTopToBottom then
     4531      ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Top]) else
     4532      ptrbmp := TBGRAPtrBitmap.Create(Width,Bottom-Top,ScanLine[Bottom-1]);
     4533    ptrbmp.LineOrder := LineOrder;
     4534    result := ptrbmp;
     4535  end;
     4536end;
     4537
     4538{ Draw BGRA data to a canvas with transparency }
    38924539procedure TBGRADefaultBitmap.DataDrawTransparent(ACanvas: TCanvas;
    38934540  Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
    … …  
    39114558end;
    39124559
     4560{ Draw BGRA data to a canvas without transparency }
    39134561procedure TBGRADefaultBitmap.DataDrawOpaque(ACanvas: TCanvas;
    39144562  Rect: TRect; AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
    … …  
    39244572  ALineEndMargin: integer;
    39254573  CreateResult: boolean;
    3926 {$IFDEF DARWIN}
    3927   TempShift: byte;
    3928 {$ENDIF}
     4574  {$IFDEF DARWIN}
     4575  TempShift: Byte;
     4576  {$ENDIF}
    39294577begin
    39304578  if (AHeight = 0) or (AWidth = 0) then
    … …  
    39394587  PTempData := TempData;
    39404588  PSource   := AData;
    3941      {$IFDEF DARWIN}
    3942   SwapRedBlue; //swap red and blue values
    3943      {$ENDIF}
     4589
     4590{$IFDEF DARWIN} //swap red and blue values
    39444591  for y := 0 to AHeight - 1 do
    39454592  begin
    39464593    for x := 0 to AWidth - 1 do
    39474594    begin
    3948       PWord(PTempData)^ := PWord(PSource)^;
    3949       Inc(PTempData, 2);
    3950       Inc(PSource, 2);
    3951       PTempData^ := PSource^;
    3952       Inc(PTempData);
    3953       Inc(PSource, 2);
     4595      PTempData^ := (PSource+2)^;
     4596      (PTempData+1)^ := (PSource+1)^;
     4597      (PTempData+2)^ := PSource^;
     4598      inc(PTempData,3);
     4599      inc(PSource,4);
    39544600    end;
    39554601    Inc(PTempData, ALineEndMargin);
    39564602  end;
    3957      {$IFDEF DARWIN}
    3958   SwapRedBlue; //swap red and blue values
    3959      {$ENDIF}
     4603{$ELSE}
     4604  for y := 0 to AHeight - 1 do
     4605  begin
     4606    for x := 0 to AWidth - 1 do
     4607    begin
     4608      PWord(PTempData)^ := PWord(PSource)^;
     4609      (PTempData+2)^ := (PSource+2)^;
     4610      Inc(PTempData,3);
     4611      Inc(PSource, 4);
     4612    end;
     4613    Inc(PTempData, ALineEndMargin);
     4614  end;
     4615{$ENDIF}
    39604616
    39614617  RawImage.Init;
    39624618  RawImage.Description.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight);
    3963      {$IFDEF DARWIN}
    3964   //swap red and blue positions
     4619{$IFDEF DARWIN}
    39654620  TempShift := RawImage.Description.RedShift;
    39664621  RawImage.Description.RedShift := RawImage.Description.BlueShift;
    39674622  RawImage.Description.BlueShift := TempShift;
    3968      {$ENDIF}
     4623{$ENDIF}
     4624
    39694625  RawImage.Description.LineOrder := ALineOrder;
    39704626  RawImage.Description.LineEnd := rileDWordBoundary;
     4627
    39714628  if integer(RawImage.Description.BytesPerLine) <> AWidth * 3 + ALineEndMargin then
    39724629  begin
    … …  
    39994656    raise EOutOfMemory.Create('TBGRADefaultBitmap: Not enough memory');
    40004657  InvalidateBitmap;
     4658  FScanPtr := nil;
    40014659end;
    40024660
    … …  
    40424700var
    40434701  bmp: TBitmap;
    4044   subBmp: TBGRADefaultBitmap;
     4702  subBmp: TBGRACustomBitmap;
    40454703  subRect: TRect;
    40464704  cw,ch: integer;
    … …  
    40814739end;
    40824740
     4741function TBGRADefaultBitmap.GetNbPixels: integer;
     4742begin
     4743  result := FNbPixels;
     4744end;
     4745
     4746function TBGRADefaultBitmap.GetWidth: integer;
     4747begin
     4748  Result := FWidth;
     4749end;
     4750
     4751function TBGRADefaultBitmap.GetHeight: integer;
     4752begin
     4753  Result:= FHeight;
     4754end;
     4755
     4756function TBGRADefaultBitmap.GetRefCount: integer;
     4757begin
     4758  result := FRefCount;
     4759end;
     4760
     4761function TBGRADefaultBitmap.GetLineOrder: TRawImageLineOrder;
     4762begin
     4763  result := FLineOrder;
     4764end;
     4765
     4766function TBGRADefaultBitmap.GetCanvasOpacity: byte;
     4767begin
     4768  result:= FCanvasOpacity;
     4769end;
     4770
     4771function TBGRADefaultBitmap.GetFontHeight: integer;
     4772begin
     4773  result := FFontHeight;
     4774end;
     4775
    40834776{ TBGRAPtrBitmap }
    40844777
    … …  
    40994792end;
    41004793
    4101 function TBGRAPtrBitmap.Duplicate: TBGRADefaultBitmap;
     4794function TBGRAPtrBitmap.Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap;
    41024795begin
    41034796  Result := NewBitmap(Width, Height);
    4104   TBGRAPtrBitmap(Result).SetDataPtr(FData);
     4797  if DuplicateProperties then CopyPropertiesTo(TBGRADefaultBitmap(Result));
    41054798end;
    41064799
    … …  
    41084801begin
    41094802  FData := AData;
     4803end;
     4804
     4805procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
     4806  c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
     4807  gammaColorCorrection: boolean = True; Sinus: Boolean=False);
     4808var
     4809  gradScan : TBGRAGradientScanner;
     4810begin
     4811  //handles transparency
     4812  if (c1.alpha = 0) and (c2.alpha = 0) then
     4813  begin
     4814    bmp.FillRect(x, y, x2, y2, BGRAPixelTransparent, mode);
     4815    exit;
     4816  end;
     4817
     4818  gradScan := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
     4819  bmp.FillRect(x,y,x2,y2,gradScan,mode);
     4820  gradScan.Free;
    41104821end;
    41114822
Note: See TracChangeset for help on using the changeset viewer.