Ignore:
Timestamp:
Apr 9, 2015, 9:58:36 PM (9 years ago)
Author:
chronos
Message:
  • Fixed: Use csOpaque control style also to Image, PaintBox and OpenGLControl.
  • Modified: Change size of test frame with SpinEdits as delayed using timer.
  • Updated: BRGABitmap package to version 8.1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgrabitmaptypes.pas

    r452 r472  
    3636  PBGRAPixel = ^TBGRAPixel;
    3737
    38   //pixel structure
     38  Int32or64 = {$IFDEF CPU64}Int64{$ELSE}LongInt{$ENDIF};
     39  UInt32or64 = {$IFDEF CPU64}UInt64{$ELSE}LongWord{$ENDIF};
     40
     41  //Each pixel is a sequence of 4 bytes containing blue, green, red and alpha channel.
    3942  TBGRAPixel = packed record
    4043    blue, green, red, alpha: byte;
    4144  end;
     45
     46  ArrayOfTBGRAPixel = array of TBGRAPixel;
    4247
    4348  //gamma expanded values
    … …  
    5055    hue, saturation, lightness, alpha: word;
    5156  end;
     57  TGSBAPixel = THSLAPixel;
    5258
    5359  //general purpose color variable with floating point values
    … …  
    7076
    7177  TResampleMode = (rmSimpleStretch,   //low quality resample
    72                    rmFineResample);   //use resample filters
    73   TResampleFilter = (rfLinear,        //linear interpolation
     78                   rmFineResample);   //use resample filters and pixel-centered coordinates
     79  TResampleFilter = (rfBox,           //equivalent of stretch with high quality
     80                     rfLinear,        //linear interpolation
    7481                     rfHalfCosine,    //mix of rfLinear and rfCosine
    7582                     rfCosine,        //cosine-like interpolation
    … …  
    7784                     rfMitchell,      //downsizing interpolation
    7885                     rfSpline,        //upsizing interpolation
     86                     rfLanczos2,      //Lanczos with radius 2
     87                     rfLanczos3,      //Lanczos with radius 3
     88                     rfLanczos4,      //Lanczos with radius 4
    7989                     rfBestQuality);  //mix of rfMitchell and rfSpline
    8090
     91  TDitheringAlgorithm = (daNearestNeighbor, daFloydSteinberg);
     92  TAlphaChannelPaletteOption = (acIgnore, acTransparentEntry, acFullChannelInPalette);
     93
     94const
     95  ResampleFilterStr : array[TResampleFilter] of string =
     96   ('Box','Linear','HalfCosine','Cosine','Bicubic','Mitchell','Spline',
     97    'Lanczos2','Lanczos3','Lanczos4','BestQuality');
     98
     99function StrToResampleFilter(str: string): TResampleFilter;
     100
     101type
     102  TBGRAImageFormat = (ifUnknown, ifJpeg, ifPng, ifGif, ifBmp, ifIco, ifPcx, ifPaintDotNet, ifLazPaint, ifOpenRaster,
     103    ifPsd, ifTarga, ifTiff, ifXwd, ifXPixMap, ifBmpMioMap);
     104
     105var
     106  DefaultBGRAImageReader: array[TBGRAImageFormat] of TFPCustomImageReaderClass;
     107  DefaultBGRAImageWriter: array[TBGRAImageFormat] of TFPCustomImageWriterClass;
     108
     109type
    81110  TBGRAFontQuality = (fqSystem, fqSystemClearType, fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR);
     111        // fqSystem: use system rendering. It is fast however it may be not be smoothed.
     112        // fqSystemClearType: use system rendering with ClearType. This quality is of course better than fqSystem however it may not be much smoother.
     113        // fqFineAntialiasing: garanties a high quality antialiasing. This is slower.
     114        // fqFineClearTypeRGB: garanties a high quality antialiasing with ClearType. The order of the color in the LCD screen is supposed to be un red/green/blue order.
     115        // fqFineClearTypeBGR: same as above, except the color of the LCD screen is supposed to be in blue/green/red order.
    82116
    83117  TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth);
    84   TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast);
    85   TSplineStyle = (ssInside, ssInsideWithEnds, ssCrossing, ssCrossingWithEnds, ssOutside, ssRoundOutside, ssVertexToSide);
     118  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast, rbBox);
     119  TSplineStyle = (ssInside, ssInsideWithEnds, ssCrossing, ssCrossingWithEnds,
     120    ssOutside, ssRoundOutside, ssVertexToSide);
    86121 
    87   //Advanced blending modes
    88   //see : http://www.brighthub.com/multimedia/photography/articles/18301.aspx
    89   //and : http://www.pegtop.net/delphi/articles/blendmodes/ 
     122  { Advanced blending modes
     123    see : http://www.brighthub.com/multimedia/photography/articles/18301.aspx
     124    and : http://www.pegtop.net/delphi/articles/blendmodes/ }
    90125  TBlendOperation = (boLinearBlend, boTransparent,                                  //blending
    91126    boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boDivide, boNiceGlow, boSoftLight, boHardLight, //lighting
    … …  
    146181  end;
    147182
     183  TArcDef = record
     184    center: TPointF;
     185    radius: TPointF;
     186    xAngleRadCW, startAngleRadCW, endAngleRadCW: single; //see convention in BGRAPath
     187    anticlockwise: boolean
     188  end;
     189  PArcDef = ^TArcDef;
     190
    148191  TPoint3D = record
    149192    x,y,z: single;
    150193  end;
     194
     195  TBGRAArrowStyle = (asNone, asNormal, asCut, asTriangle, asHollowTriangle, asFlipped, asFlippedCut, asTail, asTailRepeat);
    151196
    152197  TBGRATypeWriterAlignment = (twaTopLeft, twaTop, twaTopRight,
    … …  
    169214function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
    170215function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
     216function BezierCurve(origin, destination: TPointF) : TQuadraticBezierCurve; overload;
     217function ArcDef(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean) : TArcDef;
    171218
    172219{ Useful constants }
    … …  
    184231  clBlackOpaque = TColor($010000);
    185232
     233{$DEFINE INCLUDE_COLOR_CONST}
    186234{$i csscolorconst.inc}
    187235
    … …  
    204252  public
    205253    constructor Create;
    206     procedure Add(Name: string; Color: TBGRAPixel);
     254    procedure Add(Name: string; const Color: TBGRAPixel);
    207255    procedure Finished;
    208256    function IndexOf(Name: string): integer;
     257    function IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer;
    209258
    210259    property ByName[Name: string]: TBGRAPixel read GetByName;
    … …  
    215264
    216265var
    217   CSSColors: TBGRAColorList;
     266  VGAColors, CSSColors: TBGRAColorList;
    218267
    219268function isEmptyPointF(pt: TPointF): boolean;
    … …  
    236285  end;
    237286
     287  { A path is the ability to define a contour with moveTo, lineTo...
     288    It must not implement reference counting. }
     289  IBGRAPath = interface
     290    procedure closePath;
     291    procedure moveTo(const pt: TPointF);
     292    procedure lineTo(const pt: TPointF);
     293    procedure polylineTo(const pts: array of TPointF);
     294    procedure quadraticCurveTo(const cp,pt: TPointF);
     295    procedure bezierCurveTo(const cp1,cp2,pt: TPointF);
     296    procedure arc(const arcDef: TArcDef);
     297    procedure copyTo(dest: IBGRAPath);
     298  end;
     299
    238300  TScanAtFunction = function (X,Y: Single): TBGRAPixel of object;
    239301  TScanAtIntegerFunction = function (X,Y: Integer): TBGRAPixel of object;
    240302  TScanNextPixelFunction = function: TBGRAPixel of object;
    241303  TBGRACustomGradient = class;
     304
     305  TBGRACustomFillInfo = class;
     306  TBGRACustomFontRenderer = class;
    242307
    243308  { TBGRACustomBitmap }
    … …  
    249314  protected
    250315     { accessors to properies }
     316     function GetArrowEndRepeat: integer; virtual; abstract;
     317     function GetArrowStartRepeat: integer; virtual; abstract;
     318     procedure SetArrowEndRepeat(AValue: integer); virtual; abstract;
     319     procedure SetArrowStartRepeat(AValue: integer); virtual; abstract;
     320     function GetArrowEndOffset: single; virtual; abstract;
     321     function GetArrowStartOffset: single; virtual; abstract;
     322     procedure SetArrowEndOffset(AValue: single); virtual; abstract;
     323     procedure SetArrowStartOffset(AValue: single); virtual; abstract;
     324     function GetArrowEndSize: TPointF; virtual; abstract;
     325     function GetArrowStartSize: TPointF; virtual; abstract;
     326     procedure SetArrowEndSize(AValue: TPointF); virtual; abstract;
     327     procedure SetArrowStartSize(AValue: TPointF); virtual; abstract;
     328     function GetLineCap: TPenEndCap; virtual; abstract;
     329     procedure SetLineCap(AValue: TPenEndCap); virtual; abstract;
     330     function GetFontRenderer: TBGRACustomFontRenderer; virtual; abstract;
     331     procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); virtual; abstract;
    251332     function GetHeight: integer; virtual; abstract;
    252333     function GetWidth: integer; virtual; abstract;
    … …  
    280361     procedure SetClipRect(const AValue: TRect); virtual; abstract;
    281362     function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
    282      function LoadAsBmp32(Str: TStream): boolean; virtual; abstract;
     363     procedure ClearTransparentPixels; virtual; abstract;
     364     procedure SetArrowStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); virtual; abstract;
     365     procedure SetArrowEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0); virtual; abstract;
    283366
    284367  public
    285368     Caption:   string;  //user defined caption
    286369
    287      //font style
    288      FontName:  string;
    289      FontStyle: TFontStyles;
    290      FontQuality : TBGRAFontQuality;
    291      FontOrientation: integer;
     370     {-------------------font style------------------------}
     371     FontName: string;              //Specifies the font to use. Unless the font renderer accept otherwise,
     372                                    //the name is in human readable form, like 'Arial', 'Times New Roman', ...
     373
     374     FontStyle: TFontStyles;        //Specifies the set of styles to be applied to the font.
     375                                    //These can be fsBold, fsItalic, fsStrikeOut, fsUnderline.
     376                                    //So the value [fsBold,fsItalic] means that the font must be bold and italic.
     377
     378     FontQuality : TBGRAFontQuality;//Specifies the quality of rendering. Default value is fqSystem.
     379
     380     FontOrientation: integer;      //Specifies the rotation of the text, for functions that support text rotation.
     381                                    //It is expressed in tenth of degrees, positive values going counter-clockwise.
    292382
    293383     //line style
    294      LineCap:   TPenEndCap;
    295384     JoinStyle: TPenJoinStyle;
    296385     JoinMiterLimit: single;
    297386
    298387     FillMode:  TFillMode;  //winding or alternate
     388     LinearAntialiasing: boolean;
    299389
    300390     { The resample filter is used when resizing the bitmap, and
    … …  
    310400     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); virtual; abstract; overload;
    311401     constructor Create(AFilename: string); virtual; abstract; overload;
     402     constructor Create(AFilename: string; AIsUtf8Filename: boolean); virtual; abstract; overload;
    312403     constructor Create(AStream: TStream); virtual; abstract; overload;
    313404
    … …  
    315406     function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; virtual; abstract; overload;
    316407     function NewBitmap(Filename: string): TBGRACustomBitmap; virtual; abstract; overload;
    317 
     408     function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; virtual; abstract; overload;
     409
     410     //there are UTF8 functions that are different from standard function as those
     411     //depend on TFPCustomImage that does not clearly handle UTF8
    318412     procedure LoadFromFile(const filename: string); virtual;
    319      procedure LoadFromStream(Str: TStream); virtual;
    320      procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader); virtual;
    321      procedure SaveToFile(const filename: string); virtual;
    322      procedure SaveToFile(const filename: string; Handler:TFPCustomImageWriter); virtual;
     413     procedure LoadFromFileUTF8(const filenameUTF8: string); virtual;
     414     procedure LoadFromFileUTF8(const filenameUTF8: string; AHandler: TFPCustomImageReader); virtual;
     415     procedure LoadFromStream(Str: TStream); virtual; overload;
     416     procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader); virtual; overload;
     417     procedure SaveToFile(const filename: string); virtual; overload;
     418     procedure SaveToFile(const filename: string; Handler:TFPCustomImageWriter); virtual; overload;
     419     procedure SaveToFileUTF8(const filenameUTF8: string); virtual; overload;
     420     procedure SaveToFileUTF8(const filenameUTF8: string; Handler:TFPCustomImageWriter); virtual; overload;
    323421     procedure SaveToStreamAsPng(Str: TStream); virtual; abstract;
    324      procedure Assign(ABitmap: TBitmap); virtual; abstract; overload;
     422     procedure SaveToStreamAs(Str: TStream; AFormat: TBGRAImageFormat); virtual;
     423     procedure Assign(ARaster: TRasterImage); virtual; abstract; overload;
    325424     procedure Assign(MemBitmap: TBGRACustomBitmap); virtual; abstract; overload;
    326425     procedure Serialize(AStream: TStream); virtual; abstract;
    … …  
    328427
    329428     {Pixel functions}
    330      procedure SetPixel(x, y: integer; c: TColor); virtual; abstract; overload;
    331      procedure XorPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
    332      procedure SetPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
    333      procedure DrawPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
    334      procedure DrawPixel(x, y: integer; ec: TExpandedPixel); virtual; abstract; overload;
    335      procedure FastBlendPixel(x, y: integer; c: TBGRAPixel); virtual; abstract;
    336      procedure ErasePixel(x, y: integer; alpha: byte); virtual; abstract;
    337      procedure AlphaPixel(x, y: integer; alpha: byte); virtual; abstract;
    338      function GetPixel(x, y: integer): TBGRAPixel; virtual; abstract;
    339      function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
    340      function GetPixelCycle(x, y: integer): TBGRAPixel; virtual;
     429     procedure SetPixel(x, y: int32or64; c: TColor); virtual; abstract; overload;
     430     procedure XorPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
     431     procedure SetPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
     432     procedure DrawPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract; overload;
     433     procedure DrawPixel(x, y: int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
     434     procedure DrawPixel(x, y: int32or64; ec: TExpandedPixel); virtual; abstract; overload;
     435     procedure FastBlendPixel(x, y: int32or64; c: TBGRAPixel); virtual; abstract;
     436     procedure ErasePixel(x, y: int32or64; alpha: byte); virtual; abstract;
     437     procedure AlphaPixel(x, y: int32or64; alpha: byte); virtual; abstract;
     438     function GetPixel(x, y: int32or64): TBGRAPixel; virtual; abstract; overload;
     439     function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract;
     440     function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; virtual; abstract; overload;
     441     function GetPixelCycle(x, y: int32or64): TBGRAPixel; virtual; overload;
    341442     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
    342443     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; virtual; abstract; overload;
     444     function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
     445     function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; virtual; abstract; overload;
    343446
    344447     {Line primitives}
    345      procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
    346      procedure XorHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
    347      procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract; overload;
    348      procedure DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel); virtual; abstract; overload;
    349      procedure DrawHorizLine(x, y, x2: integer; texture: IBGRAScanner); virtual; abstract; overload;
    350      procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
    351      procedure AlphaHorizLine(x, y, x2: integer; alpha: byte); virtual; abstract;
    352      procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
    353      procedure XorVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
    354      procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
    355      procedure AlphaVertLine(x, y, y2: integer; alpha: byte); virtual; abstract;
    356      procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
    357      procedure DrawHorizLineDiff(x, y, x2: integer; c, compare: TBGRAPixel;
    358        maxDiff: byte); virtual; abstract;
     448     procedure SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
     449     procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
     450     procedure DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract; overload;
     451     procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); virtual; abstract; overload;
     452     procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload;
     453     procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); virtual; abstract;
     454     procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); virtual; abstract;
     455     procedure SetVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
     456     procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
     457     procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
     458     procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); virtual; abstract;
     459     procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); virtual; abstract;
     460     procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel; maxDiff: byte); virtual; abstract;
     461     procedure HorizLine(x,y,x2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
     462     procedure VertLine(x,y,y2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode);
     463     procedure HorizLine(x,y,x2: Int32or64; texture: IBGRAScanner; ADrawMode: TDrawMode); virtual; abstract; overload;
    359464
    360465     {Shapes}
    361      procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract;
     466     procedure DrawPath(APath: IBGRAPath; c: TBGRAPixel; w: single); virtual; abstract;
     467     procedure DrawPath(APath: IBGRAPath; texture: IBGRAScanner; w: single); virtual; abstract;
     468
     469     procedure ArrowStartAsNone;
     470     procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1);
     471     procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5);
     472     procedure ArrowStartAsTail;
     473
     474     procedure ArrowEndAsNone;
     475     procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1);
     476     procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5);
     477     procedure ArrowEndAsTail;
     478
     479     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode= dmDrawWithTransparency); virtual; abstract;
    362480     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract; overload;
    363481     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; abstract; overload;
    … …  
    368486     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); virtual; abstract; overload;
    369487
     488     procedure DrawPolyLine(const points: array of TPoint; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode=dmDrawWithTransparency);
    370489     procedure DrawPolyLineAntialias(const points: array of TPoint; c: TBGRAPixel; DrawLastPixel: boolean); virtual; overload;
    371490     procedure DrawPolyLineAntialias(const points: array of TPoint; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; overload;
    … …  
    373492     procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
    374493     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
     494     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); virtual; abstract; overload;
     495     procedure DrawPolygon(const points: array of TPoint; c: TBGRAPixel; ADrawMode: TDrawMode=dmDrawWithTransparency);
     496     procedure DrawPolygonAntialias(const points: array of TPoint; c: TBGRAPixel); overload;
    375497     procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); virtual; abstract; overload;
    376498     procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
     499     procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); virtual; abstract; overload;
    377500
    378501     procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); virtual; abstract;
    … …  
    380503     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); virtual; abstract; overload;
    381504     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); virtual; abstract; overload;
     505     procedure ErasePolyLine(const points: array of TPoint; alpha: byte; DrawLastPixel: boolean);
     506     procedure ErasePolyLineAntialias(const points: array of TPoint; alpha: byte; DrawLastPixel: boolean); overload;
    382507     procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); virtual; abstract; overload;
     508     procedure ErasePolygonOutline(const points: array of TPoint; alpha: byte);
     509     procedure ErasePolygonOutlineAntialias(const points: array of TPoint; alpha: byte);
     510
     511     procedure FillPath(APath: IBGRAPath; c: TBGRAPixel); virtual; abstract;
     512     procedure FillPath(APath: IBGRAPath; texture: IBGRAScanner); virtual; abstract;
    383513
    384514     procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
    … …  
    394524     procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
    395525     procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
     526     procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); virtual; abstract; overload;
    396527     procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
     528     procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); virtual; abstract; overload;
    397529
    398530     procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel);  virtual; abstract; overload;
    … …  
    408540     procedure ErasePoly(const points: array of TPointF; alpha: byte); virtual; abstract;
    409541     procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); virtual; abstract;
     542
     543     procedure FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel; drawmode: TDrawMode); virtual; abstract;
     544     procedure FillShape(shape: TBGRACustomFillInfo; texture: IBGRAScanner; drawmode: TDrawMode); virtual; abstract;
     545     procedure FillShapeAntialias(shape: TBGRACustomFillInfo; c: TBGRAPixel); virtual; abstract;
     546     procedure FillShapeAntialias(shape: TBGRACustomFillInfo; texture: IBGRAScanner); virtual; abstract;
     547     procedure EraseShape(shape: TBGRACustomFillInfo; alpha: byte); virtual; abstract;
     548     procedure EraseShapeAntialias(shape: TBGRACustomFillInfo; alpha: byte); virtual; abstract;
    410549
    411550     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); virtual; abstract;
    … …  
    427566     procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
    428567
    429      procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel); virtual; abstract;
     568     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; abstract; overload;
     569     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; abstract; overload;
    430570     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
    431571     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
    432572     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
    433573     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
     574     procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual;
    434575     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
    435576     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
    436577     procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); virtual; abstract;
    437578
     579     procedure EllipseInRect(r: TRect; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; overload;
     580     procedure EllipseInRect(r: TRect; BorderColor,FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual; overload;
     581     procedure FillEllipseInRect(r: TRect; FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); virtual;
     582
    438583     procedure FillRect(r: TRect; c: TColor); virtual; overload;
    439584     procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
     585     procedure FillRect(r: TRect; texture: IBGRAScanner; mode: TDrawMode); virtual; overload;
    440586     procedure FillRect(x, y, x2, y2: integer; c: TColor); virtual; overload;
    441587     procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
    442      procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); virtual; abstract;
     588     procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); virtual; abstract; overload;
    443589     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); virtual; abstract;
    444590     procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); virtual; abstract;
    … …  
    446592     procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); virtual; abstract;
    447593
    448      procedure TextOut(x, y: single; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
    449      procedure TextOut(x, y: single; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
    450      procedure TextOutAngle(x, y: single; orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
    451      procedure TextOutAngle(x, y: single; orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
    452      procedure TextOut(x, y: single; s: string; c: TBGRAPixel); virtual; overload;
    453      procedure TextOut(x, y: single; s: string; c: TColor); virtual; overload;
    454      procedure TextOut(x, y: single; s: string; texture: IBGRAScanner); virtual; overload;
    455      procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract; overload;
    456      procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract; overload;
    457      procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); virtual; overload;
    458      procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); virtual; overload;
    459      function TextSize(s: string): TSize; virtual; abstract;
     594     procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
     595     procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
     596     procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
     597     procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
     598     procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract; overload;
     599     procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract; overload;
     600     function TextSize(sUTF8: string): TSize; virtual; abstract;
     601
     602     { Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c or texture is used to fill the text.
     603       The value of FontOrientation is taken into account, so that the text may be rotated. }
     604     procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel); virtual; overload;
     605     procedure TextOut(x, y: single; sUTF8: string; c: TColor); virtual; overload;
     606     procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner); virtual; overload;
     607
     608     { Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
     609       The position depends on the specified horizontal alignment halign and vertical alignement valign.
     610       The color c or texture is used to fill the text. No rotation is applied. }
     611     procedure TextRect(ARect: TRect; sUTF8: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); virtual; overload;
     612     procedure TextRect(ARect: TRect; sUTF8: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); virtual; overload;
    460613
    461614     {Spline}
    … …  
    494647     procedure AlphaFill(alpha: byte); virtual; overload;
    495648     procedure AlphaFill(alpha: byte; start, Count: integer); virtual; abstract; overload;
    496      procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; abstract; overload;
    497      procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); virtual; abstract; overload;
     649     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; overload;
     650     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); virtual; overload;
     651     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ADrawMode: TDrawMode); virtual; abstract; overload;
     652     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ADrawMode: TDrawMode); virtual; abstract; overload;
    498653     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); virtual; abstract; overload;
    499654     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); virtual; abstract; overload;
    … …  
    529684
    530685     {BGRA bitmap functions}
     686     procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); virtual; abstract;
     687     procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); virtual; abstract;
    531688     procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
     689     procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
    532690     procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
    533691     procedure PutImagePart(x,y: integer; Source: TBGRACustomBitmap; SourceRect: TRect; mode: TDrawMode; AOpacity: byte = 255);
    534      procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); virtual; abstract;
    535      procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); virtual; abstract;
     692     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload;
     693     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte=255); overload;
     694     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); virtual; abstract; overload;
     695     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte=255; ACorrectBlur: Boolean = false); overload;
     696     function GetImageAffineBounds(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap): TRect;
     697     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload;
     698     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false; ACorrectBlur: Boolean = false); overload;
     699     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload;
     700     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255; ARestoreOffsetAfterRotation: boolean = false); overload;
     701     procedure ComputeImageAngleAxes(x,y,w,h,angle: single; imageCenterX,imageCenterY: single; ARestoreOffsetAfterRotation: boolean;
     702       out Origin,HAxis,VAxis: TPointF);
     703     function GetImageAngleBounds(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; ARestoreOffsetAfterRotation: boolean = false): TRect;
    536704     procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); virtual; abstract;
    537705     procedure BlendImageOver(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte = 255;
    … …  
    542710     function Resample(newWidth, newHeight: integer;
    543711       mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract;
    544      procedure VerticalFlip; virtual; abstract;
    545      procedure HorizontalFlip; virtual; abstract;
     712     procedure VerticalFlip; virtual; overload;
     713     procedure VerticalFlip(ARect: TRect); virtual; abstract; overload;
     714     procedure HorizontalFlip; virtual; overload;
     715     procedure HorizontalFlip(ARect: TRect); virtual; abstract; overload;
    546716     function RotateCW: TBGRACustomBitmap; virtual; abstract;
    547717     function RotateCCW: TBGRACustomBitmap; virtual; abstract;
    548718     procedure Negative; virtual; abstract;
     719     procedure NegativeRect(ABounds: TRect); virtual; abstract;
    549720     procedure LinearNegative; virtual; abstract;
     721     procedure LinearNegativeRect(ABounds: TRect); virtual; abstract;
     722     procedure InplaceGrayscale; virtual; abstract;
     723     procedure InplaceGrayscale(ABounds: TRect); virtual; abstract;
    550724     procedure ConvertToLinearRGB; virtual; abstract;
    551725     procedure ConvertFromLinearRGB; virtual; abstract;
    … …  
    553727     procedure GrayscaleToAlpha; virtual; abstract;
    554728     procedure AlphaToGrayscale; virtual; abstract;
    555      procedure ApplyMask(mask: TBGRACustomBitmap); virtual; abstract;
     729     procedure ApplyMask(mask: TBGRACustomBitmap); overload;
     730     procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect); overload;
     731     procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); virtual; abstract; overload;
    556732     function GetImageBounds(Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; virtual; abstract;
    557      function GetImageBounds(Channels: TChannels): TRect; virtual; abstract;
     733     function GetImageBounds(Channels: TChannels; ANothingValue: Byte = 0): TRect; virtual; abstract;
    558734     function GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect; virtual; abstract;
    559735     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract;
    … …  
    563739     function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
    564740     function FilterSmooth: TBGRACustomBitmap; virtual; abstract;
    565      function FilterSharpen: TBGRACustomBitmap; virtual; abstract;
     741     function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; virtual; abstract;
     742     function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; virtual; abstract;
    566743     function FilterContour: TBGRACustomBitmap; virtual; abstract;
     744     function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract;
    567745     function FilterBlurRadial(radius: integer;
    568746       blurType: TRadialBlurType): TBGRACustomBitmap; virtual; abstract;
    569      function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract;
     747     function FilterBlurRadial(ABounds: TRect; radius: integer;
     748       blurType: TRadialBlurType): TBGRACustomBitmap; virtual; abstract;
    570749     function FilterBlurMotion(distance: integer; angle: single;
    571750       oriented: boolean): TBGRACustomBitmap; virtual; abstract;
     751     function FilterBlurMotion(ABounds: TRect; distance: integer; angle: single;
     752       oriented: boolean): TBGRACustomBitmap; virtual; abstract;
    572753     function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
     754     function FilterCustomBlur(ABounds: TRect; mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
    573755     function FilterEmboss(angle: single): TBGRACustomBitmap; virtual; abstract;
     756     function FilterEmboss(angle: single; ABounds: TRect): TBGRACustomBitmap; virtual; abstract;
    574757     function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; virtual; abstract;
    575758     function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; virtual; abstract;
    576759     function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; virtual; abstract;
    577760     function FilterGrayscale: TBGRACustomBitmap; virtual; abstract;
     761     function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; virtual; abstract;
    578762     function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
    579      function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; virtual; abstract;
     763     function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
     764     function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; virtual; abstract;
    580765     function FilterSphere: TBGRACustomBitmap; virtual; abstract;
    581766     function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; virtual; abstract;
     767     function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; virtual; abstract;
    582768     function FilterCylinder: TBGRACustomBitmap; virtual; abstract;
    583769     function FilterPlane: TBGRACustomBitmap; virtual; abstract;
    584770
    585      property Data: PBGRAPixel Read GetDataPtr;
    586      property Width: integer Read GetWidth;
    587      property Height: integer Read GetHeight;
    588      property NbPixels: integer Read GetNbPixels;
    589      property Empty: boolean Read CheckEmpty;
    590 
    591      property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;
     771     property Width: integer Read GetWidth;        //width of the image in pixels
     772     property Height: integer Read GetHeight;      //height of the image in pixels
     773     property NbPixels: integer Read GetNbPixels;  //total number of pixels. It is always true that NbPixels = Width * Height
     774
     775     property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;   //Returns the address of the left-most pixel of any line.
     776                                                                   //The parameter y ranges from 0 to Height-1.
     777
     778     property LineOrder: TRawImageLineOrder Read GetLineOrder;     //Indicates the order in which lines are stored in memory.
     779                                                                   //If it is equal to riloTopToBottom, the first line is the top line.
     780                                                                   //If it is equal to riloBottomToTop, the first line is the bottom line.
     781
     782     property Data: PBGRAPixel Read GetDataPtr;  //Provides a pointer to the first pixel in memory.
     783                                                 //Depending on the LineOrder property, this can be the top-left pixel or the bottom-left pixel.
     784                                                 //There is no padding between scanlines, so the start of the next line is at the address Data + Width.
     785
     786     property Empty: boolean Read CheckEmpty;    //Returns True if the bitmap only contains transparent pixels or has a size of zero.
     787
     788     property HasTransparentPixels: boolean Read GetHasTransparentPixels; //Returns True if there are transparent or semitransparent pixels,
     789                                                                          //and so if the image would be stored with an alpha channel.
     790
    592791     property RefCount: integer Read GetRefCount;
    593792     property Bitmap: TBitmap Read GetBitmap; //don't forget to call InvalidateBitmap before if you changed something with Scanline
    594      property HasTransparentPixels: boolean Read GetHasTransparentPixels;
    595793     property AverageColor: TColor Read GetAverageColor;
    596794     property AveragePixel: TBGRAPixel Read GetAveragePixel;
    597      property LineOrder: TRawImageLineOrder Read GetLineOrder;
    598795     property CanvasFP: TFPImageCanvas read GetCanvasFP;
    599796     property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP;
    … …  
    603800       Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
    604801
    605      property FontHeight: integer Read GetFontHeight Write SetFontHeight;
    606802     property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle;
    607803     property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle;
    608804     property ClipRect: TRect read GetClipRect write SetClipRect;
    609      property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias; //antialiasing (it's different from TFont antialiasing mode)
     805
     806     { Specifies the height of the font without taking into account additional line spacing.
     807       A negative value means that it is the full height instead (see below). }
     808     property FontHeight: integer Read GetFontHeight Write SetFontHeight;
     809
     810     { Specifies the height of the font, taking into account the additional line spacing defined for the font. }
    610811     property FontFullHeight: integer read GetFontFullHeight write SetFontFullHeight;
    611      property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;
    612 
    613      //interface
    614      function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
    615      function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
    616      function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     812
     813     property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias;    //Simplified property to specify the quality.
     814     property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;   //Returns measurement for the current font in pixels.
     815
     816     { Specifies the font renderer. By default it is an instance of TLCLFontRenderer of unit BGRAText.
     817       Other renderers are provided in BGRATextFX unit and BGRAVectorize unit.
     818       Once you assign a renderer, it will automatically be freed.
     819       The renderers may provide additional styling for the font. }
     820     property FontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer;
     821
     822     property LineCap: TPenEndCap read GetLineCap write SetLineCap;
     823     property ArrowStartSize: TPointF read GetArrowStartSize write SetArrowStartSize;
     824     property ArrowEndSize: TPointF read GetArrowEndSize write SetArrowEndSize;
     825     property ArrowStartOffset: single read GetArrowStartOffset write SetArrowStartOffset;
     826     property ArrowEndOffset: single read GetArrowEndOffset write SetArrowEndOffset;
     827     property ArrowStartRepeat: integer read GetArrowStartRepeat write SetArrowStartRepeat;
     828     property ArrowEndRepeat: integer read GetArrowEndRepeat write SetArrowEndRepeat;
    617829
    618830     //IBGRAScanner
    … …  
    623835     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
    624836     function IsScanPutPixelsDefined: boolean; virtual;
     837
     838  protected
     839     //interface
     840     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     841     function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     842     function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     843
    625844  end;
    626845
    … …  
    637856    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
    638857    function IsScanPutPixelsDefined: boolean; virtual;
     858  protected
    639859    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
    640860    function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
    … …  
    653873  end;
    654874
     875  { TIntersectionInfo }
     876
     877  TIntersectionInfo = class
     878    interX: single;
     879    winding: integer;
     880    numSegment: integer;
     881    procedure SetValues(AInterX: Single; AWinding, ANumSegment: integer);
     882  end;
     883  ArrayOfTIntersectionInfo = array of TIntersectionInfo;
     884
     885  TBGRACustomFillInfo = class
     886    public
     887      //returns true if the same segment number can be curved
     888      function SegmentsCurved: boolean; virtual; abstract;
     889
     890      //returns integer bounds
     891      function GetBounds: TRect; virtual; abstract;
     892
     893      //compute min-max to be drawn on destination bitmap according to cliprect. Returns false if
     894      //there is nothing to draw
     895      function ComputeMinMax(out minx,miny,maxx,maxy: integer; bmpDest: TBGRACustomBitmap): boolean; virtual; abstract;
     896
     897      //check if the point is inside the filling zone
     898      function IsPointInside(x,y: single; windingMode: boolean): boolean; virtual; abstract;
     899
     900      //create an array that will contain computed intersections.
     901      //you may augment, in this case, use CreateIntersectionInfo for new items
     902      function CreateIntersectionArray: ArrayOfTIntersectionInfo; virtual; abstract;
     903      function CreateIntersectionInfo: TIntersectionInfo; virtual; abstract; //creates a single info
     904      procedure FreeIntersectionArray(var inter: ArrayOfTIntersectionInfo); virtual; abstract;
     905
     906      //fill a previously created array of intersections with actual intersections at the current y coordinate.
     907      //nbInter gets the number of computed intersections
     908      procedure ComputeAndSort(cury: single; var inter: ArrayOfTIntersectionInfo; out nbInter: integer; windingMode: boolean); virtual; abstract;
     909  end;
     910
     911  { TBGRACustomFontRenderer }
     912
     913  TBGRACustomFontRenderer = class
     914    FontName: string;              //Specifies the font to use. Unless the font renderer accept otherwise,
     915                                   //the name is in human readable form, like 'Arial', 'Times New Roman', ...
     916
     917    FontStyle: TFontStyles;        //Specifies the set of styles to be applied to the font.
     918                                   //These can be fsBold, fsItalic, fsStrikeOut, fsUnderline.
     919                                   //So the value [fsBold,fsItalic] means that the font must be bold and italic.
     920
     921    FontQuality : TBGRAFontQuality;//Specifies the quality of rendering. Default value is fqSystem.
     922
     923    FontOrientation: integer;      //Specifies the rotation of the text, for functions that support text rotation.
     924                                   //It is expressed in tenth of degrees, positive values going counter-clockwise.
     925
     926    FontEmHeight: integer;         // Specifies the height of the font without taking into account additional line spacing.
     927                                   // A negative value means that it is the full height instead.
     928
     929    { Returns measurement for the current font in pixels. }
     930    function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
     931
     932    { Returns the total size of the string provided using the current font.
     933      Orientation is not taken into account, so that the width is along the text.  }
     934    function TextSize(sUTF8: string): TSize; virtual; abstract;
     935
     936    { Draws the UTF8 encoded string, with color c.
     937      If align is taLeftJustify, (x,y) is the top-left corner.
     938      If align is taCenter, (x,y) is at the top and middle of the text.
     939      If align is taRightJustify, (x,y) is the top-right corner.
     940      The value of FontOrientation is taken into account, so that the text may be rotated. }
     941    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
     942
     943    { Same as above functions, except that the text is filled using texture.
     944      The value of FontOrientation is taken into account, so that the text may be rotated. }
     945    procedure TextOut(ADest: TBGRACustomBitmap; x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
     946
     947    { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. }
     948    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
     949    procedure TextOutAngle(ADest: TBGRACustomBitmap; x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
     950
     951    { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect.
     952      Additional style information is provided by the style parameter.
     953      The color c or texture is used to fill the text. No rotation is applied. }
     954    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract;
     955    procedure TextRect(ADest: TBGRACustomBitmap; ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract;
     956
     957    { Copy the path for the UTF8 encoded string into ADest.
     958      If align is taLeftJustify, (x,y) is the top-left corner.
     959      If align is taCenter, (x,y) is at the top and middle of the text.
     960      If align is taRightJustify, (x,y) is the top-right corner. }
     961    procedure CopyTextPathTo({%H-}ADest: IBGRAPath; {%H-}x, {%H-}y: single; {%H-}s: string; {%H-}align: TAlignment); virtual; //optional
     962  end;
     963
    655964type
    656965  TBGRABitmapAny = class of TBGRACustomBitmap;  //used to create instances of the same type (see NewBitmap)
     966  TBGRATextOutImproveReadabilityMode = (irMask, irNormal, irClearTypeRGB, irClearTypeBGR);
    657967
    658968var
    659969  BGRABitmapFactory : TBGRABitmapAny;
     970  BGRATextOutImproveReadabilityProc : procedure (bmp: TBGRACustomBitmap; AFont: TFont; xf,yf: single; text: string; color: TBGRAPixel; tex: IBGRAScanner; align: TAlignment; mode : TBGRATextOutImproveReadabilityMode);
     971
     972function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb, maxyb, ignoreleft: integer; const cliprect: TRect): boolean; inline;
    660973
    661974{ Color functions }
    662 function GetIntensity(c: TExpandedPixel): word; inline;
    663 function SetIntensity(c: TExpandedPixel; intensity: word): TExpandedPixel;
    664 function GetLightness(c: TExpandedPixel): word; inline;
    665 function SetLightness(c: TExpandedPixel; lightness: word): TExpandedPixel;
     975function GetIntensity(const c: TExpandedPixel): word; inline;
     976function GetIntensity(c: TBGRAPixel): word; inline;
     977function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
     978function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel;
     979function GetLightness(c: TBGRAPixel): word;
     980function GetLightness(const c: TExpandedPixel): word; inline;
     981function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
     982function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
     983function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; //if you already know the current lightness of the color
    666984function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
    667985function ApplyIntensityFast(color: TBGRAPixel; lightness: longword): TBGRAPixel;
    668 function CombineLightness(lightness1,lightness2: integer): integer;
     986function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
    669987function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
    670 function ExpandedToHSLA(ec: TExpandedPixel): THSLAPixel; inline;
    671 function BGRAToGSBA(c: TBGRAPixel): THSLAPixel;
    672 function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
    673 function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
     988function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
     989function ExpandedToGSBA(ec: TExpandedPixel): TGSBAPixel;
     990function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
     991function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
     992function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
    674993function GtoH(ghue: word): word;
    675994function HtoG(hue: word): word;
    … …  
    677996function GetHue(ec: TExpandedPixel): word;
    678997function ColorImportance(ec: TExpandedPixel): word;
    679 function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
    680 function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
     998function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
     999function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
     1000function GSBAToHSLA(c: TGSBAPixel): THSLAPixel;
    6811001function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
    682 function GammaCompression(ec: TExpandedPixel): TBGRAPixel; inline;
     1002function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline;
    6831003function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline;
    6841004function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
    … …  
    7071027operator * (const c1: TColorF; factor: single): TColorF; inline;
    7081028function ColorF(red,green,blue,alpha: single): TColorF;
    709 function BGRAToStr(c: TBGRAPixel): string;
    710 function StrToBGRA(str: string): TBGRAPixel;
    711 function StrToBGRA(str: string; DefaultColor: TBGRAPixel): TBGRAPixel;
     1029function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; AMaxDiff: Word= 0): string;
     1030function StrToBGRA(str: string): TBGRAPixel; //full parse
     1031function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel; //full parse with default when error or missing values
     1032function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out error: boolean): TBGRAPixel; //partial parse allowed
     1033procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean);
    7121034
    7131035{ Get height [0..1] stored in a TBGRAPixel }
    … …  
    7361058operator * (const pt1: TPointF; factor: single): TPointF; inline;
    7371059operator * (factor: single; const pt1: TPointF): TPointF; inline;
    738 function PtInRect(pt: TPoint; r: TRect): boolean;
     1060function PtInRect(const pt: TPoint; r: TRect): boolean; overload;
     1061function RectWithSize(left,top,width,height: integer): TRect;
    7391062function VectLen(dx,dy: single): single; overload;
    7401063function VectLen(v: TPointF): single; overload;
    … …  
    7531076
    7541077{ Cyclic functions }
    755 function PositiveMod(value, cycle: integer): integer; inline;
     1078function PositiveMod(value, cycle: Int32or64): Int32or64; inline; overload;
    7561079
    7571080{ Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
    … …  
    7611084  without applying a modulo. }
    7621085procedure PrecalcSin65536; // compute all values now
    763 function Sin65536(value: word): integer; inline;
    764 function Cos65536(value: word): integer; inline;
     1086function Sin65536(value: word): Int32or64; inline;
     1087function Cos65536(value: word): Int32or64; inline;
    7651088function ByteSqrt(value: byte): byte; inline;
    7661089
     1090function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat;
     1091function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string = ''): TBGRAImageFormat;
     1092function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
     1093function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader;
     1094function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter;
     1095
    7671096implementation
    7681097
    769 uses Math, SysUtils;
     1098uses Math, SysUtils, FileUtil, lazutf8classes, LCLProc,
     1099  FPReadTiff, FPReadXwd, FPReadXPM,
     1100  FPWriteTiff, FPWriteJPEG, FPWritePNG, FPWriteBMP, FPWritePCX,
     1101  FPWriteTGA, FPWriteXPM;
     1102
     1103function StrToResampleFilter(str: string): TResampleFilter;
     1104var f: TResampleFilter;
     1105begin
     1106  result := rfLinear;
     1107  str := LowerCase(str);
     1108  for f := low(TResampleFilter) to high(TResampleFilter) do
     1109    if CompareText(str,ResampleFilterStr[f])=0 then
     1110    begin
     1111      result := f;
     1112      exit;
     1113    end;
     1114end;
    7701115
    7711116function StrToBlendOperation(str: string): TBlendOperation;
    … …  
    9371282end;
    9381283
     1284//straight line
     1285function BezierCurve(origin, destination: TPointF): TQuadraticBezierCurve;
     1286begin
     1287  result.p1 := origin;
     1288  result.c := (origin+destination)*0.5;
     1289  result.p2 := destination;
     1290end;
     1291
     1292function ArcDef(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single;
     1293  anticlockwise: boolean): TArcDef;
     1294begin
     1295  result.center := PointF(cx,cy);
     1296  result.radius := PointF(rx,ry);
     1297  result.xAngleRadCW:= xAngleRadCW;
     1298  result.startAngleRadCW := startAngleRadCW;
     1299  result.endAngleRadCW:= endAngleRadCW;
     1300  result.anticlockwise:= anticlockwise;
     1301end;
     1302
    9391303{ Check if a PointF structure is empty or should be treated as a list separator }
    9401304function isEmptyPointF(pt: TPointF): boolean;
    9411305begin
    9421306  Result := (pt.x = EmptySingle) and (pt.y = EmptySingle);
     1307end;
     1308
     1309{ TBGRACustomFontRenderer }
     1310
     1311procedure TBGRACustomFontRenderer.CopyTextPathTo(ADest: IBGRAPath; x, y: single; s: string; align: TAlignment);
     1312begin
     1313end;
     1314
     1315{ TIntersectionInfo }
     1316
     1317procedure TIntersectionInfo.SetValues(AInterX: Single; AWinding,
     1318  ANumSegment: integer);
     1319begin
     1320  interX := AInterX;
     1321  winding := AWinding;
     1322  numSegment := ANumSegment;
    9431323end;
    9441324
    … …  
    9911371end;
    9921372
    993 procedure TBGRAColorList.Add(Name: string; Color: TBGRAPixel);
     1373procedure TBGRAColorList.Add(Name: string; const Color: TBGRAPixel);
    9941374begin
    9951375  if FFinished then
    … …  
    10211401end;
    10221402
     1403function TBGRAColorList.IndexOfColor(const AColor: TBGRAPixel; AMaxDiff: Word = 0): integer;
     1404var i: integer;
     1405  MinDiff,CurDiff: Word;
     1406begin
     1407  if AMaxDiff = 0 then
     1408  begin
     1409    for i := 0 to FNbColors-1 do
     1410      if AColor = FColors[i].Color then
     1411      begin
     1412        result := i;
     1413        exit;
     1414      end;
     1415    result := -1;
     1416  end else
     1417  begin
     1418    MinDiff := AMaxDiff;
     1419    result := -1;
     1420    for i := 0 to FNbColors-1 do
     1421    begin
     1422      CurDiff := BGRAWordDiff(AColor,FColors[i].Color);
     1423      if CurDiff <= MinDiff then
     1424      begin
     1425        result := i;
     1426        MinDiff := CurDiff;
     1427        if MinDiff = 0 then exit;
     1428      end;
     1429    end;
     1430  end;
     1431end;
     1432
    10231433{ TBGRACustomBitmap }
    10241434
    … …  
    10391449procedure TBGRACustomBitmap.LoadFromFile(const filename: string);
    10401450begin
    1041   inherited LoadFromFile(filename);
     1451  LoadFromFileUTF8(SysToUtf8(filename));
     1452end;
     1453
     1454procedure TBGRACustomBitmap.LoadFromFileUTF8(const filenameUTF8: string);
     1455var
     1456  Stream: TStream;
     1457  format: TBGRAImageFormat;
     1458  reader: TFPCustomImageReader;
     1459begin
     1460  stream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
     1461  try
     1462    format := DetectFileFormat(Stream, ExtractFileExt(filenameUTF8));
     1463    reader := CreateBGRAImageReader(format);
     1464    try
     1465      LoadFromStream(stream, reader);
     1466    finally
     1467      reader.Free;
     1468    end;
     1469  finally
     1470    ClearTransparentPixels;
     1471    stream.Free;
     1472  end;
     1473end;
     1474
     1475procedure TBGRACustomBitmap.LoadFromFileUTF8(const filenameUTF8: string;
     1476  AHandler: TFPCustomImageReader);
     1477var
     1478  Stream: TStream;
     1479begin
     1480  stream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
     1481  try
     1482    LoadFromStream(stream, AHandler);
     1483  finally
     1484    ClearTransparentPixels;
     1485    stream.Free;
     1486  end;
    10421487end;
    10431488
    10441489procedure TBGRACustomBitmap.SaveToFile(const filename: string);
    10451490begin
    1046   inherited SaveToFile(filename);
     1491  SaveToFileUTF8(SysToUtf8(filename));
     1492end;
     1493
     1494procedure TBGRACustomBitmap.SaveToFileUTF8(const filenameUTF8: string);
     1495var
     1496  writer: TFPCustomImageWriter;
     1497  format: TBGRAImageFormat;
     1498begin
     1499  format := SuggestImageFormat(filenameUTF8);
     1500  writer := CreateBGRAImageWriter(Format, HasTransparentPixels);
     1501  try
     1502    SaveToFileUTF8(filenameUTF8, writer);
     1503  finally
     1504    writer.free;
     1505  end;
    10471506end;
    10481507
    … …  
    10501509  Handler: TFPCustomImageWriter);
    10511510begin
    1052   inherited SaveToFile(filename, Handler);
     1511  SaveToFileUTF8(SysToUtf8(filename),Handler);
     1512end;
     1513
     1514procedure TBGRACustomBitmap.SaveToFileUTF8(const filenameUTF8: string;
     1515  Handler: TFPCustomImageWriter);
     1516var
     1517  stream: TFileStreamUTF8;
     1518begin
     1519   stream := TFileStreamUTF8.Create(filenameUTF8,fmCreate);
     1520   try
     1521     SaveToStream(stream, Handler);
     1522   finally
     1523     stream.Free;
     1524   end;
     1525end;
     1526
     1527procedure TBGRACustomBitmap.SaveToStreamAs(Str: TStream;
     1528  AFormat: TBGRAImageFormat);
     1529var handler: TFPCustomImageWriter;
     1530begin
     1531  handler := CreateBGRAImageWriter(AFormat, HasTransparentPixels);
     1532  try
     1533    SaveToStream(Str, handler)
     1534  finally
     1535    handler.Free;
     1536  end;
     1537end;
     1538
     1539procedure TBGRACustomBitmap.DrawPixel(x, y: int32or64; c: TBGRAPixel;
     1540  ADrawMode: TDrawMode);
     1541begin
     1542  case ADrawMode of
     1543  dmSet: SetPixel(x,y,c);
     1544  dmSetExceptTransparent: if c.alpha = 255 then SetPixel(x,y,c);
     1545  dmLinearBlend: FastBlendPixel(x,y,c);
     1546  dmDrawWithTransparency: DrawPixel(x,y,c);
     1547  dmXor: XorPixel(x,y,c);
     1548  end;
     1549end;
     1550
     1551procedure TBGRACustomBitmap.LoadFromStream(Str: TStream);
     1552var
     1553  format: TBGRAImageFormat;
     1554  reader: TFPCustomImageReader;
     1555begin
     1556  format := DetectFileFormat(Str);
     1557  reader := CreateBGRAImageReader(format);
     1558  try
     1559    LoadFromStream(Str,reader);
     1560  finally
     1561    reader.Free;
     1562  end;
    10531563end;
    10541564
    … …  
    10571567  FP drawing mode is temporarily changed to load
    10581568  bitmaps properly }
    1059 procedure TBGRACustomBitmap.LoadFromStream(Str: TStream);
    1060 var
    1061   OldDrawMode: TDrawMode;
    1062 begin
    1063   OldDrawMode := CanvasDrawModeFP;
    1064   CanvasDrawModeFP := dmSet;
    1065   try
    1066     if not LoadAsBmp32(Str) then
    1067       inherited LoadFromStream(Str);
    1068   finally
    1069     CanvasDrawModeFP := OldDrawMode;
    1070   end;
    1071 end;
    1072 
    1073 { See above }
    10741569procedure TBGRACustomBitmap.LoadFromStream(Str: TStream;
    10751570  Handler: TFPCustomImageReader);
    … …  
    10871582
    10881583{ Look for a pixel considering the bitmap is repeated in both directions }
    1089 function TBGRACustomBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
     1584function TBGRACustomBitmap.GetPixelCycle(x, y: int32or64): TBGRAPixel;
    10901585begin
    10911586  if (Width = 0) or (Height = 0) then
    … …  
    10931588  else
    10941589    Result := (Scanline[PositiveMod(y,Height)] + PositiveMod(x,Width))^;
     1590end;
     1591
     1592procedure TBGRACustomBitmap.DrawHorizLine(x, y, x2: int32or64;
     1593  texture: IBGRAScanner);
     1594begin
     1595  HorizLine(x,y,x2,texture,dmDrawWithTransparency);
     1596end;
     1597
     1598procedure TBGRACustomBitmap.HorizLine(x, y, x2: Int32or64; c: TBGRAPixel;
     1599  ADrawMode: TDrawMode);
     1600begin
     1601  case ADrawMode of
     1602    dmSet: SetHorizLine(x,y,x2,c);
     1603    dmSetExceptTransparent: if c.alpha = 255 then SetHorizLine(x,y,x2,c);
     1604    dmXor: XorHorizLine(x,y,x2,c);
     1605    dmLinearBlend: FastBlendHorizLine(x,y,x2,c);
     1606    dmDrawWithTransparency: DrawHorizLine(x,y,x2,c);
     1607  end;
     1608end;
     1609
     1610procedure TBGRACustomBitmap.VertLine(x, y, y2: Int32or64; c: TBGRAPixel;
     1611  ADrawMode: TDrawMode);
     1612begin
     1613  case ADrawMode of
     1614    dmSet: SetVertLine(x,y,y2,c);
     1615    dmSetExceptTransparent: if c.alpha = 255 then SetVertLine(x,y,y2,c);
     1616    dmXor: XorVertLine(x,y,y2,c);
     1617    dmLinearBlend: FastBlendVertLine(x,y,y2,c);
     1618    dmDrawWithTransparency: DrawVertLine(x,y,y2,c);
     1619  end;
     1620end;
     1621
     1622procedure TBGRACustomBitmap.ArrowStartAsNone;
     1623begin
     1624  SetArrowStart(asNone);
     1625end;
     1626
     1627procedure TBGRACustomBitmap.ArrowStartAsClassic(AFlipped: boolean; ACut: boolean; ARelativePenWidth: single);
     1628var join: TPenJoinStyle;
     1629begin
     1630  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
     1631  if ACut then
     1632  begin
     1633    if AFlipped then
     1634      SetArrowStart(asFlippedCut,join,ARelativePenWidth)
     1635    else
     1636      SetArrowStart(asCut,join,ARelativePenWidth)
     1637  end
     1638  else
     1639  begin
     1640    if AFlipped then
     1641      SetArrowStart(asFlipped,join,ARelativePenWidth)
     1642    else
     1643      SetArrowStart(asNormal,join,ARelativePenWidth)
     1644  end;
     1645end;
     1646
     1647procedure TBGRACustomBitmap.ArrowStartAsTriangle(ABackOffset: single; ARounded: boolean; AHollow: boolean;
     1648  AHollowPenWidth: single);
     1649var join: TPenJoinStyle;
     1650begin
     1651  if ARounded then join := pjsRound else join := pjsMiter;
     1652  if AHollow then
     1653    SetArrowStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
     1654  else
     1655    SetArrowStart(asTriangle, join,1,ABackOffset);
     1656end;
     1657
     1658procedure TBGRACustomBitmap.ArrowStartAsTail;
     1659begin
     1660  SetArrowStart(asTail);
     1661end;
     1662
     1663procedure TBGRACustomBitmap.ArrowEndAsNone;
     1664begin
     1665  SetArrowEnd(asNone);
     1666end;
     1667
     1668procedure TBGRACustomBitmap.ArrowEndAsClassic(AFlipped: boolean; ACut: boolean; ARelativePenWidth: single);
     1669var join: TPenJoinStyle;
     1670begin
     1671  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
     1672  if ACut then
     1673  begin
     1674    if AFlipped then
     1675      SetArrowEnd(asFlippedCut,join,ARelativePenWidth)
     1676    else
     1677      SetArrowEnd(asCut,join,ARelativePenWidth)
     1678  end
     1679  else
     1680  begin
     1681    if AFlipped then
     1682      SetArrowEnd(asFlipped,join,ARelativePenWidth)
     1683    else
     1684      SetArrowEnd(asNormal,join,ARelativePenWidth)
     1685  end;
     1686end;
     1687
     1688procedure TBGRACustomBitmap.ArrowEndAsTriangle(ABackOffset: single; ARounded: boolean; AHollow: boolean;
     1689  AHollowPenWidth: single);
     1690var join: TPenJoinStyle;
     1691begin
     1692  if ARounded then join := pjsRound else join := pjsMiter;
     1693  if AHollow then
     1694    SetArrowEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
     1695  else
     1696    SetArrowEnd(asTriangle, join,1, ABackOffset);
     1697end;
     1698
     1699procedure TBGRACustomBitmap.ArrowEndAsTail;
     1700begin
     1701  SetArrowEnd(asTail);
     1702end;
     1703
     1704procedure TBGRACustomBitmap.DrawPolyLine(const points: array of TPoint;
     1705  c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
     1706var i: integer;
     1707begin
     1708   if length(points) = 1 then
     1709   begin
     1710     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c,ADrawMode);
     1711   end
     1712   else
     1713     for i := 0 to high(points)-1 do
     1714       DrawLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1),ADrawMode);
    10951715end;
    10961716
    … …  
    11021722   if length(points) = 1 then
    11031723   begin
    1104      if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
     1724     if DrawLastPixel then DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,true);
    11051725   end
    11061726   else
    … …  
    11241744end;
    11251745
     1746procedure TBGRACustomBitmap.DrawPolygon(const points: array of TPoint;
     1747  c: TBGRAPixel; ADrawMode: TDrawMode);
     1748var i: integer;
     1749begin
     1750   if length(points) = 1 then
     1751   begin
     1752     DrawPixel(points[0].x,points[0].y,c,ADrawMode);
     1753   end
     1754   else
     1755   begin
     1756     for i := 0 to high(points)-1 do
     1757       DrawLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,false,ADrawMode);
     1758     DrawLine(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,false,ADrawMode);
     1759   end;
     1760end;
     1761
     1762procedure TBGRACustomBitmap.DrawPolygonAntialias(const points: array of TPoint;
     1763  c: TBGRAPixel);
     1764var i: integer;
     1765begin
     1766   if length(points) = 1 then
     1767   begin
     1768     DrawLineAntialias(points[0].x,points[0].y,points[0].x,points[0].y,c,true);
     1769   end
     1770   else
     1771   begin
     1772     for i := 0 to high(points)-1 do
     1773       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,false);
     1774     DrawLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,c,false);
     1775   end;
     1776end;
     1777
     1778procedure TBGRACustomBitmap.ErasePolyLine(const points: array of TPoint; alpha: byte;
     1779  DrawLastPixel: boolean);
     1780var i: integer;
     1781begin
     1782   if length(points) = 1 then
     1783   begin
     1784     if DrawLastPixel then ErasePixel(points[0].x,points[0].y,alpha);
     1785   end
     1786   else
     1787     for i := 0 to high(points)-1 do
     1788       EraseLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,DrawLastPixel and (i=high(points)-1));
     1789end;
     1790
     1791procedure TBGRACustomBitmap.ErasePolyLineAntialias(
     1792  const points: array of TPoint; alpha: byte; DrawLastPixel: boolean);
     1793var i: integer;
     1794begin
     1795   if length(points) = 1 then
     1796   begin
     1797     if DrawLastPixel then ErasePixel(points[0].x,points[0].y,alpha);
     1798   end
     1799   else
     1800     for i := 0 to high(points)-1 do
     1801       EraseLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,DrawLastPixel and (i=high(points)-1));
     1802end;
     1803
     1804procedure TBGRACustomBitmap.ErasePolygonOutline(const points: array of TPoint;
     1805  alpha: byte);
     1806var i: integer;
     1807begin
     1808   if length(points) = 1 then
     1809   begin
     1810     ErasePixel(points[0].x,points[0].y,alpha);
     1811   end
     1812   else
     1813   begin
     1814     for i := 0 to high(points)-1 do
     1815       EraseLine(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,false);
     1816     EraseLine(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,alpha,false);
     1817   end;
     1818end;
     1819
     1820procedure TBGRACustomBitmap.ErasePolygonOutlineAntialias(
     1821  const points: array of TPoint; alpha: byte);
     1822var i: integer;
     1823begin
     1824   if length(points) = 1 then
     1825   begin
     1826     ErasePixel(points[0].x,points[0].y,alpha);
     1827   end
     1828   else
     1829   begin
     1830     for i := 0 to high(points)-1 do
     1831       EraseLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,alpha,false);
     1832     EraseLineAntialias(points[high(points)].x,points[high(points)].Y,points[0].x,points[0].y,alpha,false);
     1833   end;
     1834end;
     1835
    11261836{ Following functions are defined for convenience }
    11271837procedure TBGRACustomBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
    … …  
    11531863end;
    11541864
     1865procedure TBGRACustomBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX,
     1866  DY: integer; FillColor: TBGRAPixel; ADrawMode: TDrawMode);
     1867begin
     1868  RoundRect(X1,Y1,X2,Y2,DX,DY,FillColor,FillColor,ADrawMode);
     1869end;
     1870
     1871procedure TBGRACustomBitmap.EllipseInRect(r: TRect; BorderColor: TBGRAPixel;
     1872  ADrawMode: TDrawMode);
     1873begin
     1874  RoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),BorderColor,ADrawMode);
     1875end;
     1876
     1877procedure TBGRACustomBitmap.EllipseInRect(r: TRect; BorderColor,
     1878  FillColor: TBGRAPixel; ADrawMode: TDrawMode);
     1879begin
     1880  RoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),BorderColor,FillColor,ADrawMode);
     1881end;
     1882
     1883procedure TBGRACustomBitmap.FillEllipseInRect(r: TRect; FillColor: TBGRAPixel;
     1884  ADrawMode: TDrawMode);
     1885begin
     1886  FillRoundRect(r.left,r.top,r.right,r.bottom,abs(r.right-r.left),abs(r.bottom-r.top),FillColor,ADrawMode);
     1887end;
     1888
    11551889procedure TBGRACustomBitmap.FillRect(r: TRect; c: TColor);
    11561890begin
    … …  
    11631897end;
    11641898
     1899procedure TBGRACustomBitmap.FillRect(r: TRect; texture: IBGRAScanner;
     1900  mode: TDrawMode);
     1901begin
     1902  FillRect(r.Left, r.top, r.right, r.bottom, texture, mode);
     1903end;
     1904
    11651905procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
    11661906begin
    … …  
    11681908end;
    11691909
    1170 procedure TBGRACustomBitmap.TextOut(x, y: single; s: string; c: TBGRAPixel);
    1171 begin
    1172   TextOut(x, y, s, c, taLeftJustify);
    1173 end;
    1174 
    1175 procedure TBGRACustomBitmap.TextOut(x, y: single; s: string; c: TColor);
    1176 begin
    1177   TextOut(x, y, s, ColorToBGRA(c));
    1178 end;
    1179 
    1180 procedure TBGRACustomBitmap.TextOut(x, y: single; s: string;
     1910{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text.
     1911  The value of FontOrientation is taken into account, so that the text may be rotated. }
     1912procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string; c: TBGRAPixel);
     1913begin
     1914  TextOut(x, y, sUTF8, c, taLeftJustify);
     1915end;
     1916
     1917{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The color c is used to fill the text.
     1918  The value of FontOrientation is taken into account, so that the text may be rotated. }
     1919procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string; c: TColor);
     1920begin
     1921  TextOut(x, y, sUTF8, ColorToBGRA(c));
     1922end;
     1923
     1924{ Draw the UTF8 encoded string, (x,y) being the top-left corner. The texture is used to fill the text.
     1925  The value of FontOrientation is taken into account, so that the text may be rotated. }
     1926procedure TBGRACustomBitmap.TextOut(x, y: single; sUTF8: string;
    11811927  texture: IBGRAScanner);
    11821928begin
    1183   TextOut(x, y, s, texture, taLeftJustify);
    1184 end;
    1185 
    1186 procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
     1929  TextOut(x, y, sUTF8, texture, taLeftJustify);
     1930end;
     1931
     1932{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
     1933  The position depends on the specified horizontal alignment halign and vertical alignement valign.
     1934  The color c is used to fill the text. No rotation is applied. }
     1935procedure TBGRACustomBitmap.TextRect(ARect: TRect; sUTF8: string;
    11871936  halign: TAlignment; valign: TTextLayout; c: TBGRAPixel);
    11881937var
    … …  
    11971946  style.ShowPrefix := false;
    11981947  style.Clipping := false;
    1199   TextRect(ARect,ARect.Left,ARect.Top,s,style,c);
    1200 end;
    1201 
    1202 procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
     1948  TextRect(ARect,ARect.Left,ARect.Top,sUTF8,style,c);
     1949end;
     1950
     1951{ Draw the UTF8 encoded string in the rectangle ARect. Text is wrapped if necessary.
     1952  The position depends on the specified horizontal alignment halign and vertical alignement valign.
     1953  The texture is used to fill the text. No rotation is applied. }
     1954procedure TBGRACustomBitmap.TextRect(ARect: TRect; sUTF8: string;
    12031955  halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner);
    12041956var
    … …  
    12131965  style.ShowPrefix := false;
    12141966  style.Clipping := false;
    1215   TextRect(ARect,ARect.Left,ARect.Top,s,style,texture);
     1967  TextRect(ARect,ARect.Left,ARect.Top,sUTF8,style,texture);
    12161968end;
    12171969
    … …  
    12451997begin
    12461998  AlphaFill(alpha, 0, NbPixels);
     1999end;
     2000
     2001procedure TBGRACustomBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
     2002  color: TBGRAPixel);
     2003begin
     2004  FillMask(x,y, AMask, color, dmDrawWithTransparency);
     2005end;
     2006
     2007procedure TBGRACustomBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
     2008  texture: IBGRAScanner);
     2009begin
     2010  FillMask(x,y, AMask, texture, dmDrawWithTransparency);
    12472011end;
    12482012
    … …  
    12762040    oldClip,newClip: TRect;
    12772041begin
    1278   if Source = nil then exit;
     2042  if (Source = nil) or (AOpacity = 0) then exit;
    12792043  w := SourceRect.Right-SourceRect.Left;
    12802044  h := SourceRect.Bottom-SourceRect.Top;
    … …  
    13042068
    13052069  ClipRect := oldClip;
     2070end;
     2071
     2072procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
     2073  Source: TBGRACustomBitmap; AOpacity: Byte; ACorrectBlur: Boolean);
     2074begin
     2075  if ACorrectBlur then
     2076    PutImageAffine(Origin,HAxis,VAxis,Source,rfCosine,AOpacity)
     2077  else
     2078    PutImageAffine(Origin,HAxis,VAxis,Source,rfLinear,AOpacity);
     2079end;
     2080
     2081procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
     2082  Source: TBGRACustomBitmap; AResampleFilter: TResampleFilter; AOpacity: Byte);
     2083var outputBounds: TRect;
     2084begin
     2085  if (Source = nil) or (AOpacity = 0) then exit;
     2086  if (abs(Origin.x-round(Origin.x))<1e-6) and (abs(Origin.y-round(Origin.Y))<1e-6) and
     2087     (abs(HAxis.x-(Origin.x+Source.Width))<1e-6) and (abs(HAxis.y-origin.y)<1e-6) and
     2088     (abs(VAxis.x-Origin.x)<1e-6) and (abs(VAxis.y-(Origin.y+Source.Height))<1e-6) then
     2089  begin
     2090    PutImage(round(origin.x),round(origin.y),Source,dmDrawWithTransparency,AOpacity);
     2091    exit;
     2092  end;
     2093  outputBounds := GetImageAffineBounds(Origin,HAxis,VAxis,Source);
     2094  PutImageAffine(Origin,HAxis,VAxis,Source,outputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity);
     2095end;
     2096
     2097procedure TBGRACustomBitmap.PutImageAffine(Origin, HAxis, VAxis: TPointF;
     2098  Source: TBGRACustomBitmap; AOutputBounds: TRect; AOpacity: Byte;
     2099  ACorrectBlur: Boolean);
     2100begin
     2101  if ACorrectBlur then
     2102    PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfCosine,dmDrawWithTransparency, AOpacity)
     2103  else
     2104    PutImageAffine(Origin,HAxis,VAxis,Source,AOutputBounds,rfLinear,dmDrawWithTransparency,AOpacity);
     2105end;
     2106
     2107{ Returns the area that contains the affine transformed image }
     2108function TBGRACustomBitmap.GetImageAffineBounds(Origin, HAxis, VAxis: TPointF;
     2109  Source: TBGRACustomBitmap): TRect;
     2110var minx,miny,maxx,maxy: integer;
     2111    vx,vy,pt1: TPointF;
     2112    sourceBounds: TRect;
     2113
     2114  //include specified point in the bounds
     2115  procedure Include(pt: TPointF);
     2116  begin
     2117    if floor(pt.X) < minx then minx := floor(pt.X);
     2118    if floor(pt.Y) < miny then miny := floor(pt.Y);
     2119    if ceil(pt.X) > maxx then maxx := ceil(pt.X);
     2120    if ceil(pt.Y) > maxy then maxy := ceil(pt.Y);
     2121  end;
     2122
     2123begin
     2124  result := EmptyRect;
     2125  if (Source = nil) then exit;
     2126  sourceBounds := source.GetImageBounds;
     2127  if IsRectEmpty(sourceBounds) then exit;
     2128
     2129  if (abs(Origin.x-round(Origin.x))<1e-6) and (abs(Origin.y-round(Origin.Y))<1e-6) and
     2130     (abs(HAxis.x-(Origin.x+Source.Width))<1e-6) and (abs(HAxis.y-origin.y)<1e-6) and
     2131     (abs(VAxis.x-Origin.x)<1e-6) and (abs(VAxis.y-(Origin.y+Source.Height))<1e-6) then
     2132  begin
     2133    result := sourceBounds;
     2134    OffsetRect(result,round(origin.x),round(origin.y));
     2135    IntersectRect(result,result,ClipRect);
     2136    exit;
     2137  end;
     2138
     2139  { Compute bounds }
     2140  vx := (HAxis-Origin)*(1/source.Width);
     2141  vy := (VAxis-Origin)*(1/source.Height);
     2142  pt1 := Origin+vx*sourceBounds.Left+vy*sourceBounds.Top;
     2143  minx := floor(pt1.X);
     2144  miny := floor(pt1.Y);
     2145  maxx := ceil(pt1.X);
     2146  maxy := ceil(pt1.Y);
     2147  Include(Origin+vx*sourceBounds.Right+vy*sourceBounds.Top);
     2148  Include(Origin+vx*sourceBounds.Right+vy*sourceBounds.Bottom);
     2149  Include(Origin+vx*sourceBounds.Left+vy*sourceBounds.Bottom);
     2150
     2151  result := rect(minx,miny,maxx+1,maxy+1);
     2152  IntersectRect(result,result,ClipRect);
     2153end;
     2154
     2155procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
     2156  Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect;
     2157  imageCenterX: single; imageCenterY: single; AOpacity: Byte;
     2158  ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean);
     2159begin
     2160  if ACorrectBlur then
     2161    PutImageAngle(x,y,Source,angle,AOutputBounds,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation)
     2162  else
     2163    PutImageAngle(x,y,Source,angle,AOutputBounds,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation);
     2164end;
     2165
     2166procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
     2167  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
     2168  imageCenterY: single; AOpacity: Byte; ARestoreOffsetAfterRotation: boolean; ACorrectBlur: Boolean);
     2169begin
     2170  if ACorrectBlur then
     2171    PutImageAngle(x,y,Source,angle,rfCosine,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation)
     2172  else
     2173    PutImageAngle(x,y,Source,angle,rfLinear,imageCenterX,imageCenterY,AOpacity,ARestoreOffsetAfterRotation);
     2174end;
     2175
     2176procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
     2177  Source: TBGRACustomBitmap; angle: single; AOutputBounds: TRect;
     2178  AResampleFilter: TResampleFilter; imageCenterX: single; imageCenterY: single; AOpacity: Byte;
     2179  ARestoreOffsetAfterRotation: boolean);
     2180var
     2181  Origin,HAxis,VAxis: TPointF;
     2182begin
     2183  if (source = nil) or (AOpacity=0) then exit;
     2184  ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation,
     2185     Origin,HAxis,VAxis);
     2186  PutImageAffine(Origin,HAxis,VAxis,source,AOutputBounds,AResampleFilter,dmDrawWithTransparency,AOpacity);
     2187end;
     2188
     2189procedure TBGRACustomBitmap.PutImageAngle(x, y: single;
     2190  Source: TBGRACustomBitmap; angle: single; AResampleFilter: TResampleFilter;
     2191  imageCenterX: single; imageCenterY: single; AOpacity: Byte;
     2192  ARestoreOffsetAfterRotation: boolean);
     2193var
     2194  Origin,HAxis,VAxis: TPointF;
     2195begin
     2196  if (source = nil) or (AOpacity=0) then exit;
     2197  ComputeImageAngleAxes(x,y,source.Width,source.Height,angle,imageCenterX,imageCenterY,ARestoreOffsetAfterRotation,
     2198     Origin,HAxis,VAxis);
     2199  PutImageAffine(Origin,HAxis,VAxis,source,AResampleFilter,AOpacity);
     2200end;
     2201
     2202procedure TBGRACustomBitmap.ComputeImageAngleAxes(x, y, w, h,
     2203  angle: single; imageCenterX, imageCenterY: single;
     2204  ARestoreOffsetAfterRotation: boolean; out Origin, HAxis, VAxis: TPointF);
     2205var
     2206  cosa,sina: single;
     2207
     2208  { Compute rotated coordinates }
     2209  function Coord(relX,relY: single): TPointF;
     2210  begin
     2211    relX -= imageCenterX;
     2212    relY -= imageCenterY;
     2213    result.x := relX*cosa-relY*sina+x;
     2214    result.y := relY*cosa+relX*sina+y;
     2215    if ARestoreOffsetAfterRotation then
     2216    begin
     2217      result.x += imageCenterX;
     2218      result.y += imageCenterY;
     2219    end;
     2220  end;
     2221
     2222begin
     2223  cosa := cos(-angle*Pi/180);
     2224  sina := -sin(-angle*Pi/180);
     2225  Origin := Coord(0,0);
     2226  HAxis := Coord(w,0);
     2227  VAxis := Coord(0,h);
     2228end;
     2229
     2230function TBGRACustomBitmap.GetImageAngleBounds(x, y: single;
     2231  Source: TBGRACustomBitmap; angle: single; imageCenterX: single;
     2232  imageCenterY: single; ARestoreOffsetAfterRotation: boolean): TRect;
     2233var
     2234  cosa,sina: single;
     2235
     2236  { Compute rotated coordinates }
     2237  function Coord(relX,relY: single): TPointF;
     2238  begin
     2239    relX -= imageCenterX;
     2240    relY -= imageCenterY;
     2241    result.x := relX*cosa-relY*sina+x;
     2242    result.y := relY*cosa+relX*sina+y;
     2243    if ARestoreOffsetAfterRotation then
     2244    begin
     2245      result.x += imageCenterX;
     2246      result.y += imageCenterY;
     2247    end;
     2248  end;
     2249
     2250begin
     2251  if (source = nil) then
     2252  begin
     2253    result := EmptyRect;
     2254    exit;
     2255  end;
     2256  cosa := cos(-angle*Pi/180);
     2257  sina := -sin(-angle*Pi/180);
     2258  result := GetImageAffineBounds(Coord(0,0),Coord(source.Width,0),Coord(0,source.Height),source);
     2259end;
     2260
     2261procedure TBGRACustomBitmap.VerticalFlip;
     2262begin
     2263  VerticalFlip(rect(0,0,Width,Height));
     2264end;
     2265
     2266procedure TBGRACustomBitmap.HorizontalFlip;
     2267begin
     2268  HorizontalFlip(rect(0,0,Width,Height));
     2269end;
     2270
     2271procedure TBGRACustomBitmap.ApplyMask(mask: TBGRACustomBitmap);
     2272begin
     2273  ApplyMask(mask, Rect(0,0,Width,Height), Point(0,0));
     2274end;
     2275
     2276procedure TBGRACustomBitmap.ApplyMask(mask: TBGRACustomBitmap; ARect: TRect);
     2277begin
     2278  ApplyMask(mask, ARect, ARect.TopLeft);
    13062279end;
    13072280
    … …  
    14482421{************************** Color functions **************************}
    14492422
     2423function CheckPutImageBounds(x, y, tx, ty: integer; out minxb, minyb, maxxb,
     2424  maxyb, ignoreleft: integer; const cliprect: TRect): boolean;
     2425var x2,y2: integer;
     2426begin
     2427  if (x >= cliprect.Right) or (y >= cliprect.Bottom) or (x <= cliprect.Left-tx) or
     2428    (y <= cliprect.Top-ty) or (ty <= 0) or (tx <= 0) then
     2429  begin
     2430    result := false;
     2431    exit;
     2432  end;
     2433
     2434  x2 := x + tx - 1;
     2435  y2 := y + ty - 1;
     2436
     2437  if y < cliprect.Top then
     2438    minyb := cliprect.Top
     2439  else
     2440    minyb := y;
     2441  if y2 >= cliprect.Bottom then
     2442    maxyb := cliprect.Bottom - 1
     2443  else
     2444    maxyb := y2;
     2445
     2446  if x < cliprect.Left then
     2447  begin
     2448    ignoreleft := cliprect.Left-x;
     2449    minxb      := cliprect.Left;
     2450  end
     2451  else
     2452  begin
     2453    ignoreleft := 0;
     2454    minxb      := x;
     2455  end;
     2456  if x2 >= cliprect.Right then
     2457    maxxb := cliprect.Right - 1
     2458  else
     2459    maxxb := x2;
     2460
     2461  result := true;
     2462end;
     2463
    14502464{ The intensity is defined here as the maximum value of any color component }
    1451 function GetIntensity(c: TExpandedPixel): word; inline;
     2465function GetIntensity(const c: TExpandedPixel): word; inline;
    14522466begin
    14532467  Result := c.red;
    … …  
    14582472end;
    14592473
    1460 function SetIntensity(c: TExpandedPixel; intensity: word): TExpandedPixel;
     2474function GetIntensity(c: TBGRAPixel): word;
     2475begin
     2476  Result := c.red;
     2477  if c.green > Result then
     2478    Result := c.green;
     2479  if c.blue > Result then
     2480    Result := c.blue;
     2481  result := GammaExpansionTab[Result];
     2482end;
     2483
     2484function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
    14612485var
    14622486  curIntensity: word;
    … …  
    14642488  curIntensity := GetIntensity(c);
    14652489  if curIntensity = 0 then //suppose it's gray if there is no color information
    1466     Result := c
     2490  begin
     2491    Result.red := intensity;
     2492    Result.green := intensity;
     2493    Result.blue := intensity;
     2494    result.alpha := c.alpha;
     2495  end
    14672496  else
    14682497  begin
    … …  
    14752504end;
    14762505
     2506function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel;
     2507begin
     2508  result := GammaCompression(SetIntensity(GammaExpansion(c),intensity));
     2509end;
     2510
     2511function GetLightness(c: TBGRAPixel): word;
     2512begin
     2513  result := GetLightness(GammaExpansion(c));
     2514end;
     2515
    14772516{ The lightness here is defined as the subjective sensation of luminosity, where
    14782517  blue is the darkest component and green the lightest }
    1479 function GetLightness(c: TExpandedPixel): word; inline;
     2518function GetLightness(const c: TExpandedPixel): word; inline;
    14802519begin
    14812520  Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 +
    … …  
    14832522end;
    14842523
    1485 function SetLightness(c: TExpandedPixel; lightness: word): TExpandedPixel;
     2524function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
    14862525var
    14872526  curLightness: word;
    1488   AddedWhiteness, maxBeforeWhite: word;
    1489   clip: boolean;
    14902527begin
    14912528  curLightness := GetLightness(c);
    … …  
    14952532    exit;
    14962533  end;
     2534  result := SetLightness(c, lightness, curLightness);
     2535end;
     2536
     2537function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
     2538begin
     2539  result := GammaCompression(SetLightness(GammaExpansion(c),lightness));
     2540end;
     2541
     2542function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel;
     2543var
     2544  AddedWhiteness, maxBeforeWhite: word;
     2545  clip: boolean;
     2546begin
     2547  if lightness = curLightness then
     2548  begin //no change
     2549    Result := c;
     2550    exit;
     2551  end;
    14972552  if lightness = 65535 then //set to white
    14982553  begin
    … …  
    15212576  if lightness < curLightness then //darker is easy
    15222577  begin
    1523     Result := SetIntensity(c, (GetIntensity(c) * lightness + (curLightness shr 1)) div
    1524       curLightness);
     2578    result.alpha:= c.alpha;
     2579    result.red := (c.red * lightness + (curLightness shr 1)) div curLightness;
     2580    result.green := (c.green * lightness + (curLightness shr 1)) div curLightness;
     2581    result.blue := (c.blue * lightness + (curLightness shr 1)) div curLightness;
    15252582    exit;
    15262583  end;
    … …  
    15972654end;
    15982655
    1599 function CombineLightness(lightness1,lightness2: integer): integer;
     2656function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
    16002657{$ifdef CPUI386} {$asmmode intel} assembler;
    16012658  asm
    … …  
    16632720end;
    16642721
    1665 function ExpandedToHSLA(ec: TExpandedPixel): THSLAPixel;
     2722procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline;
    16662723const
    1667   deg60  = 8192;
    1668   deg120 = deg60 * 2;
    1669   deg240 = deg60 * 4;
    1670   deg360 = deg60 * 6;
     2724  deg60  = 10922;
     2725  deg120 = 21845;
     2726  deg240 = 43690;
    16712727var
    1672   min, max, minMax: integer;
    1673   twiceLightness: integer;
    1674   r,g,b: integer;
    1675 begin
    1676   r := ec.red;
    1677   g := ec.green;
    1678   b := ec.blue;
    1679   min := r;
    1680   max := r;
    1681   if g > max then
    1682     max := g
    1683   else
    1684   if g < min then
     2728  min, max, minMax: Int32or64;
     2729  UMinMax,UTwiceLightness: UInt32or64;
     2730begin
     2731  if g > r then
     2732  begin
     2733    max := g;
     2734    min := r;
     2735  end
     2736  else
     2737  begin
     2738    max := r;
    16852739    min := g;
     2740  end;
    16862741  if b > max then
    16872742    max := b
    … …  
    16922747
    16932748  if minMax = 0 then
    1694     Result.hue := 0
     2749    dest.hue := 0
    16952750  else
    16962751  if max = r then
    1697     Result.hue := (((g - b) * deg60) div
    1698       minMax + deg360) mod deg360
     2752    {$PUSH}{$RANGECHECKS OFF}
     2753    dest.hue := ((g - b) * deg60) div minMax
     2754    {$POP}
    16992755  else
    17002756  if max = g then
    1701     Result.hue := ((b - r) * deg60) div minMax + deg120
    1702   else
    1703     {max = b} Result.hue :=
    1704       ((r - g) * deg60) div minMax + deg240;
    1705   twiceLightness := max + min;
     2757    dest.hue := ((b - r) * deg60) div minMax + deg120
     2758  else
     2759    {max = b} dest.hue := ((r - g) * deg60) div minMax + deg240;
     2760  UTwiceLightness := max + min;
    17062761  if min = max then
    1707     Result.saturation := 0
    1708   else
    1709   {$hints off}
    1710   if twiceLightness < 65536 then
    1711     Result.saturation := (int64(minMax) shl 16) div (twiceLightness + 1)
    1712   else
    1713     Result.saturation := (int64(minMax) shl 16) div (131072 - twiceLightness);
    1714   {$hints on}
    1715   Result.lightness := twiceLightness shr 1;
    1716   Result.alpha := ec.alpha;
    1717   Result.hue   := (Result.hue shl 16) div deg360;
     2762    dest.saturation := 0
     2763  else
     2764  begin
     2765    UMinMax:= minMax;
     2766    if UTwiceLightness < 65536 then
     2767      dest.saturation := (UMinMax shl 16) div (UTwiceLightness + 1)
     2768    else
     2769      dest.saturation := (UMinMax shl 16) div (131072 - UTwiceLightness);
     2770  end;
     2771  dest.lightness := UTwiceLightness shr 1;
     2772end;
     2773
     2774function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
     2775begin
     2776  result.alpha := ec.alpha;
     2777  ExpandedToHSLAInline(ec.red,ec.green,ec.blue,result);
    17182778end;
    17192779
    17202780function HtoG(hue: word): word;
    17212781const
    1722   segmentDest: array[0..5] of word =
     2782  segmentDest: array[0..5] of NativeUInt =
    17232783     (13653, 10923, 8192, 13653, 10923, 8192);
    1724   segmentSrc: array[0..5] of word =
     2784  segmentSrc: array[0..5] of NativeUInt =
    17252785     (10923, 10922, 10923, 10923, 10922, 10923);
    1726 begin
    1727   if hue < segmentSrc[0] then
    1728     result := hue * segmentDest[0] div segmentSrc[0]
    1729   else
    1730   begin
    1731     result := segmentDest[0];
    1732     hue -= segmentSrc[0];
    1733     if hue < segmentSrc[1] then
    1734       result += hue * segmentDest[1] div segmentSrc[1]
     2786var
     2787  h,g: NativeUInt;
     2788begin
     2789  h := hue;
     2790  if h < segmentSrc[0] then
     2791    g := h * segmentDest[0] div segmentSrc[0]
     2792  else
     2793  begin
     2794    g := segmentDest[0];
     2795    h -= segmentSrc[0];
     2796    if h < segmentSrc[1] then
     2797      g += h * segmentDest[1] div segmentSrc[1]
    17352798    else
    17362799    begin
    1737       result += segmentDest[1];
    1738       hue -= segmentSrc[1];
    1739       if hue < segmentSrc[2] then
    1740         result += hue * segmentDest[2] div segmentSrc[2]
     2800      g += segmentDest[1];
     2801      h -= segmentSrc[1];
     2802      if h < segmentSrc[2] then
     2803        g += h * segmentDest[2] div segmentSrc[2]
    17412804      else
    17422805      begin
    1743         result += segmentDest[2];
    1744         hue -= segmentSrc[2];
    1745         if hue < segmentSrc[3] then
    1746           result += hue * segmentDest[3] div segmentSrc[3]
     2806        g += segmentDest[2];
     2807        h -= segmentSrc[2];
     2808        if h < segmentSrc[3] then
     2809          g += h * segmentDest[3] div segmentSrc[3]
    17472810        else
    17482811        begin
    1749           result += segmentDest[3];
    1750           hue -= segmentSrc[3];
    1751           if hue < segmentSrc[4] then
    1752             result += hue * segmentDest[4] div segmentSrc[4]
     2812          g += segmentDest[3];
     2813          h -= segmentSrc[3];
     2814          if h < segmentSrc[4] then
     2815            g += h * segmentDest[4] div segmentSrc[4]
    17532816          else
    17542817          begin
    1755             result += segmentDest[4];
    1756             hue -= segmentSrc[4];
    1757             result += hue * segmentDest[5] div segmentSrc[5];
     2818            g += segmentDest[4];
     2819            h -= segmentSrc[4];
     2820            g += h * segmentDest[5] div segmentSrc[5];
    17582821          end;
    17592822        end;
    … …  
    17612824    end;
    17622825  end;
     2826  result := g;
    17632827end;
    17642828
    17652829function GtoH(ghue: word): word;
    17662830const
    1767   segment: array[0..5] of word =
     2831  segment: array[0..5] of NativeUInt =
    17682832     (13653, 10923, 8192, 13653, 10923, 8192);
    1769 begin
    1770   if ghue < segment[0] then
    1771     result := ghue * 10923 div segment[0]
    1772   else
    1773   begin
    1774     ghue -= segment[0];
    1775     if ghue < segment[1] then
    1776       result := ghue * (21845-10923) div segment[1] + 10923
     2833var g: NativeUint;
     2834begin
     2835  g := ghue;
     2836  if g < segment[0] then
     2837    result := g * 10923 div segment[0]
     2838  else
     2839  begin
     2840    g -= segment[0];
     2841    if g < segment[1] then
     2842      result := g * (21845-10923) div segment[1] + 10923
    17772843    else
    17782844    begin
    1779       ghue -= segment[1];
    1780       if ghue < segment[2] then
    1781         result := ghue * (32768-21845) div segment[2] + 21845
     2845      g -= segment[1];
     2846      if g < segment[2] then
     2847        result := g * (32768-21845) div segment[2] + 21845
    17822848      else
    17832849      begin
    1784         ghue -= segment[2];
    1785         if ghue < segment[3] then
    1786           result := ghue * (43691-32768) div segment[3] + 32768
     2850        g -= segment[2];
     2851        if g < segment[3] then
     2852          result := g * (43691-32768) div segment[3] + 32768
    17872853        else
    17882854        begin
    1789           ghue -= segment[3];
    1790           if ghue < segment[4] then
    1791             result := ghue * (54613-43691) div segment[4] + 43691
     2855          g -= segment[3];
     2856          if g < segment[4] then
     2857            result := g * (54613-43691) div segment[4] + 43691
    17922858          else
    17932859          begin
    1794             ghue -= segment[4];
    1795             result := ghue * (65536-54613) div segment[5] + 54613;
     2860            g -= segment[4];
     2861            result := g * (65536-54613) div segment[5] + 54613;
    17962862          end;
    17972863        end;
    … …  
    18012867end;
    18022868
    1803 function BGRAToGSBA(c: TBGRAPixel): THSLAPixel;
    1804 var ec: TExpandedPixel;
    1805     lightness: word;
    1806 begin
    1807   ec := GammaExpansion(c);
    1808   lightness := GetLightness(ec);
    1809 
    1810   result := ExpandedToHSLA(ec);
     2869function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
     2870var lightness: UInt32Or64;
     2871    red,green,blue: Int32or64;
     2872begin
     2873  red   := GammaExpansionTab[c.red];
     2874  green := GammaExpansionTab[c.green];
     2875  blue  := GammaExpansionTab[c.blue];
     2876  result.alpha := c.alpha shl 8 + c.alpha;
     2877
     2878  lightness := (red * redWeightShl10 + green * greenWeightShl10 +
     2879    blue * blueWeightShl10 + 512) shr 10;
     2880
     2881  ExpandedToHSLAInline(red,green,blue,result);
    18112882  if result.lightness > 32768 then
    1812     result.saturation := result.saturation* word(65535-result.lightness) div 32767;
     2883    result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767;
    18132884  result.lightness := lightness;
    18142885  result.hue := HtoG(result.hue);
    18152886end;
    18162887
    1817 function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
     2888function ExpandedToGSBA(ec: TExpandedPixel): TGSBAPixel;
     2889var lightness: UInt32Or64;
     2890    red,green,blue: Int32or64;
     2891begin
     2892  red   := ec.red;
     2893  green := ec.green;
     2894  blue  := ec.blue;
     2895  result.alpha := ec.alpha;
     2896
     2897  lightness := (red * redWeightShl10 + green * greenWeightShl10 +
     2898    blue * blueWeightShl10 + 512) shr 10;
     2899
     2900  ExpandedToHSLAInline(red,green,blue,result);
     2901  if result.lightness > 32768 then
     2902    result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767;
     2903  result.lightness := lightness;
     2904  result.hue := HtoG(result.hue);
     2905end;
     2906
     2907function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
    18182908const
    18192909  deg30  = 4096;
    … …  
    18242914  deg360 = deg60 * 6;
    18252915
    1826   function ComputeColor(p, q: integer; h: integer): word; inline;
    1827   begin
    1828     if h > deg360 then
    1829       Dec(h, deg360);
    1830     if h < deg60 then
    1831       Result := p + ((q - p) * h + deg30) div deg60
    1832     else
     2916  function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline;
     2917  begin
    18332918    if h < deg180 then
    1834       Result := q
    1835     else
    1836     if h < deg240 then
    1837       Result := p + ((q - p) * (deg240 - h) + deg30) div deg60
    1838     else
    1839       Result := p;
     2919    begin
     2920      if h < deg60 then
     2921        Result := p + ((q - p) * h + deg30) div deg60
     2922      else
     2923        Result := q
     2924    end else
     2925    begin
     2926      if h < deg240 then
     2927        Result := p + ((q - p) * (deg240 - h) + deg30) div deg60
     2928      else
     2929        Result := p;
     2930    end;
    18402931  end;
    18412932
    18422933var
    1843   q, p: integer;
    1844 begin
    1845   c.hue := c.hue * deg360 shr 16;
    1846   if c.saturation = 0 then  //gray
    1847   begin
    1848     result.red   := c.lightness;
    1849     result.green := c.lightness;
    1850     result.blue  := c.lightness;
     2934  q, p, L, S, H: Int32or64;
     2935begin
     2936  L := c.lightness;
     2937  S := c.saturation;
     2938  if S = 0 then  //gray
     2939  begin
     2940    result.red   := L;
     2941    result.green := L;
     2942    result.blue  := L;
    18512943    result.alpha := c.alpha;
    18522944    exit;
    18532945  end;
    18542946  {$hints off}
    1855   if c.lightness < 32768 then
    1856     q := (c.lightness shr 1) * ((65535 + c.saturation) shr 1) shr 14
    1857   else
    1858     q := c.lightness + c.saturation - ((c.lightness shr 1) *
    1859       (c.saturation shr 1) shr 14);
     2947  if L < 32768 then
     2948    q := (L shr 1) * ((65535 + S) shr 1) shr 14
     2949  else
     2950    q := L + S - ((L shr 1) *
     2951      (S shr 1) shr 14);
    18602952  {$hints on}
    1861   if q > 65535 then
    1862     q := 65535;
    1863   p   := c.lightness * 2 - q;
    1864   if p > 65535 then
    1865     p      := 65535;
    1866   result.red   := ComputeColor(p, q, c.hue + deg120);
    1867   result.green := ComputeColor(p, q, c.hue);
    1868   result.blue  := ComputeColor(p, q, c.hue + deg240);
     2953  if q > 65535 then q := 65535;
     2954  p   := (L shl 1) - q;
     2955  if p > 65535 then p := 65535;
     2956  H := c.hue * deg360 shr 16;
     2957  result.green := ComputeColor(p, q, H);
     2958  inc(H, deg120);
     2959  if H > deg360 then Dec(H, deg360);
     2960  result.red   := ComputeColor(p, q, H);
     2961  inc(H, deg120);
     2962  if H > deg360 then Dec(H, deg360);
     2963  result.blue  := ComputeColor(p, q, H);
    18692964  result.alpha := c.alpha;
    18702965end;
    18712966
    18722967{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space }
    1873 function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
     2968function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
    18742969var ec: TExpandedPixel;
    18752970begin
    … …  
    19453040end;
    19463041
    1947 function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
     3042function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
    19483043var ec: TExpandedPixel;
    19493044    lightness: word;
    … …  
    19563051end;
    19573052
    1958 function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
     3053function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
     3054var lightness: word;
     3055begin
     3056  c.hue := GtoH(c.hue);
     3057  lightness := c.lightness;
     3058  c.lightness := 32768;
     3059  result := SetLightness(HSLAToExpanded(c),lightness);
     3060end;
     3061
     3062function GSBAToHSLA(c: TGSBAPixel): THSLAPixel;
    19593063begin
    19603064  result := BGRAToHSLA(GSBAToBGRA(c));
    … …  
    19703074end;
    19713075
    1972 function GammaCompression(ec: TExpandedPixel): TBGRAPixel;
     3076function GammaCompression(const ec: TExpandedPixel): TBGRAPixel;
    19733077begin
    19743078  Result.red   := GammaCompressionTab[ec.red];
    … …  
    19943098  cgray: byte;
    19953099begin
     3100  if c.alpha = 0 then
     3101  begin
     3102    result := BGRAPixelTransparent;
     3103    exit;
     3104  end;
    19963105  //gamma expansion
    19973106  ec    := GammaExpansion(c);
    … …  
    20173126function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel;
    20183127var
    2019   sumR,sumG,sumB,sumA: longword;
     3128  sumR,sumG,sumB,sumA: NativeUInt;
    20203129  i: integer;
    20213130begin
    … …  
    21073216  weight2: byte): TBGRAPixel;
    21083217var
    2109     f1,f2: word;
    2110     f12: longword;
    2111 begin
    2112   if (weight1 = 0) then
    2113   begin
    2114     if (weight2 = 0) then
     3218    w1,w2,f1,f2,f12,a: UInt32or64;
     3219begin
     3220  w1 := weight1;
     3221  w2 := weight2;
     3222  if (w1 = 0) then
     3223  begin
     3224    if (w2 = 0) then
    21153225      result := BGRAPixelTransparent
    21163226    else
    … …  
    21183228  end
    21193229  else
    2120   if (weight2 = 0) then
     3230  if (w2 = 0) then
    21213231    Result := c1
    21223232  else
    21233233  begin
    2124     f1 := c1.alpha*weight1 shr 1;
    2125     f2 := c2.alpha*weight2 shr 1;
     3234    f1 := c1.alpha*w1;
     3235    f2 := c2.alpha*w2;
     3236    a := (f1+f2 + ((w1+w2) shr 1)) div (w1+w2);
     3237    if a = 0 then
     3238    begin
     3239      result := BGRAPixelTransparent;
     3240      exit;
     3241    end else
     3242      Result.alpha := a;
     3243    {$IFNDEF CPU64}
     3244    if (f1 >= 32768) or (f2 >= 32768) then
     3245    begin
     3246      f1 := f1 shr 1;
     3247      f2 := f2 shr 1;
     3248    end;
     3249    {$ENDIF}
    21263250    f12 := f1+f2;
    2127     if f12 = 0 then
    2128       result := BGRAPixelTransparent
    2129     else
    2130     begin
    2131       Result.red   := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12];
    2132       Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12];
    2133       Result.blue  := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12];
    2134       Result.alpha := (c1.alpha*weight1+c2.alpha*weight2 + ((weight1+weight2) shr 1)) div (weight1+weight2);
    2135     end;
     3251    Result.red   := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12];
     3252    Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12];
     3253    Result.blue  := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12];
    21363254  end;
    21373255end;
    … …  
    23293447end;
    23303448
    2331 { Write a color in hexadecimal format RRGGBBAA }
    2332 function BGRAToStr(c: TBGRAPixel): string;
    2333 begin
     3449{ Write a color in hexadecimal format RRGGBBAA or using the name in a color list }
     3450function BGRAToStr(c: TBGRAPixel; AColorList: TBGRAColorList = nil; AMaxDiff: Word= 0): string;
     3451var idx: integer;
     3452begin
     3453  if Assigned(AColorList) then
     3454  begin
     3455    idx := AColorList.IndexOfColor(c, AMaxDiff);
     3456    if idx<> -1 then
     3457    begin
     3458      result := AColorList.Name[idx];
     3459      exit;
     3460    end;
     3461  end;
    23343462  result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
    23353463end;
    … …  
    23383466    arrayOfString = array of string;
    23393467
    2340 function SimpleParseFuncParam(str: string): arrayOfString;
     3468function SimpleParseFuncParam(str: string; var flagError: boolean): arrayOfString;
    23413469var idxOpen,start,cur: integer;
    23423470begin
    23433471    result := nil;
    23443472    idxOpen := pos('(',str);
    2345     if idxOpen = 0 then exit;
    2346     start := idxOpen+1;
     3473    if idxOpen = 0 then
     3474    begin
     3475      start := 1;
     3476      //find first space
     3477      while (start <= length(str)) and (str[start]<>' ') do inc(start);
     3478    end else
     3479      start := idxOpen+1;
    23473480    cur := start;
    23483481    while cur <= length(str) do
    … …  
    23513484       begin
    23523485         setlength(result,length(result)+1);
    2353          result[high(result)] := copy(str,start,cur-start);
     3486         result[high(result)] := trim(copy(str,start,cur-start));
    23543487         start := cur+1;
     3488         if str[cur] = ')' then exit;
    23553489       end;
    23563490       inc(cur);
    23573491    end;
     3492    if idxOpen <> 0 then flagError := true; //should exit on ')'
    23583493    if start <= length(str) then
    23593494    begin
    … …  
    23633498end;
    23643499
    2365 function ParseColorValue(str: string): byte;
     3500function ParseColorValue(str: string; var flagError: boolean): byte;
    23663501var pourcent,unclipped,{%H-}errPos: integer;
    23673502begin
    … …  
    23713506    begin
    23723507      val(copy(str,1,length(str)-1),pourcent,errPos);
     3508      if errPos <> 0 then flagError := true;
    23733509      if pourcent < 0 then result := 0 else
    23743510      if pourcent > 100 then result := 255 else
    … …  
    23773513    begin
    23783514      val(str,unclipped,errPos);
     3515      if errPos <> 0 then flagError := true;
    23793516      if unclipped < 0 then result := 0 else
    23803517      if unclipped > 255 then result := 255 else
    … …  
    23843521end;
    23853522
     3523//this function returns the parsed value only if it contains no error nor missing values, otherwise
     3524//it returns BGRAPixelTransparent
    23863525function StrToBGRA(str: string): TBGRAPixel;
    2387 begin
    2388   result := StrToBGRA(str, BGRAPixelTransparent);
    2389 end;
    2390 
    2391 { Read a color in hexadecimal format RRGGBB(AA) or RGB(A) }
    2392 function StrToBGRA(str: string; DefaultColor: TBGRAPixel): TBGRAPixel;
     3526var missingValues, error: boolean;
     3527begin
     3528  result := BGRABlack;
     3529  TryStrToBGRA(str, result, missingValues, error);
     3530  if missingValues or error then result := BGRAPixelTransparent;
     3531end;
     3532
     3533//this function changes the content of parsedValue depending on available and parsable information.
     3534//set parsedValue to the fallback values before calling this function.
     3535//missing values are expressed by empty string or by '?', for example 'rgb(255,?,?,?)' will change only the red value.
     3536//note that if alpha is not expressed by the string format, it will be opaque. So 'rgb(255,?,?)' will change the red value and the alpha value.
     3537//the last parameter of rgba() is a floating point number where 1 is opaque and 0 is transparent.
     3538procedure TryStrToBGRA(str: string; var parsedValue: TBGRAPixel; out missingValues: boolean; out error: boolean);
    23933539var errPos: integer;
    23943540    values: array of string;
    … …  
    23963542    idx: integer;
    23973543begin
    2398   if str = '' then
    2399   begin
    2400     result := DefaultColor;
     3544  str := Trim(str);
     3545  error := false;
     3546  if (str = '') or (str = '?') then
     3547  begin
     3548    missingValues := true;
    24013549    exit;
    2402   end;
    2403   str := lowerCase(str);
     3550  end else
     3551    missingValues := false;
     3552  str := StringReplace(lowerCase(str),'grey','gray',[]);
    24043553
    24053554  //VGA color names
    2406   if str='black' then result := BGRA(0,0,0) else
    2407   if str='silver' then result := BGRA(192,192,192) else
    2408   if str='gray' then result := BGRA(128,128,128) else
    2409   if str='grey' then result := BGRA(128,128,128) else
    2410   if str='white' then result := BGRA(255,255,255) else
    2411   if str='maroon' then result := BGRA(128,0,0) else
    2412   if str='red' then result := BGRA(255,0,0) else
    2413   if str='purple' then result := BGRA(128,0,128) else
    2414   if str='fuchsia' then result := BGRA(255,0,255) else
    2415   if str='green' then result := BGRA(0,128,0) else
    2416   if str='lime' then result := BGRA(0,255,0) else
    2417   if str='olive' then result := BGRA(128,128,0) else
    2418   if str='yellow' then result := BGRA(255,255,0) else
    2419   if str='navy' then result := BGRA(0,0,128) else
    2420   if str='blue' then result := BGRA(0,0,255) else
    2421   if str='teal' then result := BGRA(0,128,128) else
    2422   if str='aqua' then result := BGRA(0,255,255) else
    2423   if str='transparent' then result := DefaultColor else
     3555  idx := VGAColors.IndexOf(str);
     3556  if idx <> -1 then
     3557  begin
     3558    parsedValue := VGAColors[idx];
     3559    exit;
     3560  end;
     3561  if str='transparent' then parsedValue := BGRAPixelTransparent else
    24243562  begin
    24253563    //check CSS color
    … …  
    24273565    if idx <> -1 then
    24283566    begin
    2429       result := CSSColors[idx];
     3567      parsedValue := CSSColors[idx];
    24303568      exit;
    24313569    end;
    24323570
    24333571    //CSS RGB notation
    2434     if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') then
     3572    if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') or
     3573      (copy(str,1,4)='rgb ') or (copy(str,1,5)='rgba ') then
    24353574    begin
    2436       values := SimpleParseFuncParam(str);
     3575      values := SimpleParseFuncParam(str,error);
    24373576      if (length(values)=3) or (length(values)=4) then
    24383577      begin
    2439         result.red := ParseColorValue(values[0]);
    2440         result.green := ParseColorValue(values[1]);
    2441         result.blue := ParseColorValue(values[2]);
     3578        if (values[0] <> '') and (values[0] <> '?') then
     3579           parsedValue.red := ParseColorValue(values[0], error)
     3580        else
     3581           missingValues := true;
     3582        if (values[1] <> '') and (values[1] <> '?') then
     3583           parsedValue.green := ParseColorValue(values[1], error)
     3584        else
     3585           missingValues := true;
     3586        if (values[2] <> '') and (values[2] <> '?') then
     3587           parsedValue.blue := ParseColorValue(values[2], error)
     3588        else
     3589           missingValues := true;
    24423590        if length(values)=4 then
    24433591        begin
    2444           val(values[3],alphaF,errPos);
    2445           if alphaF < 0 then
    2446             result.alpha := 0 else
    2447           if alphaF > 1 then
    2448             result.alpha := 255
    2449           else
    2450             result.alpha := round(alphaF*255);
     3592          if (values[3] <> '') and (values[3] <> '?') then
     3593          begin
     3594            val(values[3],alphaF,errPos);
     3595            if errPos <> 0 then
     3596            begin
     3597               parsedValue.alpha := 255;
     3598               error := true;
     3599            end
     3600            else
     3601            begin
     3602              if alphaF < 0 then
     3603                parsedValue.alpha := 0 else
     3604              if alphaF > 1 then
     3605                parsedValue.alpha := 255
     3606              else
     3607                parsedValue.alpha := round(alphaF*255);
     3608            end;
     3609          end else
     3610            missingValues := true;
    24513611        end else
    2452           result.alpha := 255;
     3612          parsedValue.alpha := 255;
    24533613      end else
    2454         result := DefaultColor;
     3614        error := true;
    24553615      exit;
    24563616    end;
    … …  
    24593619    if str[1]='#' then delete(str,1,1);
    24603620
    2461     //add alpha if missing
     3621    //add alpha if missing (if you want an undefined alpha use '??' or '?')
    24623622    if length(str)=6 then str += 'FF';
    24633623    if length(str)=3 then str += 'F';
    … …  
    24663626    if length(str)=8 then
    24673627    begin
    2468       val('$'+copy(str,1,2),result.red,errPos);
    2469       if errPos <> 0 then
     3628      if copy(str,1,2) <> '??' then
    24703629      begin
    2471         result := DefaultColor;
    2472         exit;
    2473       end;
    2474       val('$'+copy(str,3,2),result.green,errPos);
    2475       if errPos <> 0 then
     3630        val('$'+copy(str,1,2),parsedValue.red,errPos);
     3631        if errPos <> 0 then error := true;
     3632      end else missingValues := true;
     3633      if copy(str,3,2) <> '??' then
    24763634      begin
    2477         result := DefaultColor;
    2478         exit;
    2479       end;
    2480       val('$'+copy(str,5,2),result.blue,errPos);
    2481       if errPos <> 0 then
     3635        val('$'+copy(str,3,2),parsedValue.green,errPos);
     3636        if errPos <> 0 then error := true;
     3637      end else missingValues := true;
     3638      if copy(str,5,2) <> '??' then
    24823639      begin
    2483         result := DefaultColor;
    2484         exit;
    2485       end;
    2486       val('$'+copy(str,7,2),result.alpha,errPos);
    2487       if errPos <> 0 then
     3640        val('$'+copy(str,5,2),parsedValue.blue,errPos);
     3641        if errPos <> 0 then error := true;
     3642      end else missingValues := true;
     3643      if copy(str,7,2) <> '??' then
    24883644      begin
    2489         result := DefaultColor;
    2490         exit;
    2491       end;
     3645        val('$'+copy(str,7,2),parsedValue.alpha,errPos);
     3646        if errPos <> 0 then
     3647        begin
     3648          error := true;
     3649          parsedValue.alpha := 255;
     3650        end;
     3651      end else missingValues := true;
    24923652    end else
    24933653    if length(str)=4 then
    24943654    begin
    2495       val('$'+copy(str,1,1),result.red,errPos);
    2496       if errPos <> 0 then
     3655      if str[1] <> '?' then
    24973656      begin
    2498         result := DefaultColor;
    2499         exit;
    2500       end;
    2501       val('$'+copy(str,2,1),result.green,errPos);
    2502       if errPos <> 0 then
     3657        val('$'+str[1],parsedValue.red,errPos);
     3658        if errPos <> 0 then error := true;
     3659        parsedValue.red *= $11;
     3660      end else missingValues := true;
     3661      if str[2] <> '?' then
    25033662      begin
    2504         result := DefaultColor;
    2505         exit;
    2506       end;
    2507       val('$'+copy(str,3,1),result.blue,errPos);
    2508       if errPos <> 0 then
     3663        val('$'+str[2],parsedValue.green,errPos);
     3664        if errPos <> 0 then error := true;
     3665        parsedValue.green *= $11;
     3666      end else missingValues := true;
     3667      if str[3] <> '?' then
    25093668      begin
    2510         result := DefaultColor;
    2511         exit;
    2512       end;
    2513       val('$'+copy(str,4,1),result.alpha,errPos);
    2514       if errPos <> 0 then
     3669        val('$'+str[3],parsedValue.blue,errPos);
     3670        if errPos <> 0 then error := true;
     3671        parsedValue.blue *= $11;
     3672      end else missingValues := true;
     3673      if str[4] <> '?' then
    25153674      begin
    2516         result := DefaultColor;
    2517         exit;
    2518       end;
    2519       result.red *= $11;
    2520       result.green *= $11;
    2521       result.blue *= $11;
    2522       result.alpha *= $11;
     3675        val('$'+str[4],parsedValue.alpha,errPos);
     3676        if errPos <> 0 then
     3677        begin
     3678          error := true;
     3679          parsedValue.alpha := 255;
     3680        end else
     3681          parsedValue.alpha *= $11;
     3682      end else missingValues := true;
    25233683    end else
    2524       result := DefaultColor;
    2525   end;
    2526 
     3684      error := true; //string format not recognised
     3685  end;
     3686
     3687end;
     3688
     3689//this function returns the values that can be read from the string, otherwise
     3690//it fills the gaps with the fallback values. The error boolean is True only
     3691//if there was invalid values, it is not set to True if there was missing values.
     3692function PartialStrToBGRA(str: string; const fallbackValues: TBGRAPixel; out
     3693  error: boolean): TBGRAPixel;
     3694var missingValues: boolean;
     3695begin
     3696  result := fallbackValues;
     3697  TryStrToBGRA(str, result, missingValues, error);
     3698end;
     3699
     3700{ Read a color, for example in hexadecimal format RRGGBB(AA) or RGB(A). Partial colors are not accepted by this function. }
     3701function StrToBGRA(str: string; const DefaultColor: TBGRAPixel): TBGRAPixel;
     3702var missingValues, error: boolean;
     3703begin
     3704  result := BGRABlack;
     3705  TryStrToBGRA(str, result, missingValues, error);
     3706  if missingValues or error then result := DefaultColor;
    25273707end;
    25283708
    … …  
    25313711begin
    25323712  intval := color.Green shl 16 + color.red shl 8 + color.blue;
    2533   result := intval/16777215;
     3713  result := intval*5.960464832810452e-8;
    25343714end;
    25353715
    … …  
    26013781end;
    26023782
    2603 function PtInRect(pt: TPoint; r: TRect): boolean;
     3783function PtInRect(const pt: TPoint; r: TRect): boolean;
    26043784var
    26053785  temp: integer;
    … …  
    26213801end;
    26223802
     3803function RectWithSize(left, top, width, height: integer): TRect;
     3804begin
     3805  result.left := left;
     3806  result.top := top;
     3807  result.right := left+width;
     3808  result.bottom := top+height;
     3809end;
     3810
    26233811function VectLen(dx, dy: single): single;
    26243812begin
    … …  
    26303818  result := sqrt(v.x*v.x+v.y*v.y);
    26313819end;
    2632 
     3820{$OPTIMIZATION OFF}  // Modif J.P  5/2013
    26333821function IntersectLine(line1, line2: TLineDef): TPointF;
    26343822var parallel: boolean;
    … …  
    26363824  result := IntersectLine(line1,line2,parallel);
    26373825end;
     3826{$OPTIMIZATION ON}
    26383827
    26393828function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
    … …  
    27873976
    27883977// Get the cyclic value in the range [0..cycle-1]
    2789 function PositiveMod(value, cycle: integer): integer; inline;
     3978function PositiveMod(value, cycle: Int32or64): Int32or64; inline;
    27903979begin
    27913980  result := value mod cycle;
    … …  
    28013990  byteSqrtTab: packed array of word;
    28023991
    2803 function Sin65536(value: word): integer;
     3992function Sin65536(value: word): Int32or64;
    28043993var b: integer;
    28053994begin
    … …  
    28254014end;
    28264015
    2827 function Cos65536(value: word): integer;
    2828 begin
     4016function Cos65536(value: word): Int32or64;
     4017begin
     4018  {$PUSH}{$R-}
    28294019  result := Sin65536(value+16384); //cosine is translated
     4020  {$POP}
    28304021end;
    28314022
    … …  
    28544045end;
    28554046
     4047function DetectFileFormat(AFilenameUTF8: string): TBGRAImageFormat;
     4048var stream: TFileStreamUTF8;
     4049begin
     4050  try
     4051    stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite);
     4052  except
     4053    result := ifUnknown;
     4054    exit;
     4055  end;
     4056  try
     4057    result := DetectFileFormat(stream, ExtractFileExt(AFilenameUTF8));
     4058  finally
     4059    stream.Free;
     4060  end;
     4061end;
     4062
     4063function DetectFileFormat(AStream: TStream; ASuggestedExtensionUTF8: string
     4064  ): TBGRAImageFormat;
     4065var
     4066  scores: array[TBGRAImageFormat] of integer;
     4067  imageFormat,bestImageFormat: TBGRAImageFormat;
     4068  bestScore: integer;
     4069
     4070  procedure DetectFromStream;
     4071  var
     4072    {%H-}magic: packed array[0..7] of byte;
     4073    {%H-}dwords: packed array[0..9] of DWORD;
     4074    magicAsText: string;
     4075
     4076    streamStartPos, maxFileSize: Int64;
     4077    expectedFileSize: DWord;
     4078
     4079    procedure DetectTarga;
     4080    var
     4081      paletteCount: integer;
     4082      {%H-}targaPixelFormat: packed record pixelDepth: byte; imgDescriptor: byte; end;
     4083    begin
     4084      if (magic[1] in[$00,$01]) and (magic[2] in[0,1,2,3,9,10,11]) and (maxFileSize >= 18) then
     4085      begin
     4086        paletteCount:= magic[5] + magic[6] shl 8;
     4087        if ((paletteCount = 0) and (magic[7] = 0)) or
     4088          (magic[7] in [16,24,32]) then //check palette bit count
     4089        begin
     4090          AStream.Position:= streamStartPos+16;
     4091          if AStream.Read({%H-}targaPixelFormat,2) = 2 then
     4092          begin
     4093            if (targaPixelFormat.pixelDepth in [8,16,24,32]) and
     4094              (targaPixelFormat.imgDescriptor and 15 < targaPixelFormat.pixelDepth) then
     4095                inc(scores[ifTarga],2);
     4096          end;
     4097        end;
     4098      end;
     4099    end;
     4100
     4101    procedure DetectLazPaint;
     4102    var
     4103      w,h: dword;
     4104      i: integer;
     4105    begin
     4106      if (copy(magicAsText,1,8) = 'LazPaint') then //with header
     4107      begin
     4108        AStream.Position:= streamStartPos+8;
     4109        if AStream.Read(dwords,10*4) = 10*4 then
     4110        begin
     4111          for i := 0 to 6 do dwords[i] := LEtoN(dwords[i]);
     4112          if (dwords[0] = 0) and (dwords[1] <= expectedFileSize) and (dwords[5] <= expectedFileSize) and
     4113             (dwords[9] <= expectedFileSize) and
     4114            (dwords[6] = 0) then inc(scores[ifLazPaint],2);
     4115        end;
     4116      end else //without header
     4117      if ((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and
     4118         ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0) then
     4119      begin
     4120        w := magic[0] + (magic[1] shl 8);
     4121        h := magic[4] + (magic[5] shl 8);
     4122        AStream.Position:= streamStartPos+8;
     4123        if AStream.Read(dwords,4) = 4 then
     4124        begin
     4125          dwords[0] := LEtoN(dwords[0]);
     4126          if (dwords[0] > 0) and (dwords[0] < 65536) then
     4127          begin
     4128            if 12+dwords[0] < expectedFileSize then
     4129            begin
     4130              AStream.Position:= streamStartPos+12+dwords[0];
     4131              if AStream.Read(dwords,6*4) = 6*4 then
     4132              begin
     4133                for i := 0 to 5 do dwords[i] := LEtoN(dwords[i]);
     4134                if (dwords[0] <= w) and (dwords[1] <= h) and
     4135                  (dwords[2] <= w) and (dwords[3] <= h) and
     4136                  (dwords[2] >= dwords[0]) and (dwords[3] >= dwords[1]) and
     4137                  ((dwords[4] = 0) or (dwords[4] = 1)) and
     4138                  (dwords[5] > 0) then inc(scores[ifLazPaint],1);
     4139              end;
     4140            end;
     4141          end;
     4142        end;
     4143      end;
     4144    end;
     4145
     4146  begin
     4147    fillchar({%H-}magic, sizeof(magic), 0);
     4148    fillchar({%H-}dwords, sizeof(dwords), 0);
     4149
     4150    streamStartPos:= AStream.Position;
     4151    maxFileSize:= AStream.Size - streamStartPos;
     4152    if maxFileSize < 8 then exit;
     4153    if AStream.Read(magic,sizeof(magic)) <> sizeof(magic) then
     4154    begin
     4155      fillchar(scores,sizeof(scores),0);
     4156      exit;
     4157    end;
     4158    setlength(magicAsText,sizeof(magic));
     4159    move(magic[0],magicAsText[1],sizeof(magic));
     4160
     4161    if (magic[0] = $ff) and (magic[1] = $d8) then
     4162    begin
     4163         inc(scores[ifJpeg]);
     4164         if (magic[2] = $ff) and (magic[3] >= $c0) then inc(scores[ifJpeg]);
     4165    end;
     4166
     4167    if (magic[0] = $89) and (magic[1] = $50) and (magic[2] = $4e) and
     4168      (magic[3] = $47) and (magic[4] = $0d) and (magic[5] = $0a) and
     4169      (magic[6] = $1a) and (magic[7] = $0a) then inc(scores[ifPng],2);
     4170
     4171    if (copy(magicAsText,1,6)='GIF87a') or (copy(magicAsText,1,6)='GIF89a') then inc(scores[ifGif],2);
     4172
     4173    if (magic[0] = $0a) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8]) then
     4174      inc(scores[ifPcx],2);
     4175
     4176    if (copy(magicAsText,1,2)='BM') then
     4177    begin
     4178      inc(scores[ifBmp]);
     4179      expectedFileSize:= magic[2] + (magic[3] shl 8) + (magic[4] shl 16) + (magic[5] shl 24);
     4180      if expectedFileSize = maxFileSize then inc(scores[ifBmp]);
     4181    end else
     4182    if (copy(magicAsText,1,2)='RL') then
     4183    begin
     4184      inc(scores[ifBmpMioMap]);
     4185      if (magic[2] in[0,1]) and (magic[3] = 0) then inc(scores[ifBmpMioMap]);
     4186    end;
     4187
     4188    if (magic[0] = $00) and (magic[1] = $00) and (magic[2] in[$01,$02]) and (magic[3] = $00) and
     4189      (magic[4] + (magic[5] shl 8) > 0) then inc(scores[ifIco]);
     4190
     4191    if (copy(magicAsText,1,4) = 'PDN3') then
     4192    begin
     4193      expectedFileSize:= 6 + (magic[4] + (magic[5] shl 8) + (magic[6] shl 16)) + 2;
     4194      if expectedFileSize <= maxFileSize then
     4195      begin
     4196        inc(scores[ifPaintDotNet]);
     4197        if magic[7] = $3c then inc(scores[ifPaintDotNet]);
     4198      end;
     4199    end;
     4200
     4201    DetectLazPaint;
     4202
     4203    if (magic[0] = $50) and (magic[1] = $4b) and (magic[2] = $03) and (magic[3] = $04) then
     4204    begin
     4205      if DefaultBGRAImageReader[ifOpenRaster] = nil then inc(scores[ifOpenRaster]) else
     4206      with CreateBGRAImageReader(ifOpenRaster) do
     4207        try
     4208          if CheckContents(AStream) then inc(scores[ifOpenRaster],2);
     4209        finally
     4210          Free;
     4211        end;
     4212    end;
     4213
     4214    if (copy(magicAsText,1,4) = '8BPS') and (magic[4] = $00) and (magic[5] = $01) then inc(scores[ifPsd],2);
     4215
     4216    DetectTarga;
     4217
     4218    if (copy(magicAsText,1,2)='II') and (magic[2] = 42) and (magic[3]=0) then inc(scores[ifTiff]) else
     4219    if (copy(magicAsText,1,2)='MM') and (magic[2] = 0) and (magic[3]=42) then inc(scores[ifTiff]);
     4220
     4221    if (copy(magicAsText,1,8) = '/* XPM *') or (copy(magicAsText,1,6) = '! XPM2') then inc(scores[ifXPixMap]);
     4222
     4223    AStream.Position := streamStartPos;
     4224  end;
     4225
     4226var
     4227  extFormat: TBGRAImageFormat;
     4228
     4229begin
     4230  result := ifUnknown;
     4231  for imageFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do
     4232    scores[imageFormat] := 0;
     4233
     4234  ASuggestedExtensionUTF8:= UTF8LowerCase(ASuggestedExtensionUTF8);
     4235  if (ASuggestedExtensionUTF8 <> '') and (UTF8Copy(ASuggestedExtensionUTF8,1,1) <> '.') then
     4236    ASuggestedExtensionUTF8 := '.'+ASuggestedExtensionUTF8;
     4237
     4238  extFormat:= SuggestImageFormat(ASuggestedExtensionUTF8);
     4239  if extFormat <> ifUnknown then inc(scores[extFormat]);
     4240
     4241  If AStream <> nil then DetectFromStream;
     4242
     4243  bestScore := 0;
     4244  bestImageFormat:= ifUnknown;
     4245  for imageFormat:=low(TBGRAImageFormat) to high(TBGRAImageFormat) do
     4246    if scores[imageFormat] > bestScore then
     4247    begin
     4248      bestScore:= scores[imageFormat];
     4249      bestImageFormat:= imageFormat;
     4250    end;
     4251  result := bestImageFormat;
     4252end;
     4253
     4254function SuggestImageFormat(AFilenameOrExtensionUTF8: string): TBGRAImageFormat;
     4255var ext: string;
     4256begin
     4257  result := ifUnknown;
     4258
     4259  ext := ExtractFileName(AFilenameOrExtensionUTF8);
     4260  if pos('.', ext) <> 0 then ext := ExtractFileExt(ext) else ext := '.'+ext;
     4261  ext := UTF8LowerCase(ext);
     4262
     4263  if (ext = '.jpg') or (ext = '.jpeg') then result := ifJpeg else
     4264  if (ext = '.png') then result := ifPng else
     4265  if (ext = '.gif') then result := ifGif else
     4266  if (ext = '.pcx') then result := ifPcx else
     4267  if (ext = '.bmp') then result := ifBmp else
     4268  if (ext = '.ico') or (ext = '.cur') then result := ifIco else
     4269  if (ext = '.pdn') then result := ifPaintDotNet else
     4270  if (ext = '.lzp') then result := ifLazPaint else
     4271  if (ext = '.ora') then result := ifOpenRaster else
     4272  if (ext = '.psd') then result := ifPsd else
     4273  if (ext = '.tga') then result := ifTarga else
     4274  if (ext = '.tif') or (ext = '.tiff') then result := ifTiff else
     4275  if (ext = '.xwd') then result := ifXwd else
     4276  if (ext = '.xpm') then result := ifXPixMap;
     4277end;
     4278
     4279function CreateBGRAImageReader(AFormat: TBGRAImageFormat): TFPCustomImageReader;
     4280begin
     4281  if DefaultBGRAImageReader[AFormat] = nil then
     4282  begin
     4283    case AFormat of
     4284      ifUnknown: raise exception.Create('The image format is unknown.');
     4285      ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to read this image.');
     4286      ifPaintDotNet: raise exception.Create('You need to call BGRAPaintNet.RegisterPaintNetFormat to read this image.');
     4287    else
     4288      raise exception.Create('The image reader is not registered for this image format.');
     4289    end;
     4290  end;
     4291  result := DefaultBGRAImageReader[AFormat].Create;
     4292end;
     4293
     4294function CreateBGRAImageWriter(AFormat: TBGRAImageFormat; AHasTransparentPixels: boolean): TFPCustomImageWriter;
     4295begin
     4296  if DefaultBGRAImageWriter[AFormat] = nil then
     4297  begin
     4298    case AFormat of
     4299      ifUnknown: raise exception.Create('The image format is unknown');
     4300      ifOpenRaster: raise exception.Create('You need to call BGRAOpenRaster.RegisterOpenRasterFormat to write with this image format.');
     4301    else
     4302      raise exception.Create('The image writer is not registered for this image format.');
     4303    end;
     4304  end;
     4305
     4306  if AFormat = ifPng then
     4307  begin
     4308    result := TFPWriterPNG.Create;
     4309    TFPWriterPNG(result).Indexed := false;
     4310    TFPWriterPNG(result).WordSized := false;
     4311    TFPWriterPNG(result).UseAlpha := AHasTransparentPixels;
     4312  end else
     4313  if AFormat = ifBmp then
     4314  begin
     4315    result := TFPWriterBMP.Create;
     4316    if AHasTransparentPixels then
     4317      TFPWriterBMP(result).BitsPerPixel := 32 else
     4318      TFPWriterBMP(result).BitsPerPixel := 24;
     4319  end else
     4320  if AFormat = ifXPixMap then
     4321  begin
     4322    result := TFPWriterXPM.Create;
     4323    TFPWriterXPM(result).ColorCharSize := 2;
     4324  end else
     4325    result := DefaultBGRAImageWriter[AFormat].Create;
     4326end;
     4327
    28564328initialization
    28574329
    28584330  InitGamma;
    2859   CSSColors := TBGRAColorList.Create;
    2860   CSSColors.Add('AliceBlue',CSSAliceBlue);
    2861   CSSColors.Add('AntiqueWhite',CSSAntiqueWhite);
    2862   CSSColors.Add('Aqua',CSSAqua);
    2863   CSSColors.Add('Aquamarine',CSSAquamarine);
    2864   CSSColors.Add('Azure',CSSAzure);
    2865   CSSColors.Add('Beige',CSSBeige);
    2866   CSSColors.Add('Bisque',CSSBisque);
    2867   CSSColors.Add('Black',CSSBlack);
    2868   CSSColors.Add('BlanchedAlmond',CSSBlanchedAlmond);
    2869   CSSColors.Add('Blue',CSSBlue);
    2870   CSSColors.Add('BlueViolet',CSSBlueViolet);
    2871   CSSColors.Add('Brown',CSSBrown);
    2872   CSSColors.Add('BurlyWood',CSSBurlyWood);
    2873   CSSColors.Add('CadetBlue',CSSCadetBlue);
    2874   CSSColors.Add('Chartreuse',CSSChartreuse);
    2875   CSSColors.Add('Chocolate',CSSChocolate);
    2876   CSSColors.Add('Coral',CSSCoral);
    2877   CSSColors.Add('CornflowerBlue',CSSCornflowerBlue);
    2878   CSSColors.Add('Cornsilk',CSSCornsilk);
    2879   CSSColors.Add('Crimson',CSSCrimson);
    2880   CSSColors.Add('Cyan',CSSCyan);
    2881   CSSColors.Add('DarkBlue',CSSDarkBlue);
    2882   CSSColors.Add('DarkCyan',CSSDarkCyan);
    2883   CSSColors.Add('DarkGoldenrod',CSSDarkGoldenrod);
    2884   CSSColors.Add('DarkGray',CSSDarkGray);
    2885   CSSColors.Add('DarkGreen',CSSDarkGreen);
    2886   CSSColors.Add('DarkKhaki',CSSDarkKhaki);
    2887   CSSColors.Add('DarkMagenta',CSSDarkMagenta);
    2888   CSSColors.Add('DarkOliveGreen',CSSDarkOliveGreen);
    2889   CSSColors.Add('DarkOrange',CSSDarkOrange);
    2890   CSSColors.Add('DarkOrchid',CSSDarkOrchid);
    2891   CSSColors.Add('DarkRed',CSSDarkRed);
    2892   CSSColors.Add('DarkSalmon',CSSDarkSalmon);
    2893   CSSColors.Add('DarkSeaGreen',CSSDarkSeaGreen);
    2894   CSSColors.Add('DarkSlateBlue',CSSDarkSlateBlue);
    2895   CSSColors.Add('DarkSlateGray',CSSDarkSlateGray);
    2896   CSSColors.Add('DarkTurquoise',CSSDarkTurquoise);
    2897   CSSColors.Add('DarkViolet',CSSDarkViolet);
    2898   CSSColors.Add('DeepPink',CSSDeepPink);
    2899   CSSColors.Add('DeepSkyBlue',CSSDeepSkyBlue);
    2900   CSSColors.Add('DimGray',CSSDimGray);
    2901   CSSColors.Add('DodgerBlue',CSSDodgerBlue);
    2902   CSSColors.Add('FireBrick',CSSFireBrick);
    2903   CSSColors.Add('FloralWhite',CSSFloralWhite);
    2904   CSSColors.Add('ForestGreen',CSSForestGreen);
    2905   CSSColors.Add('Fuchsia',CSSFuchsia);
    2906   CSSColors.Add('Gainsboro',CSSGainsboro);
    2907   CSSColors.Add('GhostWhite',CSSGhostWhite);
    2908   CSSColors.Add('Gold',CSSGold);
    2909   CSSColors.Add('Goldenrod',CSSGoldenrod);
    2910   CSSColors.Add('Gray',CSSGray);
    2911   CSSColors.Add('Green',CSSGreen);
    2912   CSSColors.Add('GreenYellow',CSSGreenYellow);
    2913   CSSColors.Add('Honeydew',CSSHoneydew);
    2914   CSSColors.Add('HotPink',CSSHotPink);
    2915   CSSColors.Add('IndianRed',CSSIndianRed);
    2916   CSSColors.Add('Indigo',CSSIndigo);
    2917   CSSColors.Add('Ivory',CSSIvory);
    2918   CSSColors.Add('Khaki',CSSKhaki);
    2919   CSSColors.Add('Lavender',CSSLavender);
    2920   CSSColors.Add('LavenderBlush',CSSLavenderBlush);
    2921   CSSColors.Add('LawnGreen',CSSLawnGreen);
    2922   CSSColors.Add('LemonChiffon',CSSLemonChiffon);
    2923   CSSColors.Add('LightBlue',CSSLightBlue);
    2924   CSSColors.Add('LightCoral',CSSLightCoral);
    2925   CSSColors.Add('LightCyan',CSSLightCyan);
    2926   CSSColors.Add('LightGoldenrodYellow',CSSLightGoldenrodYellow);
    2927   CSSColors.Add('LightGray',CSSLightGray);
    2928   CSSColors.Add('LightGreen',CSSLightGreen);
    2929   CSSColors.Add('LightPink',CSSLightPink);
    2930   CSSColors.Add('LightSalmon',CSSLightSalmon);
    2931   CSSColors.Add('LightSeaGreen',CSSLightSeaGreen);
    2932   CSSColors.Add('LightSkyBlue',CSSLightSkyBlue);
    2933   CSSColors.Add('LightSlateGray',CSSLightSlateGray);
    2934   CSSColors.Add('LightSteelBlue',CSSLightSteelBlue);
    2935   CSSColors.Add('LightYellow',CSSLightYellow);
    2936   CSSColors.Add('Lime',CSSLime);
    2937   CSSColors.Add('LimeGreen',CSSLimeGreen);
    2938   CSSColors.Add('Linen',CSSLinen);
    2939   CSSColors.Add('Magenta',CSSMagenta);
    2940   CSSColors.Add('Maroon',CSSMaroon);
    2941   CSSColors.Add('MediumAquamarine',CSSMediumAquamarine);
    2942   CSSColors.Add('MediumBlue',CSSMediumBlue);
    2943   CSSColors.Add('MediumOrchid',CSSMediumOrchid);
    2944   CSSColors.Add('MediumPurple',CSSMediumPurple);
    2945   CSSColors.Add('MediumSeaGreen',CSSMediumSeaGreen);
    2946   CSSColors.Add('MediumSlateBlue',CSSMediumSlateBlue);
    2947   CSSColors.Add('MediumSpringGreen',CSSMediumSpringGreen);
    2948   CSSColors.Add('MediumTurquoise',CSSMediumTurquoise);
    2949   CSSColors.Add('MediumVioletRed',CSSMediumVioletRed);
    2950   CSSColors.Add('MidnightBlue',CSSMidnightBlue);
    2951   CSSColors.Add('MintCream',CSSMintCream);
    2952   CSSColors.Add('MistyRose',CSSMistyRose);
    2953   CSSColors.Add('Moccasin',CSSMoccasin);
    2954   CSSColors.Add('NavajoWhite',CSSNavajoWhite);
    2955   CSSColors.Add('Navy',CSSNavy);
    2956   CSSColors.Add('OldLace',CSSOldLace);
    2957   CSSColors.Add('Olive',CSSOlive);
    2958   CSSColors.Add('OliveDrab',CSSOliveDrab);
    2959   CSSColors.Add('Orange',CSSOrange);
    2960   CSSColors.Add('OrangeRed',CSSOrangeRed);
    2961   CSSColors.Add('Orchid',CSSOrchid);
    2962   CSSColors.Add('PaleGoldenrod',CSSPaleGoldenrod);
    2963   CSSColors.Add('PaleGreen',CSSPaleGreen);
    2964   CSSColors.Add('PaleTurquoise',CSSPaleTurquoise);
    2965   CSSColors.Add('PaleVioletRed',CSSPaleVioletRed);
    2966   CSSColors.Add('PapayaWhip',CSSPapayaWhip);
    2967   CSSColors.Add('PeachPuff',CSSPeachPuff);
    2968   CSSColors.Add('Peru',CSSPeru);
    2969   CSSColors.Add('Pink',CSSPink);
    2970   CSSColors.Add('Plum',CSSPlum);
    2971   CSSColors.Add('PowderBlue',CSSPowderBlue);
    2972   CSSColors.Add('Purple',CSSPurple);
    2973   CSSColors.Add('Red',CSSRed);
    2974   CSSColors.Add('RosyBrown',CSSRosyBrown);
    2975   CSSColors.Add('RoyalBlue',CSSRoyalBlue);
    2976   CSSColors.Add('SaddleBrown',CSSSaddleBrown);
    2977   CSSColors.Add('Salmon',CSSSalmon);
    2978   CSSColors.Add('SandyBrown',CSSSandyBrown);
    2979   CSSColors.Add('SeaGreen',CSSSeaGreen);
    2980   CSSColors.Add('Seashell',CSSSeashell);
    2981   CSSColors.Add('Sienna',CSSSienna);
    2982   CSSColors.Add('Silver',CSSSilver);
    2983   CSSColors.Add('SkyBlue',CSSSkyBlue);
    2984   CSSColors.Add('SlateBlue',CSSSlateBlue);
    2985   CSSColors.Add('SlateGray',CSSSlateGray);
    2986   CSSColors.Add('Snow',CSSSnow);
    2987   CSSColors.Add('SpringGreen',CSSSpringGreen);
    2988   CSSColors.Add('SteelBlue',CSSSteelBlue);
    2989   CSSColors.Add('Tan',CSSTan);
    2990   CSSColors.Add('Teal',CSSTeal);
    2991   CSSColors.Add('Thistle',CSSThistle);
    2992   CSSColors.Add('Tomato',CSSTomato);
    2993   CSSColors.Add('Turquoise',CSSTurquoise);
    2994   CSSColors.Add('Violet',CSSViolet);
    2995   CSSColors.Add('Wheat',CSSWheat);
    2996   CSSColors.Add('White',CSSWhite);
    2997   CSSColors.Add('WhiteSmoke',CSSWhiteSmoke);
    2998   CSSColors.Add('Yellow',CSSYellow);
    2999   CSSColors.Add('YellowGreen',CSSYellowGreen);
    3000   CSSColors.Finished;
     4331  {$DEFINE INCLUDE_COLOR_LIST}
     4332  {$I csscolorconst.inc}
     4333  DefaultBGRAImageWriter[ifJpeg] := TFPWriterJPEG;
     4334  DefaultBGRAImageWriter[ifPng] := TFPWriterPNG;
     4335  DefaultBGRAImageWriter[ifBmp] := TFPWriterBMP;
     4336  DefaultBGRAImageWriter[ifPcx] := TFPWriterPCX;
     4337  DefaultBGRAImageWriter[ifTarga] := TFPWriterTarga;
     4338  DefaultBGRAImageWriter[ifXPixMap] := TFPWriterXPM;
     4339  DefaultBGRAImageWriter[ifTiff] := TFPWriterTiff;
     4340  //writing XWD not implemented
     4341
     4342  DefaultBGRAImageReader[ifTiff] := TFPReaderTiff;
     4343  DefaultBGRAImageReader[ifXwd] := TFPReaderXWD;
     4344  //the other readers are registered by their unit
    30014345
    30024346finalization
    30034347
    30044348  CSSColors.Free;
     4349  VGAColors.Free;
    30054350
    30064351end.
Note: See TracChangeset for help on using the changeset viewer.