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

Legend:

Unmodified
Added
Removed

  • GraphicTest/BGRABitmap

    • Property svn:ignore set to
      lib

  • GraphicTest/BGRABitmap/bgrabitmaptypes.pas

    r210 r317  
    3030
    3131uses
    32   Classes, Graphics;
     32  Classes, Types, Graphics, FPImage, FPImgCanv, GraphType;
    3333
    3434type
     35  //pointer for direct pixel access
    3536  PBGRAPixel = ^TBGRAPixel;
    3637
     38  //pixel structure
    3739  TBGRAPixel = packed record
    3840    blue, green, red, alpha: byte;
    3941  end;
    4042
     43  //gamma expanded values
    4144  TExpandedPixel = packed record
    4245    red, green, blue, alpha: word;
    4346  end;
    4447
     48  //pixel color defined in HSL colorspace
    4549  THSLAPixel = packed record
    4650    hue, saturation, lightness, alpha: word;
    4751  end;
    4852
    49   TDrawMode = (dmSet, dmSetExceptTransparent, dmLinearBlend, dmDrawWithTransparency);
    50   TFloodfillMode = (fmSet, fmDrawWithTransparency, fmProgressive);
    51   TResampleMode = (rmSimpleStretch, rmFineResample);
     53  //general purpose color variable with floating point values
     54  TColorF = array[1..4] of single;
     55 
     56  { These types are used as parameters }
     57
     58  TDrawMode = (dmSet,                   //replace pixels
     59               dmSetExceptTransparent,  //draw pixels with alpha=255
     60               dmLinearBlend,           //blend without gamma correction
     61               dmDrawWithTransparency,  //normal blending with gamma correction
     62               dmXor);                  //bitwise xor for all channels
     63  TChannel = (cRed, cGreen, cBlue, cAlpha);
     64  TChannels = set of TChannel;
     65               
     66  //floodfill option
     67  TFloodfillMode = (fmSet,                   //set pixels
     68                    fmDrawWithTransparency,  //draw fill color with transparency
     69                    fmProgressive);          //draw fill color with transparency according to similarity with start color
     70
     71  TResampleMode = (rmSimpleStretch,   //low quality resample
     72                   rmFineResample);   //use resample filters
     73  TResampleFilter = (rfLinear,        //linear interpolation
     74                     rfHalfCosine,    //mix of rfLinear and rfCosine
     75                     rfCosine,        //cosine-like interpolation
     76                     rfBicubic,       //simple bi-cubic filter (blur)
     77                     rfMitchell,      //downsizing interpolation
     78                     rfSpline,        //upsizing interpolation
     79                     rfBestQuality);  //mix of rfMitchell and rfSpline
     80
     81  TBGRAFontQuality = (fqSystem, fqSystemClearType, fqFineAntialiasing, fqFineClearTypeRGB, fqFineClearTypeBGR);
     82
    5283  TMedianOption = (moNone, moLowSmooth, moMediumSmooth, moHighSmooth);
     84  TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise, rbFast);
     85  TSplineStyle = (ssInside, ssInsideWithEnds, ssCrossing, ssCrossingWithEnds, ssOutside, ssRoundOutside, ssVertexToSide);
     86 
     87  //Advanced blending modes
     88  //see : http://www.brighthub.com/multimedia/photography/articles/18301.aspx
     89  //and : http://www.pegtop.net/delphi/articles/blendmodes/ 
     90  TBlendOperation = (boLinearBlend, boTransparent,                                  //blending
     91    boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boNiceGlow,         //lighting
     92    boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn, //masking
     93    boDifference, boLinearDifference, boNegation, boLinearNegation, boXor);         //negative
     94
     95const
     96  boGlowMask = boGlow;
     97  boLinearMultiply = boMultiply;
     98
     99const
     100  BlendOperationStr : array[TBlendOperation] of string =
     101   ('LinearBlend', 'Transparent',
     102    'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'NiceGlow',
     103    'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn',
     104    'Difference', 'LinearDifference', 'Negation', 'LinearNegation', 'Xor');
     105
     106function StrToBlendOperation(str: string): TBlendOperation;
     107
     108type
    53109  TGradientType = (gtLinear, gtReflected, gtDiamond, gtRadial);
    54 
    55110const
    56111  GradientTypeStr : array[TGradientType] of string =
    57112  ('Linear','Reflected','Diamond','Radial');
    58 
     113function StrToGradientType(str: string): TGradientType;
     114 
    59115type
    60   TRadialBlurType = (rbNormal, rbDisk, rbCorona, rbPrecise);
    61   TChannel = (cRed, cGreen, cBlue, cAlpha);
    62   TBlendOperation = (boLinearBlend, boTransparent, boMultiply,
    63     boLinearMultiply, boAdditive, boLinearAdd, boColorBurn, boColorDodge, boReflect,
    64     boGlow, boOverlay, boDifference, boLinearDifference, boNegation,
    65     boLinearNegation, boLighten, boDarken, boScreen, boXor);
    66 
     116  { A pen style is defined as a list of floating number. The first number is the length of the first dash,
     117    the second number is the length of the first gap, the third number is the length of the second dash...
     118    It must have an even number of values. }
     119  TBGRAPenStyle = Array Of Single;
     120  TRoundRectangleOption = (rrTopLeftSquare,rrTopRightSquare,rrBottomRightSquare,rrBottomLeftSquare,
     121                           rrTopLeftBevel,rrTopRightBevel,rrBottomRightBevel,rrBottomLeftBevel,rrDefault);
     122  TRoundRectangleOptions = set of TRoundRectangleOption;
     123  TPolygonOrder = (poNone, poFirstOnTop, poLastOnTop); //see TBGRAMultiShapeFiller in BGRAPolygon
     124 
     125function BGRAPenStyle(dash1, space1: single; dash2: single=0; space2: single = 0; dash3: single=0; space3: single = 0; dash4 : single = 0; space4 : single = 0): TBGRAPenStyle; 
     126 
     127{ Point, polygon and curve structures }
     128type
     129  PPointF = ^TPointF;
    67130  TPointF = record
    68131    x, y: single;
    69132  end;
    70133  ArrayOfTPointF = array of TPointF;
    71 
     134  TArcOption = (aoClosePath, aoPie, aoFillPath);
     135  TArcOptions = set of TArcOption;
     136
     137  TCubicBezierCurve = record
     138    p1,c1,c2,p2: TPointF;
     139  end;
     140  TQuadraticBezierCurve = record
     141    p1,c,p2: TPointF;
     142  end;
     143
     144  TPoint3D = record
     145    x,y,z: single;
     146  end;
     147
     148function ConcatPointsF(const APolylines: array of ArrayOfTPointF): ArrayOfTPointF;
     149
     150function Point3D(x,y,z: single): TPoint3D;
     151operator = (const v1,v2: TPoint3D): boolean; inline;
     152operator * (const v1,v2: TPoint3D): single; inline;
     153operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
     154operator - (const v1,v2: TPoint3D): TPoint3D; inline;
     155operator - (const v: TPoint3D): TPoint3D; inline;
     156operator + (const v1,v2: TPoint3D): TPoint3D; inline;
     157procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
     158procedure Normalize3D(var v: TPoint3D); inline;
     159
     160function BezierCurve(origin, control1, control2, destination: TPointF) : TCubicBezierCurve; overload;
     161function BezierCurve(origin, control, destination: TPointF) : TQuadraticBezierCurve; overload;
     162
     163{ Useful constants }
    72164const
    73165  dmFastBlend = dmLinearBlend;
    74 
    75 const
    76   EmptySingle: single = -3.402823e38;
    77 
    78 const
    79   EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38);
    80 
    81 const
     166  EmptySingle: single = -3.402823e38;                        //used as a separator in floating point lists
     167  EmptyPointF: TPointF = (x: -3.402823e38; y: -3.402823e38); //used as a separator in TPointF lists
    82168  BGRAPixelTransparent: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 0);
    83 
    84 const
    85169  BGRAWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
    86 
    87 const
    88170  BGRABlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
    89171
    90 const
     172  //Red colors
     173  CSSIndianRed: TBGRAPixel = (blue: 92; green: 92; red: 205; alpha: 255);
     174  CSSLightCoral: TBGRAPixel = (blue: 128; green: 128; red: 240; alpha: 255);
     175  CSSSalmon: TBGRAPixel = (blue: 114; green: 128; red: 250; alpha: 255);
     176  CSSDarkSalmon: TBGRAPixel = (blue: 122; green: 150; red: 233; alpha: 255);
     177  CSSRed: TBGRAPixel = (blue: 0; green: 0; red: 255; alpha: 255);
     178  CSSCrimson: TBGRAPixel = (blue: 60; green: 20; red: 220; alpha: 255);
     179  CSSFireBrick: TBGRAPixel = (blue: 34; green: 34; red: 178; alpha: 255);
     180  CSSDarkRed: TBGRAPixel = (blue: 0; green: 0; red: 139; alpha: 255);
     181
     182  //Pink colors
     183  CSSPink: TBGRAPixel = (blue: 203; green: 192; red: 255; alpha: 255);
     184  CSSLightPink: TBGRAPixel = (blue: 193; green: 182; red: 255; alpha: 255);
     185  CSSHotPink: TBGRAPixel = (blue: 180; green: 105; red: 255; alpha: 255);
     186  CSSDeepPink: TBGRAPixel = (blue: 147; green: 20; red: 255; alpha: 255);
     187  CSSMediumVioletRed: TBGRAPixel = (blue: 133; green: 21; red: 199; alpha: 255);
     188  CSSPaleVioletRed: TBGRAPixel = (blue: 147; green: 112; red: 219; alpha: 255);
     189
     190  //Orange colors
     191  CSSLightSalmon: TBGRAPixel = (blue: 122; green: 160; red: 255; alpha: 255);
     192  CSSCoral: TBGRAPixel = (blue: 80; green: 127; red: 255; alpha: 255);
     193  CSSTomato: TBGRAPixel = (blue: 71; green: 99; red: 255; alpha: 255);
     194  CSSOrangeRed: TBGRAPixel = (blue: 0; green: 69; red: 255; alpha: 255);
     195  CSSDarkOrange: TBGRAPixel = (blue: 0; green: 140; red: 255; alpha: 255);
     196  CSSOrange: TBGRAPixel = (blue: 0; green: 165; red: 255; alpha: 255);
     197
     198  //Yellow colors
     199  CSSGold: TBGRAPixel = (blue: 0; green: 215; red: 255; alpha: 255);
     200  CSSYellow: TBGRAPixel = (blue: 0; green: 255; red: 255; alpha: 255);
     201  CSSLightYellow: TBGRAPixel = (blue: 224; green: 255; red: 255; alpha: 255);
     202  CSSLemonChiffon: TBGRAPixel = (blue: 205; green: 250; red: 255; alpha: 255);
     203  CSSLightGoldenrodYellow: TBGRAPixel = (blue: 210; green: 250; red: 250; alpha: 255);
     204  CSSPapayaWhip: TBGRAPixel = (blue: 213; green: 239; red: 255; alpha: 255);
     205  CSSMoccasin: TBGRAPixel = (blue: 181; green: 228; red: 255; alpha: 255);
     206  CSSPeachPuff: TBGRAPixel = (blue: 185; green: 218; red: 255; alpha: 255);
     207  CSSPaleGoldenrod: TBGRAPixel = (blue: 170; green: 232; red: 238; alpha: 255);
     208  CSSKhaki: TBGRAPixel = (blue: 140; green: 230; red: 240; alpha: 255);
     209  CSSDarkKhaki: TBGRAPixel = (blue: 107; green: 183; red: 189; alpha: 255);
     210
     211  //Purple colors
     212  CSSLavender: TBGRAPixel = (blue: 250; green: 230; red: 230; alpha: 255);
     213  CSSThistle: TBGRAPixel = (blue: 216; green: 191; red: 216; alpha: 255);
     214  CSSPlum: TBGRAPixel = (blue: 221; green: 160; red: 221; alpha: 255);
     215  CSSViolet: TBGRAPixel = (blue: 238; green: 130; red: 238; alpha: 255);
     216  CSSOrchid: TBGRAPixel = (blue: 214; green: 112; red: 218; alpha: 255);
     217  CSSFuchsia: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
     218  CSSMagenta: TBGRAPixel = (blue: 255; green: 0; red: 255; alpha: 255);
     219  CSSMediumOrchid: TBGRAPixel = (blue: 211; green: 85; red: 186; alpha: 255);
     220  CSSMediumPurple: TBGRAPixel = (blue: 219; green: 112; red: 147; alpha: 255);
     221  CSSBlueViolet: TBGRAPixel = (blue: 226; green: 43; red: 138; alpha: 255);
     222  CSSDarkViolet: TBGRAPixel = (blue: 211; green: 0; red: 148; alpha: 255);
     223  CSSDarkOrchid: TBGRAPixel = (blue: 204; green: 50; red: 153; alpha: 255);
     224  CSSDarkMagenta: TBGRAPixel = (blue: 139; green: 0; red: 139; alpha: 255);
     225  CSSPurple: TBGRAPixel = (blue: 128; green: 0; red: 128; alpha: 255);
     226  CSSIndigo: TBGRAPixel = (blue: 130; green: 0; red: 75; alpha: 255);
     227  CSSDarkSlateBlue: TBGRAPixel = (blue: 139; green: 61; red: 72; alpha: 255);
     228  CSSSlateBlue: TBGRAPixel = (blue: 205; green: 90; red: 106; alpha: 255);
     229  CSSMediumSlateBlue: TBGRAPixel = (blue: 238; green: 104; red: 123; alpha: 255);
     230
     231  //Green colors
     232  CSSGreenYellow: TBGRAPixel = (blue: 47; green: 255; red: 173; alpha: 255);
     233  CSSChartreuse: TBGRAPixel = (blue: 0; green: 255; red: 127; alpha: 255);
     234  CSSLawnGreen: TBGRAPixel = (blue: 0; green: 252; red: 124; alpha: 255);
     235  CSSLime: TBGRAPixel = (blue: 0; green: 255; red: 0; alpha: 255);
     236  CSSLimeGreen: TBGRAPixel = (blue: 50; green: 205; red: 50; alpha: 255);
     237  CSSPaleGreen: TBGRAPixel = (blue: 152; green: 251; red: 152; alpha: 255);
     238  CSSLightGreen: TBGRAPixel = (blue: 144; green: 238; red: 144; alpha: 255);
     239  CSSMediumSpringGreen: TBGRAPixel = (blue: 154; green: 250; red: 0; alpha: 255);
     240  CSSSpringGreen: TBGRAPixel = (blue: 127; green: 255; red: 0; alpha: 255);
     241  CSSMediumSeaGreen: TBGRAPixel = (blue: 113; green: 179; red: 60; alpha: 255);
     242  CSSSeaGreen: TBGRAPixel = (blue: 87; green: 139; red: 46; alpha: 255);
     243  CSSForestGreen: TBGRAPixel = (blue: 34; green: 139; red: 34; alpha: 255);
     244  CSSGreen: TBGRAPixel = (blue: 0; green: 128; red: 0; alpha: 255);
     245  CSSDarkGreen: TBGRAPixel = (blue: 0; green: 100; red: 0; alpha: 255);
     246  CSSYellowGreen: TBGRAPixel = (blue: 50; green: 205; red: 154; alpha: 255);
     247  CSSOliveDrab: TBGRAPixel = (blue: 35; green: 142; red: 107; alpha: 255);
     248  CSSOlive: TBGRAPixel = (blue: 0; green: 128; red: 128; alpha: 255);
     249  CSSDarkOliveGreen: TBGRAPixel = (blue: 47; green: 107; red: 85; alpha: 255);
     250  CSSMediumAquamarine: TBGRAPixel = (blue: 170; green: 205; red: 102; alpha: 255);
     251  CSSDarkSeaGreen: TBGRAPixel = (blue: 143; green: 188; red: 143; alpha: 255);
     252  CSSLightSeaGreen: TBGRAPixel = (blue: 170; green: 178; red: 32; alpha: 255);
     253  CSSDarkCyan: TBGRAPixel = (blue: 139; green: 139; red: 0; alpha: 255);
     254  CSSTeal: TBGRAPixel = (blue: 128; green: 128; red: 0; alpha: 255);
     255
     256  //Blue/Cyan colors
     257  CSSAqua: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
     258  CSSCyan: TBGRAPixel = (blue: 255; green: 255; red: 0; alpha: 255);
     259  CSSLightCyan: TBGRAPixel = (blue: 255; green: 255; red: 224; alpha: 255);
     260  CSSPaleTurquoise: TBGRAPixel = (blue: 238; green: 238; red: 175; alpha: 255);
     261  CSSAquamarine: TBGRAPixel = (blue: 212; green: 255; red: 127; alpha: 255);
     262  CSSTurquoise: TBGRAPixel = (blue: 208; green: 224; red: 64; alpha: 255);
     263  CSSMediumTurquoise: TBGRAPixel = (blue: 204; green: 209; red: 72; alpha: 255);
     264  CSSDarkTurquoise: TBGRAPixel = (blue: 209; green: 206; red: 0; alpha: 255);
     265  CSSCadetBlue: TBGRAPixel = (blue: 160; green: 158; red: 95; alpha: 255);
     266  CSSSteelBlue: TBGRAPixel = (blue: 180; green: 130; red: 70; alpha: 255);
     267  CSSLightSteelBlue: TBGRAPixel = (blue: 222; green: 196; red: 176; alpha: 255);
     268  CSSPowderBlue: TBGRAPixel = (blue: 230; green: 224; red: 176; alpha: 255);
     269  CSSLightBlue: TBGRAPixel = (blue: 230; green: 216; red: 173; alpha: 255);
     270  CSSSkyBlue: TBGRAPixel = (blue: 235; green: 206; red: 135; alpha: 255);
     271  CSSLightSkyBlue: TBGRAPixel = (blue: 250; green: 206; red: 135; alpha: 255);
     272  CSSDeepSkyBlue: TBGRAPixel = (blue: 255; green: 191; red: 0; alpha: 255);
     273  CSSDodgerBlue: TBGRAPixel = (blue: 255; green: 144; red: 30; alpha: 255);
     274  CSSCornflowerBlue: TBGRAPixel = (blue: 237; green: 149; red: 100; alpha: 255);
     275  CSSRoyalBlue: TBGRAPixel = (blue: 255; green: 105; red: 65; alpha: 255);
     276  CSSBlue: TBGRAPixel = (blue: 255; green: 0; red: 0; alpha: 255);
     277  CSSMediumBlue: TBGRAPixel = (blue: 205; green: 0; red: 0; alpha: 255);
     278  CSSDarkBlue: TBGRAPixel = (blue: 139; green: 0; red: 0; alpha: 255);
     279  CSSNavy: TBGRAPixel = (blue: 128; green: 0; red: 0; alpha: 255);
     280  CSSMidnightBlue: TBGRAPixel = (blue: 112; green: 25; red: 25; alpha: 255);
     281
     282  //Brown colors
     283  CSSCornsilk: TBGRAPixel = (blue: 220; green: 248; red: 255; alpha: 255);
     284  CSSBlanchedAlmond: TBGRAPixel = (blue: 205; green: 235; red: 255; alpha: 255);
     285  CSSBisque: TBGRAPixel = (blue: 196; green: 228; red: 255; alpha: 255);
     286  CSSNavajoWhite: TBGRAPixel = (blue: 173; green: 222; red: 255; alpha: 255);
     287  CSSWheat: TBGRAPixel = (blue: 179; green: 222; red: 245; alpha: 255);
     288  CSSBurlyWood: TBGRAPixel = (blue: 135; green: 184; red: 222; alpha: 255);
     289  CSSTan: TBGRAPixel = (blue: 140; green: 180; red: 210; alpha: 255);
     290  CSSRosyBrown: TBGRAPixel = (blue: 143; green: 143; red: 188; alpha: 255);
     291  CSSSandyBrown: TBGRAPixel = (blue: 96; green: 164; red: 244; alpha: 255);
     292  CSSGoldenrod: TBGRAPixel = (blue: 32; green: 165; red: 218; alpha: 255);
     293  CSSDarkGoldenrod: TBGRAPixel = (blue: 11; green: 134; red: 184; alpha: 255);
     294  CSSPeru: TBGRAPixel = (blue: 63; green: 133; red: 205; alpha: 255);
     295  CSSChocolate: TBGRAPixel = (blue: 30; green: 105; red: 210; alpha: 255);
     296  CSSSaddleBrown: TBGRAPixel = (blue: 19; green: 69; red: 139; alpha: 255);
     297  CSSSienna: TBGRAPixel = (blue: 45; green: 82; red: 160; alpha: 255);
     298  CSSBrown: TBGRAPixel = (blue: 42; green: 42; red: 165; alpha: 255);
     299  CSSMaroon: TBGRAPixel = (blue: 0; green: 0; red: 128; alpha: 255);
     300
     301  //White colors
     302  CSSWhite: TBGRAPixel = (blue: 255; green: 255; red: 255; alpha: 255);
     303  CSSSnow: TBGRAPixel = (blue: 250; green: 250; red: 255; alpha: 255);
     304  CSSHoneydew: TBGRAPixel = (blue: 240; green: 255; red: 250; alpha: 255);
     305  CSSMintCream: TBGRAPixel = (blue: 250; green: 255; red: 245; alpha: 255);
     306  CSSAzure: TBGRAPixel = (blue: 255; green: 255; red: 240; alpha: 255);
     307  CSSAliceBlue: TBGRAPixel = (blue: 255; green: 248; red: 240; alpha: 255);
     308  CSSGhostWhite: TBGRAPixel = (blue: 255; green: 248; red: 248; alpha: 255);
     309  CSSWhiteSmoke: TBGRAPixel = (blue: 245; green: 245; red: 245; alpha: 255);
     310  CSSSeashell: TBGRAPixel = (blue: 255; green: 245; red: 238; alpha: 255);
     311  CSSBeige: TBGRAPixel = (blue: 220; green: 245; red: 245; alpha: 255);
     312  CSSOldLace: TBGRAPixel = (blue: 230; green: 245; red: 253; alpha: 255);
     313  CSSFloralWhite: TBGRAPixel = (blue: 240; green: 250; red: 255; alpha: 255);
     314  CSSIvory: TBGRAPixel = (blue: 240; green: 255; red: 255; alpha: 255);
     315  CSSAntiqueWhite: TBGRAPixel = (blue: 215; green: 235; red: 250; alpha: 255);
     316  CSSLinen: TBGRAPixel = (blue: 230; green: 240; red: 250; alpha: 255);
     317  CSSLavenderBlush: TBGRAPixel = (blue: 245; green: 240; red: 255; alpha: 255);
     318  CSSMistyRose: TBGRAPixel = (blue: 255; green: 228; red: 255; alpha: 255);
     319
     320  //Gray colors
     321  CSSGainsboro: TBGRAPixel = (blue: 220; green: 220; red: 220; alpha: 255);
     322  CSSLightGray: TBGRAPixel = (blue: 211; green: 211; red: 211; alpha: 255);
     323  CSSSilver: TBGRAPixel = (blue: 192; green: 192; red: 192; alpha: 255);
     324  CSSDarkGray: TBGRAPixel = (blue: 169; green: 169; red: 169; alpha: 255);
     325  CSSGray: TBGRAPixel = (blue: 128; green: 128; red: 128; alpha: 255);
     326  CSSDimGray: TBGRAPixel = (blue: 105; green: 105; red: 105; alpha: 255);
     327  CSSLightSlateGray: TBGRAPixel = (blue: 153; green: 136; red: 119; alpha: 255);
     328  CSSSlateGray: TBGRAPixel = (blue: 144; green: 128; red: 112; alpha: 255);
     329  CSSDarkSlateGray: TBGRAPixel = (blue: 79; green: 79; red: 47; alpha: 255);
     330  CSSBlack: TBGRAPixel = (blue: 0; green: 0; red: 0; alpha: 255);
     331
     332  { This color is needed for drawing black shapes on the standard TCanvas, because
     333    when drawing with pure black, there is no way to know if something has been
     334    drawn or if it is transparent }
    91335  clBlackOpaque = TColor($010000);
    92336
     337type
     338  TBGRAColorDefinition = record
     339    Name: string;
     340    Color: TBGRAPixel;
     341  end;
     342
     343  { TBGRAColorList }
     344
     345  TBGRAColorList = class
     346  protected
     347    FFinished: boolean;
     348    FNbColors: integer;
     349    FColors: array of TBGRAColorDefinition;
     350    function GetByIndex(Index: integer): TBGRAPixel;
     351    function GetByName(Name: string): TBGRAPixel;
     352    function GetName(Index: integer): string;
     353  public
     354    constructor Create;
     355    procedure Add(Name: string; Color: TBGRAPixel);
     356    procedure Finished;
     357    function IndexOf(Name: string): integer;
     358
     359    property ByName[Name: string]: TBGRAPixel read GetByName;
     360    property ByIndex[Index: integer]: TBGRAPixel read GetByIndex; default;
     361    property Name[Index: integer]: string read GetName;
     362    property Count: integer read FNbColors;
     363  end;
     364
     365var
     366  CSSColors: TBGRAColorList;
     367
    93368function isEmptyPointF(pt: TPointF): boolean;
    94369
     370type
     371  TFontPixelMetric = record
     372    Defined: boolean;
     373    Baseline, xLine, CapLine, DescentLine, Lineheight: integer;
     374  end;
     375
     376  { A scanner is like an image, but its content has no limit and can be calculated on the fly.
     377    It must not implement reference counting. }
     378  IBGRAScanner = interface
     379    procedure ScanMoveTo(X,Y: Integer);
     380    function ScanNextPixel: TBGRAPixel;
     381    function ScanAt(X,Y: Single): TBGRAPixel;
     382    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode);
     383    function IsScanPutPixelsDefined: boolean;
     384  end;
     385
     386  TScanAtFunction = function (X,Y: Single): TBGRAPixel of object;
     387  TScanNextPixelFunction = function: TBGRAPixel of object;
     388  TBGRACustomGradient = class;
     389
     390  { TBGRACustomBitmap }
     391
     392  TBGRACustomBitmap = class(TFPCustomImage,IBGRAScanner) // a bitmap can be used as a scanner
     393  private
     394    function GetFontAntialias: Boolean;
     395    procedure SetFontAntialias(const AValue: Boolean);
     396  protected
     397     { accessors to properies }
     398     function GetHeight: integer; virtual; abstract;
     399     function GetWidth: integer; virtual; abstract;
     400     function GetDataPtr: PBGRAPixel; virtual; abstract;
     401     function GetNbPixels: integer; virtual; abstract;
     402     function CheckEmpty: boolean; virtual; abstract;
     403     function GetHasTransparentPixels: boolean; virtual; abstract;
     404     function GetAverageColor: TColor; virtual; abstract;
     405     function GetAveragePixel: TBGRAPixel; virtual; abstract;
     406     procedure SetCanvasOpacity(AValue: byte); virtual; abstract;
     407     function GetScanLine(y: integer): PBGRAPixel; virtual; abstract;
     408     function GetRefCount: integer; virtual; abstract;
     409     function GetBitmap: TBitmap; virtual; abstract;
     410     function GetLineOrder: TRawImageLineOrder; virtual; abstract;
     411     function GetCanvasFP: TFPImageCanvas; virtual; abstract;
     412     function GetCanvasDrawModeFP: TDrawMode; virtual; abstract;
     413     procedure SetCanvasDrawModeFP(const AValue: TDrawMode); virtual; abstract;
     414     function GetCanvas: TCanvas; virtual; abstract;
     415     function GetCanvasOpacity: byte; virtual; abstract;
     416     function GetCanvasAlphaCorrection: boolean; virtual; abstract;
     417     procedure SetCanvasAlphaCorrection(const AValue: boolean); virtual; abstract;
     418     function GetFontHeight: integer; virtual; abstract;
     419     procedure SetFontHeight(AHeight: integer); virtual; abstract;
     420     function GetFontFullHeight: integer; virtual; abstract;
     421     procedure SetFontFullHeight(AHeight: integer); virtual; abstract;
     422     function GetPenStyle: TPenStyle; virtual; abstract;
     423     procedure SetPenStyle(const AValue: TPenStyle); virtual; abstract;
     424     function GetCustomPenStyle: TBGRAPenStyle; virtual; abstract;
     425     procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); virtual; abstract;
     426     function GetClipRect: TRect; virtual; abstract;
     427     procedure SetClipRect(const AValue: TRect); virtual; abstract;
     428     function GetFontPixelMetric: TFontPixelMetric; virtual; abstract;
     429     function LoadAsBmp32(Str: TStream): boolean; virtual; abstract;
     430
     431  public
     432     Caption:   string;  //user defined caption
     433
     434     //font style
     435     FontName:  string;
     436     FontStyle: TFontStyles;
     437     FontQuality : TBGRAFontQuality;
     438     FontOrientation: integer;
     439
     440     //line style
     441     LineCap:   TPenEndCap;
     442     JoinStyle: TPenJoinStyle;
     443     JoinMiterLimit: single;
     444
     445     FillMode:  TFillMode;  //winding or alternate
     446
     447     { The resample filter is used when resizing the bitmap, and
     448       scan interpolation filter is used when the bitmap is used
     449       as a scanner (IBGRAScanner) }
     450     ResampleFilter,
     451     ScanInterpolationFilter: TResampleFilter;
     452     ScanOffset: TPoint;
     453
     454     constructor Create; virtual; abstract; overload;
     455     constructor Create(ABitmap: TBitmap); virtual; abstract; overload;
     456     constructor Create(AWidth, AHeight: integer; Color: TColor); virtual; abstract; overload;
     457     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); virtual; abstract; overload;
     458     constructor Create(AFilename: string); virtual; abstract; overload;
     459     constructor Create(AStream: TStream); virtual; abstract; overload;
     460
     461     function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; virtual; abstract; overload;
     462     function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; virtual; abstract; overload;
     463     function NewBitmap(Filename: string): TBGRACustomBitmap; virtual; abstract; overload;
     464
     465     procedure LoadFromFile(const filename: string); virtual;
     466     procedure LoadFromStream(Str: TStream); virtual;
     467     procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader); virtual;
     468     procedure SaveToFile(const filename: string); virtual;
     469     procedure SaveToFile(const filename: string; Handler:TFPCustomImageWriter); virtual;
     470     procedure SaveToStreamAsPng(Str: TStream); virtual; abstract;
     471     procedure Assign(ABitmap: TBitmap); virtual; abstract; overload;
     472     procedure Assign(MemBitmap: TBGRACustomBitmap); virtual; abstract; overload;
     473     procedure Serialize(AStream: TStream); virtual; abstract;
     474     procedure Deserialize(AStream: TStream); virtual; abstract;
     475
     476     {Pixel functions}
     477     procedure SetPixel(x, y: integer; c: TColor); virtual; abstract; overload;
     478     procedure XorPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
     479     procedure SetPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
     480     procedure DrawPixel(x, y: integer; c: TBGRAPixel); virtual; abstract; overload;
     481     procedure DrawPixel(x, y: integer; ec: TExpandedPixel); virtual; abstract; overload;
     482     procedure FastBlendPixel(x, y: integer; c: TBGRAPixel); virtual; abstract;
     483     procedure ErasePixel(x, y: integer; alpha: byte); virtual; abstract;
     484     procedure AlphaPixel(x, y: integer; alpha: byte); virtual; abstract;
     485     function GetPixel(x, y: integer): TBGRAPixel; virtual; abstract;
     486     function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
     487     function GetPixelCycle(x, y: integer): TBGRAPixel; virtual;
     488     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; virtual; abstract; overload;
     489     function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; virtual; abstract; overload;
     490
     491     {Line primitives}
     492     procedure SetHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
     493     procedure XorHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
     494     procedure DrawHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract; overload;
     495     procedure DrawHorizLine(x, y, x2: integer; ec: TExpandedPixel); virtual; abstract; overload;
     496     procedure DrawHorizLine(x, y, x2: integer; texture: IBGRAScanner); virtual; abstract; overload;
     497     procedure FastBlendHorizLine(x, y, x2: integer; c: TBGRAPixel); virtual; abstract;
     498     procedure AlphaHorizLine(x, y, x2: integer; alpha: byte); virtual; abstract;
     499     procedure SetVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
     500     procedure XorVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
     501     procedure DrawVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
     502     procedure AlphaVertLine(x, y, y2: integer; alpha: byte); virtual; abstract;
     503     procedure FastBlendVertLine(x, y, y2: integer; c: TBGRAPixel); virtual; abstract;
     504     procedure DrawHorizLineDiff(x, y, x2: integer; c, compare: TBGRAPixel;
     505       maxDiff: byte); virtual; abstract;
     506
     507     {Shapes}
     508     procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract;
     509     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); virtual; abstract; overload;
     510     procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; abstract; overload;
     511     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); virtual; abstract; overload;
     512     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
     513     procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
     514     procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; Closed: boolean); virtual; abstract; overload;
     515
     516     procedure DrawPolyLineAntialias(const points: array of TPoint; c: TBGRAPixel; DrawLastPixel: boolean); virtual; overload;
     517     procedure DrawPolyLineAntialias(const points: array of TPoint; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); virtual; overload;
     518     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); virtual; abstract; overload;
     519     procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
     520     procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; Closed: boolean); virtual; abstract; overload;
     521     procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); virtual; abstract; overload;
     522     procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); virtual; abstract; overload;
     523     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); virtual; abstract; overload;
     524     procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); virtual; abstract; overload;
     525     procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); virtual; abstract; overload;
     526
     527     procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
     528     procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); virtual; abstract; overload;
     529     procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); virtual; abstract; overload;
     530     procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
     531     procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); virtual; abstract; overload;
     532
     533     procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
     534     procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); virtual; abstract; overload;
     535     procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True);  virtual; abstract; overload;
     536     procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); virtual; abstract; overload;
     537     procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
     538     procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
     539     procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); virtual; abstract; overload;
     540
     541     procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel);  virtual; abstract; overload;
     542     procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); virtual; abstract; overload;
     543     procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); virtual; abstract; overload;
     544     procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); virtual; abstract; overload;
     545     procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); virtual; abstract; overload;
     546
     547     procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode); virtual; abstract;
     548     procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode); virtual; abstract;
     549     procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel); virtual; abstract;
     550     procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner); virtual; abstract;
     551     procedure ErasePoly(const points: array of TPointF; alpha: byte); virtual; abstract;
     552     procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte); virtual; abstract;
     553
     554     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); virtual; abstract;
     555     procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); virtual; abstract;
     556     procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract;
     557     procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); virtual; abstract;
     558     procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); virtual; abstract;
     559     procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); virtual; abstract;
     560     procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); virtual; abstract;
     561
     562     procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
     563     procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
     564     procedure Rectangle(x, y, x2, y2: integer; c: TColor); virtual; overload;
     565     procedure Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
     566     procedure Rectangle(r: TRect; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); virtual;overload;
     567     procedure Rectangle(r: TRect; c: TColor); virtual; overload;
     568     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single); virtual; overload;
     569     procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); virtual; abstract; overload;
     570     procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); virtual; abstract; overload;
     571
     572     procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel); virtual; abstract;
     573     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
     574     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
     575     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
     576     procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); virtual; abstract;
     577     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []); virtual; abstract;
     578     procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []); virtual; abstract;
     579     procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []); virtual; abstract;
     580
     581     procedure FillRect(r: TRect; c: TColor); virtual; overload;
     582     procedure FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode); virtual; overload;
     583     procedure FillRect(x, y, x2, y2: integer; c: TColor); virtual; overload;
     584     procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); virtual; abstract; overload;
     585     procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode); virtual; abstract;
     586     procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel); virtual; abstract;
     587     procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner); virtual; abstract;
     588     procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte); virtual; abstract;
     589     procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); virtual; abstract;
     590
     591     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract; overload;
     592     procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract; overload;
     593     procedure TextOutAngle(x, y, orientation: integer; s: string; c: TBGRAPixel; align: TAlignment); virtual; abstract;
     594     procedure TextOutAngle(x, y, orientation: integer; s: string; texture: IBGRAScanner; align: TAlignment); virtual; abstract;
     595     procedure TextOut(x, y: integer; s: string; c: TBGRAPixel); virtual; overload;
     596     procedure TextOut(x, y: integer; s: string; c: TColor); virtual; overload;
     597     procedure TextOut(x, y: integer; s: string; texture: IBGRAScanner); virtual; overload;
     598     procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; c: TBGRAPixel); virtual; abstract; overload;
     599     procedure TextRect(ARect: TRect; x, y: integer; s: string; style: TTextStyle; texture: IBGRAScanner); virtual; abstract; overload;
     600     procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; c: TBGRAPixel); virtual; overload;
     601     procedure TextRect(ARect: TRect; s: string; halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner); virtual; overload;
     602     function TextSize(s: string): TSize; virtual; abstract;
     603
     604     {Spline}
     605     function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
     606     function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; virtual; abstract;
     607     function ComputeBezierCurve(const curve: TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
     608     function ComputeBezierCurve(const curve: TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
     609     function ComputeBezierSpline(const spline: array of TCubicBezierCurve): ArrayOfTPointF; virtual; abstract;
     610     function ComputeBezierSpline(const spline: array of TQuadraticBezierCurve): ArrayOfTPointF; virtual; abstract;
     611
     612     function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
     613     function ComputeWidePolyline(const points: array of TPointF; w: single; Closed: boolean): ArrayOfTPointF; virtual; abstract;
     614     function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; virtual; abstract;
     615
     616     function ComputeEllipse(x,y,rx,ry: single): ArrayOfTPointF; virtual; abstract;
     617     function ComputeEllipse(x,y,rx,ry,w: single): ArrayOfTPointF; virtual; abstract;
     618     function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; virtual; abstract;
     619     function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; virtual; abstract;
     620     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single): ArrayOfTPointF; virtual; abstract;
     621     function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions): ArrayOfTPointF; virtual; abstract;
     622     function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word): ArrayOfTPointF; virtual; abstract;
     623     function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single): ArrayOfTPointF; virtual; abstract;
     624
     625     {Filling}
     626     procedure FillTransparent; virtual;
     627     procedure NoClip; virtual; abstract;
     628     procedure ApplyGlobalOpacity(alpha: byte); virtual; abstract;
     629     procedure Fill(c: TColor); virtual; overload;
     630     procedure Fill(c: TBGRAPixel); virtual; overload;
     631     procedure Fill(texture: IBGRAScanner; mode: TDrawMode); virtual; abstract; overload;
     632     procedure Fill(texture: IBGRAScanner); virtual; abstract; overload;
     633     procedure Fill(c: TBGRAPixel; start, Count: integer); virtual; abstract; overload;
     634     procedure DrawPixels(c: TBGRAPixel; start, Count: integer); virtual; abstract;
     635     procedure AlphaFill(alpha: byte); virtual; overload;
     636     procedure AlphaFill(alpha: byte; start, Count: integer); virtual; abstract; overload;
     637     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel); virtual; abstract; overload;
     638     procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner); virtual; abstract; overload;
     639     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); virtual; abstract; overload;
     640     procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); virtual; abstract; overload;
     641     procedure ReplaceColor(before, after: TColor); virtual; abstract; overload;
     642     procedure ReplaceColor(before, after: TBGRAPixel); virtual; abstract; overload;
     643     procedure ReplaceTransparent(after: TBGRAPixel); virtual; abstract; overload;
     644     procedure FloodFill(X, Y: integer; Color: TBGRAPixel;
     645       mode: TFloodfillMode; Tolerance: byte = 0); virtual;
     646     procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
     647       mode: TFloodfillMode; Tolerance: byte = 0); virtual; abstract;
     648     procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
     649       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
     650       gammaColorCorrection: boolean = True; Sinus: Boolean=False); virtual; abstract;
     651     procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
     652       gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
     653       Sinus: Boolean=False); virtual; abstract;
     654     function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
     655                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; virtual; abstract;
     656
     657     {Canvas drawing functions}
     658     procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
     659       AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
     660     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
     661       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); virtual; abstract;
     662     procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); virtual; abstract;
     663     procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); virtual; abstract;
     664     procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); virtual; abstract;
     665     procedure DrawPart(ARect: TRect; Canvas: TCanvas; x, y: integer; Opaque: boolean); virtual;
     666     function GetPart(ARect: TRect): TBGRACustomBitmap; virtual; abstract;
     667     function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; virtual; abstract;
     668     procedure InvalidateBitmap; virtual; abstract;         //call if you modify with Scanline
     669     procedure LoadFromBitmapIfNeeded; virtual; abstract;   //call to ensure that bitmap data is up to date
     670
     671     {BGRA bitmap functions}
     672     procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); virtual; abstract;
     673     procedure PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
     674     procedure PutImageAffine(Origin,HAxis,VAxis: TPointF; Source: TBGRACustomBitmap; AOpacity: Byte=255); virtual; abstract;
     675     procedure PutImageAngle(x,y: single; Source: TBGRACustomBitmap; angle: single; imageCenterX: single = 0; imageCenterY: single = 0; AOpacity: Byte=255); virtual; abstract;
     676     procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap;
     677       operation: TBlendOperation); virtual; abstract;
     678     function Duplicate(DuplicateProperties: Boolean = False): TBGRACustomBitmap; virtual; abstract;
     679     function Equals(comp: TBGRACustomBitmap): boolean; virtual; abstract;
     680     function Equals(comp: TBGRAPixel): boolean; virtual; abstract;
     681     function Resample(newWidth, newHeight: integer;
     682       mode: TResampleMode = rmFineResample): TBGRACustomBitmap; virtual; abstract;
     683     procedure VerticalFlip; virtual; abstract;
     684     procedure HorizontalFlip; virtual; abstract;
     685     function RotateCW: TBGRACustomBitmap; virtual; abstract;
     686     function RotateCCW: TBGRACustomBitmap; virtual; abstract;
     687     procedure Negative; virtual; abstract;
     688     procedure LinearNegative; virtual; abstract;
     689     procedure SwapRedBlue; virtual; abstract;
     690     procedure GrayscaleToAlpha; virtual; abstract;
     691     procedure AlphaToGrayscale; virtual; abstract;
     692     procedure ApplyMask(mask: TBGRACustomBitmap); virtual; abstract;
     693     function GetImageBounds(Channel: TChannel = cAlpha): TRect; virtual; abstract;
     694     function GetImageBounds(Channels: TChannels): TRect; virtual; abstract;
     695     function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; virtual; abstract;
     696
     697     {Filters}
     698     function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
     699     function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; virtual; abstract;
     700     function FilterSmooth: TBGRACustomBitmap; virtual; abstract;
     701     function FilterSharpen: TBGRACustomBitmap; virtual; abstract;
     702     function FilterContour: TBGRACustomBitmap; virtual; abstract;
     703     function FilterBlurRadial(radius: integer;
     704       blurType: TRadialBlurType): TBGRACustomBitmap; virtual; abstract;
     705     function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; virtual; abstract;
     706     function FilterBlurMotion(distance: integer; angle: single;
     707       oriented: boolean): TBGRACustomBitmap; virtual; abstract;
     708     function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; virtual; abstract;
     709     function FilterEmboss(angle: single): TBGRACustomBitmap; virtual; abstract;
     710     function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; virtual; abstract;
     711     function FilterGrayscale: TBGRACustomBitmap; virtual; abstract;
     712     function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; virtual; abstract;
     713     function FilterRotate(origin: TPointF; angle: single): TBGRACustomBitmap; virtual; abstract;
     714     function FilterSphere: TBGRACustomBitmap; virtual; abstract;
     715     function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; virtual; abstract;
     716     function FilterCylinder: TBGRACustomBitmap; virtual; abstract;
     717     function FilterPlane: TBGRACustomBitmap; virtual; abstract;
     718
     719     property Data: PBGRAPixel Read GetDataPtr;
     720     property Width: integer Read GetWidth;
     721     property Height: integer Read GetHeight;
     722     property NbPixels: integer Read GetNbPixels;
     723     property Empty: boolean Read CheckEmpty;
     724
     725     property ScanLine[y: integer]: PBGRAPixel Read GetScanLine;
     726     property RefCount: integer Read GetRefCount;
     727     property Bitmap: TBitmap Read GetBitmap; //don't forget to call InvalidateBitmap before if you changed something with Scanline
     728     property HasTransparentPixels: boolean Read GetHasTransparentPixels;
     729     property AverageColor: TColor Read GetAverageColor;
     730     property AveragePixel: TBGRAPixel Read GetAveragePixel;
     731     property LineOrder: TRawImageLineOrder Read GetLineOrder;
     732     property CanvasFP: TFPImageCanvas read GetCanvasFP;
     733     property CanvasDrawModeFP: TDrawMode read GetCanvasDrawModeFP write SetCanvasDrawModeFP;
     734     property Canvas: TCanvas Read GetCanvas;
     735     property CanvasOpacity: byte Read GetCanvasOpacity Write SetCanvasOpacity;
     736     property CanvasAlphaCorrection: boolean
     737       Read GetCanvasAlphaCorrection Write SetCanvasAlphaCorrection;
     738
     739     property FontHeight: integer Read GetFontHeight Write SetFontHeight;
     740     property PenStyle: TPenStyle read GetPenStyle Write SetPenStyle;
     741     property CustomPenStyle: TBGRAPenStyle read GetCustomPenStyle write SetCustomPenStyle;
     742     property ClipRect: TRect read GetClipRect write SetClipRect;
     743     property FontAntialias: Boolean read GetFontAntialias write SetFontAntialias; //antialiasing (it's different from TFont antialiasing mode)
     744     property FontFullHeight: integer read GetFontFullHeight write SetFontFullHeight;
     745     property FontPixelMetric: TFontPixelMetric read GetFontPixelMetric;
     746
     747     //interface
     748     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};
     749     function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     750     function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     751
     752     //IBGRAScanner
     753     procedure ScanMoveTo(X,Y: Integer); virtual; abstract;
     754     function ScanNextPixel: TBGRAPixel; virtual; abstract;
     755     function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
     756     procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
     757     function IsScanPutPixelsDefined: boolean; virtual;
     758  end;
     759
     760  { TBGRACustomScanner }
     761
     762  TBGRACustomScanner = class(IBGRAScanner)
     763  private
     764    FCurX,FCurY: integer;
     765  public
     766    procedure ScanMoveTo(X,Y: Integer); virtual;
     767    function ScanNextPixel: TBGRAPixel; virtual;
     768    function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
     769    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
     770    function IsScanPutPixelsDefined: boolean; virtual;
     771    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};
     772    function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     773    function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     774  end;
     775
     776  TBGRACustomGradient = class
     777  public
     778    function GetColorAt(position: integer): TBGRAPixel; virtual; abstract;
     779    function GetAverageColor: TBGRAPixel; virtual; abstract;
     780    function GetMonochrome: boolean; virtual; abstract;
     781    property Monochrome: boolean read GetMonochrome;
     782  end;
     783
     784type
     785  TBGRABitmapAny = class of TBGRACustomBitmap;  //used to create instances of the same type (see NewBitmap)
     786
     787var
     788  BGRABitmapFactory : TBGRABitmapAny;
     789
     790{ Color functions }
    95791function GetIntensity(c: TExpandedPixel): word; inline;
    96792function SetIntensity(c: TExpandedPixel; intensity: word): TExpandedPixel;
    97793function GetLightness(c: TExpandedPixel): word; inline;
    98794function SetLightness(c: TExpandedPixel; lightness: word): TExpandedPixel;
     795function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
    99796function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
     797function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
    100798function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
     799function GtoH(ghue: word): word;
     800function HtoG(hue: word): word;
     801function HueDiff(h1, h2: word): word;
     802function GetHue(ec: TExpandedPixel): word;
     803function ColorImportance(ec: TExpandedPixel): word;
     804function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
     805function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
    101806function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
    102807function GammaCompression(ec: TExpandedPixel): TBGRAPixel; inline;
     808function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline;
    103809function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
    104 function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
     810function GrayscaleToBGRA(lightness: word): TBGRAPixel;
     811function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload;
     812function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload;
     813function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload;
    105814function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline;
    106815function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline;
    107816function ColorToBGRA(color: TColor): TBGRAPixel; overload;
    108817function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload;
     818function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
     819function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
    109820function BGRAToColor(c: TBGRAPixel): TColor;
    110821operator = (const c1, c2: TBGRAPixel): boolean; inline;
    111 
     822function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
     823function BGRAWordDiff(c1, c2: TBGRAPixel): word;
    112824function BGRADiff(c1, c2: TBGRAPixel): byte;
    113 function PointF(x, y: single): TPointF;
    114 
    115 function PtInRect(pt: TPoint; r: TRect): boolean;
    116 
    117 function StrToGradientType(str: string): TGradientType;
     825operator - (const c1, c2: TColorF): TColorF; inline;
     826operator + (const c1, c2: TColorF): TColorF; inline;
     827operator * (const c1, c2: TColorF): TColorF; inline;
     828operator * (const c1: TColorF; factor: single): TColorF; inline;
     829function ColorF(red,green,blue,alpha: single): TColorF;
    118830function BGRAToStr(c: TBGRAPixel): string;
    119831function StrToBGRA(str: string): TBGRAPixel;
    120832
     833{ Get height [0..1] stored in a TBGRAPixel }
     834function MapHeight(Color: TBGRAPixel): Single;
     835
     836{ Get TBGRAPixel to store height [0..1] }
     837function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
     838
     839
     840{ Gamma conversion arrays. Should be used as readonly }
    121841var
     842  // TBGRAPixel -> TExpandedPixel
    122843  GammaExpansionTab:   packed array[0..255] of word;
     844 
     845  // TExpandedPixel -> TBGRAPixel
    123846  GammaCompressionTab: packed array[0..65535] of byte;
    124847
     848{ Point functions }
     849function PointF(x, y: single): TPointF;
     850function PointsF(const pts: array of TPointF): ArrayOfTPointF;
     851operator = (const pt1, pt2: TPointF): boolean; inline;
     852operator - (const pt1, pt2: TPointF): TPointF; inline;
     853operator - (const pt2: TPointF): TPointF; inline;
     854operator + (const pt1, pt2: TPointF): TPointF; inline;
     855operator * (const pt1, pt2: TPointF): single; inline; //scalar product
     856operator * (const pt1: TPointF; factor: single): TPointF; inline;
     857operator * (factor: single; const pt1: TPointF): TPointF; inline;
     858function PtInRect(pt: TPoint; r: TRect): boolean;
     859function VectLen(dx,dy: single): single; overload;
     860function VectLen(v: TPointF): single; overload;
     861
     862{ Line and polygon functions }
     863type
     864    TLineDef = record
     865       origin, dir: TPointF;
     866    end;
     867
     868function IntersectLine(line1, line2: TLineDef): TPointF;
     869function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
     870function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
     871function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
     872function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
     873
     874{ Cyclic functions }
     875function PositiveMod(value, cycle: integer): integer; inline;
     876
     877{ Sin65536 and Cos65536 are fast routines to compute sine and cosine as integer values.
     878  They use a table to store already computed values. The return value is an integer
     879  ranging from 0 to 65536, so the mean value is 32768 and the half amplitude is
     880  32768 instead of 1. The input has a period of 65536, so you can supply any integer
     881  without applying a modulo. }
     882procedure PrecalcSin65536; // compute all values now
     883function Sin65536(value: word): integer; inline;
     884function Cos65536(value: word): integer; inline;
     885
    125886implementation
    126887
    127888uses Math, SysUtils;
    128889
     890function StrToBlendOperation(str: string): TBlendOperation;
     891var op: TBlendOperation;
     892begin
     893  result := boTransparent;
     894  str := LowerCase(str);
     895  for op := low(TBlendOperation) to high(TBlendOperation) do
     896    if str = LowerCase(BlendOperationStr[op]) then
     897    begin
     898      result := op;
     899      exit;
     900    end;
     901end;
     902
     903function StrToGradientType(str: string): TGradientType;
     904var gt: TGradientType;
     905begin
     906  result := gtLinear;
     907  str := LowerCase(str);
     908  for gt := low(TGradientType) to high(TGradientType) do
     909    if str = LowerCase(GradientTypeStr[gt]) then
     910    begin
     911      result := gt;
     912      exit;
     913    end;
     914end;
     915
     916{ Make a pen style. Need an even number of values. See TBGRAPenStyle }
     917function BGRAPenStyle(dash1, space1: single; dash2: single; space2: single;
     918  dash3: single; space3: single; dash4: single; space4: single): TBGRAPenStyle;
     919var
     920  i: Integer;
     921begin
     922  if dash4 <> 0 then
     923  begin
     924    setlength(result,8);
     925    result[6] := dash4;
     926    result[7] := space4;
     927    result[4] := dash3;
     928    result[5] := space3;
     929    result[2] := dash2;
     930    result[3] := space2;
     931  end else
     932  if dash3 <> 0 then
     933  begin
     934    setlength(result,6);
     935    result[4] := dash3;
     936    result[5] := space3;
     937    result[2] := dash2;
     938    result[3] := space2;
     939  end else
     940  if dash2 <> 0 then
     941  begin
     942    setlength(result,4);
     943    result[2] := dash2;
     944    result[3] := space2;
     945  end else
     946  begin
     947    setlength(result,2);
     948  end;
     949  result[0] := dash1;
     950  result[1] := space1;
     951  for i := 0 to high(result) do
     952    if result[i]=0 then
     953      raise exception.Create('Zero is not a valid value');
     954end;
     955
     956{ Bézier curves definitions. See : http://en.wikipedia.org/wiki/B%C3%A9zier_curve }
     957
     958function ConcatPointsF(const APolylines: array of ArrayOfTPointF
     959  ): ArrayOfTPointF;
     960var
     961  i,pos,count:integer;
     962  j: Integer;
     963begin
     964  count := 0;
     965  for i := 0 to high(APolylines) do
     966    inc(count,length(APolylines[i]));
     967  setlength(result,count);
     968  pos := 0;
     969  for i := 0 to high(APolylines) do
     970    for j := 0 to high(APolylines[i]) do
     971    begin
     972      result[pos] := APolylines[i][j];
     973      inc(pos);
     974    end;
     975end;
     976
     977operator-(const v: TPoint3D): TPoint3D;
     978begin
     979  result.x := -v.x;
     980  result.y := -v.y;
     981  result.z := -v.z;
     982end;
     983
     984operator + (const v1,v2: TPoint3D): TPoint3D; inline;
     985begin
     986  result.x := v1.x+v2.x;
     987  result.y := v1.y+v2.y;
     988  result.z := v1.z+v2.z;
     989end;
     990
     991operator - (const v1,v2: TPoint3D): TPoint3D; inline;
     992begin
     993  result.x := v1.x-v2.x;
     994  result.y := v1.y-v2.y;
     995  result.z := v1.z-v2.z;
     996end;
     997
     998operator * (const v1: TPoint3D; const factor: single): TPoint3D; inline;
     999begin
     1000  result.x := v1.x*factor;
     1001  result.y := v1.y*factor;
     1002  result.z := v1.z*factor;
     1003end;
     1004
     1005function Point3D(x, y, z: single): TPoint3D;
     1006begin
     1007  result.x := x;
     1008  result.y := y;
     1009  result.z := z;
     1010end;
     1011
     1012operator=(const v1, v2: TPoint3D): boolean;
     1013begin
     1014  result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z);
     1015end;
     1016
     1017operator * (const v1,v2: TPoint3D): single; inline;
     1018begin
     1019  result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
     1020end;
     1021
     1022procedure Normalize3D(var v: TPoint3D); inline;
     1023var len: double;
     1024begin
     1025  len := v*v;
     1026  if len = 0 then exit;
     1027  len := sqrt(len);
     1028  v.x /= len;
     1029  v.y /= len;
     1030  v.z /= len;
     1031end;
     1032
     1033procedure VectProduct3D(u,v: TPoint3D; out w: TPoint3D);
     1034begin
     1035  w.x := u.y*v.z-u.z*v.y;
     1036  w.y := u.z*v.x-u.x*v.z;
     1037  w.z := u.x*v.Y-u.y*v.x;
     1038end;
     1039
     1040// Define a Bézier curve with two control points.
     1041function BezierCurve(origin, control1, control2, destination: TPointF): TCubicBezierCurve;
     1042begin
     1043  result.p1 := origin;
     1044  result.c1 := control1;
     1045  result.c2 := control2;
     1046  result.p2 := destination;
     1047end;
     1048
     1049// Define a Bézier curve with one control point.
     1050function BezierCurve(origin, control, destination: TPointF
     1051  ): TQuadraticBezierCurve;
     1052begin
     1053  result.p1 := origin;
     1054  result.c := control;
     1055  result.p2 := destination;
     1056end;
     1057
     1058{ Check if a PointF structure is empty or should be treated as a list separator }
    1291059function isEmptyPointF(pt: TPointF): boolean;
    1301060begin
    … …  
    1321062end;
    1331063
     1064{ TBGRAColorList }
     1065
     1066function TBGRAColorList.GetByIndex(Index: integer): TBGRAPixel;
     1067begin
     1068  if (Index < 0) or (Index >= FNbColors) then
     1069    result := BGRAPixelTransparent
     1070  else
     1071    result := FColors[Index].Color;
     1072end;
     1073
     1074function TBGRAColorList.GetByName(Name: string): TBGRAPixel;
     1075var i: integer;
     1076begin
     1077  i := IndexOf(Name);
     1078  if i = -1 then
     1079    result := BGRAPixelTransparent
     1080  else
     1081    result := FColors[i].Color;
     1082end;
     1083
     1084function TBGRAColorList.GetName(Index: integer): string;
     1085begin
     1086  if (Index < 0) or (Index >= FNbColors) then
     1087    result := ''
     1088  else
     1089    result := FColors[Index].Name;
     1090end;
     1091
     1092constructor TBGRAColorList.Create;
     1093begin
     1094  FNbColors:= 0;
     1095  FColors := nil;
     1096  FFinished:= false;
     1097end;
     1098
     1099procedure TBGRAColorList.Add(Name: string; Color: TBGRAPixel);
     1100begin
     1101  if FFinished then
     1102    raise Exception.Create('This list is already finished');
     1103  if length(FColors) = FNbColors then
     1104    SetLength(FColors, FNbColors*2+1);
     1105  FColors[FNbColors].Name := Name;
     1106  FColors[FNbColors].Color := Color;
     1107  inc(FNbColors);
     1108end;
     1109
     1110procedure TBGRAColorList.Finished;
     1111begin
     1112  if FFinished then exit;
     1113  FFinished := true;
     1114  SetLength(FColors, FNbColors);
     1115end;
     1116
     1117function TBGRAColorList.IndexOf(Name: string): integer;
     1118var i: integer;
     1119begin
     1120  for i := 0 to FNbColors-1 do
     1121    if CompareText(Name, FColors[i].Name) = 0 then
     1122    begin
     1123      result := i;
     1124      exit;
     1125    end;
     1126  result := -1;
     1127end;
     1128
     1129{ TBGRACustomBitmap }
     1130
     1131function TBGRACustomBitmap.GetFontAntialias: Boolean;
     1132begin
     1133  result := FontQuality <> fqSystem;
     1134end;
     1135
     1136procedure TBGRACustomBitmap.SetFontAntialias(const AValue: Boolean);
     1137begin
     1138  if AValue and not FontAntialias then
     1139    FontQuality := fqFineAntialiasing
     1140  else if not AValue and (FontQuality <> fqSystem) then
     1141    FontQuality := fqSystem;
     1142end;
     1143
     1144{ These declaration make sure that these methods are virtual }
     1145procedure TBGRACustomBitmap.LoadFromFile(const filename: string);
     1146begin
     1147  inherited LoadFromFile(filename);
     1148end;
     1149
     1150procedure TBGRACustomBitmap.SaveToFile(const filename: string);
     1151begin
     1152  inherited SaveToFile(filename);
     1153end;
     1154
     1155procedure TBGRACustomBitmap.SaveToFile(const filename: string;
     1156  Handler: TFPCustomImageWriter);
     1157begin
     1158  inherited SaveToFile(filename, Handler);
     1159end;
     1160
     1161{ LoadFromStream uses TFPCustomImage routine, which uses
     1162  Colors property to access pixels. That's why the
     1163  FP drawing mode is temporarily changed to load
     1164  bitmaps properly }
     1165procedure TBGRACustomBitmap.LoadFromStream(Str: TStream);
     1166var
     1167  OldDrawMode: TDrawMode;
     1168begin
     1169  OldDrawMode := CanvasDrawModeFP;
     1170  CanvasDrawModeFP := dmSet;
     1171  try
     1172    if not LoadAsBmp32(Str) then
     1173      inherited LoadFromStream(Str);
     1174  finally
     1175    CanvasDrawModeFP := OldDrawMode;
     1176  end;
     1177end;
     1178
     1179{ See above }
     1180procedure TBGRACustomBitmap.LoadFromStream(Str: TStream;
     1181  Handler: TFPCustomImageReader);
     1182var
     1183  OldDrawMode: TDrawMode;
     1184begin
     1185  OldDrawMode := CanvasDrawModeFP;
     1186  CanvasDrawModeFP := dmSet;
     1187  try
     1188    inherited LoadFromStream(Str, Handler);
     1189  finally
     1190    CanvasDrawModeFP := OldDrawMode;
     1191  end;
     1192end;
     1193
     1194{ Look for a pixel considering the bitmap is repeated in both directions }
     1195function TBGRACustomBitmap.GetPixelCycle(x, y: integer): TBGRAPixel;
     1196begin
     1197  if (Width = 0) or (Height = 0) then
     1198    Result := BGRAPixelTransparent
     1199  else
     1200    Result := (Scanline[PositiveMod(y,Height)] + PositiveMod(x,Width))^;
     1201end;
     1202
     1203{ Pixel polylines are constructed by concatenation }
     1204procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint;
     1205  c: TBGRAPixel; DrawLastPixel: boolean);
     1206var i: integer;
     1207begin
     1208   if length(points) = 1 then
     1209   begin
     1210     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c);
     1211   end
     1212   else
     1213     for i := 0 to high(points)-1 do
     1214       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c,DrawLastPixel and (i=high(points)-1));
     1215end;
     1216
     1217procedure TBGRACustomBitmap.DrawPolyLineAntialias(const points: array of TPoint; c1,
     1218  c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
     1219var i: integer;
     1220begin
     1221   if length(points) = 1 then
     1222   begin
     1223     if DrawLastPixel then DrawPixel(points[0].x,points[0].y,c1);
     1224   end
     1225   else
     1226     for i := 0 to high(points)-1 do
     1227       DrawLineAntialias(points[i].x,points[i].Y,points[i+1].x,points[i+1].y,c1,c2,dashLen,DrawLastPixel and (i=high(points)-1));
     1228end;
     1229
     1230{ Following functions are defined for convenience }
     1231procedure TBGRACustomBitmap.Rectangle(x, y, x2, y2: integer; c: TColor);
     1232begin
     1233  Rectangle(x, y, x2, y2, ColorToBGRA(c), dmSet);
     1234end;
     1235
     1236procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TBGRAPixel; mode: TDrawMode
     1237  );
     1238begin
     1239  Rectangle(r.left, r.top, r.right, r.bottom, c, mode);
     1240end;
     1241
     1242procedure TBGRACustomBitmap.Rectangle(r: TRect; BorderColor,
     1243  FillColor: TBGRAPixel; mode: TDrawMode);
     1244begin
     1245  Rectangle(r.left, r.top, r.right, r.bottom, BorderColor, FillColor, mode);
     1246end;
     1247
     1248procedure TBGRACustomBitmap.Rectangle(r: TRect; c: TColor);
     1249begin
     1250  Rectangle(r.left, r.top, r.right, r.bottom, c);
     1251end;
     1252
     1253procedure TBGRACustomBitmap.RectangleAntialias(x, y, x2, y2: single;
     1254  c: TBGRAPixel; w: single);
     1255begin
     1256  RectangleAntialias(x, y, x2, y2, c, w, BGRAPixelTransparent);
     1257end;
     1258
     1259procedure TBGRACustomBitmap.FillRect(r: TRect; c: TColor);
     1260begin
     1261  FillRect(r.Left, r.top, r.right, r.bottom, c);
     1262end;
     1263
     1264procedure TBGRACustomBitmap.FillRect(r: TRect; c: TBGRAPixel; mode: TDrawMode);
     1265begin
     1266  FillRect(r.Left, r.top, r.right, r.bottom, c, mode);
     1267end;
     1268
     1269procedure TBGRACustomBitmap.FillRect(x, y, x2, y2: integer; c: TColor);
     1270begin
     1271  FillRect(x, y, x2, y2, ColorToBGRA(c), dmSet);
     1272end;
     1273
     1274procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string; c: TBGRAPixel);
     1275begin
     1276  TextOut(x, y, s, c, taLeftJustify);
     1277end;
     1278
     1279procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string; c: TColor);
     1280begin
     1281  TextOut(x, y, s, ColorToBGRA(c));
     1282end;
     1283
     1284procedure TBGRACustomBitmap.TextOut(x, y: integer; s: string;
     1285  texture: IBGRAScanner);
     1286begin
     1287  TextOut(x, y, s, texture, taLeftJustify);
     1288end;
     1289
     1290procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
     1291  halign: TAlignment; valign: TTextLayout; c: TBGRAPixel);
     1292var
     1293  style: TTextStyle;
     1294begin
     1295  {$hints off}
     1296  FillChar(style,sizeof(style),0);
     1297  {$hints on}
     1298  style.Alignment := halign;
     1299  style.Layout := valign;
     1300  style.Wordbreak := true;
     1301  style.ShowPrefix := false;
     1302  style.Clipping := false;
     1303  TextRect(ARect,ARect.Left,ARect.Top,s,style,c);
     1304end;
     1305
     1306procedure TBGRACustomBitmap.TextRect(ARect: TRect; s: string;
     1307  halign: TAlignment; valign: TTextLayout; texture: IBGRAScanner);
     1308var
     1309  style: TTextStyle;
     1310begin
     1311  {$hints off}
     1312  FillChar(style,sizeof(style),0);
     1313  {$hints on}
     1314  style.Alignment := halign;
     1315  style.Layout := valign;
     1316  style.Wordbreak := true;
     1317  style.ShowPrefix := false;
     1318  style.Clipping := false;
     1319  TextRect(ARect,ARect.Left,ARect.Top,s,style,texture);
     1320end;
     1321
     1322procedure TBGRACustomBitmap.FillTransparent;
     1323begin
     1324  Fill(BGRAPixelTransparent);
     1325end;
     1326
     1327procedure TBGRACustomBitmap.Fill(c: TColor);
     1328begin
     1329  Fill(ColorToBGRA(c));
     1330end;
     1331
     1332procedure TBGRACustomBitmap.Fill(c: TBGRAPixel);
     1333begin
     1334  Fill(c, 0, NbPixels);
     1335end;
     1336
     1337procedure TBGRACustomBitmap.AlphaFill(alpha: byte);
     1338begin
     1339  AlphaFill(alpha, 0, NbPixels);
     1340end;
     1341
     1342procedure TBGRACustomBitmap.FloodFill(X, Y: integer; Color: TBGRAPixel;
     1343  mode: TFloodfillMode; Tolerance: byte);
     1344begin
     1345  ParallelFloodFill(X,Y,Self,Color,mode,Tolerance);
     1346end;
     1347
     1348procedure TBGRACustomBitmap.DrawPart(ARect: TRect; Canvas: TCanvas; x,
     1349  y: integer; Opaque: boolean);
     1350var
     1351  partial: TBGRACustomBitmap;
     1352begin
     1353  partial := GetPart(ARect);
     1354  if partial <> nil then
     1355  begin
     1356    partial.Draw(Canvas, x, y, Opaque);
     1357    partial.Free;
     1358  end;
     1359end;
     1360
     1361procedure TBGRACustomBitmap.PutImageSubpixel(x, y: single; Source: TBGRACustomBitmap);
     1362begin
     1363  PutImageAngle(x,y,source,0);
     1364end;
     1365
     1366{ Interface gateway }
     1367function TBGRACustomBitmap.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1368begin
     1369  if GetInterface(iid, obj) then
     1370    Result := S_OK
     1371  else
     1372    Result := longint(E_NOINTERFACE);
     1373end;
     1374
     1375{ There is no automatic reference counting, but it is compulsory to define these functions }
     1376function TBGRACustomBitmap._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1377begin
     1378  result := 0;
     1379end;
     1380
     1381function TBGRACustomBitmap._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1382begin
     1383  result := 0;
     1384end;
     1385
     1386{$hints off}
     1387procedure TBGRACustomBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
     1388  mode: TDrawMode);
     1389begin
     1390  //do nothing
     1391end;
     1392{$hints on}
     1393
     1394function TBGRACustomBitmap.IsScanPutPixelsDefined: boolean;
     1395begin
     1396  result := False;
     1397end;
     1398
     1399{********************** End of TBGRACustomBitmap **************************}
     1400
     1401{ TBGRACustomScanner }
     1402{ The abstract class record the position so that a derived class
     1403  need only to redefine ScanAt }
     1404
     1405procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer);
     1406begin
     1407  FCurX := X;
     1408  FCurY := Y;
     1409end;
     1410
     1411{ Call ScanAt to determine pixel value }
     1412function TBGRACustomScanner.ScanNextPixel: TBGRAPixel;
     1413begin
     1414  result := ScanAt(FCurX,FCurY);
     1415  Inc(FCurX);
     1416end;
     1417
     1418{$hints off}
     1419procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
     1420  mode: TDrawMode);
     1421begin
     1422  //do nothing
     1423end;
     1424{$hints on}
     1425
     1426function TBGRACustomScanner.IsScanPutPixelsDefined: boolean;
     1427begin
     1428  result := false;
     1429end;
     1430
     1431{ Interface gateway }
     1432function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1433begin
     1434  if GetInterface(iid, obj) then
     1435    Result := S_OK
     1436  else
     1437    Result := longint(E_NOINTERFACE);
     1438end;
     1439
     1440{ There is no automatic reference counting, but it is compulsory to define these functions }
     1441function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1442begin
     1443  result := 0;
     1444end;
     1445
     1446function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
     1447begin
     1448  result := 0;
     1449end;
     1450
     1451{********************** End of TBGRACustomScanner **************************}
     1452
     1453{ The gamma correction is approximated here by a power function }
    1341454const
    135   GammaExpFactor   = 1.7;
    136 {  redWeight = 0.299;
    137   greenWeight = 0.587;
    138   blueWeight = 0.114;}
    139   redWeightShl10   = 306;
    140   greenWeightShl10 = 601;
    141   blueWeightShl10  = 117;
     1455  GammaExpFactor   = 1.7; //exponent
     1456  redWeightShl10   = 306; // = 0.299
     1457  greenWeightShl10 = 601; // = 0.587
     1458  blueWeightShl10  = 117; // = 0.114
    1421459
    1431460var
    … …  
    1461463procedure InitGamma;
    1471464var
    148   i: integer; {t: textfile; prevval,val: byte; }
    149 begin
     1465  i: integer;
     1466{$IFDEF WINCE}
     1467  j,prevpos,curpos,midpos: integer;
     1468{$ENDIF}
     1469begin
     1470  //the linear factor is used to normalize expanded values in the range 0..65535
    1501471  GammaLinearFactor := 65535 / power(255, GammaExpFactor);
     1472
     1473{$IFDEF WINCE}
     1474  curpos := 0;
     1475  GammaExpansionTab[0] := 0;
     1476  GammaCompressionTab[0] := 0;
     1477  for i := 0 to 255 do
     1478  begin
     1479    prevpos := curpos;
     1480    curpos := round(power(i, GammaExpFactor) * GammaLinearFactor);
     1481    if i = 1 then curpos := 1; //to avoid information loss
     1482    GammaExpansionTab[i] := curpos;
     1483    midpos := (prevpos+1+curpos) div 2;
     1484    for j := prevpos+1 to midpos-1 do
     1485      GammaCompressionTab[j] := i-1;
     1486    for j := midpos to curpos do
     1487      GammaCompressionTab[j] := i;
     1488  end;
     1489{$ELSE}
    1511490  for i := 0 to 255 do
    1521491    GammaExpansionTab[i] := round(power(i, GammaExpFactor) * GammaLinearFactor);
    … …  
    1551494    GammaCompressionTab[i] := round(power(i / GammaLinearFactor, 1 / GammaExpFactor));
    1561495
    157   GammaExpansionTab[1]   := 1; //to avoid information lost
     1496  GammaExpansionTab[1]   := 1; //to avoid information loss
    1581497  GammaCompressionTab[1] := 1;
    159 {
    160      assignfile(t,'gammaout.txt');
    161      rewrite(t);
    162      prevval := 255;
    163      for i := 0 to 255 do
    164      begin
    165        val := GammaCompressionTab[i*256+128];
    166        if val <> prevval then writeln(t,val);
    167        prevval := val;
    168      end;
    169      closefile(t);}
    170 end;
    171 
    172 {$hints off}
    173 
     1498{$ENDIF}
     1499end;
     1500
     1501{************************** Color functions **************************}
     1502
     1503{ The intensity is defined here as the maximum value of any color component }
    1741504function GetIntensity(c: TExpandedPixel): word; inline;
    1751505begin
    … …  
    1861516begin
    1871517  curIntensity := GetIntensity(c);
    188   if curIntensity = 0 then
     1518  if curIntensity = 0 then //suppose it's gray if there is no color information
    1891519    Result := c
    1901520  else
    1911521  begin
     1522    //linear interpolation to reached wanted intensity
    1921523    Result.red   := (c.red * intensity + (curIntensity shr 1)) div curIntensity;
    1931524    Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity;
    … …  
    1971528end;
    1981529
     1530{ The lightness here is defined as the subjective sensation of luminosity, where
     1531  blue is the darkest component and green the lightest }
    1991532function GetLightness(c: TExpandedPixel): word; inline;
    2001533begin
    … …  
    2861619end;
    2871620
     1621function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel; inline;
     1622var lightness256: byte;
     1623begin
     1624  if lightness <= 32768 then
     1625  begin
     1626    if lightness = 32768 then
     1627      result := color else
     1628    begin
     1629      lightness256 := GammaCompressionTab[lightness shl 1];
     1630      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
     1631                     color.blue * lightness256 shr 8, color.alpha);
     1632    end;
     1633  end else
     1634  begin
     1635    if lightness = 65535 then
     1636      result := BGRAWhite else
     1637    begin
     1638      lightness256 := GammaCompressionTab[(lightness-32767) shl 1];
     1639      result := BGRA(color.red + (255-color.red)*lightness256 shr 8,
     1640                     color.green + (255-color.green)*lightness256 shr 8,
     1641                     color.blue + (255-color.blue)*lightness256 shr 8,
     1642                     color.alpha);
     1643    end;
     1644  end;
     1645end;
     1646
     1647{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space }
    2881648function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
    2891649const
    … …  
    2941654var
    2951655  ec: TExpandedPixel;
    296   min, max, minMax: word;
     1656  min, max, minMax: integer;
    2971657  twiceLightness: integer;
     1658  r,g,b: integer;
    2981659begin
    2991660  ec  := GammaExpansion(c);
    300   min := ec.red;
    301   max := ec.red;
    302   if ec.green > max then
    303     max := ec.green
    304   else
    305   if ec.green < min then
    306     min := ec.green;
    307   if ec.blue > max then
    308     max := ec.blue
    309   else
    310   if ec.blue < min then
    311     min  := ec.blue;
     1661  r := ec.red;
     1662  g := ec.green;
     1663  b := ec.blue;
     1664  min := r;
     1665  max := r;
     1666  if g > max then
     1667    max := g
     1668  else
     1669  if g < min then
     1670    min := g;
     1671  if b > max then
     1672    max := b
     1673  else
     1674  if b < min then
     1675    min  := b;
    3121676  minMax := max - min;
    3131677
    … …  
    3151679    Result.hue := 0
    3161680  else
    317   if max = ec.red then
    318     Result.hue := (((ec.green - ec.blue) * deg60 + (minMax shr 1)) div
     1681  if max = r then
     1682    Result.hue := (((g - b) * deg60) div
    3191683      minMax + deg360) mod deg360
    3201684  else
    321   if max = ec.green then
    322     Result.hue := ((ec.blue - ec.red) * deg60 + (minMax shr 1)) div minMax + deg120
    323   else
    324     {max = ec.blue} Result.hue :=
    325       ((ec.red - ec.green) * deg60 + (minMax shr 1)) div minMax + deg240;
     1685  if max = g then
     1686    Result.hue := ((b - r) * deg60) div minMax + deg120
     1687  else
     1688    {max = b} Result.hue :=
     1689      ((r - g) * deg60) div minMax + deg240;
    3261690  twiceLightness := max + min;
    3271691  if min = max then
    3281692    Result.saturation := 0
    3291693  else
     1694  {$hints off}
    3301695  if twiceLightness < 65536 then
    331     Result.saturation := (minMax shl 16) div (twiceLightness + 1)
    332   else
    333     Result.saturation := (minMax shl 16) div (131072 - twiceLightness);
     1696    Result.saturation := (int64(minMax) shl 16) div (twiceLightness + 1)
     1697  else
     1698    Result.saturation := (int64(minMax) shl 16) div (131072 - twiceLightness);
     1699  {$hints on}
    3341700  Result.lightness := twiceLightness shr 1;
    3351701  Result.alpha := ec.alpha;
    336   Result.hue   := Result.hue * 65536 div deg360;
    337 end;
    338 
    339 function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
     1702  Result.hue   := (Result.hue shl 16) div deg360;
     1703end;
     1704
     1705function HtoG(hue: word): word;
     1706const
     1707  segmentDest: array[0..5] of word =
     1708     (13653, 10923, 8192, 13653, 10923, 8192);
     1709  segmentSrc: array[0..5] of word =
     1710     (10923, 10922, 10923, 10923, 10922, 10923);
     1711begin
     1712  if hue < segmentSrc[0] then
     1713    result := hue * segmentDest[0] div segmentSrc[0]
     1714  else
     1715  begin
     1716    result := segmentDest[0];
     1717    hue -= segmentSrc[0];
     1718    if hue < segmentSrc[1] then
     1719      result += hue * segmentDest[1] div segmentSrc[1]
     1720    else
     1721    begin
     1722      result += segmentDest[1];
     1723      hue -= segmentSrc[1];
     1724      if hue < segmentSrc[2] then
     1725        result += hue * segmentDest[2] div segmentSrc[2]
     1726      else
     1727      begin
     1728        result += segmentDest[2];
     1729        hue -= segmentSrc[2];
     1730        if hue < segmentSrc[3] then
     1731          result += hue * segmentDest[3] div segmentSrc[3]
     1732        else
     1733        begin
     1734          result += segmentDest[3];
     1735          hue -= segmentSrc[3];
     1736          if hue < segmentSrc[4] then
     1737            result += hue * segmentDest[4] div segmentSrc[4]
     1738          else
     1739          begin
     1740            result += segmentDest[4];
     1741            hue -= segmentSrc[4];
     1742            result += hue * segmentDest[5] div segmentSrc[5];
     1743          end;
     1744        end;
     1745      end;
     1746    end;
     1747  end;
     1748end;
     1749
     1750function GtoH(ghue: word): word;
     1751const
     1752  segment: array[0..5] of word =
     1753     (13653, 10923, 8192, 13653, 10923, 8192);
     1754begin
     1755  if ghue < segment[0] then
     1756    result := ghue * 10923 div segment[0]
     1757  else
     1758  begin
     1759    ghue -= segment[0];
     1760    if ghue < segment[1] then
     1761      result := ghue * (21845-10923) div segment[1] + 10923
     1762    else
     1763    begin
     1764      ghue -= segment[1];
     1765      if ghue < segment[2] then
     1766        result := ghue * (32768-21845) div segment[2] + 21845
     1767      else
     1768      begin
     1769        ghue -= segment[2];
     1770        if ghue < segment[3] then
     1771          result := ghue * (43691-32768) div segment[3] + 32768
     1772        else
     1773        begin
     1774          ghue -= segment[3];
     1775          if ghue < segment[4] then
     1776            result := ghue * (54613-43691) div segment[4] + 43691
     1777          else
     1778          begin
     1779            ghue -= segment[4];
     1780            result := ghue * (65536-54613) div segment[5] + 54613;
     1781          end;
     1782        end;
     1783      end;
     1784    end;
     1785  end;
     1786end;
     1787
     1788function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;
    3401789const
    3411790  deg30  = 4096;
    … …  
    3641813var
    3651814  q, p: integer;
    366   ec:   TExpandedPixel;
    3671815begin
    3681816  c.hue := c.hue * deg360 shr 16;
    3691817  if c.saturation = 0 then  //gray
    3701818  begin
    371     ec.red   := c.lightness;
    372     ec.green := c.lightness;
    373     ec.blue  := c.lightness;
    374     ec.alpha := c.alpha;
    375     Result   := GammaCompression(ec);
     1819    result.red   := c.lightness;
     1820    result.green := c.lightness;
     1821    result.blue  := c.lightness;
     1822    result.alpha := c.alpha;
    3761823    exit;
    3771824  end;
     1825  {$hints off}
    3781826  if c.lightness < 32768 then
    3791827    q := (c.lightness shr 1) * ((65535 + c.saturation) shr 1) shr 14
    … …  
    3811829    q := c.lightness + c.saturation - ((c.lightness shr 1) *
    3821830      (c.saturation shr 1) shr 14);
     1831  {$hints on}
    3831832  if q > 65535 then
    3841833    q := 65535;
    … …  
    3861835  if p > 65535 then
    3871836    p      := 65535;
    388   ec.red   := ComputeColor(p, q, c.hue + deg120);
    389   ec.green := ComputeColor(p, q, c.hue);
    390   ec.blue  := ComputeColor(p, q, c.hue + deg240);
    391   ec.alpha := c.alpha;
    392   Result   := GammaCompression(ec);
    393 end;
    394 
     1837  result.red   := ComputeColor(p, q, c.hue + deg120);
     1838  result.green := ComputeColor(p, q, c.hue);
     1839  result.blue  := ComputeColor(p, q, c.hue + deg240);
     1840  result.alpha := c.alpha;
     1841end;
     1842
     1843{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space }
     1844function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;
     1845var ec: TExpandedPixel;
     1846begin
     1847  ec := HSLAToExpanded(c);
     1848  Result := GammaCompression(ec);
     1849end;
     1850
     1851function HueDiff(h1, h2: word): word;
     1852begin
     1853  result := abs(integer(h1)-integer(h2));
     1854  if result > 32768 then result := 65536-result;
     1855end;
     1856
     1857function GetHue(ec: TExpandedPixel): word;
     1858const
     1859  deg60  = 8192;
     1860  deg120 = deg60 * 2;
     1861  deg240 = deg60 * 4;
     1862  deg360 = deg60 * 6;
     1863var
     1864  min, max, minMax: integer;
     1865  r,g,b: integer;
     1866begin
     1867  r := ec.red;
     1868  g := ec.green;
     1869  b := ec.blue;
     1870  min := r;
     1871  max := r;
     1872  if g > max then
     1873    max := g
     1874  else
     1875  if g < min then
     1876    min := g;
     1877  if b > max then
     1878    max := b
     1879  else
     1880  if b < min then
     1881    min  := b;
     1882  minMax := max - min;
     1883
     1884  if minMax = 0 then
     1885    Result := 0
     1886  else
     1887  if max = r then
     1888    Result := (((g - b) * deg60) div
     1889      minMax + deg360) mod deg360
     1890  else
     1891  if max = g then
     1892    Result := ((b - r) * deg60) div minMax + deg120
     1893  else
     1894    {max = b} Result :=
     1895      ((r - g) * deg60) div minMax + deg240;
     1896
     1897  Result   := (Result shl 16) div deg360; //normalize
     1898end;
     1899
     1900function ColorImportance(ec: TExpandedPixel): word;
     1901var min,max: word;
     1902begin
     1903  min := ec.red;
     1904  max := ec.red;
     1905  if ec.green > max then
     1906    max := ec.green
     1907  else
     1908  if ec.green < min then
     1909    min := ec.green;
     1910  if ec.blue > max then
     1911    max := ec.blue
     1912  else
     1913  if ec.blue < min then
     1914    min  := ec.blue;
     1915  result := max - min;
     1916end;
     1917
     1918function GSBAToBGRA(c: THSLAPixel): TBGRAPixel;
     1919var ec: TExpandedPixel;
     1920    lightness: word;
     1921begin
     1922  c.hue := GtoH(c.hue);
     1923  lightness := c.lightness;
     1924  c.lightness := 32768;
     1925  ec := HSLAToExpanded(c);
     1926  result := GammaCompression(SetLightness(ec, lightness));
     1927end;
     1928
     1929function GSBAToHSLA(c: THSLAPixel): THSLAPixel;
     1930begin
     1931  result := BGRAToHSLA(GSBAToBGRA(c));
     1932end;
     1933
     1934{ Apply gamma correction using conversion tables }
    3951935function GammaExpansion(c: TBGRAPixel): TExpandedPixel;
    3961936begin
    … …  
    3981938  Result.green := GammaExpansionTab[c.green];
    3991939  Result.blue  := GammaExpansionTab[c.blue];
    400   Result.alpha := c.alpha shl 8 + 128;
    401 end;
    402 
    403 {$hints on}
     1940  Result.alpha := c.alpha shl 8 + c.alpha;
     1941end;
    4041942
    4051943function GammaCompression(ec: TExpandedPixel): TBGRAPixel;
    … …  
    4111949end;
    4121950
     1951function GammaCompression(red, green, blue, alpha: word): TBGRAPixel;
     1952begin
     1953  Result.red   := GammaCompressionTab[red];
     1954  Result.green := GammaCompressionTab[green];
     1955  Result.blue  := GammaCompressionTab[blue];
     1956  Result.alpha := alpha shr 8;
     1957end;
     1958
     1959// Conversion to grayscale by taking into account
     1960// different color weights
    4131961function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
    4141962var
    … …  
    4301978end;
    4311979
     1980function GrayscaleToBGRA(lightness: word): TBGRAPixel;
     1981begin
     1982  result.red := GammaCompressionTab[lightness];
     1983  result.green := result.red;
     1984  result.blue := result.red;
     1985  result.alpha := $ff;
     1986end;
     1987
     1988{ Merge linearly two colors of same importance }
    4321989function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
     1990var c12: cardinal;
    4331991begin
    4341992  if (c1.alpha = 0) then
    … …  
    4391997  else
    4401998  begin
    441     Result.red   := round((c1.red * c1.alpha + c2.red * c2.alpha) /
    442       (c1.alpha + c2.alpha));
    443     Result.green := round((c1.green * c1.alpha + c2.green * c2.alpha) /
    444       (c1.alpha + c2.alpha));
    445     Result.blue  := round((c1.blue * c1.alpha + c2.blue * c2.alpha) /
    446       (c1.alpha + c2.alpha));
    447     Result.alpha := (c1.alpha + c2.alpha + 1) div 2;
     1999    c12 := c1.alpha + c2.alpha;
     2000    Result.red   := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12;
     2001    Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12;
     2002    Result.blue  := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12;
     2003    Result.alpha := (c12 + 1) shr 1;
     2004  end;
     2005end;
     2006
     2007function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel;
     2008  weight2: integer): TBGRAPixel;
     2009var
     2010    f1,f2,f12: integer;
     2011begin
     2012  f1 := c1.alpha*weight1;
     2013  f2 := c2.alpha*weight2;
     2014  if (f1 = 0) then
     2015  begin
     2016    if (f2 = 0) then
     2017      result := BGRAPixelTransparent
     2018    else
     2019      Result := c2
     2020  end
     2021  else
     2022  if (f2 = 0) then
     2023    Result := c1
     2024  else
     2025  if (weight1+weight2 = 0) then
     2026    Result := BGRAPixelTransparent
     2027  else
     2028  begin
     2029    f12 := f1+f2;
     2030    if f12 = 0 then
     2031      result := BGRAPixelTransparent
     2032    else
     2033    begin
     2034      Result.red   := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12;
     2035      Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12;
     2036      Result.blue  := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12;
     2037      Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2);
     2038    end;
     2039  end;
     2040end;
     2041
     2042{ Merge two colors of same importance }
     2043function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel;
     2044var c12: cardinal;
     2045begin
     2046  if (ec1.alpha = 0) then
     2047    Result := ec2
     2048  else
     2049  if (ec2.alpha = 0) then
     2050    Result := ec1
     2051  else
     2052  begin
     2053    c12 := ec1.alpha + ec2.alpha;
     2054    Result.red   := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12;
     2055    Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12;
     2056    Result.blue  := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12;
     2057    Result.alpha := (c12 + 1) shr 1;
    4482058  end;
    4492059end;
    … …  
    4652075end;
    4662076
     2077{ Convert a TColor value to a TBGRAPixel value. Note that
     2078  you need to call ColorToRGB first if you use a system
     2079  color identifier like clWindow. }
    4672080{$PUSH}{$R-}
    4682081function ColorToBGRA(color: TColor): TBGRAPixel; overload;
    … …  
    4832096{$POP}
    4842097
    485 {$hints off}
     2098{ Conversion from TFPColor to TBGRAPixel assuming TFPColor
     2099  is already gamma compressed }
     2100function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
     2101begin
     2102  with AValue do
     2103    Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
     2104end;
     2105
     2106function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
     2107begin
     2108  result.red := AValue.red shl 8 + AValue.red;
     2109  result.green := AValue.green shl 8 + AValue.green;
     2110  result.blue := AValue.blue shl 8 + AValue.blue;
     2111  result.alpha := AValue.alpha shl 8 + AValue.alpha;
     2112end;
     2113
    4862114function BGRAToColor(c: TBGRAPixel): TColor;
    4872115begin
    4882116  Result := c.red + (c.green shl 8) + (c.blue shl 16);
    4892117end;
    490 
    491 {$hints on}
    4922118
    4932119operator = (const c1, c2: TBGRAPixel): boolean;
    … …  
    5002126end;
    5012127
    502 function BGRADiff(c1, c2: TBGRAPixel): byte;
     2128function LessStartSlope65535(value: word): word;
     2129var factor: word;
     2130begin
     2131  factor := 4096 - (not value)*3 shr 7;
     2132  result := value*factor shr 12;
     2133end;
     2134
     2135function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
    5032136var
    5042137  CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2,
    5052138  CompGreenAlpha2, CompBlueAlpha2: integer;
    506   DiffAlpha: byte;
    507 begin
    508     {$hints off}
    509   CompRedAlpha1 := c1.red * c1.alpha;
    510   CompGreenAlpha1 := c1.green * c1.alpha;
    511   CompBlueAlpha1 := c1.blue * c1.alpha;
    512   CompRedAlpha2 := c2.red * c2.alpha;
    513   CompGreenAlpha2 := c2.green * c2.alpha;
    514   CompBlueAlpha2 := c2.blue * c2.alpha;
    515     {$hints on}
    516   Result    := (Abs(CompRedAlpha2 - CompRedAlpha1) +
    517     Abs(CompBlueAlpha2 - CompBlueAlpha1) + Abs(CompGreenAlpha2 - CompGreenAlpha1)) div
    518     (3 * 255);
    519   DiffAlpha := Abs(c2.Alpha - c1.Alpha) * 3 shr 2;
     2139  DiffAlpha: word;
     2140  ColorDiff: word;
     2141  TempHueDiff: word;
     2142begin
     2143  CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535
     2144  CompGreenAlpha1 := ec1.green * ec1.alpha shr 16;
     2145  CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16;
     2146  CompRedAlpha2 := ec2.red * ec2.alpha shr 16;
     2147  CompGreenAlpha2 := ec2.green * ec2.alpha shr 16;
     2148  CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16;
     2149  Result    := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 +
     2150    Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 +
     2151    Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10;
     2152  ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2));
     2153  if ColorDiff > 0 then
     2154  begin
     2155    TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2)));
     2156    if TempHueDiff < 32768 then
     2157      TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4
     2158    else
     2159      TempHueDiff := TempHueDiff shr 3;
     2160    Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12;
     2161  end;
     2162  DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha));
    5202163  if DiffAlpha > Result then
    5212164    Result := DiffAlpha;
    5222165end;
    5232166
     2167function BGRAWordDiff(c1, c2: TBGRAPixel): word;
     2168begin
     2169  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2));
     2170end;
     2171
     2172function BGRADiff(c1,c2: TBGRAPixel): byte;
     2173begin
     2174  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8;
     2175end;
     2176
     2177operator-(const c1, c2: TColorF): TColorF;
     2178begin
     2179  result[1] := c1[1]-c2[1];
     2180  result[2] := c1[2]-c2[2];
     2181  result[3] := c1[3]-c2[3];
     2182  result[4] := c1[4]-c2[4];
     2183end;
     2184
     2185operator+(const c1, c2: TColorF): TColorF;
     2186begin
     2187  result[1] := c1[1]+c2[1];
     2188  result[2] := c1[2]+c2[2];
     2189  result[3] := c1[3]+c2[3];
     2190  result[4] := c1[4]+c2[4];
     2191end;
     2192
     2193operator*(const c1, c2: TColorF): TColorF;
     2194begin
     2195  result[1] := c1[1]*c2[1];
     2196  result[2] := c1[2]*c2[2];
     2197  result[3] := c1[3]*c2[3];
     2198  result[4] := c1[4]*c2[4];
     2199end;
     2200
     2201operator*(const c1: TColorF; factor: single): TColorF;
     2202begin
     2203  result[1] := c1[1]*factor;
     2204  result[2] := c1[2]*factor;
     2205  result[3] := c1[3]*factor;
     2206  result[4] := c1[4]*factor;
     2207end;
     2208
     2209function ColorF(red, green, blue, alpha: single): TColorF;
     2210begin
     2211  result[1] := red;
     2212  result[2] := green;
     2213  result[3] := blue;
     2214  result[4] := alpha;
     2215end;
     2216
     2217{ Write a color in hexadecimal format RRGGBBAA }
     2218function BGRAToStr(c: TBGRAPixel): string;
     2219begin
     2220  result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
     2221end;
     2222
     2223type
     2224    arrayOfString = array of string;
     2225
     2226function SimpleParseFuncParam(str: string): arrayOfString;
     2227var idxOpen,start,cur: integer;
     2228begin
     2229    result := nil;
     2230    idxOpen := pos('(',str);
     2231    if idxOpen = 0 then exit;
     2232    start := idxOpen+1;
     2233    cur := start;
     2234    while cur <= length(str) do
     2235    begin
     2236       if str[cur] in[',',')'] then
     2237       begin
     2238         setlength(result,length(result)+1);
     2239         result[high(result)] := copy(str,start,cur-start);
     2240         start := cur+1;
     2241       end;
     2242       inc(cur);
     2243    end;
     2244    if start <= length(str) then
     2245    begin
     2246      setlength(result,length(result)+1);
     2247      result[high(result)] := copy(str,start,length(str)-start+1);
     2248    end;
     2249end;
     2250
     2251function ParseColorValue(str: string): byte;
     2252var pourcent,unclipped,errPos: integer;
     2253begin
     2254  if str = '' then result := 0 else
     2255  begin
     2256    if str[length(str)]='%' then
     2257    begin
     2258      val(copy(str,1,length(str)-1),pourcent,errPos);
     2259      if pourcent < 0 then result := 0 else
     2260      if pourcent > 100 then result := 255 else
     2261        result := pourcent*255 div 100;
     2262    end else
     2263    begin
     2264      val(str,unclipped,errPos);
     2265      if unclipped < 0 then result := 0 else
     2266      if unclipped > 255 then result := 255 else
     2267        result := unclipped;
     2268    end;
     2269  end;
     2270end;
     2271
     2272{ Read a color in hexadecimal format RRGGBB(AA) or RGB(A) }
     2273function StrToBGRA(str: string): TBGRAPixel;
     2274var errPos: integer;
     2275    values: array of string;
     2276    alphaF: single;
     2277    idx: integer;
     2278begin
     2279  if str = '' then
     2280  begin
     2281    result := BGRAPixelTransparent;
     2282    exit;
     2283  end;
     2284  str := lowerCase(str);
     2285
     2286  //VGA color names
     2287  if str='black' then result := BGRA(0,0,0) else
     2288  if str='silver' then result := BGRA(192,192,192) else
     2289  if str='gray' then result := BGRA(128,128,128) else
     2290  if str='white' then result := BGRA(255,255,255) else
     2291  if str='maroon' then result := BGRA(128,0,0) else
     2292  if str='red' then result := BGRA(255,0,0) else
     2293  if str='purple' then result := BGRA(128,0,128) else
     2294  if str='fuchsia' then result := BGRA(255,0,255) else
     2295  if str='green' then result := BGRA(0,128,0) else
     2296  if str='lime' then result := BGRA(0,255,0) else
     2297  if str='olive' then result := BGRA(128,128,0) else
     2298  if str='yellow' then result := BGRA(255,255,0) else
     2299  if str='navy' then result := BGRA(0,0,128) else
     2300  if str='blue' then result := BGRA(0,0,255) else
     2301  if str='teal' then result := BGRA(0,128,128) else
     2302  if str='aqua' then result := BGRA(0,255,255) else
     2303  if str='transparent' then result := BGRAPixelTransparent else
     2304  begin
     2305    //check CSS color
     2306    idx := CSSColors.IndexOf(str);
     2307    if idx <> -1 then
     2308    begin
     2309      result := CSSColors[idx];
     2310      exit;
     2311    end;
     2312
     2313    //CSS RGB notation
     2314    if (copy(str,1,4)='rgb(') or (copy(str,1,5)='rgba(') then
     2315    begin
     2316      values := SimpleParseFuncParam(str);
     2317      if (length(values)=3) or (length(values)=4) then
     2318      begin
     2319        result.red := ParseColorValue(values[0]);
     2320        result.green := ParseColorValue(values[1]);
     2321        result.blue := ParseColorValue(values[2]);
     2322        if length(values)=4 then
     2323        begin
     2324          val(values[3],alphaF,errPos);
     2325          if alphaF < 0 then
     2326            result.alpha := 0 else
     2327          if alphaF > 1 then
     2328            result.alpha := 255
     2329          else
     2330            result.alpha := round(alphaF*255);
     2331        end else
     2332          result.alpha := 255;
     2333      end else
     2334        result := BGRAPixelTransparent;
     2335      exit;
     2336    end;
     2337
     2338    //remove HTML notation header
     2339    if str[1]='#' then delete(str,1,1);
     2340
     2341    //add alpha if missing
     2342    if length(str)=6 then str += 'FF';
     2343    if length(str)=3 then str += 'F';
     2344
     2345    //hex notation
     2346    if length(str)=8 then
     2347    begin
     2348      val('$'+copy(str,1,2),result.red,errPos);
     2349      val('$'+copy(str,3,2),result.green,errPos);
     2350      val('$'+copy(str,5,2),result.blue,errPos);
     2351      val('$'+copy(str,7,2),result.alpha,errPos);
     2352    end else
     2353    if length(str)=4 then
     2354    begin
     2355      val('$'+copy(str,1,1),result.red,errPos);
     2356      val('$'+copy(str,2,1),result.green,errPos);
     2357      val('$'+copy(str,3,1),result.blue,errPos);
     2358      val('$'+copy(str,4,1),result.alpha,errPos);
     2359      result.red *= $11;
     2360      result.green *= $11;
     2361      result.blue *= $11;
     2362      result.alpha *= $11;
     2363    end else
     2364      result := BGRAPixelTransparent;
     2365  end;
     2366
     2367end;
     2368
     2369
     2370function MapHeight(Color: TBGRAPixel): Single;
     2371var intval: integer;
     2372begin
     2373  intval := color.Green shl 16 + color.red shl 8 + color.blue;
     2374  result := intval/16777215;
     2375end;
     2376
     2377function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
     2378var intval: integer;
     2379begin
     2380  if Height >= 1 then result := BGRA(255,255,255,alpha) else
     2381  if Height <= 0 then result := BGRA(0,0,0,alpha) else
     2382  begin
     2383    intval := round(Height*16777215);
     2384    result := BGRA(intval shr 8,intval shr 16,intval,alpha);
     2385  end;
     2386end;
     2387
     2388{********************** Point functions **************************}
     2389
    5242390function PointF(x, y: single): TPointF;
    5252391begin
    5262392  Result.x := x;
    5272393  Result.y := y;
     2394end;
     2395
     2396function PointsF(const pts: array of TPointF): ArrayOfTPointF;
     2397var
     2398  i: Integer;
     2399begin
     2400  setlength(result, length(pts));
     2401  for i := 0 to high(pts) do result[i] := pts[i];
     2402end;
     2403
     2404operator =(const pt1, pt2: TPointF): boolean;
     2405begin
     2406  result := (pt1.x = pt2.x) and (pt1.y = pt2.y);
     2407end;
     2408
     2409operator-(const pt1, pt2: TPointF): TPointF;
     2410begin
     2411  result.x := pt1.x-pt2.x;
     2412  result.y := pt1.y-pt2.y;
     2413end;
     2414
     2415operator-(const pt2: TPointF): TPointF;
     2416begin
     2417  result.x := -pt2.x;
     2418  result.y := -pt2.y;
     2419end;
     2420
     2421operator+(const pt1, pt2: TPointF): TPointF;
     2422begin
     2423  result.x := pt1.x+pt2.x;
     2424  result.y := pt1.y+pt2.y;
     2425end;
     2426
     2427operator*(const pt1, pt2: TPointF): single;
     2428begin
     2429  result := pt1.x*pt2.x + pt1.y*pt2.y;
     2430end;
     2431
     2432operator*(const pt1: TPointF; factor: single): TPointF;
     2433begin
     2434  result.x := pt1.x*factor;
     2435  result.y := pt1.y*factor;
     2436end;
     2437
     2438operator*(factor: single; const pt1: TPointF): TPointF;
     2439begin
     2440  result.x := pt1.x*factor;
     2441  result.y := pt1.y*factor;
    5282442end;
    5292443
    … …  
    5482462end;
    5492463
    550 function StrToGradientType(str: string): TGradientType;
    551 var gt: TGradientType;
    552 begin
    553   result := gtLinear;
    554   str := LowerCase(str);
    555   for gt := low(TGradientType) to high(TGradientType) do
    556     if str = LowerCase(GradientTypeStr[gt]) then
     2464function VectLen(dx, dy: single): single;
     2465begin
     2466  result := sqrt(dx*dx+dy*dy);
     2467end;
     2468
     2469function VectLen(v: TPointF): single;
     2470begin
     2471  result := sqrt(v.x*v.x+v.y*v.y);
     2472end;
     2473
     2474function IntersectLine(line1, line2: TLineDef): TPointF;
     2475var parallel: boolean;
     2476begin
     2477  result := IntersectLine(line1,line2,parallel);
     2478end;
     2479
     2480function IntersectLine(line1, line2: TLineDef; out parallel: boolean): TPointF;
     2481var divFactor: double;
     2482begin
     2483  parallel := false;
     2484  //if lines are parallel
     2485  if ((line1.dir.x = line2.dir.x) and (line1.dir.y = line2.dir.y)) or
     2486     ((abs(line1.dir.y) < 1e-6) and (abs(line2.dir.y) < 1e-6)) then
     2487  begin
     2488       parallel := true;
     2489       //return the center of the segment between line origins
     2490       result.x := (line1.origin.x+line2.origin.x)/2;
     2491       result.y := (line1.origin.y+line2.origin.y)/2;
     2492  end else
     2493  if abs(line1.dir.y) < 1e-6 then //line1 is horizontal
     2494  begin
     2495       result.y := line1.origin.y;
     2496       result.x := line2.origin.x + (result.y - line2.origin.y)
     2497               /line2.dir.y*line2.dir.x;
     2498  end else
     2499  if abs(line2.dir.y) < 1e-6 then //line2 is horizontal
     2500  begin
     2501       result.y := line2.origin.y;
     2502       result.x := line1.origin.x + (result.y - line1.origin.y)
     2503               /line1.dir.y*line1.dir.x;
     2504  end else
     2505  begin
     2506       divFactor := line1.dir.x/line1.dir.y - line2.dir.x/line2.dir.y;
     2507       if abs(divFactor) < 1e-6 then //almost parallel
     2508       begin
     2509            parallel := true;
     2510            //return the center of the segment between line origins
     2511            result.x := (line1.origin.x+line2.origin.x)/2;
     2512            result.y := (line1.origin.y+line2.origin.y)/2;
     2513       end else
     2514       begin
     2515         result.y := (line2.origin.x - line1.origin.x +
     2516                  line1.origin.y*line1.dir.x/line1.dir.y -
     2517                  line2.origin.y*line2.dir.x/line2.dir.y)
     2518                  / divFactor;
     2519         result.x := line1.origin.x + (result.y - line1.origin.y)
     2520                 /line1.dir.y*line1.dir.x;
     2521       end;
     2522  end;
     2523end;
     2524
     2525{ Check if a polygon is convex, i.e. it always turns in the same direction }
     2526function IsConvex(const pts: array of TPointF; IgnoreAlign: boolean = true): boolean;
     2527var
     2528  positive,negative,zero: boolean;
     2529  product: single;
     2530  i: Integer;
     2531begin
     2532  positive := false;
     2533  negative := false;
     2534  zero := false;
     2535  for i := 0 to high(pts) do
     2536  begin
     2537    product := (pts[(i+1) mod length(pts)].x-pts[i].x)*(pts[(i+2) mod length(pts)].y-pts[i].y) -
     2538               (pts[(i+1) mod length(pts)].y-pts[i].y)*(pts[(i+2) mod length(pts)].x-pts[i].x);
     2539    if product > 0 then
    5572540    begin
    558       result := gt;
    559       exit;
     2541      if negative then
     2542      begin
     2543        result := false;
     2544        exit;
     2545      end;
     2546      positive := true;
     2547    end else
     2548    if product < 0 then
     2549    begin
     2550      if positive then
     2551      begin
     2552        result := false;
     2553        exit;
     2554      end;
     2555      negative := true;
     2556    end else
     2557      zero := true;
     2558  end;
     2559  if not IgnoreAlign and zero then
     2560    result := false
     2561  else
     2562    result := true;
     2563end;
     2564
     2565{ Check if two segments intersect }
     2566function DoesSegmentIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
     2567var
     2568  seg1: TLineDef;
     2569  seg1len: single;
     2570  seg2: TLineDef;
     2571  seg2len: single;
     2572  inter: TPointF;
     2573  pos1,pos2: single;
     2574  para: boolean;
     2575
     2576begin
     2577  { Determine line definitions }
     2578  seg1.origin := pt1;
     2579  seg1.dir := pt2-pt1;
     2580  seg1len := sqrt(sqr(seg1.dir.X)+sqr(seg1.dir.Y));
     2581  if seg1len = 0 then
     2582  begin
     2583    result := false;
     2584    exit;
     2585  end;
     2586  seg1.dir *= 1/seg1len;
     2587
     2588  seg2.origin := pt3;
     2589  seg2.dir := pt4-pt3;
     2590  seg2len := sqrt(sqr(seg2.dir.X)+sqr(seg2.dir.Y));
     2591  if seg2len = 0 then
     2592  begin
     2593    result := false;
     2594    exit;
     2595  end;
     2596  seg2.dir *= 1/seg2len;
     2597
     2598  //obviously parallel
     2599  if seg1.dir = seg2.dir then
     2600    result := false
     2601  else
     2602  begin
     2603    //try to compute intersection
     2604    inter := IntersectLine(seg1,seg2,para);
     2605    if para then
     2606      result := false
     2607    else
     2608    begin
     2609      //check if intersections are inside the segments
     2610      pos1 := (inter-seg1.origin)*seg1.dir;
     2611      pos2 := (inter-seg2.origin)*seg2.dir;
     2612      if (pos1 >= 0) and (pos1 <= seg1len) and
     2613         (pos2 >= 0) and (pos2 <= seg2len) then
     2614        result := true
     2615      else
     2616        result := false;
    5602617    end;
    561 end;
    562 
    563 function BGRAToStr(c: TBGRAPixel): string;
    564 begin
    565   result := IntToHex(c.red,2)+IntToHex(c.green,2)+IntToHex(c.Blue,2)+IntToHex(c.Alpha,2);
    566 end;
    567 
    568 {$hints off}
    569 {$notes off}
    570 function StrToBGRA(str: string): TBGRAPixel;
    571 var errPos: integer;
    572 begin
    573   if length(str)=6 then str += 'FF';
    574   if length(str)=3 then str += 'F';
    575   if length(str)=8 then
    576   begin
    577     val('$'+copy(str,1,2),result.red,errPos);
    578     val('$'+copy(str,3,2),result.green,errPos);
    579     val('$'+copy(str,5,2),result.blue,errPos);
    580     val('$'+copy(str,7,2),result.alpha,errPos);
     2618  end;
     2619end;
     2620
     2621{ Check if a quaduadrilateral intersects itself }
     2622function DoesQuadIntersect(pt1,pt2,pt3,pt4: TPointF): boolean;
     2623begin
     2624  result := DoesSegmentIntersect(pt1,pt2,pt3,pt4) or DoesSegmentIntersect(pt2,pt3,pt4,pt1);
     2625end;
     2626
     2627{************************** Cyclic functions *******************}
     2628
     2629// Get the cyclic value in the range [0..cycle-1]
     2630function PositiveMod(value, cycle: integer): integer; inline;
     2631begin
     2632  result := value mod cycle;
     2633  if result < 0 then //modulo can be negative
     2634    Inc(result, cycle);
     2635end;
     2636
     2637{ Table of precalc values. Note : the value is stored for
     2638  the first half of the cycle, and values are stored 'minus 1'
     2639  in order to stay in the range 0..65535 }
     2640var
     2641  sinTab65536: packed array of word;
     2642
     2643function Sin65536(value: word): integer;
     2644var b: integer;
     2645begin
     2646  //allocate array
     2647  if sinTab65536 = nil then
     2648    setlength(sinTab65536,32768);
     2649
     2650  if value >= 32768 then //function is upside down after half-period
     2651  begin
     2652    b := value xor 32768;
     2653    if sinTab65536[b] = 0 then //precalc
     2654      sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1;
     2655    result := not sinTab65536[b];
    5812656  end else
    582   if length(str)=4 then
    583   begin
    584     val('$'+copy(str,1,1),result.red,errPos);
    585     val('$'+copy(str,2,1),result.green,errPos);
    586     val('$'+copy(str,3,1),result.blue,errPos);
    587     val('$'+copy(str,4,1),result.alpha,errPos);
    588     result.red *= $11;
    589     result.green *= $11;
    590     result.blue *= $11;
    591     result.alpha *= $11;
    592   end else
    593     result := BGRAPixelTransparent;
    594 end;
    595 {$notes on}
    596 {$hints on}
     2657  begin
     2658    b := value;
     2659    if sinTab65536[b] = 0 then //precalc
     2660      sinTab65536[b] := round((sin(b*2*Pi/65536)+1)*65536/2)-1;
     2661    {$hints off}
     2662    result := sinTab65536[b]+1;
     2663    {$hints on}
     2664  end;
     2665end;
     2666
     2667function Cos65536(value: word): integer;
     2668begin
     2669  result := Sin65536(value+16384); //cosine is translated
     2670end;
     2671
     2672procedure PrecalcSin65536;
     2673var
     2674  i: Integer;
     2675begin
     2676  for i := 0 to 32767 do Sin65536(i);
     2677end;
    5972678
    5982679initialization
    5992680
    6002681  InitGamma;
     2682  CSSColors := TBGRAColorList.Create;
     2683  CSSColors.Add('AliceBlue',CSSAliceBlue);
     2684  CSSColors.Add('AntiqueWhite',CSSAntiqueWhite);
     2685  CSSColors.Add('Aqua',CSSAqua);
     2686  CSSColors.Add('Aquamarine',CSSAquamarine);
     2687  CSSColors.Add('Azure',CSSAzure);
     2688  CSSColors.Add('Beige',CSSBeige);
     2689  CSSColors.Add('Bisque',CSSBisque);
     2690  CSSColors.Add('Black',CSSBlack);
     2691  CSSColors.Add('BlanchedAlmond',CSSBlanchedAlmond);
     2692  CSSColors.Add('Blue',CSSBlue);
     2693  CSSColors.Add('BlueViolet',CSSBlueViolet);
     2694  CSSColors.Add('Brown',CSSBrown);
     2695  CSSColors.Add('BurlyWood',CSSBurlyWood);
     2696  CSSColors.Add('CadetBlue',CSSCadetBlue);
     2697  CSSColors.Add('Chartreuse',CSSChartreuse);
     2698  CSSColors.Add('Chocolate',CSSChocolate);
     2699  CSSColors.Add('Coral',CSSCoral);
     2700  CSSColors.Add('CornflowerBlue',CSSCornflowerBlue);
     2701  CSSColors.Add('Cornsilk',CSSCornsilk);
     2702  CSSColors.Add('Crimson',CSSCrimson);
     2703  CSSColors.Add('Cyan',CSSCyan);
     2704  CSSColors.Add('DarkBlue',CSSDarkBlue);
     2705  CSSColors.Add('DarkCyan',CSSDarkCyan);
     2706  CSSColors.Add('DarkGoldenrod',CSSDarkGoldenrod);
     2707  CSSColors.Add('DarkGray',CSSDarkGray);
     2708  CSSColors.Add('DarkGreen',CSSDarkGreen);
     2709  CSSColors.Add('DarkKhaki',CSSDarkKhaki);
     2710  CSSColors.Add('DarkMagenta',CSSDarkMagenta);
     2711  CSSColors.Add('DarkOliveGreen',CSSDarkOliveGreen);
     2712  CSSColors.Add('DarkOrange',CSSDarkOrange);
     2713  CSSColors.Add('DarkOrchid',CSSDarkOrchid);
     2714  CSSColors.Add('DarkRed',CSSDarkRed);
     2715  CSSColors.Add('DarkSalmon',CSSDarkSalmon);
     2716  CSSColors.Add('DarkSeaGreen',CSSDarkSeaGreen);
     2717  CSSColors.Add('DarkSlateBlue',CSSDarkSlateBlue);
     2718  CSSColors.Add('DarkSlateGray',CSSDarkSlateGray);
     2719  CSSColors.Add('DarkTurquoise',CSSDarkTurquoise);
     2720  CSSColors.Add('DarkViolet',CSSDarkViolet);
     2721  CSSColors.Add('DeepPink',CSSDeepPink);
     2722  CSSColors.Add('DeepSkyBlue',CSSDeepSkyBlue);
     2723  CSSColors.Add('DimGray',CSSDimGray);
     2724  CSSColors.Add('DodgerBlue',CSSDodgerBlue);
     2725  CSSColors.Add('FireBrick',CSSFireBrick);
     2726  CSSColors.Add('FloralWhite',CSSFloralWhite);
     2727  CSSColors.Add('ForestGreen',CSSForestGreen);
     2728  CSSColors.Add('Fuchsia',CSSFuchsia);
     2729  CSSColors.Add('Gainsboro',CSSGainsboro);
     2730  CSSColors.Add('GhostWhite',CSSGhostWhite);
     2731  CSSColors.Add('Gold',CSSGold);
     2732  CSSColors.Add('Goldenrod',CSSGoldenrod);
     2733  CSSColors.Add('Gray',CSSGray);
     2734  CSSColors.Add('Green',CSSGreen);
     2735  CSSColors.Add('GreenYellow',CSSGreenYellow);
     2736  CSSColors.Add('Honeydew',CSSHoneydew);
     2737  CSSColors.Add('HotPink',CSSHotPink);
     2738  CSSColors.Add('IndianRed',CSSIndianRed);
     2739  CSSColors.Add('Indigo',CSSIndigo);
     2740  CSSColors.Add('Ivory',CSSIvory);
     2741  CSSColors.Add('Khaki',CSSKhaki);
     2742  CSSColors.Add('Lavender',CSSLavender);
     2743  CSSColors.Add('LavenderBlush',CSSLavenderBlush);
     2744  CSSColors.Add('LawnGreen',CSSLawnGreen);
     2745  CSSColors.Add('LemonChiffon',CSSLemonChiffon);
     2746  CSSColors.Add('LightBlue',CSSLightBlue);
     2747  CSSColors.Add('LightCoral',CSSLightCoral);
     2748  CSSColors.Add('LightCyan',CSSLightCyan);
     2749  CSSColors.Add('LightGoldenrodYellow',CSSLightGoldenrodYellow);
     2750  CSSColors.Add('LightGray',CSSLightGray);
     2751  CSSColors.Add('LightGreen',CSSLightGreen);
     2752  CSSColors.Add('LightPink',CSSLightPink);
     2753  CSSColors.Add('LightSalmon',CSSLightSalmon);
     2754  CSSColors.Add('LightSeaGreen',CSSLightSeaGreen);
     2755  CSSColors.Add('LightSkyBlue',CSSLightSkyBlue);
     2756  CSSColors.Add('LightSlateGray',CSSLightSlateGray);
     2757  CSSColors.Add('LightSteelBlue',CSSLightSteelBlue);
     2758  CSSColors.Add('LightYellow',CSSLightYellow);
     2759  CSSColors.Add('Lime',CSSLime);
     2760  CSSColors.Add('LimeGreen',CSSLimeGreen);
     2761  CSSColors.Add('Linen',CSSLinen);
     2762  CSSColors.Add('Magenta',CSSMagenta);
     2763  CSSColors.Add('Maroon',CSSMaroon);
     2764  CSSColors.Add('MediumAquamarine',CSSMediumAquamarine);
     2765  CSSColors.Add('MediumBlue',CSSMediumBlue);
     2766  CSSColors.Add('MediumOrchid',CSSMediumOrchid);
     2767  CSSColors.Add('MediumPurple',CSSMediumPurple);
     2768  CSSColors.Add('MediumSeaGreen',CSSMediumSeaGreen);
     2769  CSSColors.Add('MediumSlateBlue',CSSMediumSlateBlue);
     2770  CSSColors.Add('MediumSpringGreen',CSSMediumSpringGreen);
     2771  CSSColors.Add('MediumTurquoise',CSSMediumTurquoise);
     2772  CSSColors.Add('MediumVioletRed',CSSMediumVioletRed);
     2773  CSSColors.Add('MidnightBlue',CSSMidnightBlue);
     2774  CSSColors.Add('MintCream',CSSMintCream);
     2775  CSSColors.Add('MistyRose',CSSMistyRose);
     2776  CSSColors.Add('Moccasin',CSSMoccasin);
     2777  CSSColors.Add('NavajoWhite',CSSNavajoWhite);
     2778  CSSColors.Add('Navy',CSSNavy);
     2779  CSSColors.Add('OldLace',CSSOldLace);
     2780  CSSColors.Add('Olive',CSSOlive);
     2781  CSSColors.Add('OliveDrab',CSSOliveDrab);
     2782  CSSColors.Add('Orange',CSSOrange);
     2783  CSSColors.Add('OrangeRed',CSSOrangeRed);
     2784  CSSColors.Add('Orchid',CSSOrchid);
     2785  CSSColors.Add('PaleGoldenrod',CSSPaleGoldenrod);
     2786  CSSColors.Add('PaleGreen',CSSPaleGreen);
     2787  CSSColors.Add('PaleTurquoise',CSSPaleTurquoise);
     2788  CSSColors.Add('PaleVioletRed',CSSPaleVioletRed);
     2789  CSSColors.Add('PapayaWhip',CSSPapayaWhip);
     2790  CSSColors.Add('PeachPuff',CSSPeachPuff);
     2791  CSSColors.Add('Peru',CSSPeru);
     2792  CSSColors.Add('Pink',CSSPink);
     2793  CSSColors.Add('Plum',CSSPlum);
     2794  CSSColors.Add('PowderBlue',CSSPowderBlue);
     2795  CSSColors.Add('Purple',CSSPurple);
     2796  CSSColors.Add('Red',CSSRed);
     2797  CSSColors.Add('RosyBrown',CSSRosyBrown);
     2798  CSSColors.Add('RoyalBlue',CSSRoyalBlue);
     2799  CSSColors.Add('SaddleBrown',CSSSaddleBrown);
     2800  CSSColors.Add('Salmon',CSSSalmon);
     2801  CSSColors.Add('SandyBrown',CSSSandyBrown);
     2802  CSSColors.Add('SeaGreen',CSSSeaGreen);
     2803  CSSColors.Add('Seashell',CSSSeashell);
     2804  CSSColors.Add('Sienna',CSSSienna);
     2805  CSSColors.Add('Silver',CSSSilver);
     2806  CSSColors.Add('SkyBlue',CSSSkyBlue);
     2807  CSSColors.Add('SlateBlue',CSSSlateBlue);
     2808  CSSColors.Add('SlateGray',CSSSlateGray);
     2809  CSSColors.Add('Snow',CSSSnow);
     2810  CSSColors.Add('SpringGreen',CSSSpringGreen);
     2811  CSSColors.Add('SteelBlue',CSSSteelBlue);
     2812  CSSColors.Add('Tan',CSSTan);
     2813  CSSColors.Add('Teal',CSSTeal);
     2814  CSSColors.Add('Thistle',CSSThistle);
     2815  CSSColors.Add('Tomato',CSSTomato);
     2816  CSSColors.Add('Turquoise',CSSTurquoise);
     2817  CSSColors.Add('Violet',CSSViolet);
     2818  CSSColors.Add('Wheat',CSSWheat);
     2819  CSSColors.Add('White',CSSWhite);
     2820  CSSColors.Add('WhiteSmoke',CSSWhiteSmoke);
     2821  CSSColors.Add('Yellow',CSSYellow);
     2822  CSSColors.Add('YellowGreen',CSSYellowGreen);
     2823  CSSColors.Finished;
     2824
     2825finalization
     2826
     2827  CSSColors.Free;
    6012828
    6022829end.
    603 
Note: See TracChangeset for help on using the changeset viewer.